#
# /*
# * *********** WARNING **************
# * This file generated by ModPerl::WrapXS/0.01
# * Any changes made here will be lost
# * ***********************************
# * 01: lib/ModPerl/Code.pm:709
# * 02: lib/ModPerl/WrapXS.pm:626
# * 03: lib/ModPerl/WrapXS.pm:1175
# * 04: Makefile.PL:423
# * 05: Makefile.PL:325
# * 06: Makefile.PL:56
# */
#
package ModPerl::Util;
use strict;
use warnings FATAL => 'all';
use Apache2::XSLoader ();
our $VERSION = '2.000004';
Apache2::XSLoader::load __PACKAGE__;
#Extra stuff
our $DEFAULT_UNLOAD_METHOD ||= "unload_package_pp";
sub unload_package {
goto &$DEFAULT_UNLOAD_METHOD;
}
sub unload_package_pp {
my $package = shift;
no strict 'refs';
my $tab = \%{ $package . '::' };
# below we assign to a symbol first before undef'ing it, to avoid
# nuking aliases. If we undef directly we may undef not only the
# alias but the original function as well
for (keys %$tab) {
#Skip sub stashes
next if /::$/;
my $fullname = join '::', $package, $_;
# code/hash/array/scalar might be imported make sure the gv
# does not point elsewhere before undefing each
if (%$fullname) {
*{$fullname} = {};
undef %$fullname;
}
if (@$fullname) {
*{$fullname} = [];
undef @$fullname;
}
if ($$fullname) {
my $tmp; # argh, no such thing as an anonymous scalar
*{$fullname} = \$tmp;
undef $$fullname;
}
if (defined &$fullname) {
no warnings;
local $^W = 0;
if (defined(my $p = prototype $fullname)) {
*{$fullname} = eval "sub ($p) {}";
}
else {
*{$fullname} = sub {};
}
undef &$fullname;
}
if (*{$fullname}{IO}) {
local $@;
eval {
if (fileno $fullname) {
close $fullname;
}
};
}
}
#Wipe from %INC
$package =~ s[::][/]g;
$package .= '.pm';
delete $INC{$package};
}
1;
__END__
=head1 NAME
ModPerl::Util - Helper mod_perl Functions
=head1 Synopsis
use ModPerl::Util;
# e.g. PerlResponseHandler
$callback = ModPerl::Util::current_callback;
# exit w/o killing the interpreter
ModPerl::Util::exit();
# untaint a string (do not use it! see the doc)
ModPerl::Util::untaint($string);
# removes a stash (.so, %INC{$stash}, etc.) as best as it can
ModPerl::Util::unload_package($stash);
# current perl's address (0x92ac760 or 0x0 under non-threaded perl)
ModPerl::Util::current_perl_id();
=head1 Description
C provides mod_perl utilities API.
=head1 API
C provides the following functions and/or methods:
=head2 C
Returns the currently running callback name,
e.g. C<'PerlResponseHandler'>.
$callback = ModPerl::Util::current_callback();
=over 4
=item ret: C<$callback> ( string )
=item since: 2.0.00
=back
=head2 C
Return the memory address of the perl interpreter
$perl_id = ModPerl::Util::current_perl_id();
=over 4
=item ret: C<$perl_id> ( string )
Under threaded perl returns something like: C<0x92ac760>
Under non-thread perl returns C<0x0>
=item since: 2.0.00
=back
Mainly useful for debugging applications running under threaded-perl.
=head2 C
Terminate the request, but not the current process (or not the current
Perl interpreter with threaded mpms).
ModPerl::Util::exit($status);
=over 4
=item opt arg1: C<$status> ( integer )
The exit status, which as of this writing is ignored. (it's accepted
to be compatible with the core C function.)
=item ret: no return value
=item since: 2.0.00
=back
Normally you will use the plain C in your code. You don't need
to use C explicitly, since mod_perl overrides
C by setting C to
C. Only if you redefine C
once mod_perl is running, you may want to use this function.
The original C is still available via C.
C is implemented as a special C call,
therefore if you call it inside C or C,
while an exception is being thrown, it is caught by C. For
example:
exit;
print "Still running";
will not print anything. But:
eval {
exit;
}
print "Still running";
will print I. So you either need to check whether L is specific to C and call
C again:
use ModPerl::Const -compile => 'EXIT';
eval {
exit;
}
exit if $@ && ref $@ eq 'APR::Error' && $@ == ModPerl::EXIT;
print "Still running";
or use C:
eval {
CORE::exit;
}
print "Still running";
and nothing will be printed. The problem with the latter is the
current process (or a Perl Interpreter) will be killed; something that
you really want to avoid under mod_perl.
=head2 C
Unloads a stash from the current Perl interpreter in the safest way
possible.
ModPerl::Util::unload_package($stash);
=over 4
=item arg1: C<$stash> ( string )
The Perl stash to unload. e.g. C.
=item ret: no return value
=item since: 2.0.00
=back
Unloading a Perl stash (package) is a complicated business. This
function tries very hard to do the right thing. After calling this
function, it should be safe to C