From 983a15158daf0fe90005e66442ab09a6e4a1bcd7 Mon Sep 17 00:00:00 2001 From: short <> Date: Sat, 18 Oct 2003 20:45:55 +0000 Subject: [PATCH 1/1] Fixed 'Server has gone away'. - Do not reuse 'DBI' after fork(). Removed _cached() calls. --- perlmail-submit | 29 ++++++++++++++++++----------- 1 file changed, 18 insertions(+), 11 deletions(-) diff --git a/perlmail-submit b/perlmail-submit index fce762a..d01bc39 100755 --- a/perlmail-submit +++ b/perlmail-submit @@ -43,20 +43,26 @@ $DBI_pwd=; close DBI_PWD or warn "close DBI_pwd: $!"; chomp $DBI_pwd; -my $DBI=DBI->connect_cached("DBI:mysql:database=$DBI_database;host=","$DBI_user",$DBI_pwd,{ +my $DBI; +sub DBI +{ + return $DBI if $DBI; + $DBI=DBI->connect("DBI:mysql:database=$DBI_database;host=","$DBI_user",$DBI_pwd,{ "PrintError"=>0, # handled by "RaiseError" below "RaiseError"=>1, "ShowErrorStatement"=>1, "AutoCommit"=>1, }) or confess "Failed DBI->connect(): $!"; + return $DBI; +} # $name,@$cols sub create_table { my($name,$cols)=@_; - eval { $DBI->do("drop table $name"); }; - $DBI->do("create table $name (".join(",",@$cols).")"); + eval { DBI()->do("drop table $name"); }; + DBI()->do("create table $name (".join(",",@$cols).")"); } sub initdb @@ -68,7 +74,7 @@ sub initdb "retries int null default 0", # null=>done, 0=not yet tried to submit ], ); - $DBI->do("alter table $DB_table add index (retries,id)"); + DBI()->do("alter table $DB_table add index (retries,id)"); print "done.\n"; exit 0; } @@ -85,7 +91,7 @@ sub store "message"=>$message, # assume "retries"=>0, ); - my $prep=$DBI->prepare_cached("insert into $DB_table (".join(",",keys(%row)).")" + my $prep=DBI()->prepare("insert into $DB_table (".join(",",keys(%row)).")" ." values (".join(",",map("?",keys(%row))).")"); $prep->execute(values(%row)); print $prep->{"mysql_insertid"}."\n"; @@ -95,6 +101,7 @@ sub forkoff { my $pid=fork(); confess if !defined $pid; + $DBI=undef(); # Prevent: Server has gone away exit 0 if $pid; # parent # child } @@ -110,7 +117,7 @@ sub submitonce print "LOCKED\n"; exit 0; } - my $sth=$DBI->prepare("select id,message from $DB_table where retries is not null" + my $sth=DBI()->prepare("select id,message from $DB_table where retries is not null" # process only non-problematic mails during rerun .($submitonce_run==1 ? "" : " and retries=0") ." order by retries asc,id asc"); @@ -119,7 +126,7 @@ sub submitonce autoflush STDOUT 1; my $sock; while (my $row=$sth->fetchrow_hashref()) { - $DBI->do("update $DB_table set retries=retries+1 where id=".$row->{"id"}); + DBI()->do("update $DB_table set retries=retries+1 where id=".$row->{"id"}); if (!$sock) { $sock=IO::Socket::INET->new( "PeerAddr"=>$PeerAddr, @@ -140,7 +147,7 @@ sub submitonce undef $sock; } else { - $DBI->do("update $DB_table set retries=null where id=".$row->{"id"}); + DBI()->do("update $DB_table set retries=null where id=".$row->{"id"}); } print $progresschar.$row->{"id"}.($got eq "1" ? "" : "=FAIL"); $progresschar=","; @@ -166,7 +173,7 @@ sub print_messages { my($cond)=@_; - my $sth=$DBI->prepare("select message from $DB_table $cond order by id"); + my $sth=DBI()->prepare("select message from $DB_table $cond order by id"); $sth->execute(); while (my $row=$sth->fetchrow_hashref()) { print $row->{"message"},"\n"; @@ -188,7 +195,7 @@ sub clean my($keyword,$interval)=@_; # FIXME: SQL "now()" is raced against the block above - my $sth=$DBI->prepare("select id,time,retries from $DB_table where time>now()"); + my $sth=DBI()->prepare("select id,time,retries from $DB_table where time>now()"); $sth->execute(); while (my $row=$sth->fetchrow_hashref()) { warn "Message time in future: ".join(",",map( @@ -207,7 +214,7 @@ my($keyword,$interval)=@_; my $sec=0; $sec+=$1 while s/(\d+)s//g; die "Interval parse error; left \"$_\", parsed: $interval" if $_ ne ""; - $sth=$DBI->prepare(($print ? "select id" : "delete") + $sth=DBI()->prepare(($print ? "select id" : "delete") ." from $DB_table where retries is null and timeexecute(); if (!$print) { -- 1.8.3.1