#!/usr/local/bin/perl -w #============================================================================ # Copyright 1999 Mikodocs Guide to HTML, http://www.mikodocs.com/ # You may distribute this program freely, but keep # this notice in place. #============================================================================ #============================================================================ # modules # use strict; use CGI; use CGI::Carp 'fatalsToBrowser', 'croak'; $CGI::POST_MAX = 10240; # set maximum size of post # # modules #============================================================================ #============================================================================ # variables # my ( $query, # CGI query object $maxFields, # maximum number of fields to accept $rand, # random number for banners $paramKey, # a single parameter name $inputdata, # filehandle for uploaded files @inputVals, # values for a field (they can send more than one) $inputVal, # a single values for a field $modval, # modified value of $fileinfo, # uploaded file information @params, # array of all fields sent $key,$val, # key an value for $fileinfo hash ); $query=CGI->new; # get CGI object $maxFields=30; # maximum number of fields to accept $rand = int(rand(100000)); # random number for ad banner # # variables #============================================================================ #============================================================================ # top of page # print $query->header; print <<"(TOPOFPAGE)"; Mikodocs Guide to HTML: My CGI

Env

(TOPOFPAGE) # # top of page #============================================================================ #============================================================================ # list # # get list of fields @params = $query->param; if (@params > $maxFields) {croak "No more than $maxFields fields please"} # open table if necessary print "

\n" if @params; foreach $paramKey (@params) { print ""; #---------------------------------------------------------------- # value # $inputdata=$query->param($paramKey); $fileinfo=$query->uploadInfo($inputdata); # if it's an uploaded file if (defined($fileinfo)) { print ""; # name of field print "\n"; } # # value #---------------------------------------------------------------- print "\n"; } # close table if necessary print "
", tablesc($paramKey), "\n"; while (($key,$val) = each %{$fileinfo}) { # content-disposition gives several pieces of # information about the file, so let's parse it up if (lc($key) eq "content-disposition") { my ($dis,@dispieces); foreach $dis (split(m|\s*;\s*|,$val)) { @dispieces=split("\s*=\s*",$dis,2); next unless defined $dispieces[1]; next if $dispieces[0] =~ m|^name$|i; print "\n"; } } # else just print the field else { print "\n"; } } # output the file size seek($inputdata,0,2); # go to end of file handle print "\n"; print "
", tablesc($dispieces[0]), "", tablesc($dispieces[1]), "
", tablesc($key), "", tablesc($val), "
size", tell($inputdata), "
"; # } # else it's not an uploaded file else { # get array of input values @inputVals=$query->param($paramKey); @inputVals=grep(tablesc($_),@inputVals); # name of field print "		", tablesc($paramKey), "
";

        #out put value(s) for field
        foreach $inputVal (@inputVals)
            {$inputVal = tablesc($inputVal)}
        print join("
",@inputVals), 
            "

\n" if @params; # # list #============================================================================ #============================================================================ # bottom of document # # ************************************************************************ # *** IF YOU COPY My CGI, ABSOLUTELY PLEASE DO NOT CHANGE THIS SECTION *** # ************************************************************************ print <<"(END BOTTOM OF PAGE)";

(END BOTTOM OF PAGE) # # bottom of document #============================================================================ #============================================================================ # tablesc # return   undefined or for space-only/empty string, # otherwise change < > and & to character entities # sub tablesc { return " " if (! defined $_[0]) || ($_[0] !~ m|\S|); $_[0] =~ s|&|&|gso; $_[0] =~ s|<|<|gso; $_[0] =~ s|>|>|gso; $_[0]; } # # tablesc #============================================================================