package FORM_DATA;
sub new{
my ($pkg) = shift;
my ($uuinput) = shift;
my $r_formdata = bless{
'_formdata' => &parse_form($uuinput),
}, $pkg;
return $r_formdata;
}
#Accessor Method
sub pairs{
#print "in pairs now\n";
my ($objref) = shift; # only means something as used $obj -> formdata();
if(@_){
my($name) = shift;
#Check if it exists in our current hash as a key - if so - return it. if not return an error.
if ($objref->{'_formdata'}->{$name}){
return $objref -> {'_formdata'}->{$name}
}else{
return ""; #return null if doesn't exist
}
}else{
$objref->{'_formdata'}; #return a reference to the entire hash.
}
}
sub parse_form{
my ($input_type) = shift;
if(ref ($input_type) eq "HASH"){ #this has to be a ref to a hash
#print "\ngiving a hash.\n";
my(%given_hash) = %$input_type;
return \%given_hash;
}
else {
local (%FORM_RAW);
my($request_method, $query_string, @pairs, $class, $value, @count , @check)=(0);
##print "request_method $request_method\n";
$request_method = $ENV{'REQUEST_METHOD'}; #Which method please
# print "request_method $request_method\n";
if($request_method eq "POST"){
read( STDIN , $query_string, $ENV{'CONTENT_LENGTH'});
}
else{
print "Server Error\n";
}
###Break down and decode####
@pairs = split (/&/,$query_string);
foreach $item ( @pairs){
($class , $value) = split ( /=/, $item );
#print STDOUT "value = $value class = $class\n";
$value =~ tr/+/ /;
##hack precaution %FF format check
##print STDOUT "value = $value\n";
###############VALUE intpretation##########################################
if ($value =~/%/){
@count = $value =~ /%/g;
@check = $value =~ /%[\dA-Fa-f][\dA-Fa-f]/g;
if(@count != @check){
&return_error( 111, "Comunication Error", "Illegal input webmaster is notified
");
}
$value =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack ("C", hex($1))/eg;
}
###########CLASS Intpretation###############################################
$class =~ tr/+//; ###REMOVE SPACES from CLASS - who needs em
if ($class =~/%/){
@count = $class =~ /%/g;
@check = $class =~ /%[\dA-Fa-f][\dA-Fa-f]/g;
if(@count != @check){
&return_error( "111", "Comunication Error", "Illegal input - ema
il webmaster");
}
$class =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack ("C", hex($1))/eg;
}
####Sanitize the input strings#####
$class =~ tr/@a-zA-Z0-9/_/c;
$value =~ tr/@a-zA-Z0-9\-/_/c;
if ($value !~ /\-\d+/) {
$value =~ s/\-/\_/g;
}
##print STDOUT "Sanitized value = $value class = $class\n";
###################################################################
# This little hitch of code is to extend mulitple buttons on one #
# form: So that, as am example, one can overload the PatNum value#
# in a form to use PatNum later family searchs and not screw up #
# The SQL Parsing routine #
###################################################################
if( defined($FORM_RAW{$class})){
$class = join('', $class, $value);
}
$FORM_RAW{ $class } = $value;
}
return \%FORM_RAW;
}
}
return 1;