CGI How-To/CGI HOW-TO.iso/chap9/encoder/cgilib.pl

Perl Script | 1996-06-15 | 4.6 KB | 257 lines

#!/usr/local/bin/perl

# This file contains the subroutines needed to
# read CGI input. To use the library,
# call the subroutines readData and parseData.
#
# &readData(*data);
# &parseData(*data,*dataDict);
#
# Read data takes a scalar by name, and parse data,
# uses that scalar and a dictionary by name. The
# dictionary is filled with the key-value pairs of
# data from the CGI scripts input.
# You can also use the convience routine
# readParse, that take the name of a dictionary.
#
# &readParse(*dataDict);
#
# Subroutine for decoding form data

sub decodeData
{
    local(*queryString) = @_ if @_;

    #convert pluses to spaces

    $queryString =~ s/\+/ /g;

    # Convert the hex codes
    #
    # First find them with s/%(..)//ge,
    # then turn the found hexcode into a decimal number,
    # then pack the decimal number into character form,
    # then do normal substitution.

    $queryString =~ s/%([0-9A-Fa-f]{2})/pack("c",hex($1))/ge;

    # Return 1 for success

    return 1;
}

# Subroutine for encoding data
# This subroutine is very conservitive and converts
# Some characters that it doesnt need to

sub encodeData
{
    local($queryString) = @_ if @_;

    # Convert the hex codes
    #
    # First find them
    # then turn the found
    # then do normal substitution.

    $queryString =~ s/([^a-zA-Z0-9+ ])/sprintf("%%%lx",ord($1))/ge;

    #convert pluses to spaces

    $queryString =~ s/ /\+/g;

    $queryString = "" unless $queryString;

    # Return 1 for success

    return $queryString;
}

# Subroutine that converts a dictionary
# into a cgi encoded string

sub encodeDictionary
{
    local(*formData) = @_;
    local($returnString,$key,$needAmp);

    $needAmp = 0;

    foreach $key (keys(%formData))
    {
    if($key =~ /^A_/)
    {
        if($needAmp)
        {
        $returnString .= "&";
        }

        $returnString .= &encodeData($key);
        $returnString .= "=";
        $returnString .= &encodeData($formData{$key});

        $needAmp = 1;
    }
    }

    return $returnString;
}

# Subroutine for interpreting form data

sub parseData
{
    local(*queryString,*formData) = @_ if @_;

    local($key,$value,$curString,@tmpArray,$aName);

    # Split the string into key-value pairs, using the '&' character

    @tmpArray = split(/&/,$queryString);

    # Loop over each pair found

    foreach $curString (@tmpArray)
    {
        # Split the key and value, using the '=' character

        ($key,$value) = split(/=/,$curString);

        # Decode the key and value

        &decodeData(*key);
        &decodeData(*value);

        # Add the keys and values to the dictionary
        #
        # We will store multple values under a new name,
        # as a string, using the format, value1\376value2...
        # Where \376 is a character unlikely to appear in the
        # values.

        if($formData{$key}) # See if this is a multiple value
        {
            $aName = "A_".$key; # Make a new key

            if($formData{$aName}) #Check if the array already exists
            {
                $formData{$aName} .= "\376";
                $formData{$aName} .= $value;

                # Also put the newest value in the dictionary
                # at the real key.

                $formData{$key} = $value;

            }
            else #If not, create it and add the current value to the array
            {
                # Add the 1st value for the key to the string
                $formData{$aName} = $formData{$key};

                # Add the one that we just found

                $formData{$aName} .= "\376";
                $formData{$aName} .= $value;

                # Also put the newest value in the dictionary
                # at the real key.

                $formData{$key} = $value;
            }
        }
        else # Just add it
        {
            $formData{$key} = $value;
        }
    }

    return 1;
}

# Subroutine for reading post data

sub readPostData
{
    local(*queryString) = @_ if @_;

    local($contentLength);

    # Read the environment variable CONTENT_LENGTH

    $contentLength = $ENV{"CONTENT_LENGTH"};

    # Make sure that there is data to read

    if($contentLength)
    {
        # Read contentLength characters from STDIN into queryString

        read(STDIN,$queryString,$contentLength);
    }

    # Return 1 for success

    return 1;
}

sub readGetData
{
    local(*queryString) = @_ if @_;

    # Read the environment variable QUERY_STRING

    $queryString = $ENV{"QUERY_STRING"};

    return 1;
}

sub readData
{
    local(*queryString) = @_ if @_;

    # Read the envorinmental variable REQUEST_METHOD

    $requestType = $ENV{"REQUEST_METHOD"};

    # If the request is GET use readGetData
    # otherwise, if the request is POST use readPostData

    if($requestType eq "GET")
    {
        &readGetData(*queryString);
    }
    elsif($requestType eq "POST")
    {
        &readPostData(*queryString);
    }

    $queryString = "" unless $queryString;

}

# Read parse takes the name of a dictionary, and fills
# it with GET or POST cgi data.

sub readParse
{
    local(*dataDict) = @_;
    local($data);


    &readData(*data);
    if($data)
    {
    &parseData(*data,*dataDict);
    }
}

1;