File Coverage

blib/lib/Apache/ASP.pm

Criterion	Covered	Total	%
statement	791	1088	72.7
branch	317	568	55.8
condition	91	189	48.1
subroutine	85	100	85.0
pod	5	45	11.1
total	1289	1990	64.7

# For documentation for this module, please see the end of this file
# or try `perldoc Apache::ASP`

package Apache::ASP;

$VERSION = 2.62;

#require DynaLoader;
#@ISA = qw(DynaLoader);
#bootstrap Apache::ASP $VERSION;

use Digest::MD5 qw(md5_hex);
use Cwd qw(cwd);

# create multiple entries for this symbols for StatINC
use Fcntl qw(:flock O_RDWR O_CREAT);

# load these always, but only load ::State, ::Session, ::Application
# at runtime in non mod_perl environments since they may not be needed
use Apache::ASP::GlobalASA;
use Apache::ASP::Response;
use Apache::ASP::Request;
use Apache::ASP::Server;
use Apache::ASP::Date;
use Apache::ASP::Lang::PerlScript;

use Carp qw(confess cluck);

use strict;
no strict qw(refs);
use vars qw($VERSION
	    %NetConfig %LoadedModules %LoadModuleErrors
	    %Codes %includes %Includes %CompiledIncludes
	    @Objects %Register %XSLT
	    $ServerID $ServerPID $SrandPid
            $CompileErrorSize $CacheSize @CompileChecksumKeys
	    %ScriptLanguages $ShareDir $INCDir $AbsoluteFileMatch
            $QuickStartTime
            $SessionCookieName
            $LoadModPerl
            $ModPerl2
	   );

# other common modules load now, these are optional though, so we do not error upon failure
# just do this once perl mod_perl parent startup
unless($LoadModPerl++) {
    my @load_modules = qw( Config lib Time::HiRes );
    if($ENV{MOD_PERL}) {
	# Only pre-load these if in a mod_perl environment for sharing memory post fork.
	# These will not be loaded then for CGI until absolutely necessary at runtime
	push(@load_modules, qw(
          mod_perl
          MLDBM::Serializer::Data::Dumper Devel::Symdump CGI
          Apache::ASP::StateManager Apache::ASP::Session Apache::ASP::Application
          Apache::ASP::StatINC Apache::ASP::Error
          )
	    );
    }

    for my $module ( @load_modules ) {
         eval "use $module ();";
    }

    if(exists $ENV{MOD_PERL_API_VERSION}) {
	if($ModPerl2 = ($ENV{MOD_PERL_API_VERSION} >= 2)) {
	    if($ModPerl2) {
		eval "use Apache::ASP::ApacheCommon ();";
		die($@) if $@;
	    }
	}
    }
}

## HEADER TOKEN TWEAK
# This must be called outside the above load module block, so that
# its gets run whenever this module is loaded
# This didn't work in 1.27 mod_perl, with DSO enabled, would
# put the Apache::ASP token in front.
# eval {     &Apache::add_version_component("Apache::ASP/$VERSION"); };
# $Apache::Server::AddPerlVersion = 1;

#use integer; # don't use screws up important numeric logic

@Objects = ('Application', 'Session', 'Response', 'Server', 'Request');
map { eval "sub $_ { shift->{$_} }" } @Objects;

# use regexp directly, not sub for speed
$AbsoluteFileMatch = '^(/|[a-zA-Z]:)';
$CacheSize = 1024*1024*10;
$SessionCookieName = 'session-id';

# ServerID creates a unique identifier for the server
srand();
$ServerID = substr(md5_hex($$.rand().time().(-M('..')||'').(-M('/')||'')), 0, 16);
$ServerPID  = $$;

# DEFAULT VALUES
$Apache::ASP::CompileErrorSize = 500;
@CompileChecksumKeys = qw ( Global DynamicIncludes UseStrict XMLSubsMatch XMLSubsPerlArgs XMLSubsStrict GlobalPackage UniquePackages IncludesDir InodeNames PodComments );

%ScriptLanguages = (
		    'PerlScript' => 1,
		   );

&InitPaths();

%Apache::ASP::LoadModuleErrors =
  (
   'Filter' =>
   "Apache::Filter was not loaded correctly for using SSI filtering.  ".
   "If you don't want to use filtering, make sure you turn the Filter ".
   "config option off whereever it's being used",

   Clean => undef,

   CreateObject =>
   'OLE-active objects not supported for this platform, '.
   'try installing Win32::OLE',

    Gzip =>
   'Compress::Zlib is needed to make gzip content-encoding work, '.
   'If you want to use this feature, get yourself the latest '.
   'Compress::Zlib from CPAN. ',

   HiRes => undef,

   FormFill =>
   'HTML::FillInForm is needed to use the FormFill feature '.
   'for auto filling forms with $Response->Form() data',

   MailAlert => undef,

   SendMail => "No mailing support",

   StateDB =>
   'cannot load StateDB '.
   'must be a valid perl module with a db tied hash interface '.
   'such as: SDBM_File (default), or DB_File',

   StateSerializer =>
   'cannot load StateSerializer '.
   'must be a valid serializing perl module for use with MLDBM '.
   'such as Data::Dumper (default), or Storable',

   StatINC => "You need this module for StatINC, please download it from CPAN",

   'Cache' => "You need this module for xml output caching",

   XSLT => 'Cannot load XML::XSLT.  Try installing the module.',

  );


sub handler {
    my($package, $r) = @_;
    my $status = 200;

    # allows it to be called as an object method
    ref $package and $r = $package;

    # default to Apache request object if not passed in, for possible DSO fix
    # rarely happens, but just in case
    my $filename;
    unless($filename = eval { $r->filename }) {
        my $rtest = $ModPerl2 ? Apache2::RequestUtil->request() : Apache->request();
	if($filename = eval { $rtest->filename }) {
	    $r = $rtest;
	} else {
	    return &DSOError($rtest);
	}
    }

    # better error checking ?
    $filename ||= $r->filename();
    # using _ is optimized to use last stat() record
    return(404) if (! -e $filename or -d _);

    # alias $0 to filename, bind to glob for bug workaround
    local *0 = \$filename;

    # ASP object creation, a lot goes on in there!
    # method call used for speed optimization, as OO calls are slow
    my $self = &Apache::ASP::new('Apache::ASP', $r, $filename);

    # for runtime use/require library loads from global/INCDir
    # do this in the handler section to cover all the execution stages
    # following object set up as possible.
    local @INC = ($self->{global}, $INCDir, @INC);

    # Execute if no errors
    $self->{errs} || &Run($self);

    # moved print of object to the end, so we'll pick up all the
    # runtime config directives set while the code is running

    $self->{dbg} && $self->Debug("ASP Done Processing $self", $self );

    # error processing
    if($self->{errs}) {
	require Apache::ASP::Error;
	$status = $self->ProcessErrors;
    }

    # XX return code of 302 hangs server on WinNT
    # STATUS hook back to Apache
    my $response = $self->{Response};
    if($status != 500 and defined $response->{Status} and $response->{Status} != 302) {
	# if still default then set to what has been set by the
	# developer
	$status = $response->{Status};
    }

    # X: we DESTROY in register_cleanup, but if we are filtering, and we
    # handle a virtual request to an asp app, we need to free up the
    # the locked resources now, or the session requests will collide
    # a performance hack would be to share an asp object created between
    # virtual requests, but don't worry about it for now since using SSI
    # is not really performance oriented anyway.
    #
    # If we are not filtering, we let RegisterCleanup get it, since
    # there will be a perceived performance increase on the client side
    # since the connection is terminated before the garabage collection is run.
    #
    # Also need to destroy if we return a 500, as we could be serving an
    # error doc next, before the cleanup phase

    if($self->{filter} || ($status == 500) || ( $r->isa('Apache::ASP::CGI'))) {
	$self->DESTROY();
    }

    if($status eq '200') {
	$status = 0; # OK status code is default unless there was an internal error
    }

    $status;
}

sub Warn {
    shift if(ref($_[0]) or $_[0] eq 'Apache::ASP');
    print STDERR "[ASP WARN] ", @_;
}

sub new {
    my($class, $r, $filename) = @_;
    $r || die("need Apache->request() object to Apache::ASP->new(\$r)");

    # $StartTime is set by asp-perl early on before modules are loaded
    # for more accurate per time tracking.  Unset, so this init load time does
    # not get used more than once.
    my $start_time;
    if($QuickStartTime) {
	$start_time = $QuickStartTime;
	$QuickStartTime = undef;
    } else {
	$start_time = eval { &Time::HiRes::time(); } || time();
    }

    local $SIG{__DIE__} = \&Carp::confess;
    # like cgi, operate in the scripts directory
    $filename ||= $r->filename();
    $filename =~ m|^(.*?[/\\]?)([^/\\]+)$|;
    my $dirname = $1 || '.';
    my $basename = $2;
    chdir($dirname) || die("can't chdir to $dirname: $!");

    # temp object just to call config() on, do not bless since we
    # do not want the object to be DESTROY()'d
    my $dir_config = $r->dir_config;
    my $headers_in = $r->headers_in;
    my $self = { r => $r, dir_config => $dir_config };

    # global is the default for the state dir and also
    # a default lib path for perl, as well as where global.asa
    # can be found
    my $global = &get_dir_config($dir_config, 'Global') || '.';
    $global = &AbsPath($global, $dirname);

    # asp object is handy for passing state around
    $self = bless
      {
       'basename'       => $basename,
       'cleanup'        => [],
       'dbg'            => &get_dir_config($dir_config, 'Debug') || 0,  # debug level
       'destroy'        => 1,
       'dir_config'     => $dir_config,
       'headers_in'     => $headers_in,
       filename         => $filename,
       global           => $global,
       global_package   => &get_dir_config($dir_config, 'GlobalPackage'),
       inode_names      => &get_dir_config($dir_config, 'InodeNames'),
       no_cache         => &get_dir_config($dir_config, 'NoCache'),
       'r'              => $r, # apache request object
       start_time       => $start_time,
       stat_scripts     => &config($self, 'StatScripts', undef, 1),
       stat_inc         => &get_dir_config($dir_config, 'StatINC'),
       stat_inc_match   => &get_dir_config($dir_config, 'StatINCMatch'),
       use_strict       => &get_dir_config($dir_config, 'UseStrict'),
       win32            => ($^O eq 'MSWin32') ? 1 : 0,
       xslt             => &get_dir_config($dir_config, 'XSLT'),
      }, $class;

    # Only if debug is negative do we kick out all the internal stuff
    if($self->{dbg}) {
	if($self->{dbg} < 0) {
	    *Debug = *Out;
	    $self->{dbg} = -1 * $self->{dbg};
	} else {
	    *Debug = *Null;
	}
	$self->Debug('RUN ASP (v'. $VERSION .") for $self->{filename}");

    } else {
	*Debug = *Null;
    }

    # Ken said no need for seed ;), now we just make sure its called post fork
    # Patch from Ime suggested no need for %SrandPid, just srand() again when $$ has changed
    unless($SrandPid && $SrandPid == $$) {
	$self->{dbg} && $self->Debug("call srand() post fork");
	srand();
	$SrandPid = $$;
    }

    # filtering support
    my $filter_config = &get_dir_config($dir_config, 'Filter');
    if($filter_config) {
        if($self->LoadModules('Filter', 'Apache::Filter')) {
	    # new filter_register with Apache::Filter 1.013
	    if($r->can('filter_register')) {
		$self->{r} = $r = $r->filter_register;
	    }

	    if ($r->can('filter_input') && $r->can('get_handlers')) {
		$self->{filter} = 1;
		#X: do something with the return code, can't now because
		# apache constants aren't working on my win32
		my($fh, $rc) = $r->filter_input();
		$self->{filehandle} = $fh;
	    }
	} else {
	    if(! $r->can('get_handlers')) {
		$self->Error("You need at least mod_perl 1.16 to use SSI filtering");
	    } else {
		$self->Error("Apache::Filter was not loaded correctly for using SSI filtering.  ".
			     "If you don't want to use filtering, make sure you turn the Filter ".
			     "config option off whereever it's being used");
	    }
	}
    }

    # gzip content encoding option by [e-mail] 28/4/2000
    my $compressgzip_config = &get_dir_config($dir_config, 'CompressGzip');
    if($compressgzip_config) {
	if($self->LoadModule('Gzip','Compress::Zlib')) {
	    $self->{compressgzip} = 1;
	}
    }

    # must have global directory into which we put the global.asa
    # and possibly state files, optimize out the case of . or ..
    if($self->{global} !~ /^(\.|\.\.)$/) {
	-d $self->{global} or
	  $self->Error("global path, $self->{global}, is not a directory");
    }

    # includes_dir calculation
    if($filename =~ m,^((/|[a-zA-Z]:).*[/\\])[^/\\]+?$,) {
	$self->{dirname} = $1;
    } else {
	$self->{dirname} = '.';
    }
    $self->{includes_dir} = [
			     $self->{dirname},
			     $self->{global},
			     split(/;/, &config($self, 'IncludesDir') || ''),
			    ];

    # register cleanup before the state files get set in InitObjects
    # this way DESTROY gets called every time this script is done
    # we must cache $self for lookups later
    &RegisterCleanup($self, sub { $self->DESTROY });

    #### WAS INIT OBJECTS, REMOVED DECOMP FOR SPEED

    # GLOBALASA, RESPONSE, REQUEST, SERVER
    # always create these
    # global_asa assigns itself to parent object automatically
    my $global_asa = &Apache::ASP::GlobalASA::new($self);
    $self->{Request}   = &Apache::ASP::Request::new($self);
    $self->{Response}  = &Apache::ASP::Response::new($self);
    # Server::new() is just one line, so execute directly
    $self->{Server}    = bless {asp => $self}, 'Apache::ASP::Server';
    #&Apache::ASP::Server::new($self);

    # After GlobalASA Init, init the package that this script will execute in
    # must be here, and not end of new before things like Application_OnStart get run
    # UniquePackages & NoCache configs do not work together, NoCache wins here
    if(&config($self, 'UniquePackages')) {
	# id is not generally useful for the ASP object now, so calculate
	# it here now, only to twist the package object for this script

	# pass in basename for where to find the file for InodeNames, and the full path
	# for the FileId otherwise
	my $package = $global_asa->{'package'}.'::'.&FileId($self, $self->{basename}, $self->{filename});
	$self->{'package'} = $package;
	$self->{init_packages} = ['main', $global_asa->{'package'}, $self->{'package'}];
    } else {
	$self->{'package'} = $global_asa->{'package'};
	$self->{init_packages} = ['main', $global_asa->{'package'}];
    }

    $self->{state_dir}   = &config($self, 'StateDir', undef, $self->{global}.'/.state');
    $self->{state_dir}   =~ tr///; # untaint

    # if no state has been config'd, then set up none of the
    # state objects: Application, Internal, Session
    unless(&get_dir_config($dir_config, 'NoState')) {
	# load at runtime for CGI environments, preloaded for mod_perl
	require Apache::ASP::StateManager;
	&InitState($self);
    }

    $self;
}

# called upon every end of connection by RegisterCleanup
sub DESTROY {
    my $self = shift;

    return unless $self->{destroy}; # still active object
    $self->{dbg} && $self->Debug("destroying ASP object $self");

    # do before undef'ing the object references in main
    for my $code ( @{$self->{cleanup}} ) {
	$self->{dbg} && $self->Debug("executing cleanup $code");
	eval { &$code() };
	$@ && $self->Error("executing cleanup $code error: $@");
    }

    local $^W = 0; # suppress untie while x inner references warnings
    select(STDOUT);
    untie *RESPONSE if tied *RESPONSE;

    # can't move this to Request::DESTROY(), then CGI object compatibility
    # in test ./site/eg/cgi.htm test fails, don't know why, --jc, 12/06/2002
    untie *STDIN if tied *STDIN;

    # in case there is a dummy session here by the
    # end of object execution
    if($self->{Session}) {
        if(eval { $self->{Session}->isa('Apache::ASP::Session') }) {
	    # only the cleanup master may cleanup groups now, so OK
	    # to call just CleanupGroups
	    $self->CleanupGroups();
	} else {
            $self->Debug("$self->{Session} is not an Apache::ASP::Session");
            eval { $self->{Session}->DESTROY };
            $self->{Session} = undef;
        }
    }

    # free file handles here.  mod_perl tends to be pretty clingy
    # to memory
    for('Application', 'Internal', 'Session') {
	# all this stuff in here is very necessary for total cleanup
	# the DESTROY is the most important, as we need to explicitly free
	# state objects, just in case anyone else is keeping references to them
	# But the destroy won't work without first untieing, go figure
	next unless defined $self->{$_};
	my $tied = tied %{$self->{$_}};
	next unless $tied;
	untie %{$self->{$_}};
	$tied->DESTROY(); # call explicit DESTROY
    }

    if(my $caches = $self->{Caches}) {
	# default cache size to 10M
	$self->{cache_size} = &config($self, 'CacheSize') || $CacheSize;
	if($self->{cache_size} =~ /^([\d\.]+)(M|K|B)?$/) {
	    my($size, $unit) = ($1, $2);
	    if($unit eq 'M') {
		$size *= 1024*1024;
	    } elsif($unit eq 'K') {
		$size *= 1024;
	    }
	    if($size ne $self->{cache_size}) {
		$self->{dbg} && $self->Debug("converting CacheSize $self->{cache_size} to $size bytes");
		$self->{cache_size} = $size;
	    }
	}
	for my $cache (values %$caches) {
	    my $tied = $cache;
	    if($tied->{writes} && $tied->Size > $self->{cache_size}) {
		$self->{dbg} && $self->Debug("deleting cache $cache, size: ".$tied->Size);
		$tied->Delete;
	    } else {
		$self->{dbg} && $self->Debug("cache $cache OK size, size: ".$tied->Size);
	    }
	    $tied->DESTROY();
	}
    }

    #    $self->{'dbg'} && $self->Debug("END ASP DESTROY");
    $self->{Request} && &Apache::ASP::Request::DESTROY($self->{Request});
    $self->{Server} && ( %{$self->{Server}} = () );
    $self->{Response} && ( %{$self->{Response}} = () );
    %$self = ();

    1;
}

sub RegisterCleanup {
    my $self = shift;

    if($ModPerl2) {
	$self->{r}->pool->cleanup_register(@_);
    } else {
	$self->{r}->register_cleanup(@_);
    }
}

sub InitPaths {

    # we load this module just to detect where the shared directory really is
    use Apache::ASP::Share::CORE;

    # major problem with %INC if we cannot get this information
    my $share_path = $INC{'Apache/ASP/Share/CORE.pm'}
      || die(q(can't find path for $INC{'Apache/ASP/Share/CORE.pm'}));

    $share_path =~ s/CORE\.pm$//s;
    unless($share_path =~ /$AbsoluteFileMatch/) {
	# this %ENV manipulation is just to allow cwd() to run in taint check mode
	local %ENV = %ENV;
	$ENV{PATH} = '/bin:/usr/bin:/usr/sbin';
	delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
	my $currdir = cwd();
	$share_path = "$currdir/$share_path";
    }

    # not finding the ShareDir creates a hard error, because the Apache/ASP/Share
    # directory will become one of the fundamental underpinings of the project
    # People will need to rely on being able to load shared includes, and not have
    # to discover the lack of loading Share:: at runtime, rather this is a compile
    # time error.
    -d $share_path || die("Apache::ASP::Share directory not found.  ".
			  "Please make sure to install all the modules that make up the Apache::ASP installation."
			 );
    $ShareDir = $share_path;

    # once we find the $ShareDir, we can truncate the library path
    # and push it onto @INC with use lib... this is to help with loading
    # future Apache::ASP::* modules when the lib path it was found at is
    # relative to some directory.  This was needed to have the "make test"
    # test suite to work which loads libraries from "blib/lib", but Apache::ASP
    # will chdir() into the script directory so that can ruin this
    # library lookup.
    #
    my $lib_path = $share_path;
    $lib_path =~ s/Apache.ASP.Share.?$//s;
    -d $lib_path || die("\%INC library path $lib_path not found.");
    $INCDir = $lib_path;

    # clear taint, for some reason, tr/// or s/^(.*)$/ did not work on perl 5.6.1
    $INCDir =~ /^(.*)$/s;
    $INCDir = $1;

    # make sure this gets on @INC at startup, can't hurt
    eval "use lib qw($INCDir);";

    1;
}

sub FileId {
    my($self, $file, $abs_file, $no_compile_checksum) = @_;
    $file || die("no file passed to FileId()");
    my $id;

    # calculate compile checksum for file id
    unless($self->{compile_checksum}) {
	my $r = $self->{r};
	my $checksum = md5_hex(join('&-+',
				    $VERSION,
				    map { &config($self, $_) || '' }
				    @CompileChecksumKeys
				   )
			      );
	#    $self->{dbg} && $self->Debug("compile checksum $checksum");
	$self->{compile_checksum} = $checksum;
    }

    my $compile_checksum = $no_compile_checksum ? '' : $self->{compile_checksum};

    my @inode_stat = ();
    if($self->{inode_names}) {
	@inode_stat = stat($file);
	# one or the other device or file ids must be not 0
	unless($inode_stat[0] || $inode_stat[1]) {
	    @inode_stat = ();
	}
    }

    if(@inode_stat) {
	$id = sprintf("____DEV%X_INODE%X",@inode_stat[0,1]);
	$id .= 'x'.$compile_checksum;
    } else {
	if($abs_file) {
	    $file = $abs_file;
	}
	$file =~ s|/+|/|sg;
	$file =~ s/[\Wx]/_/sg;
	my $file_name_length = length($file);
	if($file_name_length >= 35) {
	    $id = substr($file, $file_name_length - 35, 36);
	    # only do the hex of the original file to create a unique identifier for the long id
	    $id .= 'x'.&md5_hex($file.$compile_checksum);
	} else {
	    $id = $file.'x'.$compile_checksum;
	}
    }

    $id = '__ASP_'.$id;
}

# defaults to parsing the script's file, or data from a file handle
# in the case of filtering, but we can also pass in text to parse,
# which is useful for doing includes separately for compiling
sub Parse {
    my($self, $file) = @_;
    my $file_exists = 0;
    my $parse_file = $file;
    my $r = $self->{r};
    my $data;

    # get script data, from varied data sources;
    $file || die("can't parse without file data");

    $self->{dbg} && $self->Debug("parse file $file");
    # file can be a filename, scalar ref, or scalar
    if(ref $file) {
	if ($file =~ /SCALAR/) {
	    $data = $$file;
	} elsif ($file =~ /GLOB/) {
	    local $/ = undef;
	    $data = <$file>
	}
    } elsif((length($file) < 1024) && ($file !~ /^GLOB/) && (-e $file)) {
	# filename has length < 1024, should be fine across OS's
	$self->{dbg} && $self->Debug("parsing $file");
	$data = ${$self->ReadFile($file)};
	$file_exists = 1;
	$self->{parse_file_count}++;
    } else {
	$data = $file; # raw script, no ref
    }

    # moved parsing config here since not needed for normal
    # eval execution of scripts after compilation
    unless($self->{parse_config}) {
	$self->{parse_config} = 1;
	$self->{compile_includes} = &config($self, 'DynamicIncludes');
	$self->{pod_comments} = &config($self, 'PodComments', undef, 1);
	$self->{xml_subs_strict} = &config($self, 'XMLSubsStrict');
	# default XMLSubsPerlArgs to 1 for now, until 3.0
	$self->{xml_subs_perl_args} = &config($self, 'XMLSubsPerlArgs', undef, 1);

	# reduce (pattern) patterns to (?:pattern) to not create $1 side effect
	if($self->{xml_subs_match} = &config($self, 'XMLSubsMatch')) {
	    $self->{xml_subs_match} =~ s/\(\?\:([^\)]*)\)/($1)/isg;
	    $self->{xml_subs_match} =~ s/\(([^\)]*)\)/(?:$1)/isg;
	}

	my $lang = &config($self, 'ScriptLanguage', undef, 'PerlScript');
	my $module = "Apache::ASP::Lang::".$lang;
	unless($ScriptLanguages{$lang}) {
#	    eval "use $module;";
	    $self->Error("ScriptLanguage for $lang could not be loaded: $@");
	    return;
	}
	eval {
	    my $lang_object = $module->new(ASP => $self);
	    $self->{lang_object} = $lang_object;
	    $self->{lang_module} = $module;
	    $self->{lang_language} = $lang;
	    $self->{lang_comment} = $lang_object->CommentStart;
	};
	if($@) {
	    $self->Error("ScriptLanguage object for $lang failed init: $@");
	    return;
	}
    }

    my $comment = $self->{lang_comment};
    if(&config($self, 'CgiDoSelf')) {
	$data =~ s,^(.*?)__END__,,so;
    }

    # do both before and after, so =pods can span includes with =pods
    if($self->{pod_comments}) {
	&PodComments($self, \$data);
    }

    # if compiling includes, then do now before includes conversion
    # each include will also have its Script_OnParse run on it.
    if($self->{compile_includes} && $self->{GlobalASA}{'exists'}) {
	$self->{Server}{ScriptRef} = \$data;
	$self->{GlobalASA}->ExecuteEvent('Script_OnParse');
    }

    # do includes as early as possible !! so included text gets done too
    # this section is for file includes, we do this here instead of ssi
    # so it can be parsed and compiled with the script
    local %includes; # trap recursive includes with this

    # JUST ONCE
    # there should only be one of these, <%@ LANGUAGE="PerlScript" %>, rip it out
    # we keep white space and substitue text in so the perlscript sync's up with lines
    # only take out the first one
    $data =~ s/^\#\![^\n]+(\n\s*)/\<\%$1\%\>/s; #X cgi compat ?
    $data =~ s/^(\s*)\<\%(\s*)\@([^\n]*?)\%\>/$1\<\%$2 ; \%\>/so;

    my $root_file = $file;
    my $line1_added = 0;
    my $munge = $data;
    $data = '';
    my($file_context, $file_line_number, $code_block);
    while($munge =~ s/^(.*?)\