#!/usr/bin/perl
# Needed to avoid dependence on C:\TEMP being world read+write
BEGIN { $TempFile::TMPDIRECTORY = './'; }
use strict;
use CGI::Carp qw(fatalsToBrowser);
use CGI qw( :standard);
#use File::Slurp qw( read_file );
#use DBI;
#use Crypt::Lite;
use File::Basename;
my $TRUE = 1;
my $FALSE = 0;
&header();
#my $retval = eval
{
###############################################
# CGI IN
print "###############################################\n";
print "# CGI IN\n";
my $query = CGI->new;
print "\$query = [$query]\n";
my $submit = $query->param('SUBMIT');
print "\$submit = [$submit]\n";
my $user_id= $query->param('USER_ID');
print "\$user_id = [$user_id]\n";
my $filename = $query->param("photo");
print "\$filename = [$filename]\n";
my $safe_filename_characters = "a-zA-Z0-9_.-";
print "\$safe_filename_characters = [$safe_filename_characters]\n";
#my $upload_dir = "./images-user";
my $upload_dir = ".";
print "\$upload_dir = [$upload_dir]\n";
#mkdir $upload_dir; # Just in case
$CGI::POST_MAX = 1024 * 5000;
print "\$CGI::POST_MAX = [$CGI::POST_MAX]\n";
print "###############################################\n";
if ($user_id eq '') {
print "\$user_id is blank. Skipping\n";
# my $cookie = CGI->new;
# print "\$cookie = [$cookie]\n";
# $user_id = $cookie->cookie('TEC_USER_ID');
# print "\$user_id = [$user_id]\n";
# my $crypt = Crypt::Lite->new( debug => 0, encoding => 'hex8' );
# print "\$crypt = [$crypt]\n";
# my $decrypted = $crypt->decrypt($user_id, $ip_address);
# print "\$decrypted = [$decrypted]\n";
# $user_id = $decrypted;
# print "\$user_id = [$user_id]\n";
}
print "####################################################\n";
print "##################### Main Page ####################\n";
print "####################################################\n";
# Start Main Page
my $abtflg = $FALSE;
print "\$abtflg = [$abtflg]\n";
while (!$abtflg)
{
if ($submit eq '')
{
#code
}
elsif ($submit eq 'Submit Form')
{
if ( !$filename )
{
print $query->header ( );
print "There was a problem uploading your photo (try a smaller file).\n";
$abtflg = $TRUE;
print "\$abtflg = [$abtflg]\n";
last;
}
my ( $name, $path, $extension ) = fileparse ( $filename, '..*' );
print "\$name = [$name]\n";
print "\$path = [$path]\n";
print "\$extension = [$extension]\n";
$filename = $name . $extension;
print "\$filename = [$filename]\n";
$filename =~ tr/ /_/;
print "\$filename = [$filename]\n";
$filename =~ s/[^$safe_filename_characters]//g;
print "\$filename = [$filename]\n";
if ( $filename =~ /^([$safe_filename_characters]+)$/ )
{
$filename = $1;
print "\$filename = [$filename]\n";
}
else
{
print "ERROR: Filename contains invalid characters\n";
}
my $upload_filehandle = $query->upload("photo");
print "\$upload_filehandle = [$upload_filehandle]\n";
my $output_filename = "$upload_dir/$filename";
print "\$output_filename = [$output_filename]\n";
my $open_ret = open ( UPLOADFILE, ">" ) or print "$!\n";
print "\$open_ret = [$open_ret]\n";
if (!$open_ret)
{
print "Error opening output file \"$output_filename\"\n";
$abtflg = $TRUE;
print "\$abtflg = [$abtflg]\n";
last;
}
binmode UPLOADFILE;
print "Preparing to read and write\n";
while ( my $upload_data = <$upload_filehandle> )
{
my $upload_length = length $upload_data;
print "\$upload_length = [$upload_length]\n";
my $write_ret = print UPLOADFILE;
print "\$write_ret = [$write_ret]\n";
}
print "Preparing to close UPLOADFILE\n";
close UPLOADFILE;
print "Done.\n";
}
}
}
#if ($@)
#{
# # Capture error message
# my $errmsg = $@;
#
# # !Convert to HTML
# #$errmsg =~ s/\n/\
\n/g;
#
# print "Eval Error: $errmsg\n";
#}
&footer();
exit;
{
# Persistent local variables
my $hdrflg;
# Actual routine
sub header
{
if (!defined $hdrflg)
{
print "Content-Type: text/html\n\n";
print "\n";
print "\n";
print " \n";
print " My CGI File Upload Test\n";
print " \n";
print " \n";
print " \n";
}
$hdrflg = $TRUE;
}
sub footer
{
{
print " \n";
print " \n";
print "\n";
}
$hdrflg = $TRUE;
}
}
__END__
# http://www.bhmk.com/pmcgitest/photup.htm