#!/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/>.
#
# PS: Randal L. Schwartz artical, 
# "Watching long processes through CGI", has been modified to 
# monitor CGI file upload.
# 
# URL for the artical:
# http://www.stonehenge.com/merlyn/LinuxMag/col39.html
#


$|++;

use strict;
use CGI qw(:all delete_all escapeHTML);
use Fcntl qw(:DEFAULT :flock );


####################################################################
# 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. BUFFER_SIZE to what ever size you want.
# 3. MAX_FILE_SIZE to what ever size you want.
#
use constant UPLOAD_DIR => 
	"/home/user/public_html/file/uploads";
use constant BUFFER_SIZE => 10;
use constant MAX_FILE_SIZE => 100 * 1_048_576;;

$CGI::DISABLE_UPLOADS = 0;
$CGI::POST_MAX = MAX_FILE_SIZE;

####################################################################
# 			ACTION HANDLER.
####################################################################
# This section is where all actions are handled.
#
if(my $progress_key = param('progress_key')) {
	print header;
	print start_html(
		-head => ["<meta http-equiv=refresh content=5>"]);
	my $cache = &get_cache();
	my $progress = $cache->get($progress_key);
	unless ($progress and ref $progress eq "ARRAY") {
	    upload_form();
	    exit 0;
	}
	my $width = sprintf("%0.2f", 
		(($progress->[1]/param('size')) * 100));
	print qq`<div id="progressouter" style=
		   "width: 500px; height: 20px; 
		   	border: 6px solid red;">
		   <div id="progressinner" style=
		       "position: relative; height: 20px; 
		       background-color: purple; width: $width\%; ">
		   </div>
		</div>` ;
	print p(i("... continuing ...")) unless $progress->[0];

	print end_html;	
}elsif(my $file = param('file')) {
	&upload_file();
}else{
	&upload_form();
}

exit 0;

####################################################################
# 		ALL SUBROTINES FOR THE PROGRAM
####################################################################
# This a subroutine which generates upload form. 
#
sub upload_form (){
	print header;
	print start_html;
	print h1("Try uploading a file...");
	print qq`<form enctype="multipart/form-data"  method="POST">
		       
		<input type="hidden" name="action"  value="upload"/>
		
		<input type="file" name="file"/>
		
		<input type="submit" value="Upload!"/>
		
		</form>`;

	print end_html;
}

####################################################################
# This subroutine uploads the file to your server and updates the 
# progressbar. 
#
sub upload_file (){
	my $file = param('file');
	my $fh = upload('file');
	my $progress_key = &get_unique_id();
	my $totalsize = $ENV{CONTENT_LENGTH}; 
	my $cache = &get_cache();
	$cache->set($progress_key, [0, ""]);
	
	my $buffer = "";
	
	if(my $pid = fork) {
		delete_all();
		param('progress_key', $progress_key);
		param('size', $totalsize);
		print redirect(self_url());
	}elsif(defined $pid) {
		close STDOUT;    
		open STDERR, ">/dev/null";
		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;
			print STDERR $bytes += $bytesread . "\n";
			
			$cache->set($progress_key, [0, $bytes]);
		}	
		$cache->set($progress_key, [1, $bytes]);
	       
		close OUTPUT;
		exit 0;
	} else {
		die "Cannot fork: $!";
	}
}

####################################################################
# 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 code is taken from Randal L. Schwartz artical, 
# "Watching long processes through CGI". you can find the artical at
# http://www.stonehenge.com/merlyn/LinuxMag/col39.html
#
sub get_cache() {
	require Cache::FileCache;

	  Cache::FileCache->new
	      ({
		namespace => 'upload',
		username => 'nobody',
		default_expires_in => '30 minutes',
		auto_purge_interval => '4 hours',
	       });   
}