home *** CD-ROM | disk | FTP | other *** search
/ Boot Disc 4 / boot-disc-1996-12.iso / Apps / Fusion / T2.Z / Forms-Handler.cgi < prev    next >
Text File  |  1996-08-23  |  4KB  |  153 lines

  1. #!/bin/perl
  2.  
  3. ###################
  4. #CONFIGURATION#####
  5. ###################
  6. #Directory to write file to
  7. $STORAGEDIR="\/webdata\/";
  8.  
  9. #The database separator token is -- 
  10.  
  11. $TOKEN ="    ,";
  12. ###################
  13. ###################
  14. ###################
  15.  
  16. #This will allow error to pump directly to to client, instead of crashing the server.
  17. select STDOUT;
  18. print "Content-type: text/html\n\n";
  19.  
  20.  
  21. #
  22. # This reads in the information sent when the user pressed Submit
  23. #
  24. if ($ENV{'REQUEST_METHOD'} eq "GET") { $buffer = $ENV{'QUERY_STRING'}; }
  25. else { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); }
  26.  
  27. #
  28. # Now, using a little loop, we'll split up the data into name/value
  29. # pairs, which makes them easier to work with. 
  30. #
  31. $buffer =~ s/([;<>\*\|`&\$!\#\(\)\[\]\{\}:'"])/\\$1/g; 
  32. $buffer =~ tr/\n//d; 
  33.  
  34. @pairs = split(/&/, $buffer);
  35. foreach $pair (@pairs)
  36. {
  37.     ($name, $value) = split(/=/, $pair);
  38.     $value =~ tr/+/ /;
  39.     $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
  40.     chop($value);
  41.     $FORM{$name} = $value;
  42. }
  43.  
  44.  
  45. # Once the name/value pairs have been created, you can work with
  46. # them by referring to the variable names you set up in the 
  47. # original HTML, using $FORM{"varname"}.
  48.  
  49. # First, we make sure that they actually gave an email address
  50. #
  51. #check for error -- REQUIRE on selective basis $FORM{'na'}
  52.  
  53. ¬completeinternal unless $FORM{'fields'} && $FORM{'filename'} && $FORM{'error'} && $FORM{'success'};
  54.  
  55. $STORAGEFILE = $FORM{'filename'};
  56. $NUMBERARG = $FORM{'fields'};
  57.  
  58. $COUNTER = 1;
  59.  
  60.  
  61. #### Auto #####
  62. $ERRORRESPONSE=$FORM{'error'};
  63. $SUCCESSRESPONSE=$FORM{'success'};
  64. $STORAGE = $STORAGEDIR.$STORAGEFILE;
  65. $ENV{'HTTP_REFERER'} =~ s/\/[^\/]*$/\//g; 
  66.  
  67. while($COUNTER <= $NUMBERARG){ 
  68.    $CONFIG = $COUNTER.a;
  69.    ¬complete if (($FORM{$COUNTER} eq '') && ($FORM{$CONFIG} eq "TRUE"));
  70.    $COUNTER = $COUNTER + 1;
  71. }
  72.  
  73. &makedat;
  74. &success;
  75. exit;
  76.  
  77.  
  78. ######################################################################
  79. ############################  Make .dat file    ######################
  80. ######################################################################
  81. sub makedat {
  82.     open(NEW,">> $STORAGE") || die "can't open $STORAGE\n";
  83.     select(NEW);
  84.     $COUNTER = 1;
  85.     print NEW "$FORM{$COUNTER}";
  86.     $COUNTER = 2;
  87.     while($COUNTER <= $NUMBERARG){ 
  88.     print NEW "$TOKEN$FORM{$COUNTER}";
  89.     $COUNTER = $COUNTER + 1;
  90.     }
  91.     print NEW "\n";
  92.     close(NEW);
  93. }
  94. ###############################################################################
  95. ############################  Complete/Success  ###############################
  96. ###############################################################################
  97. sub success{
  98.     select(STDOUT);
  99.     print "<html>";
  100.     print "<head>";
  101.     print "<meta http-equiv=\"Refresh\" content=\"?; URL=$SUCCESSRESPONSE\">";
  102.     print "</head>";
  103.     print "</html>";
  104.  
  105. }
  106.  
  107. ###############################################################################
  108. ############################  Incomplete Error  ###############################
  109. ###############################################################################
  110. sub notcomplete {
  111.    select(STDOUT);
  112.    print "<html>";
  113.    print "<head>";
  114.    print "<meta http-equiv=\"Refresh\" content=\"?; URL=$ERRORRESPONSE\">";
  115.    print "</head>";
  116.    print "</html>";
  117.     exit;
  118.  
  119. ###############################################################################
  120. ############################  Incomplete Error  ###############################
  121. ###############################################################################
  122. sub notcompleteinternal {
  123.     select(STDOUT);
  124.     print "<html>";
  125.     print "<h3>This is a internal error (without configuration variable)</h3>";
  126.     print "the following variable are escape out for perl script protection:";
  127.     print "<UL>";
  128.     print "\;<>\*\|\`\&\$\!\#()[]{}\:\'\"\/ (return character deleted)<br>";
  129.     print "</UL>";
  130.     print "or one of the following file is not declare in the field:";
  131.     print "<UL>";
  132.     print "filename (date file name)<br>";
  133.     print "fields (# of field)<br>";
  134.     print "success(success respond file) <br> "; 
  135.     print "error(error respond file) <br>";
  136.     print "</UL>";
  137.     print "</html>";
  138.     exit;
  139.  
  140.  
  141.  
  142.  
  143.  
  144.  
  145.  
  146.  
  147.  
  148.  
  149.  
  150.  
  151.