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

I have a little script(for the web) that I am playing with. All this script needs to do is take a group of specific params and make sure that there is info in there (not necessary if it is correct) and then take any other ones that may appear put them all into an email and send it. The mechanics of the script work fine but when I run it with other people my copy will sometimes get their data and vise-versa. It will sometimes duplicate the information inside the email. So far I have only noticed it when I hit refresh repeatedly, but I am affraid that this could become a "privacy" issue. I don't know if the CGI object is causing this, my script being stupid, or Apache. I have run it on different Apache configurations with the same problem. 
#!/usr/bin/perl
# Setting up my include files
use strict;
use CGI;
use CGI::Carp qw(fatalsToBrowser);
use Net::SMTP;

undef $/;

# Creating objects
my $q = "";
$q = new CGI;



my $email_body = "";
my @params = $q->param;
my %param = {};
my %product_names = (    'product_a' => 'Product A',
            'product_b' => 'Product B');
            
foreach (@params) {
    $param{$_} = 1;
}

$email_body.="calling HANDLE_PERSONAL_INFORMATION\n";
HANDLE_PERSONAL_INFORMATION();
$email_body.="calling HANDLE_PRODUCTS\n";
HANDLE_PRODUCTS();
PRINT_HEADER();
SEND_EMAIL($email_body);
#print $email_body;
exit;



sub HANDLE_PRODUCTS {
    #this is where I will do all the product handling
    my @last_params = keys %param;
    $email_body.="Listing products selected:\n";
    foreach (@last_params) {  
    $email_body .= $product_names{$_} . "($_): " . $q->param($_) . "\n
+" if($q->param($_) != 0);
    }
}


sub HANDLE_PERSONAL_INFORMATION {
    my $order_num = $_[0];
    my @personal_information = ('name', 'street', 'city', 'state', 'zi
+p', 'phone', 'email');
    my @errors = HANDLE_INFORMATION(@personal_information);
    if(($errors[0] != 0) || ($#errors > 1)){
    # I have created an error please help
    PRINT_HEADER();
    HANDLE_ERRORS(@errors);
    PRINT_FOOTER();
    exit;
    }
}

sub HANDLE_INFORMATION {
    my @columns = @_;
    $email_body.="Inside HANDLE_INFORMATION with columns: @columns\n";
    my @errors = ();
    foreach (@columns){
    my $temp = $q->param("$_");
    if($temp ne ''){
        delete($param{$_});
        $email_body .= uc $_;
        $email_body .= ": $temp\n";
    } else {
        #debuging    
        push @errors, $_;
    }
    }
    if($#errors == 0){
        return 0;
    } else {
    return @errors;
    }
}

sub HANDLE_ERRORS {
    #######################################
    # This handles all the errors that    #
    # the user causes              #
    #######################################
    foreach (@_){
    my $temp = ucfirst($_);
    print "<font color=red>$temp is required</font><br>\n";
    }
    print "Please hit the back button and fill out all the fields\n";
}

sub PRINT_HEADER {
    print $q->header;
print <<EODUMP;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<title>PAGE TITLE</title>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1
+">
</head>

<body bgcolor="#FFFFFF" text="#000000">
HEADER GOES HERE


EODUMP


}

sub PRINT_FOOTER {
print <<EODUMP;
</td>
</tr>
</table>
</td>
</tr>
</table>
</body>
</html>


EODUMP
    
}

sub SEND_EMAIL {
    my $smtp = Net::SMTP->new("my.email.server") or HANDLE_ERROR("Can 
+not submit.  System Down.");
    
    $smtp->mail ('email@domain');
    $smtp->to ('email@domain');
    $smtp->data();
    $smtp->datasend("To:  email\@domain\n");
    $smtp->datasend("From:  email\@domain\n");
    $smtp->datasend("Subject: Order\n");
    $smtp->datasend("\n");
    $smtp->datasend($email_body);
    $smtp->dataend();
    $smtp->quit;
    
    print "Your order has been submitted.<br>\n";
    print "You should be contacted shortly<br>\n";
    my @array = split(/\n/, $email_body);
    foreach(@array){
    print "$_<br>";
    }

}

[download]
I really think it is an Apache issue. Has anyone else had this? Thanks

--BigJoe

Learn patience, you must.
Young PerlMonk, craves Not these things.
Use the source Luke.

Replies are listed 'Best First'.
Re: CGI or Apache Problem?
by dws (Chancellor) on Jan 19, 2002 at 03:16 UTC 
      $email_body.="calling HANDLE_PERSONAL_INFORMATION\n";
  HANDLE_PERSONAL_INFORMATION();
                             ^^
  ...
  sub HANDLE_PERSONAL_INFORMATION {
      my $order_num = $_[0];
                      ^^^^^^

    [download]
    You're not passing an order number. I assume that some code that you've stripped out needs one.

[reply]
[d/l]
      Yeah I wanted to have it write to a DB but the user doesn't and I forgot to remove that line.

      --BigJoe

      Learn patience, you must.
      Young PerlMonk, craves Not these things.
      Use the source Luke.
[reply]
Re: CGI or Apache Problem?
by perrin (Chancellor) on Jan 19, 2002 at 03:00 UTC
    It's a problem with your script. Are you running under mod_perl? Globals can cause this problem, or accidental closures.
[reply]
      Yes I am running mod_perl. Do you know if there is something I can set to not allow this?

      --BigJoe

      Learn patience, you must.
      Young PerlMonk, craves Not these things.
      Use the source Luke.
[reply]
        You can use Apache::PerlRun, which clears globals for you, or you can fix the problem in your script.

        I see at least one possible cause of the problem. Your sub HANDLE_PRODUCTS() is referring to the variable $email_body, which is a lexical declared outside the subroutine. That creates a closure, and this sub keeps a private copy of that variable from then on. The best way to fix this is to pass a reference to $email_body into the subroutine instead.

[reply]
Re: CGI or Apache Problem?
by tune (Curate) on Jan 19, 2002 at 02:44 UTC
    Just a tip. I had a similar problem when I tried to run a simple CGI script on an Apache+mod_perl powered box, where some users had the previous users values because of mod_perl. With clever variable usage it is preventable.

    --
    tune

[reply]

Back to Seekers of Perl Wisdom