home *** CD-ROM | disk | FTP | other *** search
/ Internet 1996 World Exposition / park.org.s3.amazonaws.com.7z / park.org.s3.amazonaws.com / cgi-bin / Japan / Theme / cgi-lib.pl < prev    next >
Perl Script  |  2017-09-21  |  4KB  |  144 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: /cys/people/seb1005/http/cgi-bin/RCS/cgi-lib.pl,v 1.6 1994/07/13 15:00:50 seb1005 Exp $
  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. 
  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.     print Debug_FAIRU $key, ' ', $value, "\n";
  72.  
  73.     # Convert %XX from hex numbers to alphanumeric
  74.     $key =~ s/%(..)/pack("c",hex($1))/ge;
  75.     $val =~ s/%(..)/pack("c",hex($1))/ge;
  76.  
  77.     # shouldn't do this
  78.     if (defined($in{'scriptid'})) {
  79.  
  80.       next;
  81.     }
  82.  
  83.     # Associate key and value
  84.     $in{$key} .= "\0" if (defined($in{$key})); # \0 is the multiple separator
  85.     $in{$key} .= $val;
  86.  
  87.   }
  88.  
  89.   return 1; # just for fun
  90. }
  91.  
  92. # PrintHeader
  93. # Returns the magic line which tells WWW that we're an HTML document
  94.  
  95. sub PrintHeader {
  96.   return "Content-type: text/html\n\n";
  97. }
  98.  
  99. # Note: Neither of the PrintVariables functions deals with multiple
  100. #       occurences of keys
  101.  
  102. # PrintVariables
  103. # Nicely formats variables in an associative array passed as a parameter
  104. # And returns the HTML string.
  105.  
  106. sub PrintVariables {
  107.   local (%in) = @_;
  108.   local ($old, $out, $output);
  109.   $old = $*;  $* =1;
  110.   $output .=  "<DL COMPACT>";
  111.   foreach $key (sort keys(%in)) {
  112.     ($out = $in{$key}) =~ s/\n/<BR>/g;
  113.     $output .=  "<DT><B>$key</B><DD><I>$out</I><BR>";
  114.   }
  115.   $output .=  "</DL>";
  116.   $* = $old;
  117.  
  118.   return $output;
  119. }
  120.  
  121. # PrintVariablesShort
  122. # Nicely formats variables in an associative array passed as a parameter
  123. # Using one line per pair (unless value is multiline)
  124. # And returns the HTML string.
  125.  
  126.  
  127. sub PrintVariablesShort {
  128.   local (%in) = @_;
  129.   local ($old, $out, $output);
  130.   $old = $*;  $* =1;
  131.   foreach $key (sort keys(%in)) {
  132.     if (($out = $in{$key}) =~ s/\n/<BR>/g) {
  133.       $output .= "<DL COMPACT><DT><B>$key</B> is <DD><I>$out</I></DL>";
  134.     } else {
  135.       $output .= "<B>$key</B> is <I>$out</I><BR>";
  136.     }
  137.   }
  138.   $* = $old;
  139.  
  140.   return $output;
  141. }
  142.  
  143. 1; #return true
  144.