#!/usr/bin/perl

my $r = shift;
use CGI;
local our $cgi = new CGI;

our $action = "";
$action  = $cgi->param("action") || 'test_code';

if ( $action eq "test_code" ) {
       test_code ();
}
elsif ( $action eq "run" ) {
       test_prog ($cgi);
}

sub test_code
{
    # my ($cgi_sub) = @_;

    my $cgi_sub = new CGI;

    print $cgi_sub->header();
    print $cgi_sub->start_html( -title => 'Javascript calls from Perl'
+ );
    print $cgi_sub->h2("test code");
        print $cgi_sub->div($cgi_sub->font({-face=>'Arial'},"Status: "
+));
    print $cgi_sub->start_form();
    print $cgi_sub->submit(-name=>'action',-value=>'run');
    print $cgi_sub->end_form();
    print $cgi_sub->end_html();
}

sub test_prog
{
    my ($cgi_sub) = @_;
    print $cgi_sub->header();
    print $cgi_sub->start_html( -title => 'Javascript calls from mod_p
+erl' );
    print $cgi_sub->h2("test code");

print <<"EOT" ;
<script language="JavaScript1.2"><!--
if (document.getElementById || document.all || document.layers)
       document.write("<div id=statusbox><font face=Arial>Status:
</font></div>");
function newstatus(s) {
       var e;
       if (document.getElementById) {
               e = document.getElementById("statusbox");
       } else if (document.all) {
               e = document.all["statusbox"];
       } else if (document.layers) {
               e = document.layers["statusbox"];
       }
       e.innerHTML = "<font face=arial>Status: </font><font
face=arial color=blue><b>" + s + "</b></font>";
}
//--></script>
EOT

for (my $i = 1; $i <= 6; $i++){
   if ($i == 6){
       newstatus("Aggregating Data...");
       sleep (2);
       newstatus("Analyzing Data...");
       sleep (2);
       newstatus("Finished \(this text is from the server\)");
   }
   else {
       newstatus("Querying " . "$i" . " out of 5 suppliers");
       sleep (1);
   }
}
    print $cgi_sub->start_form();
    print $cgi_sub->submit(-name=>'action',-value=>'run');
    print $cgi_sub->end_form();
    print $cgi_sub->end_html();
}


sub newstatus {
   my ($s) = @_;

print <<"EOT" ;
<script language="JavaScript1.2"><!--
newstatus("$s");
//--></script>
EOT

$r->rflush;
}
[download]