Hi,
I am relocating content from a non-mod_perl Apache site to a new
mod_perl/1.24 enabled Apache server and I have a problems getting one of the
CGI scripts to behave in mod_perl. All it does is capture e-mail addresses,
and place them in a text file so we can gather them up later and drop them
into a database. If you run the script as a regular CGI (without mod_perl
enabled) it works great. But on the mod_perl enabled server, the script
throws garbage into the file and overwrites previous entries if a user
submits more than one e-mail address in a single session (i.e. they enter
one address, click "Back", then enter another address). However, if the user
submits one e-mail address, then quits their browser, restarts the browser
and enters another e-mail, it works just fine. Does anybody have any idea
why this would happen? I've included the CGI script below with actual URL's
omitted (which was written by some consultant who no longer works here).
Thanks!
-Rob
[EMAIL PROTECTED]
---------begin script text
#!/usr/local/bin/perl
$|=1;
# Enumerate the locking options for clarity...
$LOCK_EX = 2;
$LOCK_UN = 8;
$results_file = "./results.csv";
$cl = $ENV{'CONTENT_LENGTH'};
$rqm = $ENV{'REQUEST_METHOD'};
sub lock {
# print "locking<BR>";
flock(RESULTS, $LOCK_EX);
# print "seeking<BR>";
# seeks to the end of the file in case
# someone got while we were waiting for the lock
seek(RESULTS, 0, 2);
# print "locked<BR>";
}
sub unlock {
# print "unlocking<BR>";
flock(RESULTS, $LOCK_UN);
# print "unlocked<BR>";
}
sub web_die {
print "Location: http://<omitted>";
die("\n");
}
sub web_die_action {
print "Location: http://<omitted>";
die("\n");
}
sub return_error
{
local ($status, $keyword, $message) = @_;
print "Content-type: text/html", "\n";
print "Status: ", $status, " ", $keyword, "\n\n";
print <<End_of_Error;
<HTML><HEAD><TITLE>Unexpected CGI Error</TITLE></HEAD>
<BODY>
<H1>$keyword</H1>
<HR>$message</HR>
</BODY>
</HTML>
End_of_Error
exit(1);
}
sub write_entry
{
# Lock after you open
&lock();
$count = 0;
foreach (keys %FORM)
{
$count++;
}
for ($i = 0; $i < $count; $i++)
{
$index = $i + 1;
if ($FORM{"FIELD_$index"} eq "")
{
$FORM{"FIELD_$index"} = "NO ENTRY";
}
$FORM{"FIELD_$index"} =~ s/\"/\"\"/g; # ...change " to ""
$FORM{"FIELD_$index"} =~ s/\r//g; # ...kill line feeds
$FORM{"FIELD_$index"} =~ s/\n/ /g; # ...change cr to
whitespace
$FORM{"FIELD_$index"} = "\"" . $FORM{"FIELD_$index"} . "\"";
print RESULTS $FORM{"FIELD_$index"};
print RESULTS ","
}
print RESULTS "\n";
# Unlock before you close
&unlock();
close(RESULTS);
&location;
}
if ($rqm eq "POST")
{
read(STDIN, $buffer, $cl);
@pairs = split(/&/, $buffer);
$q = 0;
foreach $pair (@pairs)
{
$q++;
($name, $value) = split(/=/, $pair);
$FORM{"FIELD_$q"} = $value;
$FORM{"FIELD_$q"} =~ tr/+/ /;
$FORM{"FIELD_$q"} =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
if ($FORM{"FIELD_$q"} eq "0-12")
{
&location;
exit(0);
}
}
}
elsif ($cl > 0)
{
&web_die_action;
# Error: form results must be submitted with method POST
}
###################################################
if (! (-e $results_file))
{
if (open (RESULTS, ">results.csv"))
{
&write_entry;
}
else
{
&return_error (500, "Results Error", "Cannot create results.csv to
store
entries.");
}
}
else
{
if (! ((-r $results_file) && (-w $results_file)) )
{
&return_error (500, "Results Error", "Cannot read or write to
results.csv.");
}
else
{
open(RESULTS, ">>results.csv") || &web_die;
&write_entry;
}
}
exit(0);
sub location
{
print "Location: http://<omitted>";
}
