#!/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',
           });   
}
[download]