in reply to The pain of DBI !!! Lost connection from forked or threaded children

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]"; ~); }
  • Comment on Re: The pain of DBI !!! Lost connection from forked or threaded children
  • Download Code