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 <[EMAIL PROTECTED]>
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 <[EMAIL PROTECTED]>]
+
$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);
- [EMAIL PROTECTED]>[URI]} = $msg;
+ $self->{REQ}->log_error("$$: $class: $msg");
+ $self->{REQ}->notes->set('error-notes' => $msg);
+ [EMAIL PROTECTED]>{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
