# FILE: cgi-utils.pl

# DESCRIPTION:
# This is a library of useful perl cgi scripting routines.
# It's intended for perl4.  For perl5 (recommended), use
# CGI.pm, located at:
#         http://www-genome.wi.mit.edu/ftp/pub/software/WWW/

# AUTHOR: Lincoln Stein (lstein@genome.wi.mit.edu)

# Function descriptions:

# get_query()
#     Returns the user's query as an array.
#     Usage:
#          @keywords = &get_query;
#                   -or-
#          %parameters = &get_query;

#     For keyword list searches in the form "key1+key2+key3"
#     this function returns an array of the unescaped search
#     terms.

#     For parameter lists in the form "param1=val1&param2=val2"
#     this function returns an associative array.  Each parameter
#     becomes a key in the array.  If the same parameter
#     appears multiple times in the query, the multiple values
#     will be stored as a packed array separated by the perl
#     $; character.  For example, if the query string is
#     "sports=tennis&sports=hockey&sports=golf&region=NW"
#     then the value of sports can be obtained with
#           %param = &cgi'get_query;
#           @sports = split($;,$param{'sports'});

#     This function works for both GET and POST scripts.  For
#     debugging scripts offline, you can also place search terms
#     on the command line or submit them in standard input.  In the
#     latter case, you can separate parameter/value pairs by
#     newlines, as in:
#           sports=tennis
#           sports=hockey
#           region=NW

# cgi'unescape
#     Translates escape codes back into the original characters.
#     Usage:
#         $unescaped = &cgi'unescape($encoded)

# cgi'escape
#     Translates funny characters into escape sequences.
#     Usage:
#         $escaped = &cgi'escape($original)

package cgi;

sub main'get_query {
    local($query_string);
    local(@lines);
    local($method)=$ENV{'REQUEST_METHOD'};

    # See whether 
    # If method is GET or HEAD, fetch the query from
    # the environment.
    if ($method=~/^(GET|HEAD)$/) {
      $query_string = $ENV{'QUERY_STRING'};

    # If the method is POST, fetch the query from standard
    # input.
    } elsif ($method eq 'POST') {
      read(STDIN,$query_string,$ENV{'CONTENT_LENGTH'});

    # If neither is set, assume we're being debugged offline.
    # Check the command line and then the standard input for data.
    } elsif (@ARGV) {
        $query_string = "@ARGV";
        # massage it back into standard format
        $query_string=~tr/ /&/ if $query_string=~/=/;
    } else {                    # fetch from standard input
        chop(@lines = <>);              # remove newlines
        # massage back into standard format
        if ("@lines" =~ /=/) {
          $query_string=join("&",@lines);
        } else {
          $query_string=join("+",@lines);
        }
    }
    
    # No data.  Return an empty array.
    return () unless $query_string;

    # We now have the query string in hand.  We do slightly
    # different things for keyword lists and parameter lists.
    return &parse_params($query_string)
      if $query_string =~ /=/;

    return &parse_keywordlist($query_string);
}

sub unescape {
    local($todecode) = @_;
    $todecode =~ tr/+/ /;       # pluses become spaces
    $todecode =~ s/%([0-9A-Ha-h]{2})/pack("c",hex($1))/ge;
    return $todecode;
}

sub escape {
    local($toencode) = @_;
    $toencode=~s/([\W])/sprintf("%%%x",ord($1))/eg;
    return $toencode;
}

# -------------- semi-private subroutines -----------------
sub parse_keywordlist {
    local($tosplit) = @_;
    $tosplit = &unescape($tosplit); # unescape the keywords
    $tosplit=~tr/+/ /;          # pluses to spaces
    local(@keywords) = split(/\s+/,$tosplit);
    return @keywords;
}

sub parse_params {
    local($tosplit) = @_;
    ## changed & to [&;] to adhere to the recommendation
    ## in RFC 1866 section 8.2.1   TC / 30 july 1998
    local(@pairs) = split(/[&;]/,$tosplit);
    local($param,$value,%parameters);
    foreach (@pairs) {
      ($param,$value) = split('=');
      $param = &unescape($param);
      $value = &unescape($value);
      unless ($parameters{$param}) {
          $parameters{$param} = $value;
      } else {
          $parameters{$param} .= "$;$value";
      }
    }
    return %parameters;
}

1; # so that require() returns true