#!/usr/bin/perl


#<img width=XX height=YY alt="" SRC="animate.cgi?bar.txt">


# ----------------------------------------------------------
# 		    LOCAL CONFIGURATION
# ----------------------------------------------------------

# what's the URL to this script?
$this_script="http://www.ezenet.com/cgi-bin/animate.cgi";

# ----------------------------------------------------------
# 	 no user-serviceable parts below this line
# ----------------------------------------------------------

# called as refresh, not animate
&clientpull if ($ENV{'QUERY_STRING'} =~ /file=/i);

%suffixes = (
        "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",
);

if ($#ARGV < 0) {
    die "$0: need to know which file describes animation sequence.\n";
}

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

# pobox.com provides lifetime virtual email addresses and urls.
# for more info, goto http://pobox.com/pobox/ or email info@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;
}

$/ = 0;
$| = 1;

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

print "\n--$boundary\n";
START:
# warn "starting ...\n";
$controlmark = 0;
for (0 .. $#content) {		# iterate through the original file
				# --------------------
				# NORMAL REPEAT
				# --------------------

    if ($content[$_] =~ /^repeat (\d+)/i) {
	$repeat = $1;
	while ($repeat > 0) {
	    foreach $loopposition ($controlmark..($_-1)) {
		push(@toshow,$loopposition);
	    }
	    $repeat--;
	}
	$controlmark = $_+1;

				# --------------------
				# REVERSE REPEAT
				# --------------------

    } elsif ($content[$_] =~ /^reverse repeat (\d+)/i) {
	$repeat = $1;
	while ($repeat > 0) {
	    foreach $loopposition (reverse ($controlmark..($_-1))) {
		push(@toshow,$loopposition);
	    }
	    $repeat--;
	}
	$controlmark = $_+1;

				# --------------------
				# LOOP REPEAT
				# --------------------

    } elsif ($content[$_] =~ /^loop repeat (\d+)/i) {
	$repeat = $1;
	while ($repeat > 0) {
	    foreach $loopposition (reverse ($controlmark..($_-1))) {
		push(@toshow,$loopposition);
	    }
	    $repeat--;
	    last if ($repeat <= 0);
	    foreach $loopposition ($controlmark..($_-1)) {
		push(@toshow,$loopposition);
	    }
	    $repeat--;
	}
	$controlmark = $_+1;

				# --------------------
				# FILENAME or SLEEP
				# --------------------

    } else {
	push(@toshow,$_);
    }
}

# uncomment for debugging purposes
# warn "\@toshow is now @toshow.\n";

for (@toshow) {    &dump($_);   }

goto START if ($adnauseum);

# when will it die?  hm.  httpd 1.3R doesn't seem to close
# the file descriptor quite right.  the problem seems to be
# fixed with 1.4.
############# script terminates.

sub dump {			# takes the index of a @content line to show
    local ($loopposition) = $_[0];
    if ($content[$loopposition] =~ /^sleep (\d*)/i) { #----------------SLEEP
	sleep $1;
	return;
    }

    ($extension = $content[$loopposition]) =~ s/\.\w+$/$1/i;
    $contenttype = ($suffixes{$extension} || "text/html");

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

sub clientpull {
    $localtime = localtime;	# this will break unless you have perl 5

    @args = split(/&/,$ENV{'QUERY_STRING'});
    for (@args) {
	($key, $val) = split(/=/,$_,2);
	$val =~ s/\+/ /g;
	$val =~ s/\%(..)/pack("c",$1)/ge;
	$in{$key} = $val;
    }

    # we expect %in to contain the following values:
    # file = relative pathname from this script's CWD to a descriptor file
    # step = numerical index to where we are now, to be incremented

    &abort ("not called with enough info.\n") unless ($in{'file'} && $in{'step'});
    &abort ("check file permissions on $in{'file'}.\n") unless (open(FILE,$in{'file'}));
	

    while (chop ($_=<FILE>)) {
	push(@file,$_."\n");
	next if (/^\s*(\#.*)?$/);
	s/^\s*//;
	($pause,$url) = split(' ',$_,2);
	$steps[++$step] = "$pause $url";
    }
    close (FILE);

    ($pause && $url) ||
	&abort("couldn't find needed info in $in{'file'}\n");

    $step = $in{'step'};
    ($pause, $url) = split(' ', $steps[$step]);
    $step++;
    if ($steps[$step]) {	# pass the buck ...
	$refreshline = "Refresh: $pause;URL=$this_script?file=$in{'file'}&step=$step\n";
    } else {			# the buck has to stop somewhere, hm?
	$refreshline = "";
    }

    print <<"EOREDIRECT";
Location: $url
${refreshline}Content-type: text/html

<HEAD><TITLE>Document moved</TITLE></HEAD>
<BODY><H1>Document moved</H1>
This document has moved to <A HREF="$url">$url</A>.  This script will call $this_script again in $pause seconds.
EOREDIRECT

    exit;
}


sub abort {
    $" = "\n";
	print <<"EOABORT";
Content-type: text/html

Doh.  Stuff ain\'t working like it should.  Consider this an abortion.
The complaint, specifically, is:<BR>
<B>$_[0]</B><P>

Diagnostics:
<PRE>
\$url: $url
\$this_script: $this_script
\$step: $step
\$in{'file'}: $in{'file'}
\$in{'step'}: $in{'step'}
contents of file:
@file

</PRE>
EOABORT
    exit;
    }
