perl script error mysql server went away

[griznik]

Hi folks.

I dabble a little in Perl. Anyhow, I have been tasked with figuring out why a Perl script won't process more than one attachment of pdf files associated with a client id in a mysql database.

I have stared at this for quite a while but I haven't got a clue how to fix or re-write it. I would welcome any suggestions and am not afraid to jump in and re-write if I have to. It just doesn't look right to me. How it worked I don't know. It's a legacy issue from a Linux server that had to be replaced due to a failed mirror set.

If anyone wants to have a look, please do. Here's the code:

#!/usr/bin/perl
# This script grabs info from filename and associates it with email address.

#use CGI;
#$cgi = new CGI;
use DBI;
$cc="user1\@xxx.xxx";
$cc2="user2\@xxx.xxx";
$cc3="user3\@xxx.xxx";
$cc4="user4\@xxx.xxx";
$datadir="/home/data/dd/outbox/";
$file2="/var/

http://www/cgi-bin/dd/invoice.txt";

$sqlhost = "localhost";
$sqlport = "3306";
$sqluser = "xxxxxx";
$sqlpassword = "xxx.xxxxxx.xxx";

$account="";
$email_billing = "";
$email_address = "";

$driver = "mysql";
$dsn = "DBI:$driver:database=xxx;host=$sqlhost";
$dbh = DBI->connect($dsn, $sqluser, $sqlpassword, {PrintError => 1, RaiseError => 1});
$drh = DBI->install_driver("mysql");
@databases = $drh->func($sqlhost, $sqlport, '_ListDBs');
@tables = $dbh->tables('_ListTables');

opendir DIR, "$datadir";
my @files = grep { $_ ne '.' && $_ ne '..' } readdir DIR;
foreach(@files){
$account=`echo $_ | cut -c7-11`;
$account += 0;
$file=$_;
closedir DIR;
# Put all DB stuff in here

$sth=$dbh->prepare("SELECT email_billing,email_address FROM users WHERE customer_id=$account");
$sth->execute ();
$rows = $sth->rows;
$db_error = $sth->errstr;

if ($rows > 0) {
@sqlref = $sth->fetchrow();
$email_billing = $sqlref[0];
$email_address = $sqlref[1];
$sth->finish ();
$sth=$dbh->prepare("insert into emaillog (customer_id, email_billing, email_address, file_name) values (\"$account\", \"$email_billing\", \"$email_address\", \"$file\")");
$sth->execute ();
$sth->finish ();
$dbh->disconnect ();
if ($email_billing eq "Y") {
&sendemail;
}
}
$sth->finish ();
}
$dbh->disconnect ();
#die;

sub sendemail {
`mutt -s "$file" -a /home/data/dd/outbox/$file -F /home/.Muttrc $email_address < $file2`;
`mutt -s "$file" -a /home/data/dd/outbox/$file -F /home/.Muttrc $cc < $file2`;
`mutt -s "$file" -a /home/data/dd/outbox/$file -F /home/.Muttrc $cc2 < $file2`;
`mutt -s "$file" -a /home/data/dd/outbox/$file -F /home/.Muttrc $cc3 < $file2`;
`rm -f /home/data/dd/outbox/$file`;
}

sub showsuccess {

open (TEST, $htmlpath."test2.htm");
@buf = <TEST>;
close (TEST);
print $cgi->header;
print @buf;
print "Account: ";
print $account;
print "<BR>Filename: ";
print $file;
print "<BR>Email Address: ";
print $email_address;
die;
}

Thanks in advance.

 

[PaulTEG]

opendir DIR, "$datadir";
my @files = grep { $_ ne '.' && $_ ne '..' } readdir DIR;  
[COLOR=blue]print @files;[/color]
[COLOR=red]closedir DIR;[/color]
[COLOR=green]open LOGFILE ">log.txt";[/color]
foreach(@files){
[COLOR=green]  print LOGFILE $_."\n";[/color]
  $account=`echo $_ | cut -c7-11`;
  $account += 0;
  $file=$_;

Try this, and see how you get on, red first, then blue, then green


Paul
------------------------------------
Spend an hour a week on CPAN, helps cure all known programming ailments ;-)

 

[griznik]

Hi.

I tried the modifications suggested and now the script will at least send 2 invoices but it still chokes on 3 or more.

I also had to add a comma to the open LOGFILE ">log.txt";

It now reads as open LOGFILE, ">log.txt";

This is good progress and yet I still have te DBD mysql server went away message.

Thanks in advance for any more possible tips!

--griz

 

[stevexff]

It's broken because of the $dbh->disconnect() in the middle of the loop. The only reason you get "two" iterations with the LOGFILE solution is because it writes to the log file before it tries to communicate with the DB for the second time. Just comment it out and see what happens. Note, you still need the other $dbh->disconnect() near the bottom...

Steve

[small]"Every program can be reduced by one instruction, and every program has at least one bug. Therefore, any program can be reduced to one instruction which doesn't work." (Object:erlDesignPatterns)[/small]