CGI::Thin - A very lightweight Parser for CGI Forms

  Functions

    * `CGI::Thin::Parse_CGI(@keys)'
        The optional @keys will be used to force arrays to be returned.

        The function also has special features for getting multiple values for a
        single form key.  For example if we have this form...

          <input type="checkbox" name="color" value="red">red
          <input type="checkbox" name="color" value="green">green
          <input type="checkbox" name="color" value="blue">blue

        One of three things can happen.

        1)  The user does not select any color.
            So $cgi_data{'color'} will not exist.
        2)  The user selects exactly one color.
            So $cgi_data{'color'} will be the scalar value selected.
        3)  The user selects exactly more than one color.
            So $cgi_data{'color'} will be a reference to an array of the values selected.

        To fix this you could call the parser by giving it a list of keys that you want
        to force to be arrays.  In this case like...

          use CGI::Thin;
          my %cgi_data = &Parse_CGI ('color');

        Now it they pick exactly one color, $cgi_data{'color'} will be a reference to
        an array of the one value selected.  And thus there will be no need for
        special cases later in the code.

    Visit CGI::Thin's web site at
        http://www.PlatypiVentures.com/perl/modules/cgi_thin.shtml
    Send email to
        mailto:cgi_thin@PlatypiVentures.com

    R. Geoffrey Avery
    CPAN ID: RGEOFFREY
    modules@PlatypiVentures.com
    http://www.PlatypiVentures.com/perl

#!/usr/local/bin/perl

package CGI::Thin;
use strict;

BEGIN {
	use Exporter ();
	use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK);
	$VERSION = 0.52;
	@ISA		= qw (Exporter);
	@EXPORT		= qw (&Parse_CGI);
	@EXPORT_OK	= qw (&Force_Array);
}

########################################### main pod documentation begin ##

############################################# main pod documentation end ##

################################################ subroutine header begin ##
################################################## subroutine header end ##

sub Parse_CGI
{
	my %hash = ();

	foreach my $entry (split(/[&;]/, $ENV{'QUERY_STRING'})) {
		&Insert_Item (\%hash, &Divide_Item ($entry));
	}

	if ((defined $ENV{'CONTENT_TYPE'}) && ($ENV{'CONTENT_TYPE'} =~ m|multipart/form-data|si)) {
		my $in;
		read(STDIN, $in, $ENV{'CONTENT_LENGTH'});

		### Find the field "boundary" string.
		my $boundary = substr($in, 0, index($in, "\r\n") - 1);
		### Tokenize the input.
		my @args = split(/\s*$boundary\s*/s, $in);
		### remove extra pieces before first and after last boundary
		shift @args;
		pop @args;

		foreach my $entry (@args) {
			# Split the token into header and content
			my ($head, $item) = split(/\r\n\r\n/ios, $entry, 2);

			# ... name="CGI_FILE" filename="myfile.txt" ....
			# so this is a bit of a trick, based on the double
			# occurence of 'name'.
			my ($name, $file) = ($head =~ /name="(.*?)"/gios);

			my $mimetype;
			if ($head =~ /Content-type:\s*(\S+)/gios) {
				$mimetype = $1;
			}

			### Build a hash for the file if a filename was specified
			$item = {
						"Name"		=> $file,
						"Content"	=> $item,
						"MIME_Type"	=> $mimetype || 'unknown mime type',
						"head"		=> $head,
					} if ($file);

			&Insert_Item (\%hash, $name, $item);

		} # foreach
							  
	} elsif( $ENV{'REQUEST_METHOD'} eq "POST" ){
		my $in;
		read(STDIN, $in, $ENV{'CONTENT_LENGTH'});
		
		foreach my $entry (split(/[&;]/, $in)) {
			&Insert_Item (\%hash, &Divide_Item ($entry));
		}
	}

	foreach (@_) {
		$hash{$_} = &Force_Array ($hash{$_}) if ($hash{$_});
	}

	return (%hash);

}

################################################ subroutine header begin ##
# Convert plus's to spaces
# Convert %XX from hex numbers to alphanumeric
# Return key and value
################################################## subroutine header end ##

sub Divide_Item
{
	my ($item) = @_;

	$item =~ tr/+/ /;
	my ($key, $value) = split ("=", $item, 2);
	$key   =~ s/%([A-Fa-f0-9]{2})/chr(hex($1))/ge;
	$value =~ s/%([A-Fa-f0-9]{2})/chr(hex($1))/ge;
	return ($key, $value);
}


################################################ subroutine header begin ##
################################################## subroutine header end ##

sub Insert_Item
{
	my ($p_hash, $key, $val) = @_;

	if ( defined($p_hash->{$key})) {
		unless (ref ($p_hash->{$key}) eq "ARRAY") {
			my $firstval = $p_hash->{$key};
			$p_hash->{$key} = [$firstval];
		}
		push (@{$p_hash->{$key}}, $val);
	} else {
		$p_hash->{$key} = $val;
	}
}

################################################ subroutine header begin ##
################################################## subroutine header end ##

sub Force_Array
{
	my ($item) = @_;

	$item = [$item] unless( ref($item) eq "ARRAY" );

	return ($item);
}

###########################################################################
###########################################################################

1;

__END__