view release on metacpan or  search on metacpan

lib/Class/Usul/IPC/Cmd.pm  view on Meta::CPAN

package Class::Usul::IPC::Cmd;

use namespace::autoclean;

use Class::Null;
use Class::Usul::Constants    qw( EXCEPTION_CLASS FALSE NUL
                                  OK SPC TRUE UNDEFINED_RV );
use Class::Usul::Functions    qw( arg_list emit_to io is_arrayref
                                  is_coderef is_hashref is_member is_win32
                                  nonblocking_write_pipe_pair
                                  strip_leader throw );
use Class::Usul::Time         qw( nap );
use Class::Usul::Types        qw( ArrayRef Bool LoadableClass Logger
                                  NonEmptySimpleStr Num Object PositiveInt
                                  SimpleStr Str Undef );
use English                   qw( -no_match_vars );
use File::Basename            qw( basename );
use File::DataClass::Types    qw( Directory Path );
use File::Spec::Functions     qw( devnull rootdir tmpdir );
use IO::Handle;
use IO::Select;
use IPC::Open3;
use Module::Load::Conditional qw( can_load );
use POSIX                     qw( _exit setsid sysconf WIFEXITED WNOHANG );
use Scalar::Util              qw( blessed openhandle weaken );
use Socket                    qw( AF_UNIX SOCK_STREAM PF_UNSPEC );
use Sub::Install              qw( install_sub );
use Try::Tiny;
use Unexpected::Functions     qw( TimeOut Unspecified );

use Moo; use warnings NONFATAL => 'all';

our ($CHILD_ENUM, $CHILD_PID);

# Public attributes
has 'async'            => is => 'ro',   isa => Bool, default => FALSE;

has 'close_all_files'  => is => 'ro',   isa => Bool, default => FALSE;

has 'cmd'              => is => 'ro',   isa => ArrayRef | Str,
   required            => TRUE;

has 'detach'           => is => 'ro',   isa => Bool, default => FALSE;

has 'err'              => is => 'ro',   isa => Path | SimpleStr, default => NUL;

has 'expected_rv'      => is => 'ro',   isa => PositiveInt, default => 0;

has 'ignore_zombies'   => is => 'lazy', isa => Bool, builder => sub {
   ($_[ 0 ]->async || $_[ 0 ]->detach) ? TRUE : FALSE };

has 'in'               => is => 'ro',   isa => Path | SimpleStr, coerce => sub {
   (is_arrayref $_[ 0 ]) ? join $RS, @{ $_[ 0 ] } : $_[ 0 ] },
   default             => NUL;

has 'log'              => is => 'lazy', isa => Logger,
   builder             => sub { Class::Null->new };

has 'keep_fhs'         => is => 'lazy', isa => ArrayRef,
   builder             => sub {
      $_[ 0 ]->log->can( 'filehandle' ) ? [ $_[ 0 ]->log->filehandle ] : [] };

has 'max_pidfile_wait' => is => 'ro',   isa => PositiveInt, default => 15;

has 'nap_time'         => is => 'ro',   isa => Num, default => 0.3;

has 'out'              => is => 'ro',   isa => Path | SimpleStr, default => NUL;

has 'partition_cmd'    => is => 'ro',   isa => Bool, default => TRUE;

has 'pidfile'          => is => 'lazy', isa => Path, coerce => TRUE,
   builder             => sub { $_[ 0 ]->rundir->tempfile };

has 'response_class'   => is => 'lazy', isa => LoadableClass, coerce => TRUE,
   default             => 'Class::Usul::Response::IPC';

has 'rundir'           => is => 'lazy', isa => Directory, coerce => TRUE,
   builder             => sub { $_[ 0 ]->tempdir };

has 'tempdir'          => is => 'lazy', isa => Directory,
   builder             => sub { tmpdir }, coerce => TRUE,
   handles             => { _tempfile => 'tempfile' };

has 'timeout'          => is => 'ro',   isa => PositiveInt, default => 0;

has 'use_ipc_run'      => is => 'ro',   isa => Bool, default => FALSE;

has 'use_system'       => is => 'ro',   isa => Bool, default => FALSE;

has 'working_dir'      => is => 'lazy', isa => Directory | Undef,
   default             => sub { $_[ 0 ]->detach ? io rootdir : undef },
   coerce              => TRUE;

# Private functions
my $_child_handler; $_child_handler = sub {
   local $OS_ERROR; # So that waitpid does not step on existing value

   while ((my $child_pid = waitpid -1, WNOHANG) > 0) {
      if (WIFEXITED( $CHILD_ERROR ) and $child_pid > ($CHILD_PID || 0)) {
         $CHILD_PID = $child_pid; $CHILD_ENUM = $CHILD_ERROR;