package NetHirc::Pipe; use strict; use warnings; use POE qw(Kernel Session Wheel::Run); use NetHirc::Util; my @events = qw( _start _stop error stdout stderr closed ); sub new { shift; POE::Session->create( 'package_states' => [ 'NetHirc::Pipe' => [ @events ] ], 'args' => [ @_ ], ); } sub _start { my $kernel = $_[KERNEL]; debug('p', "begin"); my $heap = $_[HEAP]; my %args = @_[ARG0..$#_]; my $wheel = new POE::Wheel::Run( Program => $args{'Command'}, ErrorEvent => 'error', StdoutEvent => 'stdout', StderrEvent => 'stderr', CloseEvent => 'closed', ); $heap->{'wheel'} = $wheel; $heap->{'display'} = $args{'Display'}; $heap->{'error'} = $args{'Error'}; $heap->{'close'} = $args{'Close'}; } sub _stop { my $heap = $_[HEAP]; delete $heap->{'wheel'}; } sub closed { my $heap = $_[HEAP]; my $close = $heap->{'close'}; $close->() if $close; } sub error { debug('p', "error"); my ($heap, $op, $errnum, $errstr) = @_[HEAP, ARG0..ARG2]; if ($op eq 'read' and not $errstr) { my $close = $heap->{'close'}; $close->() if $close; } else { my $error = $heap->{'error'}; $error->($op, $errstr); } delete $heap->{'wheel'}; } sub stdout { debug('p', "stdout"); my ($heap, $output) = @_[HEAP, ARG0]; my $display = $heap->{'display'}; $display->($output); } sub stderr { debug('p', "stderr"); my ($heap, $output) = @_[HEAP, ARG0]; my $display = $heap->{'display'}; $display->($output); } 1; __END__