# Perl Routines to Manipulate CGI input.
# Usage:
# Use this library, of course:
#	require 'CGI_LIB.pl';
#
# Print the "Content-Type:" line:
#	&Print_Head;
#
# "GET" method: 
#	&Parse_Data;
# All the variables will be parsed into %CGI. $CGI{'NAME'} is the value
# of the variable "NAME".
#
# "POST" method:
#	&Parse_Data;
# Data parsed in the way same as "GET" method.
#
# If "ENCTYPE" is used ( for Netscape2.0 extension & HTML3.0 ):
#	&Parse_Multi;
# The data will be parsed into %CGI, $CGI{'NAME'} is the value of the
# variable "NAME". If variable's type is "FILE", (i.e. TYPE="FILE" in
# form) there'll have an extension information for this variable; and
# those informations are assigned to $EXT{'NAME'}. $EXT{'NAME'} has
# style like 'filename="xxxx"' (or maybe 'filename="xx"; yyy="zzz"',
# I'm not sure as I've not met this b4), so you need to parse it again
# in your cgi program. If the uploaded file has known suffix, ( such
# as .gif ) which "Content-Type" will be contained in the part,
# $C_TYPE{name} is the content type of the value.
#
# You can try http://140.114.63.14:6083/doc/upload.html
#
sub Parse_Data {
    local($raw_data,@items,$key,$value);

    $raw_data = &Parse_Method;

    # Split different "NAME" and their values.
    @items = split('&', $raw_data);

    # For each list of "NAME=its_value".
    for (@items) {

	$_ =~ tr/+/ /;
	($key,$value) = split('=',$_,2);

	# The %xx hex numbers are converted to alphanumeric.
	$key   =~ s/%(..)/pack("C", hex($1))/eg;
	$value =~ s/%(..)/pack("C", hex($1))/eg;
	$CGI{$key} = $value;

    }

}

sub Print_Head {
    print "Content-Type: text/html\n\n";
}

sub Parse_Multi {
    local($boundary,@pairs,$position);
    local($raw_data,$value,$name,$part,$type);

    if ( $ENV{CONTENT_TYPE} =~ /application\/x-www-form-urlencoded/ ) {
	&Parse_Data;
	return;
    };

    $raw_data = &Parse_Method;
    ($boundary = $ENV{CONTENT_TYPE}) =~ s/^.*boundary=(.*)$/\1/;
    @pairs = split(/--$boundary/, $raw_data);
    @pairs = splice(@pairs,1,$#pairs-1);

    for $part (@pairs) {
      undef $type if defined $type;
      ($position = $part) =~ s/^Content-Disposition: form-data; (.*)(\n.*)+/\1/mg;
      $position =~ s/\r\n//mg;
      if ( $position =~ /^name=".*";\s.*$/ ) {
	if ( $part =~ /^Content-Disposition:.*\nContent.*/ ) {
          ($value = $part) =~ s/^Content-Disposition: form-data; .*\nC.*\n(.*)/\1/mg;
	  ($type = $part) =~ s/^Content-Dis.*\nContent-Type:\s+(.*\/.*)(\n.*)+/\1/mg;
	  $type =~ s/(\r\n|\r)//mg;
        }
        else {
          ($value = $part) =~ s/^Content-Disposition: form-data; .*\n(.*)/\1/mg;
        }
        ($name = $position) =~ s/^name="(.*)";.*$/\1/;
        ($ext = $position) =~ s/^name=".*"(;.*)+$/\1/;
	$ext =~ s/(^;\s*|\r)//mg;
	$EXT{$name} = $ext;
	$C_TYPE{$name} = $type;
      }
      else {
        ($value = $part) =~ s/^Content-Disposition: form-data; .*\n\s*\n(.*)/\1/mg;
        ($name = $position) =~ s/^name="(.*)"\s+$/\1/;
      } 
      $value =~ s/\r\n//mg;
      $CGI{$name} = $value;  
    }
}

sub Parse_Method {
    local($buffer);

    if ($ENV{'REQUEST_METHOD'} eq "POST") {
      read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
      return $buffer;
    }
    elsif ($ENV{'REQUEST_METHOD'} eq "GET") {
      return $ENV{'QUERY_STRING'};
    }
    else {
      return 0;
    }
}
#END of CGI_LIB.pl library.
1; 
__END__