Will this work?

saffron has asked for the wisdom of the Perl Monks concerning the following question:

I have a modified script that I would like to write to selected files specified by the html form and I am in need of some direction for I am lost. I was hoping that this would work but alas, it dosen't and I'm not sure why. Please excuse my lack of understanding...I am still learning.

#!/usr/local/bin/perl
# Define Variables

$basedir = "$ENV{'DOCUMENT_ROOT_OLD'}/www";
$baseurl = "http://www.whatever.com";
$cgi_url = "http://www.whatever.com/cgi-bin/add.pl";

$mesgdir = "messages";
$datafile = "data.txt";


$ext = "html";

$title = "Recipes";

# Done

# Get the Data Number
&get_number;

# Get Form Information
&parse_form;

# Put items into nice variables
&get_variables;

# Open the new file and write information to it.
&new_file;

# Open the Main WWWBoard File to add link
&main_page;

# Increment Number
&increment_num;

############################
# Get Data Number Subroutine

sub get_number {
   open(NUMBER,"$basedir/$catagory/$datafile");
   $num = <NUMBER>;
   close(NUMBER);
   if ($num == 999999 || $num !~ /^\d+$/)  {
      $num = "1";
   }
   else {
      $num++;
   }
}

#######################
# Parse Form Subroutine

sub parse_form {
   local($name,$value);

   # Get the input
   read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});

   # Split the name-value pairs
   @pairs = split(/&/, $buffer);

   foreach $pair (@pairs) {
      ($name, $value) = split(/=/, $pair);

      # Un-Webify plus signs and %-encoding
      $value =~ tr/+/ /;
      $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

      # Remove any NULL characters, Server Side Includes
      $value =~ s/\0//g;
      $value =~ s/<!--(.|\n)*-->//g;
      $value =~ s/<([^>]|\n)*>//g;
         
      

      $FORM{$name} = $value;
   

# Get Variables

sub get_variables {

   if ($FORM{'catagory'}) {
      $name = "$FORM{'catagory'}";
      $name =~ s/"//g;
      $name =~ s/<//g;
      $name =~ s/>//g;
      $name =~ s/\&//g;
   }
   

   
   if ($FORM{'subject'}) {
      $subject = "$FORM{'subject'}";
      $subject =~ s/\&/\&amp\;/g;
      $subject =~ s/"/\&quot\;/g;
   }
   

   
   if ($FORM{'body'}) {
      $body = "$FORM{'body'}";
      $body =~ s/\cM//g;
      $body =~ s/\n\n/<p>/g;
      $body =~ s/\n/<br>/g;

      $body =~ s/&lt;/</g; 
      $body =~ s/&gt;/>/g; 
      $body =~ s/&quot;/"/g;
   }

   if ($FORM{'serves'}) {
      $invoice = "$FORM{'serves'}";
   }      

   
   ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(t
+ime);

   $month = ($mon + 1);

   @months = ("January","February","March","April","May","June","July"
+,"August","September","October","November","December");

   $year += 1900;
   $long_date = sprintf("%s %02d, %4d at %02d:%02d:%02d",$months[$mon]
+,$mday,$year,$hour,$min,$sec);

   $year %= 100;
   if ($use_time == 1) {
      $date = sprintf("%02d:%02d:%02d %02d/%02d/%02d",$hour,$min,$sec,
+$month,$mday,$year);
   }
   else {
      $date = sprintf("%02d/%02d/%02d",$month,$mday,$year);
   }
}      

#####################
# New File Subroutine

sub new_file {

   open(NEWFILE,">$basedir/$catagory/$mesgdir/$num\.$ext") || die $!;
   print NEWFILE "<html>\n";
   print NEWFILE "<head>\n";
   print NEWFILE "<title>$subject</title>\n";
   print NEWFILE "<STYLE type=text/css>\n";
   print NEWFILE ".wrapIt {\n";
   print NEWFILE "width:400px;\n";
   print NEWFILE "word-wrap:breakword;\n";
   print NEWFILE "background-color:white;\n";
   print NEWFILE "}\n";
   print NEWFILE "</STYLE>\n";
   print NEWFILE "</head>\n";
   print NEWFILE "<noframes>\n";
   print NEWFILE "<body>\n";
   print NEWFILE "</noframes>\n";
   print NEWFILE "</br>\n";

   print NEWFILE " <div align=center CLASS=body><center><table border=
+0>\n";
   print NEWFILE "     <tr>\n";
   print NEWFILE "         <td align=center valign=top colspan=5>\n";
   print NEWFILE "         <font size=5><strong>$subject</strong></fon
+t></td>\n";
   print NEWFILE "     </tr>\n";
   print NEWFILE "     <tr>\n";
   print NEWFILE "         <td>&nbsp;</td>\n";
   print NEWFILE "         <td>&nbsp;</td>\n";
   print NEWFILE "         <td>&nbsp;</td>\n";
   print NEWFILE "         <td>&nbsp;</td>\n";
   print NEWFILE "         <td>&nbsp;</td>\n";
   print NEWFILE "     </tr>\n";
   print NEWFILE "     <tr>\n";
   print NEWFILE "         <td align=center valign=top colspan=5>\n";
   print NEWFILE "         <font size=5><strong>Serves: $serves</stron
+g></font></td>\n";
   print NEWFILE "     </tr>\n";
   print NEWFILE "     <tr>\n";
   print NEWFILE "         <td>&nbsp;</td>\n";
   print NEWFILE "         <td>&nbsp;</td>\n";
   print NEWFILE "         <td>&nbsp;</td>\n";
   print NEWFILE "         <td>&nbsp;</td>\n";
   print NEWFILE "         <td>&nbsp;</td>\n";
   print NEWFILE "     </tr>\n";
   print NEWFILE "     <tr>\n";
   print NEWFILE "         <td>&nbsp;</td>\n";
   print NEWFILE "         <td>&nbsp;</td>\n";
   print NEWFILE "         <td>&nbsp;</td>\n";
   print NEWFILE "         <td>&nbsp;</td>\n";
   print NEWFILE "         <td>&nbsp;</td>\n";
   print NEWFILE "     </tr>\n";
   print NEWFILE "     <tr>\n";
   print NEWFILE "         <td colspan=5>Ingredients:</td>\n";
   print NEWFILE "     </tr>\n";
   print NEWFILE "     <tr>\n";
   print NEWFILE "         <td>$labor</td>\n";
   print NEWFILE "     </tr>\n";
   print NEWFILE "     <tr>\n";
   print NEWFILE "         <td align=center colspan=5>&nbsp</td>\n";
   print NEWFILE "     </tr>\n";
   print NEWFILE "     <tr>\n";
   print NEWFILE "         <td colspan=5>Method:</td>\n";
   print NEWFILE "     </tr>\n";
   print NEWFILE "     <tr>\n";
   $body = 'OH CRAP' if ! defined $body;
   print NEWFILE "         <td colspan=5 CLASS=wrapIt>$body</td>\n";
   print NEWFILE "     </tr>\n";
   print NEWFILE "     <tr>\n";
   print NEWFILE "         <td rowspan=2 colspan=5>&nbsp;</td>\n";
   print NEWFILE "     </tr>\n";
   print NEWFILE " </table>\n";
   print NEWFILE " </center></div>\n";
    
  
   
   print NEWFILE "</body></html>\n";
   close(NEWFILE);
}

###############################
# Main Page Subroutine

sub main_page {
   open(MAIN,"$basedir/$catagory\.$ext") || die $!;
   @main = <MAIN>;
   close(MAIN);
}

############################################
# Return html

sub return_html {
   print "Content-type: text/html\n\n";
   print "<html><head>\n";
   print "<title>$subject</title>\n";
   
   print "</head>\n";
   print "<noframes>\n";
   print "<body bgcolor=#FFFFFF>\n";
   print "<font size=2><b>Entry has been logged, click <a href=\"http:
+//wwwdesignaz.netfirms.com/recipes.html\">here</a> to return home.\n"
+;
   print "</b></font>\n";
   print "</body></html>\n";
}

sub increment_num {
   open(NUM,">$basedir/$catagory/$datafile") || die $!;
   print NUM "$num";
   close(NUM);
}
[download]

Comment on Will this work? Download Code

Replies are listed 'Best First'.
Re: Will this work? by Anonymous Monk on May 21, 2010 at 06:34 UTC
First thing you'll want to do is change `#!/usr/local/bin/perl` [download] to `#!/usr/local/bin/perl -T -- use strict; use warnings; use CGI();` [download] Then you should forget about your program for a while and do some reading. The following reading list covers everything currently present in your program (you need strictures, you need lexical variables, and you need CGI, and there are alternatives to double quotes). perlintro Coping with Scoping Use strict warnings and diagnostics or die use CGI or die; "here-document" syntax Eventually you'll want to read the following also Ovid's CGI Course CGI Programming with Perl, 2nd Edition: Chapter 8: Security perlsec	[reply] [d/l] [select]
Re: Will this work? by Xilman (Hermit) on May 21, 2010 at 06:39 UTC
Please describe the symptoms in rather more detail than "it doesn't work". Hardly anyone is going to wade through a couple of hundred lines of code otherwise. Likewise, try to strip down the posted code to remove everything which does work and is otherwise unimportant from the point of view of problem finding. The more closely you can locate the problem, the easier it is to provide a solution. Give us a clue where to look and there are a number of people around here who will be glad to help where they can. Finally, get into the habit of including `use strict; use warnings;` [download] at the head of your scripts. You will never regret their aid in displaying problems. Paul	[reply] [d/l]
Re^2: Will this work? by Anonymous Monk on May 21, 2010 at 07:29 UTC
I've had a look through his code, and aside from his html templates, his code is not worth salvaging. No amount of describing the symptoms is going to help. It doesn't compile, its incomplete, there is massive scope/variable confusion, and there is hand-rolled CGI/date code that has been haunting perl since at least 1997 :) He does try to sanitize his inputs, but with all that scope confusion, there is no telling what directory he is trying to write to. I started fixing up his program, but I honestly believe he'll benefit more from studying the basics first.	[reply]
Re^3: Will this work? by JavaFan (Canon) on May 21, 2010 at 08:19 UTC
My bet is that his CGI code isn't hand rolled. It's likely to be copied and pasted. His date code might as well.	[reply]
Re^4: Will this work? by Anonymous Monk on May 21, 2010 at 08:47 UTC
Re^5: Will this work? by JavaFan (Canon) on May 21, 2010 at 08:59 UTC
Re^5: Will this work? by saffron (Initiate) on May 21, 2010 at 19:17 UTC
Some notes below your chosen depth have not been shown here