stas 01/10/19 00:35:26
Modified: ModPerl-Registry/lib/ModPerl RegistryCooker.pm
Log:
- add uncache_myself func used in the tests, to cause the registry module
forget that it has a script cached
- use the implement by mod_perl BEGIN/END blocks execution as it was in
1.x
Revision Changes Path
1.3 +36 -6 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.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- RegistryCooker.pm 2001/10/17 05:35:34 1.2
+++ RegistryCooker.pm 2001/10/19 07:35:26 1.3
@@ -16,16 +16,16 @@
our $VERSION = '1.99';
use Apache::compat ();
-# Should not use Apache::compat, the following methods need to be implemented
+# META: Should not use Apache::compat, the following methods need to
+# be implemented:
# $r->slurp_filename
-# $r->clear_rgy_endav
-# $r->stash_rgy_endav
use Apache::Response;
use Apache::Log;
use Apache::Const -compile => qw(:common &OPT_EXECCGI);
use File::Spec::Functions ();
use ModPerl::Util ();
+use ModPerl::Global ();
#########################################################################
# issues
@@ -214,6 +214,7 @@
no warnings;
eval { $rc = &{$cv}($r, @_) } if $r->seqno;
$o->[STATUS] = $rc;
+ ModPerl::Global::special_list_call(END => $package);
}
$o->flush_namespace;
@@ -420,10 +421,39 @@
sub cache_it {
my $o = shift;
no strict 'refs';
- ${$o->[CLASS]}->{ $o->[PACKAGE] }{mtime} = $o->[MTIME];
+ ${ $o->[CLASS] }->{ $o->[PACKAGE] }{mtime} = $o->[MTIME];
}
#########################################################################
+# func: uncache_myself
+# dflt: uncache_myself
+# desc: unmark the package as cached by forgetting its modification time
+# args: none
+# rtrn: nothing
+# note: this is a function and not a method, it should be called from
+# the registry script, and using the caller() method we figure
+# out the package the script was compiled into
+
+#########################################################################
+
+sub uncache_myself {
+ my $package = scalar caller;
+ # guess the registry class from the first two package segments
+ # XXX: this will break if someone creates a registry class which
+ # is not X::Y, but this function was written for the tests.
+ my($class) = $package =~ /([^:]+::[^:]+)/;
+ warn "cannot figure out class name from $package",
+ return unless defined $class;
+ no strict 'refs';
+ if (exists ${$class}->{$package} && exists ${$class}->{$package}{mtime}) {
+ delete ${$class}->{$package}{mtime};
+ }
+ else {
+ warn "cannot find ${class}->{$package}{mtime}";
+ }
+}
+
+#########################################################################
# func: is_cached
# dflt: is_cached
# desc: checks whether the package is already cached
@@ -651,8 +681,9 @@
my $r = $o->[REQ];
$o->debug("compiling $o->[FILENAME]") if DEBUG && D_COMPILE;
+
+ ModPerl::Global::special_list_clear(END => $o->[PACKAGE]);
- $r->clear_rgy_endav;
ModPerl::Util::untaint($$eval);
{
# let the code define its own warn and strict level
@@ -661,7 +692,6 @@
eval $$eval;
}
- $r->stash_rgy_endav;
return $o->error_check;
}
