#!/usr/bin/perl -w use strict; use CGI::Carp qw(fatalsToBrowser); use CGI; my $gsdl_cgi; my $gsdl_tmp_dir; BEGIN { $|=1; # Force auto-flushing for output eval('require "./gsdlCGI.pm"'); if ($@) { print STDOUT "Content-type:text/plain\n\n"; print STDOUT "ERROR: $@\n"; exit 0; } } sub monitor_upload { my ($filename, $buffer, $bytes_read, $data) = @_; $bytes_read ||= 0; my $full_filename = &util::filename_cat($gsdl_tmp_dir, "$filename-progress.txt"); open(COUNTER, ">$full_filename"); my $per = 0; if ($ENV{CONTENT_LENGTH} > 0) { $per = int(($bytes_read * 100) / $ENV{CONTENT_LENGTH}); } print COUNTER $per; close(COUNTER); # Useful debug to slow down a 'fast' upload # Sleep for 10 msecs select(undef, undef, undef, 0.01); } sub upload_file { my ($gsdl_cgi,$full_filename) = @_; my $fh = $gsdl_cgi->upload('uploadedfile'); my $filename = $gsdl_cgi->param('uploadedfile'); return '' if ! $filename; open (OUTFILE, '>' . $full_filename) || die("Can't write to $full_filename: $!"); binmode(OUTFILE); while (my $bytesread = read($fh, my $buffer, 1024)) { print OUTFILE $buffer; } close (OUTFILE); chmod(0666, $full_filename); } sub remove_progress_file { my ($file) = @_; $file =~ s{^(.*)\/}{}; my $progress_filename = &util::filename_cat($gsdl_tmp_dir, "$file-progress.txt"); if (!unlink($progress_filename)) { print STDERR "Warning: Failed to delete $progress_filename\n"; } } sub main { # gsdlCGI->prenew() constructs a 'lite' version of the object where the # GSDL environment has been setup # # This is needed because the main call the gsdlCGI->new takes an # initializer rountine -- monitor_upload() -- as a parameter, AND THAT # routine (which is called before the constructor is finished) needs to # know the tmp directory to use to write out the progress file. my $gsdl_config = gsdlCGI->prenew(); $gsdl_tmp_dir = &util::get_toplevel_tmp_dir(); require talkback; # Use the initializer mechanism so a 'callback' routine can monitor # the progress of how much data has been uploaded $gsdl_cgi = gsdlCGI->new(\&monitor_upload); require CGI::Ajax; my $perlAjax = new CGI::Ajax('check_status' => \&check_status); if ($gsdl_cgi->param('process')) { my $rand_string = $gsdl_cgi->param('rand_string'); my $uploadedfile = $gsdl_cgi->param('uploadedfile'); my $full_filename = &util::filename_cat($gsdl_tmp_dir, "$rand_string-$uploadedfile"); my $done_html = &talkback::generate_done_html($full_filename); if ($gsdl_cgi->param('yes_upload')) { upload_file($gsdl_cgi,$full_filename); } print $gsdl_cgi->header(); print $done_html; remove_progress_file($gsdl_cgi->param('uploadedfile')); } else { my $upload_html_form; if (defined $gsdl_cgi->param('rand_string')) { my $rand_string = $gsdl_cgi->param('rand_string'); # Light-weight (hidden) form with progress bar $upload_html_form = &talkback::generate_upload_form_progressbar($rand_string); } else { print STDERR "Warning: Neither 'processing' nor 'rand_string' was set\n"; $upload_html_form = &talkback::generate_malformed_args_html(); } print $perlAjax->build_html($gsdl_cgi, $upload_html_form); } } main(); #===== sub inc_wait_dots { my $wait_filename = &util::filename_cat($gsdl_tmp_dir,"wait.txt"); open(WIN,"<$wait_filename"); my $wait = ; close(WIN); $wait = ($wait+1) %6; my $wait_dots = "." x ($wait+1); open(WOUT,">$wait_filename"); print WOUT "$wait\n"; close(WOUT); return $wait_dots; } sub check_status_single_file { my ($filename) = @_; $filename =~ s{^(.*)\/}{}; my $monitor_filename = &util::filename_cat($gsdl_tmp_dir, "$filename-progress.txt"); if (! -f $monitor_filename ) { return ""; } open my $PROGRESS, '<', $monitor_filename or die $!; my $s = do { local $/; <$PROGRESS> }; close ($PROGRESS); my $fgwidth = int($s * 1.5); my $bgwidth = 150 - $fgwidth; my $fgcol = "background-color:#dddd00;"; my $bgcol = "background-color:#008000;"; my $style_base = "height:10px; float:left;"; my $r = ""; $r .= "
$filename:
"; $r .= "
"; $r .= "
"; $r .= "
 $s%
"; $r .= "
"; return $r; } sub check_status_all { my $file_central = &util::filename_cat($gsdl_tmp_dir,"file-central.txt"); my $html = ""; if (open my $FC, '<', $file_central) { # Read entire file in all at once my $file_list_str = do { local $/; <$FC> }; my @file_list = split(/\n/,$file_list_str); foreach my $f (@file_list) { $html .= check_status_single_file($f); } close ($FC); } else { # error $html = "Failed to open $file_central: $!\n"; } return $html; } # Accessed from HTML web page through the majic of perlAjax sub check_status { my $wait_dots = inc_wait_dots(); my $html = "$wait_dots
"; my $filename = $gsdl_cgi->param('uploadedfile'); if (defined $filename) { $html .= check_status_single_file($filename); } else { $html .= check_status_all(); } return $html; }