The systems is vanilla Fedora 12. The database is mysql. Processes are forked using the code below. Because I thought forking using Fork Manager might be the problem, I tried threads again with still problems. What I can't believe is even after the fork, a whole new perl is run using system in an attempt to isolate problems like this from occuring. Some of the spwaned processes to video processing which if fails takes the entire parent process (this script) with it. In short, the script currently does threads, but with a few moved comments will just as easily do fork. The problem starts when dl_start finishes.
#! /usr/bin/perl -T print "Starting...\n"; use DBI; use threads qw(stringify); use threads::shared; use Time::HiRes qw (sleep); do("./sql.pl"); &sql_setup; #use Parallel::ForkManager; #$MAX_PROCESSES = 10000; #$pm = new Parallel::ForkManager($MAX_PROCESSES); $server_id = "A"; share($server_id); $sys_ok = 1; share($sys_ok); $|++; # $pm->run_on_finish( # sub { my ($pid, $exit_code, $ident) = @_; # #print "** $ident just got out of the pool ". # # "with PID $pid and exit code: $exit_code\n"; # } # ); # $pm->run_on_start( # sub { my ($pid,$ident)=@_; # #print "** $ident started, pid: $pid\n"; # } # ); print "Ready ($server_id).\n"; $thr3 = threads->new(\&monitor); $thr3->detach; if ($server_id =~ "proc"){ print "Processing Node Active\n"; $thr4 = threads->new(\&processor,1); $thr4->detach; } $thr1 = threads->new(\&starter); $thr1->detach; $thr2 = threads->new(\&stopper); $thr2->detach; $thr4 = threads->new(\&processor,0); $thr4->detach; while (1){ sleep(1); #$pm->wait_all_children; } sub starter{ my @row; while (1){ if ($sys_ok){ sleep(2); @row = &row_sql(qq~ select * from pool_start where status += "" limit 1; ~,-1); if (!(@row)){ #print "Nothing to do...\n"; }else{ &sql(qq~ update pool_start set status = "RUNNING" wher +e id="@row[0]"; ~,-1); #print "\nStarting (@row[1],@row[2])\n"; #my $thr = threads->create(\&bt_start,@row[1],@row[2], +@row[3]); #$thr->detach; #$child_starter++; #my $pid = $pm->start($child_starter) and next; if (@row[4] eq ""){ # &dl_start(@row[1],@row[2],@row[3],"","",@row[ +5],@row[6],@row[0]); my $thr = threads->create(\&bt_start,@row[1],@ +row[2],@row[3],"","",@row[5],@row[6],@row[0]); $thr->detach; } if (@row[4] eq "URL"){ print @row; &url_start(@row[2],@row[5],@row[6],@row[0]); } #$pm->finish($child_starter); # Terminates the child process #print("Thread $thr started...\n"); } #unless (@row){sleep(2);} }else{ sleep(30); } #$pm->wait_all_children; } } sub stopper{ my @row; while (1){ @row = &row_sql("select b from pool_stop where srv='$server_id +';",-1); if (!(@row)){ #print "Nothing to do...\n"; }else{ #print "\nShould End (@row[0])"; mkdir("./b_stop/@row[0]"); $delete = qq~ delete from pool_stop where b="@row[0]"; ~; &del_sql($delete,-1); } sleep(2); } } sub monitor{ while (1){ sleep(5); $disk =~ s/\%//g; if (($avg > $max_avg) || ($disk > 80)){$sys_ok = 0;}else{$sys_ +ok = 1;} print "($sys_ok)\n"; } } sub processor{ my @row; while (1){ if ($sys_ok){ if ($_[0] eq "0"){ $select = qq~ select * from pool_process where srv="$ser +ver_id" and any != "1" and status=""; ~; } if ($_[0] eq "1"){ $select = qq~ select * from pool_process where any="1" a +nd status=""; ~; } @row = &row_sql($select,-1); if (!(@row)){ #print "Nothing to do...\n"; }else{ &del_sql(qq~ update pool_process set status = "RUNNING +" where id="@row[0]"; ~,-1); print "Processing (@row[1],@row[2],@row[3],@row[4])\n" +; #my $thr = threads->create(\&process_start,@row[1],@ro +w[2],@row[3],@row[4],@row[5]); #$child_processor++; #my $pid = $pm->start($child_processor) and next; # &process_start(@row[1],@row[2],@row[3],@row[4],@row[5],@row +[6],@row[7],@row[0]); my $thr=threads->new(\&process_start,@row[1],@row[ +2],@row[3],@row[4],@row[5],@row[6],@row[7],@row[0]); $thr->detach; #print "($pid)($rand)Child about to get out...\n"; #print "$names[$child], Child $child is about to get + out...\n"; #print "Child about to get out ($$)\n"; #system("kill $$"); #$pm->finish($child_processor); # Terminates the chi +ld process #print "Finished Child!"; } sleep(2); }else{ sleep(30); } #$pm->wait_all_children; } } sub process_start{ system(qq~ perl ./thread_processor.pl "$_[0]" "$_[1]" "$_[2]" "$_[ +3]" "$_[4]" ~); #&tp_remove_process($_[7]); } sub dl_start{ #print $_[2], $_[2]; system(qq~ perl ./fork_sc.pl "$_[0]" "$_[1]" "$_[2]" "$_[3]" "$_[4 +]" "$_[5]" "$_[6]" ~); #&tp_remove_start($_[7]); } sub url_start{ #print "$_[0], $_[1], $_[2]"; system(qq~ perl ./fork_url.pl "$_[0]" "$_[1]" "$_[2]" ~); #&tp_remove_start($_[3]); } sub tp_remove_start(){ &sql(qq~ delete from pool_start where id="$_[0]"; ~); } sub tp_remove_process(){ &sql(qq~ delete from pool_process where id="$_[0]"; ~); }

In reply to Re: The pain of DBI !!! Lost connection from forked or threaded children by expresspotato
in thread 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.