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

# Perl Routines to Manipulate CGI input
# S.E.Brenner@bioc.cam.ac.uk
# $Header: /cys/people/seb1005/http/cgi-bin/RCS/cgi-lib.pl,v 1.4 1994/06/28 22:32:26 seb1005 Exp $
#
# Copyright 1994 Steven E. Brenner  
# Unpublished work.
# Permission granted to use and modify this library so long as the
# copyright above is maintained, modifications are documented, and
# credit is given for any use of the library.
#
# Thanks are due to many people for reporting bugs and suggestions
# especially Meng Weng Wong, Maki Watanabe, and Bo Frese Rasmussen

# see http://www.seas.upenn.edu/~mengwong/forms/   or
#     http://www.bio.cam.ac.uk/web/                for more information

# Minimalist http form and script (http://www.bio.cam.ac.uk/web/minimal.cgi):
# if (&MethGet) {
#   print &PrintHeader,
#       '<form method=POST><input type="submit">Data: <input name="myfield">';
# } else {
#   &ReadParse(*input);
#   print &PrintHeader, &PrintVariables(%input);
# }

# some  functions  have  been  added  by eamon daly,
# vampyr@acs.bu.edu.  because  i'm cool. you may  do
# whatever you like with them.

# Some functions have been even further modified by Chris Hodges
# hodgesc@rockie.nsc.com

# 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'});
  }

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

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

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

    # Split into key and value.  
    ($key, $val) = split(/=/,$in[$i],2); # splits on the first =.
    $in{$key} .= '\0' if (defined($in{$key})); # \0 is the multiple separator
    $in{$key} .= $val;
  }

  return 1; # 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";
}

# PrintError
# $!,  of  course, takes  the  error  from the
# system;  $exterr takes added  info submitted prior
# to  this function  call;  and  $errrand returns  a
# random error number.

sub PrintError {
  if (!$goto) {
    $goto = "/iface/EmptyPage.html";
  }
  srand(time^$$);
  $errrand = int(rand(100)) * 10;
  return <<EndOfError;
<title>There seems to be a problem...</title>
<h1>
<a href="$goto"> <img    alt=" . . " align=top src="/images/caution.gif"> Whoops!</a>
</h1>
<hr>
<h1>Sorry about that...</h1>
<hr>
Having Trouble.<p>
<hr>
<h1>$errrand Error: $exterr $!</h1>
<hr>
EndOfError
$! = "";
$exterr = "";
exit;
}

# IntoTags
# it's a round-about way of doing it, but it insures
# less errors for the basic tags you might find in a
# text file.  for now, only  bold, italic,  img, and
# anchors are supported.

sub IntoTags {
  $_ = $_[0];

  s/>/&gt;/;
  s/</&lt;/;

  s/(&lt;b&gt;)/<b>/;
  s/(&lt;\/b&gt;)/<\/b>/;

  s/(&lt;i&gt;)/<i>/;
  s/(&lt;\/i&gt;)/<\/i>/;

  s/(&lt;\/a&gt;)/<\/a>/;
  s/(&lt;a href)/<a href/;

  s/(&lt;img )/<img /;
  s/(\"&gt;)/\">/;
      
  return $_;
}

# NullForm
# returns  a    simple  message   when   not  enough
# information is  provided in a given form. provides
# a jump back to whatever point.

sub NullForm {
  local($backto, $reason) = @_;
  $reason .= "<p>You have filled out the form incorrectly. Please return to the form and try again.</p>";
  return <<EndOfDave;
<title>I can't do that, Dave...</title>
<h1><a href=$backto>
<img align=top alt=" . . " src="/images/caution.gif"></a>I can't do that, Dave...</h1>
<hr>
<h1>Please note instructions below.</h1>
<hr>$reason<hr>
EndOfDave
}


# 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 SortByNumber {
  $a <=> $b;
}

1; #return true

