view release on metacpan or  search on metacpan

lib/Apache/ASP/StatINC.pm  view on Meta::CPAN

package Apache::ASP;

# quickly decomped out of Apache::ASP just to optionally load
# it at runtime for CGI programs ( which shouldn't need it anyway )
# will still precompile this for mod_perl

use strict;
use vars qw( $StatINCReady $StatINCInit %Stat $StatStartTime );

$StatStartTime = time();

# Apache::StatINC didn't quite work right, so writing own
sub StatINCRun {
    my $self = shift;
    my $stats = 0;

    # include necessary libs, without nice error message...
    # we only do this once if successful, to speed up code a bit,
    # and load success bool into global. otherwise keep trying
    # to generate consistent error messages
    unless($StatINCReady) {
	my $ready = 1;
	for('Devel::Symdump') {
	    eval "use $_";
	    if($@) {
		$ready = 0;
		$self->Error("You need $_ to use StatINC: $@ ... ".
			     "Please download it from your nearest CPAN");
	    }
	}
	$StatINCReady = $ready;
    }
    return unless $StatINCReady;
    
    # make sure that we have pre-registered all the modules before
    # this only happens on the first request of a new process
    unless($StatINCInit) {
	$StatINCInit = 1;
	$self->Debug("statinc init");
	$self->StatRegisterAll();	
    }

    while(my($key,$file) = each %INC) {
	if($self->{stat_inc_match} && defined $Stat{$file}) {
	    # we skip only if we have already registered this file
	    # we need to register the codes so we don't undef imported symbols
	    next unless ($key =~ /$self->{stat_inc_match}/);
	}

	next unless (-e $file); # sometimes there is a bad file in the %INC
	my $mtime = (stat($file))[9];

	# its ok if this block is CPU intensive, since it should only happen
	# when modules get changed, and that should be infrequent on a production site
	if(! defined $Stat{$file}) {
	    $self->{dbg} && $self->Debug("loading symbols first time", { $key => $file});
	    $self->StatRegister($key, $file, $mtime);	    
	} elsif($mtime > $Stat{$file}) {
	    $self->{dbg} && $self->Debug("reloading", {$key => $file});
	    $stats++; # count files we have reloaded
	    $self->StatRegisterAll();
	    
	    # we need to explicitly re-register a namespace that 
	    # we are about to undef, in case any imports happened there
	    # since last we checked, so we don't delete duplicate symbols
	    $self->StatRegister($key, $file, $mtime);

	    my $class = &File2Class($key);
	    my $sym = Devel::Symdump->new($class);

	    my $function;
	    my $is_global_package = $class eq $self->{GlobalASA}{'package'} ? 1 : 0;
	    my @global_events_list = $self->{GlobalASA}->EventsList;

	    for $function ($sym->functions()) {
		my $code = \&{$function};

		if($function =~ /::O_[^:]+$/) {
		    $self->Debug("skipping undef of troublesome $function");
		    next;
		}

		if($Apache::ASP::Codes{$code}{count} > 1) {
		    $self->Debug("skipping undef of multiply defined $function: $code");
		    next;
		}

		if($is_global_package) {
		    # skip undef if id is an include or script 
		    if($function =~ /::__ASP_/) {
			$self->Debug("skipping undef compiled ASP sub $function");
			next;
		    }

		    if(grep($function eq $class."::".$_, @global_events_list)) {
			$self->Debug("skipping undef global event $function");
			next;
		    }

		    if($Apache::ASP::ScriptSubs{$function}) {
			$self->Debug("skipping undef script subroutine $function");
			next;
		    }

		}

		$self->{dbg} && $self->Debug("undef code $function: $code");

		undef(&$code); # method for perl 5.6.1
		delete $Apache::ASP::Codes{$code};
		undef($code);  # older perls