home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / Load.pm < prev    next >
Encoding:
Perl POD Document  |  2003-07-09  |  3.6 KB  |  152 lines
  1. package Apache::ASP::Load;
  2.  
  3. use Apache::ASP;
  4. use Apache::ASP::CGI::Table;
  5.  
  6. use strict;
  7. no strict qw(refs);
  8. use vars qw(@Days @Months $AUTOLOAD $LOADED $COUNT);
  9. @Days = qw(Sun Mon Tue Wed Thu Fri Sat);
  10. @Months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
  11.  
  12. # we need a different class from Apache::ASP::CGI because we don't
  13. # want to force use of CGI & Class::Struct when loading ASP in Apache
  14. # also a nasty bug doesn't allow us to eval require's or use's, we 
  15. # get a can't start_mutex
  16.  
  17. sub new {
  18.     my($file) = @_;
  19.     bless {
  20.     current_callback => 'PerlHandler',
  21.     filename => $file,
  22.     remote_ip => '127.0.0.1',
  23.     user => undef,
  24.     method => 'GET',
  25.     NoState => 1,
  26.     headers_in     => Apache::ASP::CGI::Table->new,
  27.     headers_out    => Apache::ASP::CGI::Table->new,
  28.     dir_config     => Apache::ASP::CGI::Table->new,
  29.     subprocess_env => Apache::ASP::CGI::Table->new,
  30.     };
  31. }
  32.  
  33. sub AUTOLOAD {
  34.     $AUTOLOAD =~ s/^(.*)::([^:]*)$/$2/;
  35.     shift->{$AUTOLOAD};
  36. }
  37.  
  38. sub log_error { 
  39.     shift; 
  40.     my @times = localtime;
  41.     printf STDERR ('[%s %s %02d %02d:%02d:%02d %d] [error] %s'."\n",
  42.            $Days[$times[6]],
  43.            $Months[$times[4]],
  44.            $times[3],
  45.            $times[2],
  46.            $times[1],
  47.            $times[0],
  48.            $times[5] + 1900,
  49.            join('', @_),
  50.            );
  51. }
  52.  
  53. sub connection { shift; }
  54.  
  55. sub Run {
  56.     shift if(ref $_[0] or $_[0] eq 'Apache::ASP');
  57.  
  58.     local $SIG{__WARN__} = \&Apache::ASP::Warn;
  59.     my($file, $match, %args) = @_;
  60.     unless(-e $file) {
  61.     warn("$file does not exist for loading");
  62.     return;
  63.     }
  64.     $match ||= '.*'; # compile all by default
  65.  
  66.     # recurse down directories and compile the scripts
  67.     if(-d $file && ! -l $file) {
  68.     $file =~ s|/$||;
  69.     opendir(DIR, $file) || die("can't open $file for reading: $!");
  70.     my @files = readdir(DIR);
  71.     close DIR;
  72.     unless(@files) {
  73.         Apache::ASP::Load->log_error("[asp] $$ [WARN] can't read files in $file");
  74.         return;
  75.     }
  76.  
  77.     my $top;
  78.     if(! defined $LOADED) {
  79.         $top = 1;
  80.     }
  81.     defined $LOADED or (local $LOADED = 0);
  82.     defined $COUNT or (local $COUNT = 0);
  83.     
  84.     for(@files) {
  85.         chomp;
  86.         next if /^\.\.?$/;
  87.         &Run("$file/$_", $match, %args);
  88.     }
  89.     if($top) {
  90.         Apache::ASP::Load->log_error("[asp] $$ (re)compiled $LOADED scripts of $COUNT loaded for $file");
  91.     }
  92.     return;
  93.     } 
  94.  
  95.     # now the real work
  96.     unless($file =~ /$match/) {
  97.     if($args{Debug} and $args{Debug} < 0) {
  98.         Apache::ASP::Load->log_error("skipping compile of $file no match $match");
  99.     }
  100.  
  101.     return;
  102.     }
  103.  
  104.     unless($file =~ /$match/) {
  105.        if($args{Debug} < 0) {
  106.            warn("skipping compile of $file no match $match");
  107.        }
  108.        return;
  109.     }
  110.  
  111.     my $r = Apache::ASP::Load::new($file);
  112.     for my $key ( 
  113.          qw( Debug StatINC StatINCMatch ), 
  114.          @{Apache::ASP->CompileChecksumKeys} 
  115.         ) 
  116.       {
  117.       $r->dir_config->set($key, $args{$key});
  118.       }
  119.     $r->dir_config->set('NoState', 1);
  120.  
  121.     # RegisterIncludes created for precompilation, on by default here
  122.     $r->dir_config->set('RegisterIncludes', 1);
  123.     if ((defined $args{'RegisterIncludes'})) {
  124.     $r->dir_config->set('RegisterIncludes', $args{'RegisterIncludes'});
  125.     }
  126.  
  127.     eval {
  128.     $COUNT++;
  129.     my $asp = Apache::ASP->new($r);    
  130.  
  131.     # if StatINC* is configured, run on first script
  132.     if(($COUNT == 1) && ($asp->config('StatINC') || $asp->config('StatINCMatch'))) {
  133.         $asp->StatINC;
  134.     }
  135.  
  136.     my $rv = $asp->CompileInclude($asp->{'basename'})
  137.       || die($@);
  138.  
  139.     if($args{'Execute'}) {
  140.         local *Apache::ASP::Response::Flush = sub {};
  141.         $asp->Run;
  142.     }
  143.     $asp->DESTROY;
  144.     $LOADED++;
  145.     };
  146.     $@ && warn($@);
  147.  
  148.     return $LOADED;
  149. }
  150.  
  151. 1;
  152.