root/main/trunk/greenstone2/cgi-bin/talkback-progressbar.pl @ 23137

Revision 23137, 5.6 KB (checked in by davidb, 9 years ago)

Preparation work to support monitoring of multiple files

  • Property svn:executable set to *
Line 
1#!/usr/bin/perl -w
2
3
4use strict;
5
6use CGI::Carp qw(fatalsToBrowser);
7use CGI;
8
9my $gsdl_cgi;
10my $gsdl_tmp_dir;
11
12BEGIN {
13   
14    $|=1; # Force auto-flushing for output
15
16    eval('require "./gsdlCGI.pm"');
17    if ($@)
18    {
19    print STDOUT "Content-type:text/plain\n\n";
20    print STDOUT "ERROR: $@\n";
21    exit 0;
22    }
23
24}
25
26
27sub monitor_upload
28{           
29    my ($filename, $buffer, $bytes_read, $data) = @_;
30   
31    $bytes_read ||= 0;
32
33    my $full_filename = &util::filename_cat($gsdl_tmp_dir,
34                        "$filename-progress.txt");
35     
36    open(COUNTER, ">$full_filename");
37   
38    my $per = 0;
39    if ($ENV{CONTENT_LENGTH} > 0) {
40        $per = int(($bytes_read * 100) / $ENV{CONTENT_LENGTH});
41    }
42    print COUNTER $per;
43    close(COUNTER);
44   
45    # Useful debug to slow down a 'fast' upload
46    # Sleep for 10 msecs
47    select(undef, undef, undef, 0.01);
48}
49
50
51
52sub upload_file {
53
54    my ($gsdl_cgi,$full_filename) = @_;
55   
56    my $fh       = $gsdl_cgi->upload('uploadedfile');
57    my $filename = $gsdl_cgi->param('uploadedfile');
58   
59    return '' if ! $filename;     
60   
61    open (OUTFILE, '>' . $full_filename)
62        || die("Can't write to $full_filename: $!");       
63
64    binmode(OUTFILE);
65
66    while (my $bytesread = read($fh, my $buffer, 1024)) {
67        print OUTFILE $buffer;
68    }
69   
70    close (OUTFILE);
71    chmod(0666, $full_filename); 
72   
73}
74
75sub remove_progress_file
76{
77    my ($file) = @_;
78
79    $file =~ s{^(.*)\/}{};
80
81    my $progress_filename = &util::filename_cat($gsdl_tmp_dir,
82                        "$file-progress.txt");
83
84    if (!unlink($progress_filename)) {
85    print STDERR "Warning: Failed to delete $progress_filename\n";
86    }
87}
88
89
90sub main {
91
92    # gsdlCGI->prenew() constructs a 'lite' version of the object where the
93    # GSDL environment has been setup
94    #
95    # This is needed because the main call the gsdlCGI->new takes an
96    # initializer rountine -- monitor_upload() -- as a parameter, AND THAT
97    # routine (which is called before the constructor is finished) needs to
98    # know the tmp directory to use to write out the progress file.
99
100    my $gsdl_config = gsdlCGI->prenew();
101    $gsdl_tmp_dir = &util::get_toplevel_tmp_dir();
102
103    require talkback;
104
105    # Use the initializer mechanism so a 'callback' routine can monitor
106    # the progress of how much data has been uploaded
107
108    $gsdl_cgi = gsdlCGI->new(\&monitor_upload);
109
110
111    require CGI::Ajax;
112
113    my $perlAjax = new CGI::Ajax('check_status' => \&check_status);
114
115
116    if ($gsdl_cgi->param('process')) {
117
118    my $rand_string  = $gsdl_cgi->param('rand_string');
119    my $uploadedfile = $gsdl_cgi->param('uploadedfile');
120    my $full_filename = &util::filename_cat($gsdl_tmp_dir,
121                        "$rand_string-$uploadedfile");
122
123    my $done_html = &talkback::generate_done_html($full_filename);
124
125        if ($gsdl_cgi->param('yes_upload')) {
126            upload_file($gsdl_cgi,$full_filename);
127        }   
128
129        print $gsdl_cgi->header();
130        print $done_html;
131
132        remove_progress_file($gsdl_cgi->param('uploadedfile'));   
133    }
134    else {         
135
136    my $upload_html_form;
137
138    if (defined $gsdl_cgi->param('rand_string')) {
139        my $rand_string = $gsdl_cgi->param('rand_string');
140
141        # Light-weight (hidden) form with progress bar
142
143        $upload_html_form
144        = &talkback::generate_upload_form_progressbar($rand_string);
145    }
146    else {
147        print STDERR "Warning: Neither 'processing' nor 'rand_string' was set\n";
148        $upload_html_form
149        = &talkback::generate_malformed_args_html();
150       
151    }
152   
153        print $perlAjax->build_html($gsdl_cgi, $upload_html_form);
154    }
155}
156
157
158main();
159
160#=====
161
162
163
164sub inc_wait_dots
165{
166    my $wait_filename = &util::filename_cat($gsdl_tmp_dir,"wait.txt");
167    open(WIN,"<$wait_filename");
168    my $wait = <WIN>;
169    close(WIN);
170
171    $wait = ($wait+1) %6;
172    my $wait_dots = "." x ($wait+1);
173
174    open(WOUT,">$wait_filename");
175    print WOUT "$wait\n";
176    close(WOUT);
177
178    return $wait_dots;
179}
180
181sub check_status_single_file
182{
183    my ($filename) = @_;
184    $filename =~ s{^(.*)\/}{};
185
186    my $monitor_filename = &util::filename_cat($gsdl_tmp_dir,
187                           "$filename-progress.txt");
188
189    if (! -f  $monitor_filename ) {
190    return "";
191    }
192               
193    open my $PROGRESS, '<', $monitor_filename or die $!;
194    my $s = do { local $/; <$PROGRESS> };
195    close ($PROGRESS);
196   
197    my $fgwidth = int($s * 1.5);
198    my $bgwidth = 150 - $fgwidth;
199 
200    my $fgcol = "background-color:#dddd00;";
201    my $bgcol = "background-color:#008000;";
202
203    my $style_base = "height:10px; float:left;";
204
205    my $r = "";
206    $r .= "<div style=\"float:left;\">$filename:</div>";
207    $r .= "<div style=\"width: ${fgwidth}px; $fgcol $style_base\"></div>";
208    $r .= "<div style=\"width: ${bgwidth}px; $bgcol $style_base\"></div>";
209    $r .= "<div style=\"float:left; width: 80px\">&nbsp;$s%</div>";
210    $r .= "<br>";
211
212    return $r;
213}
214
215
216sub check_status_all
217{
218    my $file_central = &util::filename_cat($gsdl_tmp_dir,"file-central.txt");
219
220    my $html = "";
221
222    if (open my $FC, '<', $file_central) {
223    # Read entire file in all at once
224    my $file_list_str = do { local $/; <$FC> };
225    my @file_list = split(/\n/,$file_list_str);
226
227    foreach my $f (@file_list) {
228        $html .= check_status_single_file($f);
229    }
230
231    close ($FC);
232    }
233    else {
234    # error
235    $html = "Failed to open $file_central: $!\n";
236    }
237
238    return $html;
239
240}
241
242 
243# Accessed from HTML web page through the majic of perlAjax
244
245sub check_status
246{   
247
248    my $wait_dots = inc_wait_dots();
249    my $html = "$wait_dots<br>";
250
251    my $filename = $gsdl_cgi->param('uploadedfile');
252    if (defined $filename) {
253    $html .= check_status_single_file($filename);
254    }
255    else {
256    $html .= check_status_all();
257    }
258
259    return $html;
260}
Note: See TracBrowser for help on using the browser.