##############################################################################
#                                                                            #
#  formparse.pm - parses form information                                    #
#                                                                            #
#  Revision:  2.0  11/28/97                                                  #
#                                                                            #
#  Author:    David Harris     <dharris@drh.net>                             #
#                                                                            #
#  History:   Version 2.0                                                    #
#             Made to be object oriented. Added a print function to blab     #
#             out all the form data.                                         #
#                                                                            #
#  History:   Version 1.0                                                    #
#             Uses a tad of code from setupcgi.cgi, which origionally came   #
#             from one of Matt Wright's freeware programs ReadParse subs.    #
#                                                                            #
#                                                                            #
#  COPYRIGHT (C) 1997 David R. Harris  All Rights Reserved.                  #
#                                                                            #
##############################################################################

package formparse;

##############################################################################
# SUB: new($data_source)
# Takes in any post data and puts it into the given vars. $data_source is
# equal to "GET" or "POST" or "GET/POST" or "POST/GET". Returns an object.

sub new
{
	my $class = shift;
	my ($data_source) = @_;
	my (@pairs, $name, $value);
	my ($ref_to_hash, $ref_to_multiple_hash);

	# Get the input and split it into pairs
	if ( uc($data_source) eq "POST" )
	{
		my $buffer;
		read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
		@pairs = split(/&/, $buffer);
	}
	elsif ( uc($data_source) eq "GET" )
	{
		@pairs = split(/&/, $ENV{'QUERY_STRING'});
	}
	elsif ( uc($data_source) eq "GET/POST" )
	{
		my $buffer;
		read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
		@pairs = ( split(/&/, $ENV{'QUERY_STRING'}), split(/&/, $buffer) );
	}
	elsif ( uc($data_source) eq "POST/GET" )
	{
		my $buffer;
		read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
		@pairs = ( split(/&/, $buffer), split(/&/, $ENV{'QUERY_STRING'}) );
	}
	else
	{
		main::my_die("[formparse.pm @{[__LINE__]}][Invalid dataSource = $data_source]");
	}

	# Loop for all the pairs
	foreach $pair (@pairs)
	{

		# Split the pair apart
		($name, $value) = split(/=/, $pair);

		# Un-Webify plus signs and %-encoding
		$value =~ tr/+/ /;
		$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

		# Set the $name / $value pair
		if ( !exists $ref_to_hash->{$name} )
		{
			$ref_to_hash->{$name} = $value;
		}
		else
		{
			$ref_to_multiple_hash->{$name} = []
				if !exists $ref_to_multiple_hash->{$name};
			push(@{$ref_to_multiple_hash->{$name}}, $value);
		}
	}

	# Construct our hash
	my $self = {
		single_info		=> $ref_to_hash,
		multiple_info	=> $ref_to_multiple_hash,
	};

	# Bless and return it
	bless $self, $class;
	return $self;
}

##############################################################################
# SUB: get_single_info_hash_ref()
# Returns a reference to a hash with the single info in it. Import this into
# your local name space and use it for lookups. Do not use it for lookups
# when you expect multiple responces, use get_multiple_list().

sub get_single_info_hash_ref
{
	my $self = shift;

	return $self->{single_info};
}


##############################################################################
# SUB: get_multiple_list($name)
# Returns a list of all data with $name.

sub get_multiple_list
{
	my $self = shift;
	my ($ref_to_hash, $ref_to_multiple_hash, $name) = @_;

	return ($self->{single_info}{$name}, @{$self->{multiple_info}{$name}});
}


##############################################################################
# SUB: handle_checkbox($ref_to_list)
# Modifys the way checkboxes are encoded. Browsers give set the hash value
# to defined if the checkbox is on, we want it to be true. This will make
# on true and off false.

sub handle_checkbox
{
	my $self = shift;
	my ($ref_to_list) = @_;

	my $single_info = $self->{single_info};

	foreach $this_checkbox ( @$ref_to_list )
	{
		$single_info->{$this_checkbox} = defined $single_info->{$this_checkbox}
	}
}


##############################################################################
# SUB: require($exist, $have_value, $error_string)
# Requires that the keys in $exist exist (can have no value) and the keys in
# $have_value have a value ( are not equal to "" ). Without $error_string, this
# returns 1 when there is an error, instead of calling main::my_die

sub require
{
	my $self = shift;
	my ($exist, $have_value, $error_string) = @_;

	my $single_info = $self->{single_info};

	foreach $this_key ( @$exist )
	{
		(
			$error_string eq ''
			?
			return 1
			:
			main::my_die($error_string . "[Missing form key = $this_key]")
		)
			if ( !exists $single_info->{$this_key} );
	}

	foreach $this_key ( @$have_value )
	{
		(
			$error_string eq ''
			?
			return 1
			:
			main::my_die($error_string . "[Missing form key = $this_key]")
		)
			if ( "" eq $single_info->{$this_key} );
	}

	return 0;
}

##############################################################################
# SUB: print()
# Prints out all of the form data. It is formatted to be printed inside of
# a <pre> tag in HTML.

sub print
{
	my $self = shift;
	my ($this_key_space, $print_line);

	my $single_info = $self->{single_info};
	my $multiple_info = $self->{multiple_info};

	foreach $this_key ( sort keys(%$single_info) )
	{
		$print_line = "$this_key = '$single_info->{$this_key}'\n";
		$print_line =~ s/</&lt;/g;
		$print_line =~ s/>/&gt;/g;
		print $print_line;

		if ( exists $multiple_info->{$this_key} )
		{
			$this_key_space = $this_key;
			$this_key_space =~ s/\S/ /g;

			foreach $this_value ( @{ $multiple_info->{$this_key} } )
			{
				$print_line = "$this_key_space = '$this_value'\n";
				$print_line =~ s/</&lt;/g;
				$print_line =~ s/>/&gt;/g;
				print $print_line;
			}
		}
	}
}


1; # Required for packages