source: main/trunk/greenstone2/common-src/cgi-bin/talkback-progressbar.pl@ 33011

Last change on this file since 33011 was 33011, checked in by ak19, 2 years ago

On Ubuntu 18.04, confirmed Renate's findings that gsdlCGI.pm wasn't found by gliserver.pl in its @INC paths. Have now added the containing cgi-bin folder on GS2 and cgi folder on GS3 to @INC to teach gliserver.pl to find gsdlCGI.pm. This however needed a fix in build.xml where force-start-tomcat was passing the wrong value for GSDL3HOME to tomcat: it was passing in basedir instead of web.home. With this fix, gliserver.pl now works on Ubuntu 18.04. Have added lines identical to the changes in gliserver.pl to the other pl files in the cgi(-bin) folder for those pl files that similarly import gsdlCGI.pm.

  • Property svn:executable set to *
File size: 10.5 KB
Line 
1#!/usr/bin/perl -w
2
3use strict;
4
5use CGI::Carp qw(fatalsToBrowser);
6use CGI;
7
8my $gsdl_cgi;
9my $gsdl_home;
10my $gsdl_tmp_dir;
11
12my $debugging_enabled = 0; # if 1, if enabled deleting files will not happen
13
14BEGIN {
15
16 # On Ubuntu 18.04, gsdlCGI.pm can't be found as the cgi folder is not among @INC paths.
17 # Ensure gsdlCGI.pm is available in @INC by adding the cgi folder to it.
18 # For GS2:
19 my $gsdl_cgi_path = $ENV{'GSDLHOME'} . "/cgi-bin";
20 # For GS3:
21 $gsdl_cgi_path = $ENV{'GSDL3HOME'} . "/WEB-INF" . "/cgi" if defined $ENV{'GSDL3HOME'};
22
23 my $found_cgi_path = 0;
24 foreach my $inc_path (@INC) {
25 if($inc_path eq $gsdl_cgi_path) {
26 $found_cgi_path = 1;
27 last;
28 }
29 }
30 if(!$found_cgi_path) {
31 unshift (@INC, $gsdl_cgi_path);
32 }
33
34 $|=1; # Force auto-flushing for output
35
36 eval('require "./gsdlCGI.pm"');
37 if ($@)
38 {
39 print STDOUT "Content-type:text/plain\n\n";
40 print STDOUT "ERROR: $@\n";
41 exit 0;
42 }
43
44}
45
46
47sub get_progress_filename
48{
49 my ($uploaded_file) = @_;
50
51 my $progress_file = $uploaded_file;
52
53 $progress_file =~ s{^(.*)\/}{};
54 $progress_file =~ s/\.*?$//;
55 $progress_file .= "-progress.txt";
56
57 my $progress_filename = &util::filename_cat($gsdl_tmp_dir, $progress_file);
58
59 return $progress_filename;
60}
61
62sub get_file_central_filename
63{
64 my $file_central = &util::filename_cat($gsdl_tmp_dir,"file-central.txt");
65
66 return $file_central;
67}
68
69sub read_file_central
70{
71 my $fc_filename = get_file_central_filename();
72
73 my @fc_list;
74
75 if (open(FCIN,"<$fc_filename")) {
76
77 my $fc_list_str = do { local $/; <FCIN> };
78 @fc_list = split(/\n/,$fc_list_str);
79
80 close(FCIN);
81 }
82 else {
83 # OK to have no file-central.txt to start with
84 # return empty list
85 @fc_list = ();
86 }
87
88 return \@fc_list;
89
90}
91
92sub remove_from_file_central
93{
94 my ($filename,$fc_list) = @_;
95
96 my @new_fc_list = ();
97
98 my $removed = 0;
99
100 foreach my $f (@$fc_list) {
101
102 if ($f ne $filename) {
103 push(@new_fc_list,$f);
104 }
105 else {
106 $removed = 1;
107 }
108 }
109
110 if (!$removed) {
111 print STDERR "Warning: Failed to locate '$filename' in file-central.txt\n";
112 }
113
114 return \@new_fc_list;
115}
116
117sub add_to_file_central
118{
119 my ($filename,$fc_list) = @_;
120
121 my @new_fc_list = @$fc_list;
122
123 my $duplicate = 0;
124 foreach my $f (@new_fc_list) {
125
126 if ($f eq $filename) {
127 $duplicate = 1;
128 }
129 }
130
131 if (!$duplicate) {
132 push(@new_fc_list,$filename);
133 }
134 else {
135 print STDERR "Warning: Ingoring request to add duplicate entry:\n";
136 print STDERR " '$filename' into file-central.txt\n"
137 }
138
139 return \@new_fc_list;
140}
141
142
143
144sub write_file_central
145{
146 my ($fc_list) = @_;
147
148 my $fc_filename = get_file_central_filename();
149
150
151 if (open(FCOUT,">$fc_filename")) {
152
153 foreach my $f (@$fc_list) {
154 print FCOUT "$f\n";
155 }
156
157 close(FCOUT);
158
159
160 # Ensure it can be edited by owner of Greenstone install (if needed)
161 chmod(0777,$fc_filename);
162 }
163 else {
164 print STDERR "Error: Failed to write out $fc_filename\n";
165 print STDERR "$!\n";
166 }
167}
168
169sub monitor_upload
170{
171 my ($uploading_file, $buffer, $bytes_read, $data) = @_;
172
173 $bytes_read ||= 0;
174
175 my $progress_filename = get_progress_filename($uploading_file);
176
177 if (! -f $progress_filename) {
178 my $fc_list = read_file_central();
179 $fc_list = add_to_file_central($uploading_file,$fc_list);
180 write_file_central($fc_list);
181 }
182
183 open(COUNTER, ">$progress_filename");
184
185 my $per = 0;
186 if ($ENV{CONTENT_LENGTH} > 0) {
187 $per = int(($bytes_read * 100) / $ENV{CONTENT_LENGTH});
188 }
189 print COUNTER $per;
190 close(COUNTER);
191
192 # Useful debug to slow down a 'fast' upload
193 # Sleep for 10 msecs
194 #select(undef, undef, undef, 0.01);
195 #select(undef, undef, undef, 0.1);
196}
197
198
199
200sub upload_file {
201
202 my ($gsdl_cgi,$full_filename) = @_;
203
204 my $fh = $gsdl_cgi->upload('uploadedfile');
205 my $filename = $gsdl_cgi->param('uploadedfile');
206
207 return '' if ! $filename;
208
209 open (OUTFILE, '>' . $full_filename)
210 || die("Can't write to $full_filename: $!");
211
212 binmode(OUTFILE);
213
214 while (my $bytesread = read($fh, my $buffer, 1024)) {
215 print OUTFILE $buffer;
216 }
217
218 close (OUTFILE);
219 chmod(0666, $full_filename);
220
221}
222
223sub remove_progress_file
224{
225 my ($uploaded_file) = @_;
226
227 my $progress_filename = get_progress_filename($uploaded_file);
228
229 unlink($progress_filename)
230 unless $debugging_enabled;
231
232 my $fc_list = read_file_central();
233 $fc_list = remove_from_file_central($uploaded_file,$fc_list);
234 write_file_central($fc_list);
235}
236
237
238sub unzip_archives_doc
239{
240 my ($gsdl_cgi,$gsdl_home,$collect_home,$collect,$zip_filename) = @_;
241
242 my $lang_env = $gsdl_cgi->clean_param("lr") || "";
243
244 my $import_dir = &util::filename_cat($collect_home,$collect,"import");
245
246 # Unzip $zip_filename in the collection's import folder
247 my $java = $gsdl_cgi->get_java_path();
248 my $jar_dir= &util::filename_cat($gsdl_home, "bin", "java");
249 my $java_classpath = &util::filename_cat($jar_dir,"GLIServer.jar");
250
251 if (!-f $java_classpath) {
252 my $progname = $0;
253 $progname =~ s/^.*[\/\\]//;
254 my $mess = "$progname:\nFailed to find $java_classpath\n";
255 $gsdl_cgi->generate_error($mess);
256 }
257
258 my $java_args = "\"$zip_filename\" \"$import_dir\"";
259
260 $ENV{'LANG'} = $lang_env;
261 my $java_command = "\"$java\" -classpath \"$java_classpath\" org.greenstone.gatherer.remote.Unzip $java_args";
262
263 my $java_output = `$java_command`;
264 my $java_status = $?;
265 if ($java_status > 0) {
266 my $report = "Java failed: $java_command\n--\n";
267 $report .= "$java_output\n";
268 $report .= "Exit status: " . ($java_status / 256) . "\n";
269 $report .= $gsdl_cgi->check_java_home();
270
271 $gsdl_cgi->generate_error($report);
272 }
273 else {
274 # Remove the zip file once we have unzipped it, since it is an intermediate file only
275 `chmod -R a+rw $import_dir/HASH*`;
276 unlink($zip_filename) unless $debugging_enabled;
277 }
278}
279
280
281sub rebuild_collection
282{
283 my ($collect) = @_;
284
285 my $bin_script = &util::filename_cat($gsdl_home,"bin","script");
286## my $inc_rebuild_pl = &util::filename_cat($bin_script,"incremental-rebuild.pl");
287
288 my $rebuild_cmd = "perl -S incremental-rebuild.pl \"$collect\"";
289
290 my $rebuild_output = `$rebuild_cmd 2>&1`;
291 my $rebuild_status = $?;
292 if ($rebuild_status > 0) {
293 my $report = "Perl rebuild failed: $rebuild_cmd\n--\n";
294 $report .= "$rebuild_output\n";
295 $report .= "Exit status: " . ($rebuild_status / 256) . "\n";
296## $report .= $gsdl_cgi->check_perl_home();
297
298# $report .= "PATH = ". $ENV{'PATH'}. "\n";
299
300
301 $gsdl_cgi->generate_error($report);
302 }
303}
304
305sub main {
306
307 # gsdlCGI->prenew() constructs a 'lite' version of the object where the
308 # GSDL environment has been setup
309 #
310 # This is needed because the main call the gsdlCGI->new takes an
311 # initializer rountine -- monitor_upload() -- as a parameter, AND THAT
312 # routine (which is called before the constructor is finished) needs to
313 # know the tmp directory to use to write out the progress file.
314
315 my $gsdl_config = gsdlCGI->prenew();
316
317 $gsdl_home = $gsdl_config->get_gsdl_home();
318 $gsdl_tmp_dir = &util::get_toplevel_tmp_dir();
319
320 require talkback;
321
322 # Use the initializer mechanism so a 'callback' routine can monitor
323 # the progress of how much data has been uploaded
324
325 $gsdl_cgi = gsdlCGI->new(\&monitor_upload);
326
327
328 require CGI::Ajax;
329
330 my $perlAjax = new CGI::Ajax('check_status' => \&check_status);
331
332
333 if ($gsdl_cgi->param('process')) {
334
335 my $uploaded_file = $gsdl_cgi->param('uploadedfile');
336 my $full_filename = &util::filename_cat($gsdl_tmp_dir,$uploaded_file);
337
338 my $done_html = &talkback::generate_done_html($full_filename);
339
340 if ($gsdl_cgi->param('yes_upload')) {
341 upload_file($gsdl_cgi,$full_filename);
342
343 my $collect = $gsdl_cgi->param('toCollect');
344 my $collect_home = &util::filename_cat($gsdl_home,"collect");
345
346 unzip_archives_doc($gsdl_cgi,$gsdl_home,$collect_home,$collect,$full_filename);
347 rebuild_collection($collect);
348 }
349
350 print $gsdl_cgi->header();
351 print $done_html;
352
353 remove_progress_file($uploaded_file);
354 }
355 else {
356
357 my $upload_html_form;
358
359 #my $oid = $gsdl_cgi->param('oid');
360 #my $collect = $gsdl_cgi->param('collect');
361 my $uniq_file = $gsdl_cgi->param('uploadedfile');
362
363 #my $uniq_file = "$collect-$oid-doc.zip";
364 # Light-weight (hidden) form with progress bar
365
366 $upload_html_form
367 = &talkback::generate_upload_form_progressbar($uniq_file);
368
369 print $perlAjax->build_html($gsdl_cgi, $upload_html_form);
370 }
371}
372
373
374main();
375
376
377#=====
378
379sub inc_wait_dots
380{
381 my $wait_filename = &util::filename_cat($gsdl_tmp_dir,"wait.txt");
382 open(WIN,"<$wait_filename");
383 my $wait = <WIN>;
384 close(WIN);
385
386 $wait = ($wait+1) %6;
387 my $wait_dots = "." x ($wait+1);
388
389 open(WOUT,">$wait_filename");
390 print WOUT "$wait\n";
391 close(WOUT);
392
393 return $wait_dots;
394}
395
396
397sub check_status_single_file
398{
399 my ($filename) = @_;
400
401 my $monitor_filename = get_progress_filename($filename);
402
403 if (! -f $monitor_filename ) {
404 return "";
405 }
406
407 open my $PROGRESS, '<', $monitor_filename or die $!;
408 my $s = do { local $/; <$PROGRESS> };
409 close ($PROGRESS);
410
411 my $fgwidth = int($s * 1.5);
412 my $bgwidth = 150 - $fgwidth;
413
414 my $fgcol = "background-color:#dddd00;";
415 my $bgcol = "background-color:#008000;";
416
417 my $style_base = "height:10px; float:left;";
418
419 my $r = "";
420 $r .= "<div>$filename:</div>";
421 $r .= "<nobr>";
422 $r .= "<div style=\"width: ${fgwidth}px; $fgcol $style_base\"></div>";
423 $r .= "<div style=\"width: ${bgwidth}px; $bgcol $style_base\"></div>";
424 $r .= "<div style=\"float:left; width: 80px\">&nbsp;$s%</div>";
425 $r .= "</nobr>";
426 $r .= "<br />";
427
428 return $r;
429}
430
431
432sub check_status_all
433{
434 my $file_central = get_file_central_filename();
435
436 my $html = "";
437
438 my $fc_list = read_file_central();
439
440 foreach my $f (@$fc_list) {
441 $html .= check_status_single_file($f);
442 }
443
444 return $html;
445
446}
447
448
449# Accessed from HTML web page through the majic of perlAjax
450
451sub check_status
452{
453
454 my $wait_dots = inc_wait_dots();
455 my $dots_html = "Waiting for transfer: $wait_dots<br>";
456
457 my $filename = $gsdl_cgi->param('uploadedfile');
458
459 my $inner_html;
460
461 if ((defined $filename) && ($filename ne "")) {
462 $inner_html = check_status_single_file($filename);
463 }
464 else {
465 $inner_html = check_status_all();
466 }
467
468 my $html = ($inner_html ne "") ? $inner_html : $dots_html;
469
470 return $html;
471}
Note: See TracBrowser for help on using the repository browser.