#!/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;