#!/usr/bin/perl
#use warnings;
#use strict;
use PapaCat;
use Data::Dumper;
my $obj = new PapaCat();
$obj->pipe_test();
####
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;
####
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;