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