home *** CD-ROM | disk | FTP | other *** search
/ RISC DISC 2 / RISC_DISC_2.iso / the_web / documents / html / files / perl2.txt < prev    next >
Encoding:
Text File  |  1994-09-25  |  5.0 KB  |  219 lines
  1. -==-start www_pl-==-
  2.  
  3. #
  4. # www_pl  -  perl subroutines for use w/WWW development
  5. #
  6. # by: Eric Hall
  7. # date: 8/11/94
  8. #
  9. # desc: this file contains many useful and reusable subroutines
  10. #       included are GENFOOT (generates standard footer, printing
  11. #       it to a file), PRNFOOT (ditto but prints to stdout)
  12. #       GENHEAD (generates header and recognition), etc.
  13. #
  14. # Enjoy,
  15. # --eric hall
  16. # --ehall1@duck.ford.com
  17. # --hallway@ais.org
  18.  
  19.  
  20. #used for alphabetical sorts
  21. sub alpha { $a cmp $b; }
  22.  
  23.  
  24. #parses the standard input (STDIN) and generates
  25. #an associative array called %FORM w/the key=input box name
  26. #and value=what user typed into input box
  27. sub PARSEFORM {
  28.  
  29.     local($name,$value,$pair,$buffer,@pairs,%FORM);
  30.  
  31.     #this should be done first
  32.     #unshift(@INC,'/usr/local/etc/httpd/cgi-bin');
  33.  
  34.     # Get the input
  35.     read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
  36.  
  37.     # Split the name-value pairs
  38.     @pairs = split(/&/, $buffer);
  39.  
  40.     # Uncommend for debugging purposes
  41.     #print "Content-type: text/html\n\n";
  42.  
  43.     foreach $pair (@pairs)
  44.     {
  45.         ($name, $value) = split(/=/, $pair);
  46.  
  47.         # Un-Webify plus signs and %-encoding
  48.         $value =~ tr/+/ /;
  49.         $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
  50.  
  51.         #want to skip submissions of default values
  52.         next if (grep(/\?\?\?\?\?/,$value));
  53.  
  54.         # Stop people from using subshells to execute commands
  55.         # Not a big deal when using sendmail, but very important
  56.         # when using UCB mail (aka mailx).
  57.         $value =~ s/~!/ ~!/g;
  58.  
  59.         # Uncomment for debugging purposes
  60.         #print "Setting $name to $value<P>";
  61.  
  62.         $FORM{$name} = $value;
  63.     }
  64.  
  65.     return (%FORM);
  66.  
  67. } #end sub PARSEFORM
  68.  
  69.  
  70. #generates footer to file
  71. sub PRNFOOT2 {
  72.  
  73.     local($url,$to) = @_;
  74.  
  75.     print "\n";
  76.     print "<HR>\n";
  77.     print "<!<h5>\n";
  78.     print "<a href=\"http://$url\">\n";
  79.     print "<img src=\"http://www.ais.org/~hallway/icons/smalleft.gif\">\n";
  80.     print "Return to $to</i></a>\n";
  81.     print "<!</h5>\n";
  82.     print "\n";
  83.     print "\n";
  84.     print "</html>\n";
  85.     print "</body>\n";
  86.  
  87. } #end sub PRNFOOT
  88.  
  89.  
  90. #generates footer to file
  91. sub PRNFOOT {
  92.  
  93.     local($url,$to) = @_;
  94.  
  95.     print "\n";
  96.     print "<HR>\n";
  97.     print "<!<h5>\n";
  98.     print "Click <b>BACK</b> button or arrow to return.\n";
  99.     print "<!</h5>\n";
  100.     print "\n";
  101.     print "</html>\n";
  102.     print "</body>\n";
  103.  
  104. } #end sub PRNFOOT
  105.  
  106.  
  107. #generates footer to file
  108. sub GENFOOT2 {
  109.  
  110.     local(*FILE,$url,$to) = @_;
  111.  
  112.     print FILE "\n";
  113.     print FILE "<HR>\n";
  114.     print FILE "<h5>\n";
  115.     print FILE "<a href=\"http://$url\">\n";
  116.     print FILE "<img src=\"http://www.ais.org/~hallway/icons/smalleft.gif\">\n";
  117.     print FILE "Return to $to</a>\n";
  118.     print FILE "</h5>\n";
  119.     print FILE "\n";
  120.     print FILE "</html>\n";
  121.     print FILE "</body>\n";
  122.  
  123. } #end sub GENFOOT
  124.  
  125.  
  126. #generates footer to file
  127. sub GENFOOT {
  128.  
  129.     local(*FILE) = @_;
  130.  
  131.     print FILE "\n";
  132.     print FILE "<HR>\n";
  133.     print FILE "<h5>\n";
  134.     print FILE "Click <b>BACK</b> button or arrow to return.\n";
  135.     print FILE "</h5>\n";
  136.     print FILE "\n";
  137.     print FILE "</html>\n";
  138.     print FILE "</body>\n";
  139.  
  140. } #end sub GENFOOT
  141.  
  142.  
  143. #generates required header
  144. #call w/title of page and recognition list
  145. sub PRNHEAD {
  146.  
  147.     local($title, @flist) = @_;
  148.  
  149.     print "Content-type: text/html\n\n";
  150.     print "<html>\n";
  151.     print "<head>\n";
  152.     if (@flist[0] ne "") { &PRNREC(@flist); }
  153.     print "<Title>$title</Title>\n";
  154.     print "</head>\n";
  155.     print "<body>\n";
  156.     print "\n";
  157.  
  158. } #end sub PRNHEAD
  159.  
  160.  
  161. #generates required header
  162. #call w/pointer to filehandle, title of page and recognition list
  163. sub GENHEAD {
  164.  
  165.     local(*FILE,$title,@flist) = @_;
  166.  
  167.     print FILE "<html>\n";
  168.     print FILE "<head>\n";
  169.     if (@flist[0] ne "") { &GENREC(@flist); }
  170.     print FILE "<Title>$title</Title>\n";
  171.     print FILE "</head>\n";
  172.     print FILE "<body>\n";
  173.     print FILE "\n";
  174.  
  175. } #end sub GENHEAD
  176.  
  177.  
  178. #generates a recognition header
  179. sub PRNREC {
  180.  
  181.     local($fname,$ftease,$fauth,$fdesc) = @_;
  182.  
  183.     print "\n";
  184.     print "<!--------------------------------------------------------------->\n\
  185. n";
  186.     print "<!-- $fname >\n";
  187.     print "<!-- $ftease >\n\n";
  188.     print "<!-- author: $fauth >\n";
  189.     print "<!-- description: $fdesc >\n\n";
  190.     print "<!--------------------------------------------------------------->\n\
  191. n";
  192.  
  193. } #end sub PRNREC
  194.  
  195.  
  196. #generates a recognition header
  197. sub GENREC {
  198.  
  199.  
  200.     local($fname,$ftease,$fauth,$fdesc) = @_;
  201.  
  202.     print FILE "\n";
  203.     print FILE "<!--------------------------------------------------------------
  204. ->\n\n";
  205.     print FILE "<!-- $fname >\n";
  206.     print FILE "<!-- $ftease >\n\n";
  207.     print FILE "<!-- author: $fauth >\n";
  208.     print FILE "<!-- description: $fdesc >\n\n";
  209.     print FILE "<!--------------------------------------------------------------
  210. ->\n\n";
  211.  
  212. } #end sub GENREC
  213.  
  214. 1;
  215.  
  216.  
  217.  
  218.  
  219.