System administration tasks often involve running child programs. Perl's system() command is good for non-interactive programs, but sometimes it's necessary to script the interaction with them. IPC::Run and Expect are great for this, but they're limited to interacting with a single program at a time.

POE::Wheel::Run, however, provides an asynchronous way to manage interactive child programs. Because it doesn't block, you can spawn several of them. This can be a real time saver when something must be executed on dozens, if not hundreds of remote machines. Why wait for the commands to complete when several machines can run it at a time?

POE's author uses it for regression testing POE. The testing procedure goes much faster when tests run concurrently. See the SourceForge and Compaq machines at POE's test results.

This sample program, however, is much simpler than all that. It manages a single [nethack] session, piping user input to the child process and child output back to the user's terminal. It also adds a little value to the game. Check out the comments!

#!/usr/bin/perl
# $Id$

# This program manages a child process started with POE::Wheel::Run.
# Wheel::Run is a lot like IPC::Run but event driven.  Because it
# doesn't block, though, it can be instantiated several times to drive
# many child processes.
#
# This sample runs a single process, nethack, as its test program.  It
# adds two "features" to stock nethack:
#
# 1. It changes all "@" characters to random colors.  It's annoying,
# but it lets you know the program's working.
#
# 2. Ctrl+C sends a string of random movement commands to the child
# process.  This causes your player to go a little berzerk.

use warnings;
use strict;

sub PROGRAM () { "nethack" }

use POSIX;
use POE qw( Wheel::ReadWrite Wheel::Run Filter::Stream );

### Handle the _start event.  This sets things in motion.

sub handle_start {
  my ($kernel, $heap) = @_[KERNEL, HEAP];

  # Set a signal handler.

  $kernel->sig(CHLD => "got_sigchld");

  # Save the original terminal settings so they can be restored later.

  $heap->{stdin_tio} = POSIX::Termios->new();
  $heap->{stdin_tio}->getattr(0);
  $heap->{stdout_tio} = POSIX::Termios->new();
  $heap->{stdout_tio}->getattr(1);
  $heap->{stderr_tio} = POSIX::Termios->new();
  $heap->{stderr_tio}->getattr(2);

  # Put the terminal into raw input mode.  Otherwise discrete
  # keystrokes will not be read immediately.

  my $tio = POSIX::Termios->new();
  $tio->getattr(0);
  my $lflag = $tio->getlflag;
  $lflag &= ~(ECHO | ECHOE | ECHOK | ECHONL | ICANON | IEXTEN | ISIG);
  $tio->setlflag($lflag);
  my $iflag = $tio->getiflag;
  $iflag &= ~(BRKINT | INPCK | ISTRIP | IXON);
  $tio->setiflag($iflag);
  my $cflag = $tio->getcflag;
  $cflag &= ~(CSIZE | PARENB);
  $tio->setcflag($cflag);
  $tio->setattr(0, TCSANOW);

  # Start the terminal reader/writer.

  $heap->{stdio} = POE::Wheel::ReadWrite->new(
    InputHandle  => \*STDIN,
    OutputHandle => \*STDOUT,
    InputEvent   => "got_terminal_stdin",
    Filter       => POE::Filter::Stream->new(),
  );

  # Start the asynchronous child process.

  $heap->{program} = POE::Wheel::Run->new(
    Program     => PROGRAM,
    Conduit     => "pty",
    StdoutEvent => "got_child_stdout",
    StdioFilter => POE::Filter::Stream->new(),
  );
}

### Handle the _stop event.  This restores the original terminal
### settings when we're done.  That's very important.

sub handle_stop {
  my $heap = $_[HEAP];
  $heap->{stdin_tio}->setattr(0, TCSANOW);
  $heap->{stdout_tio}->setattr(1, TCSANOW);
  $heap->{stderr_tio}->setattr(2, TCSANOW);
}

### Handle terminal STDIN.  Send it to the background program's STDIN.
### If the user presses ^C, then also go berserk a little.

sub handle_terminal_stdin {
  my ($heap, $input) = @_[HEAP, ARG0];

  while ($input =~ m/\003/g) {
    my $count       = int(5 + rand(10));
    my $random_walk = '';
    $random_walk .= int(rand(9) + 1) while $count--;
    $random_walk =~ tr[5][]d;
    substr($input, pos($input) - 1, 1) = $random_walk;
  }

  $heap->{program}->put($input);
}

### Handle STDOUT from the child program.  Send it to the terminal's
### STDOUT.  Oh, and do something silly like change the foreground
### color of "@" characters to something random. :)

sub handle_child_stdout {
  my ($heap, $input) = @_[HEAP, ARG0];
  my $color = int rand 8;
  $input =~ s/\@/\e[3${color}m\@\e[0m/g;
  $heap->{stdio}->put($input);
}

### Handle SIGCHLD.  Shut down if the exiting child process was the
### one we've been managing.

sub handle_sigchld {
  my ($heap, $child_pid) = @_[HEAP, ARG1];
  if ($child_pid == $heap->{program}->PID) {
    delete $heap->{program};
    delete $heap->{stdio};
  }
  return 0;
}

### Start a session to encapsulate the previous features.

POE::Session->create(
  inline_states => {
    _start             => \&handle_start,
    _stop              => \&handle_stop,
    got_terminal_stdin => \&handle_terminal_stdin,
    got_child_stdout   => \&handle_child_stdout,
    got_sigchld        => \&handle_sigchld,
  },
);

### Start POE's main loop, which runs the session until it's done.

$poe_kernel->run();
exit 0;