home *** CD-ROM | disk | FTP | other *** search
/ Teach Yourself CGI Programming with Perl in a Week / CGIPROGRAMMINGPERL.iso / booksrc / 06cgil05.cgi < prev    next >
Encoding:
Text File  |  1995-12-08  |  3.5 KB  |  120 lines
  1. Content-type: text/plain
  2.  
  3.  
  4. #!/usr/local/bin/perl
  5.  
  6. #perltest.p
  7. #for testing cgi-bin interface
  8. # Put this in your cgi-bin directory, changing the email address below...
  9.  
  10. #sub to remove cgi-encoding
  11. sub unescape {
  12.     ($_)=@_;
  13. #    s!\\(.)!$1!ge;  # This is sometimes required to remove shell escapes
  14.     tr/+/ /;
  15.     s/%(..)/pack("c",hex($1))/ge;
  16.     $_;
  17. }
  18.  
  19. # ---------------------------------------------------------------------------
  20. # The escape and unescape functions are taken from the wwwurl.pl package
  21. # developed by Roy Fielding <fielding@ics.uci.edu> as part of the Arcadia
  22. # project at the University of California, Irvine. It is distributed
  23. # under the Artistic License (included with your Perl distribution
  24. # files).
  25. # ---------------------------------------------------------------------------
  26.  
  27. #++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  28. #.PURPOSE       Encodes a string so it doesn't cause problems in URL.
  29. #
  30. #.REMARKS
  31. #
  32. #.RETURNS       The encoded string
  33. #------------------------------------------------------------------------------
  34.  
  35. sub cgi_encode
  36. {
  37.     local ($str) = @_;
  38.     $str = &escape($str,'[\x00-\x20"#%/+;<>?\x7F-\xFF]');
  39.     $str =~ s/ /+/g;
  40.     return( $str );
  41. }
  42.  
  43. # ===========================================================================
  44. # escape(): Return the passed string after replacing all characters matching
  45. #           the passed pattern with their %XX hex escape chars.  Note that
  46. #           the caller must be sure not to escape reserved URL characters
  47. #           (e.g. / in pathnames, ':' between address and port, etc.) and thus
  48. #           this routine can only be applied to each URL part separately. E.g.
  49. #
  50. #           $escname = &escape($name,'[\x00-\x20"#%/;<>?\x7F-\xFF]');
  51. #
  52. sub escape
  53. {
  54.     local($str, $pat) = @_;
  55.  
  56.     $str =~ s/($pat)/sprintf("%%%02lx",unpack('C',$1))/ge;
  57.     return($str);
  58. }
  59.  
  60. #now the main program begins
  61.  
  62. #testing environment variables passed via URL...
  63. print "Content-type: text/plain","\n";
  64. print "\n";
  65.  
  66. open (MAIL,"| mail name@foo.edu") ||
  67.   die "Error: Can't start mail program - Please report this error to name@foo.edu";
  68.  
  69.  
  70. print MAIL "Matt's New cgi-test script report","\n";
  71. print MAIL "\n";
  72. print MAIL "\n";
  73. print MAIL "Environment variables" ,"\n";
  74. print MAIL "\n";
  75.  
  76.         foreach(sort keys %ENV)  #list all environment variables
  77.            {
  78.               $MyEnvName=$_;
  79.               $MyEnvValue=$ENV{$MyEnvName};
  80.               $URLed = &cgi_encode($MyEnvValue);
  81.               $UnURLed = &unescape($MyEnvValue);
  82.               print MAIL $MyEnvName,"\n";
  83.               print MAIL "Value: ",$MyEnvValue,"\n";
  84.               print MAIL "URLed: ",$URLed,"\n";
  85.               print MAIL "UnURLed: ",$UnURLed,"\n";
  86.               print MAIL "\n";
  87.            }
  88.  
  89.  if ($ENV{'REQUEST_METHOD'} eq "POST")
  90.    {#POST data
  91.  
  92.       print MAIL "POST data \n";
  93.  
  94.     for ($i = 0; $i < $ENV{'CONTENT_LENGTH'}; $i++)
  95.         {
  96.           $MyBuffer .= getc;
  97.         }
  98.  
  99. print MAIL "Original data: \n";
  100. print MAIL $MyBuffer,"\n";
  101. print MAIL "unURLed: \n";
  102. print MAIL &unescape($MyBuffer), "\n\n";
  103.  
  104.       @MyBuffer = split(/&/,$MyBuffer);
  105.  
  106.       foreach $i (0 .. $#MyBuffer)
  107.         {
  108.            print MAIL $MyBuffer[$i],"\n";
  109.            print MAIL "FName:",&unescape($MyBuffer[$i]),"\n";
  110.         }
  111.    }
  112.  
  113.  
  114. close ( MAIL );
  115.  
  116. print "\n";
  117. print "Thanks for filling out this form !\n";
  118. print "It has been sent to name@foo.edu\n<p>\n";
  119.  
  120.