package Form;

# Author:       David M. Hicken
# Version:      0.9.13
# Version date: June 21, 2002
# Web Site:     http://form.darklaser.com

$VERSION = 0.9.13;

use Exporter;
use vars qw^@ISA @EXPORT^;
@ISA = qw^Exporter^;
@EXPORT = qw^Form^;

sub Form {
	srand(); # begin the random number generator for later.
	my $input = read_net_input(); # reads everything in.
	return if (!$input); # quit if nothing came in.
	my ($form_vars, $name_file) = parse_mform_input($input); # parsing out all the variables and files from the form.
	my $form_vars = write_file($name_file, $form_vars);	# writing the temporary files.
	return (%{$form_vars});
}

sub read_net_input {
	my $input;
    if ($ENV{'REQUEST_METHOD'} eq "GET") { 
		$input = $ENV{'QUERY_STRING'}; 
	} elsif ($ENV{'REQUEST_METHOD'} eq "POST") {  
		if (defined($ENV{'CONTENT_LENGTH'}) and $ENV{'CONTENT_LENGTH'} > 0){
			binmode(STDIN) if ($ENV{'WINDIR'}); # use binary if this is a win32 machine
			$bytes_read = read(STDIN, $input, $ENV{'CONTENT_LENGTH'}, 0);
			$ENV{'CONTENT_LENGTH'} = 0;
		}	
	} elsif ($ENV{'USER'}){
		foreach $argument (@ARGV){
			$input .= $argument . "&";
		}
		$input =~ s/\&$//;
	}
	$input ? $Form::INPUT = $input : $input = $Form::INPUT; # Assing the parameters to a global unless parameters are empty in which case, assign parameters from the global
	return($input);
}

sub parse_form_input($){
	my $input = shift;
	my @variables = split(/\&/, $input);

	my (%form_vars, %var_count);
	foreach $variable (@variables) {
		next if ($variable !~ /\=/);
	    my ($name, $value) = split(/\=/, $variable);
	    $name =~ tr/+/ /;
	    $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
	    $value =~ tr/+/ /;
	    $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
		if ($value ne ""){
			if (!defined $form_vars{$name}) { # if this is the first of this form input name.
				$var_count{$name} = 0; # set the count of the array to 0 incase there is more than one
				$form_vars{$name} = $value; # seting the variable the hash with the name to the value
			} else { # for repeated times in with the same form input name
				$form_vars{$name} = [($form_vars{$name})] if ($var_count{$name} == 0); # set the first element to the first input if this is only the second input with this name
				$var_count{$name}++; # increase the count of the array for this form input name
				push(@{$form_vars{$name}}, $value); # adding the next element to the list
			}
		}
	}
	return(\%form_vars);
}

sub parse_mform_input($) {
	my $input = shift;
    my (%form_vars, @name_file, @list, %var_count); 
    if( $ENV{'CONTENT_TYPE'} =~ /multipart\/form-data; boundary=(.+)$/ ) {
		$boundary = '--'.$1;  # Using MIME to split out the form elements.
		@list = split(/$boundary/, $input); # split out each form variable into @list
		# this is going to eliminate the first and last element of @list if they are not valid.
		my $trash = shift(@list) if ($list[0] !~ / name=/); # Through the first element away if it is not a valid element
		$trash = pop(@list) if ($list[$#list] !~ / name=/); # Through the last element away if it is not a valid element
		
		# parsing data whether it be files or just a form.
		my $file_count = 0;
		foreach $listitem (@list){
			my %form_file;
			# if it is a file
			if ($listitem =~ / name=\"(.*)\"; filename=\"(.*?)\"[\r\n]{2}/){ # if the data has a filename in it then
				$form_file{'name'} = $1; # the contents of the () in the regular expresion.
				$form_file{'file_name'} = $2; # the contents of the () in the regular expresion.
				next if ($form_file{'file_name'} eq "");
				$listitem =~ /\r\n\r\n|\n\n/; # running an expression to seperate out the content
				$form_file{'file_content'} = $'; # rear part
			    $form_file{'file_name'} =~ s/.+\\([^\\]+)$|.+\/([^\/]+)$/$1/; # strip out the directory
				$form_file{'file_content'} =~ s/[\r\n]{2}$//;  # the last \r\n was put in by Netscape
				$form_file{'file_name'} =~ s/[^a-zA-Z0-9\-_.]//g; # strip out all charicters except - _ . and alpha numaric charicters
				$form_file{'file_name'} =~ s/\.\.+/\./g; # replace 2 or more periods in a row.
				if (length($form_file{'file_name'}) > 250){ # if the length of the file name is longer than 250 charicters
					my $extention = substr($form_file{'file_name'}, 0, 10); # get the extention (take into account it may be longer than 3 or for charicters)
					$form_file{'file_name'} = (substr($form_file{'file_name'}, 0, 240)) . $extention; # cut the file name down
				}
				
			    if ($form_file{'file_name'} ne "") { # if the file name is not empty now
					if (length($form_file{'file_content'}) > 0){ # if the file is larger than 0 bytes
						# creating a garanteed unique file name
						$form_file{'ip_addition'} = "$ENV{'REMOTE_ADDR'}-" if ($ENV{'REMOTE_ADDR'});
						$form_file{'random_number1'} = rand(1000000); # srand is set at the begining of the program.
						$form_file{'random_number2'} = rand(1000000);
						# the string "tmpfile", the current the current time in seconds, users ip address, proccess id, a random num, another random num and the file count
						$form_file{'unique_file_identifier'} = $^T . "-" . $form_file{'ip_addition'} . $$ . "-" . $form_file{'random_number1'} . "-" . $form_file{'random_number2'} . "-" . $file_count;
						$form_file{'write_file'} = "/tmp/fileupload/tmpfile$form_file{'unique_file_identifier'}";

						$form_vars{$form_file{'name'}}->{'original_name'} = $form_file{'file_name'}; #setting the variable $form_input_name{'original_name'} to the cleaned up original file name
						$form_vars{$form_file{'name'}}->{'size'} = length($form_file{'file_content'}); # setting the variable $form_input_name{'size'} to the size of the file in bytes
						$form_vars{$form_file{'name'}}->{'location'} = $form_file{'write_file'}; # seting the variable $form_input_name{'location'} to the location of the new temp file
						
						# puting the file name and file contents into named hash array which I will pass to a file writing sub
						$name_file[$file_count]->{'form_input_name'} = $form_file{'name'};
						$name_file[$file_count]->{'file_content'} = $form_file{'file_content'};
						$name_file[$file_count]->{'file_name'} = $form_file{'write_file'};
					} else {
						$form_vars{$form_file{'name'}}->{'error'}="FILE_EMPTY" if (length($form_file{'file_content'}) < 1); # set the error message.
					}
				} else {
					$form_vars{$form_file{'name'}}->{'error'}="FILE_NOT_FOUND"; # set error message					
				}
				$file_count++;
			} else { #the element was not a file
				$listitem =~ / name=\"(.+?)\"[\r\n]{2}/; # gathering form input name
				my $name = $1; # the contents of the () in the regular expresion.
				my $value = $'; # everything after the search string in the regular expresion.
				$value =~ s/^[\r\n]+//; # strip the carage returns and line breaks off the front
				$value =~ s/[\r\n]+$//; # strip the carage returns and line breaks off the end
				if ($value ne ""){
					if (!defined $form_vars{$name}) { # if this is the first of this form input name.
						$var_count{$name} = 0; # set the count of the array to 0 incase there is more than one
						$form_vars{$name} = $value; # seting the variable the hash with the name to the value
					} else { # for repeated times in with the same form input name
						$form_vars{$name} = [($form_vars{$name})] if ($var_count{$name} == 0); # set the first element to the first input if this is only the second input with this name
						$var_count{$name}++; # increase the count of the array for this form input name
						push(@{$form_vars{$name}}, $value); # adding the next element to the list
					}
				}
			}
		}
		return(\%form_vars, \@name_file);
    } else { # if it is not mime
		return(parse_form_input($input)); # call the non-mime parser
	}
}

sub write_file($ $) {
	my $name_file = shift; # array ref that contains neccisary info to save a file.
	my $form_vars = shift; # hash ref that contains more neccisary info to save a file.
	mkdir ("/tmp/fileupload", 0744) if (!-e "/tmp/fileupload");
	if (!-e "/tmp/fileupload"){
		warn("The folder /tmp/fileupload must exist for temporary file upload placement and could not be created.\n");
		return($form_vars);
	}
	foreach $file (@{$name_file}){
		if ($file->{'form_input_name'} ne ""){
			my $successfuly_opened = 1;
			unless (open(ULFD,">$file->{'file_name'}")) { #open the temp file for write
				# if we cant open the file for write then redefine the file hash to only contain an error
				$form_vars->{$file->{'form_input_name'}} = {'error' => "$file->{'file_name'}  $!"};
				warn("The file $file->{'file_name'} could not be opened for write; $!\n");
				$successfuly_opened = 0;
			}
			if ($successfuly_opened){
				binmode(ULFD) if ($ENV{'WINDIR'}); # use binary if this is a win32 machine
				print ULFD $file->{'file_content'}; # put the file into the temp file
				close(ULFD); # close the temp file
				chmod(0644, $file->{'file_name'}); # make sure the permisions of the temp file are safe.
			}
		}
	}
	return($form_vars);
}



























1;

__END__

=head1 Name

Form

=head1 Author

David M. Hicken

=head1 FUNCTION - Form

=head2 Usage:

use Form;

my %form_vars = Form();

	Note: You must use the method of "post" and have
	enctype="multipart/form-data"
	in your form tag in order to use MIME (in other words
	in order to upload files)

=head2 Definition:

Gathers form inputs and assigns them to hash elements which hash is returned to the call of the function.

The hash returned will contain the following:

	- A value for each standard input.
	- An array reference for multiple inputs with the same name.
	- A hash reference for files.

The hash reference for a file contains the following keys:

	location	- Location and name of the temporary file.
	original_name	- Original file name, lowercased and no spaces.
	size		- Size of the file in bytes.

=head2 Example Form:

	<html>
	<body>
	<form action="testing.cgi" method="post" enctype="multipart/form-data">
	a: <input type="text" name="vara" value="jim"><br>
	b: <input type="checkbox" name="varcheck" value="joe"><br>
	c: <input type="checkbox" name="varcheck" value="fred"><br>
	d: <input type="checkbox" name="varcheck" value="ben"><br>
	e: <input type="checkbox" name="varcheck" value="phill"><br>
	f: <input type="file" name="myimage"><br>
	g: <input type="file" name="yourimage"><br>
	h: <input type="file" name="ourimage"><br>
	<br>
	i: <input type="submit" value="submit"><br>
	</form>
	</body>
	</html>

=head2 Example Perl:

	#!/usr/bin/perl
	
	use Form;
	my %form_variables = Form();
	
	print "content-type: text/html\n\n";
	
	print qq^vara is "$form_variables{'vara'}"\n<br>^;
	# comparing the reference type (ref) of the hash element to "ARRAY"
	if (ref($form_variables{'varcheck'}) eq "ARRAY"){ # if its an array
		foreach $varcheck_item(@{$form_variables{'varcheck'}}){
			print qq^a varcheck item is "$varcheck_item"\n<br>^;
		}
	} else {
		if ($form_variables{'varcheck'}){ # if the variable is not empty
			print qq^varcheck is "$form_variables{'varcheck'}"\n<br>^;
		}
	}
	
	my $new_location = "/temporaryfile_" . $form_variables{'myimage'}->{'original_name'};
	rename($form_variables{'myimage'}->{'location'}, "/usr/www/doamin/public_html" . $new_location);
	print qq^<img src="$new_location">\n<br>^;
	
	my $new_location = "/temporaryfile_" . $form_variables{'yourimage'}->{'original_name'};
	rename($form_variables{'yourimage'}->{'location'}, "/usr/www/doamin/public_html" . $new_location);
	print qq^<img src="$new_location">\n<br>^;
	
	my $new_location = "/temporaryfile_" . $form_variables{'ourimage'}->{'original_name'};
	rename($form_variables{'ourimage'}->{'location'}, "/usr/www/doamin/public_html" . $new_location);
	print qq^<img src="$new_location">\n<br>^;
	

