view release on metacpan or  search on metacpan

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

	asp => $asp,
	'package' => $package,
#	filename => $filename,
#	id => $id,
    };

    # assign early, since something like compiling reference the global asa,
    # and we need to do that in here
    $asp->{GlobalASA} = $self;

    $asp->{dbg} && $asp->Debug("GlobalASA package $self->{'package'}");
    my $compiled = $Apache::ASP::Compiled{$id};
    if($compiled && ! $asp->{stat_scripts}) {

#	$asp->{dbg} && $asp->Debug("no stat: GlobalASA already compiled");
	$self->{'exists'} = $compiled->{'exists'};
	$self->{'compiled'} = $compiled; # for event lookups
	return $self;
    }

    if($compiled) {
#	$asp->{dbg} && $asp->Debug("global.asa was cached for $id");
    } else {
	$asp->{dbg} && $asp->Debug("global.asa was not cached for $id");
	$compiled = $Apache::ASP::Compiled{$id} = { mtime => 0, 'exists' => 0 };
    }
    $self->{compiled} = $compiled;
    
    my $exists = $self->{'exists'} = -e $filename;
    my $changed = 0;
    if(! $exists && ! $compiled->{'exists'}) {
	# fastest exit for simple case of no global.asa
	return $self;
    } elsif(! $exists && $compiled->{'exists'}) {
	# if the global.asa disappeared
	$changed = 1;
    } elsif($exists && ! $compiled->{'exists'}) {
	# if global.asa reappeared
	$changed = 1;
    } else {
	$self->{mtime} = $exists ? (stat(_))[9] : 0;
	if($self->{mtime} > $compiled->{mtime}) {
	    # if the modification time is greater than the compile time
	    $changed = 1;
	}
    }
    $changed || return($self);

    my $code = $exists ? ${$asp->ReadFile($filename)} : "";
    my $strict = $asp->{use_strict} ? "use strict" : "no strict";

    if($code =~ s/\<script[^>]*\>((.*)\s+sub\s+($match_events).*)\<\/script\>/$1/isg) {
	$asp->Debug("script tags removed from $filename for IIS PerlScript compatibility");
    }
    $code = (
	     "\n#line 1 $filename\n".
	     join(" ;; ",
		  "package $self->{'package'};",
		  $strict,
		  "use vars qw(\$".join(" \$",@Apache::ASP::Objects).');',
		  "use lib qw($self->{asp}->{global});",
		  $code,
		  'sub exit { $main::Response->End(); } ',
		  "no lib qw($self->{asp}->{global});",
		  '1;',
		 )
	     );

    $asp->{dbg} && $asp->Debug("compiling global.asa $self->{'package'} $id exists $exists", $self, '---', $compiled);
    $code =~ /^(.*)$/s;
    $code = $1;

    # turn off $^W to suppress warnings about reloading subroutines
    # which is a valid use of global.asa.  We cannot just undef 
    # all the events possible in global.asa, as global.asa can be 
    # used as a general package library for the web application
    # --jc, 9/6/2002
    local $^W = 0;

    # only way to catch strict errors here    
    if($asp->{use_strict}) { 
	local $SIG{__WARN__} = sub { die("maybe use strict error: ", @_) };
	eval $code;
    } else {
	eval $code;
    }

    # if we have success compiling, then update the compile time
    if(! $@) {
	# if file mod times are bad, we need to use them anyway
	# for relative comparison, time() was used here before, but
	# doesn't work
	$compiled->{mtime} = $self->{mtime} || (stat($filename))[9];
	
	# remember whether the file really exists
	$compiled->{'exists'} = $exists;
	
	# we cache whether the code was compiled so we can do quick
	# lookups before executing it
	my $routines = {};
	local *stash = *{"$self->{'package'}::"};
	for(@Routines) {
	    if($stash{$_}) {
		$routines->{$_} = 1;
	    }
	}
	$compiled->{'routines'} = $routines;
	$asp->Debug('global.asa routines', $routines);
	$self->{'compiled'} = $compiled;
    } else {
	$asp->CompileErrorThrow($code, "errors compiling global.asa: $@");
    }

    $self;
}

sub IsCompiled {
    my($self, $routine) = @_;
    $self->{'compiled'}{routines}{$routine};
}