Index: /main/trunk/greenstone2/cgi-bin/talkback-progressbar.pl
===================================================================
--- /main/trunk/greenstone2/cgi-bin/talkback-progressbar.pl	(revision 23087)
+++ /main/trunk/greenstone2/cgi-bin/talkback-progressbar.pl	(revision 23087)
@@ -0,0 +1,207 @@
+#!/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{^(.*)\/}{}; 
+
+    open(WIN,"</tmp/tmp2/wait.txt");
+    my $wait = <WIN>;
+    close(WIN);
+
+    $wait = ($wait+1) %6;
+    my $wait_dots = "." x ($wait+1);
+
+    open(WOUT,">/tmp/tmp2/wait.txt");
+    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 .= '<div style="width:' . $big . 'px;height:10px;background-color:#dddd00;float:left"></div>'; 
+    $r .= '<div style="width:' . $small . 'px;height:10px;background-color:#008000;float:left"></div>';
+    $r .= '<div style="float:left;width: 80px">&nbsp;' . $s . '%</div>'; 
+
+    return $r; 
+    
+}
+
+
+
+
+ 
