Perl 5.10.1 on CentOS 6.8
First official project on Perl and get a issue with Perl fork. The parent process is a daemon and it folks child process and end it after the task is done. But the reality is the child process won't quit.
Since with Moose, totally 3 pieces of code. The expected result is the Kitty object will quit right after the PapaCat process calls the close to kill it.
Below is the demo code:pipe_test.pl
#!/usr/bin/perl #use warnings; #use strict; use PapaCat; use Data::Dumper; my $obj = new PapaCat(); $obj->pipe_test();
PapaCat.pm
package PapaCat; use strict; use warnings FATAL => 'all'; use Moose; use Kitty; use FileHandle; use Data::Dumper; sub pipe_test { my $self = shift; pipe(my $fh_from, my $fh_to); $fh_to->autoflush(1); my $pid; my $obj = Kitty->new(fh_to=>$fh_to); if (!($pid = fork())) { $obj->meow(); exit(); } elsif (!defined($pid)){ #fork failed print "fail:fork retuns with error.\n"; return; } $obj->pid($pid); my $result = readline($fh_from); print $result; $obj->close(); close $fh_to; sleep(1000); # make sure the parent won't quit first } 1;
Kitty.pm
package Kitty; use strict; use warnings FATAL => 'all'; use Moose; use Data::Dumper; sub meow { my $self = shift; my $mm = $self->_fh_to; print $mm ("Meow!\n"); } sub close { my $self = shift; print "bb:".Dumper($self). "\n"; if (kill(0, $self->pid)) { kill(15, $self->pid); } CORE::close($self->_fh_to); delete $self->{pid}; print " closed"; } has '_fh_to' => ( is => 'rw', init_arg => 'fh_to', ); has 'pid' => ( is => 'rw', ); 1;
In reply to the sub-process wont exit until the parent does by sleepy_11
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |