File Coverage

blib/lib/Argv.pm

Criterion	Covered	Total	%
statement	399	861	46.3
branch	175	534	32.7
condition	50	157	31.8
subroutine	42	66	63.6
pod	15	28	53.5
total	681	1646	41.3

package Argv;

$VERSION = '1.28';
@ISA = qw(Exporter);

use constant MSWIN => $^O =~ /MSWin|Windows_NT/i ? 1 : 0;
use constant CYGWIN	=> $^O =~ /cygwin/i ? 1 : 0;

# To support the "FUNCTIONAL INTERFACE"
@EXPORT_OK = qw(system exec qv pipe MSWIN CYGWIN);

use strict;
use Carp;
require Exporter;

my $class = __PACKAGE__;

my $NUL = MSWIN ? 'NUL' : '/dev/null';

# Adapted from perltootc (see): an "eponymous meta-object" implementing
# "translucent attributes".
# For each key in the hash below, a method is automatically generated.
# Each method sets the object attr if called as an instance method or
# the class attr if called as a class method. They return the instance
# attr if it's defined, the class attr otherwise. The method name is
# lower-case; e.g. 'qxargs'. The default value of each attribute comes
# from the hash value set here, which may be overridden in the environment.
use vars qw(%Argv);
%Argv = (
    AUTOCHOMP	=> $ENV{ARGV_AUTOCHOMP} || 0,
    AUTOFAIL	=> $ENV{ARGV_AUTOFAIL} || 0,
    AUTOGLOB	=> $ENV{ARGV_AUTOGLOB} || 0,
    AUTOQUOTE	=> defined($ENV{ARGV_AUTOQUOTE}) ? $ENV{ARGV_AUTOQUOTE} : 1,
    DBGLEVEL	=> $ENV{ARGV_DBGLEVEL} || 0,
    DFLTSETS	=> {'' => 1},
    ENVP	=> undef,
    EXECWAIT	=> defined($ENV{ARGV_EXECWAIT}) ?
					    $ENV{ARGV_EXECWAIT} : scalar(MSWIN),
    INPATHNORM	=> $ENV{ARGV_INPATHNORM} || 0,
    MUSTEXEC	=> $ENV{ARGV_MUSTEXEC} || 0,
    NOEXEC	=> $ENV{ARGV_NOEXEC} || 0,
    OUTPATHNORM	=> $ENV{ARGV_OUTPATHNORM} || 0,
    QXARGS	=> $ENV{ARGV_QXARGS} || -1,
    QXFAIL	=> $ENV{ARGV_QXFAIL} || 0,
    QUIET	=> defined($ENV{ARGV_QUIET})  ? $ENV{ARGV_QUIET}  : 0,
    STDIN	=> defined($ENV{ARGV_STDIN})  ? $ENV{ARGV_STDIN}  : 0,
    STDOUT	=> defined($ENV{ARGV_STDOUT}) ? $ENV{ARGV_STDOUT} : 1,
    STDERR	=> defined($ENV{ARGV_STDERR}) ? $ENV{ARGV_STDERR} : 2,
    SYFAIL	=> $ENV{ARGV_SYFAIL} || 0,
    SYXARGS	=> $ENV{ARGV_SYXARGS} || 0,
    PIPECB	=> sub { print shift; return 1 },
);

# Generates execution-attribute methods from the table above. Provided
# as a class method itself to potentially allow a derived class to
# generate more of these. Semantics of these methods are quite
# context-driven and are explained in the PODs.
sub gen_exec_method {
    my $meta = shift;
    no strict 'refs'; # must evaluate $meta as a symbolic ref
    my @data = @_ ? map {uc} @_ : keys %{$meta};
    for my $attr (@data) {
	$$meta{$attr} ||= 0;
	my $method = lc $attr;
	*$method = sub {
	    my $self = shift;
	    # In null context with no args, set boolean value 'on'.
	    @_ = (1) if !@_ && !defined(wantarray);
	    my $ret = 0;
	    if (ref $self) {
		if (@_) {
		    if (defined(wantarray)) {
			if (ref $self->{$attr}) {
			    unshift(@{$self->{$attr}}, shift);
			} elsif (defined $self->{$attr}) {
			    $self->{$attr} = [shift, $self->{$attr}];
			} else {
			    $self->{$attr} = [shift];
			}
			return $self;
		    } else {
			$self->{$attr} = shift;
			return undef;
		    }
		} else {
		    $ret = defined($self->{$attr}) ?
					    $self->{$attr} : $class->{$attr};
		}
	    } else {
		if (@_) {
		    if (defined(wantarray)) {
			if (ref $class->{$attr}) {
			    unshift(@{$class->{$attr}}, shift);
			} else {
			    $class->{$attr} = [shift, $class->{$attr}];
			}
		    } else {
			$class->{$attr} = shift;
		    }
		    # If setting a class attribute, export it to the
		    # env in case we fork a child also using Argv.
		    my $ev = uc join('_', $class, $attr);
		    $ENV{$ev} = $class->{$attr};
		    return $self;
		} else {
		    $ret = $class->{$attr};
		}
	    }
	    if (ref($ret) eq 'ARRAY' && ref($ret->[0]) ne 'CODE') {
		my $stack = $ret;
		$ret = shift @$stack;
		if (ref $self) {
		    if (@$stack) {
			$self->{$attr} = shift @$stack;
		    } else {
			delete $self->{$attr};
		    }
		} else {
		    $self->{$attr} = shift @$stack;
		}
	    }
	    return $ret;
	}
    }
}

# Generate all the attribute methods declared in %Argv above.
$class->gen_exec_method;

# Generate methods for diverting stdin, stdout, and stderr in ->qx.
{
    my %streams = (stdin => 1, stdout => 1, stderr => 2);
    for my $name (keys %streams) {
	my $method = "_qx_$name";
	no strict 'refs';
	*$method = sub {
	    my $self = shift;
	    my $r_cmd = shift;
	    my $nfd = shift;
	    my $fd = $streams{$name};
	    if ($nfd !~ m%^[\d-]*$%) {
		push(@$r_cmd, "$fd$nfd");
	    } elsif ($fd == 0) {
		warn "Error: illegal value '$nfd' for $name" if $nfd > 0;
		push(@$r_cmd, "<$NUL") if $nfd < 0;
	    } elsif ($nfd == 0) {
		push(@$r_cmd, "$fd>$NUL");
	    } elsif ($nfd == (3-$fd)) {
		push(@$r_cmd, sprintf "%d>&%d", $fd, 3-$fd);
	    } elsif ($nfd != $fd) {
		warn "Error: illegal value '$nfd' for $name";
	    }
	};
    }
}

# Getopt::Long::GetOptions() respects '--' but strips it, while
# we want to respect '--' and leave it in. Thus this override.
sub GetOptions {
    @ARGV = map {/^--$/ ? qw(=--= --) : $_} @ARGV;
    my $ret = Getopt::Long::GetOptions(@_);
    @ARGV = map {/^=--=$/ ? qw(--) : $_} @ARGV;
    return $ret;
}

# This method is much like the generated exec methods but has some
# special-case logic: If called with a param which is true, it starts up
# a coprocess. If called with false (aka 0) it shuts down the coprocess
# and destroys the IPC::ChildSafe object. If called with no params at
# all it returns the existing IPC::ChildSafe object.
sub ipc_childsafe {
    my $self = shift;
    my $ipc_state = $_[0];
    my $ipc_obj;
    if ($ipc_state) {
	eval { require IPC::ChildSafe };
	return undef if $@;
	IPC::ChildSafe->VERSION(3.10);
	$ipc_obj = IPC::ChildSafe->new(@_);
    }
    no strict 'refs';
    if (ref $self) {
	if (defined $ipc_state) {
	    $self->{_IPC_CHILDSAFE} = $ipc_obj;
	    return $self;
	} else {
	    return exists($self->{_IPC_CHILDSAFE}) ?
			$self->{_IPC_CHILDSAFE} : $class->{_IPC_CHILDSAFE};
	}
    } else {
	if (defined $ipc_state) {
	    $class->{_IPC_CHILDSAFE} = $ipc_obj;
	    return $self;
	} else {
	    return $class->{_IPC_CHILDSAFE};
	}
    }
}

# Class/instance method. Parses command line for e.g. -/dbg=1. See PODs.
sub attropts {
    my $self = shift;
    my $r_argv = undef;
    my $prefix = '-/';
    if (ref $_[0] eq 'HASH') {
	my $cfg = shift;
	$r_argv = $cfg->{ARGV};
	$prefix = $cfg->{PREFIX};
    }
    require Getopt::Long;
    local $Getopt::Long::passthrough = 1;
    local $Getopt::Long::genprefix = "($prefix)";
    my @flags = map {"$_=i"} ((map lc, keys %Argv::Argv), @_);
    my %opt;
    if (ref $self) {
	if ($r_argv) {
	    local @ARGV = @$r_argv;
	    GetOptions(\%opt, @flags);
	    @$r_argv = @ARGV;
	} else {
	    local @ARGV = $self->args;
	    if (@ARGV) {
		GetOptions(\%opt, @flags);
		$self->args(@ARGV);
	    }
	}
    } elsif ($r_argv) {
	local @ARGV = @$r_argv;
	GetOptions(\%opt, @flags);
	@$r_argv = @ARGV;
    } elsif (@ARGV) {
	GetOptions(\%opt, @flags);
    }
    for my $method (keys %opt) {
	$self->$method($opt{$method});
    }
    return $self;
}
*stdopts = \&attropts;	# backward compatibility

# A class method which returns a summary of operations performed in
# printable format. Called with a void context to start data-
# collection, with a scalar context to end it and get the report.
sub summary {
    my $cls = shift;
    my($cmds, $operands);
    if (!defined wantarray) {
	$Argv::Summary = {};
	return;
    }
    return unless $Argv::Summary;
    my $fmt = "%30s:  %4s\t%s\n";
    my $str = sprintf $fmt, "$cls Summary", 'Cmds', 'Operands';
    for (sort keys %{$Argv::Summary}) {
	my @stats = @{$Argv::Summary->{$_}};
	$cmds += $stats[0];
	$operands += $stats[1];
	$str .= sprintf $fmt, $_, $stats[0], $stats[1];
    }
    $str .= sprintf $fmt, 'TOTAL', $cmds, $operands if defined $cmds;
    $Argv::Summary = 0;
    return $str;
}

# Constructor.
sub new {
    my $proto = shift;
    my $attrs = shift if ref($_[0]) eq 'HASH';
    my $self;
    if (ref($proto)) {
	# As an instance method, make a deep clone of the invoking object.
	# Some cloners are fast but not commonly installed, others the
	# reverse. We try them in order of speed and fall back to
	# Data::Dumper which is slow but core Perl as of 5.6.0. I could
	# just inherit from Clone or Storable but want to not force
	# users who don't need cloning to install them.
	eval {
	    require Clone;
	    Clone->VERSION(0.12);       # 0.11 has a bug that breaks Argv
	    $self = Clone::clone($proto);
	};
	if ($@) {
	    eval {
		require Storable;
		$self = Storable::dclone($proto);
	    };
	}
	if ($@) {
	    require Data::Dumper;
	    # Older Perl versions may not have the XS interface installed,
	    # so try it and fall back to the pure-perl version on failure.
	    my $copy = eval {
		Data::Dumper->Deepcopy(1)->new([$proto], ['self'])->Dumpxs;
	    };
	    $copy = Data::Dumper->Deepcopy(1)->new([$proto], ['self'])->Dump
									if $@;
	    eval $copy;
	}
	die $@ if $@ || !$self;
	# At least some cloners can't clone a code ref...
	$self->{PIPECB} = $proto->{PIPECB};
    } else {
	$self = {};
	if ($proto ne __PACKAGE__) {
	    # Inherit class attributes from subclass class attributes.
	    no strict 'refs';
	    for (keys %$proto) {
		$self->{$_} = $proto->{$_};
	    }
	}
	$self->{AV_PROG} = [];
	$self->{AV_ARGS} = [];
	$self->{PIPECB} = $Argv{PIPECB};
	bless $self, $proto;
	$self->optset('');
    }
    $self->attrs($attrs) if $attrs;
    $self->argv(@_) if @_;
    return $self;
}
*clone = \&new;

# Nothing to do here, just avoiding interaction with AUTOLOAD.
sub DESTROY { }

sub AUTOLOAD {
    my $self = shift;
    (my $cmd = $Argv::AUTOLOAD) =~ s/.*:://;
    return if $cmd eq 'DESTROY';
    no strict 'refs';
    # install a new method '$cmd' to avoid autoload next time ...
    *$cmd = sub {
	my $self = shift;
	if (ref $self) {
	    $self->argv($cmd, @_);
	} else {
	    $self->new($cmd, @_);
	}
    };
    # ... then service this request
    return $self->$cmd(@_);
}

# Instance methods; most class methods are auto-generated above.

# A shorthand way to set a bunch of attributes by passing a hashref
# of their names=>values.
sub attrs {
    my $self = shift;
    my $attrs = shift;
    if ($attrs) {
	for my $key (keys %$attrs) {
	    (my $method = $key) =~ s/^-//;
	    $self->$method($attrs->{$key});
	}
    }
    return $self;
}

# Replace the instance's prog(), opt(), and args() vectors all together.
# Without arguments, return the command as it currently looks either as
# a list or a string depending on context.
sub argv {
    my $self = shift;
    if (@_) {
	$self->attrs(shift) if ref($_[0]) eq 'HASH';
	$self->{AV_PROG} = [];
	$self->{AV_OPTS}{''} = [];
	$self->{AV_ARGS} = [];
	$self->prog(shift) if @_;
	$self->attrs(shift) if ref($_[0]) eq 'HASH';
	$self->opts(@{shift @_}) if ref $_[0] eq 'ARRAY';
	$self->args(@_) if @_;
	return $self;
    } else {
	my @cmd = ($self->prog, $self->opts, $self->args);
	if (wantarray) {
	    return @cmd;
	} else {
	    return "@cmd";
	}
    }
}
*cmd = \&argv;	# backward compatibility

# Set or get the 'prog' part of the command line.
sub prog {
    my $self = shift;
    if (@_) {
	my @prg = ref $_[0] ? @{$_[0]} : @_;
	@{$self->{AV_PROG}} = @prg;
    } elsif (!defined(wantarray)) {
	@{$self->{AV_PROG}} = ();
    }
    if (@_) {
	return $self;
    } else {
	return wantarray ? @{$self->{AV_PROG}} : ${$self->{AV_PROG}}[0];
    }
}

# Set or get the 'args' part of the command line.
sub args {
    my $self = shift;
    if (@_) {
	my @args = ref $_[0] eq 'ARRAY' ? @{$_[0]} : @_;
	@{$self->{AV_ARGS}} = @args;
    } elsif (!defined(wantarray)) {
	@{$self->{AV_ARGS}} = ();
    }
    if (@_) {
	return $self;
    } else {
	return @{$self->{AV_ARGS}};
    }
}

# Generates the parse(), opts(), and flag() method families. During
# construction this is used to generate the methods for the anonymous
# option set; it can be used explicitly to generate parseXX(), optsXX(),
# and argsXX() for optset 'XX'.
sub optset {
    my $self = shift;
    for (@_) {
	my $set = uc $_;
	next if defined $self->{AV_OPTS}{$set};
	$self->{AV_OPTS}{$set} = [];
	$self->{AV_LKG}{$set} = {};
	my($p_meth, $o_meth, $f_meth) = map { $_ . $set } qw(parse opts flag);
	$self->{AV_DESC}{$set} = [];
	no strict 'refs'; # needed to muck with symbol table
	*$p_meth = sub {
	    my $self = shift;
	    $self->{AV_DESC}{$set} ||= [];
	    if (@_) {
		if (ref($_[0]) eq 'ARRAY') {
		    $self->{CFG}{$set} = shift;
		} elsif (ref($_[0]) eq 'HASH') {
		    $self->warning("do not provide a linkage specifier");
		    shift;
		}
		@{$self->{AV_DESC}{$set}} = @_;
		$self->factor($set,
				$self->{AV_DESC}{$set}, $self->{AV_OPTS}{$set},
				$self->{AV_ARGS}, $self->{CFG}{$set});
		if (defined $self->{AV_OPTS}{$set}) {
		    my @parsedout = @{$self->{AV_OPTS}{$set}};
		}
	    }
	    return @{$self->{AV_OPTS}{$set}};
	} unless $Argv::{$p_meth};
	*$o_meth = sub {
	    my $self = shift;
	    $self->{AV_OPTS}{$set} ||= [];
	    if (@_ || !defined(wantarray)) {
		@{$self->{AV_OPTS}{$set}} = @_;
	    }
	    return @_ ? $self : @{$self->{AV_OPTS}{$set}};
	} unless $Argv::{$o_meth};
	*$f_meth = sub {
	    my $self = shift;
	    if (@_ > 1) {
		while(my($key, $val) = splice(@_, 0, 2)) {
		    $self->{AV_LKG}{$set}{$key} = $val;
		}
	    } else {
		my $key = shift;
		return $self->{AV_LKG}{$set}{$key};
	    }
	} unless $Argv::{$f_meth};
    }
    return keys %{$self->{AV_DESC}}; # this is the set of known optsets.
}

# Not generally used except internally; not documented. First arg
# is an option set name followed by bunch of array-refs: a pointer
# to a list of Getopt::Long-style option descs, a ref to be filled
# in with a list of found options, another containing the input
# args and to be filled in with the leftovers, and an optional
# one containing Getopt::Long-style config options.
sub factor {
    my $self = shift;
    my($pset, $r_desc, $r_opts, $r_args, $r_cfg) = @_;
    my @vgra;
    {
        local @ARGV = @$r_args;
        if ($r_desc && @$r_desc) {
            require Getopt::Long;
            # Need this version so Configure() returns prev state.
            Getopt::Long->VERSION(2.23);
            if ($r_cfg && @$r_cfg) {
                my $prev = Getopt::Long::Configure(@$r_cfg);
                GetOptions($self->{AV_LKG}{$pset}, @$r_desc);
                Getopt::Long::Configure($prev);
            } else {
                local $Getopt::Long::passthrough = 1;
                local $Getopt::Long::autoabbrev = 1;
                local $Getopt::Long::debug = 1 if $self->dbglevel == 5;
                GetOptions($self->{AV_LKG}{$pset}, @$r_desc);
            }
        }
        @vgra = @ARGV;
    }
    my(@opts, @args);
    for (reverse @$r_args) {
        if (@vgra && $vgra[$#vgra] eq $_) {
            unshift(@args, pop (@vgra));
        } else {
            unshift(@opts, $_);
        }
    }
    @$r_opts = @opts if $r_opts;
    @$r_args = @args;
    return @opts;
}

# Extract and return any of the specified options from object.
sub extract {
    my $self = shift;
    my $set = shift;
    $self->optset($set) unless defined $self->{AV_LKG}{$set};
    my $p_meth = 'parse' . $set;
    my $o_meth = 'opts' . $set;
    $self->$p_meth(@_);
    my @extracts = $self->$o_meth();
    return @extracts;
}

sub argpathnorm {
    my $self = shift;
    my $norm = $self->inpathnorm;
    return unless $norm && !ref($norm);
    if (CYGWIN) { #for the cygwin shell
        s%\\%\\\\%g for @_;
    }
    return unless MSWIN;
    for my $word (@_) {
	# If requested, change / for \ in Windows file paths.
	# This is necessarily an inexact science.
	my @fragments = split ' ', $word;
	for (@fragments) {
	    if (m%^"?/%) {
		if (m%(.*/\w+):(.+)%) {
		    # If it looks like an option specifying a path (/opt:path),
		    # normalize only the path part.
		    my($opt, $path) = ($1, $2);
		    $path =~ s%/%\\%g;
		    $_ = "$opt:$path";
		} else {
		    # If it contains a slash (any kind) after the initial one
		    # treat it as a full path. This is where you get into
		    # ambiguity with combined options (e.g. /E/I/Q/S) which
		    # could technically be a path. So that's just not allowed
		    # when path-norming.
		    my $slashes = tr/\/\\//;
		    s%/%\\%g if $slashes > 1;
		}
	    } else {
		s%/%\\%g;
	    }
	}
	$word = "@fragments";
    }
}

# Quotes @_ in place against shell expansion. Usually called via autoquote attr
sub quote {
    my $self = shift;
    for (grep {defined} @_) {
	# Hack - allow user to exempt any arg from quoting by prefixing '^'.
	next if s%^\^%%;
	# Special case - turn internal newlines back to literal \n on Win32
	s%\n%\\n%gs if MSWIN;
	# If arg is already quoted with '': on Unix it's safe, leave alone.
	# On Windows, replace the single quotes with escaped double quotes.
	if (m%^'(.*)'$%s) {
	    $_ = qq(\\"$1\\") if MSWIN;
	    next;
	} elsif (m%^".*"$%s) {
	    $_ = qq(\\"$_\\") if MSWIN || CYGWIN;
	    next;
	}
	# Skip if contains no special chars.
	if (MSWIN) {
	    # On windows globbing is not handled by the shell so we
	    # let '*' go by.
	    next unless m%[^-=:_."\w\\/*]% || tr%\n%%;
	} else {
	    next unless m%[^-=:_."\w\\/]% || m%\\n% || tr%\n%%;
	}
	# Special case - leave things that look like redirections alone.
	next if /^\d?(?:<{1,2})|(?:>{1,2})/;
	# This is a hack to support MKS-built perl 5.004. Don't know
	# if the problem is with MKS builds or 5.004 per se.
	next if MSWIN && $] < 5.005;
	# Now quote embedded quotes ...
	$_ =~ s%(\\*)"%$1$1\\"%g;
	# quote a trailing \ so it won't quote the quote (!) ...
	s%\\{1}$%\\\\%;
	# and last the entire string.
	$_ = qq("$_");
    }
    return $self;
}

# Submits @_ to Perl's glob() function. Usually invoked via autoglob attr.
sub glob {
    my $self = shift;
    my @orig = @_ ? @_ : $self->args;
    if (! @orig) {
	$self->warning("no arguments to glob");
	return 0;
    }
    my @globbed;
    for (@orig) {
	if (/^'(.*)'$/) {		# allow '' to escape globbing
	    push(@globbed, $1);
	} elsif (/[*?]/) {
	    push(@globbed, glob)
	} else {
	    push(@globbed, $_)
	}
    }
    if (defined wantarray) {
	return @globbed;
    } else {
	$self->args(@globbed);
    }
}

# Internal. Takes a list of optset names, returns a list of options.
sub _sets2opts {
    my $self = shift;
    my(@sets, @opts);
    if (! @_) {
	@sets = keys %{$self->dfltsets};
    } elsif ($_[0] eq '-') {
	@sets = ();
    } elsif ($_[0] eq '+') {
	@sets = $self->optset;
    } else {
	my %known = map {$_ => 1} $self->optset;
	for (@_) { $self->warning("Unknown optset '$_'\n") if !$known{$_} }
	@sets = @_;
    }
    for my $set (@sets) {
	next unless $self->{AV_OPTS}{$set} && @{$self->{AV_OPTS}{$set}};
	push(@opts, @{$self->{AV_OPTS}{$set}});
    }
    return @opts;
}

# Internal, collects data for use by 'summary' method.
sub _addstats {
    my $self = shift;
    my($prg, $argcnt) = @_;
    my $stats = $Argv::Summary->{$prg} || [0, 0];
    $$stats[0]++;
    $$stats[1] += $argcnt;
    $Argv::Summary->{$prg} = $stats;
}

# Handles ->autofail operations. If given a scalar, exit with the value
# of that scalar on failure unless the scalar == 0, in which case
# don't exit. If given a ref to a scalar, increment the scalar for
# each failure. If given a code ref, call that subroutine. An array ref
# is assumed to contain a code ref followed by parameters for the sub.
sub fail {
    my($self, $specific) = @_;
    my $general = $self->autofail;
    if (my $val = $specific || $general) {
	if (ref($val) eq 'CODE') {
	    &$val($self);
	} elsif (ref($val) eq 'ARRAY') {
	    my @arr = @$val;
	    my $func = shift(@arr);
	    &$func(@arr);
	} elsif (ref($val) eq 'SCALAR') {
	    $$val++;
	} elsif ($val !~ /^\d*$/) {
	    die $val;
	} elsif ($val) {
	    exit $val;
	}
    }
    return $self;
}

# Convert lines to UNIX (/) format iff they represent file pathnames.
sub unixpath {
    my $self = shift;
    for (@_) {
	chomp(my $chomped = $_);
	s%\\%/%g if -e $chomped;
    }
}

# A no-op except it prints the current state of the object to stderr.
sub objdump {
    my $self = shift;
    (my $obj = shift || 'argv') =~ s%^\$%%;
    require Data::Dumper;
    print STDERR Data::Dumper->new([$self], [$obj])->Dumpxs;
    return $self;
}

sub readonly {
    my $self = shift;
    no strict 'refs';
    if (@_) {
	$self->{AV_READONLY} = shift;
	return $self;
    } else {
	if (exists($self->{AV_READONLY})) {
	    return $self->{AV_READONLY};		# instance
	} else {
	    my $class = ref $self;
	    if ($class && exists($class->{AV_READONLY})) {
		return $class->{AV_READONLY};	# class
	    } else {
		return 'no';
	    }
	}
    }
}

sub _read_only {
    my $self = shift;
    return $self->readonly =~ /^y/i;
}

# Hidden method for printing debug output.
sub _dbg {
    my $self = shift;
    my($level, $prefix, $fh, @txt) = @_;
    my @tmp = @txt;
    for (@tmp) { $_ = qq("$_") if /\s/ && !/^"/ }

    # Print all EV's that were added to or modified from the real env.
    my $envp = $self->envp;
    if ($envp) {
	for (sort keys %$envp) {
	    next if $ENV{$_} && $ENV{$_} eq $envp->{$_};
	    print $fh "+ [\$$_=", $envp->{$_}, "]\n";
	}
    }

    $self->objdump if $level >= 3;
    my($ifd, $ofd, $efd) = ($self->stdin, $self->stdout, $self->stderr);
    if ($ifd !~ m%^[\d-]*$%) {
	$ifd =~ s%/%\\%g if MSWIN;
	push(@tmp, $ifd);
    } elsif ($ifd < 0) {
	push(@tmp, "<$NUL");
    }
    if ($ofd !~ m%^[\d-]*$%) {
	$ofd =~ s%/%\\%g if MSWIN;
	push(@tmp, $ofd);
    } elsif ($ofd <= 0) {
	push(@tmp, "1>$NUL");
    } elsif ($ofd != 1) {
	push(@tmp, "1>&$ofd");
    }
    if ($efd !~ m%^[\d-]*$%) {
	$efd =~ s%/%\\%g if MSWIN;
	push(@tmp, "2$efd");
    } elsif ($efd <= 0) {
	push(@tmp, "2>$NUL");
    } elsif ($efd != 2) {
	push(@tmp, "2>&$efd");
    }
    print $fh "$prefix @tmp\n";
}

# Attempt to derive the value of ARG_MAX (the maximum command-line
# length) for the current platform. Windows isn't really POSIX and
# in my tests POSIX::ARG_MAX() usually throws an exception.
# Therefore, on Windows we catch the exception and set the value
# to 32767. I don't know what the actual limit is but 32K seems to
# work whereas 64K fails and I haven't tried to narrow that range
# (actually a bit of subsequent testing showed 48000 to work and
# 50000 to fail, but I still prefer to depend on a round number).
# On other platforms, if ARG_MAX is missing we use _POSIX_ARG_MAX
# (4096) # as the default (that being the smallest value of ARG_MAX
# allowed by the POSIX standard).
{
    my($_argmax, $_pathmax);
    sub _arg_max {
	require Config;
	if (!defined($_argmax)) {
	    $_argmax = MSWIN ? 32767 : 4096;
	    eval { require POSIX; $_argmax = POSIX::ARG_MAX(); };
	    # The terminating NULL of argv.
	    $_argmax -= $Config::Config{ptrsize};
	}
	return $_argmax;
    }
    sub _path_max {
	if (!defined($_pathmax)) {
	    $_pathmax = MSWIN ? 260 : 1024;
	    eval { require POSIX; $_pathmax = POSIX::PATH_MAX(); };
	}
	return $_pathmax;
    }
}

# Determine the size of the environment block for subtraction
# from the calculated value of ARG_MAX. We allow for an equals
# sign and terminating null in each EV, plus the pointer
# within the environ array that references it.
# Note: Windows limits do not appear to include the environment block.
sub _env_size {
    require Config;
    my $envlen = 0;
    my $ptrsize = $Config::Config{ptrsize};
    for my $ev (keys %ENV) {
	$envlen += length($ev);
	$envlen += length($ENV{$ev}) if $ENV{$ev};
	$envlen += 2 + $ptrsize;
    }
    # Need one more pointer's worth for the terminating NULL in 'environ'.
    return $envlen + $ptrsize;
}

# In the case where the user wants to do qxargs-style chunking by
# buffer length rather than argument count, we need to keep pushing
# args onto said buffer till we run out of room.
sub _chunk_by_length {
    require Config;
    my ($args, $max) = @_;
    my @chunk = ();
    my $chunklen = 0;
    my $extra = $Config::Config{ptrsize} + 1;
    while (grep {defined} @{$args}) {
	# Reached max length?
	if (($chunklen + length(${$args}[0]) + $extra) >= $max) {
	    # Always send at least one chunk no matter what.
	    push(@chunk, shift(@{$args})) unless @chunk;
	    last;
	} else {
	    $chunklen += length(${$args}[0]) + $extra;
	    push(@chunk, shift(@{$args}));
	}
    }
    #printf STDERR "CHUNK: $chunklen (MAX=$max, LEFT=%d)\n", scalar(@{$args});
    return @chunk;
}

# Wrapper around Perl's exec(). Strawberry Perl 5.12 warns...
{ no warnings 'redefine';
sub exec {
    $class->new(@_)->exec if !ref($_[0]) || ref($_[0]) eq 'HASH';
    my $self = shift;
    if ((ref($self) ne $class) && $self->ipc_childsafe) {
	exit($self->system(@_) || $self->ipc_childsafe->finish);
    } elsif (MSWIN && $self->execwait) {
	exit($self->system(@_) >> 8);
    } else {
	my $envp = $self->envp;
	my $dbg = $self->dbglevel;
	my @cmd = (@{$self->{AV_PROG}},
			    $self->_sets2opts(@_), @{$self->{AV_ARGS}});
	if ($self->noexec && !$self->_read_only) {
	    $self->_dbg($dbg, '-', \*STDERR, @cmd);
	} else {
	    my($ifd, $ofd, $efd) = ($self->stdin, $self->stdout, $self->stderr);
	    $self->_dbg($dbg, '+', \*STDERR, @cmd) if $dbg;
	    open(_I, '<&STDIN');
	    open(_O, '>&STDOUT');
	    open(_E, '>&STDERR');
	    if ($ifd !~ m%^[\d-]*$%) {
		open(STDIN, $ifd) || warn "$ifd: $!";
	    } elsif ($ifd < 0) {
		open(STDIN, "<$NUL") || warn "STDIN: $!";
	    } else {
		warn "Warning: illegal value '$ifd' for stdin" if $ifd > 0;
	    }
	    if ($ofd !~ m%^[\d-]*$% && !$self->quiet) {
		open(STDOUT, $ofd) || warn "$ofd: $!";
	    } elsif ($ofd <= 0 || $self->quiet) {
		open(STDOUT, ">$NUL") || warn "STDOUT: $!";
	    } elsif ($ofd == 2) {
		open(STDOUT, '>&STDERR') || warn "Can't dup stdout";
	    } elsif ($ofd != 1) {
		warn "Warning: illegal value '$ofd' for stdout";
	    }
	    if ($efd !~ m%^[\d-]*$%) {
		open(STDERR, $efd) || warn "$efd: $!";
	    } elsif ($efd <= 0) {
		open(STDERR, ">$NUL") || warn "STDERR: $!";
	    } elsif ($efd == 1) {
		open(STDERR, '>&STDOUT') || warn "Can't dup stderr";
	    } elsif ($efd > 2) {
		warn "Warning: illegal value '$efd' for stderr";
	    }
	    my $rc;
	    if ($envp) {
		local %ENV = %$envp;
		$rc = exec(@cmd);
	    } else {
		$rc = exec(@cmd);
	    }
	    # Shouldn't get here but defensive programming and all that ...
	    if ($rc) {
		my $error = "$!";
		open(STDIN, '<&_I'); close(_I);
		open(STDOUT, '>&_O'); close(_O);
		open(STDERR, '>&_E'); close(_E);
		die "$0: $cmd[0]: $error\n";
	    }
	}
    }
}}

sub lastresults {
    my $self = shift;
    if (defined(wantarray)) {
	my @qxarr = @{$self->{AV_LASTRESULTS}};
	my $rc = shift @qxarr;
	if (wantarray) {
	    return @qxarr;
	} else {
	    return $rc;
	}
    } else {
	$self->{AV_LASTRESULTS} = \@_;
    }
}

# Internal - service method for system/exec to call into IPC::ChildSafe.
sub _ipccmd {
    my $self = shift;
    my $cmd = shift;
    # Throw out the prog name since it's already running
    if (@_) {
	$cmd = "@_";
    } else {
	$cmd =~ s/^\w+\s*//;
    }
    # Hack - there's an "impedance mismatch" between instance
    # methods in this class and the class methods in
    # IPC::ChildSafe, so we toggle the attrs for every cmd.
    my $csobj = $self->ipc_childsafe;
    $csobj->dbglevel($self->dbglevel);
    $csobj->noexec($self->noexec) if $self->noexec && !$self->_read_only;
    my %results = $csobj->cmd($cmd);
    return %results;
}

# Wrapper around Perl's system().
sub system {
    return $class->new(@_)->system if !ref($_[0]) || ref($_[0]) eq 'HASH';
    my $self = shift;
    my $envp = $self->envp;
    my $rc = 0;
    my($ifd, $ofd, $efd) = ($self->stdin, $self->stdout, $self->stderr);
    $self->args($self->glob) if $self->autoglob;
    my @prog = @{$self->{AV_PROG}};
    my @opts = $self->_sets2opts(@_);
    my @args = @{$self->{AV_ARGS}};
    my $childsafe = ((ref($self) ne $class) &&
			    $self->ipc_childsafe && !$self->mustexec) ? 1 : 0;

    # These potentially modify their arguments in place.
    $self->argpathnorm(@prog, @args);
    $self->quote(@prog, @opts, @args)
	if (((MSWIN && (@prog + @opts + @args) > 1) || $childsafe) &&
						       $self->autoquote);
    my @cmd = (@prog, @opts, @args);
    my $dbg = $self->dbglevel;
    if ($childsafe) {
	$self->_addstats("@prog", scalar @args) if $Argv::Summary;
	$self->warning("cannot change \%ENV of child process") if $envp;
	$self->warning("cannot close stdin of child process") if $ifd;
	my %results = $self->_ipccmd(@cmd);
	$? = $rc = ($results{status} << 8);
	if ($self->quiet) {
	    # say nothing
	} elsif ($ofd !~ m%^[\d-]*$%) {
	    if (open(OFD, $ofd)) {
		print OFD @{$results{stdout}} if @{$results{stdout}};
		close OFD;
	    } else {
		warn "$ofd: $!";
	    }
	} elsif ($ofd == 2) {
	    print STDERR @{$results{stdout}} if @{$results{stdout}};
	} else {
	    warn "Warning: illegal value '$ofd' for stdout" if $ofd > 2;
	    print STDOUT @{$results{stdout}} if @{$results{stdout}};
	}
	if ($efd == 1) {
	    print STDOUT @{$results{stderr}} if @{$results{stderr}};
	} elsif ($efd !~ m%^[\d-]*$%) {
	    if (open(EFD, $efd)) {
		print EFD @{$results{stderr}} if @{$results{stderr}};
		close EFD;
	    } else {
		warn "$efd: $!";
	    }
	} else {
	    warn "Warning: illegal value '$efd' for stderr" if $efd > 2;
	    print STDERR @{$results{stderr}} if @{$results{stderr}};
	}
    } else {
	# Reset to defaults in dbg mode (what's this for?)
	($ofd, $efd) = (1, 2) if defined($dbg) && $dbg > 2;
	if ($self->noexec && !$self->_read_only) {
	    $self->_dbg($dbg, '-', \*STDERR, @cmd);
	    return 0;
	}
	open(_I, '<&STDIN');
	open(_O, '>&STDOUT');
	open(_E, '>&STDERR');

	if ($ifd !~ m%^[\d-]*$%) {
	    open(STDIN, $ifd) || warn "$ifd: $!";
	} elsif ($ifd < 0) {
	    open(STDIN, "<$NUL") || warn "STDIN: $!";
	} else {
	    warn "Warning: illegal value '$ifd' for stdin" if $ifd > 0;
	}

	if ($ofd !~ m%^[\d-]*$% && !$self->quiet) {
	    open(STDOUT, $ofd) || warn "$ofd: $!";
	} elsif ($ofd <= 0 || $self->quiet) {
	    open(STDOUT, ">$NUL") || warn "STDOUT: $!";
	} elsif ($ofd == 2) {
	    open(STDOUT, '>&STDERR') || warn "Can't dup stdout";
	} elsif ($ofd != 1) {
	    warn "Warning: illegal value '$ofd' for stdout";
	}

	if ($efd !~ m%^[\d-]*$%) {
	    open(STDERR, $efd) || warn "$efd: $!";
	} elsif ($efd <= 0) {
	    open(STDERR, ">$NUL") || warn "STDERR: $!";
	} elsif ($efd == 1) {
	    open(STDERR, '>&STDOUT') || warn "Can't dup stderr";
	} elsif ($efd > 2) {
	    warn "Warning: illegal value '$efd' for stderr";
	}

	my $limit = $self->syxargs;
	if ($limit && @args) {
	    if ($limit == -1) {
		$limit = -_arg_max();
		$limit += _env_size() if !MSWIN;
		# There's no shell used in list-form system() ...
		$limit += _path_max();		# for @prog
		$limit += length("@opts");
	    }
	    while (my @chunk = $limit > 0 ?
		    splice(@args, 0, $limit) :
		    _chunk_by_length(\@args, abs($limit))) {
		$self->_addstats("@prog", scalar @chunk) if $Argv::Summary;
		@cmd = (@prog, @opts, @chunk);
		$self->_dbg($dbg, '+', \*_E, @cmd) if $dbg;
		if ($envp) {
		    local %ENV = %$envp;
		    $rc |= system @cmd;
		} else {
		    $rc |= system @cmd;
		}
	    }
	} else {
	    $self->_addstats("@prog", scalar @args) if $Argv::Summary;
	    $self->_dbg($dbg, '+', \*_E, @cmd) if $dbg;
	    if ($envp) {
		local %ENV = %$envp;
		$rc = system @cmd;
	    } else {
		$rc = system @cmd;
	    }
	}
	open(STDIN, '<&_I'); close(_I);
	open(STDOUT, '>&_O'); close(_O);
	open(STDERR, '>&_E'); close(_E);
    }
    print STDERR "+ (\$? == $?)\n" if $dbg > 1;
    if ($?) {
	$self->lastresults($?>>8, ());
	$self->fail($self->syfail);
    }
    return $rc;
}

# Wrapper around Perl's qx(), aka backquotes.
sub qx {
    return $class->new(@_)->qx if !ref($_[0]) || ref($_[0]) eq 'HASH';
    my $self = shift;
    my $envp = $self->envp;
    my @prog = @{$self->{AV_PROG}};
    my @opts = $self->_sets2opts(@_);
    my @args = @{$self->{AV_ARGS}};
    my $childsafe = ((ref($self) ne $class) &&
			    $self->ipc_childsafe && !$self->mustexec) ? 1 : 0;

    # These potentially modify their arguments in place.
    @args = $self->glob(@args)
		if MSWIN && $self->autoglob && $childsafe;
    $self->argpathnorm(@prog, @args);
    $self->quote(@prog, @opts, @args)
	if (((@prog + @opts + @args) > 1 || $childsafe) && $self->autoquote);

    my @cmd = (@prog, @opts, @args);
    my @data;
    my $dbg = 0;
    my $rc = 0;
    my($ifd, $ofd, $efd) = ($self->stdin, $self->stdout, $self->stderr);
    my $noexec = $self->noexec && !$self->_read_only;
    if ($childsafe) {
	$self->_addstats("@prog", scalar @args) if $Argv::Summary;
	$self->warning("cannot change \%ENV of child process") if $envp;
	$self->warning("cannot close stdin of child process") if $ifd;
	if ($noexec) {
	    $self->_dbg($dbg, '-', \*STDERR, @cmd);
	} else {
	    my %results = $self->_ipccmd(@cmd);
	    if ($ofd <= 0) {
		# ignore the results
	    } elsif ($ofd == 1) {
		push(@data, @{$results{stdout}});
	    } elsif ($ofd == 2) {
		print STDERR @{$results{stdout}};
	    } else {
		warn "Warning: illegal value '$ofd' for stdout";
	    }
	    if ($efd == 1) {
		push(@data, @{$results{stderr}});
	    } else {
		print STDERR @{$results{stderr}} if $efd;
		warn "Warning: illegal value '$efd' for stderr" if $efd > 2;
	    }
	    $? = $rc = $results{status} << 8;
	}
    } else {
	$dbg = $self->dbglevel;
	# Reset to defaults in dbg mode (what's this for?)
	($ofd, $efd) = (1, 2) if defined($dbg) && $dbg > 2;
	my $limit = $self->qxargs;
	if ($limit && @args) {
	    if ($limit == -1) {
		$limit = -_arg_max();
		$limit += _env_size() if !MSWIN;
		$limit += _path_max();		# for the shell
		$limit += length('-c');
		$limit += _path_max();		# for @prog
		$limit += length("@opts");
	    }
	    while (my @chunk = $limit > 0 ?
		    splice(@args, 0, $limit) :
		    _chunk_by_length(\@args, abs($limit))) {
		$self->_addstats("@prog", scalar @chunk) if $Argv::Summary;
		@cmd = (@prog, @opts, @chunk);
		if ($noexec) {
		    $self->_dbg($dbg, '-', \*STDERR, @cmd);
		} else {
		    $self->_dbg($dbg, '+', \*STDERR, @cmd) if $dbg;
		    $self->_qx_stderr(\@cmd, $efd);
		    $self->_qx_stdout(\@cmd, $ofd);
		    if ($envp) {
			local %ENV = %$envp;
			push(@data, qx(@cmd));
		    } else {
			push(@data, qx(@cmd));
		    }
		    $rc ||= $?;
		}
	    }
	} else {
	    $self->_addstats("@prog", scalar @args) if $Argv::Summary;
	    if ($noexec) {
		$self->_dbg($dbg, '-', \*STDERR, @cmd);
	    } else {
		$self->_dbg($dbg, '+', \*STDERR, @cmd) if $dbg;
		$self->_qx_stderr(\@cmd, $efd);
		$self->_qx_stdout(\@cmd, $ofd);
		if ($envp) {
		    local %ENV = %$envp;
		    @data = qx(@cmd);
		} else {
		    @data = qx(@cmd);
		}
		$rc ||= $?;
	    }
	}
	$? = $rc if $rc && ! $?;
    }
    print STDERR "+ (\$? == $?)\n" if $dbg > 1;
    if ($?) {
	$self->lastresults($?>>8, @data);
	$self->fail($self->qxfail);
    }
    $self->unixpath(@data) if MSWIN && $self->outpathnorm;
    if (wantarray) {
	print STDERR map {"+ <- $_"} @data if @data && $dbg >= 2;
	chomp(@data) if $self->autochomp;
	return @data;
    } else {
	my $data = join('', @data);
	print STDERR "+ <- $data" if @data && $dbg >= 2;
	chomp($data) if $self->autochomp;
	return $data;
    }
}
# Can't override qx() in main package so we export an alias instead.
*qv = \&qx;

sub pipe {
    return $class->new(@_)->pipe if !ref($_[0]) || ref($_[0]) eq 'HASH';

    my $self = shift;

    my $cb = $self->pipecb;
    $self->error("No callback supplied") unless ref($cb) eq 'CODE';

    my ($pipe, $pid) = $self->readpipe(@_);
    my $line;
    my $abort = 0;
    while($line = <$pipe>) {
	chomp($line) if $self->autochomp;
	my $keepGoing = &$cb($line);
	if (!$keepGoing) {
	    if ($self->_read_only) {
		$abort = 1;
		last;
	    }
	    $self->warning("Not abortable unless readonly - continuing!");
	}
    }
    if (MSWIN && $abort)    {
	# This is somewhat ugly, but due to perl impl details as well as
	# the fact that Windows does not have the proper counterpart to
	# SIGPIPE, we'll have to 'help' things along...
	#
	Argv::Win32Utils::killProcessTree($self, $pid);
    }
    my $rc = close($pipe);
    $self->fail($self->qxfail) if !$rc;
    return $rc;
}

# Wrapper around Perl's "open(FOO, ' |')" operator.
sub readpipe {
    return $class->new(@_)->readpipe if !ref($_[0]) || ref($_[0]) eq 'HASH';
    my $self = shift;
    my $envp = $self->envp;
    my @prog = @{$self->{AV_PROG}};
    my @opts = $self->_sets2opts(@_);
    my @args = @{$self->{AV_ARGS}};

    # These potentially modify their arguments in place.
    $self->argpathnorm(@prog, @args);
    $self->quote(@prog, @opts, @args)
	if (((@prog + @opts + @args) > 1) && $self->autoquote);

    my @cmd = (@prog, @opts, @args);
    my $dbg = 0;
    my($ifd, $ofd, $efd) = ($self->stdin, $self->stdout, $self->stderr);
    my $noexec = $self->noexec && !$self->_read_only;
    $dbg = $self->dbglevel;
    $self->_addstats("@prog", scalar @args) if $Argv::Summary;
    if ($noexec) {
	$self->_dbg($dbg, '-', \*STDERR, @cmd, '|');
    } else {
	my $handle;
	$self->_dbg($dbg, '+', \*STDERR, @cmd, '|') if $dbg;
	$self->_qx_stderr(\@cmd, $efd);
	$self->_qx_stdout(\@cmd, $ofd);
	my $rc;
	if ($envp) {
	    local %ENV = %$envp;
	    $rc = open($handle, "@cmd |");
	} else {
	    $rc = open($handle, "@cmd |");
	}
	$self->fail($self->qxfail) if !$rc || !defined($handle);
	my $oldfh = select($handle); $| = 1; select($oldfh);
	return wantarray ? ($handle, $rc) : $handle;
    }
}

# Internal - provide a warning with std format and caller's context.
sub warning {
    my $self = shift;
    (my $prog = $0) =~ s%.*[/\\]%%;
    no strict 'refs';
    carp('Warning: ', ${$self->{AV_PROG}}[-1] || $prog, ': ', @_);
}

# Internal - provide a fatal error with std format and caller's context.
sub error {
    my $self = shift;
    (my $prog = $0) =~ s%.*[/\\]%%;
    no strict 'refs';
    croak('Error: ', ${$self->{AV_PROG}}[-1] || $prog, ': ', @_);
}

# Hack this thing in here to help with *&#$ Windows. We want to hide it
# as much as possible in the hope that a better way may be found
# someday. Thus it's implemented as an "inner class" rather than
# a separate file.
{
    package Argv::Win32Utils;

    # Preload this to avoid INIT block failure in Win32::API::Type
    # (but it may not be installed at all, which is ok).
    eval "require Win32::API";

    # For internal use only - attempt to kill the process tree stemming from
    # the given pid.
    # Attempts several ways using various packages that may or may not be
    # present.
    sub killProcessTree {
	my $argv = shift;
	my $pid = shift;

	# Undocumented way to turn this off in case it causes big problems...
	return 0 if $ENV{ARGV_WIN32UTILS_SKIP_KILLPROCESSTREE};

	require Win32::Process;

	my ($implDesc, $impl) = __findImpl($argv);
	print STDERR "Using $implDesc...\n" if $argv->dbglevel > 1;
	&$impl($argv, $pid);

	return 0;
    }

    # For internal use only - attempt to kill a single process
    sub killProcess {
	my $argv = shift;
	my $pid = shift;

	print STDERR "Killing $pid...\n" if $argv->dbglevel > 1;
	return Win32::Process::KillProcess($pid, 0);
    }

    # Implementation using Win32::Process::Info
    # This pkg can give us a (pruned) pid tree with the expected
    # layout right away.
    sub __win32_process_info {
	my $argv = shift;
	my $pid = shift;

	my %pidTree = new Win32::Process::Info->Subprocesses($pid);
	__deepKill($argv, $pid, \%pidTree);

	return 0;
    }

    # Implementation using Win32::ToolHelp
    # this pkg gives a different view - rework into a pid tree
    # by 1) enter all pids as keys, and then 2) add their children.
    sub __win32_toolhelp {
	my $argv = shift;
	my $pid = shift;

	my %pidTree;
	my @allProcesses = Win32::ToolHelp::GetProcesses();
	$pidTree{$_->[1]} = [] foreach (@allProcesses);
	push(@{$pidTree{$_->[5]}}, $_->[1]) foreach (@allProcesses);
	__deepKill($argv, $pid, \%pidTree);

	return 0;
    }

    # Kill processes depth first by following the tree.
    sub __deepKill {
	my $argv = shift;
	my $pid = shift;
	my $pidTree = shift;

	# give a parent an opportunity to terminate by itself
	# which is likely when their child died
	#
	foreach my $childPid (@{$pidTree->{$pid}}) {
	    __deepKill($argv, $childPid, $pidTree);
	}
	killProcess($argv, $pid);
    }

    # Dynamically find an implementation that can figure out
    # the process tree and kill it.
    # Fall back to just kill the root pid (which may just be enough).
    sub __findImpl {
	my $argv = shift;

	# begin with a list to ensure a preferred search order
	# but put the list in a hash for easy lookup
	#
	my @implList = (
	    "Win32::ToolHelp", \&__win32_toolhelp,
	    "Win32::Process::Info", \&__win32_process_info,
	);
	my %implHash = @implList;
	foreach my $implName (@implList) {
	    eval "use $implName";
	    return ("$implName (tree capable)", $implHash{$implName}) unless $@;
	}

	# no luck, use fallback
	my @helpers = keys(%implHash);
	$argv->warning("No process tree helper found - install any of these packages: [@helpers]");
	return ("Win32::Process (not tree capable)", \&killProcess);
    }

    1;
}

1;

__END__