apache-dispatch-devel Mailing List for Apache::Dispatch (Page 5)
Brought to you by:
geoffrey_young,
phred_moyer
Menu
▾
▴
apache-dispatch-devel — Apache::Dispatch development list
You can subscribe to this list here.
| 2006 |
Jan
|
Feb
|
Mar
(4) |
Apr
(33) |
May
(10) |
Jun
(22) |
Jul
(3) |
Aug
(15) |
Sep
(3) |
Oct
(3) |
Nov
|
Dec
|
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2007 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
(2) |
Aug
(5) |
Sep
|
Oct
|
Nov
|
Dec
(9) |
| 2008 |
Jan
(6) |
Feb
(2) |
Mar
|
Apr
|
May
|
Jun
(11) |
Jul
|
Aug
|
Sep
|
Oct
(2) |
Nov
|
Dec
|
| 2009 |
Jan
|
Feb
|
Mar
|
Apr
(12) |
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2010 |
Jan
|
Feb
(3) |
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
From: Fred M. <fr...@ta...> - 2006-05-23 03:33:05
|
Geoffrey Young wrote: > Fred Moyer wrote: > > oh, and this is you, right? > > http://search.cpan.org/~phred/ It is. No modules yet :(, but they are on their way there. > I need to make you a co-maintainer in pause so you can issue a release > at some point. I'd also make sure to ping thomas again prior to a > release, just to make sure he's ok as the other co-maintainer... Ok sounds good, I'll ping Thomas prior to the release. I've reclaimed some tuits, and have set a goal for myself to have a release ready in two weeks. I've got a site using this that needs to be up by then, so it's good motivation. |
|
From: Geoffrey Y. <ge...@mo...> - 2006-05-22 16:45:46
|
Fred Moyer wrote: > Fred Moyer wrote: > >> For some reason, while testing with mod_perl1 I get this error message: >> >> waiting 60 seconds for server to start: .Syntax error on line 22 of >> /home/fred/dev/apache-dispatch/trunk/t/conf/extra.last.conf: >> Can't locate auto/Apache/Dispatch/DispatchReq.al in @INC (@INC contains: > > > Here's the work around I've used so that the DispatchRequire et al. > method calls can be shared Apache2::Dispatch and Apache::Dispatch. Geoff > if you have any ideas about why I hit this problem, or how to fix it > more cleanly please let me know. this is feeling vaguely familiar. IIRC you _must_ PerlModule the _exact_ module with your subroutine callbacks. so, if you did something like this PerlModule Apache::Dispatch:DispatchReq it would probably work. but who wants to do that - your solution below seems perfectly fine. > This seems like it *might* be a > mod_perl1 inheritance / command table method name issue - if it looks > that way to you then I'll put together a reproducible case and send it > to the mod_perl list. you could do that, but my feeling is that nobody would touch the mp1 code even to see if it's really a problem that should be addressed or a "feature" - mp1 is so solid at this point that bugfixes would likely only be considered if there were no workaround-by-design ability. oh, and this is you, right? http://search.cpan.org/~phred/ I need to make you a co-maintainer in pause so you can issue a release at some point. I'd also make sure to ping thomas again prior to a release, just to make sure he's ok as the other co-maintainer... --Geoff > > --- trunk/lib/Apache/Dispatch.pm 2006-05-22 01:28:57 UTC (rev 31) > +++ trunk/lib/Apache/Dispatch.pm 2006-05-22 06:20:02 UTC (rev 32) > @@ -15,16 +15,38 @@ > > use mod_perl 1.2401; > use Apache::Constants qw(OK DECLINED SERVER_ERROR); > -use Apache::Log (); > -use Apache::Dispatch::Util; > -push @Apache::Dispatch::ISA, qw(Apache::Dispatch::Util); > +use Apache::Log (); > +use Apache::Dispatch::Util (); > > +BEGIN { > + push @Apache::Dispatch::ISA, qw(Apache::Dispatch::Util); > + > + { > + > + #--------------------------------------------------------------------- > + # there is a problem with using command_table methods with > inheritance > + # so here we map the command table directive names to the > methods in > + # Apache::Dispatch::Util using the symbol table. this allows > us to > + # share the code between Apache::Dispatch and Apache2::Dispatch > + #--------------------------------------------------------------------- > + > + my @dir_names = > + map { $_->{name} } @{Apache::Dispatch::Util->directives}; > + no strict 'refs'; > + foreach my $directive (@dir_names) { > + *{"Apache::Dispatch::$directive"} = > + \&{"Apache::Dispatch::Util::$directive"}; > + } > + > + } > +} > + > > > ------------------------------------------------------- > Using Tomcat but need to do more? Need to support web services, security? > Get stuff done quickly with pre-integrated technology to make your job > easier > Download IBM WebSphere Application Server v.1.0.1 based on Apache Geronimo > http://sel.as-us.falkag.net/sel?cmd=lnk&kid=120709&bid=263057&dat=121642 > _______________________________________________ > Apache-dispatch-devel mailing list > Apa...@li... > https://lists.sourceforge.net/lists/listinfo/apache-dispatch-devel |
|
From: Fred M. <fr...@ta...> - 2006-05-22 06:26:59
|
Fred Moyer wrote:
> For some reason, while testing with mod_perl1 I get this error message:
>
> waiting 60 seconds for server to start: .Syntax error on line 22 of
> /home/fred/dev/apache-dispatch/trunk/t/conf/extra.last.conf:
> Can't locate auto/Apache/Dispatch/DispatchReq.al in @INC (@INC contains:
Here's the work around I've used so that the DispatchRequire et al.
method calls can be shared Apache2::Dispatch and Apache::Dispatch.
Geoff if you have any ideas about why I hit this problem, or how to fix
it more cleanly please let me know. This seems like it *might* be a
mod_perl1 inheritance / command table method name issue - if it looks
that way to you then I'll put together a reproducible case and send it
to the mod_perl list.
--- trunk/lib/Apache/Dispatch.pm 2006-05-22 01:28:57 UTC (rev 31)
+++ trunk/lib/Apache/Dispatch.pm 2006-05-22 06:20:02 UTC (rev 32)
@@ -15,16 +15,38 @@
use mod_perl 1.2401;
use Apache::Constants qw(OK DECLINED SERVER_ERROR);
-use Apache::Log ();
-use Apache::Dispatch::Util;
-push @Apache::Dispatch::ISA, qw(Apache::Dispatch::Util);
+use Apache::Log ();
+use Apache::Dispatch::Util ();
+BEGIN {
+ push @Apache::Dispatch::ISA, qw(Apache::Dispatch::Util);
+
+ {
+
+
#---------------------------------------------------------------------
+ # there is a problem with using command_table methods with
inheritance
+ # so here we map the command table directive names to the
methods in
+ # Apache::Dispatch::Util using the symbol table. this allows us to
+ # share the code between Apache::Dispatch and Apache2::Dispatch
+
#---------------------------------------------------------------------
+
+ my @dir_names =
+ map { $_->{name} } @{Apache::Dispatch::Util->directives};
+ no strict 'refs';
+ foreach my $directive (@dir_names) {
+ *{"Apache::Dispatch::$directive"} =
+ \&{"Apache::Dispatch::Util::$directive"};
+ }
+
+ }
+}
+
|
|
From: <phr...@us...> - 2006-05-22 06:20:10
|
Revision: 32 Author: phred_moyer Date: 2006-05-21 23:20:02 -0700 (Sun, 21 May 2006) ViewCVS: http://svn.sourceforge.net/apache-dispatch/?rev=32&view=rev Log Message: ----------- - Some cleanup of test libraries - Map the directive names in Apache::Dispatch::Util to Apache::Dispatch space to work around the issue of command_directive methods not being accessible for inheritance. See the Apache::Dispatch source for the symbol table manipulations. Modified Paths: -------------- trunk/lib/Apache/Dispatch.pm trunk/t/lib/Apache/Foo.pm trunk/t/lib/Apache2/Foo/Bar.pm Modified: trunk/lib/Apache/Dispatch.pm =================================================================== --- trunk/lib/Apache/Dispatch.pm 2006-05-22 01:28:57 UTC (rev 31) +++ trunk/lib/Apache/Dispatch.pm 2006-05-22 06:20:02 UTC (rev 32) @@ -15,16 +15,38 @@ use mod_perl 1.2401; use Apache::Constants qw(OK DECLINED SERVER_ERROR); -use Apache::Log (); -use Apache::Dispatch::Util; -push @Apache::Dispatch::ISA, qw(Apache::Dispatch::Util); +use Apache::Log (); +use Apache::Dispatch::Util (); +BEGIN { + push @Apache::Dispatch::ISA, qw(Apache::Dispatch::Util); + + { + + #--------------------------------------------------------------------- + # there is a problem with using command_table methods with inheritance + # so here we map the command table directive names to the methods in + # Apache::Dispatch::Util using the symbol table. this allows us to + # share the code between Apache::Dispatch and Apache2::Dispatch + #--------------------------------------------------------------------- + + my @dir_names = + map { $_->{name} } @{Apache::Dispatch::Util->directives}; + no strict 'refs'; + foreach my $directive (@dir_names) { + *{"Apache::Dispatch::$directive"} = + \&{"Apache::Dispatch::Util::$directive"}; + } + + } +} + $Apache::Dispatch::PUREPERL = 0; # set during perl Makefile.PL if ($Apache::Dispatch::PUREPERL == 0) { - require Apache::ModuleConfig; + require Apache::ModuleConfig; require DynaLoader; - push @Apache::Dispatch::ISA, qw(DynaLoader); + push @Apache::Dispatch::ISA, qw(DynaLoader); __PACKAGE__->bootstrap($VERSION); } @@ -204,7 +226,8 @@ # if not, decline the request #--------------------------------------------------------------------- - my $handler = __PACKAGE__->_check_dispatch($object, $method, $autoload, $log, $debug); + my $handler = + __PACKAGE__->_check_dispatch($object, $method, $autoload, $log, $debug); if ($handler) { $log->info("\t$uri was translated into $class->$method") @@ -223,17 +246,18 @@ foreach my $extra (@extras) { if ($extra eq "PRE") { $prehandler = - __PACKAGE__->_check_dispatch($object, "pre_dispatch", $autoload, $log, $debug); + __PACKAGE__->_check_dispatch($object, "pre_dispatch", $autoload, + $log, $debug); } elsif ($extra eq "POST") { $posthandler = - __PACKAGE__->_check_dispatch($object, "post_dispatch", $autoload, $log, - $debug); + __PACKAGE__->_check_dispatch($object, "post_dispatch", $autoload, + $log, $debug); } elsif ($extra eq "ERROR") { $errorhandler = - __PACKAGE__->_check_dispatch($object, "error_dispatch", $autoload, $log, - $debug); + __PACKAGE__->_check_dispatch($object, "error_dispatch", $autoload, + $log, $debug); } } Modified: trunk/t/lib/Apache/Foo.pm =================================================================== --- trunk/t/lib/Apache/Foo.pm 2006-05-22 01:28:57 UTC (rev 31) +++ trunk/t/lib/Apache/Foo.pm 2006-05-22 06:20:02 UTC (rev 32) @@ -1,4 +1,4 @@ -package Apache::Foo::Foo; +package Apache::Foo; use Apache::Constants qw( OK SERVER_ERROR ); use strict; @@ -6,24 +6,29 @@ sub dispatch_foo { my $class = shift; my $r = shift; - $r->log->debug(__PACKAGE__ . "->dispatch_foo()\n"; + $r->log->debug(__PACKAGE__ . "->dispatch_foo()"); $r->send_http_header('text/plain'); - $r->print("Foo::Foo->dispatch_foo()"); + $r->print(__PACKAGE__ . "->dispatch_foo()"); return OK; } -sub dispatch_bar { - print STDERR "Foo->dispatch_bar()\n"; +sub dispatch_uhoh { + my ($class, $r) = @_; + + $r->log->debug(__PACKAGE__ . "->dispatch_bar()"); return SERVER_ERROR; } sub pre_dispatch { - print STDERR "Foo->pre_dispatch()\n"; + my ($class, $r) = @_; + $r->log->debug(__PACKAGE__ . "->pre_dispatch()"); } sub post_dispatch { - print STDERR "Foo->post_dispatch()\n"; + my ($class, $r) = @_; + $r->log->debug(__PACKAGE__ . "->post_dispatch()"); + $r->print($Apache::Foo::output); } sub error_dispatch { @@ -31,7 +36,7 @@ my $r = shift; $r->send_http_header('text/plain'); $r->print("Yikes! Foo->dispatch_error()"); - print STDERR "Yikes! Foo->dispatch_error()\n"; + $r->log->error("Yikes! " . __PACKAGE__ . "->dispatch_error()"); return OK; } @@ -39,8 +44,8 @@ my $class = shift; my $r = shift; $r->send_http_header('text/plain'); - $r->print("Foo::Foo->dispatch_index()"); - print STDERR "Foo::Foo->dispatch_index()\n"; + $r->print(__PACKAGE__ . "->dispatch_index()"); + $r->log->debug(__PACKAGE__ . "->dispatch_index()"); return OK; } Modified: trunk/t/lib/Apache2/Foo/Bar.pm =================================================================== --- trunk/t/lib/Apache2/Foo/Bar.pm 2006-05-22 01:28:57 UTC (rev 31) +++ trunk/t/lib/Apache2/Foo/Bar.pm 2006-05-22 06:20:02 UTC (rev 32) @@ -25,8 +25,8 @@ $r->log->debug(__PACKAGE__ . "->dispatch_baz()"); $r->content_type('text/plain'); - $Foo::Foo::output = "pid $$"; - $r->print(__PACKAGE__ . "->dispatch_index()"); + $Apache2::Foo::Foo::output = "pid $$"; + $r->print(__PACKAGE__ . "->dispatch_baz()"); return Apache2::Const::OK; } @@ -35,7 +35,7 @@ my $r = shift; # delay printing headers until all processing is done $r->content_type('text/plain'); - $r->print($Foo::Foo::output); + $r->print($Apache2::Foo::Foo::output); $r->log->debug(__PACKAGE__ . "->post_dispatch()"); } This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
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. |
|
From: Fred M. <fr...@ta...> - 2006-05-22 01:22:21
|
For some reason, while testing with mod_perl1 I get this error message:
waiting 60 seconds for server to start: .Syntax error on line 22 of
/home/fred/dev/apache-dispatch/trunk/t/conf/extra.last.conf:
Can't locate auto/Apache/Dispatch/DispatchReq.al in @INC (@INC contains:
/home/fred/dev/apache-dispatch/trunk/t/lib
/home/fred/dev/apache-dispatch/trunk/blib/lib
/home/fred/dev/apache-dispatch/trunk/blib/arch /home/fred/dev/sl/trunk/lib
/home/fred/dev/apache-dispatch/trunk/t
/home/fred/dev/perl/lib/5.8.6/i686-linux /home/fred/dev/perl/lib/5.8.6
/home/fred/dev/perl/lib/site_perl/5.8.6/i686-linux
/home/fred/dev/perl/lib/site_perl/5.8.6 /home/fred/dev/perl/lib/site_perl
. /home/fred/dev/apache-dispatch/trunk/t/
/home/fred/dev/apache-dispatch/trunk/t/lib/perl) at /dev/null line 0
In Apache::Dispatch (and Dispatch2) I setup an inheritance from
Apache::Dispatch::Util as follows:
use Apache::Dispatch::Util;
@Apache::Dispatch::ISA = qw(Apache::Dispatch::Util);
and in DispatchUtil.pm
sub DispatchRequire {
my ($cfg, $parms, $arg) = @_;
$cfg->{_require} = $arg;
}
The inheritance works properly under mod_perl2, so I'm guessing that this
is a mod_perl1 specific issue of calling inherited methods which are also
setup through the command_table function. If I define sub DispatchRequire
directly in the Apache::Dispatch package I don't receive the above error.
|
|
From: <phr...@us...> - 2006-05-21 19:00:16
|
Revision: 30 Author: phred_moyer Date: 2006-05-21 12:00:11 -0700 (Sun, 21 May 2006) ViewCVS: http://svn.sourceforge.net/apache-dispatch/?rev=30&view=rev Log Message: ----------- - Add dispatch_index() method to test library. Modified Paths: -------------- trunk/t/lib/Apache2/Foo/Bar.pm Modified: trunk/t/lib/Apache2/Foo/Bar.pm =================================================================== --- trunk/t/lib/Apache2/Foo/Bar.pm 2006-04-23 06:01:28 UTC (rev 29) +++ trunk/t/lib/Apache2/Foo/Bar.pm 2006-05-21 19:00:11 UTC (rev 30) @@ -6,8 +6,18 @@ use Apache2::Const -compile => qw( OK SERVER_ERROR ); use Apache2::RequestRec; -@Foo::Bar::ISA = qw(Foo::Foo); +@Foo::Bar::ISA = qw(Apache::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"; + return Apache2::Const::OK; +} + sub dispatch_baz { my ($class, $r) = @_; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: Fred M. <fr...@ta...> - 2006-05-02 08:19:57
|
development has slowed down a bit as I've had to queue this for a few other processes. going to have to push back the expected release another week which makes 2-3 weeks from now. sorry to the eager folks at home, but we'll see this through. |
|
From: <phr...@us...> - 2006-04-23 06:01:34
|
Revision: 29 Author: phred_moyer Date: 2006-04-22 23:01:28 -0700 (Sat, 22 Apr 2006) ViewCVS: http://svn.sourceforge.net/apache-dispatch/?rev=29&view=rev Log Message: ----------- - Apache*::Dispatch modules now inherit common methods from Apache::Dispatch::Util - add test libs for Apache::Foo et all - update changelog to reflect recent changes Modified Paths: -------------- trunk/Changes trunk/MANIFEST trunk/lib/Apache/Dispatch/Util.pm trunk/lib/Apache/Dispatch.pm trunk/lib/Apache2/Dispatch.pm Added Paths: ----------- trunk/t/lib/Apache/ trunk/t/lib/Apache/Bar.pm trunk/t/lib/Apache/Foo.pm Modified: trunk/Changes =================================================================== --- trunk/Changes 2006-04-23 03:40:39 UTC (rev 28) +++ trunk/Changes 2006-04-23 06:01:28 UTC (rev 29) @@ -1,8 +1,17 @@ Revision history for Perl extension Apache::Dispatch 0.10 05.07.2001 + - move common methods to Apache::Dispatch::Util and adjust @ISA for + Apache*::Dispatch modules to use common methods via inheritance - fred + - deprecated $Apache::Dispatch::DEBUG directive per dev notes in favor + of DispatchDebug, which accepts the same arguments, see pod - fred + - mod_perl2 compatibility via Apache2::Dispatch - fred + - source code now under subversion at + http://svn.sourceforge.net/viewcvs.cgi/apache-dispatch/ - geoff, domm + - project moved to http://sourceforge.net/projects/apache-dispatch - geoff + * new maintainer: Fred Moyer <fr...@re...> - pass $rc to error handler to allow for finer grained error handling - - print "Using/Exiting A::D" only if $debub>=1 + - print "Using/Exiting A::D" only if $debug>=1 * new maintainer: Thomas Klausner, do...@zs... - fixed DispatchISA bug that kept adding the same classes to @ISA (Barrie Slaymaker) Modified: trunk/MANIFEST =================================================================== --- trunk/MANIFEST 2006-04-23 03:40:39 UTC (rev 28) +++ trunk/MANIFEST 2006-04-23 06:01:28 UTC (rev 29) @@ -1,10 +1,14 @@ Changes MANIFEST Makefile.PL -Dispatch.pm README ToDo -eg/Foo.pm -eg/Bar.pm -eg/Foo/Foo.pm -eg/Foo/Bar.pm +lib/Apache/Dispatch.pm +lib/Apache/Dispatch/Util.pm +lib/Apache2/Dispatch.pm +t/lib/Apache/Foo/Bar.pm +t/lib/Apache/Foo/Foo.pm +t/lib/Apache/Bar.pm +t/lib/Apache/Foo.pm +t/lib/Apache2/Foo/Bar.pm +t/lib/Apache2/Foo.pm Modified: trunk/lib/Apache/Dispatch/Util.pm =================================================================== --- trunk/lib/Apache/Dispatch/Util.pm 2006-04-23 03:40:39 UTC (rev 28) +++ trunk/lib/Apache/Dispatch/Util.pm 2006-04-23 06:01:28 UTC (rev 29) @@ -23,7 +23,7 @@ =back =cut - + my @directives = ( #------------------------------------------------------------------ @@ -67,6 +67,16 @@ }, #------------------------------------------------------------------ + # DispatchDebug defines debugging verbosity + #------------------------------------------------------------------ + { + name => 'DispatchDebug', + errmsg => 'numeric verbosity level', + args_how => 'TAKE1', + req_override => 'OR_ALL', + }, + + #------------------------------------------------------------------ # DispatchISA is a list of modules your module should inherit from #------------------------------------------------------------------ { @@ -117,6 +127,9 @@ }, ); +# create global hash to hold the modification times of the modules +my %stat = (); + =head1 METHODS =over 4 @@ -144,10 +157,322 @@ =cut sub directives { - my $class = shift; - return wantarray ? @directives : \@directives; + my $class = shift; + return wantarray ? @directives : \@directives; } +=item bogus_uri + +=cut + +sub bogus_uri { + my ($class, $uri) = @_; + if ($uri =~ m![^\w/-]!) { + return 1; + } + return; +} +#********************************************************************* +# the below methods are not part of the external API +#********************************************************************* + +sub _stat { + + #--------------------------------------------------------------------- + # stat and reload the module if it has changed... + # this method is for internal use only + #--------------------------------------------------------------------- + + my $pkg = shift; + my ($class, $log) = @_; + + (my $module = $class) =~ s!::!/!g; + + $module .= ".pm"; + + $stat{$module} = $^T unless $stat{$module}; + + if ($INC{$module}) { + $log->info("\tchecking $module for reload in pid $$..."); + + my $mtime = (stat $INC{$module})[9]; + + unless (defined $mtime && $mtime) { + $log->warn("Apache2::Dispatch cannot find $module!"); + return 1; + } + + if ($mtime > $stat{$module}) { + + # turn off warnings for this bit... + local $^W; + + delete $INC{$module}; + eval { require $module }; + + if ($@) { + $log->error("Apache2::Dispatch: $module failed reload! $@"); + return; + } + elsif (!$@) { + $log->debug("\t$module reloaded"); + } + $stat{$module} = $mtime; + } + else { + $log->info("\t$module not modified"); + } + } + else { + $log->warn("Apache2::Dispatch: $module not in \%INC!"); + } + + return 1; +} + +sub _recurse_stat { + + #--------------------------------------------------------------------- + # recurse through all the parent classes of the current class + # and call _stat on each + # this method is for internal use only + #--------------------------------------------------------------------- + + my ($class, $log) = @_; + + my $rc = _stat($class, $log); + + return unless $rc; + + # turn off strict here so we can get at the class @ISA + no strict 'refs'; + + foreach my $package (@{"${class}::ISA"}) { + $rc = _recurse_stat($package, $log); + last unless $rc; + } + + return $rc; +} + +sub _set_ISA { + + #--------------------------------------------------------------------- + # set the ISA array for the class + # this method is for internal use only + #--------------------------------------------------------------------- + my $pkg; + my ($class, $log, @parents) = @_; + + # turn off strict here so we can get at the class @ISA + no strict 'refs'; + + $log->debug("\t\@ISA for $class currently contains ", + (join ", ", @{"${class}::ISA"})); + $log->debug("\tabout to merge ", (join ", ", @parents)); + + # only add classes to @ISA if they are not there already + my %seen; + + @{"${class}::ISA"} = grep !$seen{$_}++, (@{"${class}::ISA"}, @parents); + + return 1; +} + +#--------------------------------------------------------------------- +# Apache configuration methods +#--------------------------------------------------------------------- + +sub _new { + return bless {}, shift; +} + +sub DIR_CREATE { + my $class = shift; + my $self = $class->_new; + + $self->{_stat} = "Off"; # no reloading by default + $self->{_autoload} = 0; # no autloading by default + $self->{_require} = 0; # no require()ing by default + + # warn "inside DIR_CREATE"; + return $self; +} + +sub DIR_MERGE { + my ($parent, $current) = @_; + my %new = (%$parent, %$current); + + # warn "inside DIR_MERGE"; + return bless \%new, ref($parent); +} + +sub _translate_uri { + + #--------------------------------------------------------------------- + # take the uri and return a class and method + # this method is for internal use only + #--------------------------------------------------------------------- + + my $pkg = shift; + my ($r, $prefix, $newloc, $log, $debug) = @_; + + my $uri = $r->uri; + + my $location; + + # change all the / to :: + (my $class_and_method = $r->uri) =~ s!/!::!g; + + if ($newloc) { + $log->info("\tmodifying location from ", $r->location, " to $newloc") + if $debug > 1; + ($location = $newloc) =~ s!/!::!g; + } + else { + ($location = $r->location) =~ s!/!::!g; + } + + # strip off the leading and trailing :: if any + $class_and_method =~ s/^::|::$//g; + $location =~ s/^::|::$//g; + + # substitute the prefix for the location + # <Location /> is a special case that we can deal with + # (but not advertise :) + my $times; + + if ($location) { + $times = $class_and_method =~ s/^\Q$location/$prefix/e; + } + else { + + # <Location /> + $prefix .= "::"; + $times = $class_and_method =~ s/^/$prefix/e; + } + + unless ($times) { + $log->info("\tLocation substitution failed - uri not translated") + if $debug > 1; + + return (undef, undef); + } + + my ($class, $method); + + if ($prefix eq $class_and_method) { + $method = "dispatch_index"; + $class = $prefix; + } + else { + ($class, $method) = $class_and_method =~ m/(.*)::(.*)/; + $method = "dispatch_$method"; + } + + return ($class, $method); +} + +sub _check_dispatch { + + #--------------------------------------------------------------------- + # see if class->method() is a valid call + # this method is for internal use only + #--------------------------------------------------------------------- + + my $pkg = shift; + my ($object, $method, $autoload, $log, $debug) = @_; + + my $class = ref($object); + + my $coderef; + + $log->info("\tchecking the validity of $class->$method...") + if $debug > 1; + + if ($autoload) { + $coderef = $object->can($method) || $object->can("AUTOLOAD"); + } + else { + $coderef = $object->can($method); + } + + if ($coderef && $debug > 1) { + $log->info("\t$class->$method is a valid method call"); + } + elsif ($debug > 1) { + $log->info("\t$class->$method is not a valid method call"); + } + + return $coderef; +} + +sub DispatchLocation { + my ($cfg, $parms, $arg) = @_; + + $cfg->{_newloc} = $arg; +} + +sub DispatchPrefix { + my ($cfg, $parms, $arg) = @_; + + $cfg->{_prefix} = $arg; +} + +sub DispatchExtras { + my ($cfg, $parms, $arg) = @_; + + if ($arg =~ m/^(Pre|Post|Error)$/i) { + push @{$cfg->{_extras}}, uc($arg) + unless grep /$arg/i, @{$cfg->{_extras}}; + } + else { + die "Invalid DispatchExtra $arg!"; + } +} + +sub DispatchISA { + my ($cfg, $parms, $arg) = @_; + + push @{$cfg->{_isa}}, $arg + unless grep /$arg/, @{$cfg->{_isa}}; +} + +sub DispatchStat { + my ($cfg, $parms, $arg) = @_; + + if ($arg =~ m/^(On|Off|ISA)$/i) { + $cfg->{_stat} = uc($arg); + } + else { + die "Invalid DispatchStat $arg!"; + } +} + +sub DispatchRequire { + my ($cfg, $parms, $arg) = @_; + + $cfg->{_require} = $arg; +} + +sub DispatchFilter { + my ($cfg, $parms, $arg) = @_; + + $cfg->{_filter} = $arg; +} + +sub DispatchAUTOLOAD { + my ($cfg, $parms, $arg) = @_; + + $cfg->{_autoload} = $arg; +} + +sub DispatchUpperCase { + my ($cfg, $parms, $arg) = @_; + + $cfg->{_uppercase} = $arg; +} + =pod =back Modified: trunk/lib/Apache/Dispatch.pm =================================================================== --- trunk/lib/Apache/Dispatch.pm 2006-04-23 03:40:39 UTC (rev 28) +++ trunk/lib/Apache/Dispatch.pm 2006-04-23 06:01:28 UTC (rev 29) @@ -16,30 +16,18 @@ use mod_perl 1.2401; use Apache::Constants qw(OK DECLINED SERVER_ERROR); use Apache::Log; +use Apache::Dispatch::Util; +push @Apache::Dispatch::ISA, qw(Apache::Dispatch::Util); -$Apache::Dispatch::PUREPERL=0; # set during perl Makefile.PL +$Apache::Dispatch::PUREPERL = 0; # set during perl Makefile.PL -# create global hash to hold the modification times of the modules -my %stat = (); - if ($Apache::Dispatch::PUREPERL == 0) { require Apache::ModuleConfig; require DynaLoader; @Apache::Dispatch::ISA = qw(DynaLoader); - __PACKAGE__->bootstrap($VERSION); + __PACKAGE__->bootstrap($VERSION); } -sub directives { - return wantarray ? @directives : \@directives; -} - -# set debug level -# 0 - messages at info or debug log levels -# 1 - verbose output at info or debug log levels -# 2 - really verbose output at info or debug log levels -# this is rapidly becoming deprecated -$Apache::Dispatch::DEBUG = 0; - sub handler { #--------------------------------------------------------------------- @@ -60,38 +48,25 @@ || $r->dir_config('Filter') || 0; - my $debug = - defined $dcfg->{_debug} - ? $dcfg->{_debug} - : $Apache::Dispatch::DEBUG; - - my $autoload = $dcfg->{_autoload}; - - my $stat = $dcfg->{_stat}; - - my $prefix = $dcfg->{_prefix}; - - my $uppercase = $dcfg->{_uppercase}; - + my $debug = $dcfg->{_debug}; + my $autoload = $dcfg->{_autoload}; + my $stat = $dcfg->{_stat}; + my $prefix = $dcfg->{_prefix}; + my $uppercase = $dcfg->{_uppercase}; my $new_location = $dcfg->{_newloc}; + my $require = $dcfg->{_require}; + my @parents = $dcfg->{_isa} ? @{$dcfg->{_isa}} : (); + my @extras = $dcfg->{_extras} ? @{$dcfg->{_extras}} : (); + my $log = $r->server->log; + my $uri = $r->uri; - my $require = $dcfg->{_require}; - - my @parents = $dcfg->{_isa} ? @{$dcfg->{_isa}} : (); - - my @extras = $dcfg->{_extras} ? @{$dcfg->{_extras}} : (); - - my $log = $r->server->log; - - my $uri = $r->uri; - my ($prehandler, $posthandler, $errorhandler, $rc); #--------------------------------------------------------------------- # do some preliminary stuff... #--------------------------------------------------------------------- - $log->info("Using Apache::Dispatch") if $debug > 0; + $log->info("Using Apache::Dispatch") if $debug; # redefine $r as necessary for Apache::Filter 1.013 and above if ($filter) { @@ -102,19 +77,19 @@ # that other filters in the chain recognize us... $r->dir_config->set(Filter => 'On'); - $r = $r->filter_register; $log = $r->server->log; } $log->info("\tchecking $uri for possible dispatch...") - if $debug; + if $debug > 1; # if the uri contains any characters we don't like, bounce... # is this necessary? - if ($uri =~ m![^\w/-]!) { - $log->info("\t$uri has bogus characters...") - if $debug; - $log->info("Exiting Apache::Dispatch"); + if (__PACKAGE__->bogus_uri($uri)) { + if ($debug) { + $log->info("\t$uri has bogus characters..."); + $log->info("Exiting Apache::Dispatch"); + } return DECLINED; } @@ -149,7 +124,7 @@ #--------------------------------------------------------------------- my ($class, $method) = - _translate_uri($r, $prefix, $new_location, $log, $debug); + __PACKAGE__->_translate_uri($r, $prefix, $new_location, $log, $debug); unless ($class && $method) { $log->info("\tclass and method could not be discovered") @@ -171,7 +146,7 @@ #--------------------------------------------------------------------- if (@parents) { - $rc = _set_ISA($class, $log, $debug, @parents); + $rc = __PACKAGE__->_set_ISA($class, $log, $debug, @parents); unless ($rc) { $log->error("\tDispatchISA did not return successfully!"); @@ -206,7 +181,7 @@ #--------------------------------------------------------------------- if ($stat eq "ON") { - $rc = _stat($class, $log, $debug); + $rc = __PACKGE__->_stat($class, $log, $debug); unless ($rc) { $log->error("\tDispatchStat did not return successfully!"); @@ -215,7 +190,7 @@ } } elsif ($stat eq "ISA") { - $rc = _recurse_stat($class, $log, $debug); + $rc = __PACKAGE__->_recurse_stat($class, $log, $debug); unless ($rc) { $log->error("\tDispatchStat did not return successfully!"); @@ -229,7 +204,7 @@ # if not, decline the request #--------------------------------------------------------------------- - my $handler = _check_dispatch($object, $method, $autoload, $log, $debug); + my $handler = __PACKAGE__->_check_dispatch($object, $method, $autoload, $log, $debug); if ($handler) { $log->info("\t$uri was translated into $class->$method") @@ -248,16 +223,16 @@ foreach my $extra (@extras) { if ($extra eq "PRE") { $prehandler = - _check_dispatch($object, "pre_dispatch", $autoload, $log, $debug); + __PACKAGE__->_check_dispatch($object, "pre_dispatch", $autoload, $log, $debug); } elsif ($extra eq "POST") { $posthandler = - _check_dispatch($object, "post_dispatch", $autoload, $log, + __PACKAGE__->_check_dispatch($object, "post_dispatch", $autoload, $log, $debug); } elsif ($extra eq "ERROR") { $errorhandler = - _check_dispatch($object, "error_dispatch", $autoload, $log, + __PACKAGE__->_check_dispatch($object, "error_dispatch", $autoload, $log, $debug); } } @@ -298,210 +273,6 @@ # the below methods are not part of the external API #********************************************************************* -sub _translate_uri { - - #--------------------------------------------------------------------- - # take the uri and return a class and method - # this method is for internal use only - #--------------------------------------------------------------------- - - my ($r, $prefix, $newloc, $log, $debug) = @_; - - my $uri = $r->uri; - - my $location; - - # change all the / to :: - (my $class_and_method = $r->uri) =~ s!/!::!g; - - if ($newloc) { - $log->info("\tmodifying location from ", $r->location, " to $newloc") - if $debug > 1; - ($location = $newloc) =~ s!/!::!g; - } - else { - ($location = $r->location) =~ s!/!::!g; - } - - # strip off the leading and trailing :: if any - $class_and_method =~ s/^::|::$//g; - $location =~ s/^::|::$//g; - - # substitute the prefix for the location - # <Location /> is a special case that we can deal with - # (but not advertise :) - my $times; - - if ($location) { - $times = $class_and_method =~ s/^\Q$location/$prefix/e; - } - else { - - # <Location /> - $prefix .= "::"; - $times = $class_and_method =~ s/^/$prefix/e; - } - - unless ($times) { - $log->info("\tLocation substitution failed - uri not translated") - if $debug > 1; - - return (undef, undef); - } - - my ($class, $method); - - if ($prefix eq $class_and_method) { - $method = "dispatch_index"; - $class = $prefix; - } - else { - ($class, $method) = $class_and_method =~ m/(.*)::(.*)/; - $method = "dispatch_$method"; - } - - return ($class, $method); -} - -sub _check_dispatch { - - #--------------------------------------------------------------------- - # see if class->method() is a valid call - # this method is for internal use only - #--------------------------------------------------------------------- - - my ($object, $method, $autoload, $log, $debug) = @_; - - my $class = ref($object); - - my $coderef; - - $log->info("\tchecking the validity of $class->$method...") - if $debug > 1; - - if ($autoload) { - $coderef = $object->can($method) || $object->can("AUTOLOAD"); - } - else { - $coderef = $object->can($method); - } - - if ($coderef && $debug > 1) { - $log->info("\t$class->$method is a valid method call"); - } - elsif ($debug > 1) { - $log->info("\t$class->$method is not a valid method call"); - } - - return $coderef; -} - -sub _stat { - - #--------------------------------------------------------------------- - # stat and reload the module if it has changed... - # this method is for internal use only - #--------------------------------------------------------------------- - # Use Apache::Reload here?? - my ($class, $log, $debug) = @_; - - (my $module = $class) =~ s!::!/!g; - - $module .= ".pm"; - - $stat{$module} = $^T unless $stat{$module}; - - if ($INC{$module}) { - $log->info("\tchecking $module for reload in pid $$...") - if $debug > 1; - - my $mtime = (stat $INC{$module})[9]; - - unless (defined $mtime && $mtime) { - $log->warn("Apache::Dispatch cannot find $module!"); - return 1; - } - - if ($mtime > $stat{$module}) { - - # turn off warnings for this bit... - local $^W; - - delete $INC{$module}; - eval { require $module }; - - if ($@) { - $log->error("Apache::Dispatch: $module failed reload! $@"); - return undef; - } - elsif ($debug) { - $log->info("\t$module reloaded"); - } - $stat{$module} = $mtime; - } - else { - $log->info("\t$module not modified") - if $debug > 1; - } - } - else { - $log->warn("Apache::Dispatch: $module not in \%INC!"); - } - - return 1; -} - -sub _recurse_stat { - - #--------------------------------------------------------------------- - # recurse through all the parent classes of the current class - # and call _stat on each - # this method is for internal use only - #--------------------------------------------------------------------- - - my ($class, $log) = @_; - - my $rc = _stat($class, $log); - - return undef unless $rc; - - # turn off strict here so we can get at the class @ISA - no strict 'refs'; - - foreach my $package (@{"${class}::ISA"}) { - $rc = _recurse_stat($package, $log); - last unless $rc; - } - - return $rc; -} - -sub _set_ISA { - - #--------------------------------------------------------------------- - # set the ISA array for the class - # this method is for internal use only - #--------------------------------------------------------------------- - - my ($class, $log, $debug, @parents) = @_; - - # turn off strict here so we can get at the class @ISA - no strict 'refs'; - - if ($debug > 1) { - $log->info("\t\@ISA for $class currently contains ", - (join ", ", @{"${class}::ISA"})); - $log->info("\tabout to merge ", (join ", ", @parents)); - } - - # only add classes to @ISA if they are not there already - my %seen; - - @{"${class}::ISA"} = grep !$seen{$_}++, (@{"${class}::ISA"}, @parents); - - return 1; -} - #--------------------------------------------------------------------- # Pure Perl configuration methods #--------------------------------------------------------------------- @@ -521,111 +292,6 @@ return $cfg; } -#--------------------------------------------------------------------- -# Apache configuration methods -#--------------------------------------------------------------------- - -sub _new { - return bless {}, shift; -} - -sub DIR_CREATE { - my $class = shift; - my $self = $class->_new; - - $self->{_stat} = "Off"; # no reloading by default - $self->{_autoload} = 0; # no autloading by default - $self->{_require} = 0; # no require()ing by default - - # warn "inside DIR_CREATE"; - return $self; -} - -sub DIR_MERGE { - my ($parent, $current) = @_; - my %new = (%$parent, %$current); - - # warn "inside DIR_MERGE"; - return bless \%new, ref($parent); -} - -sub DispatchLocation ($$$) { - my ($cfg, $parms, $arg) = @_; - - $cfg->{_newloc} = $arg; -} - -sub DispatchPrefix ($$$) { - my ($cfg, $parms, $arg) = @_; - - $cfg->{_prefix} = $arg; -} - -sub DispatchExtras ($$@) { - my ($cfg, $parms, $arg) = @_; - - if ($arg =~ m/^(Pre|Post|Error)$/i) { - push @{$cfg->{_extras}}, uc($arg) - unless grep /$arg/i, @{$cfg->{_extras}}; - } - else { - die "Invalid DispatchExtra $arg!"; - } -} - -sub DispatchISA ($$@) { - my ($cfg, $parms, $arg) = @_; - - push @{$cfg->{_isa}}, $arg - unless grep /$arg/, @{$cfg->{_isa}}; -} - -sub DispatchStat ($$$) { - my ($cfg, $parms, $arg) = @_; - - if ($arg =~ m/^(On|Off|ISA)$/i) { - $cfg->{_stat} = uc($arg); - } - else { - die "Invalid DispatchStat $arg!"; - } -} - -sub DispatchRequire ($$$) { - my ($cfg, $parms, $arg) = @_; - - $cfg->{_require} = $arg; -} - -sub DispatchFilter ($$$) { - my ($cfg, $parms, $arg) = @_; - - $cfg->{_filter} = $arg; -} - -sub DispatchAUTOLOAD ($$$) { - my ($cfg, $parms, $arg) = @_; - - $cfg->{_autoload} = $arg; -} - -sub DispatchDebug ($$$) { - my ($cfg, $parms, $arg) = @_; - - if ($arg =~ m/[0-9]/) { - $cfg->{_debug} = $arg; - } - else { - die "Invalid DispatchDebug $arg!"; - } -} - -sub DispatchUpperCase ($$$) { - my ($cfg, $parms, $arg) = @_; - - $cfg->{_uppercase} = $arg; -} - 1; __END__ @@ -794,13 +460,10 @@ Off - do not use Apache::Filter (Default) - DispatchDebug - Apache::Dispatch uses $r->server->log->info() for debugging. - Verbose debugging is enabled by setting DispatchDebug to 1. - Very verbose debugging is enabled at 2. $Apache::Dispatch::DEBUG - remains for backward compatibility, but is soon to be deprecated. - To turn off all debug information set your Apache LogLevel - directive above info level. + 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. =head1 SPECIAL CODING GUIDELINES Modified: trunk/lib/Apache2/Dispatch.pm =================================================================== --- trunk/lib/Apache2/Dispatch.pm 2006-04-23 03:40:39 UTC (rev 28) +++ trunk/lib/Apache2/Dispatch.pm 2006-04-23 06:01:28 UTC (rev 29) @@ -2,35 +2,28 @@ #--------------------------------------------------------------------- # -# usage: PerlHandler Apache::Dispatch +# usage: PerlHandler Apache2::Dispatch # #--------------------------------------------------------------------- use strict; use warnings; -$Apache2::Dispatch::VERSION = '0.15'; +$Apache2::Dispatch::VERSION = '0.10'; use mod_perl2 1.99023; use Apache2::Const -compile => qw(OK DECLINED SERVER_ERROR); -use Apache2::Log (); -use Apache2::Module (); -use Apache2::RequestRec (); -use Apache2::RequestUtil (); -use Apache::Dispatch::Util (); +use Apache2::Log (); +use Apache2::Module (); +use Apache2::RequestRec (); +use Apache2::RequestUtil (); +use Apache::Dispatch::Util; +push @Apache2::Dispatch::ISA, qw(Apache::Dispatch::Util); -# Read server config and use this if appropriate -use Data::Dumper; - # Initialize the directives -my $directives = Apache::Dispatch::Util->directives(); +my $directives = __PACKAGE__->directives(); Apache2::Module::add(__PACKAGE__, $directives); -# create global hash to hold the modification times of the modules -my %stat = (); - -$Apache::Dispatch::PUREPERL ||= 0; - sub handler { #--------------------------------------------------------------------- @@ -40,39 +33,25 @@ # Is there an advantage to keeping the pureperl option? my $dcfg; - if ($Apache::Dispatch::PUREPERL == 0) { - $dcfg = - Apache2::Module::get_config(__PACKAGE__, $r->server, - $r->per_dir_config); - } - else { - $dcfg = get_pureperl_config($r); - } + $dcfg = + Apache2::Module::get_config(__PACKAGE__, $r->server, $r->per_dir_config); my $filter = $dcfg->{_filter} || $r->dir_config('Filter') || 0; - my $autoload = $dcfg->{_autoload}; - - my $stat = $dcfg->{_stat}; - - my $prefix = $dcfg->{_prefix}; - - my $uppercase = $dcfg->{_uppercase} || 0; - + my $debug = $dcfg->{_debug} || 0; + my $autoload = $dcfg->{_autoload}; + my $stat = $dcfg->{_stat}; + my $prefix = $dcfg->{_prefix}; + my $uppercase = $dcfg->{_uppercase} || 0; my $new_location = $dcfg->{_newloc}; + my $require = $dcfg->{_require}; + my @parents = $dcfg->{_isa} ? @{$dcfg->{_isa}} : (); + my @extras = $dcfg->{_extras} ? @{$dcfg->{_extras}} : (); + my $log = $r->server->log; + my $uri = $r->uri; - my $require = $dcfg->{_require}; - - my @parents = $dcfg->{_isa} ? @{$dcfg->{_isa}} : (); - - my @extras = $dcfg->{_extras} ? @{$dcfg->{_extras}} : (); - - my $log = $r->server->log; - - my $uri = $r->uri; - my ($prehandler, $posthandler, $errorhandler, $rc); #--------------------------------------------------------------------- @@ -81,7 +60,6 @@ $log->debug("Using Apache2::Dispatch"); - # redefine $r as necessary for Apache::Filter 1.013 and above if ($filter) { $log->debug("\tregistering handler with Apache::Filter"); @@ -95,46 +73,54 @@ $log = $r->server->log; } - $log->debug("\tchecking $uri for possible dispatch..."); + $log->debug("\tchecking $uri for possible dispatch...") + if $debug > 1; # if the uri contains any characters we don't like, bounce... - if ($uri =~ m![^\w/-]!) { - $log->debug("\t$uri has bogus characters..."); - $log->info("Exiting Apache::Dispatch"); + if (__PACKAGE__->bogus_uri($uri)) { + if ($debug) { + + $log->info("\t$uri has bogus characters..."); + $log->info("Exiting Apache2::Dispatch"); + } return Apache2::Const::DECLINED; } + if ($debug > 1) { + $log->debug( + "\tapplying the following dispatch rules:", + "\n\t\tDispatchPrefix: ", + $prefix, + "\n\t\tDispatchUpperCase: ", + $uppercase, + "\n\t\tDispatchStat: ", + $stat, + "\n\t\tDispatchFilter: ", + $filter, + "\n\t\tDispatchDebug: ", + $debug, + "\n\t\tDispatchLocation: ", + $new_location ? $new_location : "Unaltered", + "\n\t\tDispatchAUTOLOAD: ", + $autoload, + "\n\t\tDispatchRequire: ", + $require, + "\n\t\tDispatchExtras: ", + (@extras ? (join ' ', @extras) : "None"), + "\n\t\tDispatchISA: ", + (@parents ? (join ' ', @parents) : "None"), + ); + } - $log->debug( - "\tapplying the following dispatch rules:", - "\n\t\tDispatchPrefix: ", - $prefix, - "\n\t\tDispatchUpperCase: ", - $uppercase, - "\n\t\tDispatchStat: ", - $stat, - "\n\t\tDispatchFilter: ", - $filter, - "\n\t\tDispatchLocation: ", - $new_location ? $new_location : "Unaltered", - "\n\t\tDispatchAUTOLOAD: ", - $autoload, - "\n\t\tDispatchRequire: ", - $require, - "\n\t\tDispatchExtras: ", - (@extras ? (join ' ', @extras) : "None"), - "\n\t\tDispatchISA: ", - (@parents ? (join ' ', @parents) : "None"), - ); - #--------------------------------------------------------------------- # create the new object #--------------------------------------------------------------------- - my ($class, $method) = _translate_uri($r, $prefix, $new_location, $log); + my ($class, $method) = + __PACKAGE__->_translate_uri($r, $prefix, $new_location, $log, $debug); unless ($class && $method) { $log->debug("\tclass and method could not be discovered"); - $log->debug("Exiting Apache::Dispatch"); + $log->debug("Exiting Apache2::Dispatch"); return Apache2::Const::DECLINED; } @@ -151,11 +137,11 @@ #--------------------------------------------------------------------- if (@parents) { - $rc = _set_ISA($class, $log, @parents); + $rc = __PACKAGE__->_set_ISA($class, $log, @parents); unless ($rc) { $log->error("\tDispatchISA did not return successfully!"); - $log->info("Exiting Apache::Dispatch"); + $log->info("Exiting Apache2::Dispatch"); return Apache2::Const::DECLINED; } } @@ -171,7 +157,7 @@ if ($@) { $log->warn("\tcould not require $class: $@"); - $log->info("Exiting Apache::Dispatch"); + $log->info("Exiting Apache2::Dispatch"); return Apache2::Const::DECLINED; } else { @@ -184,20 +170,20 @@ #--------------------------------------------------------------------- if ($stat eq "ON") { - $rc = _stat($class, $log); + $rc = __PACKAGE__->_stat($class, $log); unless ($rc) { $log->error("\tDispatchStat did not return successfully!"); - $log->info("Exiting Apache::Dispatch"); + $log->info("Exiting Apache2::Dispatch"); return Apache2::Const::DECLINED; } } elsif ($stat eq "ISA") { - $rc = _recurse_stat($class, $log); + $rc = __PACKAGE__->_recurse_stat($class, $log); unless ($rc) { $log->error("\tDispatchStat did not return successfully!"); - $log->info("Exiting Apache::Dispatch"); + $log->info("Exiting Apache2::Dispatch"); return Apache2::Const::DECLINED; } } @@ -207,14 +193,14 @@ # if not, decline the request #--------------------------------------------------------------------- - my $handler = _check_dispatch($object, $method, $autoload, $log); + my $handler = __PACKAGE__->_check_dispatch($object, $method, $autoload, $log, $debug); if ($handler) { $log->info("\t$uri was translated into $class->$method"); } else { $log->info("\t$uri did not result in a valid method"); - $log->info("Exiting Apache::Dispatch"); + $log->info("Exiting Apache2::Dispatch"); return Apache2::Const::DECLINED; } @@ -224,15 +210,15 @@ foreach my $extra (@extras) { if ($extra eq "PRE") { $prehandler = - _check_dispatch($object, "pre_dispatch", $autoload, $log); + __PACKAGE__->_check_dispatch($object, "pre_dispatch", $autoload, $log); } elsif ($extra eq "POST") { $posthandler = - _check_dispatch($object, "post_dispatch", $autoload, $log); + __PACKAGE__->_check_dispatch($object, "post_dispatch", $autoload, $log); } elsif ($extra eq "ERROR") { $errorhandler = - _check_dispatch($object, "error_dispatch", $autoload, $log); + __PACKAGE__->_check_dispatch($object, "error_dispatch", $autoload, $log); } } @@ -260,342 +246,26 @@ # wrap up... #--------------------------------------------------------------------- - $log->info("\tApache::Dispatch is returning $rc"); + $log->info("\tApache2::Dispatch is returning $rc"); - $log->info("Exiting Apache::Dispatch"); + $log->info("Exiting Apache2::Dispatch"); return $rc; } -#********************************************************************* -# the below methods are not part of the external API -#********************************************************************* - -sub _translate_uri { - - #--------------------------------------------------------------------- - # take the uri and return a class and method - # this method is for internal use only - #--------------------------------------------------------------------- - - my ($r, $prefix, $newloc, $log) = @_; - - my $uri = $r->uri; - - my $location; - - # change all the / to :: - (my $class_and_method = $r->uri) =~ s!/!::!g; - - if ($newloc) { - $log->info("\tmodifying location from ", $r->location, " to $newloc"); - ($location = $newloc) =~ s!/!::!g; - } - else { - ($location = $r->location) =~ s!/!::!g; - } - - # strip off the leading and trailing :: if any - $class_and_method =~ s/^::|::$//g; - $location =~ s/^::|::$//g; - - # substitute the prefix for the location - # <Location /> is a special case that we can deal with - # (but not advertise :) - my $times; - - if ($location) { - $r->log->debug( -"Location: $location, Prefix $prefix, Class_and_method $class_and_method"); - $times = $class_and_method =~ s/^\Q$location/$prefix/e; - } - else { - - # <Location /> - $prefix .= "::"; - $times = $class_and_method =~ s/^/$prefix/e; - } - - unless ($times) { - $log->info("\tLocation substitution failed - uri not translated"); - - return (undef, undef); - } - - my ($class, $method); - - if ($prefix eq $class_and_method) { - $method = "dispatch_index"; - $class = $prefix; - } - else { - ($class, $method) = $class_and_method =~ m/(.*)::(.*)/; - $method = "dispatch_$method"; - } - - return ($class, $method); -} - -sub _check_dispatch { - - #--------------------------------------------------------------------- - # see if class->method() is a valid call - # this method is for internal use only - #--------------------------------------------------------------------- - - my ($object, $method, $autoload, $log) = @_; - - my $class = ref($object); - - my $coderef; - - $log->info("\tchecking the validity of $class->$method..."); - - if ($autoload) { - $coderef = $object->can($method) || $object->can("AUTOLOAD"); - } - else { - $coderef = $object->can($method); - } - - if ($coderef) { - $log->debug("\t$class->$method is a valid method call"); - } - elsif (!$coderef) { - $log->warn("\t$class->$method is not a valid method call"); - } - - return $coderef; -} - -sub _stat { - - #--------------------------------------------------------------------- - # stat and reload the module if it has changed... - # this method is for internal use only - #--------------------------------------------------------------------- - # Use Apache::Reload here?? - my ($class, $log) = @_; - - (my $module = $class) =~ s!::!/!g; - - $module .= ".pm"; - - $stat{$module} = $^T unless $stat{$module}; - - if ($INC{$module}) { - $log->info("\tchecking $module for reload in pid $$..."); - - my $mtime = (stat $INC{$module})[9]; - - unless (defined $mtime && $mtime) { - $log->warn("Apache::Dispatch cannot find $module!"); - return 1; - } - - if ($mtime > $stat{$module}) { - - # turn off warnings for this bit... - local $^W; - - delete $INC{$module}; - eval { require $module }; - - if ($@) { - $log->error("Apache::Dispatch: $module failed reload! $@"); - return; - } - elsif (!$@) { - $log->debug("\t$module reloaded"); - } - $stat{$module} = $mtime; - } - else { - $log->info("\t$module not modified"); - } - } - else { - $log->warn("Apache::Dispatch: $module not in \%INC!"); - } - - return 1; -} - -sub _recurse_stat { - - #--------------------------------------------------------------------- - # recurse through all the parent classes of the current class - # and call _stat on each - # this method is for internal use only - #--------------------------------------------------------------------- - - my ($class, $log) = @_; - - my $rc = _stat($class, $log); - - return unless $rc; - - # turn off strict here so we can get at the class @ISA - no strict 'refs'; - - foreach my $package (@{"${class}::ISA"}) { - $rc = _recurse_stat($package, $log); - last unless $rc; - } - - return $rc; -} - -sub _set_ISA { - - #--------------------------------------------------------------------- - # set the ISA array for the class - # this method is for internal use only - #--------------------------------------------------------------------- - - my ($class, $log, @parents) = @_; - - # turn off strict here so we can get at the class @ISA - no strict 'refs'; - - $log->debug("\t\@ISA for $class currently contains ", - (join ", ", @{"${class}::ISA"})); - $log->debug("\tabout to merge ", (join ", ", @parents)); - - # only add classes to @ISA if they are not there already - my %seen; - - @{"${class}::ISA"} = grep !$seen{$_}++, (@{"${class}::ISA"}, @parents); - - return 1; -} - -#--------------------------------------------------------------------- -# Pure Perl configuration methods -#--------------------------------------------------------------------- - -sub get_pureperl_config { - my $r = shift; - my $cfg = {}; - no strict 'refs'; - foreach my $key ( - qw(DispatchPrefix DispatchExtras DispatchStat DispatchAUTOLOAD DispatchISA DispatchLocation DispatchRequire DispatchFilter DispatchUpperCase) - ) - { - my $arg = $r->dir_config($key); - next unless $arg; - &$key($cfg, undef, $arg); - } - return $cfg; -} - -#--------------------------------------------------------------------- -# Apache configuration methods -#--------------------------------------------------------------------- - -sub _new { - return bless {}, shift; -} - -sub DIR_CREATE { - my $class = shift; - my $self = $class->_new; - - $self->{_stat} = "Off"; # no reloading by default - $self->{_autoload} = 0; # no autloading by default - $self->{_require} = 0; # no require()ing by default - - # warn "inside DIR_CREATE"; - return $self; -} - -sub DIR_MERGE { - my ($parent, $current) = @_; - my %new = (%$parent, %$current); - - # warn "inside DIR_MERGE"; - return bless \%new, ref($parent); -} - -sub DispatchLocation { - my ($cfg, $parms, $arg) = @_; - - $cfg->{_newloc} = $arg; -} - -sub DispatchPrefix { - my ($cfg, $parms, $arg) = @_; - - $cfg->{_prefix} = $arg; -} - -sub DispatchExtras { - my ($cfg, $parms, $arg) = @_; - - if ($arg =~ m/^(Pre|Post|Error)$/i) { - push @{$cfg->{_extras}}, uc($arg) - unless grep /$arg/i, @{$cfg->{_extras}}; - } - else { - die "Invalid DispatchExtra $arg!"; - } -} - -sub DispatchISA { - my ($cfg, $parms, $arg) = @_; - - push @{$cfg->{_isa}}, $arg - unless grep /$arg/, @{$cfg->{_isa}}; -} - -sub DispatchStat { - my ($cfg, $parms, $arg) = @_; - - if ($arg =~ m/^(On|Off|ISA)$/i) { - $cfg->{_stat} = uc($arg); - } - else { - die "Invalid DispatchStat $arg!"; - } -} - -sub DispatchRequire { - my ($cfg, $parms, $arg) = @_; - - $cfg->{_require} = $arg; -} - -sub DispatchFilter { - my ($cfg, $parms, $arg) = @_; - - $cfg->{_filter} = $arg; -} - -sub DispatchAUTOLOAD { - my ($cfg, $parms, $arg) = @_; - - $cfg->{_autoload} = $arg; -} - -sub DispatchUpperCase { - my ($cfg, $parms, $arg) = @_; - - $cfg->{_uppercase} = $arg; -} - 1; __END__ =head1 NAME -Apache::Dispatch - call PerlHandlers with the ease of Registry scripts +Apache2::Dispatch - call PerlHandlers with the ease of Registry scripts =head1 SYNOPSIS httpd.conf: - PerlModule Apache::Dispatch + PerlModule Apache2::Dispatch PerlModule Bar DispatchExtras Pre Post Error @@ -605,7 +275,7 @@ <Location /Foo> SetHandler perl-script - PerlHandler Apache::Dispatch + PerlHandler Apache2::Dispatch DispatchPrefix Bar DispatchFilter Off @@ -613,7 +283,7 @@ =head1 DESCRIPTION -Apache::Dispatch translates $r->uri into a class and method and runs +Apache2::Dispatch translates $r->uri into a class and method and runs it as a PerlHandler. Basically, this allows you to call PerlHandlers as you would Regsitry scripts without having to load your httpd.conf with a slurry of <Location> tags. @@ -622,12 +292,12 @@ in httpd.conf - PerlModule Apache::Dispatch + PerlModule Apache2::Dispatch PerlModule Bar <Location /Foo> SetHandler perl-script - PerlHandler Apache::Dispatch + PerlHandler Apache2::Dispatch DispatchPrefix Bar </Location> @@ -654,10 +324,10 @@ uri. DispatchLocation - Using Apache::Dispatch from a <Directory> directive, either + Using Apache2::Dispatch from a <Directory> directive, either directly or from a .htaccess file, will _require_ the use of DispatchLocation, which defines the location from which - Apache::Dispatch will start class->method() translation. + Apache2::Dispatch will start class->method() translation. For example: httpd.conf @@ -668,7 +338,7 @@ .htaccess (in /usr/local/apache/htdocs/Foo) SetHandler perl-script - PerlHandler Apache::Dispatch + PerlHandler Apache2::Dispatch DispatchPrefix Baz DispatchLocation /Foo @@ -695,7 +365,7 @@ Foo->error_dispatch($r, $@) is called and return status of it is returned instead. Unlike the pre and post processing routines above, error_dispatch is not wrapped - in an eval, so if it dies, the Apache::Dispatch dies, + in an eval, so if it dies, the Apache2::Dispatch dies, and Apache will process the error using ErrorDocument, custom_response(), etc. With error_dispatch() disabled, the return status of the @@ -753,7 +423,7 @@ =head1 SPECIAL CODING GUIDELINES -Migrating to Apache::Dispatch is relatively painless - it requires +Migrating to Apache2::Dispatch is relatively painless - it requires only a few minor code changes. The good news is that once you adapt code to work with Dispatch, it can be used as a conventional mod_perl method handler, requiring only a few considerations. Below are a few @@ -761,10 +431,10 @@ In the interests of security, all handler methods must be prefixed with 'dispatch_', which is added to the uri behind the scenes. Unlike -ordinary mod_perl handlers, for Apache::Dispatch there is no default +ordinary mod_perl handlers, for Apache2::Dispatch there is no default method (with a tiny exception - see NOTES below). -Apache::Dispatch uses object oriented calls behind the scenes. This +Apache2::Dispatch uses object oriented calls behind the scenes. This means that you either need to account for your handler to be called as a method handler, such as @@ -779,7 +449,7 @@ my $r = Apache->request; } -If you want to use the handler unmodified outside of Apache::Dispatch, +If you want to use the handler unmodified outside of Apache2::Dispatch, you must do three things: prototype your handler: @@ -809,19 +479,19 @@ =head1 FILTERING -Apache::Dispatch provides for output filtering using Apache::Filter +Apache2::Dispatch provides for output filtering using Apache::Filter 1.013 and above. <Location /Foo> SetHandler perl-script - PerlHandler Apache::Dispatch Apache::Compress + PerlHandler Apache2::Dispatch Apache::Compress DispatchPrefix Bar DispatchFilter On </Location> Your handler need do nothing special to make its output the start of -the chain - Apache::Dispatch registers itself with Apache::Filter and +the chain - Apache2::Dispatch registers itself with Apache::Filter and hides the task from your handler. Thus, any dispatched handler is automatically Apache::Filter ready without the need for additional code. @@ -864,7 +534,7 @@ follow the normal dispatch rules. If the uri can be dispatched but contains anything other than -[a-zA-Z0-9_/-] Apache::Dispatch declines to handle the request. +[a-zA-Z0-9_/-] Apache2::Dispatch declines to handle the request. Like everything in perl, the package names are case sensitive. @@ -880,7 +550,7 @@ =head1 FEATURES/BUGS -If a module fails reload under DispatchStat, Apache::Dispatch declines +If a module fails reload under DispatchStat, Apache2::Dispatch declines the request. This might change to SERVER_ERROR in the future... =head1 SEE ALSO Added: trunk/t/lib/Apache/Bar.pm =================================================================== --- trunk/t/lib/Apache/Bar.pm (rev 0) +++ trunk/t/lib/Apache/Bar.pm 2006-04-23 06:01:28 UTC (rev 29) @@ -0,0 +1,35 @@ +package Foo::Bar; +use Apache::Constants qw( OK SERVER_ERROR ); +use strict; + +@Foo::Bar::ISA = qw(Foo); + +sub dispatch_baz { + my $r = Apache->request; + $r->send_http_header('text/plain'); + $r->print("Foo::Bar->dispatch_baz()"); + print STDERR "Foo->dispatch_baz()\n"; + return OK; +} + +1; + +__END__ + +here is a sample httpd.conf entry + + PerlModule Apache::Dispatch + PerlModule Foo + + <Location /Test> + SetHandler perl-script + PerlHandler Apache::Dispatch + DispatchPrefix Foo + DispatchExtras Pre Post Error + </Location> + +once you install it, you should be able to go to +http://localhost/Test/foo +or +http://localhost/Test/Bar/foo +etc, and get some results Added: trunk/t/lib/Apache/Foo.pm =================================================================== --- trunk/t/lib/Apache/Foo.pm (rev 0) +++ trunk/t/lib/Apache/Foo.pm 2006-04-23 06:01:28 UTC (rev 29) @@ -0,0 +1,64 @@ +package Apache::Foo; + +use Apache::Constants qw( OK SERVER_ERROR ); +use strict; + +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"; + return OK; +} + +sub dispatch_bar { + print STDERR "Foo->dispatch_bar()\n"; + return SERVER_ERROR; +} + +sub pre_dispatch { + print STDERR "Foo->pre_dispatch()\n"; +} + +sub post_dispatch { + print STDERR "Foo->post_dispatch()\n"; +} + +sub error_dispatch { + my $class = shift; + my $r = shift; + $r->send_http_header('text/plain'); + $r->print("Yikes! Foo->dispatch_error()"); + print STDERR "Yikes! Foo->dispatch_error()\n"; + return OK; +} + +sub dispatch_index { + my $class = shift; + my $r = shift; + $r->send_http_header('text/plain'); + $r->print("Foo->dispatch_index()"); + print STDERR "Foo->dispatch_index()\n"; + return OK; +} + +1; + +__END__ + +here is a sample httpd.conf entry + + PerlModule Apache::Dispatch + PerlModule Foo + + <Location /Test> + SetHandler perl-script + PerlHandler Apache::Dispatch + DispatchPrefix Foo + DispatchExtras Pre Post Error + </Location> + +once you install it, you should be able to go to +http://localhost/Test/foo +and get some results Property changes on: trunk/t/lib/Apache/Foo.pm ___________________________________________________________________ Name: svn:executable + * This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: Fred M. <fr...@re...> - 2006-04-23 04:14:48
|
On Sat, 22 Apr 2006, Fred Moyer wrote: > Any thoughts on why deprecating it is good? Ok I've looked into this more and looks like $Apache::Dispatch::DEBUG was slated for deprecation in favor of DispatchDebug. Which makes sense. |
|
From: Fred M. <fr...@re...> - 2006-04-23 03:58:38
|
There are notes in the code about deprecating DispatchDebug and I've moved towards that but the more I think about it, it's a useful feature to have around. When you're using it, you don't want to see debugging output because you're concentrating on your own app's logging, but there might be times when you want to turn it up. That's how DBI works, and Apache::DBI. Any thoughts on why deprecating it is good? |
|
From: <phr...@us...> - 2006-04-23 03:40:42
|
Revision: 28 Author: phred_moyer Date: 2006-04-22 20:40:39 -0700 (Sat, 22 Apr 2006) ViewCVS: http://svn.sourceforge.net/apache-dispatch/?rev=28&view=rev Log Message: ----------- Remove ridiculous debugging statement while attempting to determine if <Perl> sections caused an early load of modules - there is no PerlLoadModule for mp1. Modified Paths: -------------- trunk/t/conf/extra.last.conf.in Modified: trunk/t/conf/extra.last.conf.in =================================================================== --- trunk/t/conf/extra.last.conf.in 2006-04-23 03:12:26 UTC (rev 27) +++ trunk/t/conf/extra.last.conf.in 2006-04-23 03:40:39 UTC (rev 28) @@ -4,9 +4,7 @@ <IfDefine APACHE1> PerlModule Apache::Dispatch </IfDefine> -<Perl> - print STDERR "GOOOOZAAAAAAAQ!!!"; -</Perl> + <Location /plain> SetHandler perl-script DispatchRequire On This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <phr...@us...> - 2006-04-23 03:12:28
|
Revision: 27 Author: phred_moyer Date: 2006-04-22 20:12:26 -0700 (Sat, 22 Apr 2006) ViewCVS: http://svn.sourceforge.net/apache-dispatch/?rev=27&view=rev Log Message: ----------- Get rid of the autogenerated file now that I'm not stumbling around like an xs noob. Removed Paths: ------------- trunk/Dispatch.xs Deleted: trunk/Dispatch.xs =================================================================== --- trunk/Dispatch.xs 2006-04-23 03:10:10 UTC (rev 26) +++ trunk/Dispatch.xs 2006-04-23 03:12:26 UTC (rev 27) @@ -1,165 +0,0 @@ -#include "modules/perl/mod_perl.h" - -static mod_perl_perl_dir_config *newPerlConfig(pool *p) -{ - mod_perl_perl_dir_config *cld = - (mod_perl_perl_dir_config *) - palloc(p, sizeof (mod_perl_perl_dir_config)); - cld->obj = Nullsv; - cld->pclass = "main"; - register_cleanup(p, cld, perl_perl_cmd_cleanup, null_cleanup); - return cld; -} - -static void *create_dir_config_sv (pool *p, char *dirname) -{ - return newPerlConfig(p); -} - -static void *create_srv_config_sv (pool *p, server_rec *s) -{ - return newPerlConfig(p); -} - -static void stash_mod_pointer (char *class, void *ptr) -{ - SV *sv = newSV(0); - sv_setref_pv(sv, NULL, (void*)ptr); - hv_store(perl_get_hv("Apache::XS_ModuleConfig",TRUE), - class, strlen(class), sv, FALSE); -} - -static mod_perl_cmd_info cmd_info_DispatchPrefix = { -"main::DispatchPrefix", "", -}; -static mod_perl_cmd_info cmd_info_DispatchExtras = { -"main::DispatchExtras", "", -}; -static mod_perl_cmd_info cmd_info_DispatchStat = { -"main::DispatchStat", "", -}; -static mod_perl_cmd_info cmd_info_DispatchAUTOLOAD = { -"main::DispatchAUTOLOAD", "", -}; -static mod_perl_cmd_info cmd_info_DispatchDebug = { -"main::DispatchDebug", "", -}; -static mod_perl_cmd_info cmd_info_DispatchISA = { -"main::DispatchISA", "", -}; -static mod_perl_cmd_info cmd_info_DispatchLocation = { -"main::DispatchLocation", "", -}; -static mod_perl_cmd_info cmd_info_DispatchRequire = { -"main::DispatchRequire", "", -}; -static mod_perl_cmd_info cmd_info_DispatchFilter = { -"main::DispatchFilter", "", -}; -static mod_perl_cmd_info cmd_info_DispatchUpperCase = { -"main::DispatchUpperCase", "", -}; - - -static command_rec mod_cmds[] = { - - { "DispatchPrefix", perl_cmd_perl_TAKE1, - (void*)&cmd_info_DispatchPrefix, - OR_ALL, TAKE1, "a class to be used as the base class" }, - - { "DispatchExtras", perl_cmd_perl_ITERATE, - (void*)&cmd_info_DispatchExtras, - OR_ALL, ITERATE, "choose any of: Pre, Post, or Error" }, - - { "DispatchStat", perl_cmd_perl_TAKE1, - (void*)&cmd_info_DispatchStat, - OR_ALL, TAKE1, "choose one of On, Off, or ISA" }, - - { "DispatchAUTOLOAD", perl_cmd_perl_FLAG, - (void*)&cmd_info_DispatchAUTOLOAD, - OR_ALL, FLAG, "choose one of On or Off" }, - - { "DispatchDebug", perl_cmd_perl_TAKE1, - (void*)&cmd_info_DispatchDebug, - OR_ALL, TAKE1, "numeric verbosity level" }, - - { "DispatchISA", perl_cmd_perl_ITERATE, - (void*)&cmd_info_DispatchISA, - OR_ALL, ITERATE, "a list of parent modules" }, - - { "DispatchLocation", perl_cmd_perl_TAKE1, - (void*)&cmd_info_DispatchLocation, - OR_ALL, TAKE1, "a location to replace the current <Location>" }, - - { "DispatchRequire", perl_cmd_perl_FLAG, - (void*)&cmd_info_DispatchRequire, - OR_ALL, FLAG, "choose one of On or Off" }, - - { "DispatchFilter", perl_cmd_perl_FLAG, - (void*)&cmd_info_DispatchFilter, - OR_ALL, FLAG, "choose one of On or Off" }, - - { "DispatchUpperCase", perl_cmd_perl_FLAG, - (void*)&cmd_info_DispatchUpperCase, - OR_ALL, FLAG, "choose one of On or Off" }, - - { NULL } -}; - -module MODULE_VAR_EXPORT XS_main = { - STANDARD_MODULE_STUFF, - NULL, /* module initializer */ - create_dir_config_sv, /* per-directory config creator */ - NULL, /* dir config merger */ - create_srv_config_sv, /* server config creator */ - NULL, /* server config merger */ - mod_cmds, /* command table */ - NULL, /* [7] list of handlers */ - NULL, /* [2] filename-to-URI translation */ - NULL, /* [5] check/validate user_id */ - NULL, /* [6] check user_id is valid *here* */ - NULL, /* [4] check access by host address */ - NULL, /* [7] MIME type checker/setter */ - NULL, /* [8] fixups */ - NULL, /* [10] logger */ - NULL, /* [3] header parser */ - NULL, /* process initializer */ - NULL, /* process exit/cleanup */ - NULL, /* [1] post read_request handling */ -}; - -#define this_module "main.pm" - -static void remove_module_cleanup(void *data) -{ - if (find_linked_module("main")) { - /* need to remove the module so module index is reset */ - remove_module(&XS_main); - } - if (data) { - /* make sure BOOT section is re-run on restarts */ - (void)hv_delete(GvHV(incgv), this_module, - strlen(this_module), G_DISCARD); - if (dowarn) { - /* avoid subroutine redefined warnings */ - perl_clear_symtab(gv_stashpv("main", FALSE)); - } - } -} - -MODULE = main PACKAGE = main - -PROTOTYPES: DISABLE - -BOOT: - XS_main.name = "main"; - add_module(&XS_main); - stash_mod_pointer("main", &XS_main); - register_cleanup(perl_get_startup_pool(), (void *)1, - remove_module_cleanup, null_cleanup); - -void -END() - - CODE: - remove_module_cleanup(NULL); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <phr...@us...> - 2006-04-23 03:10:36
|
Revision: 26 Author: phred_moyer Date: 2006-04-22 20:10:10 -0700 (Sat, 22 Apr 2006) ViewCVS: http://svn.sourceforge.net/apache-dispatch/?rev=26&view=rev Log Message: ----------- Ok geoff you can stop cringing from my previous checkins, I understand how the xs voodoo works now. the makefile.pl wasn't in Apache::Dispatch namespace, it was in main namespace since the first line was shebang perl... Modified Paths: -------------- trunk/Makefile.PL trunk/lib/Apache/Dispatch.pm trunk/t/conf/extra.last.conf.in Modified: trunk/Makefile.PL =================================================================== --- trunk/Makefile.PL 2006-04-23 02:00:32 UTC (rev 25) +++ trunk/Makefile.PL 2006-04-23 03:10:10 UTC (rev 26) @@ -1,4 +1,4 @@ -#!perl +package Apache::Dispatch; require 5.005; @@ -38,7 +38,6 @@ } elsif ($mp_wanted != 2) { # mod_perl1 specific makefile - eval { require Apache::ExtUtils; require Apache::src; @@ -61,10 +60,18 @@ $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; + require ExtUtils::MakeMaker; ExtUtils::MakeMaker::WriteMakefile( NAME => 'Apache::Dispatch', Modified: trunk/lib/Apache/Dispatch.pm =================================================================== --- trunk/lib/Apache/Dispatch.pm 2006-04-23 02:00:32 UTC (rev 25) +++ trunk/lib/Apache/Dispatch.pm 2006-04-23 03:10:10 UTC (rev 26) @@ -11,111 +11,8 @@ use strict; use warnings; -my $VERSION = '0.10'; +our $VERSION = '0.10'; -my @directives = ( - - #------------------------------------------------------------------ - # DispatchPrefix defines the base class for a given <Location> - #------------------------------------------------------------------ - { - name => 'DispatchPrefix', - errmsg => 'a class to be used as the base class', - args_how => 'TAKE1', - req_override => 'OR_ALL', - }, - - #------------------------------------------------------------------ - # DispatchExtras defines the extra dispatch methods to enable - #------------------------------------------------------------------ - { - name => 'DispatchExtras', - errmsg => 'choose any of: Pre, Post, or Error', - args_how => 'ITERATE', - req_override => 'OR_ALL', - }, - - #------------------------------------------------------------------ - # DispatchStat enables module testing and subsequent reloading - #------------------------------------------------------------------ - { - name => 'DispatchStat', - errmsg => 'choose one of On, Off, or ISA', - args_how => 'TAKE1', - req_override => 'OR_ALL', - }, - - #------------------------------------------------------------------ - # DispatchAUTOLOAD defines AutoLoader behavior - #------------------------------------------------------------------ - { - name => 'DispatchAUTOLOAD', - errmsg => 'choose one of On or Off', - args_how => 'FLAG', - req_override => 'OR_ALL', - }, - - #------------------------------------------------------------------ - # DispatchDebug defines debugging verbosity - #------------------------------------------------------------------ - { - name => 'DispatchDebug', - errmsg => 'numeric verbosity level', - args_how => 'TAKE1', - req_override => 'OR_ALL', - }, - - #------------------------------------------------------------------ - # DispatchISA is a list of modules your module should inherit from - #------------------------------------------------------------------ - { - name => 'DispatchISA', - errmsg => 'a list of parent modules', - args_how => 'ITERATE', - req_override => 'OR_ALL', - }, - - #------------------------------------------------------------------ - # DispatchLocation allows you to redefine the <Location> - #------------------------------------------------------------------ - { - name => 'DispatchLocation', - errmsg => 'a location to replace the current <Location>', - args_how => 'TAKE1', - req_override => 'OR_ALL', - }, - - #------------------------------------------------------------------ - # DispatchRequire require()s the class - #------------------------------------------------------------------ - { - name => 'DispatchRequire', - errmsg => 'choose one of On or Off', - args_how => 'FLAG', - req_override => 'OR_ALL', - }, - - #------------------------------------------------------------------ - # DispatchFilter makes the dispatched handler Apache::Filter aware - #------------------------------------------------------------------ - { - name => 'DispatchFilter', - errmsg => 'choose one of On or Off', - args_how => 'FLAG', - req_override => 'OR_ALL', - }, - - #------------------------------------------------------------------ - # DispatchUppercase converts the first char of a class to uppercase - #------------------------------------------------------------------ - { - name => 'DispatchUpperCase', - errmsg => 'choose one of On or Off', - args_how => 'FLAG', - req_override => 'OR_ALL', - }, -); - use mod_perl 1.2401; use Apache::Constants qw(OK DECLINED SERVER_ERROR); use Apache::Log; @@ -129,7 +26,7 @@ require Apache::ModuleConfig; require DynaLoader; @Apache::Dispatch::ISA = qw(DynaLoader); - __PACKAGE__->bootstrap($VERSION); + __PACKAGE__->bootstrap($VERSION); } sub directives { Modified: trunk/t/conf/extra.last.conf.in =================================================================== --- trunk/t/conf/extra.last.conf.in 2006-04-23 02:00:32 UTC (rev 25) +++ trunk/t/conf/extra.last.conf.in 2006-04-23 03:10:10 UTC (rev 26) @@ -2,9 +2,11 @@ PerlLoadModule Apache2::Dispatch </IfDefine> <IfDefine APACHE1> - PerlLoadModule Apache::Dispatch + PerlModule Apache::Dispatch </IfDefine> - +<Perl> + print STDERR "GOOOOZAAAAAAAQ!!!"; +</Perl> <Location /plain> SetHandler perl-script DispatchRequire On This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <phr...@us...> - 2006-04-23 02:00:35
|
Revision: 25 Author: phred_moyer Date: 2006-04-22 19:00:32 -0700 (Sat, 22 Apr 2006) ViewCVS: http://svn.sourceforge.net/apache-dispatch/?rev=25&view=rev Log Message: ----------- Build the command table using XS instead of command utils Modified Paths: -------------- trunk/Makefile.PL Modified: trunk/Makefile.PL =================================================================== --- trunk/Makefile.PL 2006-04-22 22:44:42 UTC (rev 24) +++ trunk/Makefile.PL 2006-04-23 02:00:32 UTC (rev 25) @@ -59,15 +59,8 @@ print "\nBuilding with Custom Apache Directives ('DispatchPrefix'). You will need a C compiler and Apache/mod_perl sources.\n\n"; - import Apache::ExtUtils qw(command_table); - - require Apache::Dispatch; - my $directives = Apache::Dispatch->directives; - command_table($directives); - $makefile_params{'PL_FILES'} = {'set_pureperl.PL' => '0'}; $makefile_params{'PREREQ_PM'} = {mod_perl => 1.2401,}; - $makefile_params{'clean'} = {FILES => '*.xs*'}; } my $inc = Apache::src->new->inc; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: Fred M. <fr...@re...> - 2006-04-22 23:02:32
|
On Sat, 22 Apr 2006, Geoffrey Young wrote: >>> no it wasn't me. if you could post a copy I'll look at it - it might be >>> autogenerated, but if memory serves the autogenerated stuff is like >>> PACKAGE.xs not main.xs. >> >> I was just able to get it to compile once but I still belong in the xs >> beginner's area... I've committed it as Dispatch.xs. > > I don't think that's wise - I'm pretty sure Dispatch.xs is autogenerated by > the mp1 tools during make, so these will collide later on. but I don't have > a mp1 build at the moment to verify with... I should probably get my dev box > back up :) Yep you're right - I'm starting to see this as I hack away here on it. >> I've been wanting >> to hack xs for a while, and I guess this is a good point to start. > > chapter 7 in the mpdc goes into this in quite a bit of detail. at the time, > I was all hot on the custom directive API, so I spent lots of time trying to > explain it well since the actual documentation was sparse... ok I've got my copy here a few feet away - I'll read up on this. you're right, the docs on xs is voodoo, but I've always had aspirations of being a witch doctor... :) |
|
From: Geoffrey Y. <ge...@mo...> - 2006-04-22 22:54:25
|
Fred Moyer wrote: > Geoffrey Young wrote: > >> Fred Moyer wrote: >> >>> did you write main.xs or did domm write that? I'm trying to grok it and >>> it looks like an xs implementation of the Dispatch Directives. It's not >>> in svn, but it was in domm's svn dump I think. >> >> >> no it wasn't me. if you could post a copy I'll look at it - it might be >> autogenerated, but if memory serves the autogenerated stuff is like >> PACKAGE.xs not main.xs. > > > I was just able to get it to compile once but I still belong in the xs > beginner's area... I've committed it as Dispatch.xs. I don't think that's wise - I'm pretty sure Dispatch.xs is autogenerated by the mp1 tools during make, so these will collide later on. but I don't have a mp1 build at the moment to verify with... I should probably get my dev box back up :) > I've been wanting > to hack xs for a while, and I guess this is a good point to start. chapter 7 in the mpdc goes into this in quite a bit of detail. at the time, I was all hot on the custom directive API, so I spent lots of time trying to explain it well since the actual documentation was sparse... > >> it's a shame domm isn't on the list... > > > from his journal posts it sounds like he's been getting some good > weather in vienna and is taking advantage of it. I've been able to grok > most of what he did, and I think that in a couple weeks this thing may > be ready to release into the open. :) --Geoff |
|
From: <phr...@us...> - 2006-04-22 22:44:46
|
Revision: 24 Author: phred_moyer Date: 2006-04-22 15:44:42 -0700 (Sat, 22 Apr 2006) ViewCVS: http://svn.sourceforge.net/apache-dispatch/?rev=24&view=rev Log Message: ----------- - commit some of the recent changes while getting this to play nicely with xs Modified Paths: -------------- trunk/lib/Apache/Dispatch.pm Modified: trunk/lib/Apache/Dispatch.pm =================================================================== --- trunk/lib/Apache/Dispatch.pm 2006-04-22 22:37:52 UTC (rev 23) +++ trunk/lib/Apache/Dispatch.pm 2006-04-22 22:44:42 UTC (rev 24) @@ -11,6 +11,8 @@ use strict; use warnings; +my $VERSION = '0.10'; + my @directives = ( #------------------------------------------------------------------ @@ -118,7 +120,7 @@ use Apache::Constants qw(OK DECLINED SERVER_ERROR); use Apache::Log; -$Apache::Dispatch::PUREPERL = 'PUREPERL'; # set during perl Makefile.PL +$Apache::Dispatch::PUREPERL=0; # set during perl Makefile.PL # create global hash to hold the modification times of the modules my %stat = (); @@ -127,7 +129,7 @@ require Apache::ModuleConfig; require DynaLoader; @Apache::Dispatch::ISA = qw(DynaLoader); - Apache::Dispatch->bootstrap($Apache::Dispatch::VERSION); + __PACKAGE__->bootstrap($VERSION); } sub directives { This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: Fred M. <fr...@ta...> - 2006-04-22 22:41:49
|
Geoffrey Young wrote: > Fred Moyer wrote: >>did you write main.xs or did domm write that? I'm trying to grok it and >>it looks like an xs implementation of the Dispatch Directives. It's not >>in svn, but it was in domm's svn dump I think. > > no it wasn't me. if you could post a copy I'll look at it - it might be > autogenerated, but if memory serves the autogenerated stuff is like > PACKAGE.xs not main.xs. I was just able to get it to compile once but I still belong in the xs beginner's area... I've committed it as Dispatch.xs. I've been wanting to hack xs for a while, and I guess this is a good point to start. > it's a shame domm isn't on the list... from his journal posts it sounds like he's been getting some good weather in vienna and is taking advantage of it. I've been able to grok most of what he did, and I think that in a couple weeks this thing may be ready to release into the open. > > --Geoff |
|
From: <phr...@us...> - 2006-04-22 22:37:59
|
Revision: 23 Author: phred_moyer Date: 2006-04-22 15:37:52 -0700 (Sat, 22 Apr 2006) ViewCVS: http://svn.sourceforge.net/apache-dispatch/?rev=23&view=rev Log Message: ----------- Adding the xs module formerly known as main.xs. Still getting my xs foo up to speed :) Have been able to get it compiled once but not sure how I did that... Added Paths: ----------- trunk/Dispatch.xs Added: trunk/Dispatch.xs =================================================================== --- trunk/Dispatch.xs (rev 0) +++ trunk/Dispatch.xs 2006-04-22 22:37:52 UTC (rev 23) @@ -0,0 +1,165 @@ +#include "modules/perl/mod_perl.h" + +static mod_perl_perl_dir_config *newPerlConfig(pool *p) +{ + mod_perl_perl_dir_config *cld = + (mod_perl_perl_dir_config *) + palloc(p, sizeof (mod_perl_perl_dir_config)); + cld->obj = Nullsv; + cld->pclass = "main"; + register_cleanup(p, cld, perl_perl_cmd_cleanup, null_cleanup); + return cld; +} + +static void *create_dir_config_sv (pool *p, char *dirname) +{ + return newPerlConfig(p); +} + +static void *create_srv_config_sv (pool *p, server_rec *s) +{ + return newPerlConfig(p); +} + +static void stash_mod_pointer (char *class, void *ptr) +{ + SV *sv = newSV(0); + sv_setref_pv(sv, NULL, (void*)ptr); + hv_store(perl_get_hv("Apache::XS_ModuleConfig",TRUE), + class, strlen(class), sv, FALSE); +} + +static mod_perl_cmd_info cmd_info_DispatchPrefix = { +"main::DispatchPrefix", "", +}; +static mod_perl_cmd_info cmd_info_DispatchExtras = { +"main::DispatchExtras", "", +}; +static mod_perl_cmd_info cmd_info_DispatchStat = { +"main::DispatchStat", "", +}; +static mod_perl_cmd_info cmd_info_DispatchAUTOLOAD = { +"main::DispatchAUTOLOAD", "", +}; +static mod_perl_cmd_info cmd_info_DispatchDebug = { +"main::DispatchDebug", "", +}; +static mod_perl_cmd_info cmd_info_DispatchISA = { +"main::DispatchISA", "", +}; +static mod_perl_cmd_info cmd_info_DispatchLocation = { +"main::DispatchLocation", "", +}; +static mod_perl_cmd_info cmd_info_DispatchRequire = { +"main::DispatchRequire", "", +}; +static mod_perl_cmd_info cmd_info_DispatchFilter = { +"main::DispatchFilter", "", +}; +static mod_perl_cmd_info cmd_info_DispatchUpperCase = { +"main::DispatchUpperCase", "", +}; + + +static command_rec mod_cmds[] = { + + { "DispatchPrefix", perl_cmd_perl_TAKE1, + (void*)&cmd_info_DispatchPrefix, + OR_ALL, TAKE1, "a class to be used as the base class" }, + + { "DispatchExtras", perl_cmd_perl_ITERATE, + (void*)&cmd_info_DispatchExtras, + OR_ALL, ITERATE, "choose any of: Pre, Post, or Error" }, + + { "DispatchStat", perl_cmd_perl_TAKE1, + (void*)&cmd_info_DispatchStat, + OR_ALL, TAKE1, "choose one of On, Off, or ISA" }, + + { "DispatchAUTOLOAD", perl_cmd_perl_FLAG, + (void*)&cmd_info_DispatchAUTOLOAD, + OR_ALL, FLAG, "choose one of On or Off" }, + + { "DispatchDebug", perl_cmd_perl_TAKE1, + (void*)&cmd_info_DispatchDebug, + OR_ALL, TAKE1, "numeric verbosity level" }, + + { "DispatchISA", perl_cmd_perl_ITERATE, + (void*)&cmd_info_DispatchISA, + OR_ALL, ITERATE, "a list of parent modules" }, + + { "DispatchLocation", perl_cmd_perl_TAKE1, + (void*)&cmd_info_DispatchLocation, + OR_ALL, TAKE1, "a location to replace the current <Location>" }, + + { "DispatchRequire", perl_cmd_perl_FLAG, + (void*)&cmd_info_DispatchRequire, + OR_ALL, FLAG, "choose one of On or Off" }, + + { "DispatchFilter", perl_cmd_perl_FLAG, + (void*)&cmd_info_DispatchFilter, + OR_ALL, FLAG, "choose one of On or Off" }, + + { "DispatchUpperCase", perl_cmd_perl_FLAG, + (void*)&cmd_info_DispatchUpperCase, + OR_ALL, FLAG, "choose one of On or Off" }, + + { NULL } +}; + +module MODULE_VAR_EXPORT XS_main = { + STANDARD_MODULE_STUFF, + NULL, /* module initializer */ + create_dir_config_sv, /* per-directory config creator */ + NULL, /* dir config merger */ + create_srv_config_sv, /* server config creator */ + NULL, /* server config merger */ + mod_cmds, /* command table */ + NULL, /* [7] list of handlers */ + NULL, /* [2] filename-to-URI translation */ + NULL, /* [5] check/validate user_id */ + NULL, /* [6] check user_id is valid *here* */ + NULL, /* [4] check access by host address */ + NULL, /* [7] MIME type checker/setter */ + NULL, /* [8] fixups */ + NULL, /* [10] logger */ + NULL, /* [3] header parser */ + NULL, /* process initializer */ + NULL, /* process exit/cleanup */ + NULL, /* [1] post read_request handling */ +}; + +#define this_module "main.pm" + +static void remove_module_cleanup(void *data) +{ + if (find_linked_module("main")) { + /* need to remove the module so module index is reset */ + remove_module(&XS_main); + } + if (data) { + /* make sure BOOT section is re-run on restarts */ + (void)hv_delete(GvHV(incgv), this_module, + strlen(this_module), G_DISCARD); + if (dowarn) { + /* avoid subroutine redefined warnings */ + perl_clear_symtab(gv_stashpv("main", FALSE)); + } + } +} + +MODULE = main PACKAGE = main + +PROTOTYPES: DISABLE + +BOOT: + XS_main.name = "main"; + add_module(&XS_main); + stash_mod_pointer("main", &XS_main); + register_cleanup(perl_get_startup_pool(), (void *)1, + remove_module_cleanup, null_cleanup); + +void +END() + + CODE: + remove_module_cleanup(NULL); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: Geoffrey Y. <ge...@mo...> - 2006-04-22 22:32:59
|
Fred Moyer wrote: > hey geoff, > > did you write main.xs or did domm write that? I'm trying to grok it and > it looks like an xs implementation of the Dispatch Directives. It's not > in svn, but it was in domm's svn dump I think. no it wasn't me. if you could post a copy I'll look at it - it might be autogenerated, but if memory serves the autogenerated stuff is like PACKAGE.xs not main.xs. it's a shame domm isn't on the list... --Geoff |
|
From: Fred M. <fr...@ta...> - 2006-04-22 22:03:24
|
hey geoff, did you write main.xs or did domm write that? I'm trying to grok it and it looks like an xs implementation of the Dispatch Directives. It's not in svn, but it was in domm's svn dump I think. |
|
From: <phr...@us...> - 2006-04-21 07:05:50
|
Revision: 22 Author: phred_moyer Date: 2006-04-21 00:05:46 -0700 (Fri, 21 Apr 2006) ViewCVS: http://svn.sourceforge.net/apache-dispatch/?rev=22&view=rev Log Message: ----------- - PUREPERL option somewhat functional now but make failing during XS build. Modified Paths: -------------- trunk/Makefile.PL trunk/set_pureperl.PL Modified: trunk/Makefile.PL =================================================================== --- trunk/Makefile.PL 2006-04-21 06:31:46 UTC (rev 21) +++ trunk/Makefile.PL 2006-04-21 07:05:46 UTC (rev 22) @@ -17,7 +17,6 @@ 'PREREQ_PM' => \%prereq, ); - # enable "make test" require Apache::TestMM; Apache::TestMM->import(qw(test clean)); @@ -38,13 +37,16 @@ ModPerl::MM::WriteMakefile(%makefile_params); } -elsif ($mp_wanted != 2) { # mod_perl1 specific makefile +elsif ($mp_wanted != 2) { # mod_perl1 specific makefile eval { require Apache::ExtUtils; require Apache::src; }; + # Build directives using xs or PerlSetVar + my $pureperl; + if ($@ || $ENV{DISPATCH_PUREPERL}) { print "\nBuilding without Custom Apache Directives, use 'PerlSetVar' for configuration.\n\n"; @@ -61,24 +63,22 @@ require Apache::Dispatch; my $directives = Apache::Dispatch->directives; - Apache::Extutils::command_table($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{'PL_FILES'} = {'set_pureperl.PL' => '0'}; - $makefile_params{'PREREQ_PM'} = {mod_perl => 1.2401,}; - $makefile_params{'clean'} = {FILES => '*.xs*'}; - $makefile_params{'NAME'} = 'Apache2::Dispatch'; - - require ExtUtils::MakeMaker; - ExtUtils::MakeMaker::WriteMakefile( - INC => $inc, - LIBS => [''], - %makefile_params, - ); + $makefile_params{'PREREQ_PM'} = {mod_perl => 1.2401,}; + $makefile_params{'clean'} = {FILES => '*.xs*'}; } + + my $inc = Apache::src->new->inc; + die "Can't find mod_perl header files installed" unless $inc; + require ExtUtils::MakeMaker; + ExtUtils::MakeMaker::WriteMakefile( + NAME => 'Apache::Dispatch', + INC => $inc, + LIBS => [''], + %makefile_params, + ); } # The next sub inspired by Apache::Peek 1.05 @@ -141,16 +141,3 @@ return ($wanted, $mp_ver); } -__END__ - -open (FH,catfile(qw(blib lib Apache Dispatch.pm))) || die "cannot read Dispatch.pm: $!"; -my $code=join('',<FH>); -close FH; - -$code=~s/%%PUREPERL%%/$pureperl/; - -open (OUT,">".catfile(qw(blib lib Apache Dispatch.pm))) || die "cannot write to Dispatch.pm: $!"; -print OUT $code; -close OUT; - - Modified: trunk/set_pureperl.PL =================================================================== --- trunk/set_pureperl.PL 2006-04-21 06:31:46 UTC (rev 21) +++ trunk/set_pureperl.PL 2006-04-21 07:05:46 UTC (rev 22) @@ -1,21 +1,22 @@ use strict; +use warnings FATAL => 'all'; + use File::Spec::Functions; my $pureperl=shift(@ARGV); -my $dispatch=catfile(qw(blib lib Apache Dispatch.pm)); +my $dispatch=catfile(qw(lib Apache Dispatch.pm)); -open (FH,$dispatch) || die "cannot read Dispatch.pm: $!"; -my $code=join('',<FH>); -close FH; +my $fh; +open ($fh,$dispatch) || die "cannot read Dispatch.pm: $!"; +my $code=join('',<$fh>); +close $fh; chmod(0755,$dispatch); -$code=~s/'PUREPERL'/$pureperl/; +$code =~ s{(\$Apache::Dispatch::PUREPERL\=)\d}{$1$pureperl}; -open (OUT,">$dispatch") || die "cannot write to Dispatch.pm: $!"; -print OUT $code; -close OUT; +open ($fh,">", $dispatch) || die "cannot write to Dispatch.pm: $!"; +print $fh $code; +close $fh; - - This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <phr...@us...> - 2006-04-21 06:31:54
|
Revision: 21 Author: phred_moyer Date: 2006-04-20 23:31:46 -0700 (Thu, 20 Apr 2006) ViewCVS: http://svn.sourceforge.net/apache-dispatch/?rev=21&view=rev Log Message: ----------- Include the pureperl option for PerlSetVar Modified Paths: -------------- trunk/INSTALL Modified: trunk/INSTALL =================================================================== --- trunk/INSTALL 2006-04-21 06:17:43 UTC (rev 20) +++ trunk/INSTALL 2006-04-21 06:31:46 UTC (rev 21) @@ -4,12 +4,25 @@ perl Makefile.PL make && make test && make install +------------------------------------------------------------------------------ + Install Apache2::Dispatch explicitly for mod_perl2. perl Makefile.PL MOD_PERL=2 make && make test && make install +------------------------------------------------------------------------------ + Install Apache::Dispatch explicitly for mod_perl1. perl Makefile.PL MOD_PERL=1 +make && make test && make install + +------------------------------------------------------------------------------ + +Install Apache::Dispatch explicitly for mod_perl1, using PerlSetVar for +Dispatch configuration. + +export DISPATCH_PUREPERL=1 +perl Makefile.PL MOD_PERL=1 make && make test && make install \ No newline at end of file This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <phr...@us...> - 2006-04-21 06:17:46
|
Revision: 20 Author: phred_moyer Date: 2006-04-20 23:17:43 -0700 (Thu, 20 Apr 2006) ViewCVS: http://svn.sourceforge.net/apache-dispatch/?rev=20&view=rev Log Message: ----------- Install file with explicit directions on how to specify which version Added Paths: ----------- trunk/INSTALL Added: trunk/INSTALL =================================================================== --- trunk/INSTALL (rev 0) +++ trunk/INSTALL 2006-04-21 06:17:43 UTC (rev 20) @@ -0,0 +1,15 @@ +Install and guess which version of mod_perl you use, defaulting to mp2 if both +exist. + +perl Makefile.PL +make && make test && make install + +Install Apache2::Dispatch explicitly for mod_perl2. + +perl Makefile.PL MOD_PERL=2 +make && make test && make install + +Install Apache::Dispatch explicitly for mod_perl1. + +perl Makefile.PL MOD_PERL=1 +make && make test && make install \ No newline at end of file This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
