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;
