#!/store/bin/perl

############################################################
#                                                          #
#			 animate.cgi                       #
#			    v0.1                           #
#		Tue Mar  7 07:08:44 EST 1995               #
#		brought to you by pobox.com                #
#		  lifetime email addresses                 #
#		       web consulting                      #
#		  http://pobox.com/pobox/                  #
#                                                          #
# netscape 1.1 supports animation, through the mechanism   #
# of server push, and the mime-type x-mixed-replace.  see  #
# http://home.netscape.com/home/demo/1.1b1/pushpull.html   #
# for the description, and                                 #
# http://home.netscape.com/home/demo/1.1b1/mozilla/doc.html #
# for an actual example.                                   #
#                                                          #
# this is a perl script which makes serving animations     #
# very easy.  the example above uses a C program, which    #
# is specific to that example.  this script is extensible  #
# and widely applicable.                                   #
#                                                          #
# here's what to do.  i'm assuming you already have your   #
# images -- a series of .gif or .jpg files, all the same   #
# dimensions.  you've described the order of animation     #
# in a text file that lists the .gif or .jpg filenames,    #
# one per line.                                            #
#                                                          #
# the images are called foo1.gif fooo2.gif foo3.gif.       #
# they're listed in the file called bar.txt.               #
# all files involved are, for now, in the same directory,  #
# though it will become obvious how to make things work    #
# when the files are spread across different directories.  #
#                                                          #
# in your file, you say                                    #
#                                                          #
# <img width=XX height=YY alt="" SRC="animate.cgi?bar.txt">
#                                                          #
# and this script takes care of everything else.           #
#                                                          #
############################################################

#print "Content-type: text/plain\n\nhi there\n";
if ($#ARGV < 0) {
    die "$0: need to know which file describes animation sequence.\n";
}
#print "point 1\n";
if ($ARGV[1] =~ /^\d+$/) {
    $sleeptime = $ARGV[1];
} else { $sleeptime = 0; }

# sleeptime is generally a bad idea because ncsa httpd buffers cgi output.

$boundary = "brought to you by pobox.com";

if ($ARGV[0] =~ /^(.*\/)[^\/]*/) { $dirname = $1; }
else                            { $dirname = ""; }

open (CONTENT, $ARGV[0]) || die "unable to open $ARGV[0]: $!\n";
@content = (<CONTENT>);
chop @content;
close CONTENT;

@content = grep(! /^\s*(\#.*)?$/,@content); # remove blank lines and comments

if ($content[-1] eq "ad nauseum") {
    $adnauseum = 1;
    pop @content;
} elsif ($content[-1] =~ /repeat (\d+)/) {
    $repeat = $1;
    pop @content;
}
			       
$/ = 0;
$| = 1;

print "Content-Type: multipart/x-mixed-replace;boundary=$boundary\n";

print "\n--$boundary\n";
START:
for (0 .. $#content) {
       if ($content[$_] =~ /gif$/i)   { $contenttype = "image/gif";  }
    elsif ($content[$_] =~ /jpe?g$/i) { $contenttype = "image/jpeg"; }
    elsif ($content[$_] =~ /te?xt$/i) { $contenttype = "text/plain"; }
    elsif ($content[$_] =~ /html?$/i) { $contenttype = "text/html"; }

    print "Content-Type: $contenttype\n";
    print "\n";
    open (CURRENT, $dirname.$content[$_]) || warn "$0: unable to open $dirname$content[$_]: $!\n";
    print (<CURRENT>);
    close CURRENT;
    if ($_ != $#content) {
	print "\n--$boundary\n";
	sleep $sleeptime;
    }
}

goto START if ($adnauseum || ($repeat && (++$count < $repeat)));

# when will it die?  hm.  httpd 1.3R doesn't seem to close the file descriptor quite right.

print "\n--$boundary--\n";
