stas 2002/08/15 05:34:20
Modified: ModPerl-Registry/lib/ModPerl RegistryCooker.pm
Log:
s/$o/$self/g, $o looks silly
Revision Changes Path
1.14 +113 -113 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.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- RegistryCooker.pm 15 Aug 2002 12:29:06 -0000 1.13
+++ RegistryCooker.pm 15 Aug 2002 12:34:20 -0000 1.14
@@ -87,9 +87,9 @@
sub new {
my($class, $r) = @_;
- my $o = bless [], $class;
- $o->init($r);
- return $o;
+ my $self = bless [], $class;
+ $self->init($r);
+ return $self;
}
#########################################################################
@@ -129,42 +129,42 @@
# func: default_handler
# dflt: META: see above
# desc: META: see above
-# args: $o - registry blessed object
+# args: $self - registry blessed object
# rtrn: handler's response status
# note: that's what most sub-class handlers will call
#########################################################################
sub default_handler {
- my $o = shift;
+ my $self = shift;
- $o->make_namespace;
+ $self->make_namespace;
- if ($o->should_compile) {
- my $rc = $o->can_compile;
+ if ($self->should_compile) {
+ my $rc = $self->can_compile;
return $rc unless $rc == Apache::OK;
- $rc = $o->convert_script_to_compiled_handler;
+ $rc = $self->convert_script_to_compiled_handler;
return $rc unless $rc == Apache::OK;
}
- return $o->run;
+ return $self->run;
}
#########################################################################
# func: run
# dflt: run
# desc: executes the compiled code
-# args: $o - registry blessed object
+# args: $self - registry blessed object
# rtrn: execution status (Apache::?)
#########################################################################
sub run {
- my $o = shift;
+ my $self = shift;
- my $r = $o->[REQ];
- my $package = $o->[PACKAGE];
+ my $r = $self->[REQ];
+ my $package = $self->[PACKAGE];
- $o->set_script_name;
- $o->chdir_file;
+ $self->set_script_name;
+ $self->chdir_file;
my $rc = Apache::OK;
my $cv = \&{"$package\::handler"};
@@ -172,15 +172,15 @@
{ # run the code and preserve warnings setup when it's done
no warnings;
eval { $rc = &{$cv}($r, @_) };
- $o->[STATUS] = $rc;
+ $self->[STATUS] = $rc;
ModPerl::Global::special_list_call(END => $package);
}
- $o->flush_namespace;
+ $self->flush_namespace;
- #$o->chdir_file("$Apache::Server::CWD/");
+ #$self->chdir_file("$Apache::Server::CWD/");
- if ( ($rc = $o->error_check) != Apache::OK) {
+ if ( ($rc = $self->error_check) != Apache::OK) {
return $rc;
}
@@ -193,37 +193,37 @@
# func: can_compile
# dflt: can_compile
# desc: checks whether the script is allowed and can be compiled
-# args: $o - registry blessed object
+# args: $self - registry blessed object
# rtrn: $rc - return status to forward
# efct: initializes the data object's fields: MTIME
#########################################################################
sub can_compile {
- my $o = shift;
- my $r = $o->[REQ];
+ my $self = shift;
+ my $r = $self->[REQ];
unless (-r $r->finfo && -s _) {
- $o->log_error("$o->[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 _;
- $o->[MTIME] = -M _;
+ $self->[MTIME] = -M _;
unless (-x _ or IS_WIN32) {
$r->log_reason("file permissions deny server execution",
- $o->[FILENAME]);
+ $self->[FILENAME]);
return Apache::FORBIDDEN;
}
if (!($r->allow_options & Apache::OPT_EXECCGI)) {
$r->log_reason("Options ExecCGI is off in this directory",
- $o->[FILENAME]);
+ $self->[FILENAME]);
return Apache::FORBIDDEN;
}
- $o->debug("can compile $o->[FILENAME]") if DEBUG & D_NOISE;
+ $self->debug("can compile $self->[FILENAME]") if DEBUG & D_NOISE;
return Apache::OK;
@@ -232,7 +232,7 @@
# func: namespace_root
# dflt: namespace_root_common
# desc: define the namespace root for storing compiled scripts
-# args: $o - registry blessed object
+# args: $self - registry blessed object
# rtrn: the namespace root
#########################################################################
@@ -243,23 +243,23 @@
}
sub namespace_root_local {
- my $o = shift;
- join '::', ref($o), 'ROOT';
+ my $self = shift;
+ join '::', ref($self), 'ROOT';
}
#########################################################################
# func: make_namespace
# dflt: make_namespace
# desc: prepares the namespace
-# args: $o - registry blessed object
+# args: $self - registry blessed object
# rtrn: the namespace
# efct: initializes the field: PACKAGE
#########################################################################
sub make_namespace {
- my $o = shift;
+ my $self = shift;
- my $package = $o->namespace_from;
+ my $package = $self->namespace_from;
# Escape everything into valid perl identifiers
$package =~ s/([^A-Za-z0-9_])/sprintf("_%2x", unpack("C", $1))/eg;
@@ -268,9 +268,9 @@
$package =~ s/^(\d)/_$1/;
# prepend root
- $package = $o->namespace_root() . "::$package";
+ $package = $self->namespace_root() . "::$package";
- $o->[PACKAGE] = $package;
+ $self->[PACKAGE] = $package;
return $package;
}
@@ -279,7 +279,7 @@
# func: namespace_from
# dflt: namespace_from_filename
# desc: returns a partial raw package name based on filename, uri, else
-# args: $o - registry blessed object
+# args: $self - registry blessed object
# rtrn: a unique string
#########################################################################
@@ -287,22 +287,22 @@
# return a package name based on $r->filename only
sub namespace_from_filename {
- my $o = shift;
+ my $self = shift;
my ($volume, $dirs, $file) =
- File::Spec::Functions::splitpath($o->[FILENAME]);
+ File::Spec::Functions::splitpath($self->[FILENAME]);
my @dirs = File::Spec::Functions::splitdir($dirs);
return join '_', grep { defined && length } $volume, @dirs, $file;
}
# return a package name based on $r->uri only
sub namespace_from_uri {
- my $o = shift;
+ my $self = shift;
- my $path_info = $o->[REQ]->path_info;
- my $script_name = $path_info && $o->[URI] =~ /$path_info$/ ?
- substr($o->[URI], 0, length($o->[URI]) - length($path_info)) :
- $o->[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];
$script_name =~ s:/+$:/__INDEX__:;
@@ -313,47 +313,47 @@
# func: convert_script_to_compiled_handler
# dflt: convert_script_to_compiled_handler
# desc: reads the script, converts into a handler and compiles it
-# args: $o - registry blessed object
+# args: $self - registry blessed object
# rtrn: success/failure status
#########################################################################
sub convert_script_to_compiled_handler {
- my $o = shift;
+ my $self = shift;
- $o->debug("Adding package $o->[PACKAGE]") if DEBUG & D_NOISE;
+ $self->debug("Adding package $self->[PACKAGE]") if DEBUG & D_NOISE;
# get the script's source
- $o->read_script;
+ $self->read_script;
# convert the shebang line opts into perl code
- $o->rewrite_shebang;
+ $self->rewrite_shebang;
# mod_cgi compat, should compile the code while in its dir, so
# relative require/open will work.
- $o->chdir_file;
+ $self->chdir_file;
-# undef &{"$o->[PACKAGE]\::handler"}; unless DEBUG & D_NOISE; #avoid warnings
-# $o->[PACKAGE]->can('undef_functions') && $o->[PACKAGE]->undef_functions;
+# undef &{"$self->[PACKAGE]\::handler"}; unless DEBUG & D_NOISE; #avoid warnings
+# $self->[PACKAGE]->can('undef_functions') && $self->[PACKAGE]->undef_functions;
- my $line = $o->get_mark_line;
+ my $line = $self->get_mark_line;
- $o->strip_end_data_segment;
+ $self->strip_end_data_segment;
my $eval = join '',
'package ',
- $o->[PACKAGE], ";",
+ $self->[PACKAGE], ";",
"sub handler {\n",
$line,
- ${ $o->[CODE] },
+ ${ $self->[CODE] },
"\n}"; # last line comment without newline?
my %orig_inc = %INC;
- my $rc = $o->compile(\$eval);
+ my $rc = $self->compile(\$eval);
return $rc unless $rc == Apache::OK;
- $o->debug(qq{compiled package \"$o->[PACKAGE]\"}) if DEBUG & D_NOISE;
+ $self->debug(qq{compiled package \"$self->[PACKAGE]\"}) if DEBUG & D_NOISE;
- #$o->chdir_file("$Apache::Server::CWD/");
+ #$self->chdir_file("$Apache::Server::CWD/");
# %INC cleanup in case .pl files do not declare package ...;
for (keys %INC) {
@@ -366,7 +366,7 @@
# $r->child_terminate if lc($opt) eq "on";
# }
- $o->cache_it;
+ $self->cache_it;
return $rc;
}
@@ -375,7 +375,7 @@
# func: cache_table
# dflt: cache_table_common
# desc: return a symbol table for caching compiled scripts in
-# args: $o - registry blessed object (or the class name)
+# args: $self - registry blessed object (or the class name)
# rtrn: symbol table
#########################################################################
@@ -387,8 +387,8 @@
sub cache_table_local {
- my $o = shift;
- my $class = ref($o) || $o;
+ my $self = shift;
+ my $class = ref($self) || $self;
no strict 'refs';
\%$class;
}
@@ -397,13 +397,13 @@
# func: cache_it
# dflt: cache_it
# desc: mark the package as cached by storing its modification time
-# args: $o - registry blessed object
+# args: $self - registry blessed object
# rtrn: nothing
#########################################################################
sub cache_it {
- my $o = shift;
- $o->cache_table->{ $o->[PACKAGE] }{mtime} = $o->[MTIME];
+ my $self = shift;
+ $self->cache_table->{ $self->[PACKAGE] }{mtime} = $self->[MTIME];
}
@@ -411,14 +411,14 @@
# func: is_cached
# dflt: is_cached
# desc: checks whether the package is already cached
-# args: $o - registry blessed object
+# args: $self - registry blessed object
# rtrn: TRUE if cached,
# FALSE otherwise
#########################################################################
sub is_cached {
- my $o = shift;
- exists $o->cache_table->{ $o->[PACKAGE] }{mtime};
+ my $self = shift;
+ exists $self->cache_table->{ $self->[PACKAGE] }{mtime};
}
@@ -426,7 +426,7 @@
# func: should_compile
# dflt: should_compile_once
# desc: decide whether code should be compiled or not
-# args: $o - registry blessed object
+# args: $self - registry blessed object
# rtrn: TRUE if should compile
# FALSE otherwise
# efct: sets MTIME if it's not set yet
@@ -437,10 +437,10 @@
# return false only if the package is cached and its source file
# wasn't modified
sub should_compile_if_modified {
- my $o = shift;
- $o->[MTIME] ||= -M $o->[REQ]->finfo;
- !($o->is_cached &&
- $o->cache_table->{ $o->[PACKAGE] }{mtime} <= $o->[MTIME]);
+ my $self = shift;
+ $self->[MTIME] ||= -M $self->[REQ]->finfo;
+ !($self->is_cached &&
+ $self->cache_table->{ $self->[PACKAGE] }{mtime} <= $self->[MTIME]);
}
# return false if the package is cached already
@@ -452,22 +452,22 @@
# func: flush_namespace
# dflt: NOP (don't flush)
# desc: flush the compiled package's namespace
-# args: $o - registry blessed object
+# args: $self - registry blessed object
# rtrn: nothing
#########################################################################
*flush_namespace = \&NOP;
sub flush_namespace_normal {
- my $o = shift;
+ my $self = shift;
- $o->debug("flushing namespace") if DEBUG & D_NOISE;
+ $self->debug("flushing namespace") if DEBUG & D_NOISE;
no strict 'refs';
- my $tab = \%{ $o->[PACKAGE] . '::' };
+ my $tab = \%{ $self->[PACKAGE] . '::' };
for (keys %$tab) {
- my $fullname = join '::', $o->[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) {
@@ -507,17 +507,17 @@
# func: read_script
# dflt: read_script
# desc: reads the script in
-# args: $o - registry blessed object
+# args: $self - registry blessed object
# rtrn: nothing
# efct: initializes the CODE field with the source script
#########################################################################
# reads the contents of the file
sub read_script {
- my $o = shift;
+ my $self = shift;
- $o->debug("reading $o->[FILENAME]") if DEBUG & D_NOISE;
- $o->[CODE] = $o->[REQ]->slurp_filename;
+ $self->debug("reading $self->[FILENAME]") if DEBUG & D_NOISE;
+ $self->[CODE] = $self->[REQ]->slurp_filename;
}
#########################################################################
@@ -525,7 +525,7 @@
# dflt: rewrite_shebang
# desc: parse the shebang line and convert command line switches
# (defined in %switches) into a perl code.
-# args: $o - registry blessed object
+# args: $self - registry blessed object
# rtrn: nothing
# efct: the CODE field gets adjusted
#########################################################################
@@ -542,8 +542,8 @@
);
sub rewrite_shebang {
- my $o = shift;
- my($line) = ${ $o->[CODE] } =~ /^(.*)$/m;
+ my $self = shift;
+ my($line) = ${ $self->[CODE] } =~ /^(.*)$/m;
my @cmdline = split /\s+/, $line;
return unless @cmdline;
return unless shift(@cmdline) =~ /^\#!/;
@@ -557,14 +557,14 @@
$prepend .= &{$switches{$_}};
}
}
- ${ $o->[CODE] } =~ s/^/$prepend/ if $prepend;
+ ${ $self->[CODE] } =~ s/^/$prepend/ if $prepend;
}
#########################################################################
# func: set_script_name
# dflt: set_script_name
# desc: set $0 to the script's name
-# args: $o - registry blessed object
+# args: $self - registry blessed object
# rtrn: nothing
#########################################################################
@@ -576,7 +576,7 @@
# func: chdir_file
# dflt: NOP
# desc: chdirs into $dir
-# args: $o - registry blessed object
+# args: $self - registry blessed object
# $dir - a dir
# rtrn: nothing (?or success/failure?)
#########################################################################
@@ -584,28 +584,28 @@
*chdir_file = \&NOP;
sub chdir_file_normal {
- my($o, $dir) = @_;
- # $o->[REQ]->chdir_file($dir ? $dir : $o->[FILENAME]);
+ my($self, $dir) = @_;
+ # $self->[REQ]->chdir_file($dir ? $dir : $self->[FILENAME]);
}
#########################################################################
# func: get_mark_line
# dflt: get_mark_line
# desc: generates the perl compiler #line directive
-# args: $o - registry blessed object
+# args: $self - registry blessed object
# rtrn: returns the perl compiler #line directive
#########################################################################
sub get_mark_line {
- my $o = shift;
- $ModPerl::Registry::MarkLine ? "\n#line 1 $o->[FILENAME]\n" : "";
+ my $self = shift;
+ $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 $o->[CODE]
-# args: $o - registry blessed object
+# desc: remove the trailing non-code from $self->[CODE]
+# args: $self - registry blessed object
# rtrn: nothing
#########################################################################
@@ -619,19 +619,19 @@
# func: compile
# dflt: compile
# desc: compile the code in $eval
-# args: $o - registry blessed object
+# args: $self - registry blessed object
# $eval - a ref to a scalar with the code to compile
# rtrn: success/failure
#########################################################################
sub compile {
- my($o, $eval) = @_;
+ my($self, $eval) = @_;
- my $r = $o->[REQ];
+ my $r = $self->[REQ];
- $o->debug("compiling $o->[FILENAME]") if DEBUG && D_COMPILE;
+ $self->debug("compiling $self->[FILENAME]") if DEBUG && D_COMPILE;
- ModPerl::Global::special_list_clear(END => $o->[PACKAGE]);
+ ModPerl::Global::special_list_clear(END => $self->[PACKAGE]);
ModPerl::Util::untaint($$eval);
{
@@ -641,22 +641,22 @@
eval $$eval;
}
- return $o->error_check;
+ return $self->error_check;
}
#########################################################################
# func: error_check
# dflt: error_check
# desc: checks $@ for errors
-# args: $o - registry blessed object
+# args: $self - registry blessed object
# rtrn: Apache::SERVER_ERROR if $@ is set, Apache::OK otherwise
#########################################################################
sub error_check {
- my $o = shift;
+ my $self = shift;
if ($@ and substr($@,0,4) ne " at ") {
- $o->log_error($@);
- $@{$o->[REQ]->uri} = $@;
+ $self->log_error($@);
+ $@{$self->[REQ]->uri} = $@;
#$@ = ''; #XXX fix me, if we don't do this Apache::exit() breaks
return Apache::SERVER_ERROR;
}
@@ -690,17 +690,17 @@
### helper methods
sub debug {
- my $o = shift;
- my $class = ref $o;
- $o->[REQ]->log_error("$$: $class: " . join '', @_);
+ my $self = shift;
+ my $class = ref $self;
+ $self->[REQ]->log_error("$$: $class: " . join '', @_);
}
sub log_error {
- my($o, $msg) = @_;
- my $class = ref $o;
+ my($self, $msg) = @_;
+ my $class = ref $self;
- $o->[REQ]->log_error("$$: $class: $msg");
- $o->[REQ]->notes('error-notes', $msg);
+ $self->[REQ]->log_error("$$: $class: $msg");
+ $self->[REQ]->notes('error-notes', $msg);
}
#########################################################################
