resub IPC::Open3::open3

resub-open3.pl

#!/usr/bin/env perl

use strict;
use warnings;
use FindBin qw($Bin);
use lib "$Bin/../lib";

use Test::More tests => 3;
use Test::Resub qw(resub);

use IPC::Open3;
use IO::Select;

# barring an actual need for using open3(), I lifted this from:
# http://www.perlmonks.org/bare/?node_id=419919
sub bc {
  my ($expression) = @_;

  local(*READ, *WRITE, *ERROR);
  my $pid = open3(\*WRITE, \*READ, \*ERROR, "bc");
  #if \*ERROR is false, STDERR is sent to STDOUT

  my $selread = new IO::Select();
  my $selerror = new IO::Select();
  $selread->add(\*READ);
  $selerror->add(\*ERROR);
  # may not be best use of IO::Select, but it works :-)

  my($error,$answer)=('','');

  #send query to bc
  print WRITE "$expression\n";

  #timing delay needed tp let bc output
  select(undef,undef,undef,.01);

  #get any error from bc
  sysread(ERROR, $error, 4096) if $selerror->can_read(0);

  #get the answer from bc
  sysread(READ, $answer, 4096) if $selread->can_read(0);

  waitpid($pid, 1);
  chomp($answer);
  return $answer;
}

# sanity check that `bc()` uses IPC::Open3::open3 correctly
{
  my $out = bc('2 + 3');
  is( $out, 5, 'bc(2 + 3) == 5' );
}

sub isa_deeply {
  my ($l, $r, $m) = @_;
  local $Test::Builder::Level = $Test::Builder::Level + 1;
  $l = [map { [map { ref } @$_] } @$l];
  $r = [map { [map { ref } @$_] } @$r];
  return is_deeply( $l, $r, $m );
}

# resub IPC::Open3::open3 - note we actually target `main::open3`, not
# `IPC::Open3::open3`, because `open3` is a function exported into our
# current namespace. If this were a class method interface, i.e.
#     my $pid = IPC::Open3->open3(WRITE, READ, ERROR, 'command')
# then we would target our resub against `IPC::Open3::open3`.
{
  # actually redefine open3 here

  my $wrote;
  my $rs_open3 = resub 'main::open3', sub {
    my ($writer, $reader, $error, $command) = @_;

    # we need to make sure $writer can be printed to
    open $writer, '>', \$wrote or die "open $writer for writing: $!\n";

    return 8043;
  };

  my $answer = bc('7 * 9');
  my $glob = do { local *glob; \*glob };
  isa_deeply( $rs_open3->args, [[($glob) x 3, 'bc']] );
  is( $wrote, "7 * 9\n", 'sent 7 * 9 to bc via open3' );
}

__END__
1..3                                                                                          
ok 1 - bc(2 + 3) == 5                                                                         
ok 2                                                                                          
ok 3 - sent 7 * 9 to bc via open3