#!/bin/perl -- -*- C -*- # Perl Routines to Manipulate CGI input # S.E.Brenner@bioc.cam.ac.uk # $Header: /cys/people/brenner/http/cgi-bin/RCS/cgi-lib.pl,v 1.8 1995/04/07 21:35:29 brenner 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, Bo Frese Rasmussen, # Andrew Dalke, Mark-Jason Dominus and Dave Dittrich. # Minimalist http form and script (http://www.bio.cam.ac.uk/web/minimal.cgi): # sub ReadParse { local (*in) = @_ if @_; local ($i, $key, $val); # Read in text if (&MethGet) { $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; # 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; # Associate key and value $in{$key} .= "\0" if (defined($in{$key})); # \0 is the multiple separator $in{$key} .= $val; } return length($in); } # PrintHeader # Returns the magic line which tells WWW that we're an HTML document sub PrintHeader { return "Content-type: text/html\n\n"; } # MethGet # Return true if this cgi call was using the GET request, false otherwise sub MethGet { return ($ENV{'REQUEST_METHOD'} eq "GET"); } # MyURL # Returns a URL to the script sub MyURL { return 'http://comp.uark.edu/~jwiggins/' . $ENV{'SERVER_NAME'} . $ENV{'SCRIPT_NAME'}; } # CgiError # Prints out an error message which which containes appropriate headers, # markup, etcetera. # Parameters: # If no parameters, gives a generic error message # Otherwise, the first parameter will be the title and the rest will # be given as different paragraphs of the body sub CgiError { local (@msg) = @_; local ($i,$name); if (!@msg) { $name = &MyURL; @msg = ("Error: script $name encountered fatal error"); }; print &PrintHeader; print "
$msg[$i]
\n"; } print "\n"; } # 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 .= "