Page 1 of 1

Upload Progress Bar - Perl solution

Posted: Tue May 15, 2007 3:14 pm
by Todd_Z
Hey folks, so I'm sure there are 1800 ways to get a progress bar going, but the flash solutions seemed too unstable, and so I finally found an open source solution that worked.

http://tomas.epineer.se/tesupload/

I manipulated the files to bring it down to the bare bones of what I want to do. Essentially, you upload a file to this script, and it creates three files:

{$sid}_file : file data (WITH HEADERS(gross))
{$sid}_size : the total size of the file
{$sid}_name : name of the file upload

So post a form to this file, with the name of the file input as "file" and the query ?sid=[a-f0-9]{32} <- i use a randomly generated md5

Code: Select all

#!/usr/bin/perl -w

# PHP File Uploader with progress bar Version 2.0
# Copyright (C) Raditha Dissanyake 2003
# http://www.raditha.com
# Changed for use with AJAX by Tomas Larsson
# http://tomas.epineer.se/
# Changed for simplicity by S. Todd Zusman

# Licence:
# The contents of this file are subject to the Mozilla Public
# License Version 1.1 (the "License"); you may not use this file
# except in compliance with the License. You may obtain a copy of
# the License at http://www.mozilla.org/MPL/
# 
# Software distributed under this License is distributed on an "AS
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
# implied. See the License for the specific language governing
# rights and limitations under the License.
# 
# The Initial Developer of the Original Code is Raditha Dissanayake.
# Portions created by Raditha are Copyright (C) 2003
# Raditha Dissanayake. All Rights Reserved.
# 

# CHANGES:
# As of version 1.00 cookies were abolished!
# as of version 1.02 stdin is no longer set to non blocking.
# 1.40 - POST is no longer required and processing is more efficient.
#       Please refer online docs  for details.
# 1.42 - The temporary locations were changed, to make it easier to
#       clean up afterwards.    
# 1.45.
#   Changed the way in which the file list is passed to the php handler
# 2.0  (2006-03-12) (Tomas Larsson)
#   Changed to work better with AJAX. This meant improved error handling
#       and no forwarding to php page after successful upload. Also moved settings
#       in to this file.
# 2.0  (2006-04-22) (Tomas Larsson)
#   Settings are now read from a file above document root (shared with PHP code)

use CGI;
use Fcntl qw(:DEFAULT :flock);
use File::Temp qw/ tempfile tempdir /;

$max_upload = 536870912;
$tmp_dir = "/tmp";

@qstring = split(/&/,$ENV{'QUERY_STRING'});
@p1 = split(/=/,$qstring[0]);

$sessionid = $p1[1];
$sessionid =~ s/[^a-zA-Z0-9]//g;  # sanitized as suggested by Terrence Johnson.

$post_data_file = "$tmp_dir/$sessionid"."_file";
$monitor_file = "$tmp_dir/$sessionid"."_size";
$name_file = "$tmp_dir/$sessionid"."_name";

$len = $ENV{'CONTENT_LENGTH'};
$bRead = 0;
$| = 1;

sub bye_bye {
        $mes = shift;

        sysopen(FH, "/tmp/error", O_RDWR | O_CREAT) or &bye_bye ("Can't open numfile: $!");
        flock(FH, LOCK_EX) or  &bye_bye ("Can't write-lock numfile: $!");
        seek(FH, 0, 0) or &bye_bye ("Can't rewind numfile : $!");
        print FH $msg;
        close(FH);

        print "Content-type: text/html\n\n";
        print "<html><head><script language=javascript>alert('Encountered error: $mes.');</script></head></html>\n";
        exit;
}

if ( $len > $max_upload ) {
        close (STDIN);
        bye_bye("The maximum upload size has been exceeded:".$len);
}

sysopen(FH, $monitor_file, O_RDWR | O_CREAT) or &bye_bye ("Can't open numfile: $!");

$ofh = select(FH);
$| = 1;
select ($ofh);

flock(FH, LOCK_EX) or  &bye_bye ("Can't write-lock numfile: $!");
seek(FH, 0, 0) or &bye_bye ("Can't rewind numfile : $!");
print FH $len;
close(FH);

#sleep(1);

open(TMP,">","$post_data_file") or &bye_bye ("Can't open temp file");

$ofh = select(TMP); $| = 1; select ($ofh);
while ( read (STDIN ,$LINE, 4096) && $bRead < $len ) {
        $bRead += length $LINE;
        #select(undef, undef, undef,0.35);      # sleep for 0.35 of a second.
        print TMP $LINE;
}

close (TMP);

open(STDIN,"$post_data_file") or &bye_bye("Can't open temp file");
my $cg = new CGI();
my %vars = $cg->Vars;
open (QSTR,">", "$name_file") or &bye_bye ("Can't open output file");
my $fh = $cg->upload('file');
$fh =~ s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;
print QSTR $fh;
close (QSTR);

print "Content-type: text/html\n\n";
print "<html></html>";
[/syntax]