#!/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(); #===== # accessed from HTML web page through perlAjax sub check_status { my $filename = $gsdl_cgi->param('uploadedfile'); $filename =~ s{^(.*)\/}{}; 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); my $monitor_filename = "$gsdl_tmp_dir/$filename-progress.txt"; if (! -f $monitor_filename ) { return $wait_dots; } open my $PROGRESS, '<', $monitor_filename or die $!; my $s = do { local $/; <$PROGRESS> }; close ($PROGRESS); my $small = 300 - ($s * 3); my $big = $s * 3; my $r = "$wait_dots "; $r .= '
'; $r .= '
'; $r .= '
 ' . $s . '%
'; return $r; }