#!/usr/bin/perl # -*-CPerl-*- # # This example writes a data structure into a child process that updates # it then writes it back to the parent. It does not do anything very # interesting. For interesting stuff look elsewhere. # use strict; use warnings; use POE qw(Wheel::Run Filter::Reference); # # Create a queue of data structures to pass to the child. # my @list = map { my $s; chomp; @$s{'month', 'stone', 'flower'} = split(/:/); $s } <DATA>; # # A session to handle the Wheel::Run child process. # POE::Session->create( inline_states => { _start => sub { my ($kernel, $heap) = @_[KERNEL, HEAP]; $heap->{cmd} = POE::Wheel::Run->new( Program => \&mycmd, ErrorEvent => 'cmd_error', StdoutEvent => 'cmd_stdout', StderrEvent => 'cmd_stderr', StdioFilter => POE::Filter::Reference->new(), ) or die "$0: can't POE::Wheel::Run->new"; $heap->{words} = \@list; $kernel->yield('next_cmd'); }, cmd_stdout => \&cmd_stdout, cmd_stderr => \&cmd_stderr, cmd_error => \&cmd_error, next_cmd => sub { my ($kernel, $heap) = @_[KERNEL, HEAP]; my $c = shift(@list); return 1 unless ($c); $heap->{cmd}->put($c); $_[KERNEL]->yield('next_cmd'); } } ) or die "$0: POE::Session->create failed $!"; # # This subroutine is run in a child process outside poe # sub mycmd { binmode(STDIN); binmode(STDOUT); # Required for this to work on MSWin32 my $raw; my $size = 4096; my $filter = POE::Filter::Reference->new(); # # POE::Filter::Reference does buffering so that you don't have to. # READ: while (sysread(STDIN, $raw, $size)) { my $s = $filter->get([$raw]); # # It is possible that $filter->get() has returned more than one # structure from the parent process. Each $t represents whatever # was pushed from the parent. # for my $t (@$s) { # # Here is a stand-in for something that might be doing # real work. # $t->{fubar} = 'mycmd'; # # this part re-freezes the data structure and writes # it back to the parent process. # my $u = $filter->put([$t]); print STDOUT @$u; # # this is the exit condition. # last READ if ($t->{'month'} eq 'December'); } } } # # In the parent process this detects when the child has closed the pipe to # the parent. # sub cmd_error { my ($hash, $op, $code, $handle) = @_[HEAP, ARG0, ARG1, ARG4]; if ($op eq 'read' and $code == 0 and $handle eq 'STDOUT') { warn "child has closed output"; delete $hash->{cmd}; } } # # demonstrate that something is happening. # sub cmd_stdout { my ($heap, $txt) = @_[HEAP, ARG0]; print join ":", 'cmd_stdout ', values(%$txt), "\n"; } # # Just so that we can see what the child writes on errors. # sub cmd_stderr { my ($heap, $txt) = @_[HEAP, ARG0]; print "cmd_stderr: $txt\n"; } POE::Kernel->run(); exit 0; __END__ January:Garnet:Carnation February:Amethyst:Violet March:Aquamarine:Jonquil April:Diamond:Sweetpea May:Emerald:Lily Of The Valley June:Pearl:Rose July:Ruby:Larkspur August:Peridot:Gladiolus September:Sapphire:Aster October:Opal:Calendula November:Topaz:Chrysanthemum December:Turquoise:Narcissus
CFedde