Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

CGI, File Upload and AJAX

by gugubanana (Acolyte)
on Feb 21, 2008 at 18:01 UTC ( #669327=perlquestion: print w/ replies, xml ) Need Help??
gugubanana has asked for the wisdom of the Perl Monks concerning the following question:

Elloo wise ones, I am trying to create a web based file upload with a progress bar. In short, the file upload works fine however the progress bar does not. Can any one tell me what I may be doing wrong? Here is my attempt...
#!/usr/bin/perl -w # # This program is free software: you can redistribute it and/or # modify it under the terms of the GNU General Public License as # published by the Free Software Foundation, either version 3 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public # License along with this program. If not, see # <http://www.gnu.org/licenses/>. # $|++; use strict; use CGI qw( :standard ); use Fcntl qw( :DEFAULT :flock ); use CGI::Carp qw(fatalsToBrowser set_message); #################################################################### # Capture any fatal browser error and display them on the browser. # BEGIN { sub handle_errors { my $msg = shift; print "<h1>Error Message!</h1>"; print "<p>Got an error: $msg</p>"; } set_message(\&handle_errors); } #################################################################### # Some constants for the program. Change it to what ever you want # respectively. # Example, you can change: # 1. UPLOAD_DIR to your own defined upload directory. # 2. UPLOAD_FDATA_DIR to your defined file data directory # 3. BUFFER_SIZE to what ever size you want. # 4. MAX_FILE_SIZE to what ever size you want. # 5. MAX_DIR_SIZE to what ever size you want. # use constant UPLOAD_DIR => "/home/neta2b2/public_html/file/uploads"; use constant UPLOAD_FDATA_DIR => "/home/neta2b2/public_html/file/datas"; use constant BUFFER_SIZE => 100; use constant MAX_FILE_SIZE => 1_048_576; use constant MAX_DIR_SIZE => 100 * 1_048_576; use constant MAX_OPEN_TRIES => 100; $CGI::DISABLE_UPLOADS = 0; $CGI::POST_MAX = MAX_FILE_SIZE; my $cgi = new CGI; #################################################################### # Unique id for file upload # my $id = &get_unique_id(); #################################################################### # Unique name for data file. # my $fdata = $id . "-data.txt"; #################################################################### # This subroutine returns the header of a html page. # sub header ($$$){ my ($cgi, $title, $script) = @_; return $cgi->header("text/html") . $cgi->start_html( -title => "Upload: $title", -script => $script ). $cgi->h2($title) . $cgi->hr; } #################################################################### # This subroutine returns the footer of a html page. # sub footer ($){ my $cgi = shift; #my $url = $ENV{SCRIPT_NAME}; return $cgi->end_html; } #################################################################### # This subroutine which generates ajax script. # Argument(s): # 1. $upload_fdata_dir: Is type string. This holds the location of # the data file ($fdata) directory. The data file holds how much # data has been uploaded so far. # 2. $fdata: Is type string. This is name of the data file # sub get_script($$) { my ($upload_fdata_dir, $fdata) = @_; my $AJAX = qq` var XMLHttpRequestObject = window.XMLHttpRequest ? new XMLHttpRequest() : new ActiveXObject("Microsoft.XMLHTTP"); function get_progress() { if (XMLHttpRequestObject) { var obj = document.getElementById('progressinner'); XMLHttpRequestObject.open("GET", '$upload_fdata_dir/$fdata'); XMLHttpRequestObject.onreadystatechange = function() { if (XMLHttpRequestObject.readyState == 4 && XMLHttpRequestObject.status == 200) { obj.innerHTML = XMLHttpRequestObject.responseText; setTimeout("getProgress()", 10); } } XMLHttpRequestObject.send(null); } } function startProgress(){ document.getElementById("progressouter").style.display="block" +; setTimeout("getProgress()", 1000); }`; return $AJAX; } #################################################################### # This a subroutine which generates upload form. # sub upload_form (){ my $id = $cgi->param('id'); return qq`<form enctype="multipart/form-data" id="upload_form" method="POST"> <input type="hidden" name="progress_key" id="progress_key" value="$id"/> <input type="hidden" name="action" id="action" value="upload"/> <input type="file" id="test_file" name="file"/><br/> <input onclick="window.parent.startProgress(); return true;" type="submit" value="Upload!"/> </form>` } #################################################################### # This subroutine uploads the file to your server and updates the # size of the file uploaded so far by calling &set_upload_size($) # subroutine. # sub upload_file ($){ my $cgi = shift; my $file = $cgi->param('file'); my $fh = $cgi->upload('file'); my $progress_key = $cgi->param('progress_key'); my $buffer = ""; sysopen (OUTPUT, UPLOAD_DIR . "/" . $progress_key . "-" . $file, O_CREAT | O_RDWR | O_EXCL); binmode $fh; binmode OUTPUT; my $bytes = 0; while(my $bytesread = read($fh, $buffer, BUFFER_SIZE)) { print OUTPUT $buffer; $bytes += $bytesread; &set_uploaded_size($bytes, $progress_key); } close OUTPUT; } #################################################################### # This subroutine updates the upload 'data' file ($fdata) with the # size of the file uploaded so far. # Argument(s): # 1. $bytesread: Is type integer. It is the amount of bytes read # while uploading a file. # 2. $progress_key: Is type string. It is an unique string for a # particular upload # sub set_uploaded_size ($$$$){ my ($bytesread, $progress_key) = @_; sysopen(OPUT, UPLOAD_FDATA_DIR . "/" . $progress_key . "-data.txt", O_CREAT | O_RDWR); print OPUT $bytesread; close OPUT; } #################################################################### # This subroutine gets an unique id. # sub get_unique_id (){ return $ENV{UNIQUE_ID} if exists $ENV{UNIQUE_ID}; require Digest::MD5; my $md5 = new Digest::MD5; my $remote = $ENV{REMOTE_ADDR} . $ENV{REMOTE_PORT}; my $id = $md5->md5_base64(time, $$, $remote); $id =~ tr|+/=|-_.|; return $id; } #################################################################### # This subroutine prints error message. It takes in two arguments # $cgi and $msg. # # Please note I have not used this subroutine as of yet. I've # thought to leave it just in case I may need it! # # Argument(s): # 1. $cgi :Is type CGI object # 2. $msg :Is type string # sub error ($$){ my($cgi, $msg) = @_; print $cgi->header("text/html"); print $cgi->start_html("Error"); print qq`$msg`; print $cgi->end_html(); } #################################################################### # This subroutine is where the html is created and displayed. # Arguments: # 1. $cgi: Is type CGI object. # 2. $title: Is type string. # 3. $script: Is type string. Javascript # 4. $id: Is type string. This unique string for file upload. # sub main($$$) { my($cgi, $title, $script, $id) = @_; print &header($cgi, $title, $script) . qq`<iframe id="theframe" name="theframe" src="uploader.cgi?action=upload_form&id=$id" style="border: none; height: 100px; width: 400px;" > </iframe>` . qq`<br/><br/> <div id="progressouter" style= "width: 500px; height: 20px; border: 6px solid red;"> <div id="progressinner" style= "position: relative; height: 20px; background-color: purple; width: 0%; "> </div> </div>` . &footer($cgi); } #################################################################### # ACTION HANDLER. #################################################################### # This section is where all actions are handled. # if ($cgi->param('action') eq "upload_form") { print $cgi->header; print $cgi->start_html; print &upload_form(); print $cgi->end_html; }elsif($cgi->param('action') eq "upload") { print $cgi->header; print $cgi->start_html; &upload_file($cgi); print "Upload complete"; print $cgi->end_html; }else{ &main($cgi, "Upload", get_script(UPLOAD_FDATA_DIR, $fdata), $id); } exit;

Comment on CGI, File Upload and AJAX
Download Code
Re: CGI, File Upload and AJAX
by Corion (Pope) on Feb 21, 2008 at 18:06 UTC
      Thanks Corion, for getting back. I'm having a look at it now.
Re: CGI, File Upload and AJAX
by kyle (Abbot) on Feb 21, 2008 at 18:34 UTC
      Thanks Kyle. I think this more along the line of what I have been looking for.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://669327]
Approved by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others romping around the Monastery: (7)
As of 2014-12-25 02:13 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (159 votes), past polls