# CGI_LIB.pl : Perl Routines to Manipulate CGI input.
# Author : Simon Tneoh Chee-Boon
# Email : tneohcb@tneoh.zoneit.com or tneohcb@pc.jaring.my
# Last modified : 21st.Jul.1997
# Homepage : http://www.tneoh.zoneit.com/cgi/upload
# Changes : Multiple value is ok now. (For example: "multiple
# select form")
# New way to store uploaded file's data and works for
# both "windows" and "unix" platforms.
# Usage :
#
# Use this library, of course:
# require 'CGI_LIB.pl';
# * If your CGI_LIB.pl is not inside @INC directories. You can do
# the followings:
# 1) #!/usr/bin/perl -I/dir/where/this/lib/file/saved
# 2) Add the directory to the environment variable "PERL5LIB".
#
# Print the "Content-Type: text/html\n\n":
# &Print_Head;
#
# For both "GET" and "POST" methods, all data will be parsed into %CGI.
# EG: Single value =>
# $CGI{'TextVar'} is equal to "123".
# Multiple value =>
# $CGI{'SelectVar'} will be an array.
# $CGI{'SelectVar'}[0] is equal to "Sel1".
# $CGI{'SelectVar'}[1] is equal to "Sel2".
# You can check whether it's an array or not by using:
# if (ref($CGI{'SelectVar'}) =~ /ARRAY/) ...
#
# For those data with enctype="multipart/form-data" will also be
# parsed into %CGI.
# * Make sure in your form tag same as the followings:
#
#
#
#-------------END---------------------------------------------------------
#-----------/cgi-bin/uploader.cgi-----------------------------------------
# #!/usr/bin/perl
# require 'CGI_LIB.pl';
# #For those whose server is on windows system, you need the following
# #three lines.
# #Thanks to Carlo Maria Piacenti who told me about this.
# binmode(STDIN);
# binmode(STDOUT);
# binmode(STDERR);
# &Parse_Multi;
# print "Content-Type: $CGI{'UploadedFile'}->{'Content-Type'}\n\n";
# print $CGI{'UploadedFile'}->{'Contents'};
#--------------END--------------------------------------------------------
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;
if (grep(/^$key$/, keys(%CGI))) {
if (@{$CGI{$key}} > 0) {
push(@{$CGI{$key}}, "$value");
}
else {
$arrvalue = $CGI{$key};
undef $CGI{$key};
$CGI{$key}[0] = $arrvalue;
push(@{$CGI{$key}}, "$value");
}
}
else {
$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);
$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) {
$part =~ s/[\r]\n$//g;
($dump, $firstline, $datas) = split(/[\r]\n/, $part, 3);
next if $firstline =~ /filename=\"\"/;
$firstline =~ s/^Content-Disposition: form-data; //;
(@columns) = split(/;\s+/, $firstline);
($name = $columns[0]) =~ s/^name="([^"]+)"$/\1/g;
if ($#columns > 0) {
if ($datas =~ /^Content-Type:/) {
($CGI{"$name"}->{'Content-Type'}, $blankline, $datas) = split(/[\r]\n/, $datas, 3);
$CGI{"$name"}->{'Content-Type'} =~ s/^Content-Type: ([^\s]+)$/\1/g;
}
else {
($blankline, $datas) = split(/[\r]\n/, $datas, 2);
$CGI{"$name"}->{'Content-Type'} = "application/octet-stream";
}
}
else {
($blankline, $datas) = split(/[\r]\n/, $datas, 2);
if (grep(/^$name$/, keys(%CGI))) {
if (@{$CGI{$name}} > 0) {
push(@{$CGI{$name}}, $datas);
}
else {
$arrvalue = $CGI{$name};
undef $CGI{$name};
$CGI{$name}[0] = $arrvalue;
push(@{$CGI{$name}}, $datas);
}
}
else {
next if $datas =~ /^\s*$/;
$CGI{"$name"} = $datas;
}
next;
}
for $currentColumn (@columns) {
($currentHeader, $currentValue) = $currentColumn =~ /^([^=]+)="([^"]+)"$/;
$CGI{"$name"}->{"$currentHeader"} = $currentValue;
}
$CGI{"$name"}->{'Contents'} = $datas;
}
}
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__