home *** CD-ROM | disk | FTP | other *** search
/ SunSoft Catalyst 1995 September to December / CDware_Sep-Dec_1995.bin / .products / RogueWave / rouge.test / cgi-lib
Text File  |  1995-09-26  |  3KB  |  106 lines
  1. #!/usr/local/bin/perl -- 
  2.  
  3. # Perl Routines to Manipulate CGI input
  4. # S.E.Brenner@bioc.cam.ac.uk
  5. # $Header: /people/seb1005/http/cgi-bin/RCS/cgi-lib.pl,v 1.2 1994/01/10 15:05:40 seb1005 Exp $
  6. #
  7. # Copyright 1993 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. # ReadParse
  14. # Reads in GET or POST data, converts it to unescaped text, and puts
  15. # one key=value in each member of the list "@in"
  16. # Also creates key/value pairs in %in, using '\0' to separate multiple
  17. # selections
  18.  
  19. # If a variable-glob parameter (e.g., *cgi_input) is passed to ReadParse,
  20. # information is stored there, rather than in $in, @in, and %in.
  21.  
  22. sub ReadParse {
  23.   if (@_) {
  24.     local (*in) = @_;
  25.   }
  26.  
  27.   local ($i, $loc, $key, $val);
  28.  
  29.   # Read in text
  30.   if ($ENV{'REQUEST_METHOD'} eq "GET") {
  31.     $in = $ENV{'QUERY_STRING'};
  32.   } elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
  33.     for ($i = 0; $i < $ENV{'CONTENT_LENGTH'}; $i++) {
  34.       $in .= getc;
  35.     }
  36.   } 
  37.  
  38.   @in = split(/&/,$in);
  39.  
  40.   foreach $i (0 .. $#in) {
  41.     # Convert plus's to spaces
  42.     $in[$i] =~ s/\+/ /g;
  43.  
  44.     # Convert %XX from hex numbers to alphanumeric
  45.     $in[$i] =~ s/%(..)/pack("c",hex($1))/ge;
  46.  
  47.     # Split into key and value.
  48.     $loc = index($in[$i],"=");
  49.     $key = substr($in[$i],0,$loc);
  50.     $val = substr($in[$i],$loc+1);
  51.     $in{$key} .= '\0' if (defined($in{$key})); # \0 is the multiple separator
  52.     $in{$key} .= $val;
  53.   }
  54.  
  55.   return 1; # just for fun
  56. }
  57.  
  58. # PrintHeader
  59. # Returns the magic line which tells WWW that we're an HTML document
  60.  
  61. sub PrintHeader {
  62.   return "Content-type: text/html\n\n";
  63. }
  64.  
  65. # PrintVariables
  66. # Nicely formats variables in an associative array passed as a parameter
  67. # And returns the HTML string.
  68.  
  69. sub PrintVariables {
  70.   local (%in) = @_;
  71.   local ($old, $out);
  72.   $old = $*;  $* =1;
  73.   $output .=  "<DL COMPACT>";
  74.   foreach $key (sort keys(%in)) {
  75.     ($out = $in{$key}) =~ s/\n/<BR>/g;
  76.     $output .=  "<DT><B>$key</B><DD><i>$out</I><BR>";
  77.   }
  78.   $output .=  "</DL>";
  79.   $* = $old;
  80.  
  81.   return $output;
  82. }
  83.  
  84. # PrintVariablesShort
  85. # Nicely formats variables in an associative array passed as a parameter
  86. # Using one line per pair (unless value is multiline)
  87. # And returns the HTML string.
  88.  
  89. sub PrintVariablesShort {
  90.   local (%in) = @_;
  91.   local ($old, $out);
  92.   $old = $*;  $* =1;
  93.   foreach $key (sort keys(%in)) {
  94.     if (($out = $in{$key}) =~ s/\n/<BR>/g) {
  95.       $output .= "<DL COMPACT><DT><B>$key</B> is <DD><i>$out</I></DL>";
  96.     } else {
  97.       $output .= "<B>$key</B> is <i>$out</I><BR>";
  98.     }
  99.   }
  100.   $* = $old;
  101.  
  102.   return $output;
  103. }
  104.  
  105. 1; #return true
  106.