view release on metacpan or  search on metacpan

pltest  view on Meta::CPAN

		if( $opt eq 'V' ) {
		    $perl = "perl$arg";
		    undef $opt; # treat $opts below
		} elsif( $opt eq 'I' ) {
		    push @perl, $opts.'I', $arg; # let perl check for empty arg
		} elsif( $opt =~ /[ABbEe]/ ) {
		    $seen{$opt} ||= $opt =~ /[be]/;
		    push @pltest::opts, join( '', '-', @pl1, $opt ), $arg;
		    @pl1 = ();
		    undef $opt; # treat $opts below
		} else {
		    $seen{F} ||= $opt eq 'F';
		    push @perl, $opts.$opt.$arg;
		}
	    }
	    unless( defined $opt ) { # no else, because of -[bBeEV] above
		push @perl, $opts if 1 < length $opts;
	    }
	} else {
	    s/^-$one*(?:[0l][0-7]*$one*)*(.).*/-$1/;
	    warn "Unrecognized switch: $_  (-h will show valid options).\n";
	    exit 29;
	}
    }
    $seen{a} ||= push @perl, '-a' if $seen{F};
    $seen{n} ||= push @perl, '-n'
      if ! grep $seen{$_}, qw(o O)
      and grep $seen{$_}, qw(a b e P p r);
    push @pltest::opts, join '', '-', @pl1 if @pl1;
#warn join '|', $perl // $^X, @perl, '--', $0, '+', @pltest::opts, '--', @ARGV, "\n";
    if( ! $execed and $perl || @perl ) { # let perl do perl-opts
	unshift @ARGV, $perl //= $^X, @perl, '--', $0, '+', @pltest::opts, '--';
	if( $^O =~ /^MSWin/ ) {
	    require Win32::ShellQuote;
	    my $ret = system {$ARGV[0]} Win32::ShellQuote::quote_system_list( @ARGV );
	    warn $perl, ": $!\n" if $!;
	    exit $ret >> 8;
	}
	exec @ARGV;
	warn $perl, ": $!\n";
	exit 1;
    }
}

use strict;

#use warnings;

use feature ':5.10';
use sort 'stable';

use List::Util '/./'; # all EXPORT_OK
BEGIN {
    eval q{
	sub any(&@) { my $prog = shift; &$prog && return 1 for @_ };
	sub all(&@) { my $prog = shift; &$prog || return for @_; 1 };
	sub none(&@) { my $prog = shift; &$prog && return for @_; 1 };
	sub notall(&@) { my $prog = shift; &$prog || return 1 for @_ };
	sub product(@) { reduce { $a * $b } 1, @_ };
	*sum0 = sub(@) { sum 0, @_ } if !defined \&sum0;
    } if $] lt '5.02';
}


our( $A, @A,
     @F, @FIELD,
     $H, $HEX_SORT,
     $I, $ARGIND,
     %K, %KEYDIFF,
     %N, %NUMBER,
     $q, $quote,
     $Q, $Quote,
     $R, $RESULT,
     @R, @RESULT,
     %R, %RESULT,
     $T, $TXT_SORT );



# Echo remove quine
sub echo(@) {
    if( wantarray ) {
	my @ret = &Echo;
	$ret[-1] .= "\n" if @ret;
	@ret;
    } elsif( defined wantarray ) {
	join( ' ', &Echo ) . "\n";
    } else {
	local $, = ' ';
	say &Echo;
    }
}

# Echo without newline
sub Echo(@) {
    if( wantarray ) {
	map {
	    if( ! defined ) {
		"$pltest::c{I}undef$pltest::c{E}";
	    } elsif( !ref ) {
		$_;
	    } elsif( eval { $_->can( '(""' ) } ) {
		"$_";
	    } else {
		require Data::Dumper;
		my $ret = Data::Dumper::Dumper( $_ );
		$ret =~ s/;?\n?$//s;
		$ret =~ s/\bundef\b/$pltest::c{I}undef$pltest::c{E}/gs;
		$ret;
	    }
	} @_ ? @_ : $_;
    } elsif( defined wantarray ) {
	join ' ', &Echo;
    } else {
	local( $,, $\, $| ) = (' ', '', 1);
	print &Echo;
    }
}

# Would call it format, but that's not overridable.
sub form($@) {