[23087] | 1 | #!/usr/bin/perl -w
|
---|
| 2 |
|
---|
| 3 |
|
---|
| 4 | use strict;
|
---|
| 5 |
|
---|
| 6 | use CGI::Carp qw(fatalsToBrowser);
|
---|
| 7 | use CGI;
|
---|
| 8 |
|
---|
| 9 | my $gsdl_cgi;
|
---|
| 10 | my $gsdl_tmp_dir;
|
---|
| 11 |
|
---|
| 12 | BEGIN {
|
---|
| 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 |
|
---|
| 27 | sub 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 |
|
---|
| 52 | sub 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 |
|
---|
| 75 | sub 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 |
|
---|
| 90 | sub 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 |
|
---|
| 158 | main();
|
---|
| 159 |
|
---|
| 160 | #=====
|
---|
| 161 |
|
---|
| 162 | # accessed from HTML web page through perlAjax
|
---|
| 163 |
|
---|
| 164 | sub check_status {
|
---|
| 165 |
|
---|
| 166 | my $filename = $gsdl_cgi->param('uploadedfile');
|
---|
| 167 | $filename =~ s{^(.*)\/}{};
|
---|
| 168 |
|
---|
[23089] | 169 | my $wait_filename = &util::filename_cat($gsdl_tmp_dir,"wait.txt");
|
---|
| 170 | open(WIN,"<$wait_filename");
|
---|
[23087] | 171 | my $wait = <WIN>;
|
---|
| 172 | close(WIN);
|
---|
| 173 |
|
---|
| 174 | $wait = ($wait+1) %6;
|
---|
| 175 | my $wait_dots = "." x ($wait+1);
|
---|
| 176 |
|
---|
[23089] | 177 | open(WOUT,">$wait_filename");
|
---|
[23087] | 178 | print WOUT "$wait\n";
|
---|
| 179 | close(WOUT);
|
---|
| 180 |
|
---|
| 181 | my $monitor_filename = "$gsdl_tmp_dir/$filename-progress.txt";
|
---|
| 182 |
|
---|
| 183 | if (! -f $monitor_filename ) {
|
---|
| 184 |
|
---|
| 185 | return $wait_dots;
|
---|
| 186 | }
|
---|
| 187 |
|
---|
| 188 |
|
---|
| 189 | open my $PROGRESS, '<', $monitor_filename or die $!;
|
---|
| 190 | my $s = do { local $/; <$PROGRESS> };
|
---|
| 191 | close ($PROGRESS);
|
---|
| 192 |
|
---|
| 193 | my $small = 300 - ($s * 3);
|
---|
| 194 | my $big = $s * 3;
|
---|
| 195 |
|
---|
| 196 | my $r = "$wait_dots ";
|
---|
| 197 | $r .= '<div style="width:' . $big . 'px;height:10px;background-color:#dddd00;float:left"></div>';
|
---|
| 198 | $r .= '<div style="width:' . $small . 'px;height:10px;background-color:#008000;float:left"></div>';
|
---|
| 199 | $r .= '<div style="float:left;width: 80px"> ' . $s . '%</div>';
|
---|
| 200 |
|
---|
| 201 | return $r;
|
---|
| 202 |
|
---|
| 203 | }
|
---|
| 204 |
|
---|
| 205 |
|
---|
| 206 |
|
---|
| 207 |
|
---|
| 208 |
|
---|