You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl-cvs@perl.apache.org by st...@apache.org on 2002/08/16 10:01:19 UTC
cvs commit: modperl-2.0/ModPerl-Registry/t/conf modperl_extra_startup.pl
stas 2002/08/16 01:01:18
Modified: ModPerl-Registry/lib/ModPerl RegistryLoader.pm
ModPerl-Registry/t/cgi-bin special_blocks.pl
ModPerl-Registry/t/conf modperl_extra_startup.pl
Log:
ModPerl::RegistryLoader is now fully operational and tested
Revision Changes Path
1.2 +29 -13 modperl-2.0/ModPerl-Registry/lib/ModPerl/RegistryLoader.pm
Index: RegistryLoader.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/ModPerl-Registry/lib/ModPerl/RegistryLoader.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- RegistryLoader.pm 13 Nov 2001 04:33:06 -0000 1.1
+++ RegistryLoader.pm 16 Aug 2002 08:01:18 -0000 1.2
@@ -1,11 +1,15 @@
package ModPerl::RegistryLoader;
-use Apache::Const -compile => qw(OPT_EXECCGI);
+use Apache::Process;
+
+use Apache::Const -compile => qw(OK HTTP_OK OPT_EXECCGI);
use Carp;
our @ISA = ();
-sub new {
+# using create() instead of new() since the latter is inherited from
+# the SUPER class, and it's used inside handler() from the SUPER class
+sub create {
my $class = shift;
my $self = bless {@_} => ref($class)||$class;
$self->load_package($self->{package});
@@ -31,9 +35,9 @@
}
else {
# try to translate URI->filename
- if (my $func = $self->{trans}) {
+ if (exists $self->{trans} and ref($self->{trans}) eq 'CODE') {
no strict 'refs';
- $filename = $func->($uri);
+ $filename = $self->{trans}->($uri);
unless (-e $filename) {
$self->warn("Cannot find a translated from uri: $filename");
return;
@@ -41,8 +45,11 @@
} else {
# try to guess
(my $guess = $uri) =~ s|^/||;
- $filename = Apache::server_root_relative($guess);
- $self->warn("Trying to guess filename based on uri");
+
+ $self->warn("Trying to guess filename based on uri")
+ if $self->{debug};
+ my $pool = Apache->server->process->pool;
+ $filename = Apache::server_root_relative($pool, $guess);
unless (-e $filename) {
$self->warn("Cannot find guessed file: $filename",
"provide \$filename or 'trans' sub");
@@ -55,25 +62,34 @@
$self->warn("*** uri=$uri, filename=$filename");
}
- my $r = bless {
- uri => $uri,
- filename => $filename,
- } => ref($self) || $self;
+ my $rl = bless {
+ uri => $uri,
+ filename => $filename,
+ package => $self->{package},
+ } => ref($self) || $self;
- $r->SUPER::handler;
+ __PACKAGE__->SUPER::handler($rl);
}
sub filename { shift->{filename} }
+sub status { Apache::HTTP_OK }
sub finfo { shift->{filename} }
sub uri { shift->{uri} }
sub path_info {}
sub allow_options { Apache::OPT_EXECCGI } #will be checked again at run-time
sub log_error { shift; die @_ if $@; warn @_; }
*log_reason = \&log_error;
-sub run {} # don't run the script
+sub run { return Apache::OK } # don't run the script
sub server { shift }
+# the preloaded file needs to be precompiled into the package
+# specified by the 'package' attribute, not RegistryLoader
+sub namespace_root {
+ join '::', 'ModPerl::ROOT',
+ shift->[ModPerl::RegistryCooker::REQ]->{package};
+}
+
# override Apache class methods called by Modperl::Registry*. normally
# only available at request-time via blessed request_rec pointer
sub slurp_filename {
@@ -97,7 +113,7 @@
sub warn {
my $self = shift;
- Apache::warn(__PACKAGE__ . ": @_\n");
+ Apache->warn(__PACKAGE__ . ": @_\n");
}
1;
1.4 +1 -1 modperl-2.0/ModPerl-Registry/t/cgi-bin/special_blocks.pl
Index: special_blocks.pl
===================================================================
RCS file: /home/cvs/modperl-2.0/ModPerl-Registry/t/cgi-bin/special_blocks.pl,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- special_blocks.pl 14 May 2002 15:47:12 -0000 1.3
+++ special_blocks.pl 16 Aug 2002 08:01:18 -0000 1.4
@@ -27,7 +27,7 @@
}
END {
- if ($test eq 'end') {
+ if (defined $test && $test eq 'end') {
print "end ok";
}
}
1.3 +39 -30 modperl-2.0/ModPerl-Registry/t/conf/modperl_extra_startup.pl
Index: modperl_extra_startup.pl
===================================================================
RCS file: /home/cvs/modperl-2.0/ModPerl-Registry/t/conf/modperl_extra_startup.pl,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- modperl_extra_startup.pl 14 May 2002 17:12:01 -0000 1.2
+++ modperl_extra_startup.pl 16 Aug 2002 08:01:18 -0000 1.3
@@ -8,40 +8,49 @@
use Apache::ServerUtil;
use Apache::Process;
use APR::Pool;
-# test the scripts pre-loading by explicitly specifying uri => filename
+
use ModPerl::RegistryLoader ();
-my $rl = ModPerl::RegistryLoader->new(package => "ModPerl::Registry");
+my $rl = ModPerl::RegistryLoader->create(package => "ModPerl::Registry");
my $pool = Apache->server->process->pool;
my $base_dir = Apache::server_root_relative($pool, "cgi-bin");
+
+# test the scripts pre-loading by explicitly specifying uri => filename
my $base_uri = "/cgi-bin";
-#for my $file (qw(basic.pl env.pl)) {
-# my $file_path = "$base_dir/$file";
-# my $info_path = "$base_uri/$file";
-# $rl->handler($info_path, $file_path);
-#}
-
-#{
-# # test the scripts pre-loading by using trans sub
-# use DirHandle ();
-# use strict;
-
-# sub trans {
-# my $uri = shift;
-# $uri =~ s|^/registry_bb/|cgi-bin/|;
-# return Apache::server_root_relative($pool, $uri);
-# }
-
-# my $dir = Apache::server_root_relative($pool, "cgi-bin");
-
-# my $rl = ModPerl::RegistryLoader->new(package => "ModPerl::RegistryBB",
-# trans => \&trans);
-# my $dh = DirHandle->new($dir) or die $!;
-
-# for my $file ($dh->read) {
-# next unless $file =~ /\.pl$/;
-# $rl->handler("/registry_bb/$file");
-# }
-#}
+for my $file (qw(basic.pl env.pl)) {
+ my $file_path = "$base_dir/$file";
+ my $uri = "$base_uri/$file";
+ $rl->handler($uri, $file_path);
+}
+
+{
+ # test the scripts pre-loading by using trans sub
+ use DirHandle ();
+ use strict;
+
+ sub trans {
+ my $uri = shift;
+ $uri =~ s|^/registry_bb/|cgi-bin/|;
+ return Apache::server_root_relative($pool, $uri);
+ }
+
+ my $rl = ModPerl::RegistryLoader->create(
+ package => "ModPerl::RegistryBB",
+ trans => \&trans,
+ );
+
+ my $dh = DirHandle->new($base_dir) or die $!;
+ for my $file ($dh->read) {
+ next unless $file =~ /\.pl$/;
+
+ # skip these as they are knowlingly generate warnings
+ next if $file =~ /^(closure.pl|not_executable.pl)$/;
+
+ # these files shouldn't be preloaded
+ next if $file =~ /^(local-conf.pl)$/;
+
+ $rl->handler("/registry_bb/$file");
+ }
+}
1;