My CGI File Upload Test

##

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

##

##

###############################################
# CGI IN
$query = [CGI=HASH(0xb72b4ec)]
$submit = [Submit Form]
$user_id = [marinersk]
$filename = [Humor-Fake-Doctor-001a.bmp]
$safe_filename_characters = [a-zA-Z0-9_.-]
$upload_dir = [.]
$CGI::POST_MAX = [5120000]
###############################################
####################################################
##################### Main Page ####################
####################################################
$abtflg = [0]
$name = []
$path = [./]
$extension = [Humor-Fake-Doctor-001a.bmp]
$filename = [Humor-Fake-Doctor-001a.bmp]
$filename = [Humor-Fake-Doctor-001a.bmp]
$filename = [Humor-Fake-Doctor-001a.bmp]
$filename = [Humor-Fake-Doctor-001a.bmp]
$upload_filehandle = [Humor-Fake-Doctor-001a.bmp]
$output_filename = [./Humor-Fake-Doctor-001a.bmp]
No such file or directory
$open_ret = []
Error opening output file "./Humor-Fake-Doctor-001a.bmp"
$abtflg = [1]

	Photo File:
	UserId: