Hi everyone,
This is a followup to a previous question about a fork/DBI clash. I have a
script that calls fork, which starts children which call some batch files,
which call some perl scripts. This works great (on Windows 2000).
However, when I try to connect to the database in this main script, just to
get a number from a table to use in naming the batch files later, I get "The
memory could not be read" pop-up error. I disconnect from the database
before I start the fork, and I only make that one connection. However, it
seems like whenever I try to have fork and DBI in the same script, it causes
crashing.
In the following script I have commented out the DBI parts, and it works
that way. If these sections are un-commented, the script fails.
Any insights would be greatly appreciated.
Thanks!
Becka Louden
#!C:/Perl
# USE STATEMENTS
use Net::SMTP; # for sendmail
use File::Copy;
use DBI;
use Net::Time;
use Mail::Sender; # for sendmail
use POSIX ":sys_wait_h";
use Win32::Process;
use strict;
# GLOBALS
my $from = "Collectamerica_automated_process\@collectamerica.com";
my $to = "rlouden\@collectamerica.com";
my $thisfile = "fork.pl";
my $dbname = 'dbi:Oracle:mydatabase';
my $user = 'mylogin';
my $pass = 'mypassword';
my $wait = 0;
# SUB ROUTINES
sub ErrorReport{
# used for win32::Process error handling
print "Aha!: ", Win32::FormatMessage( Win32::GetLastError() );
}
sub sendmail{
#sends mail in case of error
#print "Arguments passed: @_\n";
my($to, $from, $subject, @body) = @_;
my $relay = "mail.collectamerica.com";
my $smtp = Net::SMTP->new($relay,
Hello => 'WORKGROUP'); # specify mail domain);
die "Could not open connection: $!" if (!defined $smtp);
$smtp->mail($from);
$smtp->to($to);
$smtp->data();
$smtp->datasend("To: $to\n");
$smtp->datasend("From: $from\n");
$smtp->datasend("Subject: $subject\n");
$smtp->datasend("\n");
foreach(@body) {
$smtp->datasend(":$_\n");
}
$smtp->dataend();
$smtp->quit;
}
sub get_max_cacv {
#retrieves number of highest note from database
my $cacv_max;
my $max;
$Main::get_num_cacv->execute();
while(my $cacv_one = $Main::get_num_cacv->fetchrow_array) {
$cacv_max = $cacv_one;
}
if($cacv_max =~ m/^CACV(\d{3})\/.*$/) {
$max = $1;
}
return $max;
}
sub parent_proc {
# Does nothing, just has children
return 0;
}
sub child_proc {
#calls batch file of number specified by argument
my $args = (@_);
if ($args != 1) {
die "Whoops, wrong num args passed to fork_off\n";
} else {
my $num = $_[0];
print "Child was called!: ";
my $args = '';
my $proc_obj = '';
my $exitcode = -1;
print "Attempting to open query${num}.bat\n";
Win32::Process::Create($proc_obj,
"c:/perl/exercises/fork/query${num}.bat",
$args,
0,
NORMAL_PRIORITY_CLASS,
".")|| die( &ErrorReport() );
$proc_obj->Wait(600000);
$proc_obj->GetExitCode($exitcode);
if($exitcode != 1) {
print "Batch process exit code: $exitcode!\n";
}
return $exitcode;
} # end else args = 1
}
sub fork_off {
# fork processes so they run in parallel
my $child = 0;
my $parent = 0;
my $pid;
my $args = (@_);
if ($args != 1) {
die "Whoops, wrong num args passed to fork_off\n";
} else {
my $num = $_[0];
if(defined($pid = fork)) {
if ($pid) {
print "Calling parent: $pid\n";
$parent = &parent_proc();
} else {
print "Calling child: $pid\n";
$child = &child_proc($num);
print "Child returned $child\n";
exit;
}
} else {
print "Forking didn't work\n";
}
return $num;
} # end else args = 1
return 0;
}
sub reaper {
print "In reaper.\n";
my $zombie;
our %Kid_Status;
while ( ($zombie = waitpid(-1, WNOHANG)) == -1) {
$Kid_Status{$zombie} = $?;
}
}
# DATABASE CONNECTION
if(0) { # MULTI LINE COMMENT
my $subject = "Connection to database failed!";
my @body = ("$thisfile failed to connect to database - please see log
file\n");
my $dbh;
until (defined($dbh) || ($wait > 10) ) {
$dbh = DBI->connect($dbname, $user, $pass, {AutoCommit=>0})
||
sendmail($to,$from,$subject,@body);
if(!defined($dbh)) {
sleep 300;
$wait++;
}
} # end until (defined($dbh))
if(!defined($dbh)) {
die "$subject";
}
$dbh->{LongReadLen} = 214748363;
$dbh->{LongTruncOk} = 1;
} # END MULTI LINE COMMENT
# PREDEFINE STATEMENTS
#$Main::get_num_cacv = $dbh->prepare("SELECT frw_name from frw where
# frw_name LIKE 'CACV%'");
# MAIN
my @num_month =
(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36);
# GET CACV NUMBER FROM DATABASE DYNAMICALLY
#my $max_month = &get_max_cacv();
#my @num_month = (1..$max_month);
#print "Num_month is @num_month\n";
#$Main::get_num_cacv-> finish();
#$dbh->disconnect or warn "Disconnection failed: $DBI::errstr\n";
foreach my $num (@num_month) {
# write the batch files to run the pl files
open(BATFILE, ">c:/perl/exercises/fork/query${num}.bat") || die "I can't
open ${num}.bat\n";
print BATFILE "c:/perl/exercises/fork/query${num}.pl\n";
close(BATFILE);
open(PLFILE, ">c:/perl/exercises/fork/query${num}.pl") || die "I can't open
${num}.pl\n";
print PLFILE "#!C:/Perl\n#Perl stub file\n",
"print \"File query${num}.pl was called successfully!\n\";";
close(PLFILE);
}
# call the batch files thru FORK
our $zombies = 0;
my @processes = ();
{ # scope bracket
$SIG{CHLD} = sub {$zombies++};
foreach my $num (@num_month) {
my $done = &fork_off($num);
print "Done: $done\n";
}
&reaper() && ($zombies = 0) if $zombies;
} # end scope bracket
print "Done with all.\n";
_________________________________________________________________
Send and receive Hotmail on your mobile device: http://mobile.msn.com
