[Apache-dispatch-devel] SF.net SVN: apache-dispatch: [31] trunk
Brought to you by:
geoffrey_young,
phred_moyer
Menu
▾
▴
[Apache-dispatch-devel] SF.net SVN: apache-dispatch: [31] trunk
|
From: <phr...@us...> - 2006-05-22 01:29:05
|
Revision: 31 Author: phred_moyer Date: 2006-05-21 18:28:57 -0700 (Sun, 21 May 2006) ViewCVS: http://svn.sourceforge.net/apache-dispatch/?rev=31&view=rev Log Message: ----------- - Add DispatchDebug directives in the configuration file. - Re-add the DispatchDebug callback now that I understand which direction this was meant to go in. - Some small cleanups in the test libraries. - Move plain.t to 01plain.t. Add a test for lack of dispatch_index functionality below the top level DispatchPrefix class. All tests for 01plain.t passing now for mp2. There's an inheritance problem that's preventing the tests from passing under mp1 which I haven't figured out yet. Modified Paths: -------------- trunk/Makefile.PL trunk/lib/Apache/Dispatch/Util.pm trunk/lib/Apache/Dispatch.pm trunk/lib/Apache2/Dispatch.pm trunk/t/conf/extra.last.conf.in trunk/t/lib/Apache/Foo.pm trunk/t/lib/Apache2/Foo/Bar.pm trunk/t/lib/Apache2/Foo.pm Added Paths: ----------- trunk/t/01plain.t Removed Paths: ------------- trunk/t/plain.t Modified: trunk/Makefile.PL =================================================================== --- trunk/Makefile.PL 2006-05-21 19:00:11 UTC (rev 30) +++ trunk/Makefile.PL 2006-05-22 01:28:57 UTC (rev 31) @@ -14,7 +14,6 @@ my %makefile_params = ( 'VERSION' => '0.10', - 'PREREQ_PM' => \%prereq, ); # enable "make test" @@ -32,6 +31,7 @@ if ($mp_wanted == 2) { # mod_perl2 specific makefile $prereq{'mod_perl2'} = 1.99023; # this covers the naming change $makefile_params{'NAME'} = 'Apache2::Dispatch'; + $makefile_params{'PREREQ_PM'} = \%prereq; require ModPerl::MM; ModPerl::MM::WriteMakefile(%makefile_params); @@ -59,25 +59,23 @@ will need a C compiler and Apache/mod_perl sources.\n\n"; $makefile_params{'PL_FILES'} = {'set_pureperl.PL' => '0'}; - $makefile_params{'PREREQ_PM'} = {mod_perl => 1.2401,}; $makefile_params{'clean'} = {FILES => '*.xs*'}; import Apache::ExtUtils qw(command_table); require Apache::Dispatch::Util; - my $directives = Apache::Dispatch::Util->directives(); - command_table($directives); - - } - - my $inc = Apache::src->new->inc; - die "Can't find mod_perl header files installed" unless $inc; - + my @directives = Apache::Dispatch::Util->directives(); + command_table(\@directives); + + my $inc = Apache::src->new->inc; + die "Can't find mod_perl header files installed" unless $inc; + $makefile_params{'INC'} = $inc; + } + $makefile_params{'PREREQ_PM'} = {mod_perl => 1.2401}; require ExtUtils::MakeMaker; ExtUtils::MakeMaker::WriteMakefile( - NAME => 'Apache::Dispatch', - INC => $inc, - LIBS => [''], - %makefile_params, + NAME => __PACKAGE__, + PREREQ_PM => \%prereq, + %makefile_params, ); } Modified: trunk/lib/Apache/Dispatch/Util.pm =================================================================== --- trunk/lib/Apache/Dispatch/Util.pm 2006-05-21 19:00:11 UTC (rev 30) +++ trunk/lib/Apache/Dispatch/Util.pm 2006-05-22 01:28:57 UTC (rev 31) @@ -198,7 +198,7 @@ my $mtime = (stat $INC{$module})[9]; unless (defined $mtime && $mtime) { - $log->warn("Apache2::Dispatch cannot find $module!"); + $log->warn("Apache::Dispatch cannot find $module!"); return 1; } @@ -211,7 +211,7 @@ eval { require $module }; if ($@) { - $log->error("Apache2::Dispatch: $module failed reload! $@"); + $log->error("Apache::Dispatch: $module failed reload! $@"); return; } elsif (!$@) { @@ -224,7 +224,7 @@ } } else { - $log->warn("Apache2::Dispatch: $module not in \%INC!"); + $log->warn("Apache::Dispatch: $module not in \%INC!"); } return 1; @@ -451,8 +451,8 @@ sub DispatchRequire { my ($cfg, $parms, $arg) = @_; - - $cfg->{_require} = $arg; + + $cfg->{_require} = $arg; } sub DispatchFilter { @@ -473,6 +473,12 @@ $cfg->{_uppercase} = $arg; } +sub DispatchDebug { + my ($cfg, $parms, $arg) = @_; + + $cfg->{_debug} = $arg; +} + =pod =back Modified: trunk/lib/Apache/Dispatch.pm =================================================================== --- trunk/lib/Apache/Dispatch.pm 2006-05-21 19:00:11 UTC (rev 30) +++ trunk/lib/Apache/Dispatch.pm 2006-05-22 01:28:57 UTC (rev 31) @@ -15,16 +15,16 @@ use mod_perl 1.2401; use Apache::Constants qw(OK DECLINED SERVER_ERROR); -use Apache::Log; +use Apache::Log (); use Apache::Dispatch::Util; push @Apache::Dispatch::ISA, qw(Apache::Dispatch::Util); $Apache::Dispatch::PUREPERL = 0; # set during perl Makefile.PL if ($Apache::Dispatch::PUREPERL == 0) { - require Apache::ModuleConfig; + require Apache::ModuleConfig; require DynaLoader; - @Apache::Dispatch::ISA = qw(DynaLoader); + push @Apache::Dispatch::ISA, qw(DynaLoader); __PACKAGE__->bootstrap($VERSION); } @@ -460,11 +460,9 @@ Off - do not use Apache::Filter (Default) - DispatchDebug - DEPRECATED - Per development notes this directive has been deprecated as of - Apache::Dispatch 0.10. The debugging verbosity is controlled using - the Apache LogLevel directive. - + DispatchDebug + Set DispatchDebug to 1 or 2 to control the verbosity of debug statements. + =head1 SPECIAL CODING GUIDELINES Migrating to Apache::Dispatch is relatively painless - it requires Modified: trunk/lib/Apache2/Dispatch.pm =================================================================== --- trunk/lib/Apache2/Dispatch.pm 2006-05-21 19:00:11 UTC (rev 30) +++ trunk/lib/Apache2/Dispatch.pm 2006-05-22 01:28:57 UTC (rev 31) @@ -22,6 +22,7 @@ # Initialize the directives my $directives = __PACKAGE__->directives(); + Apache2::Module::add(__PACKAGE__, $directives); sub handler { @@ -31,9 +32,9 @@ #--------------------------------------------------------------------- my $r = shift; - # Is there an advantage to keeping the pureperl option? my $dcfg; - $dcfg = + + $dcfg = Apache2::Module::get_config(__PACKAGE__, $r->server, $r->per_dir_config); my $filter = $dcfg->{_filter} Copied: trunk/t/01plain.t (from rev 24, trunk/t/plain.t) =================================================================== --- trunk/t/01plain.t (rev 0) +++ trunk/t/01plain.t 2006-05-22 01:28:57 UTC (rev 31) @@ -0,0 +1,26 @@ +use strict; +use warnings FATAL => 'all'; + +use Apache::Test; +use Apache::TestRequest; + +plan tests => 4, \&have_lwp; + +# Test Apache2::Foo->dispatch_index +my $uri = '/plain'; +ok GET_OK $uri; + +# Test Apache2::Foo->dispatch_foo +$uri = '/plain/foo'; +ok GET_OK $uri; + +# Test non-usage of Apache2::Foo::Bar->dispatch_index since +# Apache2::Foo->dispatch_bar does not exist +$uri = '/plain/bar'; +my $res = GET $uri; +ok $res->code == 404; + +# Test Apache2::Foo::Bar->dispatch_baz +$uri = '/plain/bar/baz'; +ok GET_OK $uri; + Modified: trunk/t/conf/extra.last.conf.in =================================================================== --- trunk/t/conf/extra.last.conf.in 2006-05-21 19:00:11 UTC (rev 30) +++ trunk/t/conf/extra.last.conf.in 2006-05-22 01:28:57 UTC (rev 31) @@ -8,7 +8,8 @@ <Location /plain> SetHandler perl-script DispatchRequire On - + DispatchDebug 2 + DispatchUpperCase On <IfDefine APACHE2> DispatchPrefix Apache2::Foo PerlResponseHandler Apache2::Dispatch @@ -17,7 +18,6 @@ PerlHandler Apache::Dispatch DispatchPrefix Apache::Foo </IfDefine> - </Location> <Location /filtered> @@ -25,6 +25,7 @@ DispatchFilter On DispatchRequire On DispatchExtras Pre Post + DispatchDebug 2 <IfDefine APACHE2> DispatchPrefix Apache2::Foo @@ -41,6 +42,7 @@ SetHandler perl-script DispatchRequire On DispatchExtras Pre Error + DispatchDebug 2 <IfDefine APACHE2> DispatchPrefix Apache2::Foo @@ -58,6 +60,7 @@ DispatchRequire On DispatchAUTOLOAD On DispatchISA Foo::Parent + DispatchDebug 2 <IfDefine APACHE2> DispatchPrefix Apache2::Foo @@ -74,6 +77,7 @@ SetHandler perl-script DispatchLocation /BLARG DispatchRequire On + DispatchDebug 2 <IfDefine APACHE2> DispatchPrefix Apache2::Foo Modified: trunk/t/lib/Apache/Foo.pm =================================================================== --- trunk/t/lib/Apache/Foo.pm 2006-05-21 19:00:11 UTC (rev 30) +++ trunk/t/lib/Apache/Foo.pm 2006-05-22 01:28:57 UTC (rev 31) @@ -1,4 +1,4 @@ -package Apache::Foo; +package Apache::Foo::Foo; use Apache::Constants qw( OK SERVER_ERROR ); use strict; @@ -6,9 +6,10 @@ sub dispatch_foo { my $class = shift; my $r = shift; - $r->send_http_header('text/plain'); - $r->print("Foo->dispatch_foo()"); - print STDERR "Foo->dispatch_foo()\n"; + $r->log->debug(__PACKAGE__ . "->dispatch_foo()\n"; + + $r->send_http_header('text/plain'); + $r->print("Foo::Foo->dispatch_foo()"); return OK; } @@ -38,8 +39,8 @@ my $class = shift; my $r = shift; $r->send_http_header('text/plain'); - $r->print("Foo->dispatch_index()"); - print STDERR "Foo->dispatch_index()\n"; + $r->print("Foo::Foo->dispatch_index()"); + print STDERR "Foo::Foo->dispatch_index()\n"; return OK; } Modified: trunk/t/lib/Apache2/Foo/Bar.pm =================================================================== --- trunk/t/lib/Apache2/Foo/Bar.pm 2006-05-21 19:00:11 UTC (rev 30) +++ trunk/t/lib/Apache2/Foo/Bar.pm 2006-05-22 01:28:57 UTC (rev 31) @@ -5,24 +5,28 @@ use Apache2::Const -compile => qw( OK SERVER_ERROR ); use Apache2::RequestRec; +use Apache2::RequestIO; -@Foo::Bar::ISA = qw(Apache::Foo::Foo); +@Foo::Bar::ISA = qw(Apache2::Foo::Foo); sub dispatch_index { # test calls to /Bar/index or / my $self = shift; my $r = shift; - $r->send_http_header('text/plain'); - $r->print("Foo::Bar->dispatch_index()"); - print STDERR "Foo::Bar->dispatch_index()\n"; + $r->log_debug(__PACKAGE__ . "->dispatch_index()"); + + $r->content_type('text/plain'); + $r->print(__PACKAGE__ . "->dispatch_index()"); return Apache2::Const::OK; } sub dispatch_baz { my ($class, $r) = @_; + $r->log->debug(__PACKAGE__ . "->dispatch_baz()"); - $r->log->debug("Foo->dispatch_baz()"); + $r->content_type('text/plain'); $Foo::Foo::output = "pid $$"; + $r->print(__PACKAGE__ . "->dispatch_index()"); return Apache2::Const::OK; } @@ -30,9 +34,9 @@ my $self = shift; my $r = shift; # delay printing headers until all processing is done - $r->send_http_header('text/plain'); + $r->content_type('text/plain'); $r->print($Foo::Foo::output); - print STDERR "Foo->post_dispatch()\n"; + $r->log->debug(__PACKAGE__ . "->post_dispatch()"); } 1; @@ -47,7 +51,8 @@ <Location /Test> SetHandler perl-script PerlHandler Apache2::Dispatch - DispatchPrefix Foo + DispatchUpperCase On + DispatchPrefix Foo DispatchExtras Pre Post Error </Location> Modified: trunk/t/lib/Apache2/Foo.pm =================================================================== --- trunk/t/lib/Apache2/Foo.pm 2006-05-21 19:00:11 UTC (rev 30) +++ trunk/t/lib/Apache2/Foo.pm 2006-05-22 01:28:57 UTC (rev 31) @@ -1,50 +1,51 @@ package Apache2::Foo; +use strict; + use Apache2::Const -compile => qw( OK SERVER_ERROR ); use Apache2::RequestIO; -use strict; sub dispatch_foo { my ($class, $r) = @_; + $r->log->debug(__PACKAGE__ . "->dispatch_foo()"); $r->content_type('text/plain'); - $r->print("Foo->dispatch_foo()"); - $r->log->debug("Foo->dispatch_foo()"); + $r->print(__PACKAGE__ . "->dispatch_foo()"); return Apache2::Const::OK; } -sub dispatch_bar { +sub dispatch_uhoh { my ($class, $r) = @_; - require Data::Dumper; - $r->log->debug("ARGV is " . Data::Dumper::Dumper(\@_)); - $r->log->debug( "Foo->dispatch_bar()"); + + $r->log->debug(__PACKAGE__ . "->dispatch_uhoh()"); return Apache2::Const::SERVER_ERROR; } sub pre_dispatch { my ($class, $r) = @_; - $r->log->debug("Foo->pre_dispatch()"); + $r->log->debug(__PACKAGE__ . "->pre_dispatch()"); } sub post_dispatch { my ($class, $r) = @_; - $r->log->debug("Foo->post_dispatch()"); + $r->log->debug(__PACKAGE__ . "->post_dispatch()"); } sub error_dispatch { my ($class, $r) = @_; + $r->log->debug(__PACKAGE__ . "->error_dispatch()"); - $r->send_http_header('text/plain'); - $r->print("Yikes! Foo->dispatch_error()"); + $r->content_type('text/plain'); + $r->print("Yikes! " . __PACKAGE__ . "->dispatch_error()"); return Apache2::Const::OK; } sub dispatch_index { my ($class, $r) = @_; + $r->log->debug(__PACKAGE__ . "->dispatch_index()"); $r->content_type('text/plain'); - $r->print("Foo->dispatch_index()"); - $r->log->debug( "Foo->dispatch_index()"); + $r->print(__PACKAGE__ . "->dispatch_index()"); return Apache2::Const::OK; } Deleted: trunk/t/plain.t =================================================================== --- trunk/t/plain.t 2006-05-21 19:00:11 UTC (rev 30) +++ trunk/t/plain.t 2006-05-22 01:28:57 UTC (rev 31) @@ -1,24 +0,0 @@ -use strict; -use warnings FATAL => 'all'; - -use Apache::Test; -use Apache::TestRequest; - -plan tests => 4, \&have_lwp; - -# Test Apache2::Foo->dispatch_index -my $url = '/plain/'; -ok GET_OK $url; - -# Test Apache2::Foo->dispatch_foo -$url = '/plain/foo'; -ok GET_OK $url; - -# Test Apache2::Foo::Bar->dispatch_index -$url = '/plain/Bar/'; -ok GET_OK $url; - -# Test Apache2::Foo::Bar->dispatch_foo -$url = '/plain/Bar/baz'; -ok GET_OK $url; - This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
