home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1997 March / PCWK0397.iso / novell / webserv3 / disk1 / public / perl / cgi-lib.pl
Perl Script  |  1996-12-16  |  4KB  |  136 lines
  1. #!/usr/local/bin/perl -- -*- C -*-
  2.  
  3. # Perl Routines to Manipulate CGI input
  4. # S.E.Brenner@bioc.cam.ac.uk
  5. # $Header:   I:/web_arch/perl/scripts/vcs/cgi-lib.pv_   1.0   16 Dec 1996 17:10:24   ndam  $
  6. #
  7. # Copyright 1994 Steven E. Brenner  
  8. # Unpublished work.
  9. # Permission granted to use and modify this library so long as the
  10. # copyright above is maintained, modifications are documented, and
  11. # credit is given for any use of the library.
  12. #
  13. # Thanks are due to many people for reporting bugs and suggestions
  14. # especially Meng Weng Wong, Maki Watanabe, Bo Frese Rasmussen,
  15. # Andrew Dalke, Mark-Jason Dominus and Dave Dittrich.
  16.  
  17. # see http://www.seas.upenn.edu/~mengwong/forms/   or
  18. #     http://www.bio.cam.ac.uk/web/                for more information
  19.  
  20. # Minimalist http form and script (http://www.bio.cam.ac.uk/web/minimal.cgi):
  21. # if (&MethGet) {
  22. #   print &PrintHeader,
  23. #       '<form method=POST><input type="submit">Data: <input name="myfield">';
  24. # } else {
  25. #   &ReadParse(*input);
  26. #   print &PrintHeader, &PrintVariables(%input);
  27. # }
  28.  
  29.  
  30. # MethGet
  31. # Return true if this cgi call was using the GET request, false otherwise
  32. # Now that cgi scripts can be put in the normal file space, it is useful
  33. # to combine both the form and the script in one place with GET used to
  34. # retrieve the form, and POST used to get the result.
  35.  
  36. sub MethGet {
  37.   return ($ENV{'REQUEST_METHOD'} eq "GET");
  38. }
  39.  
  40. # ReadParse
  41. # Reads in GET or POST data, converts it to unescaped text, and puts
  42. # one key=value in each member of the list "@in"
  43. # Also creates key/value pairs in %in, using '\0' to separate multiple
  44. # selections
  45.  
  46. # If a variable-glob parameter (e.g., *cgi_input) is passed to ReadParse,
  47. # information is stored there, rather than in $in, @in, and %in.
  48.  
  49. sub ReadParse {
  50.     local (*in) = @_ if @_;
  51.  
  52.  
  53.   local ($i, $loc, $key, $val);
  54.  
  55.   # Read in text
  56.   if ($ENV{'REQUEST_METHOD'} eq "GET") {
  57.     $in = $ENV{'QUERY_STRING'};
  58.   } elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
  59.     read(STDIN,$in,$ENV{'CONTENT_LENGTH'});
  60.   }
  61.  
  62.   @in = split(/&/,$in);
  63.  
  64.   foreach $i (0 .. $#in) {
  65.     # Convert plus's to spaces
  66.     $in[$i] =~ s/\+/ /g;
  67.  
  68.     # Split into key and value.  
  69.     ($key, $val) = split(/=/,$in[$i],2); # splits on the first =.
  70.  
  71.     # Convert %XX from hex numbers to alphanumeric
  72.     $key =~ s/%(..)/pack("c",hex($1))/ge;
  73.     $val =~ s/%(..)/pack("c",hex($1))/ge;
  74.  
  75.     # Associate key and value
  76.     $in{$key} .= "\0" if (defined($in{$key})); # \0 is the multiple separator
  77.     $in{$key} .= $val;
  78.  
  79.   }
  80.  
  81.   return 1; # just for fun
  82. }
  83.  
  84. # PrintHeader
  85. # Returns the magic line which tells WWW that we're an HTML document
  86.  
  87. sub PrintHeader {
  88.   return "Content-type: text/html\n\n";
  89. }
  90.  
  91. # PrintVariables
  92. # Nicely formats variables in an associative array passed as a parameter
  93. # And returns the HTML string.
  94.  
  95. sub PrintVariables {
  96.   local (%in) = @_;
  97.   local ($old, $out, $output);
  98.   $old = $*;  $* =1;
  99.   $output .=  "<DL COMPACT>";
  100.   foreach $key (sort keys(%in)) {
  101.     foreach (split("\0", $in{$key})) {
  102.       ($out = $_) =~ s/\n/<BR>/g;
  103.       $output .=  "<DT><B>$key</B><DD><I>$out</I><BR>";
  104.     }
  105.   }
  106.   $output .=  "</DL>";
  107.   $* = $old;
  108.  
  109.   return $output;
  110. }
  111.  
  112. # PrintVariablesShort
  113. # Nicely formats variables in an associative array passed as a parameter
  114. # Using one line per pair (unless value is multiline)
  115. # And returns the HTML string.
  116.  
  117.  
  118. sub PrintVariablesShort {
  119.   local (%in) = @_;
  120.   local ($old, $out, $output);
  121.   $old = $*;  $* =1;
  122.   foreach $key (sort keys(%in)) {
  123.     foreach (split("\0", $in{$key})) {
  124.       ($out = $_) =~ s/\n/<BR>/g;
  125.       $output .= "<B>$key</B> is <I>$out</I><BR>";
  126.     }
  127.   }
  128.   $* = $old;
  129.  
  130.   return $output;
  131. }
  132.  
  133. 1; #return true
  134.  
  135.  
  136.