perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From s...@apache.org
Subject cvs commit: modperl-2.0/ModPerl-Registry/t/conf modperl_extra_startup.pl
Date Fri, 16 Aug 2002 08:01:19 GMT
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;
  
  
  

Mime
View raw message