I've run across a problem with UndefOnReload stomping on code
in mod_perl/1.21, which I believe affects mod_perl/1.22 as well.
I scanned through the mod_perl archives and found that others had
similar problems a while back, leading to Apache::StatINC and
Apache::Symbols::undef_function being modified so that they only
undefine exported functions.
However, it appears to me that the current code only works for
modules that do export functions, and not for those that do not.
Those that don't export functions still have all of their
functions (imported or otherwise) undefined.
Here's a summary of my problem and diagnosis... if you'd rather
cut to the chase, there's a patch at the end.
I'm using Apache::StatINC with UndefOnReload enabled. Whenever I
changed a particular module (Palm::DB), I would get Internal Server
Errors from any future requests along with the following error in my
logs:
[Tue Apr 11 13:45:12 2000] [error] Undefined subroutine &Palm::Template::error
called at /usr/local/lib/perl5/site_perl/5.005/Palm/Template.pm line 36.
I enabled StatINCDebug and verified that only Palm::DB was being
reloaded. I looked through the code and found
Apache::Symbol::undef_function(). I uncommented the warn within
it and saw the following in my logs:
...
[Tue Apr 11 13:45:22 2000] null: Palm::DB::update=CODE(0x2e5570)
[Tue Apr 11 13:45:22 2000] null: Palm::DB::build_menu=CODE(0x2dff68)
[Tue Apr 11 13:45:22 2000] null: Palm::DB::insert=CODE(0x2e3060)
[Tue Apr 11 13:45:22 2000] null: Palm::DB::get_row=CODE(0x2d9c3c)
[Tue Apr 11 13:45:22 2000] null: Palm::DB::get_table=CODE(0x2dfe54)
[Tue Apr 11 13:45:22 2000] null: Palm::DB::DESTROY=CODE(0x2eb418)
[Tue Apr 11 13:45:22 2000] null: Palm::DB::error=CODE(0x29f0b8)
...
[Tue Apr 11 13:45:22 2000] DB.pm: Apache::StatINC: process 20967 reloading Palm/DB.pm
The only problem is that there is no error() sub in Palm::DB.
It's exported by another module, Palm::Template. Palm::DB is
an object-oriented module that exports no functions, and
Palm::DB uses Palm::Template (which does export functions) for
error reporting. Thus Palm::Template was exporting error() as
Palm::DB::error(), which Apache::Symbol::undef_function() undefined
whenever I updated Palm::DB, causing problems. (...and anyone who
could follow this paragraph without rereading it deserves a prize)
Here's the code for Apache::Symbol::undef_functions()
(I'll use the code from 1.22, not 1.21; the only difference
is the addition of "defined" to the 4 $any_export_var tests.)
sub undef_functions {
my( $package, $skip, $only_undef_exports ) = @_;
my $stab = Devel::Symdump->rnew($package);
my @functions = $stab->functions;
if( $only_undef_exports ) {
no strict 'refs';
my $any_export_var;
$any_export_var = 1 if defined @{$package . "::EXPORT"};
$any_export_var = 1 if defined @{$package . "::EXPORT_OK"};
$any_export_var = 1 if defined %{$package . "::EXPORT_TAGS"};
$any_export_var = 1 if defined @{$package . "::EXPORT_EXTRAS"};
if( $any_export_var ) {
my @names = (@{$package . "::EXPORT"},
@{$package . "::EXPORT_OK"},
@{$package . "::EXPORT_EXTRAS"});
foreach my $tagdata (values %{$package . "::EXPORT_TAGS"}) {
push @names, @$tagdata;
}
my %exported = map { $package . "::" . $_ => 1 } @names;
@functions = grep( $exported{$_}, @functions );
}
}
for my $cv (@functions) {
no strict 'refs';
next if substr($cv, 0, 14) eq "Devel::Symdump";
next if $skip and $cv =~ /$skip/;
#warn "$cv=", *{$cv}{CODE}, "\n";
Apache::Symbol::undef(*{$cv}{CODE});
}
}
It appears to me that the following assignment:
@functions = grep( $exported{$_}, @functions );
should be outside the $any_export_var if block. Otherwise setting
$only_undef_exports only affects those modules that do export
functions.
Assuming that's right, here's a patch that seems to fix my
problem (generated against the 1.22 version):
--- Symbol.pm.orig Wed Apr 12 10:39:16 2000
+++ Symbol.pm Wed Apr 12 10:39:06 2000
@@ -30,6 +30,7 @@
$any_export_var = 1 if defined %{$package . "::EXPORT_TAGS"};
$any_export_var = 1 if defined @{$package . "::EXPORT_EXTRAS"};
+ my %exported;
if( $any_export_var ) {
my @names = (@{$package . "::EXPORT"},
@{$package . "::EXPORT_OK"},
@@ -37,9 +38,9 @@
foreach my $tagdata (values %{$package . "::EXPORT_TAGS"}) {
push @names, @$tagdata;
}
- my %exported = map { $package . "::" . $_ => 1 } @names;
- @functions = grep( $exported{$_}, @functions );
+ %exported = map { $package . "::" . $_ => 1 } @names;
}
+ @functions = grep( $exported{$_}, @functions );
}
for my $cv (@functions) {
Or let me know if I'm way off... thanks!
- Scott
