####
#! c:/Perl/bin/Perl.exe -wT
# Script to upload file. This script is tied to upload.html
use strict;
use CGI;
my $query = CGI->new();
my $fn = $query->param ('file');
my $fh = $query->upload ('file');
($fn)=($fn=~/^.+\\(.+)/);
my $size=-s $fh;
my $max_size=100;
print $query->header( "text/html" ),
$query->start_html(-title => "Upload Test");
if ($size<$max_size*1024) { #This file size allowed
if (open FH, ">$fn") { # Open file
while (<$fh>) {
print FH;
}
if (check_filesize((-s FH), $size)) { # If all file copied to server
print $query->p("File uploaded succesfully");
} else {
print $query->p("There was a problem uploading your
file. Please ").a({-href=>"localhost/upload.html"}, "try again");
}
} else {
print $query->p("There was a problem uploading your
file. Please ").a({-href=>"localhost/upload.html"}, "try again");
}
} else {
print $query->p("Sorry, this file is too large. Maximum size allowed is ", $max_size, "kb");
}
print $query->end_html;
sub check_filesize { # Check if upload file size is approximately equal to the file written
my ($up_file, $down_file)=@_;
return 1 if ((sprintf "%d", $up_file/1024)==(sprintf "%d", $down_file/1024) ||
(sprintf "%d", $up_file/1024)==(sprintf "%d", $down_file/1024)+1 ||
(sprintf "%d", $up_file/1024)==(sprintf "%d", $down_file/1024)-1);
return 0
}