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