File Coverage

blib/lib/IPC/Run3/Shell/CLIWrapper.pm

Criterion	Covered	Total	%
statement	62	63	100.0
branch	22	26	88.4
condition			n/a
subroutine	12	13	92.3
pod	1	1	100.0
total	97	103	96.1

#!perl
package IPC::Run3::Shell::CLIWrapper;
use warnings;
use strict;

our $VERSION = '0.58';
# For AUTHOR, COPYRIGHT, AND LICENSE see the bottom of this file

BEGIN {
	require IPC::Run3::Shell;
	*__pp = \&IPC::Run3::Shell::pp; # double underscore to not clutter up the namespace too much
	*__debug = \&IPC::Run3::Shell::debug;
}
sub __DEBUG { $IPC::Run3::Shell::DEBUG } # don't alias because that doesn't work with `local`

our %DEFAULTS = ( opt_char=>'--', val_sep=>undef, under2dash=>1 );

my %NEW_ARGS = map {$_=>1} qw/ opt_char val_sep under2dash /;

sub new {
	# The arguments to new() are the same as make_cmd():
	# option hashrefs can be at the *beginning* of the argument list
	my ($class, @mcmd) = @_;
	my %opt;
	%opt = ( %opt, %{shift @mcmd} ) while ref $mcmd[0] eq 'HASH';
	# now extract the arguments we care about
	my %self;
	for (keys %NEW_ARGS) { $self{$_} = delete $opt{$_} if exists $opt{$_} }
	# set up ourselves
	for (keys %DEFAULTS) { $self{$_} = $DEFAULTS{$_} unless exists $self{$_} }
	__debug "new CLIWrapper, self=",__pp(\%self),", opt=",__pp(\%opt),", cmd=",__pp(\@mcmd) if __DEBUG;
	# ok, now set up the command
	$self{cmd} = IPC::Run3::Shell::make_cmd(\%opt, @mcmd);
	return bless \%self, $class;
}

sub __argconv {
	my $self = shift;
	my @args;
	my $oc = $self->{opt_char}; $oc = '' unless defined $oc;
	my $vs = $self->{val_sep};
	my $u2d = $self->{under2dash};
	for my $x (@_) {
		if ( ref $x eq 'ARRAY' ) {
			if ( @$x%2 ) {
				# ... work around a Carp issue in really old Perls ...
				# uncoverable branch true
				# uncoverable condition true
				if ( $] lt '5.008' ) {
					warn "Odd number of elements in argument list";  # uncoverable statement
				} else { warnings::warnif('IPC::Run3::Shell',
					'Odd number of elements in argument list') }
			}
			for (my $i=0;$i<@$x;$i+=2) {
				my ($k,$v) = @{$x}[$i,$i+1];
				$k =~ s/_/-/g if $u2d;
				push @args, defined $v
					? ( defined $vs ? $oc.$k.$vs.$v : ($oc.$k, $v) )
					: $oc.$k;
			}
		}
		else { push @args, $x }
	}
	return @args;
};

use overload
	'&{}' => sub {
		my $self = shift;
		return sub {
			my @args = __argconv($self, @_);
			__debug "plain command, args=",__pp(\@args) if __DEBUG;
			$self->{cmd}->(@args);
		}
	};

our $AUTOLOAD;
sub AUTOLOAD {  ## no critic (ProhibitAutoloading)
	my $meth = $AUTOLOAD;
	$meth =~ s/^.*:://;
	my $sub = sub {
		my $self = shift;
		my $cmd  = $meth;
		my @args = __argconv($self, @_);
		$cmd =~ s/_/-/g if $self->{under2dash};
		__debug "method ",__pp($cmd),", args=",__pp(\@args) if __DEBUG;
		$self->{cmd}->($cmd, @args);
	};
	no strict 'refs';  ## no critic (ProhibitNoStrict)
	*$AUTOLOAD = $sub;
	goto &$AUTOLOAD;
}
sub DESTROY {} # so AUTOLOAD isn't called on destruction

1;
__END__