Hi, I'm using DBI across multiple threads and or forks. Apparently DBI still shares handles even across FORKED processes. Adding InactiveDestroy=>1 to the connect routine is supposed to fix this. There is no way I can setup and tear down a DBI instance directly in my program when need be. Thus, I use a single SQL.pl script, then call various subroutines to either row_sql,get_sql,put_sql or hash_sql. Now the problem is, when one of the forked children terminates, it seems to take other handles along with it from the parent. I've tried various things, even stupid things no doubt to get this working (like just constantly creating new handles if the old one has been used). Anyone who is able to help me solve this problem gets a free $25 paypal donation to them. Below is the SQL.pl code. Making it crash is fairly hard in a single threaded environment. But if you thread or fork a child process, when the thread / fork is done, so are some of the handles until the "until" loop kicks in to save the query from certain death! The Until loop provides some level of protection but I would preffer an error free solution. 
#!/usr/bin/perl -T

use DBI;
&sql_setup;

$sqlw = 1;  #Don't print SQL warnings if 0

sub sql_setup{
    if ($_ eq ""){
        $db="tr";
    }else{
        $db = $_[0];
    }
    $user="user";
    $passwd="password";
    $host="blogsphere.com:3306";
    $connectionInfo="dbi:mysql:$db;$host";
    $sql = 1;
        $sql_abort = 0;
}

sub del_sql{
    if ($_[0] eq ""){print "Empty Delete";}
    return &sql($_[0]);
}

sub mod_sql{
    if ($_[0] eq ""){print "Empty Modify";}
    return &sql($_[0]);
}

sub put_sql{
    if ($_[0] eq ""){print "Empty Put";}
    return &sql($_[0]);
}

sub row_sql(){
    $sql_r++;
  my $select = $_[0];
  my (@row1,@dbh1,@sth1,$retry_count1);
  if ($select eq ""){print "Empty Select."; exit;}

  until (
      eval {
        if ($sql_abort){&log("Aborted failed SQL.",-2); return 1;}
      $z1++;
        @dbh1[$z1]=DBI->connect_cached($connectionInfo,$user,$passwd, 
+{PrintError=>0,InactiveDestroy=>1,mysql_auto_reconnect=>1} );
      @sth1[$z1]=@dbh1[$z1]->prepare($select);
    if (@sth1[$z1]->execute()) {
      @row1=@sth1[$z1]->fetchrow_array();
      @sth1[$z1]->finish;
      }
    }
    ) { if ($sqlw){print "Retrying SQL Row ($DBI::errstr,$select)...";
+ } &sql_check_err($DBI::err,$select); sleep (1); $retry_count1++;}
    @dbh1[$z1]->disconnect();
    #print "Used Row Handle ($z1)";
    return @row1;
}

sub get_sql(){
    $sql_g++;
  my $select = $_[0];
    my $c = 0;
  my (@results,@row,@dbh2,@sth2,$retry_count2);
  if ($select eq ""){print "Empty Select."; exit;}
    
  until (
      eval {
        if ($sql_abort){&log("Aborted failed SQL.",-2); return 1;}
      $z2++; 
        @dbh2[$z2]=DBI->connect_cached($connectionInfo,$user,$passwd, 
+{PrintError=>0,InactiveDestroy=>1} );
        @sth2[$z2] = @dbh2[$z2]->prepare($select);
    if (@sth2[$z2]->execute()) {
      while (@row=@sth2[$z2]->fetchrow_array()) {
          @results[$c] = @row[0];
          $c++;
      }
        @sth2[$z2]->finish;
        }
        }
    ) { if ($sqlw){print "Retrying SQL Get ($DBI::errstr)...";} &sql_c
+heck_err($DBI::err,$select); sleep (1); $retry_count2++;}
    @dbh2[$z2]->disconnect();
    #print "Used Get Handle ($z2)";
  return (@results);
}

sub hash_sql(){
    $sql_h++;
  my $select = $_[0];
  my (@dbh3,@sth3,$retry_count3,$rows);
  if ($select eq ""){print "Empty Select."; exit;} 

  until (
      eval {
        if ($sql_abort){&log("Aborted failed SQL.",-2); return 1;}
      $z3++;
        @dbh3[$z3]=DBI->connect_cached($connectionInfo,$user,$passwd, 
+{PrintError=>0,InactiveDestroy=>1} );
     $rows = @dbh3[$z3]->selectall_arrayref(
      $select,
      { Slice => {} }
         );
        }
  ) { if ($sqlw){print "Retrying SQL Hash Select ($DBI::errstr,$DBI::e
+rr)...";}  &sql_check_err($DBI::err,$select);  sleep (1); $retry_coun
+t3++;}
    @dbh3[$z3]->disconnect();
    #print "Used Hash Handle ($z3)";
  return ($rows);    
}


sub sql{
    $sql_a++;
  my (@row,@dbh4,@sth4,$retry_count4);
    my $insert = $_[0];
    if ($insert eq ""){print "Empty insert."; exit;}
    
  until (
      eval {
        if ($sql_abort){&log("Aborted failed SQL.",-2); return 1;}
      $z4++;
        @dbh4[$z4]=DBI->connect_cached($connectionInfo,$user,$passwd, 
+{PrintError=>0,InactiveDestroy=>1} );
      @sth4[$z4]=@dbh4[$z4]->prepare($insert);
    if (@sth4[$z4]->execute()) {
            return 1;
        }
    }
    ) { if ($sqlw){print "Retrying SQL Insert ($insert) ($DBI::errstr)
+...";} &sql_check_err($DBI::err,$insert); sleep (1); $retry_count4++;
+}
    @dbh4[$z4]->disconnect();
    #print "Used SQL Handle ($z4)";
    return 1;
}

sub sql_check_err{
    #print "chkerr ($_[0])" . substr($_[0],0,19);
    #$_[1] =~ s/\"//g;        
    if ($_[0] eq "1064"){
        print "WARNING: SQL SYNTAX ERROR<br>($_[1])!!!\n";
        #&log("WARNING SQL SYNTAX ERROR ($_[1])",-3);
        $sql_abort = 1;
    }
    if ($_[0] eq "1054"){
        print "WARNING: SQL UNKNOWN COLUMN!!!\n";
        #&log("WARNING SQL COLUMN ERROR ($_[1])",-3);
        $sql_abort = 1;
    }
    
    if ($sql_abort){
        exit;
    }
}

[download]

In reply to The pain of DBI !!! Lost connection from forked or threaded children by expresspotato

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.