Re: Framework for handling Query tasks that take a LONG time

Hi Guys,

I wanted to say thank you for your support and ideas.

I did not find something that I liked as much as to adopt it right away.

So, I wrote my own module for this, which will, no duobt, evolve some more.

I may open source it.

The way it works is as follows:

1) The initiating web page starts a long task by executing a call to
start_long_task, passing it a ref to a subroutine to be executed that could
take a long time.

A few things happen:
* Process forks
* Output to STDOUT is redirected to a variable
* An IFRAME tag is output, pointing to the monitoring script (see below).
* The subref is executed
* When it finishes, it writes the output from the variable to
file  /tmp/longtask.<taskid>

2) The monitoring script is a two liner:

#!/usr/bin/perl
use LongWebTask; serve_long_web_task;

serve_long_web_task is the subroutine that handles everything.

* The monitoring script is watching the output in /tmp/longtask.<taskid>
file. It keeps refreshing the iframe content until it finds said file, at
which point it outputs its content and deletes temporary files.

I am including the source here, but it is a work in progress. I would like
to hear comments as to whether this would be appropriate for CPAN. I have
another module there called Net::eBay.

#!/usr/bin/perl

use strict;
use warnings;

package LongWebTask;

use Time::HiRes qw( gettimeofday );
use Digest::MD5 qw( md5_hex );
use CGI;
use File::Slurp;

use strict;

require Exporter;
use vars       qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
@ISA = qw(Exporter);
$VERSION = 2000.0821;

@EXPORT= qw(
             start_long_web_task
             serve_long_web_task
           );

sub start_long_web_task {
  my ($cgi, $options, $subref, @args) = @_;

  my $progress_url = $options->{progress_url}
    || die "progress_url parameter not defined, cannot create iframe";
  my $refresh_frequency = $options->{refresh_frequency} || 10;

  my ($seconds, $microseconds) = gettimeofday;
  my $randstr = $$ . $seconds . $microseconds . rand( 1E9 );

  my $jobid = md5_hex( $randstr );

  my $iframe_width  = $options->{iframe_width}  || "90%";
  my $iframe_height = $options->{iframe_height} || "1000";

  print "<IFRAME SRC=\"$progress_url?jobid=$jobid\&action=show\"
WIDTH=$iframe_width HEIGHT=$iframe_height></IFRAME>";

  if ( fork ) { # Parent

  } else {      # Child

    my $output = "";
    close STDOUT;
    open STDOUT, ">", \$output;

    my $rc = &$subref( @args );

    close STDOUT;

    my $outfn = outputfn( $jobid );
    write_file( "$outfn.new", $output );
    rename( "$outfn.new", $outfn );

    exit( $rc );
  }
}

sub outputfn {
  my ($jobid) = @_;
  return "/tmp/longtask.$jobid.output";
}

sub progressfn {
  my ($jobid) = @_;
  return "/tmp/longtask.$jobid.progress";
}

sub serve_long_web_task {

  my $cgi = new CGI;

  my $jobid = $cgi->param( 'jobid' )
    || die "$0: Parameter jobid is not defined in serve_long_web_task";
  my $action = $cgi->param( 'action' )
    || die "$0: Parameter action is not defined in serve_long_web_task";

  $jobid =~ /^\w+$/
    or die "Job id is illegal: '$jobid'";

  if ( $action eq 'show' ) {

    print $cgi->header;

    my $outfn = outputfn( $jobid );

    if ( -e $outfn ) {

      print read_file( $outfn );
      unlink( outputfn  ( $jobid ) );
      unlink( progressfn( $jobid ) );

    } else {
      print $cgi->start_html(
                             '-head'  => $cgi->meta(
                                                    {
                                                     -http_equiv =>
'Refresh',
                                                     -content    => 3,
                                                    }
                                                   ),
                            );
      print "Job is in progress. <BR>\n" . `date `;
    }


  }
}

1;