#!perl

use 5.008;

$^W = 1;
# use strict;

$SIG{INT} = sub { exit(2) };

${^WIN32_SLOPPY_STAT} = 1;

my @Warnings;
$SIG{__WARN__} = sub { push @Warnings, @_ };

our $VERSION = '2.18';
our ($Bin_dir, %Col, $Col_Reset, %Env, $File, $Filepath, $HOME_dir, $Newline,
    @P, %Peg_longopt, %Peg_S, $Verbose, $Z);

my $Usage = <<"EOT";
Usage: peg [OPTION]... PERLEXPR [FILE]...
Try `peg --help' for more information.
EOT
my (@Before, @Cmdline_dirs, @Cmdline_files, @F, %F, %Globbed, @Ini_files,
    @Is_ascii_text, @Matched_files, %Opts, @Peg_options_ARGV, @Perlexpr,
    @Perlexpr_k, @S, %S);
my ($Beep, $Binary_file, $Bytes_read, $C, $Code_after_open, $Code_at_end,
    $Code_before_close, $Code_before_open, $Code_per_line, $Console_width,
    $Context_line, $Context_line2, $Context_lineno, $Context_matcher,
    $Context_matcher2, $Count, $CRLF_to_newline, $CRs, $Do_globbing, $First,
    $Fix_doubled_slashes, $Fix_drive_relative, $Found, $Guess_encoding,
    $Implicit_C, $Input_encoding, $Input_record_separator, $Inside_archive,
    $Last_matches_file, $Match_failed, $Matched, $Matches, $Max_matches, $MTime,
    $MTime_new, $MTime_old, $Needs_crlf_layer, $Newline_literal, $Offset,
    $Opt_d, $Opt_m, $Opt_p_expr, $Opt_pp_code, $Opt_pp_expr, $Opt_r_cmd, $Opt_s,
    $Opt_ss, $Opt_y, $Opt_yy, $Output_BOM, $Output_encoding, $P, $Perlexpr,
    $Print_context_matcher, $S_depth, $S_F, $S_FILE, $S_handler_re,
    $S_nonarchive_re, $Search, $Search_STDIN, $Simple_Perlexpr, $Size, $Slurp,
    $Slurp_maxsize, $Start_time, $STDIN_is_terminal, $STDOUT_is_terminal);
my ($Total_bytes, $Total_files, $Total_lines, $Total_matched) = (0, 0, 0, 0);
my ($DQ, $SQ, $BT, $EM, $GT, $LT, $PC) = qw( " ' ` ! > < % );
my $R_file = 'peg_' . time . ($< || '') . abs($$) . '.txt';
my $Is_Win32 = $^O eq 'MSWin32';
my ($After, $Before) = (2, 2);

END { close STDOUT or die_("can't close STDOUT: $!") };

load_ini_files();

process_ARGV();

process_options1();

build_Perlexpr();

process_options2();

build_search();

show_debug() if $Opts{D};

run();

caller() ? return : exit(@Matched_files ? 0 : 1);



sub eval_ { eval $_[0] }


sub chomp_ { $_[0] =~ s/\015?[\012\015]\z// }


sub warn_
{
    my $msg = join '', @_;
    chomp_ $msg;
    print STDERR "peg: $msg\n";

} # warn_


sub die_
{
    warn_ @_;
    exit(2);

} # die_


sub cwd
{
    require Cwd;
    local $_ = Cwd::cwd();
    s|\\|/|g if $Is_Win32;
    $_ .= '/' unless m|/\z|;
    $_ = ucfirst if m|^\w:/|;
    return $_;

} # cwd


sub ee
{
    $@ =~ s/^(.*) at .* line \d+.*\z/$1/s;
    chomp_ $@;
    $@ .= "\n";
    return $@;

} # ee


sub load_ini_files
{
    $Data::Dumper::Indent = 1;
    $Data::Dumper::Sortkeys = 1;
    $Bin_dir = ($_ = $ENV{PEG_BINDIR}) ? $_ : ($0 =~ /^(.*)[\\\/]/) ? $1 : ((
	require FindBin), $FindBin::RealBin);
    $HOME_dir = $ENV{HOME} || $ENV{USERPROFILE} || '/';
    for ($Bin_dir, $HOME_dir) {
	s|\\|/|g if $Is_Win32;
	$_ .= '/' unless m|/\z|;
	$_ = ucfirst if m|^\w:/|;
    }
    $Last_matches_file = "${HOME_dir}.peg_matches";
    my %orig_ENV = %ENV;
    unless (@ARGV and $ARGV[0] =~ /^-YY/) {
	my @f = ($_ = $ENV{PEG_INI}) ? ($_) :
	    ("${Bin_dir}peg_ini.pl", "${HOME_dir}.peg_ini.pl", "./.peg_ini.pl");
	foreach my $f (@f) {
	    next unless -f $f;
	    eval { require $f };
	    $@ and die_ "bad ini file $f:\n", @Warnings, &ee;
	    push @Ini_files, $f;
	}
    }
    foreach my $k (keys %ENV) {
	warn_ "ini files set $k in both %ENV and %Env"
	    if (exists $Env{$k} and (!exists $orig_ENV{$k} or $ENV{$k} ne $orig_ENV{$k}));
	$Env{$k} = $ENV{$k};
    }
    $Beep = exists $Env{PEG_BEEP} ? "\a" : "";
    $Console_width = $Env{PEG_CONSOLE_WIDTH} || 70;
    $Slurp_maxsize = $Env{PEG_SLURP_MAXSIZE} || 67_108_864; # 2**26
    $Do_globbing = (exists $Env{PEG_GLOB} ? $Env{PEG_GLOB} : $Is_Win32);
    $Peg_longopt{help} = sub { help($_[0]->[0]) };

} # load_ini_files


sub process_ARGV
{
    my @argv = @ARGV;
    my %peg_options;
    my $options = 1;
    my $context = 'C';
    my $pe_type = '';

    if (@argv == 1 and $argv[0] eq '-V') {
	die_ "v$VERSION Perl $] $^X\n";
    }

    $Opts{$_} = 0 for ('a'..'z', 'A'..'Z', '#', qw(% = + _ / \ { }));

    if ($_ = $Env{PEG_OPTIONS}) {
	if (/[\s\"]/) { # handle quoted arguments
	    while (s/^\s+//, length) {
		if (/^\"/) { # eg. "a double ""quoted"" string"
		    s/^"((?>[^"]*)(?>(?:""(?>[^"])*)*))"(?>\s|$)//
			or die_ "bad double quoted string in PEG_OPTIONS: $_";
		    (my $arg = $1) =~ s/""/"/g;
		    push @Peg_options_ARGV, $arg;
		} else {
		    s/^(\S+)//;
		    push @Peg_options_ARGV, $1;
		}
	    }
	} else {
	    $_ = "-$_" unless /^-/;
	    @Peg_options_ARGV = ($_);
	}
	unshift @argv, @Peg_options_ARGV;
    }

    while (defined ($_ = shift @argv)) {
	# Keep a copy of %Opts at the end of PEG_OPTIONS.
	%peg_options = %Opts if (@argv == @ARGV - 1);

	# Firstly, some OPTIONs take an argument.
	if ($Opts{e}) {
	    if ($Opts{e} == 1) { push @Perlexpr, $_ }
	    else               { push @Cmdline_files, $_ }
	    $Opts{e} = 0;
	}
	elsif ($Opts{f}) {
	    open(my $fin, "<", $_) or die_ "can't open -f file $_: $!";
	    while (<$fin>) {
		chomp_ $_;
		next if $_ eq '';
		if    ($Opts{f} == 1) { push @Perlexpr, $_ }
		elsif ($Opts{f} == 2) { push @Cmdline_files, $_ }
		else                  { ++$F{$_} }
	    }
	    $Opts{f} = 0;
	}
	elsif ($Opts{'m'}) {
	    /^[1-9][0-9]*$/ or die_ "-m expected integer argument: $_";
	    $Max_matches = $_;
	    $Opt_m = $Opts{'m'};
	    $Opts{'m'} = 0;
	}
	elsif ($Opts{M}) {
	    my $time = $_;
	    my ($num, $fix, $interval); # in days
	    if ($time =~ s/\#(\d+(?:\.\d*)?)([smhdw])?$//) { # INTERVAL
		($interval, my $units) = ($1, $2 || 'd');
		if    ($units eq 's') { $interval /= 24*60*60 }
		elsif ($units eq 'm') { $interval /= 24*60 }
		elsif ($units eq 'h') { $interval /= 24 }
		elsif ($units eq 'w') { $interval *= 7 }
	    }
	    if ($time =~ /^(\d+):(\d*)(:(\d*))?(?:-(\d+))?$/) { # EXACT
		my $sec_specified = defined $3;
		my ($hrs, $min, $sec, $days) = ($1, $2 || 0, $4 || 0, $5 || 0);
		die_ "bad -M time: $time" if ($hrs >= 24 or $min >= 60 or $sec >= 60);
		my @lt = localtime();
		my $now = $lt[0] + 60*$lt[1] + 60*60*$lt[2];
		my $given = $sec + 60*$min + 60*60*$hrs;
		$num = $days + (($now - $given) / (24*60*60));
		$num < 0 and warn_ "future -M time: $time$Beep";
		$fix = 1 / ($sec_specified ? 24*60*60 : 24*60);
	    } elsif ($time =~ m|^(\d+)/(\d+)(?:/(\d+))?$|
		    or $time =~ m|^()(\d+)-(\d+)-(\d+)$|) { # DATE
		my ($day, $mon, $yr) = length($1) ? ($1, $2, $3) : ($4, $3, $2);
		die_ "bad -M date: $time" if ($day > 31 or $mon > 12);
		$yr = (localtime())[5] unless defined $yr;
		require Time::Local;
		my $t = Time::Local::timelocal_nocheck(0,0,0,$day,$mon-1,$yr);
		$num = (time() - $t) / (24*60*60);
		$num < 0 and warn_ "future -M date: $time$Beep";
		$fix = 1;
	    } elsif ($time =~ /^(\d+(?:\.\d*)?)([smhdtw])?$/) { # OFFSET
		($num, my $units) = ($1, $2 || 'd');
		$fix = 0;
		if    ($units eq 's') { $num /= 24*60*60 }
		elsif ($units eq 'm') { $num /= 24*60 }
		elsif ($units eq 'h') { $num /= 24 }
		elsif ($units eq 't') { $num -= 1-((1.0+(localtime)[2])/24) }
		elsif ($units eq 'w') { $num *= 7 }
	    } elsif ($time =~ /^(.+)\@$/) { # FILE
		my $file = $1;
		$num = -M $file;
		die_ "-M no such file: $file" unless defined $num;
		$fix = 1/(24*60*60);
	    } else {
		die_ "bad -M argument: $time";
	    }
	    if (defined $interval) {
		$MTime_old = [$num + $interval, $fix];
		$MTime_new = [$num - $interval, $fix];
	    } elsif ($Opts{M} > 1) {
		$MTime_old = [$num, $fix];
	    } else {
		$MTime_new = [$num, $fix];
	    }
	    $Opts{M} = 0;
	}
	elsif ($Opts{p}) {
	    my $negated = s/^!(?=[\w\.\,\-]+$)//;
	    my $expr;
	    $expr = $Env{"PEG_P_" . uc($_)} if /^\w+$/; # ALIAS
	    $expr ||= '/' . quotemeta($_) . '$/i' if /^[\w\.\,\-]+$/; # EXTENSION
	    $expr ||= $_; # EXPRESSSION
	    $expr =~ s/^-s\s*</(-s) </; # fix a common syntax error: -p "-s < 1024"
	    eval_ "if (0 and ($expr)) {}";
	    $@ and die_ "bad -p file matcher: $expr\n", &ee;
	    $expr = "!($expr)" if $negated;
	    my $var_ref = $Opts{p} == 1 ? \$Opt_p_expr : \$Opt_pp_expr;
	    $$var_ref = $$var_ref ? "($expr)\n\tand $$var_ref" : "($expr)";
	    $Opts{p} = 0;
	}
	elsif ($Opts{P}) {
	    my $Opt_P = $Opts{P};
	    my $code;
	    if (/^\w+$/) { # ALIAS
		my $evar = "PEG_CODE_" . uc($_);
		$code = $Env{$evar}
		    || die_ "no such environment variable $evar";
		$code =~ /^\s*\# -(P+)/m and $Opt_P = length $1;
	    } else {
		$code = $_;
	    }
	    # Don't check for valid code here. Wait until $Code_* is complete.
	    my $var_ref =
		$Opt_P == 1 ? \$Code_per_line :
		$Opt_P == 2 ? \$Code_before_open :
		$Opt_P == 3 ? \$Code_before_close :
		$Opt_P == 4 ? \$Code_at_end : \$Code_after_open;
	    $$var_ref = $$var_ref ? "$$var_ref$code" : $code;
	    $Opts{P} = 0;
	}
	elsif ($Opts{z}) {
	    if (/^\w+$/) { # ALIAS
		my $evar = "PEG_Z_" . uc($_);
		$Context_matcher = $Env{$evar}
		    || die_ "no such environment variable $evar";
		$Context_matcher2 = $Env{"PEG_ZZ_" . uc($_)};
	    } elsif ($Opts{z} == 1) {
		$Context_matcher = $_;
	    } else {
		$Context_matcher2 = $_;
	    }
	    $Opts{z} = 0;
	}
	elsif ($Opts{'/'}) {
	    $Input_record_separator = $_;
	    $Opts{'/'} = 0;
	}
	elsif ($Opts{'{'}) {
	    $Input_encoding = lc $_;
	    require Encode;
	    Encode::find_encoding($Input_encoding)
		or die_ "unknown -{ encoding: $Input_encoding";
	    $Opts{'{'} = 0;
	}
	elsif ($Opts{'}'}) {
	    $Output_encoding = lc $_;
	    $Output_BOM = ($Output_encoding =~ s/\#//);
	    require Encode;
	    Encode::find_encoding($Output_encoding)
		or die_ "unknown -} encoding: $Output_encoding";
	    $Output_BOM &&= {
		'utf8'    => "\xEF\xBB\xBF",
		'utf16be' => "\xFE\xFF",
		'utf16le' => "\xFF\xFE",
		'utf32be' => "\x00\x00\xFE\xFF",
		'utf32le' => "\xFF\xFE\x00\x00",
	    }->{$Output_encoding}
		|| die_ "BOM unknown for -} encoding: $Output_encoding";
	    $Opts{'}'} = 0;
	}
	# Named long options.
	elsif ($options and /^--?([a-zA-Z-]{3,})$/ and exists $Peg_longopt{$1}) {
	    my $opt = $1;
	    eval { $Peg_longopt{$opt}->(\@argv, \@Cmdline_files) };
	    $@ and die_ "--$opt: ", &ee;
	}
	# Now check for an OPTION argument.
	elsif ($options && s/^-(?=.)//) {
	    while (s/^(.)//) {
		my $opt = $1;
		if ($opt =~ /^[abcdefhiklmnopqrstvwxyzABCDEFGHIJKLMNOPRSTUVWXZ_=\+\#\/\{\}\\]$/) { # Available: gjuQ
		    # Options set in PEG_OPTIONS do not count towards overloading.
		    if (@argv < @ARGV and $peg_options{$opt}) {
			delete $peg_options{$opt};
			$Opts{$opt} = 1;
		    } else {
			++$Opts{$opt};
		    }
		    $context = $opt if ($opt =~ /^[ABC]$/);
		    $pe_type = $opt if ($opt =~ /^[koO]$/);
		}
		elsif ($opt =~ /^\d$/) {
		    while (s/^(\d)//) { $opt = (10 * $opt) + $1 }
		    if ($Opts{'m'}) {
			$Max_matches = $opt;
			$Opt_m = $Opts{'m'};
			$Opts{'m'} = 0;
		    } else {
			$After  = $opt if ($context ne 'B');
			$Before = $opt if ($context ne 'A');
			$Implicit_C = 1;
		    }
		}
		elsif ($opt eq '-') { $options = undef }
		elsif ($opt eq 'Y') {
		    if (s/^,(.*)$//) {
			for my $o (split //, $1) {
			    $Opts{$o} = 0;
			    $o eq 'm' and $Opt_m = undef;
			    $o eq 'M' and $MTime_new = $MTime_old = undef;
			    $o eq 'p' and $Opt_p_expr = $Opt_pp_expr = undef;
			    $o eq 'z' and $Context_matcher = $Context_matcher2 = undef;
			    $o eq '/' and $Input_record_separator = undef;
			    $o eq '{' and $Input_encoding = undef;
			    $o eq '}' and $Output_encoding = undef;
			    $o eq 'P' and $Code_before_close = $Code_before_open =
				$Code_after_open = $Code_at_end = $Code_per_line = undef;
			}
		    } else {
			$Opts{$_} = 0 for keys %Opts;
			$Code_after_open = $Code_at_end = $Code_per_line = undef;
			$Code_before_close = $Code_before_open = undef;
			$Context_matcher = $Context_matcher2 = undef;
			$Input_encoding = $Output_encoding = undef;
			$Implicit_C = $Input_record_separator = undef;
			$Opt_m = $Opt_p_expr = $Opt_pp_expr = undef;
			$MTime_new = $MTime_old = undef;
			%F = ();
			# Leave @Perlexpr, @Cmdline_files
		    }
		}
		elsif ($opt eq '%') {
		    require Time::HiRes;
		    $Start_time ||= Time::HiRes::time();
		    ++$Opts{'%'};
		}
		else {
		    die_ "unknown option -- $opt\n$Usage";
		}
	    }
	}
	# Typically, first non OPTION argument is the PERLEXPR.
	elsif (!(@Perlexpr or @Perlexpr_k) or ($options and $pe_type ne '')) {
	    if ($pe_type eq 'k') { push @Perlexpr_k, $_ }
	    else                 { push @Perlexpr, $_ }
	}
	# Arguments which are neither OPTION nor PERLEXPR are FILEs.
	else {
	    push @Cmdline_files, $_;
	}
    }

    if ($Opts{X} > 1) {
	while (<STDIN>) {
	    chomp_ $_;
	    next if $_ eq '';
	    if ($pe_type eq 'k') { push @Perlexpr_k, $_ }
	    else                 { push @Perlexpr,   $_ }
	}
	$Opts{X} %= 2;
    }

    foreach my $opt (qw(e f m M p P z / { })) {
	die_ "option requires an argument -- $opt" if $Opts{$opt};
    }

    die $Usage unless (@Perlexpr or @Perlexpr_k or $Opts{'='});

} # process_ARGV


sub last_matches
{
    my $return_fullpaths = shift;
    open(my $fin, "<", $Last_matches_file)
	or die_ "can't open $Last_matches_file: $!";
    my $cwd = cwd();
    my $drive = ($cwd =~ m|^(\w:)/| ? $1 : '');
    my (@matches, %seen);
    while (<$fin>) {
	chomp_ $_;
	s/^\Q$cwd//o or ($drive and s/^\Q$drive//o) unless $return_fullpaths;
	push @matches, $_ unless $seen{$_}++;
    }
    return @matches;

} # last_matches


sub save_matches
{
    return if ($Opt_yy or !@Matched_files or $Search_STDIN);

    open(my $fout, ">", $Last_matches_file)
	or ((warn_ "can't write to $Last_matches_file: $!"), return);
    my $cwd = cwd();
    my $drive = ($cwd =~ m|^(\w:)/| ? $1 : '');
    foreach my $f (@Matched_files) {
	$f =~ s|\\|/|g if $Is_Win32;
	if    ($f =~ m|^\w:/|) { $f = ucfirst($f) } # c:/foo -> C:/foo
	elsif ($f =~ m|^//|) {} # UNC
	elsif ($f =~ m|^/|) { $f = "$drive$f" }
	else { $f = "$cwd$f" }
	print $fout $f, "\n";
    }
    close $fout or warn_ "can't close $Last_matches_file: $!";

} # save_matches


sub process_options1
{
    $Opt_s = ($Opts{'s'} == 1);
    $Opt_ss = $Opts{'s'};
    $Verbose = $Opts{V};
    $STDIN_is_terminal = -t STDIN;
    $STDOUT_is_terminal = -t STDOUT;

    if (!$STDOUT_is_terminal or $Opts{R}) {
	$Opts{'#'} = 0 unless $Opts{'#'} > 1;
    }
    if ($Output_encoding and $Opts{'#'}) {
	warn_ "-} prevents colored output" unless $Opt_s;
	$Opts{'#'} = 0;
    }

    if ($Is_Win32 and ($STDOUT_is_terminal or $Opts{'#'}) and !$Output_encoding) {
	# This is needed to properly handle >127 chars (eg. ä) in the correct codepage.
	eval {
	    require Win32::Console::ANSI;
	};
	if ($@) {
	    $Opts{'#'} and die_ "can't color output:\n", &ee;
	    unless (exists $Env{PEG_NO_WIN32_CONSOLE_ANSI}) {
		warn_ "failed to load Win32::Console::ANSI" unless $Opt_s;
	    }
	}
    }

    # Populate %Col based on -# and PEG_COLOR.
    my %types = qw(f filename c colon l lineno b offset n nonmatch m match z z_context y z_context2);
    if ($Opts{'#'}) {
	require Term::ANSIColor;
	# Default coloring mimics GNU grep 2.5.3's --color.
	my $peg_color = $Env{PEG_COLOR} || 'b=g,c=c,f=m,l=g,m=dr,z=c';
	$Col_Reset  = Term::ANSIColor::color('reset');
	$Col{$_} = $Col_Reset for values %types;
	$peg_color =~ s/\s+//g;
	foreach my $specifier (split /,/, lc $peg_color) {
	    eval {
		$specifier =~ /^(\w)=(.+)$/ or die;
		my ($t, $col_def) = ($1, $2);
		my $type = $types{$t} or die;
		$Col{$type} = get_col($col_def);
	    };
	    $@ and die_ "bad specifier '$specifier' in PEG_COLOR: $peg_color";
	}
    } else {
	$Col{$_} = '' for values %types;
	$Col_Reset = '';
    }

    if ($Opts{'='}) {
	my @files = last_matches($Opts{H});
	warn_ scalar(@files), " files matched" unless $Opt_s;
	my $sort = $Opts{t} + ($Opts{l} ? $Opts{l} - 1 : 0); # -=ll := -=lt
	my $long = $Opts{l} && !$Opts{h}; # -=llh := -=t
	my ($filtered, $index, @matches, $mtime, $size);
	foreach my $file (@files) {
	    ++$index;
	    if ($Opt_p_expr) {
		$_ = $File = $file;
		unless (eval_ $Opt_p_expr) {
		    $@ and warn_ "-p error: $file: ", &ee;
		    ++$filtered;
		    next;
		}
	    }
	    $file =~ s|/|\\|g if $Opts{"\\"};
	    if ($long or $sort) {
		my @s = stat($file)
		    or ($Opt_s || warn_ "can't stat $file: $!"), next;
		($size, $mtime) = ($s[7], $s[9]);
	    }
	    push @matches, [$mtime, $size, $file, $index];
	}
	$filtered and warn_ "$filtered files filtered by -p" unless $Opt_s;
	$sort and @matches = sort {(
	    $sort == 1 ? $a->[0] <=> $b->[0] :
	    $sort == 2 ? $b->[0] <=> $a->[0] :
	    $sort == 3 ? $a->[1] <=> $b->[1] :
	    $sort == 4 ? $b->[1] <=> $a->[1] : 0)
		||
	    $a->[2] cmp $b->[2];
	} @matches;
	foreach my $m (@matches) {
	    if ($long) {
		my @t = localtime $m->[0];
		my $day = qw(Sun Mon Tue Wed Thu Fri Sat)[$t[6]];
		my $mon = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec)[$t[4]];
		printf "%04d %s %2d %s %2d:%02d:%02d %9d  ",
		    1900+$t[5], $mon, $t[3], $day, $t[2], $t[1], $t[0], $m->[1];
	    }
	    printf "%s%-3d%s ", $Col{lineno}, $m->[3], $Col_Reset if $Opts{n};
	    print $Col{filename}, $m->[2], $Col_Reset, "\n";
	    last if (defined $Max_matches and --$Max_matches <= 0);
	}
	exit;
    }

    # -E overrides -F & -G, and -F overrides -G.
    if ($Opts{E}) {
	$Opts{F} = $Opts{G} = 0;
    } elsif ($Opts{F}) {
	# Use -FF in PEG_OPTIONS to make it be overrideable by -G on the command line.
	if ($Opts{F} == 1) {
	    $Opts{G} = 0;
	} elsif ($Opts{G}) {
	    $Opts{F} = 0;
	}
    }

    if ($Context_matcher2 and !$Context_matcher) {
	$Context_matcher = $Context_matcher2;
	$Context_matcher2 = undef;
    }

    $Opts{k} = 0 if !@Perlexpr_k;
    $Print_context_matcher = $Context_matcher;
    # In order of priority.
    if ($Opts{k}) {
	$Print_context_matcher = $Implicit_C = $Opt_m = undef;
	$Opts{$_} = 0 for qw(b c h l A B C J L N O W Z);
    }
    if ($Opts{O}) {
	$Print_context_matcher = $Implicit_C = $Opt_m = undef;
	$Opts{$_} = 0 for qw(b c h l A B C J L N W Z);
    }
    if ($Opts{Z}) {
	$Print_context_matcher = $Implicit_C = $Opt_m = undef;
	$Opts{$_} = 0 for qw(b c h l A B C L W);
    }
    if ($Opts{L}) {
	$Print_context_matcher = $Implicit_C = $Opt_m = undef;
	$Opts{$_} = 0 for qw(b c h l A B C J W);
    }
    # GNU grep has -l override -c; peg works the other way around.
    if ($Opts{c}) {
	$Print_context_matcher = $Implicit_C = undef;
	$Opts{$_} = 0 for qw(b l h A B C J W);
    }
    if ($Opts{l}) {
	$Print_context_matcher = $Implicit_C = $Opt_m = undef;
	$Opts{$_} = 0 for qw(b h A B C J W);
    }
    $Opt_y = ($Opts{'y'} % 2);
    $Opt_yy = ($Opts{'y'} > 1);
    $Opts{w} = 0 if $Opts{x};
    $Opt_pp_expr = undef unless $Opts{S};

} # process_options1


{
    my %col;
    BEGIN { %col = qw(r red g green y yellow b blue m magenta c cyan w white k black) };

    sub get_col
    {
	my $col_def = shift;
	$col_def =~ /^(d?)(\w)(o(d?)(\w))?$/ or die;
	my ($d, $c, $od, $oc) = ($1, $2, $4, $5);
	die unless (exists $col{$c} and (!$oc or exists $col{$oc}));
	return '' unless $Opts{'#'};
	my $col = $col{$c};
	$col = "bold $col" if $d;
	$col = "$col on_$col{$oc}" if $oc;
	$col = "underline $col" if $od;
	return Term::ANSIColor::color("reset $col");

    } # get_col
}


sub build_Perlexpr
{
    my ($simple, $warned);
    my $iwx = ($Opts{i} || $Opts{w} || $Opts{x}); # if $simple then -F else -G

    # If the PERLEXPR is simple enough, then it is faster to read
    #  the file in one go and perform the match on a single line.
    $Slurp = 1 unless ($Opts{x} or $Opts{E} or $Opts{S} or $Code_per_line);

    # Can we guarantee that after a true PERLEXPR, that ("$`$&$'" eq $_)?
    $Simple_Perlexpr = !($Opts{v} || $Opts{E} || $Opts{W});

    foreach (@Perlexpr, @Perlexpr_k) {
	next if $Opts{E};
	$simple = /^[\w\s\-\.\,\'\:\;\#]*$/;
	# Non simple implies -E unless one of -[FGiwx].
	if ($simple or $Opts{F}) {}
	elsif ($iwx or $Opts{G}) {
	    # Beware slurping causing false matches across newlines cf. peg -lG "foo[^x]+bar"
	    $Slurp = undef if /\[\^/;
	} else {
	    $Slurp = $Simple_Perlexpr = undef;
	    next; # implicit -E
	}
	# Beware accidental pattern option eg. peg -i /foo/ bar
	if (!$simple and $iwx and !($Opts{G} or $Opts{F}) and !$warned++) {
	    warn_ "interpreting as pattern: $_$Beep" unless $Opt_s;
	}
	if ($Opts{F} or ($simple and !$Opts{G})) {
	    $_ = quotemeta($_);
	} else {
	    s|/|\\/|g; # cf. "peg -G '^/' f" vs "peg -F '^/' f"
	    # Must not slurp if PERLEXPR matches real line ends:
	    $Slurp = undef if (/(?:^|[^\\\[])\^/ or /[^\\]\$(?:\W|$)/ or /\\[azZ]/);
	}
	$_ = '\b(?:' . $_ . ')\b' if $Opts{w}; # cf. peg -w "a|b"
	$_ = '^(?:' . $_ . ')$' if $Opts{x};
	$_ = '/' . $_ . '/';
	$_ .= 'i' if ($Opts{i} and ($Opts{i} == 1 or ($simple and $_ eq lc $_)));
    }

    if ($Opts{k}) {
	$Perlexpr = join ",\n\t",
	    map({"((" . $Perlexpr_k[$_] . ")\t && (\$Match_failed = 1, last))"} (0..$#Perlexpr_k)),
	    map({"(\$Match$_ ||= (" . $Perlexpr[$_] . "))"} (0..$#Perlexpr));
    }
    elsif ($Opts{O}) {
	$Perlexpr = join ",\n\t",
	    map({"(\$Match$_ ||= (" . $Perlexpr[$_] . "))"} (0..$#Perlexpr)),
	    ('(' . join(' && ', map {"\$Match$_"} (0 .. $#Perlexpr)) . ')');
    }
    elsif (@Perlexpr > 1) {
	$Perlexpr = join "\n\t|| ", map {"($_)"} @Perlexpr;
    }
    else {
	$Perlexpr = $Perlexpr[0];
    }
    $Perlexpr = 'not (' . $Perlexpr . ')' if $Opts{v};

    # Check the PERLEXPR is valid Perl code.
    eval_ "if (0 and ($Perlexpr)) {}";

    if ($@) {
	my $ee = join '', @Warnings, &ee;
	if ((@Perlexpr + @Perlexpr_k) > 1) { # Determine first bad expression.
	    foreach my $pe (@Perlexpr, @Perlexpr_k) {
		@Warnings = ();
		eval_ "if (0 and ($pe)) {}";
		$@ and die_ "error in the Perl expression: $pe\n", @Warnings, &ee;
	    }
	}
	die_ "error in Perl expression: $Perlexpr\n$ee";
    }

} # build_Perlexpr


sub process_options2
{
    # Do we need to convert CRLFs to newlines?
    $Opts{N} = 1 if defined $Input_record_separator or $Opts{a} > 1;
    if ($Is_Win32) {
	if ($Opts{N} or $Input_encoding) {
	    $CRLF_to_newline = 1;
	} else {
	    foreach my $code ($Perlexpr, $Code_per_line) {
		next unless defined $code;
		# Does the PERLEXPR appear to refer to *newlines*? ie. not \z.
		if ($code =~ /\$\/|\\n|\bchomp\b/) {
		    $CRLF_to_newline = 1;
		    last;
		}
	    }
	}
	# Do we need a ":crlf" layer on the output?
	if ($CRLF_to_newline or $Opts{k} or $Opts{l} or $Opts{L} or $Opts{O} or $Opts{Z}) {
	    $Needs_crlf_layer = 1;
	}
    }
    if ($Is_Win32 and !$Needs_crlf_layer) {
	$Newline = "\015\012";
	$Newline_literal = "\\015\\012";
    } else {
	$Newline = "\n";
	$Newline_literal = "\\n";
    }

    foreach my $m ($Context_matcher, $Context_matcher2) {
	next unless defined $m;
	eval_ "if (0 and ($m)) {}";
	$@ and die_ "bad -z context matcher: $m\n", &ee;
    }

    foreach my $code ($Code_after_open, $Code_at_end,
	    $Code_before_close, $Code_before_open, $Code_per_line) {
	next unless defined $code;
	$code =~ s/\bRETURN\b/ "; print \"$Col{filename}\$File$Col_Reset$Newline_literal\"; push \@Matched_files, \$File; return;" /eg;
	eval_ "if (0) { $code }";
	$@ and die_ "bad -P code: $code\n", &ee;
    }

    $Opts{K} = 0 if $Input_encoding;
    if ($Opts{K} and $Guess_encoding = $Env{PEG_GUESS_ENCODING}) {
	require Encode::Guess;
	eval { Encode::Guess->set_suspects(split /\s+/, $Guess_encoding) };
	$@ and die_ "bad PEG_GUESS_ENCODING: $Guess_encoding:\n", &ee;
	$Encode::Guess::NoUTFAutoGuess = 1;
    }

    $Opts{C} = 1 if ($Implicit_C and !($Opts{A} or $Opts{B}));
    $Opts{A} = $Opts{B} = 1 if $Opts{C};

    # If '-+' specified, then ignore the peg result files unless they are
    #  explicitly named on the command line eg. "*/*/peg*"
    if ($Opts{'+'}) {
	foreach my $file (@Cmdline_files) {
	    if ($file =~ /\bpeg/) {
		$Opts{'+'} = 0;
		last if $Do_globbing;
	    } elsif (!$Do_globbing) {
		$Opts{'+'} = 1;
		last;
	    }
	}
	$Opts{'+'} = 0 if (($_ = $Opt_p_expr) and /peg/);
    }

    if (@Cmdline_files) {
	# The single filename "-" indicates to read STDIN.
	if (@Cmdline_files == 1 and $Cmdline_files[0] eq '-') {
	    @Cmdline_files = ();
	}
    } elsif ($STDIN_is_terminal and !($Opts{r} or $Opts{X} or $Opt_y)) {
	warn_ "assuming -r" unless $Opt_ss;
	$Opts{r} = 1;
    }

    my ($glob_failed, $found_globbed_file);
    if ($Do_globbing) {
	my $dosglob = $Is_Win32 ? !$Env{PEG_USE_BSDGLOB} : $Env{PEG_USE_DOSGLOB};
	my ($glob, @f, @glob_results);
	foreach my $f (@Cmdline_files) {
	    if ($f =~ /\*/
		    or ($f =~ /\?/ and !($Is_Win32 and $f =~ /^[\\\/]{2}\?[^\?]+$/))
		    or (!$dosglob and $f =~ /^~|\[.*\]|\{.*\}/ and not -e $f)) {
		my $f_orig = $f;
		$f =~ s|(\*\*+)| join '/', split //, $1 |eg; # **c -> */*c
		$glob ||= do {
		    if ($dosglob) {
			require File::DosGlob;
			sub {
			    my $pat = $_[0];
			    if ($pat =~ /\s/) {
				$pat =~ s|\\|\\\\|g;
				$pat =~ s|([\s'])|\\$1|g;
			    }
			    return File::DosGlob::glob($pat);
			};
		    } else {
			require File::Glob;
			sub {
			    return File::Glob::bsd_glob($_[0]);
			};
		    }
		};
		if (@glob_results = $glob->($f)) {
		    if ($Is_Win32 and $f =~ /^\w:[^\\\/]/) {
			# Fix drive relative pathnames.
			# The pattern "D:*c" produces "D:./foo.c". Convert to "D:foo.c".
			foreach (@glob_results) { s|^(\w:)\./|$1| }
		    }
		    if ($f =~ /^(?:.*[\\\/])?\*$/) {
			# A non specific glob eg. "src/*".
			foreach my $gf (@glob_results) { $Globbed{$gf} = 1 }
		    }
		    push @f, @glob_results;
		    $found_globbed_file = 1;
		} else {
		    warn_ "glob failed to match any files for: $f_orig" unless $Opt_s;
		    $glob_failed = 1;
		}
	    } else {
		push @f, $f;
	    }
	}
	@Cmdline_files = @f;
    }

    if ($Opts{d}) {
	if ($Opts{X}) {
	    warn_ "directories in -X file list are not searched$Beep" unless $Opt_s;
	}
	my @files;
	foreach my $f (@Cmdline_files) {
	    if (-d $f) {
		$Opt_d = 1;
		if ($Is_Win32) {
		    # Fix for bug in File::Find. It strips any trailing slash
		    #  off the pathname, and since chdir 'C:/' != chdir 'C:', we
		    #  need to add an extra trailing slash to a drive root path.
		    if ($f =~ s|^(\w):[\\/]+$|$1://|) { $Fix_doubled_slashes = 1 }
		    # File::Find incorrectly names files found relative to a drive.
		    elsif ($f =~ s|^(\w:)$|$1./|) { $Fix_drive_relative = 1 }
		    # If a directory ends in a backslash, File::Find appends a forward slash.
		    elsif ($f eq "\\") { $f = '/' }
		    else { $f =~ s|(?<=[^\\])\\+$|/| }
		} else {
		    $f =~ s|(?<=[^/])/+$||;
		}
		push @Cmdline_dirs, $f;
	    } else {
		push @files, $f;
	    }
	}
	@Cmdline_files = @files;
    }

    if ($Opt_y) {
	push @Cmdline_files, last_matches();
    }

    unless (@Cmdline_files or $Opts{r} or $Opt_d or $Opts{X} or $Opt_y) {
	die_ "no files found" if $glob_failed;
	$Search_STDIN = 1;
	$Opts{a} ||= 1;
	$Opts{I} = 0;
	$Opts{_} = 0;
	$Opt_p_expr = undef;
	$Slurp = undef;
	if ($Opts{K}) {
	    warn_ "-K does not work on STDIN" unless $Opt_s;
	    $Opts{K} = 0;
	}
    }

    $Slurp = undef if $Input_record_separator;

    $Opts{_} = 0 unless ($Opts{R} and $STDOUT_is_terminal and !$Opt_s);
    $Opts{_} = 0 if (@Cmdline_files == 1 and !($Opts{r} or $Opt_d or $Opt_y or $Opts{S} or $Opts{X}));
    $Opts{_} = 0 if ($Opts{X} and $STDIN_is_terminal); # cf. "find . | peg -XR_ foo" vs "peg -XR_ foo"

    if ($Opts{J} == 2) { # -JJ reverts to "file:line" output when writing to a pipe/file
	$Opts{J} = 0 if $Opts{R} or !$STDOUT_is_terminal;
    }

    if ($Opts{H}) {
	$Opts{h} = 0;
	$Opts{J} = 0 if $Opts{J} >= 2;
    } elsif (@Cmdline_files <= 1 and !($Opt_d or $Opts{r} or $Opts{S} or $Opt_y or $Opts{X} or $found_globbed_file)) {
	$Opts{h} = 1;
	$Opts{J} = 0 if $Opts{J} >= 2;
    } elsif ($Opts{J} >= 2 and $Opts{Z}) {
	$Opts{J} = 0;
    } elsif ($Opts{J}) {
	$Opts{h} = 1;
    }

    if ($Opts{I} == 3) { # -III := -I, but -a overrides it.
	$Opts{I} = $Opts{a} ? 0 : 1;
    } elsif ($Opts{a} and $Opts{I} == 1) {
	warn_ "possible conflict between -a and -I$Beep" unless $Opt_s;
    }

    if ($Opts{S}) {
	die_ "-S needs a %Peg_S" unless %Peg_S;
	my (@archive_exts, @non_archive_exts);
	while (my ($ext, $code) = each %Peg_S) {
	    die_ "uppercase extension: $ext" if ($ext ne lc $ext);
	    die_ "\$Peg_S{'$ext'} is not a valid CODE ref"
		unless ref $Peg_S{$ext} eq 'CODE' and defined &{$Peg_S{$ext}};
	    if ($ext =~ s/^\*//) {
		push @archive_exts, $ext;
		$Peg_S{$ext} = $code;
		delete $Peg_S{"*$ext"};
	    } else {
		push @non_archive_exts, $ext;
	    }
	}
	my $gen_re = sub {
	    return unless @_;
	    return "\\.(?i)(" . (join '|', map quotemeta, sort { length($b) <=> length($a) || $a cmp $b } @_) . ")\\z";
	};
	if ($Opt_pp_expr) {
	    $Opt_pp_code = "sub pp {\n  return 1 unless \@_;\n  local \$_ = shift;\n";
	    $Opt_pp_code .= '  warn_ "V: in pp($_)";' . "\n" if $Verbose;
	    $Opt_pp_code .= "  return (($Opt_pp_expr)";
	    if (my $archive_re = $gen_re->(@archive_exts)) {
		$Opt_pp_code .= " or /$archive_re/" if $Opts{S} == 1; # -SS := no recurse
	    }
	    $Opt_pp_code .= ");\n}";
	} else {
	    $Opt_pp_code = 'sub pp { @_ ? 1 : 0 }';
	}
	eval_ $Opt_pp_code;
	$@ and die_ "bad -pp code: $Opt_pp_code\n", &ee;
	$S_handler_re = $gen_re->(keys %::Peg_S);
	$S_nonarchive_re = $gen_re->(@non_archive_exts);
	warn_ "-S cannot guess input encoding" if $Opts{K}; # XXX
    }

    if ($Opts{t}) {
	if ($Opts{r} or $Opt_d) {
	    require File::Find;
	    my @dirs = (($Opts{r} ? '.' : ()), @Cmdline_dirs);
	    eval {
		File::Find::find({ skip_dirs => 1, wanted => sub {
		    push @Cmdline_files, $File::Find::name if -f;
		}}, @dirs);
	    };
	    $@ and die_ "File::Find::find failed: ", &ee;
	    $Opts{r} = $Opt_d = 0;
	}

	# Sort command line files according to their last modification time.
	# Always do non existent files last.
	my $new_first = ($Opts{t} % 2);
	my $mt;
	@Cmdline_files = map {$_->[0]} sort {
		($new_first
		    ? ($a->[1] <=> $b->[1])
		    : ($b->[1] <=> $a->[1]))
			||
		($a->[0] cmp $b->[0])
	    } map {
		[$_, defined ($mt = -M $_) ? $mt : ($new_first ? 9e9 : -9e9)]
	    } @Cmdline_files;
    }

    # XXX On Win32, Open3 does not like a redirected STDOUT.
    if ($Opts{r} == 1 and $STDOUT_is_terminal and $Opt_r_cmd = $Env{PEG_R_CMD}) {
	$Opts{r} = 0;
    }

    if ($Opts{K}) {
	# An ASCII text lookup table: 9=tab, 10=LF, 13=CR, 32-126=isprint
	@Is_ascii_text = (undef) x 256;
	$Is_ascii_text[$_] = 1 for (9, 10, 13, 32..126);
    }

} # process_options2


sub help
{
    my $opt = shift;
    if (defined $opt) {
	$opt =~ s/^-?(.).*/$1/;
	$opt = 'A' if $opt =~ /^[BC\d]$/;
	my @out;
	while (<DATA>) {
	    if (/^=item\s+B<-\Q$opt/) {
		push @out, help_line($_, 0);
		last;
	    }
	}
	die_ "no such option '$opt'" unless @out;
	my $over = 0;
	while (<DATA>) {
	    if (/^=over/) { ++$over }
	    elsif (/^=back/) { last unless $over-- > 0 }
	    else {
		last if (/^=/ and !$over);
		push @out, help_line($_, $over);
	    }
	}
	# Strip consecutive blank lines.
	print "\n";
	my ($is_empty, $last_empty);
	while (defined ($_ = shift @out)) {
	    $is_empty = /^\s*$/;
	    print unless ($is_empty and ($last_empty or !grep /\S/, @out));
	    $last_empty = $is_empty;
	}
	print "\n";
    } elsif (-t STDOUT) {
	system "perldoc $0";
    } else {
	print `perldoc $0`;
    }
    exit;

} # help


sub help_line
{
    my ($line, $over) = @_;
    return '' if ($line =~ /^=(over|back)/);
    my $title = ($line =~ s/^=item\s+//) ? 1 : 0;
    if ($line =~ /^\S/) { # NB. indented POD is verbatim
	$line =~ s/\bB<(.+?)>/"$1"/g;                        # bold
	$line =~ s/\bI<(.+?)>/*$1*/g;                        # italic
	$line =~ s/\bC<([\$\%\@]\S*?)>/$1/g;                 # code1
	$line =~ s/\bC<(\S+?)>/"$1"/g;                       # code2
	$line =~ s/\bC<< (.+?) >>/``$1''/g;                  # code3a
	$line =~ s/\bC<(.+?)>/``$1''/g;                      # code3b
	$line =~ s/\bL<(.+?)\/(.+)>/$2 in the $1 manpage/g;  # link
	$line =~ s/\b\w<(.+?)>/$1/g;                         # other
    }
    my $indent = ' ' x (2 - $title + 2*$over);
    my @lines = ("$indent$line");
    if ($title and $line !~ /^\*$/) {
	push @lines, ($indent . ("=" x (length($line) - 1)) . "\n");
    }
    return @lines;

} # help_line


sub show_debug
{
    my $verbose = $Opts{D} > 1;
    my $i;
    if ($verbose) {
	print "# peg v$VERSION $0\n\n";
	print "# Perl version $]  $^X\n\n";
	print "# cwd => @{[ cwd() ]}\n\n";
    }
    if (@Ini_files) {
	print "# Ini files =>\n";
	foreach my $ini_file (@Ini_files) {
	    print "\t$ini_file\n";
	    next unless $verbose;
	    open(my $fin, "<", $ini_file) or ((print "open failed: $!\n"), next);
	    print " $.:\t$_" while (<$fin>);
	    print "\n";
	}
	print "\n";
    } else {
	print "# No ini files\n\n";
    }
    if ($verbose) {
	my @env = grep { /^PEG_/ and !exists $ENV{$_} } keys %Env;
	if (@env) {
	    print "# Env =>\n";
	    printf "\t%-12s = %s\n", $_, $Env{$_} for sort @env;
	    print "\n";
	}
	print "# ENV =>\n";
	printf "\t%-12s = %s\n", $_, $ENV{$_} for sort grep /^PEG_/, keys %ENV;
	print "\n";
	print "# HOME directory => $HOME_dir\n\n";
	print "# Bin directory => $Bin_dir\n\n";
	print "# STDIN is not a terminal\n\n" unless $STDIN_is_terminal;
	print "# STDOUT is not a terminal\n\n" unless $STDOUT_is_terminal;
	if ($Opts{'#'}) {
	    print "# Colors =>\n";
	    printf "\t%-12s %s<#>$Col_Reset\n", $_, $Col{$_} for sort keys %Col;
	    print "\n";
	}
	print "# \%INC =>\n";
	printf "\t%-24s => %s\n", $_, $INC{$_} for sort keys %INC;
	print "\n";
	print "# keys %Peg_S =>\n", map({"\t$_\n"} sort keys %Peg_S), "\n" if keys %Peg_S;
	my @longopts = sort grep !/^help$/, keys %Peg_longopt;
	print "# keys %Peg_longopt =>\n", map({"\t$_\n"} @longopts), "\n" if @longopts;
    }
    if (@Peg_options_ARGV) {
	$i = 0;
	print "# PEG_OPTIONS =>\n";
	print "\t", ++$i, ": ", $_, "\n" for @Peg_options_ARGV;
	print "\n";
    }
    $i = 0;
    print "# ARGV =>\n", map({("\t", ++$i, ": ", $_, "\n")} @ARGV), "\n";
    print "# Enabled options => ";
    print join '', map {$_ x $Opts{$_}} sort grep $Opts{$_}, keys %Opts;
    print "\n\n";
    print "# Reading from STDIN\n\n" if $Search_STDIN;
    print "# PEG_R_CMD => $Opt_r_cmd\n\n" if $Opt_r_cmd;
    print "# -pp code =>\n\n$Opt_pp_code\n\n" if $Opt_pp_code;
    if (@Cmdline_files) {
	print "# Command line files (@{[ scalar @Cmdline_files ]}) =>\n";
	print map {"\t$_\n"} @Cmdline_files if (@Cmdline_files < 10 or $verbose);
	print "\n";
    }
    if (@Cmdline_dirs) {
	print "# Command line directories (@{[ scalar @Cmdline_dirs ]}) =>\n";
	print map {"\t$_\n"} @Cmdline_dirs if (@Cmdline_dirs < 10 or $verbose);
	print "\n";
    }
    foreach my $v (qw(MTime_new MTime_old)) {
	my $t = eval "\$$v" or next;
	printf "# %s => %-24s %s\n\n", $v, $t, (localtime($^T - 24*60*60*$t) || '?');
    }
    print "# Internal Perl code =>\n$Search\n";
    print "# Warnings =>\n", @Warnings, $Beep, "\n" if @Warnings;
    exit;

} # show_debug


sub near
{
    @_ == 1 or @_ == 2 or die "usage: near(PATTERN|SUB ?,RANGE?)\n";
    my $arg = shift;
    my $arg_is_sub = (ref $arg eq 'CODE');
    my $N = 10;
    my $start = 0;
    if (@_) {
	my $range = shift;
	$range =~ /^(!)?(\d+|\*)$/ or die "bad RANGE argument to near(): $range\n";
	$start = 1 if $1;
	$N = ($2 eq '*') ? @P : $2;
    }
    $N = @P if $N > @P;
    my ($line, $matched);
    eval {
	for (my $i = $start; $i <= $N; ++$i) {
	    $line = ($i == 0) ? $_ : $P[-$i]; # NB. $_ is the current line
	    if ($arg_is_sub) {
		local $_ = $line;
		$matched = $arg->();
	    } else {
		$matched = ($line =~ /$arg/);
	    }
	    last if $matched;
	}
    };
    $@ and die "error in near():\n", &ee;
    return $matched ? 1 : 0;

} # near


{
    my %regexps;

    sub nearby
    {
	my $N = 10;
	if (@_ and ref($_[0]) eq 'SCALAR') { $N = ${ +shift } }
	@_ >= 2 or die "usage: nearby(?\\N,? PAT1, PAT2 ...)\n";
	my ($i, $j, $regexp, @regexps);
	foreach my $pat (@_) {
	    eval { push @regexps, ($regexps{$pat} ||= qr/$pat/) };
	    $@ and die "error in nearby pattern: $pat\n", &ee;
	}
	my $match_idx = -1;
	for ($i = 0; $i < @regexps; ++$i) {
	    $regexp = $regexps[$i];
	    if ($_ =~ /$regexp/) { # NB. $_ is the current line
		return 1 if ($match_idx != -1);
		$match_idx = $i;
	    }
	}
	return 0 if $match_idx == -1;
	$N = @P if $N > @P;
	for ($i = 0; $i < @regexps; ++$i) {
	    next if $i == $match_idx;
	    $regexp = $regexps[$i];
	    for ($j = 1; $j <= $N; ++$j) {
		return 1 if ($P[-$j] =~ /$regexp/);
	    }
	}
	return 0;

    } # nearby
}


sub colorall
{
    my $pattern = shift;
    die "usage: colorall(PATTERN ?,COLOR_DEFINITION?)" unless length $pattern;
    my $match_col = $Col{match};
    if (@_) {
	my $col_def = shift;
	unless (exists $Col{$col_def}) {
	    eval { $Col{$col_def} = get_col($col_def) };
	    $@ and die "colorall: bad color '$col_def'\n";
	}
	$match_col = $Col{$col_def};
    }
    my $matches = 0 + eval {
	s/($pattern)/ $match_col . $1 . $Col{nonmatch} /eg;
    };
    $@ and die "error in colorall:\n", &ee;
    return $matches;

} # colorall


sub Z_display
{
    my $file = shift;
    unless (defined $Z) {
	warn_ +(defined $file ? "$file: " : ()), "\$Z is not defined" unless $Opt_s;
	return;
    }
    my $file_colon = '';
    if (defined $file) {
	if ($Opts{J}) {
	    print header($file);
	} else {
	    $file_colon = $Col{filename} . $file . $Col{colon} . ':' . $Col_Reset;
	}
    }

    if ($Opts{Z} >= 3 and $Opts{Z} <= 4) {
	require Data::Dumper;
	print $file_colon, "\n" if $file_colon;
	print Data::Dumper->Dump([$Z], ['Z']), "\n";
    }
    elsif (ref($Z) eq 'HASH') {
	my $numeric_cmp = 1;
	foreach my $v (values %$Z) {
	    unless (defined $v and $v =~ /^[+-]?(?:\d+(?:\.\d*)?|\.\d+)(?:[eE][+-]?\d+)?$/) {
		$numeric_cmp = 0;
		last;
	    }
	}
	# -ZZZZZ := -Z but do not numerically sort the keys.
	my @keys = ($numeric_cmp and $Opts{Z} <= 2)
	    ? (sort { $Z->{$b} <=> $Z->{$a} || $a cmp $b } keys %$Z)
	    : (sort keys %$Z);
	my $sep = ($Opts{T} ? "\t=> " : " => ");
	print $file_colon, "\n" if $file_colon;
	foreach my $key (@keys) {
	    my $v = $Z->{$key};
	    chomp_ $key;
	    chomp_ $v;
	    print $key, (defined $v ? "$sep$v" : ()), "\n";
	}
    }
    elsif (ref($Z) eq 'ARRAY') {
	print $file_colon, "\n" if $file_colon;
	foreach my $v (@$Z) {
	    chomp_ $v;
	    print $v, "\n";
	}
    }
    else {
	chomp_ $Z;
	print $file_colon, $Z, "\n";
    }

} # Z_display


sub build_search
{
    my ($gap, $nonmatch_print, $output, $print);
    my $context = ($Opts{A} || $Opts{B} || $Opts{C});

    $Opt_m ||= 0; # undef -> 0

    if ($Opts{c} or $Opts{k} or $Opts{L} or $Opts{Z}) {
	$output = undef;
    }
    elsif ($Opts{l} or $Opts{O}) {
	$output = '"';
	$output .= "$Col{lineno}\@{[scalar \@Matched_files]}$Col_Reset\\t" if $Opts{n};
	$output .= '$File' . ($Opts{l} > 1 ? '\0' : '\n') . '"';
    }
    else {
	$output = '';
	$output = "\$Offset:" if $Opts{b};
	$output = "\$.:$output" if $Opts{n};
	$output = "\$File:$output" if !$Opts{h};
	$output = "\"$output\$_\"" if $output;
    }

    if (defined $output) {
	$print = 'print' . ($output ? " $output" : '') . ';';
	$print .= ' last;' if ($Opts{l} or $Opts{O});
    }
    if ($context) {
	$output ||= '$_';
	$gap = ($Opts{A} ? $After : 0) + ($Opts{B} ? $Before : 0);
	($nonmatch_print = $print) =~ s/:/-/g;
	$output =~ s/:/-/g;
	$Perlexpr = "(\$Matches < $Max_matches) && ($Perlexpr)" if $Opt_m;
    }

    if ($Opts{T}) {
	my $sep = $Col_Reset . "\\t";
	foreach ($output, $print, $nonmatch_print) {
	    defined and s/^(.*[:\-])/$1$sep/;
	}
    }

    # Are any of the AUTOVARS used?
    my ($needs_reset, $uses_C, $uses_F, $uses_Filepath, $uses_P, $uses_S);
    foreach my $code ($Perlexpr, $Code_per_line) {
	next unless defined $code;
	$uses_C ||= ($code =~ /\$C\b/);
	$uses_F ||= ($code =~ /\$F\[|\@F\b/);
	$uses_P ||= ($code =~ /\bnear(?:by)?\(|\$P\[|\@P\b/);
	$uses_S ||= ($code =~ /\$S[\[\{]|[\@%]S\b/);
    }
    foreach my $code ($Code_after_open, $Code_before_close, $Code_before_open,
	    $Code_per_line, $Opt_p_expr, $Perlexpr) {
	next unless defined $code;
	$uses_Filepath ||= ($code =~ /\$Filepath\b/);
	$needs_reset   ||= ($code =~ /[\$\@\%][a-z]/);
    }

    if ($uses_C and !$Context_matcher) {
	warn_ "\$C requires -z option$Beep" unless $Opt_s;
	$uses_C = undef;
    } elsif (!($uses_C or $Print_context_matcher)) {
	$Context_matcher = undef;
    }

    if ($Opts{'#'}) {
	foreach ($output, $print, $nonmatch_print) {
	    next unless defined;
	    s|\$File\\([n0])|$Col{filename}\$File$Col_Reset\\$1|
		or
	    s|\$File|$Col{filename}\$File|;
	    s|\$\.|$Col{lineno}\$.|;
	    s|\$Offset|$Col{offset}\$Offset|;
	    s|([:\-])|$Col{colon}$1|g;
	}
	for ($output) {
	    last unless defined;
	    if (!length $_) { $_ = '$_' }
	    s|^\$_$|"$Col{nonmatch}\$_$Col_Reset"|
		or
	    s|\$_|$Col{nonmatch}\$_$Col_Reset|;
	}
	for ($print) {
	    last unless defined;
	    last if ($Opts{k} or $Opts{l} or $Opts{L} or $Opts{O});
	    s|;$||g;
	    my $orig_print = $_;
	    my $ensure_newline = !$Opts{N} ? '' : ($Perlexpr =~ /\bcolorall\b/)
		? q[, (/\n(?:\Q] . $Col_Reset . q[\E)?\z/ ? () : "\n")]
		: q[, (/\n\z/ ? () : "\n")];
	    my $cl = "$Col{nonmatch}\$`$Col{match}\$&$Col{nonmatch}\$'$Col_Reset";
	    s|\$_|$cl|
		or
	    s|^print$|print "$cl"|;
	    if ($Simple_Perlexpr) {
		$_ .= $ensure_newline . ';';
	    } else {
		# Fix the case where $`$&$' is not the same as $_ eg. peg -# "/(...)/ and $_=$1"
		$orig_print =~ s|^print$|print "$Col{nonmatch}\$_$Col_Reset"|
		    or
		$orig_print =~ s|\$_|$Col{nonmatch}\$_$Col_Reset|;
		$_ = q{($_ eq "$`$&$'")} . "\n\t? ($_$ensure_newline)\n\t: ($orig_print$ensure_newline);";
	    }
	}
	for ($nonmatch_print) {
	    last unless defined;
	    my $ncl = "$Col{nonmatch}\$_$Col_Reset";
	    s|\$_|$ncl|
		or
	    s|print(;?)$|print "$ncl"$1|;
	}
	# Remove redundant color resets:
	foreach ($output, $print, $nonmatch_print) {
	    next unless defined;
	    while (s|(\Q$Col_Reset\E[\$\.\:\-\w\s]*)\Q$Col_Reset\E|$1|) {}
	    s/\"\Q$Col_Reset\E/\"/;
	}
    }

    $Count = $Matches = 0;
    my $Opt_B = ($Opts{B} and $Before > 0);
    my $print_header = ($Opts{J} and !$Opts{Z});
    my $use_First = ($print_header or $context or !($Opts{L} or $Opts{k}));
    my ($Opt_b_hex, $Opt_b_unixoffset);
    if ($Opts{b}) {
	# -bbb[b] reverses PEG_B_HEX setting.
	$Opt_b_unixoffset = (!($Opts{b} % 2) and !($Opts{K} or $Input_encoding));
	$Opt_b_hex = (($Opts{b} <= 2 and $Env{PEG_B_HEX}) or ($Opts{b} >= 3 and !$Env{PEG_B_HEX}));
    }
    my $assign_Offset = '$Offset = ' . ($Opt_b_hex ? 'sprintf "%#x", ' : '') . 'tell(F)' . ($Opt_b_unixoffset ? ' - $CRs' : '') . ';';
    my $fix_newline = 's/\015?[\012\015]\z//; $_ .= "\n";';
    my $context_format = $Env{PEG_CONTEXT_FORMAT};
    my $Col_File = $Col{filename} . '$File' . $Col_Reset;
    # The context matching code's circular buffer method does not work when
    # multiple lines are treated as one eg. if $Code_per_line merges backslashed
    # lines into one, then the sequence of $.'s muddles $Before[$. % $Before]
    # So provide a mechanism to force the use of v1's safe (but slow) push/shift stack method.
    my $safe_before_context = ($Opt_B and ($_ = $Code_per_line) and /\# PEG_SAFE_BEFORE_CONTEXT/);
    # "peg -l +1 ..." is a special case. It skips reading the file.
    my $plus_one = ($Opts{l} and $Perlexpr eq '+1');
    my $needs_Binary_file = (($Opts{I} || !($Opts{a} || $Opts{c} || $Opts{l} || $Opts{L} || $Opts{Z})) && !$plus_one);
    my ($sysread_slurp, $irs_slurp, $quick_no_match_test);
    if ($Slurp and !$plus_one) {
	if ($Opts{k} or $Opts{l} or $Opts{L} or $Opts{O}) {
	    if ($Opts{K} or $Input_encoding) {
		$irs_slurp = 1;
	    } else {
		$sysread_slurp = 1;
	    }
	} elsif (!($Opts{K} or $Input_encoding or $Opts{a} > 1)) {
	    $quick_no_match_test = 1;
	}
    }
    my $qfind_only = (($_ = $Opt_r_cmd) and /qfind/ and !(@Cmdline_files or $Opt_d or $Opts{X}));

    $Search  = "sub search {\n";
    $Search .= "  warn_ \"V: in search()\";\n" if $Verbose;
    $Search .= "  local \$/ = $Input_record_separator;\n" if $Input_record_separator;
    if ($Opts{S}) {
	$Search .= "  if (defined \$S_FILE) {\n";
	$Search .= "    \$File = \$S_FILE;\n    \$S_FILE = undef;\n";
	$Search .= "    warn_ \"V: called via S() File=\$File\";\n" if $Verbose;
	$Search .= '    $Filepath = $File;' . "\n" if $uses_Filepath;
	$Search .= "    \$_ = \$File; return unless ($Opt_pp_expr);\n" if $Opt_pp_expr;
	$Search .= "    *F = \$S_F;\n";
	if ($Input_encoding) {
	    my $layer = ":encoding($Input_encoding)";
	    $layer = ":raw:perlio$layer" if ($Is_Win32 and $Opts{b}); # XXX workaround :crlf & tell() bug
	    $Search .= "    binmode F, '$layer'\n      or (" . ($Opt_s ? '' : "(warn_ \"binmode '$layer' failed: \$!\"), ") . "return);\n";
	}
	$Search .= "    show_progress(\$File);\n" if $Opts{_};
	$Search .= "    goto process_file;\n";
	$Search .= "  }\n";
    }
####$Search .= q{ print "DBG: _=$_\tF:F:n=$File::Find::name", (0 ? "\tF:F:d=$File::Find::dir\n" : ()) ,"\n";} . "\n";
####$Search .= q{ print "DBG: cwd=", cwd(), "\n";} . "\n";
    if ($Opts{'+'}) {
	$Search .= "  return if (/\\bpeg_\\d+\\.txt\\z/);\n";
    } elsif ($Opts{R}) {
	$Search .= "  return if (/\\b@{[ quotemeta $R_file ]}\\z/);\n";
    }
    $Search .= '  $File = $File::Find::name;' . "\n";
    $Search .= "  warn_ \"V: File=\$File\";\n" if $Verbose;
    unless ($qfind_only) {
	$Search .= '  $File =~ s|^\.' . ($Is_Win32 ? "[/\\\\]" : '/') . '||;' . "\n";
	$Search .= '  $_    =~ s|^\.' . ($Is_Win32 ? "[/\\\\]" : '/') . '||;' . "\n"; # Needed on Win32 for almost "too long" filenames.
    }
    $Search .= '  $File =~ s|(?<=.)//+|/|;' . "\n" if $Fix_doubled_slashes;
    $Search .= '  $File =~ s|^(\w:)\./|$1|;' . "\n" if $Fix_drive_relative;
    $Search .= '  $File =~ s|/|\\\\|g;' . "\n" if $Opts{"\\"} == 1;
    $Search .= '  $File =~ s|\\\\|/|g;' . "\n" if $Opts{"\\"} == 2;
    $Search .= '  $Filepath = $_;' . "\n" if $uses_Filepath;
    $Search .= "  show_progress(\$File);\n" if $Opts{_};
    # cf. "peg -S -p .zip foobar". The -p should only apply to files on the
    # filesystem and not to files within the zip archives.
    $Search .= "  warn_ \"V: applying -p test\";\n" if ($Verbose and ($Opt_p_expr or $Opt_pp_expr));
    if ($Opt_p_expr) {
	if ($Opts{S}) {
	    if ($Opt_pp_expr) {
		$Search .= "  return unless (\$Inside_archive ? ($Opt_pp_expr) : ($Opt_p_expr));\n";
	    } else {
		$Search .= "  return unless (\$Inside_archive or ($Opt_p_expr));\n";
	    }
	} else {
	    $Search .= "  return unless ($Opt_p_expr);\n";
	}
    } elsif ($Opt_pp_expr) {
	$Search .= "  return unless (!\$Inside_archive or ($Opt_pp_expr));\n";
    }
    if ($MTime_new or $MTime_old) {
	# Allow non existant files to trigger "can't open" error.
	$Search .= "  warn_ \"V: applying -M test\";\n" if $Verbose;
	$Search .= "  \$MTime = -M \$_;\n  return unless (";
	$Search .= '$Inside_archive or ' if $Opts{S};
	$Search .= $plus_one ? 'defined $MTime and ' : '!defined $MTime or ';
	if (!$MTime_old) {
	    $MTime_new = $MTime_new->[0];
	    $Search .= "\$MTime <= \$MTime_new);\n";
	} elsif (!$MTime_new) {
	    $MTime_old = $MTime_old->[0] - $MTime_old->[1];
	    $Search .= "\$MTime >= \$MTime_old);\n";
	} else {
	    if ($MTime_new->[0] > $MTime_old->[0]) { # Ensure range makes sense.
		($MTime_new, $MTime_old) = ($MTime_old, $MTime_new);
	    }
	    $MTime_new = $MTime_new->[0] - $MTime_new->[1];
	    $MTime_old = $MTime_old->[0];
	    $Search .= "(\$MTime >= \$MTime_new and \$MTime <= \$MTime_old));\n";
	}
    }
    $Search .= "  ++\$Total_files;\n" if $Opts{'%'};
    if ($Opts{S}) {
	$Search .= "  if (-f \$_ and \$File =~ /$S_handler_re/) {\n";
	$Search .= '    my $ext = lc $1;' . "\n";
	$Search .= "    warn_ \"V: calling '\$ext' -S handler\";\n" if $Verbose;
	$Search .= '    my $ok = eval { $Peg_S{$ext}->($_, $File) };' . "\n";
	$Search .= '    $@ and die_ "-S handler error: $File\n$@";' . "\n";
	$Search .= '    return if $ok;' . "\n";
	$Search .= "    warn_ \"V: -S handler returned false - continuing search\";\n" if $Verbose;
	$Search .= "  }\n";
	$Search .= "  return unless ($Opt_pp_expr);\n" if $Opt_pp_expr;
    }
    if ($plus_one) {
	$Search .= "  return unless -f \$_;\n" unless ($qfind_only or $Opts{S}); # "peg -l +1 *" should not show directory names
	$Search .= "  $Code_before_open;\n" if $Code_before_open;
	$Search .= "  push \@Matched_files, \$File;\n";
	$Search .= "  print \"" . ($Opts{n} ? "$Col{lineno}\@{[scalar \@Matched_files]}$Col_Reset\\t" : '') . "$Col_File\\" . ($Opts{l} > 1 ? '0' : 'n') . "\";\n";
	$Search .= "  return;\n\n";
    }
    $Search .= "  $Code_before_open;\n" if ($Code_before_open and !$plus_one);
    $Search .= "  warn_ \"V: open'ing file\";\n" if $Verbose;
    if ($Search_STDIN) {
	$Search .= '  open(F, "<-") or die_ "cannot open STDIN: $!";' . "\n";
	if ($Input_encoding) { # NB. doesn't handle BOMs
	    $Search .= "  binmode(F, ':encoding($Input_encoding)') or die_ \"failed to apply $Input_encoding encoding layer to STDIN: \$!\";\n";
	} elsif ($Is_Win32) {
	    $Search .= "  binmode F;\n";
	}
    } else {
	# Do not check for a directory and then skip the open as we must still
	#  allow for "peg x a_directory" to at least try to read it (sometimes can).
	# On systems that perform filename globbing there is the dilemma of whether
	#  to warn about not being able to open a directory. There are two distinct
	#  use cases: "peg x *" (no warning is preferable) and "peg x afile adir"
	#  (a warning is preferable). The compromise solution is to warn unless -ss.
	my $warn_on_failed_open_code = '';
	if ($Opt_r_cmd or $Opts{r} or $Opt_d or $Opts{X} or (!$Do_globbing and $Opt_ss)) {
	    $warn_on_failed_open_code = '-d $_ or '; # cf. "find . | peg -X foo"
	} elsif (%Globbed) {
	    $warn_on_failed_open_code = '(exists $Globbed{$File} and -d $_) or '; # cf. "peg main *" vs "peg main *c"
	}
	if ($Opts{K}) {
	    $Search .= '  *F = magic_open($_, $File)';
	} else {
	    my $layer = '';
	    if ($Input_encoding) {
		$layer = ":encoding($Input_encoding)";
		$layer = ":raw:perlio$layer" if ($Is_Win32 and $Opts{b}); # XXX workaround :crlf & tell() bug
	    }
	    $Search .= '  open(F, "<' . $layer . '", $_)';
	}
	$Search .= $Opt_s ? " || return;\n"
	    : "\n    || ((${warn_on_failed_open_code}print STDERR \"peg: can't open \$File: \$!\\n\"), return);\n";
	if ($Is_Win32 and !($Opts{K} or $Input_encoding or ($_ = $Input_record_separator and /\\n/))) {
	    $Search .= "  binmode F;\n";
	}
    }
    # Stop if the output channel goes eg. if running thro' a pager which quits:
    $Search .= "  print '' or goto done;\n" unless ($STDOUT_is_terminal or $Opts{R});
    # NB. need to local-ise $/ if there are any outer readline()s ie. <R_CMD_OUT> or -X's <STDIN>.
    $Search .= '  ' . (($Opt_r_cmd or $Opts{X}) ? 'local ' : '') . '$/ = (-s F < ' . $Slurp_maxsize . ') ? undef : "\n";' . "\n" if $irs_slurp;
    $Search .= "  \$Size = -s F;\n  \$Slurp = (\$Size < $Slurp_maxsize);\n" if $sysread_slurp;
    if ($Opts{S}) {
	$Search .= "process_file:\n";
	$Search .= '  $File =~ s|/|\\\\|g;' . "\n" if $Opts{"\\"} == 1;
	$Search .= '  $File =~ s|\\\\|/|g;' . "\n" if $Opts{"\\"} == 2;
    }
    if ($needs_Binary_file) {
	$Search .= "  eval { \$Binary_file = -B F };\n";
	$Search .= '  $@ && (' . ($Opt_s ? '' : '(print STDERR "peg: error reading $File: ", &ee), ') . 'close(F), return);' . "\n";
	$Search .= '  warn_ "V: file is ", ($Binary_file ? "" : "not "), "binary";' . "\n" if $Verbose;
	$Search .= '  $Binary_file ' . ($Opts{I} == 1 ? '&&' : '||') . " (close(F), return);\n" if $Opts{I};
    }
    $Search .= "  reset 'a-z';\n" if $needs_reset;
    $Search .= "  \$After = $After;\n" if $Opts{A};
    $Search .= "  \@Before = ();\n" if $Opt_B;
    $Search .= "  \$C = undef;\n" if $uses_C;
    $Search .= "  \$Context_line = undef;\n" if $Context_matcher;
    $Search .= "  \$Context_line2 = undef;\n" if $Context_matcher2;
    $Search .= "  \$Count = 0;\n" if ($Opts{c} == 1 or $Opts{c} >= 3);
    $Search .= "  \$Matches = 0;\n" if $Opt_m == 1;
    $Search .= "  \$CRs = 0;\n" if $Opt_b_unixoffset;
    $Search .= "  \$First = 1;\n" if $use_First;
    $Search .= "  \$Found = 0;\n" if $Opts{L};
    $Search .= '  ' . join("\n\t= ", map {"\$Match$_"} (0..$#Perlexpr)) . " = 0;\n" if (($Opts{k} and @Perlexpr) or $Opts{O});
    $Search .= "  \$Match_failed = 0;\n" if $Opts{k};
    $Search .= "  \@P = ();\n" if $uses_P;
    $Search .= "  \%S = ();\n" if $uses_S;
    $Search .= "  undef \$Z;\n" if ($Opts{Z} % 2);
    $Search .= "  $Code_after_open;\n" if $Code_after_open;
####$Search .= '  print "DBG: $File: ", (join ", ", PerlIO::get_layers(\*F, details => 1)), " pos=", tell(F), "\n";' . "\n";
    $Search .= " eval {\n";
    if ($quick_no_match_test) {
	# This is an optimisation based on the assumption that most files do not match.
	$Search .= "  warn_ \"V: doing quick match test\";\n" if $Verbose;
	$Search .= "  \$Size = -s F;\n";
	$Search .= "  if (\$Size < $Slurp_maxsize) {\n";
	# NB. return's below jump to end of enclosing eval block.
	$Search .= '    sysseek(F, 0, 0)     or (' . ($Opt_s ? '' : q{(print STDERR "peg: sysseek failed $File: $!\n"), }) . 'return);' . "\n" if $needs_Binary_file;
	$Search .= '    $Bytes_read = sysread(F, $_, $Size);' . "\n";
	$Search .= '    defined $Bytes_read  or (' . ($Opt_s ? '' : q{(print STDERR "peg: sysread failed $File: $!\n"), }) . 'return);' . "\n";
	$Search .= '    $Bytes_read == $Size or (' . ($Opt_s ? '' : q{(print STDERR "peg: slurp failed $File\n"), }) . 'return);' . "\n";
	$Search .= "    return unless ($Perlexpr);\n";
	$Search .= '    seek(F, 0, 0)        or (' . ($Opt_s ? '' : q{(print STDERR "peg: sysseek failed $File: $!\n"), }) . 'return);' . "\n";
	$Search .= "  }\n";
    }
    $Search .= "  $assign_Offset\n" if $Opts{b};
    $Search .= "  warn_ \"V: reading file\";\n" if $Verbose;
    # Reading a file using a single sysread is quicker than using "$/=undef".
    if ($sysread_slurp) {
	$Search .= "  while (1) {\n";
	$Search .= "   if (\$Slurp) {\n";
	$Search .= '    last if $Slurp == -1; $Slurp = -1;' . "\n";
	$Search .= '    sysseek(F, 0, 0)     or (' . ($Opt_s ? '' : q{(print STDERR "peg: sysseek failed $File: $!\n"), }) . 'last);' . "\n" if $needs_Binary_file;
	$Search .= '    $Bytes_read = sysread(F, $_, $Size);' . "\n";
	$Search .= '    defined $Bytes_read  or (' . ($Opt_s ? '' : q{(print STDERR "peg: sysread failed $File: $!\n"), }) . 'last);' . "\n";
	$Search .= '    $Bytes_read == $Size or (' . ($Opt_s ? '' : q{(print STDERR "peg: slurp failed $File\n"), }) . 'last);' . "\n";
	$Search .= "   } else {\n";
	$Search .= '    $_ = readline(*F);' . "\n";
	$Search .= '    last unless defined;' . "\n";
	$Search .= "   }\n";
    } else {
	$Search .= "  while (<F>) {\n";
    }
    $Search .= "    \$CRs += tr/\\015/\\015/;\n" if $Opt_b_unixoffset;
    $Search .= "    s/\\015?[\\012\\015]\\z/\\n/;\n" if ($CRLF_to_newline and !$Input_record_separator);
    # Handling "-/ INPUT_RECORD_SEPARATOR" needs special newline handling:
    #  1. peg -/ "qq(\r)" "/\w$/" macfile.txt -- the $ matches \n's NOT $/'s!
    #  2. peg -/ "'<'" /=/ foo.xml -- the 'lines' may contain multiple internal newline. Need to fix all of them not just a trailing one.
    $Search .= "   s/(?:\\015\\012|\\012|\\015)/\\n/g; $fix_newline\n" if $Input_record_separator;
####$Search .= q<    print "DBG: ", join ' ', unpack("C*", $_), "\n"; next;> . "\n";
    $Search .= "    ++\$Total_lines;\n" if $Opts{'%'};
    if ($Opts{a} > 1) {
	# 1. fix utf16 strings of ASCII chars
	# 2. remove unprintable characters
	$Search .= '    s/((?:\0[[:print:]\t\n\r]){2,})/ my $Str = $1; $Str =~ s|\0+||g; $Str /eg;' . "\n";
	$Search .= '    s/[^[:print:]\t\n\r]+/ /g;' . "\n";
    }
    $Search .= "    \$P = \$_;\n" if ($uses_P or $Opts{W});
    if ($Context_matcher) {
	my $needs_local; # if the context matching code modifies $_.
	# Provide buyout from expensive "local $_ = $_" if context matcher:
	#  a) modifies $_ in order to change the context line, AND
	#  b) does not care that this will be used by PERLEXPR.
	unless ($Context_matcher =~ /\# PEG_FAST_Z_CONTEXT/) {
	    foreach my $code ($Context_matcher, $Context_matcher2) {
		next unless defined $code;
		if ($code =~ /\$_\s*\.?=[^~]/) {
		    $needs_local = 1; last;
		}
		# Allow "$var =~ s/foo/bar/", but not a $_ modifiying "s/foo/bar/".
		while ($code =~ /(.*?)\bs\//g) {
		    unless ($1 =~ /\$(?:_\w+|[a-zA-Z]\w*)\s*=~\s*\z/) {
			$needs_local = 1; last;
		    }
		}
	    }
	}
	$Search .= "   {local \$_ = \$_;\n" if $needs_local;
	$Search .= "    if ($Context_matcher) {\n";
	$Search .= "      \$C = \$_;\n" if $uses_C;
	if ($context_format) {
	    $Search .= "      \$Context_line = \"$Col{z_context}$context_format$Col_Reset\";\n";
	} else {
	    # Optimisation: avoid possibly unnecesary string concatenation.
	    $Search .= "      \$Context_line = \$_;\n";
	    $Search .= "      \$Context_lineno = \$.;\n";
	}
	$Search .= "    }\n";
	if ($Context_matcher2) {
	    my $context_format2 = (($_ = $Env{PEG_CONTEXT_FORMAT2}) ? $_ : '++++ ($.) $_');
	    $Search .= "    if ($Context_matcher2) {\n";
	    $Search .= "      \$Context_line = undef;\n";
	    $Search .= "      \$Context_line2 = \"$Col{z_context2}$context_format2$Col_Reset\";\n";
	    $Search .= "    }\n";
	}
	$Search .= "   }\n" if $needs_local;
    }
    $Search .= "    \@F = split;\n" if $uses_F;
    $Search .= '    @S = (); while (/(\w+)/g) { push @S, $1; ++$S{$1} };' . "\n" if $uses_S;
    $Search .= "    $Code_per_line;\n" if $Code_per_line;
    $Search .= "    shift \@Before if (\@Before > $Before);\n" if $safe_before_context;
    # Need to clear $& to avoid possible false coloring of a matched line where $& is due to the context match and not PERLEXPR.
    $Search .= "    ' ' =~ /./;\n" if ($Opts{'#'} and ($Context_matcher or $Code_per_line) and !$Simple_Perlexpr);
    $Search .= "    study;\n" if ((@Perlexpr + @Perlexpr_k) >= 20);
    if ($Opts{W}) {
	$Search .= "    \$Matched = ($Perlexpr) ? 1 : 0;\n";
	$Search .= "    \$_ = \$P;\n";
	$Search .= "    if (\$Matched) {\n";
    } else {
	$Search .= "    if ($Perlexpr) {\n";
    }
    $Search .= "      next;\n" if $Opts{k};
    unless ($Opts{L}) {
	$Search .= "      exit;\n" if $Opts{q};
	$Search .= '      $First && push @Matched_files, $File;' . "\n";
    }
    $Search .= "      \$Binary_file && ((print \"Binary file $Col_File matches$Newline_literal\"), last);\n" unless ($Opts{a} or $Opts{c} or ($Opts{I} == 1) or $Opts{l} or $Opts{L} or $Opts{Z});
    $Search .= "      $fix_newline\n" if ($Opts{N} and !$Opts{'#'});
    $Search .= "      ++\$Count;\n" if $Opts{c};
    $Search .= "      ++\$Matches;\n" if $Opt_m;
    $Search .= "      \$Found = 1;\n      last;\n" if $Opts{L};
    $Search .= "      print " . ($Opts{J} == 1 ? 'header($File)' : "\"$Col_File$Newline_literal\"") . " if \$First;\n" if $print_header;
    $Search .= "      print \"--$Newline_literal\" if (" . ($Opts{J} ? '(!$First && ' : '$Total_matched++ && ($First || ') . "(\$After > $gap)));\n" if $context;
    if ($Print_context_matcher) {
	$Search .= "      if (defined \$Context_line2) { print \$Context_line2; \$Context_line2 = undef; }\n" if $Context_matcher2;
	$Search .= "      if (defined \$Context_line) {\n";
	if ($context_format) {
	    $Search .= "        print \$Context_line;\n";
	} else {
	    $Search .= "        print \"$Col{z_context}**** (\$Context_lineno) \$Context_line$Col_Reset\";\n";
	}
	$Search .= "        \$Context_line = undef;\n";
	$Search .= "      }\n";
    }
    $Search .= $safe_before_context
	? "      print \@Before;\n"
	: "      print grep defined, \@Before[(\$. % $Before)..@{[$Before-1]}, 0..((\$. % $Before)-1)];\n" if $Opt_B;
    $Search .= "      $print\n" if $print;
    $Search .= "      " . ($Opt_m == 1 ? 'last' : 'goto done') . " if \$Matches >= $Max_matches;\n" if ($Opt_m and !$context);
    $Search .= "      \$After = 0;\n" if $context;
    $Search .= "      \@Before = ();\n" if $Opt_B;
    $Search .= "      \$First = 0;\n" if $use_First;
    $Search .= "    }\n";
    $Search .= "    elsif (++\$After <= $After) {\n" if $Opts{A};
    $Search .= "      $fix_newline\n" if ($Opts{A} and $Opts{N});
    $Search .= "      $nonmatch_print\n    }\n" if $Opts{A};
    $Search .= "    else {\n" if ($Opts{B} or ($context and $Opt_m));
    $Search .= "      " . ($Opt_m > 1 ? 'goto done' : 'last') . " if (\$Matches >= $Max_matches);\n" if ($Opt_m and $context);
    $Search .= "      ++\$After;\n" if (!$Opts{A} and $Opts{B});
    $Search .= "      $fix_newline\n" if ($Opt_B and $Opts{N});
    $Search .= $safe_before_context
	? "      push \@Before, $output;\n"
	: "      \$Before[\$. % $Before] = $output;\n" if $Opt_B;
    $Search .= "    }\n" if ($Opts{B} or ($context and $Opt_m));
    $Search .= "    $assign_Offset\n" if $Opts{b};
    $Search .= "    push \@P, \$P;\n" if $uses_P;
    $Search .= "  }\n";
    # NB. in the event of an exception, we can't print $_ as it's contents may trigger another exception in the output IO!
    $Search .= ' };' . ($Opt_s ? '' : ' $@ && ((print STDERR "\npeg: error at line $. of $File:\n", &ee), exit(2));') . "\n";
    $Search .= '  $Total_bytes += ' . (($sysread_slurp or $quick_no_match_test) ? '$Size' : 'tell(F)') . ";\n" if $Opts{'%'};
    $Search .= "  $Code_before_close;\n" if $Code_before_close;
    $Search .= "  close(F);\n" unless $Search_STDIN;
    $Search .= "  goto done if (\$Matches >= $Max_matches);\n" if ($context and $Opt_m > 1);
    if ($Opts{k}) {
	$Search .= "  if (!\$Match_failed" . join("",
	    map({"\n\t&& \$Match$_"} (0..$#Perlexpr))) . ") {\n";
	$Search .= "    exit;\n" if $Opts{q};
	$Search .= "    print \"$Col_File\\n\";\n";
	$Search .= "    push \@Matched_files, \$File;\n";
	$Search .= "  }\n";
    }
    if ($Opts{c} == 1 or $Opts{c} >= 3) {
	$Search .= '  print "' . ($Opts{h} ? '' : "$Col_File$Col{colon}:$Col_Reset") . "\$Count$Newline_literal\"";
	$Search .= " if \$Count" if ($Opts{c} >= 3);
	$Search .= ";\n";
    }
    $Search .= "  Z_display(" . ((!$Opts{h} or $Opts{J}) ? '$File' : '') . ");\n" if ($Opts{Z} % 2);
    if ($Opts{L}) {
	$Search .= "  unless (\$Found) {\n";
	$Search .= "    exit;\n" if $Opts{q};
	$Search .= "    print \"$Col_File\\n\";\n";
	$Search .= "    push \@Matched_files, \$File;\n";
	$Search .= "  }\n";
    }
    $Search .= '  warn_ "V: done search()\n\n";' . "\n" if $Verbose;
    $Search .= "}\n";

    # Make the search() code visible to DProf/SmallProf etc.
    if (grep /Devel/, keys %INC) {
	my $file = "__peg_search.pl";
	open my $fout, ">", $file or die;
	print $fout $Search, "1;\n";
	close $fout;
	eval { require $file };
	unlink $file;
    } else {
	eval_ $Search;
    }

    $@ and die_ "internal error:\n", @Warnings, &ee, "\n...while eval'ing:\n$Search";

} # build_search


sub header
{
    my $file = shift;
    my $border = $Newline . $Col{colon} . (":" x (6 + length($file))) . $Col_Reset . $Newline;
    my $cc = $Col{colon} . "::" . $Col_Reset;
    return $border . $cc . " " . $Col{filename} . $file . $Col_Reset . " " . $cc . $border . $Newline;

} # header


# magic_open() - attempt to open a file using the 'correct' encoding.
#
# Ensure there is no :crlf layer on the filehandle.
#  1. We want the CRs.
#  2. The :crlf layer interferes badly with encodings. For example,
#     tell()'s result on "<:encoding(utf16le):crlf" filehandles
#     are not aligned to the original file's bytes.
#
sub magic_open
{
    my ($file, $fullpath) = @_;
    # Open the file for reading *binary*, but ensure no :crlf layer.
    open(my $fh, "<:raw:perlio", $file) or return;

    my $len = read($fh, my $data, 8);
    return unless defined $len;
    return $fh if $len < 2;

    my @res; # (encoding, start_offset)
    my @b = unpack("C*", $data);
    # Look for a BOM.
    if ($b[0]==0xEF and $len >= 3 and $b[1]==0xBB and $b[2]==0xBF) {
	@res = ('utf8', 3);
    } elsif ($b[0]==0xFF and $b[1]==0xFE) {
	if (!($len % 4) and !$b[2] and !$b[3])
	    { @res = ('utf32le', 4) }
	elsif (!($len % 2))
	    { @res = ('utf16le', 2) }
    } elsif ($b[0]==0xFE and $b[1]==0xFF and !($len % 2)) {
	@res = ('utf16be', 2);
    } elsif (!$b[0] and !$b[1] and $b[2]==0xFE and $b[3]==0xFF and !($len % 4)) {
	@res = ('utf32be', 4);
    }
    # OK - cannot find a BOM, perhaps it's ASCII text encoded in UTF(16|32).
    elsif ((!$b[0] or !$b[1]) and !($len % 2)) {
	if (    (!$b[1] and $Is_ascii_text[$b[0]] and ($len==2 or
		(!$b[3] and $Is_ascii_text[$b[2]] and ($len==4 or
		(!$b[5] and $Is_ascii_text[$b[4]] and ($len==6 or
		(!$b[7] and $Is_ascii_text[$b[6]])))))))) {
	    @res = ('utf16le', 0);
	} elsif (!$b[0] and $Is_ascii_text[$b[1]] and ($len==2 or
		(!$b[2] and $Is_ascii_text[$b[3]] and ($len==4 or
		(!$b[4] and $Is_ascii_text[$b[5]] and ($len==6 or
		(!$b[6] and $Is_ascii_text[$b[7]]))))))) {
	    @res = ('utf16be', 0);
	} elsif ($len==4 or $len==8) {
	    if (    (!$b[1] and !$b[2] and !$b[3] and $Is_ascii_text[$b[0]])
			and ($len==4 or
		    (!$b[5] and !$b[6] and !$b[7] and $Is_ascii_text[$b[4]])))
		{ @res = ('utf32le', 0) }
	    elsif ( (!$b[0] and !$b[1] and !$b[2] and $Is_ascii_text[$b[3]])
			and ($len==4 or
		    (!$b[4] and !$b[5] and !$b[6] and $Is_ascii_text[$b[7]])))
		{ @res = ('utf32be', 0) }
	}
    }

    my ($encoding, $start_offset);
    if (@res) {
	($encoding, $start_offset) = @res;
	warn_ "assuming $encoding: $fullpath" unless $Opt_ss;
    } else {
	$start_offset = 0;
	if ($Guess_encoding) {
	    seek($fh, 0, 0) or return;
	    $len = read($fh, $data, 4096);
	    defined $len or return;
	    my $enc_obj = Encode::Guess::guess_encoding($data);
	    if (ref $enc_obj and $enc_obj->name ne 'ascii') {
		$encoding = $enc_obj->name;
		warn_ "guessing $encoding: $fullpath" unless $Opt_ss;
	    }
	}
    }
    seek($fh, $start_offset, 0) or return;
    if ($encoding) {
	my $layer = ":encoding($encoding)";
	eval {
	    binmode($fh, $layer) or die "binmode '$layer' failed: $!\n";
	};
	if ($@) {
	    warn_ "encoding error $fullpath:\n", &ee unless $Opt_s;
	    close $fh;
	    open($fh, "<", $file) or return;
	}
    }
####print "DBG: $fullpath: ", (join ', ', PerlIO::get_layers($fh, details => 1)), "\n";
    return $fh;

} # magic_open


{
    my $last_file;

    sub show_progress
    {
	my $file = shift;
	my $N = $Console_width - 10;
	# Ensure $file fits the terminal width.
	# Try: a/b/c/def -> a/b/~/def -> a/~/def -> ~/def -> ~/d~f
	$file =~ s|\\|/|g if $Is_Win32;
	if (length($file) > $N) {
	    my $fits;
	    if ($file =~ m|^(.+)/([^/]+)\z|) {
		my ($root, $tail) = ($1, $2);
		while ($root =~ s|/+[^/]+\z||) {
		    if (length($root) + length($tail) < $N) {
			$file = "$root/~/$tail";
			$fits = 1;
			last;
		    }
		}
		if (!$fits and length($tail) < $N) {
		    $file = "~/$tail";
		    $fits = 1;
		}
	    }
	    unless ($fits) {
		my $N_2 = int($N / 2);
		$file =~ s|^.+/|~/|;
		$file = substr($file, 0, $N_2) . "~" . substr($file, length($file) - $N_2);
	    }
	}
	if (defined $last_file) {
	    # When consecutive filenames truncate the same, show progress has been made.
	    $file .= '*' if $file eq $last_file;
	    # Don't reprint their common prefix to prevent flickering.
	    my $lower = 0; # lower <= common < upper
	    my $upper = 1 + ((length($file) < length($last_file)) ? length($file) : length($last_file));
	    while ($upper - $lower > 1) {
		my $try = int(($lower + $upper) / 2);
		if (substr($file, 0, $try) eq substr($last_file, 0, $try))
		    { $lower = $try }
		else
		    { $upper = $try }
	    }
	    my $common = $lower;
	    my $out = '';
	    my $overhang = length($last_file) - length($file);
	    if ($overhang > 0) { # erase overhanging characters of last_file
		$out .= "\b" x $overhang;
		$out .= " "  x $overhang;
	    }
	    $out .= "\b" x (length($last_file) - $common);
	    $out .= substr $file, $common;
	    print STDOUT $out;
	} else {
	    print STDOUT "peg: $file";
	}
	$last_file = $file;

    } # show_progress
}


sub S
{
    my ($fh, $filename, $within_archive) = @_;
    if ($within_archive and ($Opts{S} == 1
	    ? $filename =~ /$S_handler_re/o
	    : ($S_nonarchive_re and $filename =~ /$S_nonarchive_re/o))) {
	my $ext = lc $1;
	require File::Temp;
	my ($fout, $tempfile) = File::Temp::tempfile("peg-S-XXXXX", SUFFIX => ".$ext", UNLINK => 1);
	binmode $fout;
	my ($len, $buf);
	while ($len = sysread($fh, $buf, 65_536)) {
	    syswrite($fout, $buf, $len)
		or die "error writing to tempfile: $!\n";
	}
	close $fout or die "can't close tempfile: $!\n";
	close $fh;
	++$Inside_archive;
	warn_ "V: S() calling $ext handler with ('$tempfile', '$filename')\n" if $Verbose;
	$Peg_S{$ext}->($tempfile, $filename);
	--$Inside_archive;
	unlink $tempfile;
    } else {
	($S_F, $S_FILE) = ($fh, $filename);
	warn_ "V: S() calling search('$filename')\n" if $Verbose;
	search();
    }

} # S


sub search_files
{
    foreach my $file (@{$_[0]}) {
	$_ = $File::Find::name = $file;
	search();
    }

} # search_files


sub run
{
    $/ = "\n";
    my $cwd = cwd();
    my $STDERR_contents;

    my $Profile = $Env{PEG_PROFILE} || 0; # A simple profiling mechanism
    warn_ "PROFILE = $Profile$Beep" if $Profile > 0;

    if ($Opts{R}) {
	require Fcntl;
	my $mode = (&Fcntl::O_WRONLY | &Fcntl::O_EXCL | &Fcntl::O_CREAT);
	my $R_dir = $cwd;
	unless (sysopen(OUT, $R_file, $mode, 0600)) {
	    warn_ "can't create -R file in current directory: $!" unless $Opt_s;
	    $R_dir = $HOME_dir;
	    sysopen(OUT, "$R_dir$R_file", $mode, 0600)
		or die_ "can't create -R file: $!";
	}
	warn_ "-R: $R_dir$R_file" unless $Opt_s;
	select OUT;
	if ($Opts{_}) {
	    # Flush STDOUT to ensure progress is seen.
	    select((select(STDOUT), $| = 1)[0]);
	    # Save STDERR output till the end to avoid clobbering the progress output.
	    open(OLDERR, ">&", \*STDERR) or die_ "can't save STDERR: $!";
	    close STDERR; # Needed to avoid possible "Bad file descriptor" error.
	    open(STDERR, '>', \$STDERR_contents)
		or ((print STDOUT "peg: can't redirect STDERR: $!\n"), exit(2));
	    $SIG{__DIE__} = sub {
		return unless ((caller(1))[3] =~ /\bsearch$/);
		show_progress("!error!");
		print STDOUT "\n";
		close STDERR;
		open(STDERR, ">&OLDERR")
		    or ((print STDOUT "peg: can't restore STDERR: $!\n"), exit(2));
		my $err = join '', "\n", $STDERR_contents, "\n", @_;
		$err =~ s/[\012\015]+/\n/gs;
		print STDERR $err;
		exit(2);
	    };
	    show_progress("*start*");
	}
    }

    # Flush output unless we know it's going to a file.
    $| = ($Opts{R} or $Opts{U}) ? 0 : 1;

    my $layer;
    if ($Output_encoding) {
	if ($Output_BOM) {
	    binmode select();
	    print $Output_BOM;
	}
	$layer = ":encoding($Output_encoding)";
	if ($Is_Win32) {
	    if ($CRLF_to_newline) {
		if ($Output_encoding eq 'utf8') {
		    # Leave implicit :crlf layer on output.
		} else {
		    $layer = ':pop' . $layer . ':crlf'; # Reposition :crlf layer.
		}
	    } else {
		$layer = ':pop' . $layer; # Remove redundant :crlf layer.
	    }
	}
    } elsif ($Needs_crlf_layer) {
	$layer = ':crlf';
    } else {
	$layer = ':raw'; # NB. needed on Win32 to prevent CRLF -> CRCRLF!
    }
    eval {
	binmode(select(), $layer) or die "$!\n";
    };
    $@ and die_ "failed to binmode output using '$layer':\n", &ee;
####print "DBG: output '$layer' => ", (join ', ', PerlIO::get_layers(select(), details => 1)), "\n";

    if ($Opts{R} > 1) {
	my $header = <<"EOT";
##
# TIME : @{[ scalar localtime ]}
# CWD  : @{[ $cwd ]}
# ARGV : @{[ join "\n#        ", @ARGV ]}
##
EOT
	$header =~ s/\n/$Newline/g;
	print $header;
    }

    # Ensure we don't leave console incorrectly colored if interrupted.
    # SIGQUIT (Ctrl-Pause on Win32) saves the files matched so far.
    $SIG{INT} = $SIG{QUIT} = $SIG{TERM} = sub {
	# XXX Win32 fix for unread STDIN contents leaking to shell when run via bat file.
	if ($Is_Win32 and !$STDIN_is_terminal) {
	    while (<STDIN>) {}
	}
	print $Col_Reset;
	chdir($cwd) && save_matches() if $_[0] eq 'QUIT';
	exit(2);
    };

    $SIG{__WARN__} = sub {}; # Ignore warnings from here on in.

start:

    search_files(\@Cmdline_files);

    if ($Opt_r_cmd) {
	require IPC::Open3;
	require IO::File;
	*R_CMD_ERR = IO::File->new_tmpfile;
	# Ensure that the R_CMD process does not become a zombie if an
	#  interrupt occurs before it has finished and triggers peg to exit.
	#  In particular, it is possible for an interrupt to occur after
	#  open3() has created the R_CMD process but before it has returned.
	my $INT_handler = $SIG{INT};
	my $interrupt = 0;
	$SIG{INT} = sub { $interrupt = 1 };
	my $pid = eval {
	    IPC::Open3::open3(undef, \*R_CMD_OUT, ">&R_CMD_ERR", $Opt_r_cmd);
	};
	$@ and die_ "failed to run $Opt_r_cmd\n", &ee;
	my $finished;
	eval "END { kill('KILL', $pid) unless \$finished }";
	$SIG{INT} = $INT_handler;
	$SIG{INT}->('INT') if $interrupt;
	warn_ "created process $pid for $Opt_r_cmd" unless $Opt_ss;
	while (<R_CMD_OUT>) {
	    s/\015?[\012\015]\z//; # inline chomp_
	    $File::Find::name = $_;
	    search();
	}
	seek(R_CMD_ERR, 0, 0) or die_ "seek failed: $!";
	while (<R_CMD_ERR>) {
	    warn_($_) unless $Opt_ss;
	}
	close R_CMD_ERR;
	close R_CMD_OUT;
	waitpid($pid, 0);
	$finished = 1;
	$? and warn_ "non zero exit status ($?): $Opt_r_cmd";
    }

    if ($Opts{r} or $Opt_d) {
	require File::Find;
	local $SIG{__WARN__} = sub {
	    my $err = $_[0];
	    $err =~ s/^(.*) at .* line \d+.*\z/$1/s;
	    $err =~ s/^Can't opendir\((?:\.\/)?(.+)\): /can't opendir $1: /;
	    $err = lcfirst $err if $err =~ /^C\w+\'t /;
	    # If search() is in the call stack then File::Find::name is valid.
	    for (my $i = 0; my @cs = caller($i); ++$i) {
		if ($cs[3] =~ /search/) {
		    return if $i == 2; # Ignore warnings from PERLEXPR
		    $err = $File::Find::name . ": " . $err;
		    $err =~ s|^\./||;
		    last;
		}
	    }
	    warn_ $err;
	} unless $Opt_ss;
	my @dirs = (($Opts{r} ? '.' : ()), @Cmdline_dirs);
	eval {
	    File::Find::find({ wanted => \&search, skip_dirs => 1 }, @dirs);
	};
	$@ and warn_ "File::Find::find failed: ", &ee;
	chdir($cwd) or die_ "can't chdir back to $cwd: $!";
    }

    if ($Opts{X}) {
	# Avoid interleaving the file list and output on the terminal.
	if ($STDOUT_is_terminal and $STDIN_is_terminal and !$Opts{R}) {
	    warn_ "buffering up -X file list" unless $Opt_s;
	    my @files;
	    while (<STDIN>) {
		chomp_ $_;
		next if $_ eq '';
		push @files, $_;
	    }
	    search_files(\@files);
	} else {
	    while (<STDIN>) {
		chomp_ $_;
		next if $_ eq '';
		$File::Find::name = $_;
		search();
	    }
	}
    }

    if ($Search_STDIN) {
	search_files(['-']);
    }

    # Finished searching specified files.
    if (--$Profile > 0) {
	goto start;
    }

done:

    if ($Code_at_end) {
	eval_ $Code_at_end;
	$@ and warn_ "-PPPP code gave an error:\n", &ee;
    }

    if ($Opts{c} == 2) {
	print $Count, $Newline;
    }
    elsif ($Opts{Z} and !($Opts{Z} % 2)) {
	Z_display();
    }

    print $Col_Reset;

    if ($Opts{R}) {
	if ($Opts{_}) {
	    show_progress("*done*");
	    print STDOUT "\n";
	    open(STDERR, ">&OLDERR")
		or ((print STDOUT "peg: can't restore STDERR: $!\n"), exit(2));
	    print STDERR $STDERR_contents;
	}
	select STDOUT;
	close OUT or warn_ "failed to close -R file: $!";
    }

    save_matches();

    if ($Opts{'%'}) {
	my $total_time = sprintf "%.2f", (0.1 + Time::HiRes::time() - $Start_time);
	my $rate = int($Total_bytes / $total_time);
	if ($rate >= 1048576) { $rate = int($rate / 1048576) . 'M' }
	elsif ($rate >= 1024) { $rate = int($rate / 1024) . 'K' }
	foreach ($Total_files, $Total_lines) {
	    1 while s/^(\d+)(\d{3})/$1,$2/; # commify
	}
	warn_ "took $total_time seconds: $Total_lines lines in $Total_files files \@ $rate bytes/sec";
    }

} # run


# Avoid "used only once" warnings.
1 or ($Data::Dumper::Indent, $Data::Dumper::Sortkeys,
	$Encode::Guess::NoUTFAutoGuess, $FindBin::RealBin, $::OLDERR);

__END__

=head1 NAME

peg - Perl expression grep

=head1 SYNOPSIS

peg [OPTION]... PERLEXPR [FILE]...

=head1 DESCRIPTION

B<Peg> is a file search tool similar to the UNIX program B<grep>.

It uses a Perl expression to match lines from a list of input files.

Internally, B<peg> works in a manner similar to the following pseudo-Perl:

    foreach $File ( FILEs ) {
        if (open F, "<", $File) {
            while (<F>) {
                if ( PERLEXPR ) {
                    print;
                }
            }
        }
    }

Thus, each input line is available as the Perl variable C<$_>, and
this will be printed if PERLEXPR is true. In particular, to match lines
according to a Perl regular expression pattern, it is necessary to place
it within the pattern matching operator, which defaults to searching C<$_>.
For example, C<peg /needle/i haystack>.

To simplify specifying the PERLEXPR in the common case of searching for
plain text, the following rules are used to determine how it is treated
if none of B<-E>, B<-F> or B<-G> are specified:

=over 4

=item 1.

If the PERLEXPR is a I<simple> string (which is defined as
matching C</^[\w\s\-\.\,\'\:\;\#]+$/>), then the PERLEXPR is taken
as a literal string to search for ie. B<-F> is assumed.

=item 2.

If the PERLEXPR is not simple, and any of B<-i>, B<-w> or B<-x> are
specified, then the PERLEXPR is taken as a regular expression pattern
to match against ie. B<-G> is assumed.

=item 3.

Otherwise, the PERLEXPR is assumed to be a Perl expression
ie. B<-E> is assumed.

=back

The above rules allow for C<peg /needle/ haystack> to be run as
the more natural C<peg needle haystack>.

To assist in quoting battles against less enlightened shells,
B<peg> provides the following variables:

    ($DQ, $SQ, $BT, $EM, $GT, $LT, $PC) = qw( " ' ` ! > < % )

B<Peg> will C<reset> any Perl variables beginning with a lowercase
letter prior to searching each file.

If no files are specified then if STDIN is attached to the terminal
then B<-r> is assumed else B<peg> reads from standard input.

=head1 OPTIONS

The options include equivalents to all of standard B<grep(1)>,
and most of the B<GNU> extensions. Note that some are subtly different.

They can be grouped I<anywhere> in the argument list (except after
B<-->, or after options that take an argument). For example, C<peg -i a b>,
C<peg a -i b> and C<peg a b -i> are all equivalent. Some options are
overloaded to have different behaviour if they are specified more than
once. Options can also be set via the environment variable
B<PEG_OPTIONS>.

If less than two files are specified, then B<-h> is assumed.

=head2 Selection and interpretation of PERLEXPR

=over 4

=item B<-E>

Assume PERLEXPR is a Perl expression.

=item B<-F>

Assume PERLEXPR is a fixed literal string.
Thus, C<peg -F fo+ bar> is equivalent to C<peg /fo\+/ bar>.

=item B<-G>

Assume PERLEXPR is a Perl regular expression I<pattern>.
Thus, C<peg -G \bfoo\b bar> is equivalent to C<peg /\bfoo\b/ bar>.

=item B<-e> I<overloaded>

=over 4

=item B<-e PERLEXPR>

Specify a PERLEXPR to match.

If used more than once, then it is equivalent to using B<-o>.
For example, C<peg -e foo -e bar baz>, C<peg -o foo bar -- baz>,
and C<peg "/foo/ or /bar/" baz> are all equivalent.

=item B<-ee FILE>

Specify a file to search.

For example, C<peg -ee -filename -e -text>, will search for
the string B<-text> in the file B<-filename>.

=back

=item B<-f> I<overloaded>

=over 4

=item B<-f FILE>

FILE is a file containing further PERLEXPRs.
Lines will be adjudged to match if they match any of the PERLEXPRs.

=item B<-ff FILE>

FILE is a file containing files to search.

=item B<-fff FILE>

FILE is a file whose lines are added as keys to the
Perl associative array variable C<%F>.

=back

=item B<-i> I<overloaded>

=over 4

=item B<-i>

Ignore case distinctions. Enables B<-G>.

=item B<-ii>

I<Smartcase> matching. Ignore case distinctions if PERLEXPR is
entirely lowercase.

=back

=item B<-o>

Non option arguments following the B<-o> option up until B<--> are
interpreted as further PERLEXPRs. Lines will be adjudged to match
if they match any of the PERLEXPRs.
For example, C<peg -o foo bar baz -- file> is equivalent to
C<peg "/foo/ or /bar/ or /baz/" file>.

=item B<-O>

Similar to B<-ol>, except each PERLEXPR must match at least once.

=item B<-k>

Similar to B<-O>, except each PERLEXPR must not match anywhere
within the file. It can be thought of as being to B<-O> what
B<-L> is to B<-l>. For example, C<peg -rO aa bb -k AA BB -O cc -k CC>
will print the names of the files that contain all of aa, bb and cc,
but none of AA, BB or CC.

=item B<-v>

Negates the sense of PERLEXPR.

=item B<-w>

Force PERLEXPR to match only whole I<words>. Enables B<-G>.

=item B<-x>

Force PERLEXPR to match only whole I<lines>. Enables B<-G>.

=back

=head2 File selection

=over 4

=item B<-d>

Any directories listed in the file list will be searched
recursively for files to work upon.

=item B<-I> I<overloaded>

=over 4

=item B<-I>

Do not process binary files.

=item B<-II>

Process I<only> binary files.

=back

=item B<-K>

Attempt to I<automatically> detect each file's encoding.
It does this by looking at the first few bytes of the file for:

=over 4

=item *

A byte order mark (BOM) at the start of the file.
Supports utf16le, utf16be, utf32le, utf32be and utf8.

=item *

No byte order mark, but first few bytes look like the file is
ASCII encoded in UTF-16 or UTF-32.

=back

If this does not succeed, then an encoding can still be determined
if the environment variable B<PEG_GUESS_ENCODING> is set. This
should be a whitespace delimited list of encodings, for example
C<euc-jp euc-kr euc-cn>. These are then tried by B<Encode::Guess>
to see if the encoding can be determined.

=item B<-M> I<overloaded>

This takes a B<TIME> argument which is then compared to
the modification time of each file to filter out either
old or new files.

=over 4

=item B<-M TIME>

Search I<new> files, last modified since B<TIME>.

=item B<-MM TIME>

Search I<old> files, last modified prior to B<TIME>.

=item B<-M TIME1 -MM TIME2>

Search files last modified between B<TIME1> and B<TIME2>.

=back

The possible formats for B<TIME> are:

=over 4

=item * A precise time.

This is specified as a 24 hour time optionally followed by
the number of days previous. Its expected format is one of:
C<hrs:min:sec>, C<hrs:min>, C<hrs:min:sec-days> or C<hrs:min-days>.
For example, C<13:30-2> means 1:30pm two days ago.

=item * An actual date.

This is specified as one of C<Year-Month-Day>, C<Day/Month/Year>
or C<Day/Month> (where the current year is assumed).
For example, C<2001-12-25> and C<25/12/01> both represent
Christmas Day 2001.

=item * A time offset since now.

This is specified as a number followed by an optional letter
denoting the unit of time. The available time units are
B<s> for seconds, B<m> for minutes, B<h> for hours,
B<d> for days (the default), B<t> for I<todays> ie. whole days,
and B<w> for weeks. For example, C<-M 2t> would search files
modified either today or yesterday.

=item * The last modification time of a file.

This is specified as C<FILE@>.

=back

To search files last modified within an interval either side
of B<TIME>, suffix it with C<# NUMBER ?UNIT?>. The available
time units are B<s> for seconds, B<m> for minutes, B<h> for
hours, B<d> for days (the default), and B<w> for weeks.
For example, C<-M foo@#10m> will search files modified within
ten minutes of when foo was last modified; and C<-M 15/3#0>
will search files modified on the 15th of March.

=item B<-p> I<overloaded>

=over 4

=item B<-p ALIAS>, B<-p EXTENSION> or B<-p EXPRESSION>

Filter files from being searched dependent on B<-p>'s argument.

If B<-p>'s argument is a simple string (matches C</^[\w\.\,\-]+$/>)
then this is used to match against the end of the current
filename in a case insensitive manner. Only filenames matching
this will be searched. For example, C<peg -rp .txt foo> will
search files whose extension is '.txt'.

If B<-p>'s argument is not a simple string then it is taken as a
Perl expression to be used to determine whether to search the file.
This expression can use C<$_> and C<$File>. C<$_> holds the relative
path and should be used for filetests or pattern matches against the
file's basename. C<$File> holds the full path name and should
be used for name tests which require the directory part. For example,
C<peg -rp "-s $_ < 1024" foo> will only search files whose size
is less than 1Kb; and C<peg -rp "$File !~ m#(^|/)CVS/#" foo>
will skip files that reside beneath a directory called F<CVS>.

Common expressions can be stored in environment variables called
B<PEG_P_>I<alias> and then used by specifying the I<alias> as B<-p>'s
argument. The alias environment variable must be all in uppercase,
but can be specified on the command line in lowercase.
For example, setting B<PEG_P_C> to C</\.[ch]$/i> will make
C<peg -rp c foo> search through I<C> files.

The sense of both ALIAS and EXTENSION matches can be negated by
prefixing the argument with a C<!>. For example, C<-p !html> will
search non HTML files.

Multiple B<-p>'s can be specified and the effect is cumulative.
For example, C<peg -rp .c -p "$File !~ /old/" foo> will search
through files with a '.c' suffix except in paths containing 'old'.
This could also be done using only one expression:
C<peg -rp "/\.c$/i and $File !~ /old/" foo>.

=item B<-pp ALIAS>, B<-pp EXTENSION> or B<-pp EXPRESSION>

Essentially the same as B<-p> except it filters out files within
archives processed via the C<S()> subroutine when using B<-S>.
The user coded subroutine can also perform this filtering by
calling C<pp($filename)> - this returns false if the filename does
not match the B<-pp> expression. If called without any arguments,
C<pp()> returns true iff B<-pp> was specified. See the
documentation for B<-S> for an example of how it can be used.

NB. only file I<name> tests should be used.

=back

=item B<-r>

Work upon all files in and beneath the current directory.

This option is implicit if no files are specified and STDIN is attached
to the terminal.

By default B<peg> uses Perl's C<File::Find::find()> to determine the
files to process when B<-r> is used. Alternatively, an external command
such as C</usr/bin/find . -type f -print> can be specified in the
environment variable C<PEG_R_CMD> to feed B<peg> with the file list.
This can give significantly shorter run times.

=item B<-t> I<overloaded>

Sort the FILEs according to their last modification time.

=over 4

=item B<-t>

Process recently modified files I<first>.

=item B<-tt>

Process recently modified files I<last>.

=back

=item B<-X> I<overloaded>

=over 4

=item B<-X>

Interpret the standard input stream as a list of FILEs to process.
This provides a built-in B<xargs(1)> facility.

=item B<-XX>

Interpret the standard input stream as a list of PERLEXPRs
to process. In the case of using B<-XXX>, the standard input
stream is read twice: the first list will be the PERLEXPRs,
and the second list the FILEs.

=back

=item B<-y> I<overloaded>

=over 4

=item B<-y>

Search the files matched by the last successful run of B<peg>.

=item B<-yy>

Do not store the files matched by this run of B<peg>.
This can be combined with B<-y> by specifying B<-yyy> to reuse
the same set of matched files from the last non B<-yy> run.

=back

=item B<-{ ENCODING>

Specify the encoding of the input files eg. C<utf16le>.

=back

=head2 Basic output control

=over 4

=item B<-a> I<overloaded>

=over 4

=item B<-a>

Do not suppress binary output. The default behavior for when
a match occurs on a binary file is to display the message
C<Binary file FILE matches>.

Note that binary output can interfere with the terminal
color codes used by B<-#> and lead to garbled output.

=item B<-aa>

Same as B<-a>, but also filter out any I<binary> characters
from the output.

=back

=item B<-A -B -C -NUM>

These options specify that matches should be shown with lines
of surrounding I<context>. B<-A> shows lines of trailing (I<after>)
context; B<-B> shows lines of leading (I<before>) context; B<-C> shows
both leading and trailing context. B<-NUM> sets the number of lines
of context for the most recently specified context option
(the default is 2) or assumes B<-C> if none specified. For example,
B<-B1A3> specifies one line of leading context and three lines of
trailing context.

=item B<-b> I<overloaded>

=over 4

=item B<-b>

Print the byte offset of the matching line within the input file.

=item B<-bb>

Same as B<-b> but report UNIX byte offsets ie. as if carriage
returns were not there.

=back

If the environment variable B<PEG_B_HEX> is set then the byte offset
is printed in hexadecimal.

=item B<-c> I<overloaded>

=over 4

=item B<-c>

Print a count of the number of input lines that match PERLEXPR
for each file specified.

=item B<-cc>

Print the total count of the number of input lines that match
PERLEXPR over all files specified.

=item B<-ccc>

Same as B<-c>, but only display those files which contain one
or more matches.

=back

=item B<-h>

Suppress filenames being printed when searching multiple files.

=item B<-H>

Print the filename for each match.

=item B<-J> I<overloaded>

=over 4

=item B<-J>

Display any matching line's filename in a single banner header
with all that file's matches following it.

=item B<-JJ>

Display any matching line's filename on its own line with all
that file's matches following it.

This option is disabled if writing to a file/pipe or if B<-R> is
specified. To force B<-JJ> functionality in these cases use B<-JJJ>.

=back

=item B<-l> I<overloaded>

=over 4

=item B<-l>

Print only the names of files which match PERLEXPR.

If the PERLEXPR is C<+1> and the file I<exists> then it is assumed
to match without actually C<open>ing the file. Thus zero size files
and binary files are valid matches. This enables B<peg> to be used
as an alternative to B<find(1)>. For example, to find recently
modified Perl files, you could C<peg -rl +1 -p /\.p[lm]$/ -M 7d>.

=item B<-ll>

Same as B<-l>, but print a 0 byte after each filename instead of
a newline.

=back

=item B<-L>

Print only the names of files which don't match PERLEXPR anywhere.

=item B<-m> I<overloaded>

=over 4

=item B<-m NUM>

Stop reading a file after NUM matches.

The NUM can be specified either as an argument or immediately
following the option. That is, B<-m3> and B<-m 3> are equivalent.

=item B<-mm NUM>

Similar to B<-m>, but stops processing files after NUM matches.
Note that B<-m3 -m6> is interpreted as B<-m6> and not B<-mm6>.

=back

=item B<-n>

Print the input line number.

=item B<-T>

Inserts a tab character between any context output and the
matching line. This is useful when the input data is tab indented,
as it keeps the output aligned as it was intended to be viewed.

=item B<-z> I<overloaded>

=over 4

=item B<-z PERLEXPR>, B<-z ALIAS>

Show the most recently matched I<context> line before matches.

This context line is the line that most recently matched the
specified PERLEXPR. If B<-z>'s argument is a single word, then it
is assumed to be an I<alias>, in which case PERLEXPR is defined by
the value of the environment variable named B<PEG_Z_>I<ALIAS>.
For example, setting B<PEG_Z_C> to C</^\w[\w\s:\*]*\(/ && !/[;"]/>
will make C<peg -z c foo *.c> include the (I<potentially!>)
relevant B<C> function name for any matches.

If B<-z>'s argument is an alias, then a secondary context can be
defined with an environment variable named B<PEG_ZZ_>I<ALIAS>
set to the desired Perl expression. For example, you can define
an I<alias> called C<p> to be used when searching Perl code that
determines the subroutine and package contexts of the match by
defining the environment variables C<PEG_Z_P> and C<PEG_ZZ_P> to
be respectively C</^sub\s+\w/> and C</^package\b/>.

=item B<-zz PERLEXPR>

Explicitly set the secondary context PERLEXPR.

=back

=item B<-#> I<overloaded>

=over 4

=item B<-#>

Color the output.

The coloring scheme can be configured by the B<PEG_COLOR>
environment variable. Its expected format is a comma separated
list of color specifiers whose format is:

    TYPE = d? COLOR (o d? COLOR)?

The TYPE and COLOR are single letters whose possible values are
listed below. If the color is prefixed with a B<d> then this
indicates to use the bold version of that color. The optional
B<o d? COLOR> part indicates a background color (mnemonic: on).

    TYPEs:                                  COLORs:
    f  filename                             r  red
    c  colon                                g  green
    l  line number                          b  blue
    b  byte offset                          c  cyan
    n  non matching part of the line        m  magenta
    m  matching part of the line            y  yellow
    z  -z context line                      k  black
    y  secondary -z context line            w  white

For example, if B<PEG_COLOR> is C<f=g,m=dyob>, then the
filename will be colored in green, and the matching text
as bold yellow on blue.

This option is disabled if the output is not directed to a terminal.

On the Windows platform, this option requires that the B<CPAN>
module C<Win32::Console::ANSI> is installed.

=item B<-##>

Same as B<-#>, but do not disable the coloring if the output is
not directed towards a terminal.

=back

=item B<-\>

Show filenames using the Window's convention of separating
the parts using a backslash.

=item B<-} ENCODING>

Specify an encoding for the output eg. C<utf16le>.

To output the ENCODING's appropriate BOM, add a C<#> eg. C<utf16le#>.

=back

=head2 B<Peg> specials

=over 4

=item B<-D>

Prints out useful debugging information, including the
internally used Perl search routine.

Additional details are displayed if B<-DD> is specified.

=item B<-N>

Ensure each printed line ends in a (native) newline.

=item B<-P> I<overloaded>

Each of these options runs some Perl code, but at a different
stage of B<peg>'s processing. The Perl code is specified by
its argument. If the argument is a single word, then it is
assumed to be an I<alias> where the actual B<PERLCODE> is the
value of the environment variable named B<PEG_CODE_>I<ALIAS>.
If the argument is not a single word, then it is assumed to be
the B<PERLCODE>. Note that the Perl code specified can be any
Perl statement(s) ie. it's not limited to just an expression.

=over 4

=item B<-P PERLCODE>, B<-P ALIAS>

The Perl code is run for each line of input before it is tested
by PERLEXPR for a match. For example, to count all occurrences
of a word: C<peg -ZP "++$Z while /word/g" +0 file>.

=item B<-PP PERLCODE>, B<-PP ALIAS>

The Perl code is run before each file is opened.

=item B<-PPP PERLCODE>, B<-PPP ALIAS>

The Perl code is run after each file has been processed.

=item B<-PPPP PERLCODE>, B<-PPPP ALIAS>

The Perl code is run after all the files have been processed.

=item B<-PPPPP PERLCODE>, B<-PPPPP ALIAS>

The Perl code is run after the file has been opened,
but before it is read.

=back

=item B<-R> I<overloaded>

=over 4

=item B<-R>

Write the output to a file named C<peg_>I<uid>C<.txt>.

=item B<-RR>

Same as B<-R>, but also include a header at the top of the
output file giving details on the search performed.

=back

=item B<-S>

This allows for a user defined Perl subroutine to process each
FILE and give B<peg> an alternative input stream to search.
Usage examples include searching non text based file formats
such as B<PDF>, or searching the individual files inside
a C<.tar.gz> archive.

The Perl subroutine can be written in any of the B<peg>
customization files. The subroutine used is determined according
to the file extension of the input file. The hash variable
C<%Peg_S> is used to map a file extension to a reference of the
subroutine that will handle files with that extension. For archive
files such as B<zip> files, prefix the file extension with a C<*> so
that B<peg> knows to recurse into them to look for further matches.

    # peg_ini.pl
    # Define a mapping between the file extension and subroutine:
    %Peg_S = (
        'pdf'   => \&process_pdf,
        '*zip'  => \&process_zip,
    );

When B<peg> processes a file whose file extension is in C<%Peg_S>,
then it calls the appropriate subroutine with 2 arguments: the
relative filename (needed to C<open> the file) and its full pathname
(needed for error messages). The subroutine should perform its
processing, and then call the subroutine C<S()> with 2 or 3 arguments:
a new Perl filehandle for B<peg> to process, a filename to use for
this input, and optionally a boolean flag that indicates if this
stream is within an archive. If the subroutine returns false, then
B<peg> will continue to process the file as usual, otherwise it will
continue with the next file.

The following code shows how this mechanism can be used to make
B<peg> process the individual files within a B<zip> archive, and
text within a B<PDF>. Note that it relies on the availability of
the F<unzip> and F<pdftotext> programs.

    # peg_ini.pl
    sub process_zip {
        my ($file, $fullpath) = @_;
        # Determine the files within the .zip file
        my @filelist = `unzip -Z1 \"$file\" 2>&1`;
        if ($?) {
            print STDERR "unzip failed with $fullpath: $?\n";
            return 0; # signal to process the file as usual
        }
        # Extract each file in turn
        foreach my $f (sort @filelist) {
            $f =~ s/\015?\012\z//;
            # Avoid extracting files which will be skipped due to "-pp"
            next unless pp($f);
            my $cmd = qq(unzip -p "$file" "$f");
            open(my $fh, "$cmd|")
                or die "can't extract $f from $fullpath: $!\n";
            # Make peg process this.
            S($fh, "$fullpath -> $f", 1);
        }
        return 1; # signal to continue with next file
    }
    sub process_pdf {
        my ($file, $fullpath) = @_;
        my $tempfile = "_tempfile.$$";
        system "pdftotext \"$file\" $tempfile";
        if ($?) {
            print STDERR "pdftotext failed: $?\n";
            unlink $tempfile;
            return 0;
        }
        unless (open($fh, "<", $tempfile)) {
            print STDERR "could not open $tempfile: $!\n";
            unlink $tempfile;
            return 0;
        }
        S($fh, $fullpath);
        unlink $tempfile;
        return 1;
    }

=item B<-U>

Buffer output. This sets C<$|> to zero.

The default behaviour is to flush each line of output. This ensures
output is shown immediately on the terminal, and that output piped
to another command is processed immediately. However, this is slow
when redirecting massive amounts of output to a file. For example,
C<< peg -r foo > ../log.txt >> may run significantly faster by
using B<-U>.

=item B<-W>

This restores C<$_> to its original contents prior to printing.
Only useful if C<$_> is changed within PERLEXPR. For example,
C<peg -W "s/\/\*.*//, /foo/" main.c>.

=item B<-Z> I<overloaded>

=over 4

=item B<-Z>

Print the value of C<$Z> at EOF. If C<$Z> is a reference to an array
then the elements in that array are printed; else if C<$Z> is a
reference to a hash then the keys of the hash are printed in
C<sort>ed order, with the values displayed if defined.

=item B<-ZZ>

Same as B<-Z>, but display the value of C<$Z> once, after all
files have been processed.

=item B<-ZZZ> and B<-ZZZZ>

Same as B<-Z> and B<-ZZ> respectively, but uses C<Data::Dumper> to
display the value of C<$Z>.

=back

=item B<-_>

When using B<-R>, show a continually updated progress message
showing which file is currently being processed.

=item B<-/ INPUT_RECORD_SEPARATOR>

Specify an alternative input record separator string
(Perl's C<$/> variable). See L<perlvar/"$/">.

For example, to process files with MAC style line endings of a
single linefeed character on a Windows machine, you would need
C<peg -/ qq(\r) foo macfile.txt>.

=item B<-=>

Print the names of the files matched by the last successful run.
This option does not use, nor require, a PERLEXPR. Additionally,
the format can be modified by any of the following options:

=over 4

=item B<H>

Show the full path names.

=item B<\>

Show the files using backslashes instead of forward slashes.

=item B<l>

Show each file's last modification time and size.

=item B<n>

Show each file's I<match index>.

=item B<t>, B<tt>, B<ttt> & B<tttt>

Sort the files respectively oldest first, oldest last,
smallest first or smallest last.

=back

=back

=head2 Miscellaneous

=over 4

=item B<-q>

Immediately exit with status 0 when a match is found.

=item B<-s> I<overloaded>

=over 4

=item B<-s>

Suppress all B<peg>'s error/informational messages to STDERR.

=item B<-ss>

Suppress a subset of B<peg>'s error/informational messages.
In particular, those for unreadable directories emitted
when either B<-d> or B<-r> is used, and those for the assumed
encoding of files when using B<-K>.

=back

=item B<-V> I<overloaded>

When called as C<peg -V>, display version information for B<peg>
and the interpreting B<perl>.

Otherwise it makes B<peg> print out progress messages to STDERR.
Also sets the Perl variable C<$::Verbose> to true which is
available for use by subroutines in the customization files.

=item B<-Y> I<overloaded>

This disables any previously specified options.
Useful for disabling options set in B<PEG_OPTIONS>,
or when modifying a previous command.

If it used as C<-Y,abc>, then only the options listed after the
comma are disabled. For example, C<peg -Y,K ...> will disable B<-K>.

Additionally, if it is double specified as the first argument,
ie. C<peg -YY...>, then the ini files will not be loaded.

=item B<-%>

Display the approximate time taken in seconds to complete the search.

=item B<-+>

Ignore the results files created by B<-R>.

=item B<-->

Explicitly end options.

Allows filenames beginning with a C<-> to not be interpreted
as options. Also used by the B<-k>, B<-o> and B<-O> options to
determine which arguments are PERLEXPRs and which are files.

=item B<--help [OPTION]>

Show this I<help>ful documentation! If an option is specified,
then just the documentation for that particular option is shown.

=back

=head1 AUTOVARS

Peg automatically provides the following variables that can be
used within the PERLEXPR:

=over 4

=item C<$C>

When B<-z> is used, this contains the current line of context.

=item C<$File> and C<$Filepath>

For each file processed, C<$File> is its I<name> as output by B<-H>,
while C<$Filepath> is the path used to C<open> it.

=item C<@F>

This is the result of a split applied to the input line.
That is, it contains a list of the whitespace delimited strings
in the current line.

=item C<@P>

This contains the lines of the current file up to the current line
so that C<$P[0]> is the first line of input and C<$P[-1]> is the
previous line of input. This array can be used to test for matches
over consecutive lines.

=item C<%S> and C<@S>

C<%S> contains as keys all the alphanumeric words (matches C<\w+>)
encountered so far in the file. The values are the number of times
that word has been seen.

C<@S> contains in order all the alphanumeric words (matches C<\w+>)
in the current line.

=back

=head1 AVAILABLE SUBROUTINES

B<Peg> provides some subroutines that can be used in the PERLEXPR:

=over 4

=item * C<near(PATTERN|SUB ?,RANGE?)>

This can be used to check for a match in the preceding lines.
It returns 1 on a match and 0 otherwise.
Its first argument is either a regular expression I<pattern> or a
subroutine reference which is called with each preceding line set
to C<$_>. An optional second argument specifying how many lines back
to check (the default is 10). Additionally, if the second argument is
prefixed with a C<!> then this indicates not to check the current
line; and if the second argument is a C<*> then this will check all
the previous lines up to that point.

For example, C<peg "/x/ and near(q[(?i)y], 5)" file>
will return lines containing an C<x> where there is also a C<y> or
C<Y> in the preceding 5 lines. This could also be written as
C<peg "/x/ and near(sub { /y/ or /Y/ }, 5)" file>.

=item * C<nearby(?\N,? PATTERN1, PATTERN2, ...)>

This can be used to check for where a line matches one of a list of
regular expression patterns and also one of the other patterns
matches in the preceding few lines. If the first argument is a
reference to a number, then this will be used as the number of
preceding lines B<N> to check against (the default is 10).
It returns 1 if it finds a match and 0 otherwise.

=item * C<colorall(PATTERN ?,COLOR_DEFINITION?)>

This highlights each string found to match the given PATTERN.
It returns the number of matches found. For example,
C<peg -# "colorall( q/(?i)needle/ )" haystack>.

The optional color specifier argument takes the same format as used
by B<PEG_COLOR>. For example, to highlight all occurrences of I<foo>
and I<bar> in a file with bold magenta and blue on yellow:
C<peg "colorall('foo', 'dm') + colorall('bar', 'boy')" file>.

=item * C<last_matches(?RETURN_FULLPATHS?)>

This returns the list of files matched by the last successful run.
If it is called with a true argument (eg.  C<last_matches(1)>) then
the full pathnames are returned; otherwise the files are relative to
the current directory. For an example of its use, see the B<--vim>
option defined in the example F<peg_ini.pl> below.

=back

=head1 CUSTOMIZATION

At startup, B<peg> will load the following Perl files if they exist:

=over 4

=item * A site wide customization file.

F<peg_ini.pl> in the same directory that the B<peg> script resides.

=item * A user specific customization file.

F<.peg_ini.pl> in the user's B<HOME> directory.

=item * A current directory customization file.

F<.peg_ini.pl> in the current working directory.

=back

These files should contain valid Perl code. They are primarily
intended for the setting of B<peg>'s configuration environment variables,
but can also process C<@ARGV> and so be used to extend B<peg>'s command
line functionality.

=head2 Defining named command line options

Named command line options can be defined by adding I<option-name>/I<code>
pairs to C<%::Peg_longopt>. If B<--option-name> is given on the command line
the relevent code is called with two arguments: a reference to the array
containing the remaining command line arguments, and a reference to the
array containing the file list. The general syntax is:

    $::Peg_longopt{'option-name'} = sub {
        my ($argv_ref, $filelist_ref) = @_;
        # Define functionality for "--option-name".
    };

=head2 Example B<peg_ini> code

    # Make "peg # ..." a shortcut for "peg -l +1 ..."
    if (@ARGV and $ARGV[0] eq '#') {
        splice @ARGV, 0, 1, '-l', '+1';
    }

    # Establish some useful default options:
    $ENV{PEG_OPTIONS} ||= q{ -ssJJ+#_ -p "$File !~ m#(^|/)(\.svn|CVS)/#" };

    # Configure some -p & -z aliases:
    $ENV{PEG_P_P} ||= '/\.(pm|pl)$/i';
    $ENV{PEG_Z_P} ||= '/^(\s*sub\s+\w|=head|__(END|DATA)__)/';

    # Define a "--pager" option that pipes output through "less".
    $::Peg_longopt{pager} = sub {
        my $argv_ref = shift;
        unshift @$argv_ref, '-Y,J#', '-JJJ##';
        $! = $? = 0;
        open(PAGER_OUT, '|-', "less -mR") && !$! && !$?
            or die "unable to pipe STDOUT via less\n";
        *STDOUT = \*PAGER_OUT;
    };

    # Define a "--vim NUM" option that opens the NUM-th match in vim.
    $Peg_longopt{vim} = sub {
        my $argv_ref = shift;
        my $n = shift @$argv_ref or die "Usage: --vim NUM";
        my @matches = last_matches();
        my $file = $matches[$n-1];
        system "vim \"$file\"";
        exit;
    };

    1;

=head1 EXIT STATUS

The following exit values are returned:

    0   one or more matches were found
    1   no matches were found
    2   peg did not complete normally

=head1 EXAMPLES

=over 4

=item 1. Search recursively for all VHDL constant definitions:

    % peg "/^\s*constant\s.*:=/i"

=item 2. Find the instance names of CTS buffers in a verilog netlist:

    % peg -N "/^\s*CTS\w*\s+(\w+)\s*\(/ and $_ = $1" foo.v

=item 3. Extract the entity declaration section from a VHDL file:

    % peg "s/\s*--.*$//, /\bentity\b/i .. /\bend\b/i" bar.vhd

=item 4. Search for the sequence A,B,C split over 3 consecutive lines:

    % peg -B2n "$P[-2]=~/A/ and $P[-1]=~/B/ and /C/" bam

=item 5. Sum up the entries in the last column of a file:

    % peg -Z "$Z += $F[-1]" report.txt

=item 6. Search for "main" in C files below the current directory:

    % find . -name "*.c" | peg -Xw main
    % peg -wp .c main

=back

=head1 ENVIRONMENT

Options can be set via the environment variable B<PEG_OPTIONS>.

The colors used when running with B<-#> can be configured with B<PEG_COLOR>.

Aliases for B<-p>'s file extension matching regular expressions are
set via B<PEG_P_>I<alias>.

Aliases for B<-z>'s context matching regular expressions are
set via B<PEG_Z_>I<alias>.

The environment variable B<PEG_GUESS_ENCODING> can be used to provide
a list of possible encodings to test for when using B<-K>.

The filename "-" indicates to read from standard input only if no other
file is listed; otherwise it is treated as an ordinary filename.

=head1 PLATFORM ISSUES

Filenames constructed while traversing the directory structure during
B<-d> or B<-r> searches are by output in the UNIX B</> separated style.

On Windows, command line filenames containing either a C<*> or a C<?>
undergo glob expansion. Note that B<peg> replaces consecutive C<*>s with
a C</> separated list of C<*>s. For example, the filename C<***c> is
treated as C<*/*/*c>.

On Windows, you should install the B<CPAN> module C<Win32::Console::ANSI>.
This will enable B<-#> to work, and will also ensure that the correct
output code page is used.

=head1 COREQUISITES

Win32::Console::ANSI

=head1 SCRIPT CATEGORIES

Search

=head1 README

Yet another imitation of the UNIX B<grep> program,
but with the power of Perl expressions.

=head1 HISTORY

=over 4

=item v0.1 summer 1996.

Born as "pgrep".

=item v1.00 September 1999.

Released to CPAN.

=item v2.00

Use File::Find to traverse directories.

Better support for running on Windows.

Now in color!

Lots of new options.

=back

=head1 SEE ALSO

L<perl>, L<perlre>, L<perlreref>, L<http://www.gnu.org/software/grep/>.

=head1 AUTHOR

Alex Davies

=head1 COPYRIGHT

Copyright (c) 1999-2008 Alex Davies. All rights reserved. This program
is free software; you can redistribute it and/or modify it under the
same terms as Perl itself.

=cut