fork and DBI on Win 2000

[Becka]

Hi All,

I am missing out on a concept, I hope someone can help. (I'm getting an access 
violation when I run my script.)  What I want to do is write a script that 
connects to the database, forks several processes (which will actually be 
executions of prepared statements, which call SQL scripts), and then exits.  My 
entire goal is to run several executions simultaneously.

The problem I am encountering is that, with just a connection to the database, 
a simple fork, and a disconnection, I'm getting an error stating: "The 
instruction at <hex address> referenced memory at <another hex address>.  The 
memory could not be read."  I haven't even written any prepare statements yet. 
This is accompanied by STDOUT errors saying "Attempt to free unreferenced 
scalar during global destruction."  Do I need some signal handling?  I want the 
script to wait on the processes, if necessary.  But right now it isn't even 
processing anything. I've just got a print statement in the child and parent 
routines.

Any help will be appreciated! The code follows.

#!C:/Perl

use Net::SMTP; # for sendmail
use File::Copy; 
use DBI; # for Database interaction
use Net::Time; 
use Mail::Sender; # for sendmail
use POSIX ":sys_wait_h";

my $from         = "my_address\@my_workplace.com";
my $to           = "their_address\@their_workplace.com";
my $thisfile      = "specifics.pl";

$dbname = 'dbi:Oracle:our_machine';
$user   = 'our_user';
$pass   = 'our_password';
$wait   = 0;

sub sendmail{

    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 reaper { 
  print "In reaper.\n";
  my $zombie;
  our %Kid_Status;
  $zombies = 0;
  while ( ($zombie = waitpid(-1, WNOHANG)) == -1) {
    $Kid_Status{$zombie} = $?;
  }
}

sub parent_proc {
  print "Parent was called!\n";
  }

sub child_proc {
  print "Child was called: @_!\n";
 }

sub fork_off {
  my $child = 0;
  my $parent = 0;
  
  if(defined($pid = fork && exit)) {
    if ($pid) {
      print "Calling parent: $pid\n";
      $parent = &parent_proc();
      print "Parent returned $parent\n";
    } else {
      print "Calling child: $pid\n";
      $child = &child_proc();
      print "Child returned $child\n";
      exit;
    }
  } else {
    print "Forking didn't work\n";
  }
}

#                   DATABASE CONNECTION
###############################################################################
####################
my $subject = "Connection to database failed!";
my @body = ("$thisfile failed to connect to database - please see log file\n");

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;
                      
#                     !MAIN!
###############################################################################
####################

our $zombies = 0;

{
  $SIG{CHLD} = sub {$zombies++};
   
  &fork_off();
  
  &reaper() if $zombies;

}

$dbh->disconnect or warn "Disconnection failed: $DBI::errstr\n";
print "Done.\n";

--Becka Louden