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

Last change on this file since 23140 was 23140, checked in by davidb, 13 years ago
  • Property svn:executable set to *
File size: 5.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 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 $uploadedfile = $gsdl_cgi->param('uploadedfile');
119 my $full_filename = &util::filename_cat($gsdl_tmp_dir,$uploadedfile);
120
121 my $done_html = &talkback::generate_done_html($full_filename);
122
123 if ($gsdl_cgi->param('yes_upload')) {
124 upload_file($gsdl_cgi,$full_filename);
125 }
126
127 print $gsdl_cgi->header();
128 print $done_html;
129
130 remove_progress_file($gsdl_cgi->param('uploadedfile'));
131 }
132 else {
133
134 my $upload_html_form;
135
136 #my $oid = $gsdl_cgi->param('oid');
137 #my $collect = $gsdl_cgi->param('collect');
138 my $uniq_file = $gsdl_cgi->param('uploadedfile');
139
140 #my $uniq_file = "$collect-$oid-doc.xml";
141 # Light-weight (hidden) form with progress bar
142
143 $upload_html_form
144 = &talkback::generate_upload_form_progressbar($uniq_file);
145
146 print $perlAjax->build_html($gsdl_cgi, $upload_html_form);
147 }
148}
149
150
151main();
152
153#=====
154
155
156
157sub inc_wait_dots
158{
159 my $wait_filename = &util::filename_cat($gsdl_tmp_dir,"wait.txt");
160 open(WIN,"<$wait_filename");
161 my $wait = <WIN>;
162 close(WIN);
163
164 $wait = ($wait+1) %6;
165 my $wait_dots = "." x ($wait+1);
166
167 open(WOUT,">$wait_filename");
168 print WOUT "$wait\n";
169 close(WOUT);
170
171 return $wait_dots;
172}
173
174sub check_status_single_file
175{
176 my ($filename) = @_;
177 $filename =~ s{^(.*)\/}{};
178
179 my $monitor_filename = &util::filename_cat($gsdl_tmp_dir,
180 "$filename-progress.txt");
181
182 if (! -f $monitor_filename ) {
183 return "";
184 }
185
186 open my $PROGRESS, '<', $monitor_filename or die $!;
187 my $s = do { local $/; <$PROGRESS> };
188 close ($PROGRESS);
189
190 my $fgwidth = int($s * 1.5);
191 my $bgwidth = 150 - $fgwidth;
192
193 my $fgcol = "background-color:#dddd00;";
194 my $bgcol = "background-color:#008000;";
195
196 my $style_base = "height:10px; float:left;";
197
198 my $r = "";
199 $r .= "<div style=\"float:left;\">$filename:</div>";
200 $r .= "<div style=\"width: ${fgwidth}px; $fgcol $style_base\"></div>";
201 $r .= "<div style=\"width: ${bgwidth}px; $bgcol $style_base\"></div>";
202 $r .= "<div style=\"float:left; width: 80px\">&nbsp;$s%</div>";
203 $r .= "<br>";
204
205 return $r;
206}
207
208
209sub check_status_all
210{
211 my $file_central = &util::filename_cat($gsdl_tmp_dir,"file-central.txt");
212
213 my $html = "";
214
215 if (open my $FC, '<', $file_central) {
216 # Read entire file in all at once
217 my $file_list_str = do { local $/; <$FC> };
218 my @file_list = split(/\n/,$file_list_str);
219
220 foreach my $f (@file_list) {
221 $html .= check_status_single_file($f);
222 }
223
224 close ($FC);
225 }
226 else {
227 # error
228 $html = "Failed to open $file_central: $!\n";
229 }
230
231 return $html;
232
233}
234
235
236# Accessed from HTML web page through the majic of perlAjax
237
238sub check_status
239{
240
241 my $wait_dots = inc_wait_dots();
242 my $html = "$wait_dots<br>";
243
244 my $filename = $gsdl_cgi->param('uploadedfile');
245 if (defined $filename) {
246 $html .= check_status_single_file($filename);
247 }
248 else {
249 $html .= check_status_all();
250 }
251
252 return $html;
253}
Note: See TracBrowser for help on using the repository browser.