#!/usr/bin/perl -w
# 
######################################################################
# 
# Example Application for Image::ParseGIF - Main
#  (c) 1999 University of NSW
# 
# Written by Benjamin Low <ben@snrc.uow.edu.au>
#
#
#  This CGI application:
#   1) accepts a user request to do some work
#   2) returns a 'progress' page (with an image reference to the status 
#      script)
#   3) returns a 'result' page
#
#  Uses named pipes to communicate between this main script and the 
# status script.
#  An issue with using a pipe could be blocking, however the minimum 
# pipe buffer size (given by POSIX::PIPE_BUF), is apparently at least  
# 512 bytes (p. 579 Perl Cookbook). Thus so long as we aren't too 
# verbose, this script won't be held up by waiting for the status 
# script.
# 
#  The 'result' page is generated by a Refresh HTTP header. Not all 
# browsers understand Refresh (e.g. lynx). Furthermore, IE 4, 5 and 
# at least some versions of Opera don't wait to finish drawing the 
# page before triggering the refresh, which means the user won't see 
# the progress bar... kind of defeating the purpose.
#  Workarounds are to either a) set the delay large enough to allow the
# status image to complete; and/or b) add a 'click to continue' image
# frame, or link. Note that Netscape works great, and their page at
# (http://home.netscape.com/assist/net_sites/pushpull.html) specifically
# notes the browser will display the page before acting on the
# refresh...
#
######################################################################
#

use CGI_Lite;
use URI::Escape;
use Fcntl qw(:DEFAULT :flock);  # sysopen, flock symbolic constants

$ENV{'PATH'} = "/bin:/usr/bin";	# where to find mkfifo

# only Netscape seems to properly support refresh directives (see below)
$ENV{'HTTP_USER_AGENT'} =~ /Mozilla.([\d\.]+)(?!.*MSIE)/;
my $refresh = $1 > 1.1;

# get the CGI request
my $CGI = new CGI_Lite;
my $query = $CGI->parse_form_data();

# get the request identifer - empty for a new request
my $key = $query->{'key'} || '';

$| = 1;

if ($key eq '')	# new request, send status page, and write progress to pipe
{
	$key = 3; #URI::Escape::uri_escape(rand(1<<31));

	# create a named pipe with which to talk to the status script
	system('mkfifo', "/tmp/status.$key");
	$SIG{PIPE} = 'IGNORE';	# should check $! (== EPIPE) after writes

	print join("\n", (
		"Expires: 0",
		"Pragma: no-cache", 
		"Cache-Control: no-cache",
		'Content-type: text/html',
		'',
		"<meta http-equiv=\"refresh\" content=\"" . 
			($refresh ? "0" : "30") . ";url=main.cgi?key=$key\">",
		'Processing request...<p>',
		"<a href=\"main.cgi?key=$key\"><img src=status.cgi?key=$key border=0 width=200 height=40></a>",
		"<p>",	# 'flush' the last paragraph
	));

	# open for reading as well as writing to avoid blocking
	open(STATUS, "+>/tmp/status.$key");
	select(STATUS); $| = 1;

	flock(STATUS, LOCK_EX);	# block the 'Done' step till we are done (below)

	my $steps = 10;
	for (my $i = 0; $i < $steps; $i++)
	{
		print STATUS $i/$steps, "\n";	# percent complete

		# and do some work...
		select (undef, undef, undef, rand()>0.2?rand(1):rand(5));
	}
	print STATUS "1\n";	# percent complete
	close (STATUS);
}
else
{
	print "Content-type: text/html\n\n";

	# wait till the work is done
	open(STATUS, "+>/tmp/status.$key");	# just to get a lock
	unless (flock(STATUS, LOCK_SH|LOCK_NB))
	{
		print "waiting for request to complete...<p>\n";
		flock(STATUS, LOCK_SH);
	}
	close(STATUS);
	unlink ("/tmp/status.$key");

	print "Done.\n";
}