stas 01/10/19 03:37:20
Modified: ModPerl-Registry/lib/ModPerl RegistryCooker.pm
Log:
- module cleanup, moving XXX/META's into the todo list
Revision Changes Path
1.4 +35 -75 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.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- RegistryCooker.pm 2001/10/19 07:35:26 1.3
+++ RegistryCooker.pm 2001/10/19 10:37:20 1.4
@@ -16,9 +16,6 @@
our $VERSION = '1.99';
use Apache::compat ();
-# META: Should not use Apache::compat, the following methods need to
-# be implemented:
-# $r->slurp_filename
use Apache::Response;
use Apache::Log;
@@ -27,27 +24,10 @@
use ModPerl::Util ();
use ModPerl::Global ();
-#########################################################################
-# issues
-#
-#########################################################################
-
-# META: who sets this? What's the default?
unless (defined $ModPerl::Registry::MarkLine) {
$ModPerl::Registry::MarkLine = 1;
}
-### Optimizations
-#
-# - $o->[CLASS] of the subclass is known at compile time, so should
-# create the subs using $o->[CLASS] on the fly for each subclass
-# which wants them
-
-### TODO
-#
-# - who handles END/BEGIN/,CHECK,INIT) blocks?
-# - see META's accross the file
-
#########################################################################
# debug constants
#
@@ -58,9 +38,9 @@
use constant D_COMPILE => 4;
use constant D_NOISE => 8;
-# can override the debug level in httpd.conf with:
+# the debug level can be overriden on the main server level of
+# httpd.conf with:
# PerlSetVar ModPerl::RegistryCooker::DEBUG 4
-# on the server level
use Apache::ServerUtil ();
use constant DEBUG =>
defined Apache->server->dir_config('ModPerl::RegistryCooker::DEBUG')
@@ -96,26 +76,6 @@
#########################################################################
-# install the aliases into $class
-#
-#########################################################################
-
-sub install_aliases {
- my ($class, $rh_aliases) = @_;
-
- no strict 'refs';
- while (my($k,$v) = each %$rh_aliases) {
- if (my $sub = *{$v}{CODE}){
- #warn "$class: ok: $k => $v";
- *{ $class . "::$k" } = $sub;
- }
- else {
- die "$class: $k aliasing failed; sub $v doesn't exist";
- }
- }
-}
-
-#########################################################################
# func: new
# dflt: new
# args: $class - class to bless into
@@ -128,7 +88,6 @@
my($class, $r) = @_;
my $o = bless [], $class;
$o->init($r);
- #$o->debug("$$: init class: $class");
return $o;
}
@@ -160,7 +119,6 @@
# __PACKAGE__, which is tied to the file)
#########################################################################
-# META: prototyping ($$) segfaults on request
sub handler {
my $class = (@_ >= 2) ? shift : __PACKAGE__;
my $r = shift;
@@ -219,7 +177,6 @@
$o->flush_namespace;
- # META: handle!
#$o->chdir_file("$Apache::Server::CWD/");
if ( ($rc = $o->error_check) != Apache::OK) {
@@ -291,9 +248,6 @@
# make sure that the sub-package doesn't start with a digit
$package = "_$package";
- # META: ??? explain
- $ModPerl::Registry::curstash = $package;
-
# prepend root
$package = $o->[CLASS] . "::Cache::$package";
@@ -331,12 +285,6 @@
substr($o->[URI], 0, length($o->[URI]) - length($path_info)) :
$o->[URI];
- # META: do we handle this?
- # if ($ModPerl::Registry::NameWithVirtualHost && $o->[REQ]->server->is_virtual)
{
- # my $name = $o->[REQ]->get_server_name;
- # $script_name = join "", $name, $script_name if $name;
- # }
-
$script_name =~ s:/+$:/__INDEX__:;
return $script_name;
@@ -365,10 +313,7 @@
# relative require/open will work.
$o->chdir_file;
-# META: what's this?
-# # compile this subroutine into the uniq package name
-# $o->debug("handler eval-ing") if DEBUG & D_NOISE;
-# undef &{"$o->[PACKAGE]\::handler"};# unless $Debug && $Debug & 4; #avoid
warnings
+# undef &{"$o->[PACKAGE]\::handler"}; unless DEBUG & D_NOISE; #avoid warnings
# $o->[PACKAGE]->can('undef_functions') && $o->[PACKAGE]->undef_functions;
my $line = $o->get_mark_line;
@@ -385,22 +330,18 @@
my %orig_inc = %INC;
-#warn "[-- $eval --]";
my $rc = $o->compile(\$eval);
$o->debug(qq{compiled package \"$o->[PACKAGE]\"}) if DEBUG & D_NOISE;
- # META: handle!
#$o->chdir_file("$Apache::Server::CWD/");
- # %INC cleanup
- #in case .pl files do not declare package ...;
+ # %INC cleanup in case .pl files do not declare package ...;
for (keys %INC) {
next if $orig_inc{$_};
next if /\.pm$/;
delete $INC{$_};
}
-# META: $r->child_terminate is not implemented
# if(my $opt = $r->dir_config("PerlRunOnce")) {
# $r->child_terminate if lc($opt) eq "on";
# }
@@ -516,9 +457,8 @@
for (keys %$tab) {
my $fullname = join '::', $o->[PACKAGE], $_;
- #code/hash/array/scalar might be imported
- #make sure the gv does not point elsewhere
- #before undefing each
+ # code/hash/array/scalar might be imported make sure the gv
+ # does not point elsewhere before undefing each
if (%$fullname) {
*{$fullname} = {};
undef %$fullname;
@@ -528,7 +468,7 @@
undef @$fullname;
}
if ($$fullname) {
- my $tmp; #argh, no such thing as an anonymous scalar
+ my $tmp; # argh, no such thing as an anonymous scalar
*{$fullname} = \$tmp;
undef $$fullname;
}
@@ -581,8 +521,8 @@
my %switches = (
'T' => sub {
- Apache::warn("T switch ignored, ".
- "enable with 'PerlTaintCheck On'\n")
+ Apache::warn("T switch is ignored, ".
+ "enable with 'PerlSwitches -T' in httpd.conf\n")
unless $Apache::__T; "";
},
'w' => sub { "use warnings;\n" },
@@ -601,7 +541,6 @@
last if substr($s,0,1) eq "-";
for (split //, $s) {
next unless exists $switches{$_};
- #print STDERR "parsed `$_' switch\n";
$prepend .= &{$switches{$_}};
}
}
@@ -633,8 +572,6 @@
sub chdir_file_normal {
my($o, $dir) = @_;
- # META: not implemented
- # META: see todo/api.txt unsafe!
# $o->[REQ]->chdir_file($dir ? $dir : $o->[FILENAME]);
}
@@ -708,12 +645,36 @@
if ($@ and substr($@,0,4) ne " at ") {
$o->[REQ]->log_error("$$: $o->[CLASS]: `$@'");
$@{$o->[REQ]->uri} = $@;
- $@ = ''; #XXX fix me, if we don't do this Apache::exit() breaks
+ #$@ = ''; #XXX fix me, if we don't do this Apache::exit() breaks
return Apache::SERVER_ERROR;
}
return Apache::OK;
}
+
+#########################################################################
+# func: install_aliases
+# dflt: install_aliases
+# desc: install the method aliases into $class
+# args: $class - the class to install the methods into
+# $rh_aliases - a ref to a hash with aliases mapping
+# rtrn: nothing
+#########################################################################
+
+sub install_aliases {
+ my ($class, $rh_aliases) = @_;
+
+ no strict 'refs';
+ while (my($k,$v) = each %$rh_aliases) {
+ if (my $sub = *{$v}{CODE}){
+ *{ $class . "::$k" } = $sub;
+ }
+ else {
+ die "$class: $k aliasing failed; sub $v doesn't exist";
+ }
+ }
+}
+
### helper methods
sub debug{
@@ -727,10 +688,9 @@
=head1 NAME
-ModPerl::RegistryCooker -
+ModPerl::RegistryCooker - A Base Class of all mod_perl Registry Modules
=head1 SYNOPSIS
-
=head1 DESCRIPTION
