Fixed 'Server has gone away'.

 - Do not reuse 'DBI' after fork().
Removed _cached() calls.

diff --git a/perlmail-submit b/perlmail-submit
index fce762a..d01bc39 100755 (executable)
--- a/perlmail-submit
+++ b/perlmail-submit
@@ -43,20 +43,26 @@ $DBI_pwd=<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 time<from_unixtime(unix_timestamp()-$sec)");
        $sth->execute();
        if (!$print) {