From 7c9d662d272235833b9fe741221f38e47247a6b3 Mon Sep 17 00:00:00 2001 From: ijackson Date: Fri, 18 Jun 1999 15:56:08 +0000 Subject: [PATCH 1/1] Copied in cgi-lib.pl --- cgi-lib.pl | 203 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 203 insertions(+) create mode 100644 cgi-lib.pl diff --git a/cgi-lib.pl b/cgi-lib.pl new file mode 100644 index 0000000..97e894d --- /dev/null +++ b/cgi-lib.pl @@ -0,0 +1,203 @@ +#!/usr/local/bin/perl + +# Perl Routines to Manipulate CGI input +# +# Copyright (c) 1995 Steven E. Brenner +# 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, Dave Dittrich, Jason Mathews + +# For more information, see: +# http://www.bio.cam.ac.uk/web/form.html +# http://www.seas.upenn.edu/~mengwong/forms/ + +# Minimalist http form and script (http://www.bio.cam.ac.uk/web/minimal.cgi): +# +# require "cgi-lib.pl"; +# if (&ReadParse(*input)) { +# print &PrintHeader, &PrintVariables(%input); +# } else { +# print &PrintHeader,'

Data: '; +#} + +# ReadParse +# Reads in GET or POST data, converts it to unescaped text, +# creates key/value pairs in %in, using '\0' to separate multiple +# selections + +# Returns TRUE if there was input, FALSE if there was no input +# UNDEF may be used in the future to indicate some failure. + +# 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. If no parameters +# are given (i.e., ReadParse returns FALSE), then a form could be output. + +# 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, $key, $val); + + # Read in text + if (&MethGet) { + $in = $ENV{'QUERY_STRING'}; + } elsif (&MethPost) { + 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 scalar(@in); +} + + +# PrintHeader +# Returns the magic line which tells WWW that we're an HTML document + +sub PrintHeader { + return "Content-type: text/html\n\n"; +} + + +# HtmlTop +# Returns the of a document and the beginning of the body +# with the title and a body

header as specified by the parameter + +sub HtmlTop +{ + local ($title) = @_; + + return < + +$title + + +
$title
+END_OF_TEXT +} + +# Html Bot +# Returns the , codes for the bottom of every HTML page + +sub HtmlBot +{ + return "\n\n"; + } + + +# MethGet +# Return true if this cgi call was using the GET request, false otherwise + +sub MethGet { + return ($ENV{'REQUEST_METHOD'} eq "GET"); +} + + +# MethPost +# Return true if this cgi call was using the POST request, false otherwise + +sub MethPost { + return ($ENV{'REQUEST_METHOD'} eq "POST"); +} + + +# MyURL +# Returns a URL to the script + +sub MyURL { + local ($port); + $port = ":" . $ENV{'SERVER_PORT'} if $ENV{'SERVER_PORT'} != 80; + return 'http://' . $ENV{'SERVER_NAME'} . $port . $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[0]\n"; + print "
$msg[0]
\n"; + foreach $i (1 .. $#msg) { + print "
$msg[$i]
\n"; + } + print "\n"; +} + + +# CgiDie +# Identical to CgiError, but also quits with the passed error message. + +sub CgiDie { + local (@msg) = @_; + &CgiError (@msg); + die @msg; +} + + +# 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 .= "\n
\n"; + foreach $key (sort keys(%in)) { + foreach (split("\0", $in{$key})) { + ($out = $_) =~ s/\n/
\n/g; + $output .= "
$key\n
$out
\n"; + } + } + $output .= "
\n"; + $* = $old; + + return $output; +} + +# PrintVariablesShort +# Now obsolete; just calls PrintVariables + +sub PrintVariablesShort { + return &PrintVariables(@_); +} + +1; #return true + + -- 2.30.2