Listing 2: Apache MIME action filter filter.pl

#!/usr/bin/perl

use File::stat;

$| = 1;
print "Content-type: text/html\n\n";

SetScriptLang();

if ((! -e $Script ) || ((stat($Script)->mtime) < \
    (stat($InlineHTML)->mtime))) {
   UpdateCache();
}

ExportFormData();

system("chmod u+x $Script");
system("$Script");    
    
sub SetScriptLang {

   $InlineHTML=$ENV{"PATH_TRANSLATED"};
   $PathInfo=$ENV{"PATH_INFO"};
   $CachePath=$ENV{"CACHE_PATH"};

   $Script = $PathInfo;
   $Script = $CachePath . $Script;

   $MimeType = $PathInfo;
   $MimeType =~ s/(.)*\.(.*)/$2/;
   $MimeType =~ tr/a-z/A-Z/;

   $doc_open=$MimeType . "_HEREDOC_OPEN";            
   $doc_close=$MimeType . "_HEREDOC_CLOSE";
   $int_env=$MimeType . "_INTERPRETER";

   $open=$ENV{$doc_open};
   $close=$ENV{$doc_close};
   $interpreter=$ENV{$int_env};

}

sub UpdateCache {

   open (INLINE, $InlineHTML) || 
      die " $^X : cannot open $InlineHTML!\n";

   open (SCRIPT, ">$Script") || 
      die " $^X cannot open script in cache : $Script\n";
   flock (SCRIPT, 2);

   print SCRIPT "#!", $interpreter, "\n\n";

   print SCRIPT "$open\n"; $state="html";
   while (<INLINE>) {
      s/<!--\s+(.|\s)*-->//g; 
      if ((/<\?\s+/i) && ($state eq "html")) {
       $state="script";
       s/$1/\n$close\n/;
      }
      if ((/\s+\?>/i) && ($state eq "script")) {
         $state="html";
         s/$1/\n$open\n/;     
      }
      s/(<\?\s+)|(\s+\?>)//g;
      print SCRIPT $_;       
   }

   if ($state eq "html") {
      print SCRIPT "\n$close\n";
   }

   flock(SCRIPT, 8);
   close(SCRIPT);
   close(INLINE);

}

sub ExportFormData {

   $RequestMethod=$ENV{"REQUEST_METHOD"};
   if ($RequestMethod eq "POST") {
      read(STDIN,$QueryString,$ENV{"CONTENT_LENGTH"});
   } elsif ($RequestMethod eq "GET") {
      $QueryString=$ENV{"QUERY_STRING"};
   } else {
      die " $^X : Illegal form action requested.\n"; 
   }

   @URLFormElements=split(/&/,$QueryString);
   foreach $EnvVar (@URLFormElements) {
      ($Variable, $Setting)=split(/=/,$EnvVar);
      $Variable =~ tr/+/ /;
      $Variable =~ s/%([a-fA-F\d][a-fA-F\d])/pack("C", hex($1))/eg;
      $Setting =~ tr/+/ /;
      $Setting =~ s/%([a-fA-F\d][a-fA-F\d])/pack("C", hex($1))/eg; 
      $ENV{"$Variable"}=$Setting;  
      system("export", $Variable);
   }

}