I did fail to mention that I was running this in Windows XP with Perl 5.6.1. The error message probably stems from the OS as you pointed out, but, I'm thinking that something with Perl is not managing the memory properly.
I tried to copy about 700 files with 5 child processes and it dies with the error message at about 97% completion. I even tried to copy less files (200) - same thing.
Here's the whole code, if it helps:
use Getopt::Long;
use CER::CERIDIAN; #logging purposes
use Text::Tabs;
use Time::Local;
use Tie::IxHash;
use File::Path;
use Win32;
use File::Copy;
use File::DosGlob 'glob';
use Win32::File;
use Win32::AdminMisc;
#------------------Syntax Checking
Configure( \%Config, @ARGV );
if ($Config{help} || !$Config{source} || !$Config{target} || !$Config{
+filemask} || !$Config{thread}){
Syntax();
exit 10;
}
if ($Config{log}){
$log_file = $Config{log};
}else{
my ($Script) = ($0 =~ /([^\\\/]*?)$/);
$log_file = "$Script.log";
}
if ($Config{test}){
CERIDIAN::logentry("flagged as a testmode",$log_file);
$testmode = 1;
}else{
$testmode = 0;
}
#------------------Main Body
CERIDIAN::logentry("OPMCOPY started...",$log_file);
print "\nStarting to copy\n";
$source = $Config{source};
$target = $Config{target};
$threads = $Config{thread};
foreach $filemask(@filemasks){
$fileparm = "$source\\$filemask";
push(@list,glob($fileparm)); #look into globbing 400 at a time
}
$num_of_files = scalar(@list);
$per_batch = int($num_of_files / $threads);
use warnings;
$| = 1; # turn off buffering
my $pid = $$; # $$ holds the current process ID number
my $parent = 0; # the original process was an immaculate conception
my @kids = (); # no babies yet
FORKER: for ($i = 1; $i <= $threads; $i++){
my $newpid = fork();
if ( not defined $newpid ){
# if return value of fork() is undef, something went wrong
die "fork didn't work: $!\n";
}elsif ( $newpid == 0 ){
# if return value is 0, this is the child process
$parent = $pid; # which has a parent called $pid
$pid = $$; # and which will have a new process ID number of it
+s very own
@kids = (); # the child doesn't want this baggage from the par
+ent
last FORKER; # and we don't want the child making babies eithe
+r
}else{
# the parent process is returned the PID of the newborn by for
+k()
CERIDIAN::logentry("$$ spawned $newpid",$log_file);
push @kids, $newpid;
}
}
if ( $parent ){ # if I have a parent, i.e. if I'm the child process
do_something();
exit( 0 );
}else{
# parent process needs to preside over the death of its kids
while ( my $kid = shift @kids ){
CERIDIAN::logentry("Parent waiting for $kid to die",$log_file)
+;
my $reaped = waitpid( $kid, 0 );
unless ( $reaped == $kid ){
CERIDIAN::logentry("Something's up: $?",$log_file);
}
}
}
#------------------End Main Body
sub do_something {
$offset = 0;
if ($i == $threads){
$offset = $num_of_files - ($threads*$per_batch);
}
$start_point = (($i-1)*$per_batch)+1;
$end_point = $i*$per_batch + $offset;
for ($ii = $start_point; $ii <= $end_point; $ii++) {
if (!$testmode){
copy "$list[$ii-1]" => "$target";
}
CERIDIAN::logentry("copying $list[$ii-1] => $target",$log_file
+);
}
return(1);
}
sub Configure
{
my( $Config, @Args ) = @_;
my $Result;
Getopt::Long::Configure( "prefix_pattern=(-|\/)" );
$Result = GetOptions( $Config,
qw(
source|s=s
target|d=s
filemask|f=s@
thread|n=s
test|t=s
log|l=s
help|h|?
)
);
$Config->{help} = 1 if( ! $Result );
push( @filemasks, @{$Config->{filemask}} ) if( scalar @{$Config->{
+filemask}} );
}
sub Syntax {
my ($Script) = ($0 =~ /([^\\\/]*?)$/);
my ($Line) = "-" x length($Script);
print <<EOT;
$Script
$Line
Syntax:
$Script -s source -d destination -n threadcount -f filemask
[-f filemask2 [-f filemask3 [...]]]
[-l log -t testmode]
[-help | -h | -?]
-s...............Specifies the source directory of files
-d...............Specifies the target directory to copy to
-n...............Specifies type number of threads (processes)
to split the command into
-f...............filemask for the copy command
Specify as many as needed.
-l...............log file to write to
-t...............testmode (doesn't copy anything)
Exit Parameters:
exit 0...............successful completion
exit 10..............called for help (view syntax)
exit 20..............unable to open log file
EOT
}
|