Well, I'm a little bit behind
schedule because the home page for Form.pm just got erased (long story).
Anyway, I just setup a backup system on my server now so I'll have a weeks worth
of daily backup's (ya, I know I should have had this before). But attached
are the main functions of Form.pm there are three functions I left out.
One is Form, another is read_net_input and the last one is
write_file. By the way, do I have any reason to believe that somebody may
run off with my code and claim it as their own?
I was about to just include a
link to the home page for Form.pm in this email, but now that its gone I'm not
going to do that. I'm hoping a buddy of mine has a cached copy.
I have yet to implement the file
size limitations, file upload limitation, and the get with post
option.
Soon, I will get the home page back together (I may
have to rebuild it from scratch), then I'll post that, and you can just download
the actual lib with all of the functions and the perldoc in it.
David
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
}
}
-- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]
