#!/usr/local/bin/perl
#  !!!
#  *** make sure this is the correctly perl path!
#

#
#  Animate 0.9
#
#   Do cool animations using the Netscape 1.1 multipart/x-mixed-replace
#     functionality...
#


#
#  Copyright 1995, Home Pages, Inc.  All rights reserved.
#      
#   Home Pages, Inc.
#   257 Castro St. Suite 219
#   Mountain View, CA 94041
#
#   Please contact support@homepages.com regarding bugs or problems 
#      or http://www.homepages.com/tools/
#

$SIG{"ALRM"} = "exit";
alarm 10*60;


#
#  defimage is the default image to use when under a non-Netscape browers
#   [defaults to the first image in the images list]
#
$defimage = "";

#
#  The animation sequence
#
$basedir = "/stat1/faculty/west/";

@images = (
	"$basedir/NEWGIFA.WEEK001.GIF",
	"$basedir/NEWGIFA.WEEK105.GIF",
	"$basedir/NEWGIFA.WEEK209.GIF",
	"$basedir/NEWGIFA.WEEK313.GIF",
	"$basedir/NEWGIFA.WEEK417.GIF",
	"$basedir/NEWGIFA.WEEK521.GIF",
	"$basedir/NEWGIFA.WEEK625.GIF",
#	"$basedir/whiteball.gif",
#	"$basedir/orangeball.gif",
#	"$basedir/purpleball.gif",
#	"$basedir/redball.gif",
#	"$basedir/yellowball.gif",
);

#
#  The sleep delay between sending the first and second image
#
$delay = 0.9;

#
#  You probably don't want to change the rest of this...
#

#
#  If there is no default image use the first image of the loop
#
$defimage = $images[0] if $defimage eq "";

#
#  Default content type
#
$defsufix = "txt";

#
#  Suffix to content type list
#
%sufixes = (
	"gif",	"image/gif",
	"jpeg",	"image/jpeg",
	"jpg",	"image/jpeg",
	"jpe",	"image/jpeg",
	"tiff",	"image/tiff",
	"tif",	"image/tiff",
	"pnm",	"image/x-portable-anymap",
	"pbm",	"image/x-portable-bitmap",
	"pgm",	"image/x-portable-graymap",
	"ppm",	"image/x-portable-pixmap",
	"rgb",	"image/x-rgb",
	"xbm",	"image/x-xbitmap",
	"xpm",	"image/x-xpixmap",
	"xwd",	"image/x-xwindowdump",
	"html",	"text/html",
	"htm",	"text/html",
	"txt",	"text/plain",
	"tsv",	"text/tab-separated-values",
);

#
#
#
$agent = $ENV{'HTTP_USER_AGENT'}.$ENV{'HTTP_USERAGENT'};

$sep = "=-+=-+=-+=MULTI__PART__SEPERATOR-+=-+=-+=";
#$sep = "ThisRandomString";

$| = 1;

#
#
#
if ($ENV{'SERVER_SOFTWARE'} =~ /NCSA/) {
	$dostdhdrs = 1;
}

if ($ENV{'SERVER_SOFTWARE'} =~ /NCSA/ && $0 !~ /\/nph-/) {
	&error("Bad script name for NCSA server (must be nph-$0)");
}

if ($ENV{'SERVER_PROTOCOL'} =~ /0\.9/) {
	$dostdhdrs = 0;
}

#  Print the "OK" response
#
#
if ($dostdhdrs) {
	print <<"END";
$ENV{'SERVER_PROTOCOL'} 200 OK
Server: $ENV{'SERVER_SOFTWARE'} -- Animate0.9
MIME-version: 1.0
END
}

&ReadParse;

#
#
#
if ($agent =~ /Mozilla\/([1-9].[0-9])/ && $1 > 1.0 && !defined $in{"frame"}) {
	print "Content-type: multipart/x-mixed-replace; boundary=$sep\n";
	$first = 1;

	if (defined $in{"start"}) {
		while ($in{"start"} > 0 && $#images != -1) {
			shift(@images);
			$in{"start"}--;
		}
	}

	if (!defined $in{"loop"}) {
		$sz = 0;
		foreach $f (@images) {
			$sz += &contentsize($f);
			$sz += length($sep) + 4;
		}
		$sz += 3;
		print "Content-length: ", $sz, "\n";
	}

	do {
		foreach $f (@images) {
			print "\n--$sep\n";
			if (!$first) {
				$first = 0;
			} else {
				sleep($delay) 
			}
			&output($f);
		}
	} while (defined $in{"loop"});
	print "\n--$sep--\n";
} else {
	if (defined $in{"frame"}) {
		while ($in{"frame"} > 0 && $#images != -1) {
			$file = shift(@images);
			$in{"frame"}--;
		}
	} else {
		$file = "";
	}

	$file = $defimage if ($file eq "");

	&output($file);
}

sub output {
	local($file) = @_;
	local($type);
	local($len);

	open(FILE, $file) || return &error("Error finding file $file");

	$type = &gettype($file);

	print "Content-type: $type\n";

	$len = (stat($file))[7];
	print "Content-length: $len\n\n";
	
	read(FILE, $buf, $len);
	print $buf;
}

sub error {
	local($msg) = @_;

	print "Content-type: $sufixes{'html'}\n\n";
	print "\n";
	print "
$msg
\n";
}

sub contentsize {
	local($file) = @_;
	local($size,$type);

	$size = (stat($file))[7];
	$type = &gettype($file);
	$size += length("Content-type: $type\n");
	$size += length("Content-length: $len\n\n");

	return $size;
}

# 
#  Given a file name return a MIME type
#
sub gettype {
	local($file) = @_;
	local($suf);

	$file =~ /.*\.(\w+)/;
	$suf = $1;
	$suf =~ tr/A-Z/a-z/;

	if (defined $sufixes{$suf}) {
		return $sufixes{$suf};
	} else {
		return $sufixes{$defsufix};
	}
}


# Perl Routines to Manipulate CGI input
# S.E.Brenner@bioc.cam.ac.uk
# $Header: /people/seb1005/http/cgi-bin/RCS/cgi-lib.pl,v 1.2 1994/01/10 15:05:40 seb1005 Exp $
#
# Copyright 1993 Steven E. Brenner  
# Unpublished work.
# Permission granted to use and modify this library so long as the
# copyright above is maintained, modifications are documented, and
# credit is given for any use of the library.

# ReadParse
# Reads in GET or POST data, converts it to unescaped text, and puts
# one key=value in each member of the list "@in"
# Also creates key/value pairs in %in, using '\0' to separate multiple
# selections

# If a variable-glob parameter (e.g., *cgi_input) is passed to ReadParse,
# information is stored there, rather than in $in, @in, and %in.

sub ReadParse {
  if (@_) {
    local (*in) = @_;
  }

  local ($i, $loc, $key, $val);

  # Read in text
  if ($ENV{'REQUEST_METHOD'} eq "GET") {
    $in = $ENV{'QUERY_STRING'};
  } elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
    for ($i = 0; $i < $ENV{'CONTENT_LENGTH'}; $i++) {
      $in .= getc;
    }
  } 

  while ($in ne "") {
          @in = split(/&/,$in);

	  foreach $i (0 .. $#in) {
	    # Convert plus's to spaces
	    $in[$i] =~ s/\+/ /g;

	    # Convert %XX from hex numbers to alphanumeric
	    $in[$i] =~ s/%(..)/pack("c",hex($1))/ge;

	    # Split into key and value.
	    $loc = index($in[$i],"=");
	    $key = substr($in[$i],0,$loc);
	    $val = substr($in[$i],$loc+1);
	    $in{$key} .= '\0' if (defined($in{$key})); 
			# \0 is the multiple separator
	    $in{$key} .= $val;
	  }

	  $in = "";
  }

  return 1; # just for fun
}