Some of the other nodes I referenced above give more background information.
The problem is indeed that once you call CGI->new() you are 'trapped' until CGI.pm has processed _all_ the form data including uploaded files.
But CGI.pm has added this optional 'hook' feature that allows you to specify one of your routines for CGI.pm to call _during_ the processing of the form data.
You call CGI.pm and it runs until done, but each time it processes some more upload data it calls your routine.
In your code you could do something like this: (untested)
. . .
open( my $fh, '>', 'myprogressdata') or die "bad open: $!";
$fh->autoflush; # no buffering, print writes immediately
my $q = CGI->new( \&myhooksub, $fh );
# You'll get control here only after CGI.pm is done
# processing form and upload data
. . .
Somewhere else in your same code you define your routine that CGI.pm will call for each chunk of data. Here we rely on that extra parameter value that CGI.pm copies from the new() call to pass into your routine. We open the file, give the filehandle to CGI.pm, and CGI.pm adds that to every call to your routine:
sub myhooksub {
my( $filename, $buffer, $bytes_read, $fh ) = @_;
seek( $fh, 0, 0 ); # rewind to start of file
printf $fh "Uploading '%s', %d out of %d bytes read\n",
$filename, $bytes_read, $ENV{CONTENT_LENGTH};
}
CGI.pm will call this routine many times, once for each chunk of the upload data it processes, something like:
(in CGI.pm)
. . .
$that_ref_to_his_sub = ... # copied from your
$his_other_data_value = ... # call to new()
. . .
while( $buffer = more_to_read() ) {
if( defined $that_ref_to_his_sub ) {
$bytes_read += length($buffer);
&{$that_ref_to_his_sub}($filename,$buffer,$bytes_read,$his_other
+_data_value );
}
print $fh_tempfile $buffer;
}
. . .
Note that value $ENV{CONTENT_LENGTH} will really be larger than the uploaded file sizes, as it includes the rest of the form data also, but it's close and the only 'total' number we have (sigh).
Your display CGI could be as simple as:
#!/usr/bin/perl -w
use strict;
use warnings;
use CGI;
my $q = new CGI;
print $q->header, $q->start_html(
-title => 'Upload Progress',
-head => meta({-http_equiv=>'Refresh', -content=>'3'})
+);
if( open( my $fh, '<', 'myprogressdata') ) {
my $progress = <$fh>;
print $q->h2('Upload Progress'), $progress;
} else {
print $q->h2('No Data Available'), $!;
}
print $q->end_html;
Now this example used files (I'm currently using a database table). You might want to use file locking (see flock in perlfunc and do SuperSearch's) to make sure the display CGI doesn't read a partially written record, though with one line it seems unlikely.
Anyway, I hope this helps, and that I haven't confused you more than before. |