crash when use fork

crash when use fork

crash when use fork
各位高手帮忙看看以下这段代码,运行后程序崩溃。问题出在File::Find的wanted callback函数中用了fork,但不清楚为什么会这样,请各位赐教。

use strict;
use File::Find qw/find/;

sub wanted {
return if m{ ^ [.]{1,2} $ }xms;

print "[$_]\n";
if (my $pid = fork) {
print "parent start to wait\n";
wait;
}
else {
defined($pid) or die "fork fail: $!";
exec("echo child") or die "exec fail: $!";
}
}

print "start\n";

find( { wanted => \&wanted, bydepth => 1 }, shift || die "input destination dir first\n" );

print "end";

运行后的提示,类似于:

g:\Downloads>error.pl TOC
start
[TOC.html]
parent start to wait
child
Attempt to free unreferenced scalar: SV 0x19ccc38, Perl interpreter: 0x193a014.
没有人回答吗
虽然我还没有找到解决问题的方法,所以暂时只好退而求其次了,不在wanted hook中新建子进程了(我用了Parallel::ForkManager也是同样的问题,所以认定不能在其中新建子进程),以下是我完成的代码,高手给提点意见。

# this script is for setting svn:ignore property to the working copy managed by subversion.
# after running it, call 'svn commit' if your are sure.
# mail to joe.zheng@yuhuatel.com if any question/suggestion.

use strict;
use File::Find qw/find/;
use File::Spec::Functions;
use File::Temp qw/tempfile/;

# exclude all the files in the match directory.
# use regular express
my @exclude_dir = qw(
\/obj$
\/dep$
\/generated$
\/debug$
);

# exclude the files match the pattern.
# use regular express
my @exclude_file = qw(
\.bak$
\.lib$
\.a$
\.img$
\.map$
\.html$
\.htm$
\.err$
\.pkg$
\.ffs$
\.cat$
\.axf$
\.exe$
\.dll$
\.ilk$
\.ncb$
);

my $max_parallel_process_num = 10; # max number of the parallel process
my $debug = 0;
my %pid2info;
my %ignore_dir;

my $root_dir = shift or die "input destination dir first\n";
my $report = shift;

sub wait_for_a_kid {
my $pid = wait;
return 0 if $pid == -1; # no children any more
my $dir = $pid2info{$pid}{dir};
warn("Why did I see $pid ($?)\n"), next unless $dir;
warn "reaping $pid for $dir\n" if $debug;
unless ( $? >> 8 ) {
print "<< mission complete: $dir\n" if $debug;
print "[*] $dir\n";
print map "ignore: $_\n", @{ $ignore_dir{ $dir } };
}
else {
delete $ignore_dir{ $dir }; # failed
}
unlink $pid2info{$pid}{file};
delete $pid2info{$pid};

1;
}

sub wanted {
my $item = $_;
return if m{ ^ [.]{1,2} $ }xms;
return if $File::Find::name =~ m{ (?: [/] | ^ ) [.]svn (?: [/] | $ ) }xms;
if ( -d $item ) {
print '.';
foreach my $exclude_dir ( @exclude_dir ) {
if ( $File::Find::name =~ m{ $exclude_dir }xms ) {
push @{ $ignore_dir{ $File::Find::name } }, '*.*';
return;
}
}
}
else {
foreach my $exclude_file ( @exclude_file ) {
if ( $File::Find::name =~ m{ $exclude_file }xms ) {
push @{ $ignore_dir{ $File::Find::dir } }, $item;
return;
}
}
}
}

$| = 1;

print ">> start to check...\n";
find( { wanted => \&wanted, bydepth => 1 }, $root_dir );
print "\n<< check finished\n";

print ">> start to set property...\n";
for my $dir ( sort keys %ignore_dir ) {
my ( $fhandle, $fname ) = tempfile();
my %ignore_files = map +( $_, 1 ), @{ $ignore_dir{ $dir } };
if ( $ignore_files{ '*.*' } ) {
print $fhandle '*.*';
}
else {
print $fhandle map "$_\n", @{ $ignore_dir{ $dir } };
}
close $fhandle;

wait_for_a_kid() if keys %pid2info > $max_parallel_process_num;

my $pid = fork;
die "fork failed: $!" unless defined $pid;
if ( $pid ) {
# parent
print ">> parent [ $$ ] fork child [ $pid ] for new mission: $dir\n" if $debug;
$pid2info{ $pid } = {
dir => $dir,
file => $fname,
};
}
else {
# child
print ">> child [ $$ ] processing the mission: $dir\n" if $debug;
exec "svn ps svn:ignore -F $fname $dir";
#exit 0;
}
}

# wait for all the children
1 while wait_for_a_kid();

print "<< set property finished\n";

# generate report if necessary
if ( $report ) {
$| = 0;
open my $fh, '>', $report or die "$!";
print $fh <<"EOF_HEAD";
# set svn:ignore property to the working copy: $root_dir.
# auth: joe.zheng
# time: @{ [ scalar localtime ] }
# mail to joe.zheng\@yuhuatel.com if any question/suggestion
EOF_HEAD

for my $dir ( sort keys %ignore_dir ) {
print $fh map { ( catfile( $dir, $_ ), "\n" ) } @{ $ignore_dir{ $dir } };
}
close $fh;

print "check the report file: $report\n";
}