view release on metacpan or  search on metacpan

t/lib/Capture/Tiny.pm  view on Meta::CPAN

sub _relayer {
  my ($fh, $layers) = @_;
  # _debug("# requested layers (@{$layers}) for @{[fileno $fh]}\n");
  my %seen = ( unix => 1, perlio => 1 ); # filter these out
  my @unique = grep { !$seen{$_}++ } @$layers;
  # _debug("# applying unique layers (@unique) to @{[fileno $fh]}\n");
  binmode($fh, join(":", ":raw", @unique));
}

sub _name {
  my $glob = shift;
  no strict 'refs'; ## no critic
  return *{$glob}{NAME};
}

sub _open {
  open $_[0], $_[1] or Carp::confess "Error from open(" . join(q{, }, @_) . "): $!";
  # _debug( "# open " . join( ", " , map { defined $_ ? _name($_) : 'undef' } @_ ) . " as " . fileno( $_[0] ) . "\n" );
}

sub _close {
  # _debug( "# closing " . ( defined $_[0] ? _name($_[0]) : 'undef' )  . " on " . fileno( $_[0] ) . "\n" );
  close $_[0] or Carp::confess "Error from close(" . join(q{, }, @_) . "): $!";

t/lib/Capture/Tiny.pm  view on Meta::CPAN

  local *CT_ORIG_STDIN  = *STDIN ;
  local *CT_ORIG_STDOUT = *STDOUT;
  local *CT_ORIG_STDERR = *STDERR;
  # find initial layers
  my %layers = (
    stdin   => [PerlIO::get_layers(\*STDIN) ],
    stdout  => [PerlIO::get_layers(\*STDOUT, output => 1)],
    stderr  => [PerlIO::get_layers(\*STDERR, output => 1)],
  );
  # _debug( "# existing layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/;
  # get layers from underlying glob of tied filehandles if we can
  # (this only works for things that work like Tie::StdHandle)
  $layers{stdout} = [PerlIO::get_layers(tied *STDOUT)]
    if tied(*STDOUT) && (reftype tied *STDOUT eq 'GLOB');
  $layers{stderr} = [PerlIO::get_layers(tied *STDERR)]
    if tied(*STDERR) && (reftype tied *STDERR eq 'GLOB');
  # _debug( "# tied object corrected layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/;
  # bypass scalar filehandles and tied handles
  # localize scalar STDIN to get a proxy to pick up FD0, then restore later to CT_ORIG_STDIN
  my %localize;
  $localize{stdin}++,  local(*STDIN)