#!/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 = "\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 () {
if (/frame\s+name\s*=\s*"([^"]*)"/i) {
$name = $frame{$1} ;
s/src\s*=\s*"[^"]*"/src="$name"/i ;
}
if(//i && $frame{'title'}) {
s%<title>.*%$frame{'title'}%i ;
}
$out .= $_ ;
if (//i) { $out .= $base ; } # add BASE tag after initial header line
}
$size = length($out) + 1;
print <.
#
# 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 and
# Marion Hakanson .
#
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);
}