File Coverage

blib/lib/IO/React.pm

Criterion	Covered	Total	%
statement	22	68	32.3
branch	10	40	25.0
condition	7	15	46.6
subroutine	8	14	57.1
pod	0	7	0.0
total	47	144	32.6

require 5.6.0;
package IO::React;
use strict;
use Carp;
use IO::File;

## Module Version
our $VERSION = 1.03;


### Constructor

sub new ($) {
  my ($class, $handle) = @_;
  return bless {
    Handle   => $handle,
    Display  => 1,
    Wait     => undef,
    Timeout  => sub { },
    EOF      => sub { },
  }, $class;
}


### Methods

# Set the wait interval
sub set_wait ($) {
  my ($self, $wait) = @_;
  croak "non-numeric wait value: $wait"
      if ( defined $wait and $wait !~ /^\d+$/ );
  $self->{Wait} = $wait;
}

# Set the timeout behaviour
sub set_timeout ($) {
  my ($self, $timeout) = @_;
  croak "non-numeric timeout callback: $timeout"
      if ( defined $timeout and "$timeout" !~ /^CODE/ );
  $self->{Timeout} = $timeout ? $timeout : sub { };
}

# Set the eof behaviour
sub set_eof ($) {
  my ($self, $eof) = @_;
  croak "non-numeric eof callback: $eof"
      if ( defined $eof and "$eof" !~ /^CODE/ );
  $self->{EOF} = $eof ? $eof : sub { };
}

# Control the display
sub set_display ($) {
  my ($self, $display) = @_;
  $self->{Display} = $display ? 1 : 0;
}

# Write to the handle
sub write ($$) {
  my ($self, $data) = @_;
  my $handle = $self->{Handle};
  return syswrite($handle, $data, length($data));
}

# React to output matching given patterns
sub react ($) {
  my ($self, @p) = @_;
  my %p = @p;
  my $handle = $self->{Handle};

  # Options
  my $wait    = ( exists $p{WAIT} )    ? $p{WAIT}    : $self->{Wait};
  my $timeout = ( exists $p{TIMEOUT} ) ? $p{TIMEOUT} : $self->{Timeout};
  my $eof     = ( exists $p{EOF} )     ? $p{EOF}     : $self->{EOF};
  delete $p{WAIT};
  delete $p{TIMEOUT};
  delete $p{EOF};
  croak "non-numeric wait value: $wait"
      if ( defined $wait and $wait !~ /^\d+$/ );

  my $start    = time;
  my $timeleft = $wait;
  my $text     = '';
  my $buf      = '';
  my $rin      = '';
  vec($rin, $handle->fileno, 1) = 1; # Bit vector of handles to select

 ReadData:
  my $nfound = select(my $rout=$rin, undef, undef, $timeleft);
  croak "select failed: $!" if ( $nfound < 0 );
  if ( $nfound == 0 ) {
    # Timeout can set a new time limit
    $timeleft = $timeout->();
    croak "TIMEOUT function returned non-numeric value: $timeleft"
	if ( defined $timeleft and $timeleft !~ /^\d+$/ );
    goto ReadData if defined $timeleft;
    return;
  }

  my $nread = sysread($handle, $buf, 1024);
  croak "sysread failed: $!" if ( $nread < 0 );
  if ( $nread == 0 ) {
    # End of file
    $eof->();
    return;
  }

  print $buf if $self->{Display};

  $text .= $buf;		# Accumuate text for matching

  # Check all the patterns
  foreach ( keys %p ) {
    if ( $text =~ /$_/m ) {
      my $f = $p{$_};
      $f->($handle, $text);
      return 1;
    }
  }

  # If there is no timeout, just go back to waiting
  goto ReadData unless defined $timeleft;

  # Otherwise, adjust timer for the time that has passed
  $timeleft = $wait - ( time - $start );
  $timeleft = 0 if ( $timeleft < 0 ); # Must not be negative
  goto ReadData;
}

1;

__END__