ch06l02.txt

《Web编程专家指南》

Listing 6.2 Read and parse input from forms.

############################################################################
##                             CGI-PARSE.PL                               ##
## A library to read and parse the input available from forms as per      ##
## the CGI 1.1 specification.                                             ##
## This code is in the public domain for people to do whatever they wish  ##
## to with it. But, maintain this copyright notice and don't say you      ##
## wrote it. This work is distributed in the hope that its useful. But,   ##
## the author is not liable for any any incurred damages, directly or     ##
## indirectly due to the use or inability to use this software.           ##
############################################################################
############################################################################
## CGIGetInput                                                            ##
## This is a small function which decodes the forms input. It looks at    ##
## the REQUEST_METHOD environment variable to decide where to get the     ##
## input from. The user can invoke this subroutine thus                   ##
##              &CGIGetInput (*cgi_in);                                   ##
## and the input is returned in an associative array called cgi_in, with  ##
## the key being the name of field and its value being the value of the   ##
## field as supplied by user. If the field does not have any input, the   ##
## entry in the associative array will be undefined.                      ##
############################################################################

sub CGIGetInput {
    local (*input) = @_;
    local ($buffer,@nv_pairs);
    if ($ENV{'REQUEST_METHOD'} eq "GET") {
    $buffer = $ENV{'QUERY_STRING'};
    }
    elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
    read (STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
    }

else {
    return -1;
    }
    @nv_pairs = split (/\&/,$buffer);

    foreach $nvp (0..$#nv_pairs) {
    $nv_pairs[$nvp] =~ tr/+/ /;
        ($key, $keyword) = split (/=/, $nv_pairs[$nvp], 2);
    $key =~ s#%(..)#pack("c",hex($1))#ge;
    $keyword =~ s#%(..)#pack("c",hex($1))#ge;
    $input{$key} .= '\0' if (defined ($input{$key}));
        $input{$key} .= $keyword;
    }
    return 1;
}

############################################################################
## &PrintHeader (type/URL, is_it_a_URL)                                   ##
## This function prints the default header. If a type is specified, that  ##
## ia printed, else the default text/html is printed. If the second       ##
## parameter is 1, then the Location header is printed instead of         ##
## the text/html header.                                                  ##
##                                                                        ##
## Example invocations:                                                   ##
##      &PrintHeader ("text/plain", 0)                                    ##
##           &PrintHeader ("http://www.halcyon.com/hedlund/cgi-faq/",1)   ##
##              &PrintHeader ("",0)                                       ##
############################################################################

sub PrintHeader {
    local ($toprint, $url_p) = @_;

    if ($toprint eq "") {
    print "Content-type: text/html\n\n";
    }
    elsif ($url_p) {
    print "Location: $toprint\n\n";
    }
    else {
    print "Content-type: $toprint\n\n";
    }
}
1;