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

Last change on this file since 23087 was 23087, checked in by davidb, 12 years ago

Perl CGI script that uploads a file, using a callback method to monitor how much data has been transfered.

  • Property svn:executable set to *
File size: 4.5 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 $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# accessed from HTML web page through perlAjax
163
164sub check_status {
165
166 my $filename = $gsdl_cgi->param('uploadedfile');
167 $filename =~ s{^(.*)\/}{};
168
169 open(WIN,"</tmp/tmp2/wait.txt");
170 my $wait = <WIN>;
171 close(WIN);
172
173 $wait = ($wait+1) %6;
174 my $wait_dots = "." x ($wait+1);
175
176 open(WOUT,">/tmp/tmp2/wait.txt");
177 print WOUT "$wait\n";
178 close(WOUT);
179
180 my $monitor_filename = "$gsdl_tmp_dir/$filename-progress.txt";
181
182 if (! -f $monitor_filename ) {
183
184 return $wait_dots;
185 }
186
187
188 open my $PROGRESS, '<', $monitor_filename or die $!;
189 my $s = do { local $/; <$PROGRESS> };
190 close ($PROGRESS);
191
192 my $small = 300 - ($s * 3);
193 my $big = $s * 3;
194
195 my $r = "$wait_dots ";
196 $r .= '<div style="width:' . $big . 'px;height:10px;background-color:#dddd00;float:left"></div>';
197 $r .= '<div style="width:' . $small . 'px;height:10px;background-color:#008000;float:left"></div>';
198 $r .= '<div style="float:left;width: 80px">&nbsp;' . $s . '%</div>';
199
200 return $r;
201
202}
203
204
205
206
207
Note: See TracBrowser for help on using the repository browser.