source: main/trunk/greenstone2/cgi-bin/talkback-progressbar.pl@ 23149

Last change on this file since 23149 was 23149, checked in by davidb, 14 years ago

Progressbar code upgraded to be able to monitor multiple upload files at once

  • Property svn:executable set to *
File size: 7.4 KB
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 get_progress_filename
28{
29 my ($uploaded_file) = @_;
30
31 my $progress_file = $uploaded_file;
32
33 $progress_file =~ s{^(.*)\/}{};
34 $progress_file =~ s/\.*?$//;
35 $progress_file .= "-progress.txt";
36
37 my $progress_filename = &util::filename_cat($gsdl_tmp_dir, $progress_file);
38
39 return $progress_filename;
40}
41
42sub get_file_central_filename
43{
44 my $file_central = &util::filename_cat($gsdl_tmp_dir,"file-central.txt");
45
46 return $file_central;
47}
48
49sub read_file_central
50{
51 my $fc_filename = get_file_central_filename();
52
53 my @fc_list;
54
55 if (open(FCIN,"<$fc_filename")) {
56
57 my $fc_list_str = do { local $/; <FCIN> };
58 @fc_list = split(/\n/,$fc_list_str);
59
60 close(FCIN);
61 }
62 else {
63 # OK to have no file-central.txt to start with
64 # return empty list
65 @fc_list = ();
66 }
67
68 return \@fc_list;
69
70}
71
72sub remove_from_file_central
73{
74 my ($filename,$fc_list) = @_;
75
76 my @new_fc_list = ();
77
78 my $removed = 0;
79
80 foreach my $f (@$fc_list) {
81
82 if ($f ne $filename) {
83 push(@new_fc_list,$f);
84 }
85 else {
86 $removed = 1;
87 }
88 }
89
90 if (!$removed) {
91 print STDERR "Warning: Failed to locate '$filename' in file-central.txt\n";
92 }
93
94 return \@new_fc_list;
95}
96
97sub add_to_file_central
98{
99 my ($filename,$fc_list) = @_;
100
101 my @new_fc_list = @$fc_list;
102
103 my $duplicate = 0;
104 foreach my $f (@new_fc_list) {
105
106 if ($f eq $filename) {
107 $duplicate = 1;
108 }
109 }
110
111 if (!$duplicate) {
112 push(@new_fc_list,$filename);
113 }
114 else {
115 print STDERR "Warning: Ingoring request to add duplicate entry:\n";
116 print STDERR " '$filename' into file-central.txt\n"
117 }
118
119 return \@new_fc_list;
120}
121
122
123
124sub write_file_central
125{
126 my ($fc_list) = @_;
127
128 my $fc_filename = get_file_central_filename();
129
130 if (open(FCOUT,">$fc_filename")) {
131
132 foreach my $f (@$fc_list) {
133 print FCOUT "$f\n";
134 }
135
136 close(FCOUT);
137 }
138 else {
139 print STDERR "Error: Failed to write out $fc_filename\n";
140 print STDERR "$!\n";
141 }
142}
143
144sub monitor_upload
145{
146 my ($uploading_file, $buffer, $bytes_read, $data) = @_;
147
148 $bytes_read ||= 0;
149
150 my $progress_filename = get_progress_filename($uploading_file);
151
152 if (! -f $progress_filename) {
153 my $fc_list = read_file_central();
154 $fc_list = add_to_file_central($uploading_file,$fc_list);
155 write_file_central($fc_list);
156 }
157
158 open(COUNTER, ">$progress_filename");
159
160 my $per = 0;
161 if ($ENV{CONTENT_LENGTH} > 0) {
162 $per = int(($bytes_read * 100) / $ENV{CONTENT_LENGTH});
163 }
164 print COUNTER $per;
165 close(COUNTER);
166
167 # Useful debug to slow down a 'fast' upload
168 # Sleep for 10 msecs
169 select(undef, undef, undef, 0.01);
170 #select(undef, undef, undef, 0.1);
171}
172
173
174
175sub upload_file {
176
177 my ($gsdl_cgi,$full_filename) = @_;
178
179 my $fh = $gsdl_cgi->upload('uploadedfile');
180 my $filename = $gsdl_cgi->param('uploadedfile');
181
182 return '' if ! $filename;
183
184 open (OUTFILE, '>' . $full_filename)
185 || die("Can't write to $full_filename: $!");
186
187 binmode(OUTFILE);
188
189 while (my $bytesread = read($fh, my $buffer, 1024)) {
190 print OUTFILE $buffer;
191 }
192
193 close (OUTFILE);
194 chmod(0666, $full_filename);
195
196}
197
198sub remove_progress_file
199{
200 my ($uploaded_file) = @_;
201
202 my $progress_filename = get_progress_filename($uploaded_file);
203
204 if (!unlink($progress_filename)) {
205 print STDERR "Warning: Failed to delete $progress_filename\n";
206 }
207
208 my $fc_list = read_file_central();
209 $fc_list = remove_from_file_central($uploaded_file,$fc_list);
210 write_file_central($fc_list);
211}
212
213
214sub main {
215
216 # gsdlCGI->prenew() constructs a 'lite' version of the object where the
217 # GSDL environment has been setup
218 #
219 # This is needed because the main call the gsdlCGI->new takes an
220 # initializer rountine -- monitor_upload() -- as a parameter, AND THAT
221 # routine (which is called before the constructor is finished) needs to
222 # know the tmp directory to use to write out the progress file.
223
224 my $gsdl_config = gsdlCGI->prenew();
225 $gsdl_tmp_dir = &util::get_toplevel_tmp_dir();
226
227 require talkback;
228
229 # Use the initializer mechanism so a 'callback' routine can monitor
230 # the progress of how much data has been uploaded
231
232 $gsdl_cgi = gsdlCGI->new(\&monitor_upload);
233
234
235 require CGI::Ajax;
236
237 my $perlAjax = new CGI::Ajax('check_status' => \&check_status);
238
239
240 if ($gsdl_cgi->param('process')) {
241
242 my $uploadedfile = $gsdl_cgi->param('uploadedfile');
243 my $full_filename = &util::filename_cat($gsdl_tmp_dir,$uploadedfile);
244
245 my $done_html = &talkback::generate_done_html($full_filename);
246
247 if ($gsdl_cgi->param('yes_upload')) {
248 upload_file($gsdl_cgi,$full_filename);
249 }
250
251 print $gsdl_cgi->header();
252 print $done_html;
253
254 remove_progress_file($gsdl_cgi->param('uploadedfile'));
255 }
256 else {
257
258 my $upload_html_form;
259
260 #my $oid = $gsdl_cgi->param('oid');
261 #my $collect = $gsdl_cgi->param('collect');
262 my $uniq_file = $gsdl_cgi->param('uploadedfile');
263
264 #my $uniq_file = "$collect-$oid-doc.xml";
265 # Light-weight (hidden) form with progress bar
266
267 $upload_html_form
268 = &talkback::generate_upload_form_progressbar($uniq_file);
269
270 print $perlAjax->build_html($gsdl_cgi, $upload_html_form);
271 }
272}
273
274
275main();
276
277
278#=====
279
280sub inc_wait_dots
281{
282 my $wait_filename = &util::filename_cat($gsdl_tmp_dir,"wait.txt");
283 open(WIN,"<$wait_filename");
284 my $wait = <WIN>;
285 close(WIN);
286
287 $wait = ($wait+1) %6;
288 my $wait_dots = "." x ($wait+1);
289
290 open(WOUT,">$wait_filename");
291 print WOUT "$wait\n";
292 close(WOUT);
293
294 return $wait_dots;
295}
296
297
298sub check_status_single_file
299{
300 my ($filename) = @_;
301
302 my $monitor_filename = get_progress_filename($filename);
303
304 if (! -f $monitor_filename ) {
305 return "";
306 }
307
308 open my $PROGRESS, '<', $monitor_filename or die $!;
309 my $s = do { local $/; <$PROGRESS> };
310 close ($PROGRESS);
311
312 my $fgwidth = int($s * 1.5);
313 my $bgwidth = 150 - $fgwidth;
314
315 my $fgcol = "background-color:#dddd00;";
316 my $bgcol = "background-color:#008000;";
317
318 my $style_base = "height:10px; float:left;";
319
320 my $r = "";
321 $r .= "<div>$filename:</div>";
322 $r .= "<nobr>";
323 $r .= "<div style=\"width: ${fgwidth}px; $fgcol $style_base\"></div>";
324 $r .= "<div style=\"width: ${bgwidth}px; $bgcol $style_base\"></div>";
325 $r .= "<div style=\"float:left; width: 80px\">&nbsp;$s%</div>";
326 $r .= "</nobr>";
327 $r .= "<br />";
328
329 return $r;
330}
331
332
333sub check_status_all
334{
335 my $file_central = get_file_central_filename();
336
337 my $html = "";
338
339 my $fc_list = read_file_central();
340
341 foreach my $f (@$fc_list) {
342 $html .= check_status_single_file($f);
343 }
344
345 return $html;
346
347}
348
349
350# Accessed from HTML web page through the majic of perlAjax
351
352sub check_status
353{
354
355 my $wait_dots = inc_wait_dots();
356 my $html = "$wait_dots<br>";
357
358 my $filename = $gsdl_cgi->param('uploadedfile');
359
360 if ((defined $filename) && ($filename ne "")) {
361 $html .= check_status_single_file($filename);
362 }
363 else {
364 $html .= check_status_all();
365 }
366
367 return $html;
368}
Note: See TracBrowser for help on using the repository browser.