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/lib/ModPerl RegistryCooker.pm RegistryLoader.pm
Date Sun, 02 Mar 2003 22:47:20 GMT
stas        2003/03/02 14:47:20

  Modified:    .        Changes
               ModPerl-Registry/lib/ModPerl RegistryCooker.pm
                        RegistryLoader.pm
  Log:
  move ModPerl::RegistryCooker to use a hash as object (similar to mp1),
  to make it easier to subclass.
  Submitted by: Nathan Byrd <nathan@byrd.net>
  Reviewed by:  stas
  
  Revision  Changes    Path
  1.140     +3 -0      modperl-2.0/Changes
  
  Index: Changes
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/Changes,v
  retrieving revision 1.139
  retrieving revision 1.140
  diff -u -r1.139 -r1.140
  --- Changes	2 Mar 2003 13:28:14 -0000	1.139
  +++ Changes	2 Mar 2003 22:47:19 -0000	1.140
  @@ -10,6 +10,9 @@
   
   =item 1.99_09-dev
   
  +move ModPerl::RegistryCooker to use a hash as object (similar to mp1),
  +to make it easier to subclass. [Nathan Byrd <nathan@byrd.net>]
  +
   $r->rflush has to flush internal modperl buffer before calling
   ap_rflush, so implement rflush, instead of autogenerating the xs code
   for it. [Stas]
  
  
  
  1.32      +50 -61    modperl-2.0/ModPerl-Registry/lib/ModPerl/RegistryCooker.pm
  
  Index: RegistryCooker.pm
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/ModPerl-Registry/lib/ModPerl/RegistryCooker.pm,v
  retrieving revision 1.31
  retrieving revision 1.32
  diff -u -r1.31 -r1.32
  --- RegistryCooker.pm	7 Feb 2003 00:12:25 -0000	1.31
  +++ RegistryCooker.pm	2 Mar 2003 22:47:19 -0000	1.32
  @@ -55,17 +55,6 @@
   #        : D_NONE;
   
   #########################################################################
  -# object's array index's access constants
  -#
  -#########################################################################
  -use constant REQ       => 0;
  -use constant FILENAME  => 1;
  -use constant URI       => 2;
  -use constant MTIME     => 3;
  -use constant PACKAGE   => 4;
  -use constant CODE      => 5;
  -
  -#########################################################################
   # OS specific constants
   #
   #########################################################################
  @@ -100,7 +89,7 @@
   
   sub new {
       my($class, $r) = @_;
  -    my $self = bless [], $class;
  +    my $self = bless {}, $class;
       $self->init($r);
       return $self;
   }
  @@ -114,9 +103,9 @@
   #########################################################################
   
   sub init {
  -    $_[0]->[REQ]      = $_[1];
  -    $_[0]->[URI]      = $_[1]->uri;
  -    $_[0]->[FILENAME] = $_[1]->filename;
  +    $_[0]->{REQ}      = $_[1];
  +    $_[0]->{URI}      = $_[1]->uri;
  +    $_[0]->{FILENAME} = $_[1]->filename;
   }
   
   #########################################################################
  @@ -161,9 +150,9 @@
   
       # handlers shouldn't set $r->status but return it, so we reset the
       # status after running it
  -    my $old_status = $self->[REQ]->status;
  +    my $old_status = $self->{REQ}->status;
       my $rc = $self->run;
  -    my $new_status = $self->[REQ]->status($old_status);
  +    my $new_status = $self->{REQ}->status($old_status);
       return ($rc == Apache::OK && $old_status != $new_status)
           ? $new_status
           : $rc;
  @@ -180,8 +169,8 @@
   sub run {
       my $self = shift;
   
  -    my $r       = $self->[REQ];
  -    my $package = $self->[PACKAGE];
  +    my $r       = $self->{REQ};
  +    my $package = $self->{PACKAGE};
   
       $self->set_script_name;
       $self->chdir_file;
  @@ -227,30 +216,30 @@
   
   sub can_compile {
       my $self = shift;
  -    my $r = $self->[REQ];
  +    my $r = $self->{REQ};
   
       unless (-r $r->my_finfo && -s _) {
  -        $self->log_error("$self->[FILENAME] not found or unable to stat");
  +        $self->log_error("$self->{FILENAME} not found or unable to stat");
   	return Apache::NOT_FOUND;
       }
   
       return Apache::DECLINED if -d _;
   
  -    $self->[MTIME] = -M _;
  +    $self->{MTIME} = -M _;
   
       unless (-x _ or IS_WIN32) {
           $r->log_error("file permissions deny server execution",
  -                       $self->[FILENAME]);
  +                       $self->{FILENAME});
           return Apache::FORBIDDEN;
       }
   
       if (!($r->allow_options & Apache::OPT_EXECCGI)) {
           $r->log_error("Options ExecCGI is off in this directory",
  -                       $self->[FILENAME]);
  +                       $self->{FILENAME});
           return Apache::FORBIDDEN;
       }
   
  -    $self->debug("can compile $self->[FILENAME]") if DEBUG & D_NOISE;
  +    $self->debug("can compile $self->{FILENAME}") if DEBUG & D_NOISE;
   
       return Apache::OK;
   
  @@ -291,7 +280,7 @@
       # prepend root
       $package = $self->namespace_root() . "::$package";
   
  -    $self->[PACKAGE] = $package;
  +    $self->{PACKAGE} = $package;
   
       return $package;
   }
  @@ -311,7 +300,7 @@
       my $self = shift;
   
       my ($volume, $dirs, $file) = 
  -        File::Spec::Functions::splitpath($self->[FILENAME]);
  +        File::Spec::Functions::splitpath($self->{FILENAME});
       my @dirs = File::Spec::Functions::splitdir($dirs);
       return join '_', grep { defined && length } $volume, @dirs, $file;
   }
  @@ -320,14 +309,14 @@
   sub namespace_from_uri {
       my $self = shift;
   
  -    my $path_info = $self->[REQ]->path_info;
  -    my $script_name = $path_info && $self->[URI] =~ /$path_info$/ ?
  -	substr($self->[URI], 0, length($self->[URI]) - length($path_info)) :
  -	$self->[URI];
  +    my $path_info = $self->{REQ}->path_info;
  +    my $script_name = $path_info && $self->{URI} =~ /$path_info$/ ?
  +	substr($self->{URI}, 0, length($self->{URI}) - length($path_info)) :
  +	$self->{URI};
   
       if ($ModPerl::RegistryCooker::NameWithVirtualHost && 
  -        $self->[REQ]->server->is_virtual) {
  -        my $name = $self->[REQ]->get_server_name;
  +        $self->{REQ}->server->is_virtual) {
  +        my $name = $self->{REQ}->get_server_name;
           $script_name = join "", $name, $script_name if $name;
       }
   
  @@ -347,7 +336,7 @@
   sub convert_script_to_compiled_handler {
       my $self = shift;
   
  -    $self->debug("Adding package $self->[PACKAGE]") if DEBUG & D_NOISE;
  +    $self->debug("Adding package $self->{PACKAGE}") if DEBUG & D_NOISE;
   
       # get the script's source
       $self->read_script;
  @@ -359,8 +348,8 @@
       # relative require/open will work.
       $self->chdir_file;
   
  -#    undef &{"$self->[PACKAGE]\::handler"}; unless DEBUG & D_NOISE; #avoid warnings
  -#    $self->[PACKAGE]->can('undef_functions') && $self->[PACKAGE]->undef_functions;
  +#    undef &{"$self->{PACKAGE}\::handler"}; unless DEBUG & D_NOISE; #avoid warnings
  +#    $self->{PACKAGE}->can('undef_functions') && $self->{PACKAGE}->undef_functions;
   
       my $line = $self->get_mark_line;
   
  @@ -368,15 +357,15 @@
   
       my $eval = join '',
                       'package ',
  -                    $self->[PACKAGE], ";",
  +                    $self->{PACKAGE}, ";",
                       "sub handler {\n",
                       $line,
  -                    ${ $self->[CODE] },
  +                    ${ $self->{CODE} },
                       "\n}"; # last line comment without newline?
   
       my $rc = $self->compile(\$eval);
       return $rc unless $rc == Apache::OK;
  -    $self->debug(qq{compiled package \"$self->[PACKAGE]\"}) if DEBUG & D_NOISE;
  +    $self->debug(qq{compiled package \"$self->{PACKAGE}\"}) if DEBUG & D_NOISE;
   
       #$self->chdir_file("$Apache::Server::CWD/");
   
  @@ -421,7 +410,7 @@
   
   sub cache_it {
       my $self = shift;
  -    $self->cache_table->{ $self->[PACKAGE] }{mtime} = $self->[MTIME];
  +    $self->cache_table->{ $self->{PACKAGE} }{mtime} = $self->{MTIME};
   }
   
   
  @@ -436,7 +425,7 @@
   
   sub is_cached {
       my $self = shift;
  -    exists $self->cache_table->{ $self->[PACKAGE] }{mtime};
  +    exists $self->cache_table->{ $self->{PACKAGE} }{mtime};
   }
   
   
  @@ -456,9 +445,9 @@
   # wasn't modified
   sub should_compile_if_modified {
       my $self = shift;
  -    $self->[MTIME] ||= -M $self->[REQ]->my_finfo;
  +    $self->{MTIME} ||= -M $self->{REQ}->my_finfo;
       !($self->is_cached && 
  -      $self->cache_table->{ $self->[PACKAGE] }{mtime} <= $self->[MTIME]);
  +      $self->cache_table->{ $self->{PACKAGE} }{mtime} <= $self->{MTIME});
   }
   
   # return false if the package is cached already
  @@ -482,10 +471,10 @@
       $self->debug("flushing namespace") if DEBUG & D_NOISE;
   
       no strict 'refs';
  -    my $tab = \%{ $self->[PACKAGE] . '::' };
  +    my $tab = \%{ $self->{PACKAGE} . '::' };
   
       for (keys %$tab) {
  -        my $fullname = join '::', $self->[PACKAGE], $_;
  +        my $fullname = join '::', $self->{PACKAGE}, $_;
           # code/hash/array/scalar might be imported make sure the gv
           # does not point elsewhere before undefing each
           if (%$fullname) {
  @@ -534,8 +523,8 @@
   sub read_script {
       my $self = shift;
   
  -    $self->debug("reading $self->[FILENAME]") if DEBUG & D_NOISE;
  -    $self->[CODE] = $self->[REQ]->my_slurp_filename;
  +    $self->debug("reading $self->{FILENAME}") if DEBUG & D_NOISE;
  +    $self->{CODE} = $self->{REQ}->my_slurp_filename;
   }
   
   #########################################################################
  @@ -560,7 +549,7 @@
   
   sub rewrite_shebang {
       my $self = shift;
  -    my($line) = ${ $self->[CODE] } =~ /^(.*)$/m;
  +    my($line) = ${ $self->{CODE} } =~ /^(.*)$/m;
       my @cmdline = split /\s+/, $line;
       return unless @cmdline;
       return unless shift(@cmdline) =~ /^\#!/;
  @@ -574,7 +563,7 @@
   	    $prepend .= $switches{$_}->();
   	}
       }
  -    ${ $self->[CODE] } =~ s/^/$prepend/ if $prepend;
  +    ${ $self->{CODE} } =~ s/^/$prepend/ if $prepend;
   }
   
   #########################################################################
  @@ -586,7 +575,7 @@
   #########################################################################
   
   sub set_script_name {
  -    *0 = \(shift->[FILENAME]);
  +    *0 = \(shift->{FILENAME});
   }
   
   #########################################################################
  @@ -602,7 +591,7 @@
   
   sub chdir_file_normal {
       my($self, $dir) = @_;
  -    # $self->[REQ]->chdir_file($dir ? $dir : $self->[FILENAME]);
  +    # $self->{REQ}->chdir_file($dir ? $dir : $self->{FILENAME});
   }
   
   #########################################################################
  @@ -615,19 +604,19 @@
   
   sub get_mark_line {
       my $self = shift;
  -    $ModPerl::Registry::MarkLine ? "\n#line 1 $self->[FILENAME]\n" : "";
  +    $ModPerl::Registry::MarkLine ? "\n#line 1 $self->{FILENAME}\n" : "";
   }
   
   #########################################################################
   # func: strip_end_data_segment
   # dflt: strip_end_data_segment
  -# desc: remove the trailing non-code from $self->[CODE]
  +# desc: remove the trailing non-code from $self->{CODE}
   # args: $self - registry blessed object
   # rtrn: nothing
   #########################################################################
   
   sub strip_end_data_segment {
  -    ${ +shift->[CODE] } =~ s/__(END|DATA)__(.*)//s;
  +    ${ +shift->{CODE} } =~ s/__(END|DATA)__(.*)//s;
   }
   
   
  @@ -644,11 +633,11 @@
   sub compile {
       my($self, $eval) = @_;
   
  -    my $r = $self->[REQ];
  +    my $r = $self->{REQ};
   
  -    $self->debug("compiling $self->[FILENAME]") if DEBUG && D_COMPILE;
  +    $self->debug("compiling $self->{FILENAME}") if DEBUG && D_COMPILE;
   
  -    ModPerl::Global::special_list_clear(END => $self->[PACKAGE]);
  +    ModPerl::Global::special_list_clear(END => $self->{PACKAGE});
   
       ModPerl::Util::untaint($$eval);
       {
  @@ -707,16 +696,16 @@
   sub debug {
       my $self = shift;
       my $class = ref $self;
  -    $self->[REQ]->log_error("$$: $class: " . join '', @_);
  +    $self->{REQ}->log_error("$$: $class: " . join '', @_);
   }
   
   sub log_error {
       my($self, $msg) = @_;
       my $class = ref $self;
   
  -    $self->[REQ]->log_error("$$: $class: $msg");
  -    $self->[REQ]->notes->set('error-notes' => $msg);
  -    $@{$self->[URI]} = $msg;
  +    $self->{REQ}->log_error("$$: $class: $msg");
  +    $self->{REQ}->notes->set('error-notes' => $msg);
  +    $@{$self->{URI}} = $msg;
   }
   
   #########################################################################
  
  
  
  1.8       +1 -1      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.7
  retrieving revision 1.8
  diff -u -r1.7 -r1.8
  --- RegistryLoader.pm	29 Dec 2002 10:08:08 -0000	1.7
  +++ RegistryLoader.pm	2 Mar 2003 22:47:19 -0000	1.8
  @@ -104,7 +104,7 @@
   # specified by the 'package' attribute, not RegistryLoader
   sub namespace_root {
       join '::', ModPerl::RegistryCooker::NAMESPACE_ROOT,
  -        shift->[ModPerl::RegistryCooker::REQ]->{package};
  +        shift->{REQ}->{package};
   }
   
   # override Apache class methods called by Modperl::Registry*. normally
  
  
  

Mime
View raw message