File Coverage

blib/lib/Test/Trap/Builder/TempFile.pm

Criterion	Covered	Total	%
statement	69	69	100.0
branch	10	10	100.0
condition	1	2	100.0
subroutine	12	12	100.0
pod			n/a
total	92	93	100.0

package Test::Trap::Builder::TempFile;

use version; $VERSION = qv('0.3.4');

use strict;
use warnings;
use IO::Handle;
use File::Temp qw( tempfile );
use Test::Trap::Builder;

########
#
# I can no longer (easily?) install Devel::Cover on 5.6.2, so silence the coverage report:
#
# uncoverable condition right
# uncoverable condition false
use constant GOTPERLIO => (eval "use PerlIO (); 1" || 0);

sub import {
  shift; # package name
  my $strategy_name = @_ ? shift : 'tempfile';
  my $strategy_option = @_ ? shift : {};
  Test::Trap::Builder->capture_strategy( $strategy_name => $_ ) for sub {
    my $self = shift;
    my ($name, $fileno, $globref) = @_;
    my $pid = $$;
    my ($fh, $file) = do {
      local ($!, $^E);
      tempfile( UNLINK => 1 ); # XXX: Test?
    };
    # make an alias to $self->{$name}, so that the closure does not hold $self:
    for my $buffer ($self->{$name}) {
      $self->Teardown($_) for sub {
        # if the file is opened by some other process, that one should deal with it:
        return unless $pid == $$;
        local $/;
        local ($!, $^E);
        $buffer .= <$fh>;
        close $fh;
        unlink $file;
      };
    }
    my @io_layers;
  IO_LAYERS: {
      GOTPERLIO or last IO_LAYERS;
      local($!, $^E);
      if ($strategy_option->{preserve_io_layers}) {
        @io_layers = PerlIO::get_layers(*$globref, output => 1);
      }
      if ($strategy_option->{io_layers}) {
        push @io_layers, $strategy_option->{io_layers};
      }
      binmode $fh; # set the perlio layers for reading:
      binmode $fh, $_ for @io_layers;
    }
    local *$globref;
    {
      no warnings 'io';
      local ($!, $^E);
      open *$globref, '>>', $file;
    }
  IO_LAYERS: {
      GOTPERLIO or last IO_LAYERS;
      local($!, $^E);
      binmode *$globref; # set the perlio layers for writing:
      binmode *$globref, $_ for @io_layers;
    }
    *$globref->autoflush(1);
    $self->Next;
  };
}

1; # End of Test::Trap::Builder::TempFile

__END__