File Coverage

blib/lib/Command/Run/Tmpfile.pm

Criterion	Covered	Total	%
statement	60	60	100.0
branch	8	14	57.1
condition	3	5	60.0
subroutine	16	16	100.0
pod	8	8	100.0
total	95	103	92.2

package Command::Run::Tmpfile;

use v5.14;
use warnings;
use utf8;
use Carp;
use Fcntl;
use IO::File;
use IO::Handle;

my $fdpath;

sub new {
    my $class = shift;
    my %opt = @_;
    my $fh = new_tmpfile IO::File or die "new_tmpfile: $!\n";
    $fh->fcntl(F_SETFD, 0) or die "fcntl F_SETFD: $!\n";
    binmode $fh, $opt{raw} ? ':raw' : ':encoding(utf8)';
    # Determine usable fd-path on first instantiation, using the fd we
    # just allocated.  Checking only "$path/0" is insufficient on
    # FreeBSD where /dev/fd/0,1,2 always exist as device nodes but
    # /dev/fd/N (N>2) requires fdescfs to be mounted.
    $fdpath //= do {
	my $fd = $fh->fileno;
	my $found;
	for my $path (qw(/proc/self/fd /dev/fd)) {
	    -r "$path/$fd" and do { $found = $path; last };
	}
	$found // '';
    };
    bless { FH => $fh }, $class;
}

sub write {
    my $obj = shift;
    my $fh = $obj->fh;
    if (@_) {
	my $data = join '', @_;
	$fh->print($data);
    }
    $obj;
}

sub flush {
    my $obj = shift;
    $obj->fh->flush;
    $obj;
}

sub rewind {
    my $obj = shift;
    $obj->fh->seek(0, 0) or die "seek: $!\n";
    $obj;
}

sub reset {
    my $obj = shift;
    $obj->rewind;
    $obj->fh->truncate(0);
    $obj;
}

sub fh {
    my $obj = shift;
    $obj->{FH};
}

sub fd {
    my $obj = shift;
    $obj->fh->fileno;
}

sub path {
    my $obj = shift;
    return undef unless $fdpath;
    sprintf "%s/%d", $fdpath, $obj->fd;
}

1;

__END__