#!/usr/bin/perl
# "frameset", Copyright 1997 Andrew Daviel, Vancouver Webpages
# CGI script to generate HTML framesets
# Usage: http://some.org/cgi-bin/frameset/Path/template.html?frame1=f1.html&frame2=f2.html&title=New+Title

# Given an HTML frameset in PATH_INFO, this script replaces the TITLE and
# named frames from values in QUERY_STRING. Note that some values
# may require escaping to be used in this way.

# The URL given to this script is thus a unique URL for the frameset loaded
# with a particular set of frames, and may be used as the target for
# a JavaScript function in the child frames. In this way, a link to a
# "naked" child frame may be redirected to the correctly configured frameset


$server = $ENV{'SERVER_NAME'} ;  # name of Webserver to build BASE tag
$query = $ENV{'QUERY_STRING'} ;
$path = $ENV{'PATH_INFO'} ;
$file = $ENV{'DOCUMENT_ROOT'}.$path ; # local filename of template
# generate BASE tag so as not to require absolute URLs for frames
$base = "<base href=\"http://$server$path\">\n" ;
$ims = $ENV{'HTTP_IF_MODIFIED_SINCE'} ; 
$ims =~ s/;.*// ; # delete content-length from Netscape
if (!$path) {
  print "Status: 404 Not Found\n\nNo frameset given\"\n";
  exit ;
}
unless (open(IN,$file)) {
  print "Status: 404 Not Found\n\nCannot find frameset \"$path\"\n";
  exit ;
}
@stat = stat($file) ; $size = $stat[7]; $modtime = $stat[9] ;
if ($ims) {
  # Deal with last-modified stuff; date of frameset template,
  # or this script, whichever is later
  $ims = &get_gmtime($ims) ;
  $age = $modtime-$ims ;
  if ($ims && $modtime<=$ims) {
    print "Status: 304 Not Modified\n\n" ;
    exit ; 
  }
}
@pairs = split(/&/, $query);
foreach $pair (@pairs) {
  ($name, $value) = split(/=/, $pair);
  $value =~ tr/+/ /;
  $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
  $frame{$name} = $value ;
}
$glastmod = &wtime($modtime ,'GMT');
while (<IN>) {
  if (/frame\s+name\s*=\s*"([^"]*)"/i) {
    $name = $frame{$1} ;
    s/src\s*=\s*"[^"]*"/src="$name"/i ;
  } 
  if(/<title>/i && $frame{'title'}) {
    s%<title>.*</title>%<title>$frame{'title'}</title>%i ; 
  } 
  $out .=  $_ ;
  if (/<head>/i) { $out .=  $base ; } # add BASE tag after initial header line

}
$size = length($out) + 1;
print <<EOT;
Content-Type: text/html
Content-length: $size
Last-Modified: $glastmod

$out
EOT

# ===========================================================================
# get_gmtime() is an extension of the datetomtime() routine found in
# htcache.pl by Gertjan van Oosten <gvoosten@isosa2.estec.esa.nl>.
#
# Description:
#	Translate a GMT date string to machine time (seconds since Epoch)
#
# Usage:
#	$mtime = &get_gmtime($date)
#
sub get_gmtime
{
require "timelocal.pl";

    local ($Mstr) = 'JanFebMarAprMayJunJulAugSepOctNovDec';
    local($_) = @_;
    local($[) = 0;
    local($day, $mn, $yr, $hr, $min, $sec, $adate, $atime, $mon, $midx);
    local($offset) = 0;

    # Split date string
    local(@w) = split;

    # Remove useless weekday, if it exists
    if ($w[0] =~ /^\D/) { shift(@w); }

    if (!$w[0]) { return 0; }

    # Check which format
    if ($w[0] =~ /^\D/)   # Must be ctime (Feb  3 17:03:55 GMT 1994)
    {
        $mn    = shift(@w);
        $day   = shift(@w);
        $atime = shift(@w);
        shift(@w);
        $yr    = shift(@w);
    }
    elsif ($w[0] =~ m#/#) # Must be common logfile (03/Feb/1994:17:03:55 -0700)
    {
        ($adate, $atime) = split(/:/, $w[0], 2);
        ($day, $mn, $yr) = split(/\//, $adate);
        shift(@w);
        if ( $w[0] =~ m#^([+-])(\d\d)(\d\d)$# )
        {
            $offset = (3600 * $2) + (60 * $3);
            if ($1 eq '+') { $offset *= -1; }
        }
    }
    elsif ($w[0] =~ /-/)  # Must be rfc850 (08-Feb-94 ...)
    {
        ($day, $mn, $yr) = split(/-/, $w[0]);
        shift(@w);
        $atime = $w[0];
    }
    else                  # Must be rfc822 (09 Feb 1994 ...)
    {
        $day   = shift(@w);
        $mn    = shift(@w);
        $yr    = shift(@w);
        $atime = shift(@w);
    }
    if ($atime)
    {
        ($hr, $min, $sec) = split(/:/, $atime);
    }
    else
    {
        $hr = $min = $sec = 0;
    }

    if (!$mn || ($yr !~ /\d+/))     { return 0; }
    if (($yr > 99) && ($yr < 1970)) { return 0; }   # Epoch started in 1970

    if ($yr < 70)    { $yr += 100;  }
    if ($yr >= 1900) { $yr -= 1900; }
    if ($yr >= 138)  { return 0; }      # Epoch counter maxes out in year 2038

    # Translate month name to number
    $midx = index($Mstr, substr($mn,0,3));

    if ($midx  < 0) { return 0; }
    else            { $mon = $midx / 3; }

    # Translate to seconds since Epoch
    return (&timegm($sec, $min, $hr, $day, $mon, $yr) + $offset);
}
# wtime() is a modified version of Perl 4.036's ctime.pl
# library by Waldemar Kebsch <kebsch.pad@nixpbe.UUCP> and
# Marion Hakanson <hakanson@cse.ogi.edu>.
# 
sub wtime
{
    local(@DoW) = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday');
    local(@MoY) = ('Jan','Feb','Mar','Apr','May','Jun',
        'Jul','Aug','Sep','Oct','Nov','Dec');

    local($time, $tz) = @_;
    local($[) = 0;
    local($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);

    # Use local time if tz is anything other than 'GMT'

    ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
        ($tz eq 'GMT') ? gmtime($time) : localtime($time);

    $year += 1900;
    sprintf("%s, %02d %s %04d %02d:%02d:%02d %s", substr($DoW[$wday],0,3),
            $mday, $MoY[$mon], $year, $hour, $min, $sec, $tz);
}

