#! /usr/bin/perl

# Beware: DON'T PERFORM ANY ACTIONS AT TOP LEVEL: this file runs many times under -n!

use 5.010;

our $VERSION;
BEGIN {
    $VERSION = '0.56';
    my $execed = shift if @ARGV && $ARGV[0] eq '+'; # don't recursively call perl again for -p
    return unless @ARGV and $ARGV[0] =~ /^-/s;
    my $onepl = qr/[oOrhv?]|[pP](?:[1-9][0-9]*)?/; # simple pl opts, reflect these in doc/html
    my $one = qr/[cftTuUwWXan]|$onepl/; # simple opts to pass to perl, which handles them well
    my( $perl, @perl, @pl1, %seen );
    while( @ARGV ) {		# no for, may need to shift
	$_ = $ARGV[0];
	last unless /^-/s;
	shift;
	last if /^--$/s;
	if( /^--(?:help|version|color(?:|=never|=always|=auto))$/s ) {
	    push @pl::opts, $_;
	    next;
	}
	unshift @ARGV, "-$1" if s/^-$one*[0l][0-7]*$onepl+\K(0.*)//; # avoid -l012o0 -> -l0120
	if( /^(-$one*(?:[0l][0-7]*$one*)*)(?:([CdDFiImM0bBeEV])(.*))?$/s ) { # Perl does 0 & l inline only with oct arg.
	    my( $opts, $opt, $arg ) = ($1, $2, $3);
	    $seen{$_} ||= $opts =~ $_ for qw(a n o O p P r);
	    push @pl1, $1 while $opts =~ s/($onepl)//;
	    if( defined $opt ) {
		if( ! length $arg and $opt =~ /[IbBeEV]/ ) { # These can have arg glued or separated
		    $arg = shift;
		    unless( defined $arg ) {
			warn "Missing argument to -$opt.\n";
			exit 29;
		    }
		}
		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 =~ /[be]/i ) {
		    $seen{$opt} ||= $opt =~ /[be]/;
		    push @pl::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 @pl::opts, join '', '-', @pl1 if @pl1;
#warn join '|', $perl // $^X, @perl, '--', $0, '+', @pl::opts, '--', @ARGV, "\n";
    if( ! $execed and $perl || @perl ) { # let perl do perl-opts
	unshift @ARGV, $perl //= $^X, @perl, '--', $0, '+', @pl::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 5.10.0;
use strict;

{
    package Data::Dumper;
    our $Deparse = 1;
    our $Quotekeys = 0;
    our $Sortkeys = sub { [&pl::sort_keys] };
    our $Terse = 1;
}

#use warnings;

use feature ':'.substr $^V, 1; # Enable latest optional features.
use sort 'stable';

use List::Util;
use List::Util @List::Util::EXPORT_OK;


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
sub echo(@) { local( $,, $\ )     = (' ', "\n");  print &pl::pretty }

# Echo without newline
sub Echo(@) { local( $,, $\, $| ) = (' ', '', 1); print &pl::pretty }

# Format
sub echof($@) {		  printf shift() . "\n", &pl::pretty }

# Format without newline
sub Echof($@) { local $| = 1; printf shift,		 &pl::pretty }


sub benchmark(&@) {
    my( $code, $name, @args ) = @_;
    local( $a, $b ) = ($a, $b);
    $name //= 'anonymous';
    require Benchmark;
    local $SIG{__WARN__} = sub { die @_ };
    if( @args ) {
	echo Benchmark::timestr( Benchmark::countit( 10, $code )), "$name: $_"
	    for @args;
    } else {
	echo Benchmark::timestr( Benchmark::countit( 10, $code )), " $name";
    }
}

# Do it 100x for very fast test code (to increase weight compared to Benchmark overhead).
sub Benchmark(&@) {
    my( $code, @rest ) = @_;
    benchmark { for my $i (0..99) { &$code() }} @rest;
}

sub Config(@) {
    require Config;
    if( @_ ) {
	#{map { pairgrep { $a =~ /$_/ } %Config::Config } @_}; # needs 5.20
	my %config;
	while( my( $k, $v ) = each %Config::Config ) {
	    $k =~ $_ and $config{$k} = $v, last
	      for @_;
	}
	\%config;
    } else {
	\%Config::Config;
    }
}

sub Date(@) {
    my( $s, $us, $z, $zo );
    require Time::HiRes;
    for( @_ ) {
	if( ref ) {
	    ($s, $us) = @$_;
	} elsif( /^([-+]?)(1[0-4]|0?[0-9])(?:\.([0-9])([0-9])?|:([0-5])?([0-9]))?$/i ) {
	    $z = $2 * 3600  +  ($3 ? ($3.($4//0)) * 36  :  $6 ? (($5//0).$6) * 60  :  0);
	    $zo = sprintf ' %s%02d:%02d', $1 || '+', $z / 3600, $z % 3600 / 60;
	    $z = -$z if $1 eq '-';
	} elsif( /^([-+]?)(?=.)([0-9]*)(?:\.([0-9]*))?$/i ) {
	    my $nus = substr +($3 // '') . '0'x6, 0, 6;
	    if( $1 ) {
		($s, $us) = Time::HiRes::gettimeofday() unless defined $s;
		if( $1 eq '+' ) {
		    $s += $2 // 0;
		    $us += $nus;
		    ++$s, $us -= 1e6 if $us >= 1e6;
		} else {
		    $s -= $2 // 0;
		    $us -= $nus;
		    --$s, $us += 1e6 if $us < 0;
		}
	    } else {
		$s = $2 // 0;
		$us = $nus;
	    }
	}
    }
    ($s, $us) = Time::HiRes::gettimeofday() unless defined $s;
    if( $pl::isodate ) {
	my @time = reverse +(defined( $z ) ? gmtime $s + $z : localtime $s)[0..5];
	$s = sprintf '%04d-%02d-%02dT%02d:%02d:%02d.%06d%s', 1900 + shift( @time ), 1 + shift( @time ), @time, $us, $zo // '';
    } else {
	$s = defined( $z ) ? gmtime $s + $z : localtime $s;
	substr $s, 19, 0, $zo if $zo;
	substr $s, 19, 0, sprintf '.%06d', $us // 0;
    }
    defined wantarray ? $s : echo $s;
}

sub Isodate(@) {
    local $pl::isodate = 1;
    &Date;
}

# turns list of ipv4/6 addresses & hostnames or $_ into /etc/hosts format
# todo comment not found
sub hosts(@) {
    require Socket;
    package Socket;
    my( %res, %name );
    my $res = sub {
	my( $v4, $name, $aliases, undef, undef, @addr ) = @_;
	undef $name{$_} for $name, split ' ', $aliases;
	for( @addr ) {
	    $_ = unpack 'H*', $_;
	    if( $v4 ) { # make sortable by kind
		s/^(?=7f)/g/ or # loopback
		  s/^(?=a9fe)/i/ or # link local
		  s/^(?=0a|ac1|c0a8)/k/ or # private
		  substr $_, 0, 0, 'm';
	    } else {
		s/^(?=0+1$)/h/ or # loopback
		  s/^(?=fe[89ab])/j/ or # link local
		  s/^(?=fd)/l/ or # private
		  substr $_, 0, 0, 'n';
	    }
	    @{$res{$_}}{keys %name} = (); # don't just store %name, different names might point to same IP but not vice versa
	}
    };
    my @unpack = (\&unpack_sockaddr_in6, \&unpack_sockaddr_in);
    for my $name ( @_ ? @_ : $_ ) {
	if( exists &getaddrinfo ) { # somewhere > v5.16.3
	    for( getaddrinfo( $name, undef, {socktype => SOCK_STREAM()} )) {
		next unless ref; # 1st is return code
		%name = ();
		undef $name{$_->{canonname}} if defined $_->{canonname};
		my $v4 = $_->{family} == AF_INET();
		my $addr = $unpack[$v4]->( $_->{addr} );
		my @get = gethostbyaddr( $addr, $_->{family} );
		&$res( $v4, @get ? @get : ($name, (undef)x3, $addr) );
	    }
	} else {		# older perl
	    %name = ();
	    my $addr;
	    my $v6 = $name =~ /:/ || exists &inet_pton;
	    my @get = $v6 ? gethostbyaddr( $addr = inet_pton( AF_INET6(), $name ), AF_INET6()) :
	      $name =~ /[a-z]/i ? gethostbyname( $name ) :
	      gethostbyaddr $addr = inet_aton( $name ), AF_INET();
	    &$res( ! $v6, @get ? @get : ($name, (undef)x3, $addr) );
	}
    }
    for( sort keys %res ) {
	next if 1 == length;	# IPv6 on old perl
	my $ip = pack 'H*', substr $_, 1;
	::echo 4 == length $ip ? inet_ntoa( $ip ) : inet_ntop( AF_INET6(), $ip ),
	  sort grep ! /^[0-9.]+$|^(?=.*:)[0-9a-f:]+$/i, keys %{$res{$_}};
    }
}

# Fill keydiff arrays
sub keydiff(;$$) {
    my $val;
    if( @_ > 1 ) {
	$val = $_[1];
    } else {
	chomp( $val = $_ );
    }
    $KEYDIFF{@_ == 0 ? $1 : $_[0]}[$ARGIND] = $val;
}
sub Keydiff(;$$) {
    my $key = $FIELD[@_ == 0 ? 0 : $_[0]];
    if( @_ > 1 ) {
	keydiff $key, $_[1];
    } else {
	keydiff $key;
    }
}

# trim small values from %NUMBER
sub Number(;$) {
    my $n = $_[0] // 2;
    $NUMBER{$_} < $n and delete $NUMBER{$_} for keys %NUMBER;
}

# Pipe command to CODE
sub piped(&$@) {
    my $code = shift;
    open my $fd, "-|", @_ or die "$_[0]: $!\n";
    &$code() while <$fd>;
}


sub help(;$) {
    if( @_ && ! defined $_[0] ) {
	print <<\EOF;
usage: pl {-{BbeE} program} [-o] [-Vversion] [-perlopt...] [--] [main program] [arg ...]
  -bprog & -eprog   wrap begin/end program around each file in -n/-p...
  -Bprog & -Eprog   wrap begin/end program around program in same scope, my-vars work.
  -o                assume "for(@A) { ... }" loop around main program
  -O                assume "for $A (@A) { ... }" loop around main program
  -p[number]        print on each loop (also -o/-O) iteration, at most number times
  -P[number]        like -p, but print only if main program evaluates to true, like grep
  -r                reset "$." and -p/-P counter for each file
  -VVERSION         rerun with given version, which is just appended to "perl".
  --color[=when]    colorize the output; when can be 'never', 'always', or 'auto' (the default)
These options are handled by perl:
EOF
	piped { Echo if /^\s+-[0acCdDfFiImMntTuUvwWX]/ } $^X, '-h';
    }
    print <<\EOF;
Predefined functions:
  b { } name, arg... benchmark slow code for 10s, display name, looping over args.
  B { } name, arg... same, but run code 100 times in benchmark, to reduce overhead.
  C re...           %Config, e.g. c->{sitelib}, optionally only part matching regexps
  D [arg...][, tz]  Date (from arg [s, us], s{.us}, offset [+-]s{.us}, tz ([+-]0-14{:mm|.ff})
  e arg...          echo prettified args or $_ with spaces and newline
  E arg...          same, but no newline
  f fmt, arg...     format prettified args with newline
  F fmt, arg...     same, but no newline
  I [arg...][, tz]  Isodate (from arg [s, us], s{.us}, offset [+-]s{.us}, tz ([+-]0-14{:mm|.ff})
  k [key, value]    store value or chomped $_ in $K{key or $1}[$I] for keydiff
  K [number, value] same, but key is $F[number] or $F[0]
  N [n]             trim %n values less than n (default 2) e.g.; -EN or -E 'N 5'
  p { } cmd, arg... open pipe from cmd and loop over it.
Predefined & magic variables:
  *A	*ARGV	    A, $A & @A are aliases to ARGV, $ARGV & @ARGV
  $I	0..n	    index of ARG currently being processed in -o, -n or -p
  $q	'
  $Q	"
  %K	()[]	    at end, sort by keys, print keydiff of $I array elements.  Filled by k.
  %N	()	    at end, sort numerically by values
  *R	undef () {} at end, print each, if defined or not empty, %RESULT sorted by keys
EOF
}



# \todo help doc readline test:my
{
package pl;

our %c;

# It's annoyingly hard to figure out if all are unique & lexically compatible numbers, or whether to sort textually.
sub sort_keys(\%) {
    my $hash = $_[0];
    return () unless keys %$hash;
    goto TXT if $::TXT_SORT;
    my( $hex, $perl, $no_oct, %seen, @seen_oct ) = $::HEX_SORT;
    for( keys %$hash ) {
	goto TXT if /[^0-9a-fx._+-]/i;
	$hex = 0, last unless /^[0-9a-f](?:_?[0-9a-f]+)*$/i;
	goto TXT if exists $seen{hex $_};
	undef $seen{hex $_};
    }
    return sort { hex $a <=> hex $b } keys %$hash if $hex;

    %seen = ();
    for( keys %$hash ) {
	unless( $no_oct ||= /^[+-]?0(?=.*[89])/ ) {
	    if( /^[+-]?0(?:b(?:_?[01]+)*|x(?:_?[0-9a-f]+)*)$/i ) {
		goto TXT if exists $seen{eval $_};
		undef $seen{eval $_};
		$perl = 1, next;
	    }
	    if( /^[+-]?0(?:_?[0-7]+)*$/ ) {
		push @seen_oct, $_; # can't decide yet
		next;
	    }
	}

	if( /^[+-]?(?=.)[0-9]*(?:\.[0-9]*)?(?:(?<=.)e[+-]?[0-9]+)?$/i ) {
	    goto TXT if exists $seen{0 + $_};
	    undef $seen{0 + $_};
	    next;
	}

	goto TXT;
    }
    if( $perl ) {
	goto TXT if $no_oct;
	for( @seen_oct  ) {
	    goto TXT if exists $seen{eval $_};
	    undef $seen{eval $_};
	}
	return sort { eval $a <=> eval $b } keys %$hash;
    } else {
	for( @seen_oct  ) {
	    goto TXT if exists $seen{0 + $_};
	    undef $seen{0 + $_};
	}
	return sort { $a <=> $b } keys %$hash;
    }

  TXT:				# clearest solution here
    sort keys %$hash;
}


sub keydiff() {
    goto &_keydiff if $c{E} && eval { require Algorithm::Diff };
    for my $key ( sort_keys %::KEYDIFF ) {
	my( $same, $str ) = 1;
	$#{$::KEYDIFF{$key}} = $ARGIND - 1; # lengthen list if needed
	for( @{$::KEYDIFF{$key}} ) {
	    $str ||= $_ // '$pl::n_a';
	    $same = $str eq ($_ // '$pl::n_a');
	    last unless $same;
	}
	next if $same;
	::echo "$c{B}$key$c{E}";
	::echo defined() ? "\t$_" : "\t$c{I}n/a$c{E}"
	    for @{$::KEYDIFF{$key}};
    }
}
sub _keydiff() {
    for my $key ( sort_keys %::KEYDIFF ) {
	my( $max, $n, $ref ) = (0, 0);
	for( @{$::KEYDIFF{$key}} ) {
	    next unless defined;
	    $max = length if $max < length;
	    ++$n;
	    if( $ref ) {
		$ref = Algorithm::Diff::LCS( $ref, [split //] );
	    } else {
		$ref = [split //];
	    }
	}
	next if $n == $ARGIND && @$ref == $max;
	::echo "$c{B}$key$c{E}";
	$#{$::KEYDIFF{$key}} = $ARGIND - 1; # lengthen list if needed
	for( @{$::KEYDIFF{$key}} ) {
	    if( defined ) {
		if( ! @$ref ) {
		    substr $_, 0, 0, $c{R};
		} elsif( @$ref == length ) {
		    substr $_, 0, 0, $c{G};
		} else {
		    my( undef, $idx ) = Algorithm::Diff::LCSidx( $ref, [split //] );
		    for my $i ( reverse @$idx ) {
			substr $_, $i + 1, 0, $c{R};
			substr $_, $i, 0, $c{G};
		    }
		    substr $_, 0, 0, $c{R};
		    s/\e\[3.m(?=\e\[3.m|$)//g;
		    1 while s/(\e\[3.m)[^\e]+\K\1//;
		}
	    } else {
		$_ = "$c{I}n/a";
	    }
	    ::echo "\t$_$c{E}";
	}
    }
}

sub pretty {
    map {
	if( ! defined ) {
	    "$c{I}undef$c{E}";
	} elsif( !ref ) {
	    $_;
	} elsif( eval { $_->can( '(""' ) } ) {
	    "$_";
	} else {
	    require Data::Dumper;
	    my $ret = Data::Dumper::Dumper( $_ );
	    $ret =~ s/;?\n?$//s;
	    $ret;
	}
    } @_ ? @_ : $_;
}

sub getline {
    { local $\ = ''; print STDERR defined() ? '>> ' : '> ' }
    my $part = <>;
    if( defined $part ) {
	if( defined ) {
	    $_ .= "\n" . $part;
	} else {
	    $_ = $part;
	}
    } else {
	say '';
	exit;
    }
}
sub shell {
    # No my, as that would inject into eval.
    our $lp = eval { require Lexical::Persistence; Lexical::Persistence->new() };
    while( 1 ) {
	our $lines = undef;
	for( $lines ) {
	    &getline;
	    &getline while s/\\$//s;
	    if( /\{$/s ) {
		&getline until /\n\}$/s;
	    }
	}
	{
	    package main;
	    $lp ? $lp->do( $lines ) : eval $lines;
	}
	warn $@ if $@;
    }
}

sub selftest {
    eval join '', <::DATA>;
    warn $@ if $@;
}
}



BEGIN {
    *A = *ARGV;
    *I = \$ARGIND;
    *b = \&benchmark;
    *B = \&Benchmark;
    *C = \&Config;
    *D = \&Date;
    *e = \&echo;
    *E = \&Echo;
    *f = \&echof;
    *F = \&Echof;
    *FIELD = \@F;
    *h = \&hosts;
    *H = \$HEX_SORT,
    *I = \&Isodate;
    *k = \&keydiff;
    *K = \&Keydiff;
    *K = \%KEYDIFF;
    *N = \&Number;
    *N = \%NUMBER;
    *p = \&piped;
    *q = \$quote;
    *Q = \$Quote;
    *R = *RESULT,
    *T = \$TXT_SORT,
#    * = \&;

    ($ARGIND, $quote, $Quote, $H) = (0, "'", '"', 1);
    unless( @pl::opts || @ARGV ) {
	*pl::prog = \&pl::shell;
	return;
    }

    {
	# Assemble a program that works under perl -n, etc., while adding in pl's options.
	# This is wild stuff, as it has to blend in various options, while potentially accomodating an outer loop.
	my @prog;
	@prog[2, 4, 11, 13, 22] =
	  ('sub pl::prog { $pl::last = 1;',
	   'LINE: {',		# dummy loop
	   '} continue {',		# program didn't do last
	   '$pl::last = 0 }',
	   '}');

	while( @pl::opts ) {	# no for, need to shift
	    $_ = shift @pl::opts;
	    if( /^--color(?:()|=(a)lways|=(n)ever|=auto)$/s ) {
		$pl::c = defined( $1 ) || $2 ? 1 : $3 ? 0 : undef;
		next;
	    } elsif( /[?h]/ ) {
		help undef;
		exit;
	    } elsif( /v/ ) {
		echo "This is pl v$VERSION, with perl $^V

Copyright 1997-2020, Daniel Pfeiffer

Pl may be copied only under the terms of either the Artistic License or the
GNU General Public License, which may be found in the Perl 5 source kit.";
		exit;
	    }

	    if( /([be])/i ) {
		# put ; after \n as user may end with a comment
		my $bit = "\n#line 1 \"-$1 option\"\n" . shift( @pl::opts ) . "\n;";
		if( /b/ ) {
		    # Do it each time ARGV changes
		    $prog[5] = 'if( ($pl::exARGV //= "") ne $ARGV ) {' . $bit . '$pl::exARGV = $ARGV; }';
		} elsif( /B/ ) {
		    $prog[0] = $bit;
		} elsif( /e/ ) {
		    $prog[8] = "\nINIT { \$pl::_e = sub { $bit }}";
		    $pl::_e = '&$pl::_e();';
		} else {
		    $prog[9] = "\n;END { $bit }";
		}
	    }
	    @prog[3, 14] =
	      (/O/ ? 'for $ARGV (@ARGV) {' : 'for(@ARGV) {',
	       '} continue { ++$ARGIND; last if $pl::last }')
		if /o/i;
	    if( /p([1-9][0-9]*)?/i ) {
		my $p = $1;
		$prog[1] = '$pl::_pn = 0;';
		@prog[6, 10] =
		  ('$pl::_P = do {',
		   '}') if /P/;
		$prog[12] = '++$pl::_pn, print or die "-p destination: $!\n"' . (/P/ ? 'if $pl::_P;' : ';');
		$prog[13] =~ s/0/\$pl::_pn >= $p ? 2 : 0/ if $p;
	    }
	    $pl::_r = 1 if /r/;
	}
	$prog[7] = @ARGV ? "\n#line 1 \"main program\"\n" . shift() . "\n;" : ';';
	#$prog[13] =~ s/\$pl::last =( \$pl::_pn >= \d+)/ if($1 ) { &\$pl::_e() if \$pl::_e; exit }/ unless $pl::_r || $prog[14];
	$prog[14] //= 		# ! -[oO]
	  'if( $pl::last || eof ) { ++$ARGIND;' .
	    ($pl::_r ? 'close ARGV; $pl::_pn = 0;' : 'if( $pl::last ) { my $d = $.; close ARGV; $. = $d }') .
	      ($pl::_e // '') .
		($pl::_r ? '}' : 'exit if $pl::last == 2 }');
	# Don't pollute eval with my-vars
	$_ = join '', grep defined, @prog;
    };
    #no warnings 'experimental';	# overridden by -W
    no strict;
    if( $ENV{PLDUMP} ) { open STDOUT, '| perltidy -cb'; echo; exit }
    eval;
    if( $@ ) {
	warn $@;
	exit 255;
    }
    undef $_;
    @pl::c{qw(B I G R E)} = $pl::c // (-t STDOUT && $^O !~ /^MSWin/) ?
      map "\e[${_}m", 1, 3, 32, 31, '' :
      ('')x5;
}
&pl::prog; # will be called repeatedly if -n



END {
    echo $RESULT if defined $RESULT;
    echo for @RESULT;
    echof "%s:  %s", $_, $RESULT{$_}
	for pl::sort_keys %RESULT;

    # todo lenint.lenfloat %d/f
    printf "%8d: %s\n", $NUMBER{$_}, $_
	for sort { $NUMBER{$a} <=> $NUMBER{$b} } pl::sort_keys %NUMBER;
    &pl::keydiff if keys %KEYDIFF;
}

__DATA__

# Code for pl::selftest

sub assert($$$) {
    my( $msg, $exp, $res ) = @_;
    warn "[[$msg]]\n" if defined $msg;
    warn pretty "  expected: ", $exp, "  got: ", $res
	if defined $exp ? (defined $res ? $exp ne $res : 1) : defined $res;
}

# Emulate -n from in-memory files.
sub n_loop(&@) {
    my $code = shift;
    $::I = 0;
    for my $arg ( @_ ) {
	open my $fd, '<', \$arg;
	$::A = "file$::I";
	&$code() for <$fd>;
	++$::I;
    }
}

sub stdout(&) {
    open my $fd, '>', \my $str;
    my $orig = select $fd;
    eval { $_[0]->() };
    warn $@ if $@;
    select $orig;
    close $fd;
    $str;
}

sub test_sort_keys(&$@) {
    my( $cmp, $msg ) = splice @_, 0, 2;
    warn "[[sort_$msg]]\n" if defined $msg;
    my( %x, $prev, $res );
    for( 0..9 ) {		# Retry, one sorting bug was key order related.
	@x{@_} = ();
	if( defined $prev ) {
	    $res = join '|', sort_keys %x;
	    last if $res ne $prev;
	} else {
	    $prev = join '|', sort_keys %x;
	}
    }
    assert undef, join( '|', $cmp ? sort $cmp @_ : sort @_ ), $res eq $prev ? $res : "$res\n\tand also: $prev";
}

warn "Starting tests\n";
# assert assert_ok1 => undef, undef;
# assert assert_ok2 => 1, 1;
# assert assert_ok3 => '', '';
# assert assert_fail1 => undef, 1;
# assert assert_fail2 => 1, undef;
# assert assert_fail3 => 0, 1;

# assert stdout => "$_\n", stdout \&::echo for 'foo', 'bar';

# assert n_loop => "file0 a\n\nfile0 b\nfile1 c\n\nfile2 d\n\nfile2 e\n\nfile2 f\n",
#     stdout { n_loop { ::echo $::A, $_ } "a\nb", "c\n", "d\ne\nf" };

my @l = qw(0 a b c aa bb cc 0b1 0b2 07 08 babe bad be);
( $H, $T ) = 0;
test_sort_keys undef, no_hex => @l;
$H = 1;
test_sort_keys { hex $a <=> hex $b } hex => @l;
$T = 1;
test_sort_keys undef, hex_txt => @l;
$T = 0;
test_sort_keys undef, txt => @l, 'z';
test_sort_keys undef, hex_mix => @l, qw(1.1 +2);
test_sort_keys undef, hex_dup => @l, 'c_c';
test_sort_keys undef, dupcasehex => @l, 'CC';
test_sort_keys { $a <=> $b } num => qw(-1 -.5 0 1 +2 3 04);
@l = qw(-1 0 1 -1.1 .2 +.3 5. -1e-2 +1e-2 -1.e2 -.1e2 1.E2 -0X2 0x0_2 -0b1_1 0B1_1 04 -04);
test_sort_keys { eval $a <=> eval $b } pl => @l;
test_sort_keys undef, no_oct => @l, '08';
test_sort_keys undef, dupx => @l, '0X2';
test_sort_keys undef, dupn => @l, 100;

my $stdin = <<\EOF;
echo 1
echo 2\
, 3
for( 4, 5 ) {
    echo;
}
EOF
#close STDIN; open STDIN, '<', \$stdin;
#::echo '[[', stdout( \&shell ), ']]';
warn "Ending tests\n";



=head1 NAME

pl - Swiss Army Knife of Perl One-Liners

=head1 SYNOPSIS

There are always those tasks too menial for dedicated script, but still too
cumbersome even with the many neat one-liner options of C<perl -E>.  This
small script fills the gap with many bells & whistles: Various one-letter
commands & magic variables (with meaningful aliases too) and more nifty loop
options take Perl programming to the command line.  List::Util is fully
imported.  If you pass no program on the command line, starts a simple Perl
Shell.

How to C<e(cho)> values, including from C<@A(RGV)>, with single C<$q(uote)> &
double C<$Q(uote)>.  Same for hard-to-print values:

    pl 'echo "${quote}Perl$quote", "$Quote@ARGV$Quote"' one liner
    pl 'e "${q}Perl$q", "$Q@A$Q"' one liner

    pl 'echo \"Perl", \@ARGV, undef' one liner
    pl 'e \"Perl", \@A, undef' one liner

Loop over args, printing each with line ending.  And same, SHOUTING:

    pl -opl '' Perl one liner
    pl -opl '$_ = uc' Perl one liner

Print up to 3 matching lines, resetting count (and C<$.>) for each file:

    pl -rP3 '/Perl.*one.*liner/' file*

Count hits in magic statistics hash C<%N(UMBER)>:

    pl -n '++$NUMBER{$1} while /(Perl|one|liner)/g' file*
    pl -n '++$N{$1} while /(Perl|one|liner)/g' file*

Though they are sometimes slightly, sometimes quite a bit more complicated,
most Perl one-liners from the internet work, just by omitting C<-e> or C<-E>
(there may be only one, but you can just as well concatenate them with C<<;>).
See L<minor differences|/"Minor Differences with perl -e"> for exceptions.

=head1 DESCRIPTION

I<Don't believe everything you read on SourceForge^H^H^H the internet! -- Aristotle ;-)>

Pl follows Perl's philosophy for one-liners: the one variable solely used in
one-liners, C<@F>, is single-lettered.  Because not everyone may like that, Pl
has it both ways.  Everything is aliased both as a word and as a single
letter, including Perl's own C<@F> & C<*ARGV>.

Perl one-liners, and hence pl, are by nature bilingual.  You must run the
command with its options & arguments, typically from Shell.  By design, Perl
quotes mimic Shell quotes, so here they collide.  As Perl also uses Shell
meta-characters like C<$>, the best solution is to protect Perl-code from the
Shell with single quotes.  That means they can't be used inside.  (An ugly way
around that is C<'\''>, which ends a string, blackslashes a quote and starts
another.  For literal quotes use C<$q(uote)>.)  Double quotes or C<q{}> are
the way to go.

B<-B> doesn't do a C<BEGIN> block.  Rather it is in the same scope as your
main program.  So you can use it to initialise C<my> variables.  Whereas, if
you define a my variable in the main program of a B<-n>, B<-p>, B<-P>, B<-o>
or B<-O> loop, it's a new variable each time.  This echoes "a c" because B<-E>
gives an C<END> block, as a closure of the 1st C<$inner> variable.  Perl
warns "Variable "$inner" will not stay shared":

    pl -OB 'my $outer' -E 'echo $inner, $outer' 'my $inner = $outer = $ARGV' a b c
    pl -OB 'my $outer' -E 'e $inner, $outer' 'my $inner = $outer = $A' a b c

=head1 EXAMPLES

I<To steal ideas from one person is plagiarism.  To steal from many is research. ;-)>

Only some of these are original.  Many have been adapted from the various Perl
one-liner pages on the internet.  This is no attempt to appropriate ownership,
just to show how things are even easier and more concise with pl.

All examples, if applicable, use the long names and are repeated for short names.

=head2 Dealing with Files

=over

=item Heads ...

I<People say the back of my head looks really nice -- but I don't see it. :-)>

If you want just I<n>, e.g. 10, lines from the head of each file, use the
optional number argument to B<-p>, along with B<-r> to reset the count.  The
program can be empty, but must be present, unless you're reading from stdin:

    pl -rp10 '' file*

If you want the head up to a regexp, use the flip-flop operator, starting with
line number 1.  Use the print-if-true B<-P> loop option, again with B<-r> to
reset the count:

    pl -rP '1../last/' file*

You can combine the two, if you want at most I<n> lines, e.g. 10:

    pl -rP10 '1../last/' file*

=item ... or Tails?

I<What has a head, a tail, but no legs?  A penny. :-)>

If you want a bigger number of last lines, you need to stuff them in a list;
not really worth it.  But if you want just 1 last line from each file, the
end-of-file B<-e> code (no need to quote, as it has no special characters) can
C<E(cho)> it for you, capitalized so as to not add another newline (yes, Perl
is case sensitive):

    pl -e Echo '' file*
    pl -e E '' file*

If you want the tail from a line-number (e.g. 99) or a regexp, use the
flip-flop operator, starting with your regexp and going till each end-of-file:

    pl -P '99..eof' file*
    pl -P '/first/..eof' file*

You can even get head and tail (which in programming logic translates to C<or>),
if last line of head comes before 1st line of tail (or actually any number of
such disjoint ranges):

    pl -rP '1../last/ or /first/..eof' file*

=item Remove trailing whitespace in each file

This print-loops (B<-p>) over each file, replacing it (B<-i>) with the
modified output.  Line ends are stripped on reading and added on printing
(B<-l>), because they are also whitespace (C<\s>).  At each end of line,
substitute one or more spaces of any kind (incl. DOS newlines) with nothing:

    pl -pli 's/\s+$//' file*

=item Tabify each file

This print-loops (B<-p>) over each file, replacing it (B<-i>) with the
modified output.  At beginning of line and after each tab, 8 spaces or less
than 8 followed by a tab are converted to a tab:

    pl -pi '1 while s/(?:^|\t)\K(?: {1,7}\t| {8})/\t/' file*

If you're a fan or half-width tabs, make that:

    pl -pi '1 while s/(?:^|\t)\K(?: {1,3}\t| {4})/\t/' file*

=item Print only 1st occurrence of each line

I<Poets create worlds through a minimal of words. -- Kim Hilliker |/|>

This counts repetitions of lines in a hash.  Print only when the expression is
true (B<-P>), i.e. the count was 0:

    pl -P '!$a{$_}++' file*

If you want this per file, you must empty the hash in the end-of-file B<-e>
code:

    pl -Pe '%a = ()' '!$a{$_}++' file*

=item Remove Empty Lines

Technically this does the opposite, printing back to the same files (B<-Pi>)
all lines containing non-whitespace C<\S>:

    pl -Pi '/\S/' file*

=item Move a line further down in each file

Assume we have lines matching "from" followed by lines matching "to".  The
former shall move after the latter.  This loops over each file, replacing it
with the modified output.  The flip-flop operator becomes true when matching
the 1st regexp.  Capture something in there to easily recognize it's the
first, keep the line in a variable and empty C<$_>.  When C<$1> is again true,
it must be the last matching line.  Append the keep variable to it.

    pl -pi 'if( /(f)rom/.../(t)o/ ) { if( $1 eq "f" ) { $k = $_; $_ = "" } elsif( $1 ) { $_ .= $k }}' file*

=item Rename a file depending on contents

This reads each file without newlines in a B<-ln> loop.  When it finds the
C<package> declaration, which gives the logical name of this file, it replaces
double-colons with slashes.  It renames the file to the result.  The C<last>
statement then makes this the last line read of the current file, continuing
with the next file:

    pl -ln 'if( s/^\s*package\s+([^\s;]+).*/$1/ ) { s!::!/!g; rename $ARGV, "$_.pm" or warn "$ARGV -> $_.pm: $!\n"; last }' *.pm
    pl -ln 'if( s/^\s*package\s+([^\s;]+).*/$1/ ) { s!::!/!g; rename $A, "$_.pm" or warn "$A -> $_.pm: $!\n"; last }' *.pm

This assumes all files are at the root of the destination directories.  If not
you must add the common part of the target directories before C<$_>.

On Windows this won't quite work, because that locks the file while reading.
So there you must add C<close ARGV;> (or C<close A;>) before the C<rename>.

For Java, it's a bit more complicated, because the full name is split into a
C<package> followed by a C<class> or similar statement.  Join them when we
find the latter:

    pl -n 'if( /^\s*package\s+([^\s;]+)/ ) { $d = $1 =~ tr+.+/+r } elsif( /^\s*(?:(?:public|private|protected|abstract|final)\s+)*(?:class|interface|enum|record)\s+([^\s;]+)/ ) { rename $ARGV, "$d/$1.java" or warn "$ARGV -> $d/$1.java: $!\n"; last }' *.java
    pl -n 'if( /^\s*package\s+([^\s;]+)/ ) { $d = $1 =~ tr+.+/+r } elsif( /^\s*(?:(?:public|private|protected|abstract|final)\s+)*(?:class|interface|enum|record)\s+([^\s;]+)/ ) { rename $A, "$d/$1.java" or warn "$A -> $d/$1.java: $!\n"; last }' *.java

=item Delete matching files, except last one

If you have many files, which sort chronologically by name, and you want to
keep only the last one, it can be quite painful to formulate Shell patterns.
So check on each iteration of the B<-o> loop, if the index C<$ARGIND> (or
C<$I>) is less than the last, before unlinking (deleting).  If you want to test
it first, replace C<unlink> with C<e(cho)>:

    pl -o 'unlink if $ARGIND < $#ARGV' file*
    pl -o 'unlink if $I < $#A' file*

If your resulting list is too long for the Shell, let Perl do it.  Beware that
the Shell has a clever ordering of files, while Perl does it purely lexically!
In the B<-B> BEGIN code the result is assigned to C<@A(RGV)>, as though it had
come from the command line.  This list is then popped (shortened), instead of
checking each time.  Since the program doesn't contain special characters, you
don't even need to quote it:

    pl -oB '@ARGV = <file*>; pop' unlink
    pl -oB '@A = <file*>; pop' unlink

You can exclude files by any other criterion as well:

    pl -oB '@ARGV = grep !/keep-me/, <file*>' unlink
    pl -oB '@A = grep !/keep-me/, <file*>' unlink

=back

=head2 File statistics

I<42% of statistics are made up! :-)>

=over

=item Count files per suffix

Find and pl both use the B<-0> option to allow funny filenames, including
newlines.  Sum up encountered suffixes in sort-value-numerically-at-end hash
C<%N(UMBER)>:

    find -print0 |
        pl -0ln '++$NUMBER{/(\.[^\/.]+)$/ ? $1 : "none"}'
    find -print0 |
        pl -0ln '++$N{/(\.[^\/.]+)$/ ? $1 : "none"}'

=item Count files per directory per suffix

I<There are three types of people: those who can count and those who can't. (-:>

Match to last C</> and after a dot following something, i.e. not just a
dot-file.  C<""> is the suffix for suffixless files.  Stores in
sort-by-key-and-stringify-at-end hash C<%R(ESULT)>.  So count in a nested hash
of directory & suffix:

    find -type f -print0 |
        pl -0ln '/^(.+)\/.+?(?:\.([^.]*))?$/; ++$RESULT{$1}{$2}'
    find -type f -print0 |
        pl -0ln '/^(.+)\/.+?(?:\.([^.]*))?$/; ++$R{$1}{$2}'

This is the same, but groups by suffix and counts per directory:

    find -type f -print0 |
        pl -0ln '/^(.+)\/.+?(?:\.([^.]*))?$/; ++$RESULT{$2}{$1}'
    find -type f -print0 |
        pl -0ln '/^(.+)\/.+?(?:\.([^.]*))?$/; ++$R{$2}{$1}'

This is similar, but stores in sort-by-number-at-end C<%N(UMBER)>.  Since this matches
suffixes optionally, a lone dot indicates no suffix.  The downside is that it
is neither sorted by directory, nor by suffix:

    find -type f -print0 |
        pl -0ln '/^(.+)\/.+?(?:\.([^.]*))?$/; ++$NUMBER{"$1 .$2"}'
    find -type f -print0 |
        pl -0ln '/^(.+)\/.+?(?:\.([^.]*))?$/; ++$N{"$1 .$2"}'

This avoids the lone dot:

    find -type f -print0 |
        pl -0ln '/^(.+)\/.+?(?:\.([^.]*))?$/; ++$NUMBER{length($2) ? "$1 .$2" : "$1 none"}'
    find -type f -print0 |
        pl -0ln '/^(.+)\/.+?(?:\.([^.]*))?$/; ++$N{length($2) ? "$1 .$2" : "$1 none"}'

=item Sum up file-sizes per suffix

Find separates output with a dot and -F splits on that.  The C<\\> is to
escape one backslash from the Shell.  No matter how many dots the filename
contains, 1st element is the size and last is the suffix.  Sum it in C<%N(UMBER)>,
which gets sorted numerically at the end:

    find -name "*.*" -type f -printf "%s.%f\0" |
        pl -0lF\\. '$NUMBER{".$FIELD[-1]"} += $FIELD[0]'
    find -name "*.*" -type f -printf "%s.%f\0" |
        pl -0lF\\. '$N{".$F[-1]"} += $F[0]'

This is similar, but also deals with suffixless files:

    find -type f -printf "%s.%f\0" |
        pl -0lF\\. '$number{@FIELD == 2 ? "none" : ".$FIELD[-1]"} += $FIELD[0]'
    find -type f -printf "%s.%f\0" |
        pl -0lF\\. '$number{@F == 2 ? "none" : ".$F[-1]"} += $F[0]'

=item Count files per date

Incredibly, find has no ready-made ISO date, so specify the 3 parts.  If you
don't want days, just leave out C<-%Td>.  Sum up encountered dates in
sort-value-numerically-at-end hash C<%N(UMBER)>:

    find -printf "%TY-%Tm-%Td\n" |
        pl -ln '++$NUMBER{$_}'
    find -printf "%TY-%Tm-%Td\n" |
        pl -ln '++$N{$_}'

=item Count files per date with rollup

I<Learn sign language!  It's very handy. :-)>

Rollup means, additionally to the previous case, sum up dates with the same
prefix.  The trick here is to count both for the actual year, month and day,
as well as replacing once only the day, once also the month with "__", and
once also the year with "____".  This sorts after numbers and gives a sum for
all with the same leading numbers.  Use the sort-by-key-and-stringify-at-end
hash C<%R(ESULT)>:

    find -printf "%TY-%Tm-%Td\n" |
        pl -ln '++$RESULT{$_}; ++$RESULT{$_} while s/[0-9]+(?=[-_]*$)/"_" x length $&/e'
    find -printf "%TY-%Tm-%Td\n" |
        pl -ln '++$R{$_}; ++$R{$_} while s/[0-9]+(?=[-_]*$)/"_" x length $&/e'

=back

=head2 Diff several inputs by a unique key

I<Always remember you're unique, just like everyone else. :-)>

The function C<k(eydiff)> stores the 2nd arg or chomped C<$_> in C<%K(EYDIFF)>
keyed by 1st arg or C<$1> and the arg counter C<$ARGIND> (or C<$I>).  Its
sibling C<K(eydiff)> does the same using 1st arg or 0 as an index into C<@F(IELD)>
for the 1st part of the key.  At the end only the rows differing between files
are shown.  If you specify B<--color> and have C<Algorithm::Diff> the exact
difference gets color-highlighted.

=over

=item Diff several csv, tsv or passwd files by 1st field

This assumes no comma in key field and no newline in any field.  Else you need
a csv-parser package.  B<-F> implies B<-a>, which implies B<-n> (even using
older than Perl 5.20, which introduced this idea):

    pl -F, Keydiff *.csv
    pl -F, K *.csv

This is similar, but removes the key from the stored value, so it doesn't get
repeated for each file:

    pl -n 'keydiff if s/(.+?),//' *.csv
    pl -n 'k if s/(.+?),//' *.csv

A variant of csv is tsv, with tab as separator.  Tab is C<\t>, which must be
escaped from the Shell as C<\\t>:

    pl -F\\t Keydiff *.tsv
    pl -F\\t K *.tsv

    pl -n 'keydiff if s/(.+?)\t//' *.tsv
    pl -n 'k if s/(.+?)\t//' *.tsv

The same, with a colon as separator, if you want to compare passwd files from
several hosts.  Here we addifionally need to ignore commented out lines:

    pl -F: 'Keydiff unless /^#/' /etc/passwd passwd*
    pl -F: 'K unless /^#/' /etc/passwd passwd*

    pl -n 'keydiff if s/^([^#].*?)://' /etc/passwd passwd*
    pl -n 'k if s/^([^#].*?)://' /etc/passwd passwd*

=item Diff several zip archives by member name

This uses the same mechanism as the csv example.  Addidionally it reads the
output of C<unzip -vql> for each archive through the C<p(iped)> block.  That
has a fixed format, except for tiny members, which can report -200%, screwing
the column by one:

    pl -o 'piped { keydiff if / Defl:/ && s/^.{56,57}\K  (.+)// } "unzip", "-vql", $_' *.zip
    pl -o 'p { k if / Defl:/ && s/^.{56,57}\K  (.+)// } "unzip", "-vql", $_' *.zip

If you do a clean build of java, many class files will have the identical crc,
but still differ by date.  This excludes the date:

    pl -o 'piped { keydiff $2 if / Defl:/ && s/^.{31,32}\K.{16} ([\da-f]{8})  (.+)/$1/ } "unzip", "-vql", $_' *.jar
    pl -o 'p { k $2 if / Defl:/ && s/^.{31,32}\K.{16} ([\da-f]{8})  (.+)/$1/ } "unzip", "-vql", $_' *.jar

=item Diff several tarballs by member name

This is like the zip example.  But tar gives no checksum, so this is not very
reliable.  Each time a wider file size was seen, columns shift right.  Reformat
the columns, so this doesn't show up as a difference:

    pl -o 'piped { s/^\S+ \K(.+?) +(\d+) (.{16}) (.+)/sprintf "%-20s %10d %s", $1, $2, $3/e; keydiff $4 } "tar", "-tvf", $_' *.tar *.tgz *.txz
    pl -o 'p { s/^\S+ \K(.+?) +(\d+) (.{16}) (.+)/sprintf "%-20s %10d %s", $1, $2, $3/e; k $4 } "tar", "-tvf", $_' *.tar *.tgz *.txz

Again without the date:

    pl -o 'piped { s/^\S+ \K(.+?) +(\d+) .{16} (.+)/sprintf "%-20s %10d", $1, $2/e; keydiff $3 } "tar", "-tvf", $_' *.tar *.tgz *.txz
    pl -o 'p { s/^\S+ \K(.+?) +(\d+) .{16} (.+)/sprintf "%-20s %10d", $1, $2/e; k $3 } "tar", "-tvf", $_' *.tar *.tgz *.txz

=item Diff ELF executables by loaded dependencies

You get the idea: you can do this for any command that outputs records with a
unique key.  This one looks at the required libraries and which file they came
from.  For a change, loop with B<-O> and C<$A(RGV)> to avoid the previous
examples' confusion between outer C<$_> which are the cli args, and the inner
one, which are the read lines:

    pl -O 'piped { keydiff if s/^\t(.+\.so.*) => (.*) \(\w+\)/$2/ } ldd => $ARGV' exe1 exe2 lib*.so
    pl -O 'p { k if s/^\t(.+\.so.*) => (.*) \(\w+\)/$2/ } ldd => $A' exe1 exe2 lib*.so

It's even more useful if you use just the basename as a key, because version
numbers may change:

    pl -O 'piped { keydiff $2 if s/^\t((.+)\.so.* => .*) \(\w+\)/$1/ } ldd => $ARGV' exe1 exe2 lib*.so
    pl -O 'p { k $2 if s/^\t((.+)\.so.* => .*) \(\w+\)/$1/ } ldd => $A' exe1 exe2 lib*.so

=back

=head2 Looking at Perl

I<A pig looking at an electric socket:  "Oh no, who put you into that wall?" :)>

=over

=item VERSION of a File

Print the first line (B<-P1>) where the substitution was successful.  To avoid
the hassle of protecting them from (sometimes multiple levels of) Shell
quoting, there are variables for single C<$q(uote)> & double C<$Q(uote)>:

    pl -P1 's/.+\bVERSION\s*=\s*[v$Quote$quote]([0-9.]+).+/$1/' pl
    pl -P1 's/.+\bVERSION\s*=\s*[v$Q$q]([0-9.]+).+/$1/' pl

For multple files, add the filename, and reset (B<-r>) the B<-P> count for each
file:

    pl -rP1 's/.+\bVERSION\s*=\s*[v$Quote$quote]([0-9.]+).+/$ARGV: $1/' *.pm
    pl -rP1 's/.+\bVERSION\s*=\s*[v$Q$q]([0-9.]+).+/$A: $1/' *.pm

=item Only POD or non-POD

You can extract either parts of a Perl file, with these commands.  Note that
they don't take the empty line before into account.  If you want that, and
you're sure the files adheres strictly to this convention, use the option
B<-00P> instead (not exactly as desired, the empty line comes after things,
but still, before next thing).  If you want only the 1st POD (e.g. NAME &
SYNOPSIS) use the option B<-P1> or B<-00P1>:

    pl -P '/^=\w/../^=cut/' file

    pl -P 'not /^=\w/../^=cut/' file

=item Count Perl Code

This makes C<__DATA__> or C<__END__> the last inspected line of (unlike in
C<perl -n>!) each file.  It strips any comment (not quite reliably, also
inside a string).  Then it strips leading whitespace and adds the remaining
length to print-at-end C<$R(ESULT)>:

    pl -ln 'last if /^__(?:DATA|END)__/; s/(?:^|\s+)#.*//s; s/^\s+//; $result += length' *.pm

If you want the count per file, instead of C<$R(ESULT)> use either
sort-lexically C<$RESULT{$ARGV}> (or C<$R{$A}>) or sort-numerically
C<$NUMBER{$ARGV}> (or C<$N{$A}>).

=item Content of a Package

Pl's C<e(cho)> can print any item.  Packages are funny hashes, with two colons
at the end.  Backslashing the variable passes it as a unit to C<Data::Dumper>,
which gets loaded on demand in this case.  Otherwise all elements would come
out just separated by spaces:

    pl 'echo \%List::Util::'
    pl 'e \%List::Util::'

=item Library Loading

Where does perl load from, and what exactly has it loaded?

    pl 'echo \@INC, \%INC'
    pl 'e \@INC, \%INC'

Same, for a different Perl version, e.g. if you have F<perl5.20.0> in your
path:

    pl -V5.20.0 'echo \@INC, \%INC'
    pl -V5.20.0 'e \@INC, \%INC'

=item Configuration

You get C<%Config::Config> loaded on demand and returned by C<C(onfig)>:

    pl 'echo Config'
    pl 'e C'

It returns a hash reference, from which you can lookup an entry:

    pl 'echo Config->{sitelib}'
    pl 'e C->{sitelib}'

You can also return a sub-hash, of only the keys matching any regexps you
pass:

    pl 'echo Config "random", qr/stream/'
    pl 'e C "random", qr/stream/'

=back

=head2 Tables

=over

=item ISO paper sizes

I<ISO replaced 8 standards by one.  Now we have 9 standards. :-(>

Can't put the A into the format, because 10 is wider.  Uses Perl's lovely list
assignment to swap and alternately halve the numbers.  Because halving happens
before echoing, start with double size:

    pl '($w, $h) = (1189, 1682); echof "%3s  %4dmm x %4dmm", "A$_", ($w, $h) = ($h / 2, $w) for 0..10'
    pl '($w, $h) = (1189, 1682); f "%3s  %4dmm x %4dmm", "A$_", ($w, $h) = ($h / 2, $w) for 0..10'

The table could easily be widened to cover B- & C-formats, by extending each
list of 2, to a corresponding list of 6, e.g. C<($Aw, $Ah, $Bw, ...)>.  But a
more algorithmic approach seems better.  This fills C<@A(RGV)> in B<-B>, as
though it had been given on the command line and prepares a nested list of the
3 initials specs.  The format is tripled (with cheat spaces at the beginning).
The main program loops over C<@A(RGV)>, thanks to B<-O>, doing the same as
above, but on anonymous elements of C<@d>:

    pl -OB '@ARGV = 0..10; @d = (["A", 1189, 1682], ["B", 1414, 2000], ["C", 1297, 1834])' \
        'echof "  %3s  %4dmm x %4dmm"x3, map +("$$_[0]$ARGV", ($$_[1], $$_[2]) = ($$_[2] / 2, $$_[1])), @d'
    pl -OB '@A = 0..10; @d = (["A", 1189, 1682], ["B", 1414, 2000], ["C", 1297, 1834])' \
        'f "  %3s  %4dmm x %4dmm"x3, map +("$$_[0]$A", ($$_[1], $$_[2]) = ($$_[2] / 2, $$_[1])), @d'

=item ANSI foreground;background color table

I<If at first you don't succeed, destroy all evidence that you tried! ;-)>

What a table, hardly a one-liner...  You get numbers to fill into C<"\e[FGm">,
C<"\e[BGm"> or C<"\e[FG;BGm"> to get a color and close it with C<"\e[m">.
There are twice twice 8 different colors for dim & bright and for foreground &
background.  Hence the multiplication of escape codes and of values to fill
them.

This fills C<@A(RGV)> in B<-B>, as though it had been given on the command
line.  It maps it to the 16fold number format to print the header.  Then the
main program loops over it with C<$A(RGV)>, thanks to B<-O>, to print the
body.  All numbers are duplicated with C<(N)x2>, once to go into the escape
sequence, once to be displayed:

    pl -OB '@ARGV = map +($_, $_+8), 1..8; echof "co:  fg;bg"."%5d"x16, @ARGV' \
        'echof "%2d:  \e[%dm%d;   ".("\e[%dm%4d "x16)."\e[m", $ARGV, ($ARGV + ($ARGV > 8 ? 81 : 29))x2, map +(($_)x2, ($_+60)x2), 40..47'
    pl -OB '@A = map +($_, $_+8), 1..8; f "co:  fg;bg"."%5d"x16, @A' \
        'f "%2d:  \e[%dm%d;   ".("\e[%dm%4d "x16)."\e[m", $A, ($A + ($A > 8 ? 81 : 29))x2, map +(($_)x2, ($_+60)x2), 40..47'

This does exactly the same, but explicitly loops over lists C<@co & @bg>:

    pl '@co = map +($_, $_+8), 1..8; @bg = map +(($_)x2, ($_+60)x2), 40..47;
        echof "co:  fg;bg"."%5d"x16, @co;
        echof "%2d:  \e[%dm%d;   ".("\e[%dm%4d "x16)."\e[m", $_, ($_ + ($_ > 8 ? 81 : 29))x2, @bg for @co'
    pl '@co = map +($_, $_+8), 1..8; @bg = map +(($_)x2, ($_+60)x2), 40..47;
        f "co:  fg;bg"."%5d"x16, @co;
        f "%2d:  \e[%dm%d;   ".("\e[%dm%4d "x16)."\e[m", $_, ($_ + ($_ > 8 ? 81 : 29))x2, @bg for @co'

=back

=head2 Miscellaneous

=over

=item Triangular Number and Factorial

The triangular number is defined as the sum of all numbers from 1 to I<n>, e.g. 1
to 5:

    pl 'echo sum 1..5'
    pl 'e sum 1..5'

Factorial is the equivalent for products.  This requires List::Util as of Perl
5.20 or newer:

    pl 'echo product 1..5'
    pl 'e product 1..5'

=item Big Math

I<2 + 2 = 5 for extremely large values of 2. :-)>

With the C<big*> modules you can do arbitrary precision and fractional math:

    pl -Mbignum 'echo 123456789012345678901234567890 * 123456789012345678901234567890'
    pl -Mbignum 'e 123456789012345678901234567890 * 123456789012345678901234567890'

    pl -Mbignum 'echo 1.23456789012345678901234567890 * 1.23456789012345678901234567890'
    pl -Mbignum 'e 1.23456789012345678901234567890 * 1.23456789012345678901234567890'

    pl -Mbigrat 'echo 1/23456789012345678901234567890 * 1/23456789012345678901234567890'
    pl -Mbigrat 'e 1/23456789012345678901234567890 * 1/23456789012345678901234567890'

=item Separate big numbers with commas, ...

Loop and print with line-end (B<-opl>) over remaining args in C<$_>.  If
reading from stdin or files, instead of arguments, use only B<-pl>.  After a
decimal dot, insert a comma before each 4th comma-less digit.  Then do the
same backwards from end or decimal dot:

    pl -opl '1 while s/[,.]\d{3}\K(?=\d)/,/; 1 while s/\d\K(?=\d{3}(?:$|[.,]))/,/' \
        12345678 123456789 1234567890 1234.5678 3.141 3.14159265358

The same for languages with a decimal comma, using either a dot or a space as spacer:

    pl -opl '1 while s/[,.]\d{3}\K(?=\d)/./; 1 while s/\d\K(?=\d{3}(?:$|[.,]))/./' \
        12345678 12345678 1234567890 1234,5678 3,141 3,141592653589

    pl -opl '1 while s/[, ]\d{3}\K(?=\d)/ /; 1 while s/\d\K(?=\d{3}(?:$|[ ,]))/ /' \
        12345678 12345678 1234567890 1234,5678 3,141 3,141592653589

The same for Perl style output with underscores:

    pl -opl '1 while s/[._]\d{3}\K(?=\d)/_/; 1 while s/\d\K(?=\d{3}(?:$|[._]))/_/' \
        12345678 123456789 1234567890 1234.5678 3.141 3.14159265358

=item Generate a random UUID

I<Lottery: a tax on people who are bad at math. :-)>

This gives a hex number with the characteristic pattern of dashes.  The hex
format takes only the integral parts of the random numbers:

    pl '$x = "%04x"; echof "$x$x-$x-$x-$x-$x$x$x", map rand 0x10000, 0..7'
    pl '$x = "%04x"; f "$x$x-$x-$x-$x-$x$x$x", map rand 0x10000, 0..7'

To be RFC 4122 conformant, the 4 version & 2 variant bits need to have
standard values.  Note that Shell strings can span more than one line:

    pl '@u = map rand 0x10000, 0..7; ($u[3] /= 16) |= 0x4000; ($u[4] /= 4) |= 0x8000;
        $x = "%04x"; echof "$x$x-$x-$x-$x-$x$x$x", @u'
    pl '@u = map rand 0x10000, 0..7; ($u[3] /= 16) |= 0x4000; ($u[4] /= 4) |= 0x8000;
        $x = "%04x"; f "$x$x-$x-$x-$x-$x$x$x", @u'

=item Generate a random password

I<Why should you trust atoms? They make up everything. :-)>

Use C<say>, which doesn't put spaces between its arguments.  Generate twelve
random characters between 33 & 127, i.e. printable Ascii characters:

    pl 'say map chr(33 + rand 94), 1..12'

=item DNS lookup

I<What do you call a sheep with no legs?  A cloud. *,=,>

The C<h(osts)> function deals with the nerdy details and outputs as a hosts
file.  The file is sorted by address type (localhost, link local, private,
public), version (IPv4, IPv6) and address.  You tack on any number of
IP-addresses or hostnames, either as Perl arguments or on the command-line via
C<@A(RGV)>:

    pl 'hosts qw(perl.org 127.0.0.1 perldoc.perl.org cpan.org)'
    pl 'h qw(perl.org 127.0.0.1 perldoc.perl.org cpan.org)'

    pl 'hosts @ARGV' perl.org 127.0.0.1 perldoc.perl.org cpan.org
    pl 'h @A' perl.org 127.0.0.1 perldoc.perl.org cpan.org

If you don't want it to be sorted, call C<h(osts)> for individual addresses:

    pl 'hosts for qw(perl.org 127.0.0.1 perldoc.perl.org cpan.org)'
    pl 'h for qw(perl.org 127.0.0.1 perldoc.perl.org cpan.org)'

    pl -o hosts perl.org 127.0.0.1 perldoc.perl.org cpan.org
    pl -o h perl.org 127.0.0.1 perldoc.perl.org cpan.org

If your input comes from a file, collect it in a list and perform at end (B<-E>):

    pl -lnE 'hosts @list' 'push @list, $_' file
    pl -lnE 'h @list' 'push @list, $_' file

=item Quine

I<I feel more like I do now than I did a while ago. (-:>

A quine is a program that prints itself.  This uses inside knowledge of how
your program compiles to a function.  The internal pretty-printer decompiles
it.  Surrounding boilerplate is replaced by C<pl ''>.  Both the long and short
form are quines.  This requires at least Perl 5.14, which introduced and
automatically adds C</u>:

    pl 'echo grep({tr/\n / /s; s/.*: \{ /pl $quote/u; s/; \}.*/$quote/u;} pl::pretty(\&pl::prog))'
    pl 'e grep({tr/\n / /s; s/.*: \{ /pl $q/u; s/; \}.*/$q/u;} pl::pretty(\&pl::prog))'

Even though decompilation rarely comes up as a quine no-go, indirectly the
above does read its source.  So it might be considered a cheating quine.  To
placate those who think so, here's a constructive way of doing it, with a
format string that gets fed to itself:

    pl '$_ = q{$_ = q{%s}; echof "pl $quote$_$quote", $_}; echof "pl $quote$_$quote", $_'
    pl '$_ = q{$_ = q{%s}; f "pl $q$_$q", $_}; f "pl $q$_$q", $_'

The same approach, but without adding C<pl ''>, so this works only in the
pl-Shell, which you start by calling pl without arguments.  In the spirit of
L<Code
Golf|https://codegolf.stackexchange.com/questions/69/golf-you-a-quine-for-great-good#answer-4827>,
made it very compact.  This is inspired by the shortest Perl quine, which we
beat by 6 characters in the short form.  That uses C<x2> to duplicate the
argument to the pre-prototypes C<printf>.  But C<echof> (or C<f>) has a
prototype.  So use the C<&>-syntax to avoid it giving 2 (the length of the
list):

    &echof(qw(&echof(qw(%s)x2))x2)
    &f(qw(&f(qw(%s)x2))x2)

=item Just another pl hacker,

I<If you can't convince them, confuse them! ;-)>

Just adapted from another Perl hacker, this obfuscated mock turtle soup
L<JAPH|https://en.wikipedia.org/wiki/Just_another_Perl_hacker> is left for you
to figure out:

    pl -plo y' ya-zyOoh, Turtleneck phrase Jar! 'y xguietlbickheqjectnokhd

=back

=head1 COMPATIBILITY

Even if it is rarer nowadays, Perl 5.10 is still found out in the wild.  Pl
tries to accomodate it gracefully, falling back to what works.  Dumped
data-structures will be formatted with a funny margin and C<h(osts)> will find
the less IPv6 resolutions, the older your Perl.

=head2 Minor Differences with perl -e

Known minor differences are:

=over

=item *

don't C<goto LINE>, but C<next LINE> is fine

=item *

in a B<-n> loop C<last> is per file instead of behaving like C<exit>

=item *

using C<pop>, etc. to implicitly modify C<@A(RGV)> works in B<-B> BEGIN code,
but not in your main program (which gets compiled to a function)

=item *

shenanigans with unbalanced braces won't work

=back

=head2 Windows Notes

I<B<W>ork B<I>s B<N>ever B<D>one B<O>n B<W>indows B<S>ystems ;-)>

Do yourself a favour and get a real Shell, e.g. from WSL, Cygwin, MSYS, MinGW
or git!  If you can't avoid F<command.com> or F<cmd.exe>, you will have to
first convert all inner quotes to C<qq>.  Then convert the outer single quotes
to double quotes:

    pl "echo qq{${quote}Perl$quote}, qq{$Quote@ARGV$Quote}" one liner
    pl "e qq{${q}Perl$q}, qq{$Q@A$Q}" one liner

Any help for getting this to work in PowerShell is welcome!

While the old Windows 10 terminal understands Ansi escape sequences, it makes
it horribly hard to activate them.  So they are off by default, requiring
B<--color> to override that choice.

=for html <hr>

Pl is maintained on L<SourceForge|https://perl1liner.sourceforge.io/> and also
available on L<meta::cpan|https://metacpan.org/pod/distribution/App-pl/pl>.
