File Coverage

blib/lib/IPC/PrettyPipe/Execute/IPC/Run.pm

Criterion	Covered	Total	%
statement	20	20	100.0
branch			n/a
condition			n/a
subroutine	7	7	100.0
pod			n/a
total	27	27	100.0

package IPC::PrettyPipe::Execute::IPC::Run;

# ABSTRACT: execution backend using IPC::Run

use 5.10.0;

use Types::Standard qw[ InstanceOf ];


use Try::Tiny;
use IPC::Run ();
use Carp     ();

use Moo;
our $VERSION = '0.12';

use namespace::clean;








has pipe => (
    is       => 'ro',
    isa      => InstanceOf ['IPC::PrettyPipe'],
    required => 1,
);

# This attribute encapsulates an IPC::Run harness, tieing its creation
# to an IO::ReStoreFH object to ensure that filehandles are stored &
# restored properly.  The IPC::Run harness is created on-demand just
# before it is used.  A separate object could be used, but then
# IPC::PrettyPipe:Execute::IPC::Run turns into a *really* thin shell
# around it.  no need for an extra layer.


has _harness => (
    is      => 'ro',
    lazy    => 1,
    handles => [qw[ run start pump finish ]],
    clearer => 1,

    default => sub {

        my $self = shift;

        # While the harness is instantiated, we store the current fh's
        $self->_storefh;

        my @harness;

        my @cmds = @{ $self->pipe->cmds->elements };

        while ( @cmds ) {

            my $cmd = shift @cmds;

            if ( $cmd->isa( 'IPC::PrettyPipe::Cmd' ) ) {

                push @harness, '|' if @harness;

                push @harness,
                  [
                   $cmd->cmd,
                   map { $_->render( flatten => 1 ) } @{ $cmd->args->elements },
                  ];

                push @harness,
                  map { $_->spec, $_->has_file ? $_->file : () }
                  @{ $cmd->streams->elements };
            }
            elsif ( $cmd->isa( 'IPC::PrettyPipe' ) ) {

                croak( "cannot chain sub-pipes which have streams" )
                  unless $cmd->streams->empty;
                unshift @cmds, @{ $cmd->cmds->elements };
            }
        }

        return IPC::Run::harness( @harness );
    },

);

# store the IO::Restore object; created on demand by _harness.default
# don't create it otherwise!
has _storefh => (
    is      => 'ro',
    lazy    => 1,
    default => sub { $_[0]->pipe->_storefh },
    clearer => 1
);

# the IO::ReStoreFH object lives only as long as the
# IPC::Run harness object, and that lives only
# as long as necessary.
after 'run', 'finish' => sub {

    my $self = shift;

    try {

        # get rid of harness first to avoid possible closing of file
        # handles while the child is running.  of course the child
        # shouldn't be running at this point, but what the heck
        $self->_clear_harness;

    }

    catch {

        Carp::croak $_;

    }

    finally {

        $self->_clear_storefh;

    };

};

# this needs to go here 'cause this just defines the interface
with 'IPC::PrettyPipe::Executor';

1;

#
# This file is part of IPC-PrettyPipe
#
# This software is Copyright (c) 2018 by Smithsonian Astrophysical Observatory.
#
# This is free software, licensed under:
#
#   The GNU General Public License, Version 3, June 2007
#

__END__