rkrish has asked for the wisdom of the Perl Monks concerning the following question:

Hi I have a perl script that does the following, creates 10 child processes and process them seperately. 

use Oraperl;
use DBI;
use strict;
use DBD::Oracle qw(:ora_types);
use Time::Local;
use POSIX;


my @SharedPlanAccts=();
my $lda = "";
my $two_task = "";
my $pid=$$;
my $todays_date = `date +\%Y\%m\%d`;
my $curr_time = `date +\%H\%M\%S`;
my $noOfInputDomainsRunning = 0;
my $APIDomainIndex = 0;
my ($i1, $k1, $j1) = 0;
my @pids;
my $totalAccts = 0;
my $acctsPerChild = 0;
my $n = 10;

openLogFile();
LoginDB();
fetchAccounts();




for( $i1=1; $i1 <= $n; $i1++ )
{
    $pids[$k1] = fork();
    if ( $pids[$k1] == 0 ) 
    {
        $lda->{InactiveDestroy} = 1;
        ProcessRecords( @SharedPlanAccts, $i1, $n, $totalAccts );
        exit(0);
    }
    else
    {
        $k1++;
    }
}

foreach (@pids)
{
    #parent process waits here until all child process goes down
    waitpid($_,0);
}


LogoffDB();
sub openLogFile 
{
    my $p2klogs = $ENV{"LOGS"};

    my $log_file    = $p2klogs . "/" . $prog_name ."_" . $todays_date 
+.    $curr_time ."_".$$.".log";    

    unless (    open (LOGF,">>$log_file") )
    {
        print ("Open append failed    for    log    file = $log_file\n
+");
        print ("$prog_name    process    terminated abnormally.\n");
        exit 1;
    }
}


sub    LoginDB()
{
    my ( $db_user, $db_pswd    );

    $two_task =    $ENV{"TWO_TASK"};
    $db_user = $ENV{"DB_USER_NAME"};
    $db_pswd = $ENV{"DB_PASSWORD"};

    #--    connect    to database
    if    ( $db_user eq "/" ){
    $lda = DBI->connect("DBI:Oracle:" .    $two_task )
               || logDBIError ("logon to Oracle    failed");
    }
    else{
    $lda    = DBI->connect("DBI:Oracle:" . $two_task, $db_user,    $db
+_pswd);
            
    }
}

sub LogoffDB()
{
    $lda->disconnect || logDBIError("Failed to disconnect database han
+dle");

    logMessage ("The $prog_name process successfully completed ");

    close(LOGF);
}
sub fetchAccounts()
{
        my $res = $lda->prepare(" select distinct acct_nbr  acct_asgm 
+");
        if(defined($res))
        {

            $res->execute();
            while (my @row = $res->fetchrow_array()  ) 
            {
                push(@SharedPlanAccts,@row);
            }
        }
        else
        {
            logMessage("Could not execute the query!");
        }
        $totalAccts = @SharedPlanAccts;
        logMessage ( "Total Number of accts under validation : $totalA
+ccts ");

$acctsPerChild =  floor ($totalAccts/$n );
logMessage ("Each child process around $acctsPerChild accounts ");

}
sub ProcessRecords()
{
        my ( @acctArray,$myNbr,$totalChilds,$totalAccts) = @_;
        my $begIndex = 0;
        my $endIndex = 0;
        my $acctsProcessed = 0;
        openLogFile();
        LoginDB();

        $begIndex = ($acctsPerChild * $myNbr ) - $acctsPerChild;
        $endIndex = ($acctsPerChild * $myNbr ) - 1;
        
        if ( $myNbr == $n )
        {
            $endIndex = $totalAccts - 1;
        }

        my @acctList = @acctArray[$begIndex .. $endIndex];
        


        foreach   my $a   (@acctList) 
        {
            logMessage ("Acct Under Validation  : $a  ");
            if( defined ($a) )
            {
                my $found = 0;
                my ( $AcctNbr, $CycCd, $CycEndDt  );
                my $dly1 = $lda ->prepare("select acct_nbr,cycle_cd,cy
+cle_end_dt  from Daily1 where acct_nbr= ? and rownum <2 order by cycl
+e_end_dt ");
                my $dly2 = $lda ->prepare("select acct_nbr,cycle_cd,cy
+cle_end_dt  from Daily2 where acct_nbr= ?  and rownum < 2  order by c
+ycle_end_dt ");
                $dly1->bind_param(1,$a);
                $dly2->bind_param(1,$a);

                $dly1->execute();
                $dly1->bind_col(1,\$AcctNbr);
                $dly1->bind_col(2,\$CycCd);
                $dly1->bind_col(3,\$CycEndDt);
                $acctsProcessed=$acctsProcessed + 1;
                while ( $dly1->fetch) 
                {
                    $found++;
                    rerateandupdate($AcctNbr,$CycCd,$CycEndDt);
                    last;
                }

                if ($found == 0) 
                {
                    $dly2->execute();

                    $dly2->bind_col(1,\$AcctNbr);
                    $dly2->bind_col(2,\$CycCd);
                    $dly2->bind_col(3,\$CycEndDt);

                    while ( $dly2->fetch ) 
                    {
                        rerateandupdate($AcctNbr,$CycCd,$CycEndDt);
                        last;
                    }

                }
            }
        }
        logMessage ("Total Number of Accts processed : $acctsProcessed
+ ");
        LogoffDB();
    
}
sub rerateandupdate 
{

logMessage ("Acct rerated ");
}
sub logMessage
{
    my($message) = shift;
    my $log_date = `date +%m/%d/%Y`;
    my $log_time = `date +%T`;
    chop($log_date,    $log_time);
    print LOGF ("$log_date:$log_time |    $message\n");
}

[download]

What the script does is..first it fetches accts from a table (in sub fetchAccounts ) ,forks 10 child process and pass the accts for further processing. These child process will also need to connect to DB. But during execution,I'm getting DB errors like : DBD::Oracle::db DESTROY failed: ORA-03135: connection lost contact (DBD ERROR: OCISessionEnd) Can anyone please tell tell me whats wrong here :(

Replies are listed 'Best First'.
Re: Problem with forking in perl
by McA (Priest) on Mar 14, 2013 at 08:00 UTC

    Hi,

    just a side note while looking at your problem. You have the function 

    sub ProcessRecords()
{
        my ( @acctArray,$myNbr,$totalChilds,$totalAccts) = @_;

    [download]
    and call this function with 
    ProcessRecords( @SharedPlanAccts, $i1, $n, $totalAccts );

    [download]
    I hope you're aware of the fact that @acctArray slurps ALL args and $myNbr, $totalChilds,$totalAccts will be undef.

    For all reading this: 

    use strict;
use warnings;

use Data::Dumper;

my @list = qw(1 2 3 4);
func(@list, 'a', 'b', 'c');

sub func {
    my (@list, $s1, $s2, $s3) = @_;
    print Dumper(\@list), "\n";
    print Dumper(\$s1), "\n";
    print Dumper(\$s2), "\n";
    print Dumper(\$s3), "\n";
}

    [download]

    McA

[reply]
[d/l]
[select]
      How can I overcome this? How to seperate these variable..? also LoginDB subroutine creates DB connection handle for the child process.
[reply]

        There are two possibilities

        • Change the parameters, so that the only list assignment is at the end. 

          sub ProcessRecords() {
        my ($myNbr, $totalChilds, $totalAccts, @acctArray) = @_;

          [download]
          In this case the scalars get one value and the rest is slurped by @acctArray. The sequence of parameters has also to be changed at the calling point.

        • Or you use references: 

          sub ProcessRecords() {
    my ($ref_acctArray,$myNbr,$totalChilds,$totalAccts) = @_;

          [download]
          and call it with 
          ProcessRecords( \@SharedPlanAccts, $i1, $n, $totalAccts );

          [download]
          You than have to dereference $ref_acctArray with a @$ref_acctArray.

        McA

[reply]
[d/l]
[select]
Re: Problem with forking in perl
by McA (Priest) on Mar 14, 2013 at 07:26 UTC

    Hi,

    I'm pretty sure that the problem comes from the fact that you share the DB-Connection. As soon as a child dies the connection is closed by the DESTROY function of the dbh-handle (DBI functionality). Have a look at DBIx::Connector.

    UPDATE: Also have a look at perldoc DBI and search for InactiveDestroy.

    Best regards
    McA

[reply]
[d/l]
[select]

      But here I'm not using a shared connection. I'm establishing a DB connection for every child process created. ( in sub ProcessRecords -LoginDB() ) and closing the connection in the same subroutine too.

[reply]

        Sorry, I just saw the LoginDB() on line 24. What is this good for?

        McA

[reply]

Back to Seekers of Perl Wisdom