#!/usr/local/bin/perl -- -*- C -*-

#sub MethGet

#sub ReadParse(*in)

#sub PrintHeader

#sub PrintVariables(%in)

#sub PrintVariablesShort(%in)

#sub doerror($txt)

# MethGet
# Return true if this cgi call was using the GET request, false otherwise
# Now that cgi scripts can be put in the normal file space, it is useful
# to combine both the form and the script in one place with GET used to
# retrieve the form, and POST used to get the result.

sub MethGet {
  return ($ENV{'REQUEST_METHOD'} eq "GET");
}

# ReadParse
# Reads in GET or POST data, converts it to unescaped text, and puts
# one key=value in each member of the list "@in"
# Also creates key/value pairs in %in, using '\0' to separate multiple
# selections

# If a variable-glob parameter (e.g., *cgi_input) is passed to ReadParse,
# information is stored there, rather than in $in, @in, and %in.

sub ReadParse {
    local (*in) = @_ if @_;


  local ($i, $loc, $key, $val);
  # Read in text
  if ($ENV{'REQUEST_METHOD'} eq "GET") {
    $in = $ENV{'QUERY_STRING'};
  } elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
    read(STDIN,$in,$ENV{'CONTENT_LENGTH'});
  } else {
  return 0;
  }

  @in = split(/&/,$in);

  foreach $i (0 .. $#in) {
    # Convert plus's to spaces
    $in[$i] =~ s/\+/ /g;

    # Split into key and value.  
    ($key, $val) = split(/=/,$in[$i],2); # splits on the first =.

    # Convert %XX from hex numbers to alphanumeric
    $key =~ s/%(..)/pack("c",hex($1))/ge;
    $val =~ s/%(..)/pack("c",hex($1))/ge;

    # check for percentage numbers and dollar amounts
    if (index($key,"\%") > $[) {
     $val = $val * 0.01;
     $key =~ s/\%//;
    }
    if (index($key,"_") > $[) {
     $val =~ s/\,//;
     $key =~ s/_//;
    }

    # Associate key and value
    $in_key[$i] = $key;
    $in_val[$i] = $val;
    $in{$key} .= "\0" if (defined($in{$key})); # \0 is the multiple separator
    $in{$key} .= $val;
  }

  return $#in; # just for fun
}

# PrintHeader
# Returns the magic line which tells WWW that we're an HTML document

sub PrintHeader {
  return "Content-type: text/html\n\n";
}

# Note: Neither of the PrintVariables functions deals with multiple
#       occurences of keys

# PrintVariables
# Nicely formats variables in an associative array passed as a parameter
# And returns the HTML string.

sub PrintVariables {
  local (%in) = @_;
  local ($old, $out, $output);
  $old = $*;  $* =1;
  $output .=  "<DL COMPACT>";
  foreach $key (sort keys(%in)) {
    ($out = $in{$key}) =~ s/\n/<BR>/g;
    $output .=  "<DT><B>$key</B><DD><I>$out</I><BR>";
  }
  $output .=  "</DL>";
  $* = $old;

  return $output;
}

# PrintVariablesShort
# Nicely formats variables in an associative array passed as a parameter
# Using one line per pair (unless value is multiline)
# And returns the HTML string.


sub PrintVariablesShort {
  local (%in) = @_;
  local ($old, $out, $output);
  $old = $*;  $* =1;
  foreach $key (sort keys(%in)) {
    if (($out = $in{$key}) =~ s/\n/<BR>/g) {
      $output .= "<DL COMPACT><DT><B>$key</B> is <DD><I>$out</I></DL>";
    } else {
      $output .= "<B>$key</B> is <I>$out</I><BR>";
    }
  }
  $* = $old;

  return $output;
}

sub doerror {
 print @_[0];
 exit 0;
}

1; #return true