cgi/cgi-lib.pl

   1 #!/usr/bin/perl
   2
   3 # Perl Routines to Manipulate CGI input
   4 #
   5 # Copyright (c) 1995 Steven E. Brenner
   6 # Permission granted to use and modify this library so long as the
   7 # copyright above is maintained, modifications are documented, and
   8 # credit is given for any use of the library.
   9 #
  10 # Thanks are due to many people for reporting bugs and suggestions
  11 # especially Meng Weng Wong, Maki Watanabe, Bo Frese Rasmussen,
  12 # Andrew Dalke, Mark-Jason Dominus, Dave Dittrich, Jason Mathews
  13
  14 # For more information, see:
  15 #     http://www.bio.cam.ac.uk/web/form.html
  16 #     http://www.seas.upenn.edu/~mengwong/forms/
  17
  18 # Minimalist http form and script (http://www.bio.cam.ac.uk/web/minimal.cgi):
  19 #
  20 # require "cgi-lib.pl";
  21 # if (&ReadParse(*input)) {
  22 #    print &PrintHeader, &PrintVariables(%input);
  23 # } else {
  24 #   print &PrintHeader,'<form><input type="submit"> Data: <input name="myfield">';
  25 #}
  26
  27 # ReadParse
  28 # Reads in GET or POST data, converts it to unescaped text,
  29 # creates key/value pairs in %in, using '\0' to separate multiple
  30 # selections
  31
  32 # Returns TRUE if there was input, FALSE if there was no input
  33 # UNDEF may be used in the future to indicate some failure.
  34
  35 # Now that cgi scripts can be put in the normal file space, it is useful
  36 # to combine both the form and the script in one place.  If no parameters
  37 # are given (i.e., ReadParse returns FALSE), then a form could be output.
  38
  39 # If a variable-glob parameter (e.g., *cgi_input) is passed to ReadParse,
  40 # information is stored there, rather than in $in, @in, and %in.
  41
  42 sub ReadParse {
  43   local (*in) = @_ if @_;
  44   local ($i, $key, $val);
  45
  46   # Read in text
  47   if (&MethGet) {
  48     $in = $ENV{'QUERY_STRING'};
  49   } elsif (&MethPost) {
  50     read(STDIN,$in,$ENV{'CONTENT_LENGTH'});
  51   }
  52
  53   @in = split(/[&;]/,$in);
  54
  55   foreach $i (0 .. $#in) {
  56     # Convert plus's to spaces
  57     $in[$i] =~ s/\+/ /g;
  58
  59     # Split into key and value.
  60     ($key, $val) = split(/=/,$in[$i],2); # splits on the first =.
  61
  62     # Convert %XX from hex numbers to alphanumeric
  63     $key =~ s/%(..)/pack("c",hex($1))/ge;
  64     $val =~ s/%(..)/pack("c",hex($1))/ge;
  65
  66     # Associate key and value
  67     $in{$key} .= "\0" if (defined($in{$key})); # \0 is the multiple separator
  68     $in{$key} .= $val;
  69
  70   }
  71
  72   return scalar(@in);
  73 }
  74
  75
  76 # PrintHeader
  77 # Returns the magic line which tells WWW that we're an HTML document
  78
  79 sub PrintHeader {
  80   return "Content-type: text/html\n\n";
  81 }
  82
  83
  84 # HtmlTop
  85 # Returns the <head> of a document and the beginning of the body
  86 # with the title and a body <h1> header as specified by the parameter
  87
  88 sub HtmlTop
  89 {
  90   local ($title) = @_;
  91
  92   return <<END_OF_TEXT;
  93 <html>
  94 <head>
  95 <title>$title</title>
  96 </head>
  97 <body>
  98 <h1>$title</h1>
  99 END_OF_TEXT
 100 }
 101
 102 # Html Bot
 103 # Returns the </body>, </html> codes for the bottom of every HTML page
 104
 105 sub HtmlBot
 106 {
 107    return "</body>\n</html>\n";
 108  }
 109
 110
 111 # MethGet
 112 # Return true if this cgi call was using the GET request, false otherwise
 113
 114 sub MethGet {
 115   return ($ENV{'REQUEST_METHOD'} eq "GET");
 116 }
 117
 118
 119 # MethPost
 120 # Return true if this cgi call was using the POST request, false otherwise
 121
 122 sub MethPost {
 123   return ($ENV{'REQUEST_METHOD'} eq "POST");
 124 }
 125
 126
 127 # MyURL
 128 # Returns a URL to the script
 129
 130 sub MyURL  {
 131   local ($port);
 132   $port = ":" . $ENV{'SERVER_PORT'} if  $ENV{'SERVER_PORT'} != 80;
 133   return  'http://' . $ENV{'SERVER_NAME'} .  $port . $ENV{'SCRIPT_NAME'};
 134 }
 135
 136
 137 # CgiError
 138 # Prints out an error message which which containes appropriate headers,
 139 # markup, etcetera.
 140 # Parameters:
 141 #  If no parameters, gives a generic error message
 142 #  Otherwise, the first parameter will be the title and the rest will
 143 #  be given as different paragraphs of the body
 144
 145 sub CgiError {
 146   local (@msg) = @_;
 147   local ($i,$name);
 148
 149   if (!@msg) {
 150     $name = &MyURL;
 151     @msg = ("Error: script $name encountered fatal error");
 152   };
 153
 154   print &PrintHeader;
 155   print "<html><head><title>$msg[0]</title></head>\n";
 156   print "<body><h1>$msg[0]</h1>\n";
 157   foreach $i (1 .. $#msg) {
 158     print "<p>$msg[$i]</p>\n";
 159   }
 160   print "</body></html>\n";
 161 }
 162
 163
 164 # CgiDie
 165 # Identical to CgiError, but also quits with the passed error message.
 166
 167 sub CgiDie {
 168   local (@msg) = @_;
 169   &CgiError (@msg);
 170   die @msg;
 171 }
 172
 173
 174 # PrintVariables
 175 # Nicely formats variables in an associative array passed as a parameter
 176 # And returns the HTML string.
 177 sub PrintVariables {
 178   local (%in) = @_;
 179   local ($old, $out, $output);
 180   $old = $*;  $* =1;
 181   $output .=  "\n<dl compact>\n";
 182   foreach $key (sort keys(%in)) {
 183     foreach (split("\0", $in{$key})) {
 184       ($out = $_) =~ s/\n/<br>\n/g;
 185       $output .=  "<dt><b>$key</b>\n <dd><i>$out</i><br>\n";
 186     }
 187   }
 188   $output .=  "</dl>\n";
 189   $* = $old;
 190
 191   return $output;
 192 }
 193
 194 # PrintVariablesShort
 195 # Now obsolete; just calls PrintVariables
 196
 197 sub PrintVariablesShort {
 198   return &PrintVariables(@_);
 199 }
 200
 201 1; #return true
 202
 203