xref: /dports/textproc/greple/greple-5ad6491/bin/greple

#!/usr/local/bin/perl
##
## greple: grep with multiple keywords
##
## Copyright (c) 1991-2017 Kazumasa Utashiro
##
## Original: Mar 29 1991
##
;; our($VERSION) = q$Revision: greple,v 7.1$ =~ /(\d+\.\d+)/g;
;; my $rcsid = q$Id: greple,v 7.1 2017/03/06 03:29:33 utashiro Exp $;
##
## Use and redistribution for ANY PURPOSE are granted as long as all
## copyright notices are retained.  Redistribution with modification
## is allowed provided that you make your modified version obviously
## distinguishable from the original one.  THIS SOFTWARE IS PROVIDED
## BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES ARE
## DISCLAIMED.
##

use strict;
use warnings;

require 5.010;

use File::stat;
use IO::Handle;
use Pod::Usage;
use Text::ParseWords qw(shellwords);
use List::Util qw(min max first sum);
use Scalar::Util qw(blessed);
use Cwd qw(getcwd abs_path);
use Data::Dumper;
use Carp;

use utf8;
use Encode;
use Encode::Guess;

##
## Setting utf8 warnings fatal makes it easy to find code conversion
## error, so you can choose appropreate file code or automatic code
## recognition, but loose a chance to find string in unrelated area.
##
use warnings FATAL => 'utf8';

use Getopt::EX::Loader;
use Getopt::EX::Func qw(parse_func);

use App::Greple::Common;
use App::Greple::Util;
use App::Greple::Grep;
use App::Greple::Regions;
use App::Greple::Pattern;
use App::Greple::Pattern::Holder;
use App::Greple::Filter;


=head1 NAME


greple - grep with multiple keywords


=head1 SYNOPSIS


B<greple> [B<-M>I<module>] [ B<-options> ] pattern [ file... ]

  PATTERN
    pattern              'and +must -not ?alternative &function'
    -e pattern           regex pattern match across line boundary
    -r pattern           regex pattern cannot be compromised
    -v pattern           regex pattern not to be matched
    --le pattern         lexical expression (same as bare pattern)
    --re pattern         regular expression
    --fe pattern         fixed expression
    --file file          file contains search pattern
  MATCH
    -i                   ignore case
    --need=[+-]n         required positive match count
    --allow=[+-]n        acceptable negative match count
  STYLE
    -l                   list filename only
    -c                   print count of matched block only
    -n                   print line number
    -h                   do not display filenames
    -H                   always display filenames
    -o                   print only the matching part
    -m n[,m]             max count of blocks to be shown
    -A[n]                after match context
    -B[n]                before match context
    -C[n]                after and before match context
    --join               delete newline in the matched part
    --joinby=string      replace newline in the matched text by string
    --nonewline          do not add newline character at block end
    --filestyle=style    how filename printed (once, separate, line)
    --linestyle=style    how line number printed (separate, line)
    --separate           set filestyle and linestyle both "separate"
  FILE
    --glob=glob          glob target files
    --chdir              change directory before search
    --readlist           get filenames from stdin
  COLOR
    --color=when         use terminal color (auto, always, never)
    --nocolor            same as --color=never
    --colormap=color     R, G, B, C, M, Y etc.
    --colorful           use default multiple colors
    --ansicolor=s        ANSI color 16, 256 or 24bit
    --[no]256            same as --ansicolor 256 or 16
    --regioncolor        use different color for inside/outside regions
    --uniqcolor          use different color for unique string
    --random             use random color each time
    --face               set/unset vidual effects
  BLOCK
    -p                   paragraph mode
    --all                print whole data
    --block=pattern      specify the block of records
    --blockend=s         specify the block end mark (Default: "--\n")
  REGION
    --inside=pattern     select matches inside of pattern
    --outside=pattern    select matches outside of pattern
    --include=pattern    reduce matches to the area
    --exclude=pattern    reduce matches to outside of the area
    --strict             strict mode for --inside/outside --block
  CHARACTER CODE
    --icode=name         specify file encoding
    --ocode=name         specify output encoding
  FILTER
    --if=filter          input filter command
    --of=filter          output filter command
    --pf=filter          post process filter command
    --noif               disable default input filter
  RUNTIME FUNCTION
    --print=func         print function
    --continue           continue after print function
    --begin=func         call function before search
    --end=func           call function after search
  OTHER
    --norc               skip reading startup file
    --man                display command or module manual page
    --show               display module file
    --require=file       include perl program
    --conceal=type       conceal run time errors
    --persist            continue even after encoding error
    -d flags             display info (f:file d:dir c:color m:misc s:stat)

=cut

my $rcloader = new Getopt::EX::Loader
    BASECLASS => 'App::Greple';

my @opt_e;
my @opt_v;
my @opt_r;
my @opt_re;
my @opt_le;
my @opt_fe;
my @opt_or;

my @opt_if;
my @opt_of;
my @opt_pf;
my @opt_glob;
my @opt_icode;
my @opt_block;
my @opt_inside;
my @opt_outside;
my @opt_include;
my @opt_exclude;
my @opt_chdir;
my @opt_begin;
my @opt_end;
my $opt_noif;
my $opt_all;
my $opt_blockend;
my $opt_color = 'auto';
my $opt_ansicolor = '256';
my @opt_colormap;
my $opt_colorful = 1;
my @opt_face;
my $opt_uniqcolor;
my $opt_random;
my $opt_regioncolor;
my $opt_icode;
my $opt_ocode;
my $opt_man;
my $opt_show;
my $opt_join;
my $opt_joinby = "";
my $opt_newline = 1;
my $opt_clean;
my $opt_readlist;
my $opt_need;
my $opt_allow = 0;
my @opt_need;
my @opt_allow;
my $opt_strict = 0;
my @opt_print;
my $opt_continue;
my $opt_filestyle = 'line';
my $opt_linestyle = 'line';
my %opt_conceal = (read => 1, skip => 0);
my $opt_persist = 0;
my $opt_usage;

my $opt_c;
my @opt_d = ();
my @opt_f;
my $opt_h;
my $opt_i;
my $opt_n;
my $opt_o;
my $opt_m;
my $opt_p;
my $opt_l;
my $opt_A = 0;
my $opt_B = 0;
my $opt_C = 0;
my $opt_H;
#my $opt_M;

my @optargs = (
    'e|and=s'            => \@opt_e,
    'r|must=s'           => \@opt_r,
    'v|not=s'            => \@opt_v,
    'or=s'               => \@opt_or,
    'le=s'               => \@opt_le,
    're=s'               => \@opt_re,
    'fe=s'               => \@opt_fe,
    'need=s'             => \@opt_need,
    'allow=s'            => \@opt_allow,
    'i|ignore-case!'     => \$opt_i,
    'l'                  => \$opt_l,
    'c|count'            => \$opt_c,
    'n|line-number!'     => \$opt_n,
    'h|no-filename'      => \$opt_h,
    'H'                  => \$opt_H,
    'filestyle|fs=s'     => \$opt_filestyle,
    'linestyle|ls=s'     => \$opt_linestyle,
    'separate',          => sub {
	$opt_filestyle = $opt_linestyle = $_[0]
    },
    'o|only-matching!'   => \$opt_o,
    'm|max-count=s'      => \$opt_m,
    'p|paragraph!'       => \$opt_p,
    'A|after-context:2'  => \$opt_A,
    'B|before-context:2' => \$opt_B,
    'C|context:2'        => \$opt_C,
    'all'                => \$opt_all,
    'f|file=s'           => \@opt_f,
    'readlist!'          => \$opt_readlist,
    'd=s'                => \@opt_d,
    'man'                => \$opt_man,
    'show'               => \$opt_show,
    'icode=s'            => \@opt_icode,
    'ocode=s'            => \$opt_ocode,
    'join!'              => \$opt_join,
    'joinby=s'           => \$opt_joinby,
    'newline!'           => \$opt_newline,
    'if=s'               => \@opt_if,
    'of=s'               => \@opt_of,
    'pf=s'               => \@opt_pf,
    'noif'               => \$opt_noif,
    'block=s'            => \@opt_block,
    'blockend:s'         => \$opt_blockend,
    'inside=s'           => \@opt_inside,
    'outside=s'          => \@opt_outside,
    'include=s'          => \@opt_include,
    'exclude=s'          => \@opt_exclude,
    'strict!'            => \$opt_strict,
    'chdir=s'            => \@opt_chdir,
    'glob=s'             => \@opt_glob,
    'begin=s'            => \@opt_begin,
    'end=s'              => \@opt_end,
    'clean!'             => \$opt_clean,
    'color=s'            => \$opt_color,
    'colormap|colormode|addcolor|cm:s'
                         => \@opt_colormap,
    'nocolor|nocolour'   => sub { $opt_color = 'never' },
    'colorful!'          => \$opt_colorful,
    'face=s'             => \@opt_face,
    'uniqcolor|uc!'      => \$opt_uniqcolor,
    'random!'            => \$opt_random,
    'ansicolor=s'        => \$opt_ansicolor,
    '256!'               => sub { $opt_ansicolor = $_[1] ? '256' : '16' },
    'regioncolor|rc!'    => \$opt_regioncolor,
    'print=s'            => \@opt_print,
    'continue!'          => \$opt_continue,
    'conceal=i'          => \%opt_conceal,
    'persist!'           => \$opt_persist,
    'usage:s'            => \$opt_usage,
    'M:s'                => sub {
	warn "Use -M option at the beginning with module name.\n";
	if (my @modules = uniq($rcloader->modules())) {
	    warn "Available modules:\n";
	    warn "\t", join("\n\t", @modules), "\n";
	}
	exit 2;
    },
);

sub newopt {
    push @optargs, @_;
}

my %optargs;
sub setopt {
    unless (%optargs) {
	for (my $i = 0; $i <= $#optargs; $i += 2) {
	    my($spec, $ref) = @optargs[$i, $i + 1];
	    while ($spec =~ /\G(\w+)\|?/g) {
		$optargs{$1} = $ref;
	    }
	}
    }
    my $opt = ref $_[0] eq 'HASH' ? shift : {};
    my $name = shift;
    if (exists $optargs{$name}) {
	my $ref = $optargs{$name};
	if (ref $ref eq 'ARRAY') {
	    if ($opt->{append}) {
		push @$ref, @_;
	    } else {
		@$ref = @_;
	    }
	}
	elsif (ref $ref eq 'CODE') {
	    &$ref($name, @_);
	}
	elsif (ref $ref eq 'SCALAR') {
	    $$ref = shift;
	}
	else {
	    die "Object error.";
	}
    }
}

binmode STDERR, ":encoding(utf8)";


##
## @ARGV staff
##

require Getopt::Long;
my $parser = new Getopt::Long::Parser
    config => [ qw(bundling no_getopt_compat) ] ;
sub configure_getopt { $parser->configure(@_) }

configure_getopt qw(debug) if $ENV{DEBUG_GETOPT};
$Getopt::EX::Loader::debug = 1 if $ENV{DEBUG_GETOPTEX};

## decode
map { $_ = decode 'utf8', $_ unless utf8::is_utf8($_) } @ARGV;

## ~/.greplerc
(@ARGV and $ARGV[0] eq "--norc" and shift) or
    $rcloader->load(FILE => "$ENV{HOME}/.greplerc");

## modules
$rcloader->deal_with(\@ARGV);

push @optargs, $rcloader->builtins;

## ENV
$ENV{'GREPLEOPTS'} and unshift @ARGV, shellwords($ENV{'GREPLEOPTS'});


## GetOptions
my @SAVEDARGV = @ARGV;
$parser->getoptions(@optargs) || pod2usage;

our %opt_d;
@opt_d = map { split // } @opt_d;
@opt_d{@opt_d} = @opt_d;

if ($opt_d{o}) {
    warn "\@ARGV = ", join(' ', shellquote(@SAVEDARGV)), "\n";
}

if (exists $opt_conceal{all}) {
    $opt_conceal{$_} = $opt_conceal{all} for keys %opt_conceal;
}

## -m option
my $splicer = do {
    my($offset, $length);
    if (not defined $opt_m) {
	undef;
    } elsif (($offset) = $opt_m =~ /^(-?\d+)$/) {
	sub { splice @{+shift}, $offset }
    } elsif (($offset, $length) = $opt_m =~ /^(-?\d+),(-?\d+)?$/) {
	sub { splice @{+shift}, $offset, $length }
    } else {
	die "$opt_m: option format error.\n";
    }
};

my $file_code;
my $default_icode = 'utf8';	# default input encoding
my @default_icode_list = qw(euc-jp 7bit-jis);
my $output_code;
my $default_ocode = 'utf8';	# default output encoding

$output_code = $opt_ocode || $default_ocode;
binmode STDOUT, ":encoding($output_code)";

## show unused option characters
if ($opt_d{u}) {
    my $s = join('','0'..'9',"\n",'a'..'z',"\n",'A'..'Z',"\n");
    map { /^([0-9a-zA-Z])(?:\|[^=]+)*(?:=[is])?$/ && $s =~ s/$1/./ } @optargs;
    die $s;
}

## show man pages
if ($opt_man or $opt_show) {
    my @bucket = $rcloader->buckets;
    if (@bucket and (my $mod = $bucket[-1]->title) ne ".greplerc") {
	my @perldocopt = $opt_show ? '-m' : () ;
	my $jp = first { -x "$_/perldocjp" } split /:/, $ENV{PATH};
	my $perldoc = $jp ? "perldocjp" : "perldoc";
	$ENV{PERL5LIB} = join ':', @INC;
	my $command = "$perldoc @perldocopt App::Greple::$mod";
	warn $command, "\n" if $opt_d{m};
	exec $command or die $!;
    }
    pod2usage({-verbose => 2});
    die;
}

## setup file encoding
if (@opt_icode) {
    @opt_icode = map { split /[,\s]+/ } @opt_icode;
    if (grep { s/^\+// } @opt_icode) {
	unshift @opt_icode, @default_icode_list;
    }
    @opt_icode = uniq(@opt_icode);
    if (@opt_icode > 1) {
	@opt_icode = grep { !/(?:auto|guess)$/i } @opt_icode;
	Encode::Guess->set_suspects(@opt_icode);
	$file_code = 'Guess';
    }
    elsif ($opt_icode[0] =~ /^(?:guess|auto)$/i) {
	Encode::Guess->set_suspects(@default_icode_list);
	$file_code = 'Guess';
    } else {
	$file_code = $opt_icode[0];
    }
}
else {
    $file_code = $default_icode;
}

##
## Patterns
##

my $pat_holder = new App::Greple::Pattern::Holder;

my $FLAG_BASE = FLAG_NONE;
$FLAG_BASE |= FLAG_IGNORECASE if $opt_i;

if (@opt_f) {
    for my $opt_f (@opt_f) {
	$pat_holder->append({ flag => $FLAG_BASE, type => 'file' },
			    $opt_f);
    }
} else {
    if (@opt_le + @opt_re + @opt_fe + @opt_or + @opt_e + @opt_r == 0) {
	&usage if @ARGV == 0;
	unshift @opt_le, shift @ARGV;
    }
}

for ([ \@opt_r,  FLAG_REGEX | FLAG_COOK | FLAG_REQUIRED ],
     [ \@opt_v,  FLAG_REGEX | FLAG_COOK | FLAG_NEGATIVE ],
     [ \@opt_le, FLAG_REGEX | FLAG_COOK | FLAG_LEXICAL  ],
     [ \@opt_or, FLAG_REGEX | FLAG_COOK | FLAG_OR       ],
     [ \@opt_e,  FLAG_REGEX | FLAG_COOK                 ],
     [ \@opt_re, FLAG_REGEX                             ],
     [ \@opt_fe, FLAG_NONE                              ])
{
    my($opt, $flag) = @$_;
    $pat_holder->append({ flag => $FLAG_BASE | $flag, type => 'pattern' },
			@$opt) if @$opt;
}

##
## set $opt_need and $opt_alow
##
{
    my $must = grep({ $_->is_required } $pat_holder->patterns);
    my $posi = grep({ $_->is_positive } $pat_holder->patterns) - $must;
    my $nega = grep({ $_->is_negative } $pat_holder->patterns);

    $opt_need = $must ? 0 : $posi;
    for (@opt_need) {
	if (/^-(\d+)$/) {	# --need -n
	    $opt_need = $posi - $1;
	}
	elsif (/^\+(\d+)$/) {	# --need +n
	    $opt_need += $1;
	}
	elsif (/^(\d+)$/) {	# --need n
	    $opt_need = $1 - $must;
	}
	else {
	    die "$_ is not valid count.\n"
	}
    }

    $opt_allow = 0;
    for (@opt_allow) {
	if (/^-(\d+)$/) {	# --allow -n
	    $opt_allow = $nega - $1;
	}
	elsif (/^\+(\d+)$/) {	# --allow +n
	    $opt_allow += $1;
	}
	elsif (/^(\d+)$/) {	# --allow n
	    $opt_allow = $1;
	}
	else {
	    die "$_ is not valid count.\n"
	}
    }
}

##
## setup input/output filter
##
my $filter_d = new App::Greple::Filter;
$filter_d->parse(@opt_if);
unless ($opt_noif) {
    $filter_d->append(
	[ sub { s/\.Z$//   }, 'zcat' ],
	[ sub { s/\.g?z$// }, 'gunzip -c' ],
	[ sub { m/\.pdf$/i }, 'pdftotext -nopgbrk - -' ],
	[ sub { s/\.gpg$// }, 'gpg --quiet --no-mdc-warning --decrypt' ]);
}

##------------------------------------------------------------
## miscellaneous setups
##

my @argv_files;
my $start_directory;
my $need_filename = ($opt_H or $opt_l);
my $current_file;

if (@opt_chdir) {
    $start_directory = getcwd;
    @opt_chdir = uniq(map { glob $_ } @opt_chdir);
    push @argv_files, splice(@ARGV);
    unless ($opt_h or
	    (@opt_chdir == 1 and @argv_files == 1 and @opt_glob == 0)) {
	$need_filename++;
    }
}
elsif (@opt_glob) {
    push @ARGV, map(glob, @opt_glob);
}

push(@ARGV, '-') unless @ARGV || @argv_files || @opt_glob || $opt_readlist;
if ((@ARGV > 1 or $opt_readlist) and not $opt_h) {
    $need_filename++;
}

$opt_join = 1 if $opt_joinby ne "";

##------------------------------------------------------------
## colors
##
my %colormap = (
    FILE     => "G",
    LINE     => "Y",
    BLOCKEND => "",
    );

my @colors;

require Getopt::EX::Colormap;
my $color_handler = new Getopt::EX::Colormap
    HASH => \%colormap,
    LIST => \@colors,
    ;
$color_handler->load_params(@opt_colormap);

my @default_color =
    $opt_ansicolor eq '16'
    ? qw(RD GD BD CD MD YD)
    : qw(DK/544 DK/454 DK/445
	 DK/455 DK/545 DK/554
	 DK/543 DK/453 DK/435
	 DK/534 DK/354 DK/345
	 DK/444
	 DK/433 DK/343 DK/334
	 DK/344 DK/434 DK/443
	 DK/333)
    ;

if ($color_handler->list == 0) {
    $color_handler->append
	($opt_colorful ? @default_color : $default_color[0]);
}

if ($opt_ansicolor eq '24bit') {
    no warnings 'once';
    $Getopt::EX::Colormap::COLOR_RGB24 = 1;
}

if (@opt_face) {
    my $remove = 0;
    for my $flag (map { split // } @opt_face) {
	if ($flag eq '-' or $flag eq '+') {
	    $remove = $flag eq '-';
	    next;
	}
	map { $remove ? s/$flag//g : s/^/$flag/ } @colors;
    }
}

my $need_color = (($opt_color eq 'always')
		  or (($opt_color eq 'auto') and (!$opt_o and -t STDOUT)));

if ($opt_d{c}) {
    my $dump = sub {
	local $_ = Dumper shift;
	s/(?<=')([\w\/]+)(?=')/color($1, $1)/ge;
	$_;
    };
    warn 'colormap = ', $dump->(\%colormap);
    warn 'colors = ', $dump->(\@colors);
}

sub _file     { $color_handler->color('FILE'    , @_) }
sub _line     { $color_handler->color('LINE'    , @_) }
sub _delim    { $color_handler->color('DELIM'   , @_) }
sub _blockend { $color_handler->color('BLOCKEND', @_) }

sub index_color {
    $color_handler->index_color(@_);
}

sub color {
    $color_handler->color(@_);
}

my $uniq_color = new UniqIndex
    ignore_newline => 1;

sub dump_uniqcolor {
    my $list = $uniq_color->list;
    for my $i (0 .. $#{ $list }) {
	warn sprintf "%d %s\n", $i, index_color($i, $list->[$i]);
    }
}


my $blockend = "--\n";
if (defined $opt_blockend) {
    ($blockend = $opt_blockend) =~ s/(?<=.)$/\n/;
}
if ($opt_C) {
    $opt_A ||= $opt_C;
    $opt_B ||= $opt_C;
}
my %stat = (
    files => 0,
    match_effective => 0,
    match_positive => 0,
    match_negative => 0,
    match_block => 0,
    time_start => [],
    time_end => [],
    );

##
## Setup functions
##
for my $set (
    [ "print"  , \@opt_print  , 0 ],
    [ "begin"  , \@opt_begin  , 0 ],
    [ "end"    , \@opt_end    , 0 ],
    [ "block"  , \@opt_block  , 1 ], # need &
    [ "inside" , \@opt_inside , 1 ], # need &
    [ "outside", \@opt_outside, 1 ], # need &
    [ "include", \@opt_include, 1 ], # need &
    [ "exclude", \@opt_exclude, 1 ], # need &
    ) {
    my($cat, $opt, $pattern) = @$set;
    for (@{$opt}) {
	next if $_->can('call');
	/^&\w+/ or next if $pattern;
	$_ = parse_func($_) or die "$cat function format error: $_\n";
    }
}

my $regions = new App::Greple::Regions::Holder;
for my $set (
    [ \@opt_inside,  REGION_INSIDE  | REGION_UNION     ],
    [ \@opt_outside, REGION_OUTSIDE | REGION_UNION     ],
    [ \@opt_include, REGION_INSIDE  | REGION_INTERSECT ],
    [ \@opt_exclude, REGION_OUTSIDE | REGION_INTERSECT ])
{
    my($opt, $flag) = @$set;
    for my $spec (@$opt) {
	append $regions FLAG => $flag, SPEC => $spec;
    }
}

##------------------------------------------------------------

if ($opt_d{m}) {
    warn "Search pattern:\n";
    my $i;
    for my $pat ($pat_holder->patterns) {
	my $type =
	    $pat->is_function ? 'func' :
	    $pat->is_required ? 'must' :
	    $pat->is_negative ? 'not ' :
	    $pat->is_positive ? 'and ' : 'unknown';
	my $target = $pat->cooked;
	warn sprintf("  %s %s\n",
		     $type,
		     @colors > 1 ? index_color($i++, $target) : $target);
    }
    warn sprintf "need = %d, allow = %d\n", $opt_need, $opt_allow;
}

## push post-process filter
if (@opt_pf) {
    push_output_filter(\*STDOUT, @opt_pf);
}

usage() and exit if defined $opt_usage;

open SAVESTDIN,  '<&', \*STDIN  or die "open: $!";
open SAVESTDOUT, '>&', \*STDOUT or die "open: $!";
open SAVESTDERR, '>&', \*STDERR or die "open: $!";

sub recover_stdin {
    open STDIN, '<&', \*SAVESTDIN or die "open: $!";
}
sub recover_stderr {
    open STDERR, '>&', \*SAVESTDERR or die "open: $!";
    binmode STDERR, ':encoding(utf8)';
}
sub recover_stdout {
    close STDOUT;
    open STDOUT, '>&', \*SAVESTDOUT or die "open: $!";
}
sub close_stdout {
    close SAVESTDOUT;
    close STDOUT;
}

sub read_stdin { <SAVESTDIN> }

my($before_read, $after_read);
if ($opt_conceal{read}) {
    $before_read = sub { close STDERR };
    $after_read  = sub { recover_stderr };
}

##------------------------------------------------------------
## now ready to run.
##

## record start time
if ($opt_d{s}) {
    $stat{time_start} = [times];
}

grep_files();

if ($opt_uniqcolor and $opt_d{m}) {
    dump_uniqcolor();
}

## show statistic info
if ($opt_d{s}) {

    $stat{time_end} = [times];
    my @s = @{$stat{time_start}};
    my @e = @{$stat{time_end}};
    printf(STDERR "cpu %.3fu %.3fs\n", $e[0]-$s[0], $e[1]-$s[1]);

    local $" = ', ';
    for my $k (sort keys %stat) {
	my $v = $stat{$k};
	print STDERR
	    "$k: ",
	    ref $v eq 'ARRAY' ? "(@$v)" : $v,
	    "\n";
    }
}

close_stdout;

if ($opt_d{p}) {
    open STDOUT, ">&STDERR";
    system "ps -lww -p $$";
    system "lsof -p $$";
}

exit($stat{match_effective} == 0);

######################################################################

sub grep_files {
  FILE:
    while (defined($current_file = open_nextfile())) {

	&$before_read() if $before_read;
	my $content = eval { local $/; <STDIN> };
	&$after_read() if $after_read;

	if (not defined $content) {
	    warn $@ if $@;
	    if (not $opt_persist) {
		warn "SKIP $current_file\n" unless $opt_conceal{skip};
		next FILE;
	    }

	    # Try again
	    binmode STDIN, ':raw';
	    $content = eval { local $/; <STDIN> };
	    if (not defined $content) {
		warn "SKIP* $current_file\n" unless $opt_conceal{skip};
		next FILE;
	    }
	    binmode STDOUT, ':raw';
	}

	warn $current_file, ":\n" if $opt_d{f};

	my $matched = grep_data(\$content);

	no warnings 'uninitialized'; # why ?
	$stat{match_effective} += $matched;
	$stat{files}++;
    } continue {
	close STDIN; # wait;	# wait for 4.019 or earlier?
	# recover STDIN for opening '-' and some weird command which needs
	# STDIN opened (like unzip)
	recover_stdin;
    }
}

sub usage {
    pod2usage(-verbose => 0, -exitval => "NOEXIT");

    my $quote = qr/[\\(){}\|\*?]/;
    for my $bucket ($rcloader->buckets) {
	my $title = $bucket->title;
	print "    $title options:\n";
	for my $name ($bucket->options) {
	    my $help = $opt_usage ? "" : $bucket->help($name) // "";
	    next if $help eq 'ignore';
	    my @option = $bucket->getopt($name, ALL => 1);
	    printf("        %-20s %s\n", $name,
		   $help || join(' ', shellquote(@option)));
	}
	print "\n";
    }

    print "$rcsid\n" if $rcsid =~ /:/;

    exit 2;
}

sub open_nextfile {

    ##
    ## --chdir
    ##
    while (@ARGV == 0 and @opt_chdir and (@argv_files or @opt_glob)) {
	my $dir = shift @opt_chdir;
	warn "chdir $dir/\n" if $opt_d{d};
	chdir $start_directory or die "$!: $start_directory\n";
	chdir $dir or die "$!: $dir\n";
	push @ARGV, @argv_files, map(glob, @opt_glob);
    }

    my $file;
    while (defined($file = shift(@ARGV)) ||
	   defined($file = $opt_readlist && read_stdin)) {
	$file =~ s/\n+$//;

	if (0) {}
	elsif ($file =~ /^http:\/\//) {
	    open(STDIN, '-|') || exec("w3m -dump $file") || die "w3m: $!\n";
	}
	else {
	    open(STDIN, $file) or do {
		warn "$file: $!\n" unless -l $file;
		next;
	    };
	}

	if (my @filters = $filter_d->get_filters($file)) {
	    push_input_filter(@filters);
	}

	if ($file_code eq 'binary') {
	    # binmode STDIN, ":raw";
	} else {
	    binmode STDIN, ":encoding($file_code)";
	}

	return $file;
    }
    undef;
}

######################################################################

sub grep_data {
    local *_ = shift;

    ##
    ## --begin
    ##
    for my $f (@opt_begin) {
	$f->call(&FILELABEL => $current_file);
    }

    my $grep = new App::Greple::Grep (
	text         => \$_,
	filename     => $current_file,
	pattern      => $pat_holder,
	regions      => $regions,
	after        => $opt_A,
	before       => $opt_B,
	paragraph    => $opt_p,
	only         => $opt_o,
	all          => $opt_all,
	block        => \@opt_block,
	need         => $opt_need,
	allow        => $opt_allow,
	strict       => $opt_strict,
	region_index => $opt_regioncolor,
	stat         => \%stat,
	)->run;
    my $matched = $grep->matched;

    $splicer->($grep->result_ref) if $splicer;

    if ($opt_l) {
	print "$current_file\n" if $matched;
    }
    elsif ($opt_c) {
	print "$current_file:" if $need_filename;
	print scalar $grep->blocks, "\n";
    }
    elsif (@{$grep->result_ref}) {
	# open output filter
	@opt_of && push_output_filter(\*STDOUT, @opt_of);
	display_result($grep);
	@opt_of && recover_stdout;
    }

    ##
    ## --end
    ##
    for my $f (@opt_end) {
	$f->call(&FILELABEL => $current_file);
    }

    s/./\000/gs if $opt_clean;

    $matched;
}

sub display_result {
    my $grep = shift;
    my $file = $grep->{filename};

    if ($need_filename and $opt_filestyle eq 'once') {
	print $file, ":\n";
    }

    my $need_blockend =
	$opt_blockend || $opt_p || $opt_A || $opt_B || @opt_block;

    my $line = 1;
    my $lastpos = 0;
    for my $result ($grep->result) {

	my($block_start, $block_end) = @{shift @$result};
	my $block = $grep->cut($block_start, $block_end);

	for my $func (@opt_print) {
	    for ($block) {
		$_ = $func->call(&FILELABEL => $file, matched => $result);
	    }
	}
	if (@opt_print and not $opt_continue) {
	    print $block if defined $block;
	    next;
	}

	if ($opt_n) {
	    my $gap = $grep->cut($lastpos, $block_start);
	    $line += $gap =~ tr/\n/\n/;
	}
	$lastpos = $block_end;

	if (my $nl = 0, 1) {
	    if ($need_filename and $opt_filestyle eq 'separate') {
		print _file("$current_file:");
		$nl++;
	    }
	    if ($opt_n and $opt_linestyle eq 'separate') {
		print _line("$line:");
		$nl++;
	    }
	    print "\n" if $nl;
	}

	my $mark = "\001";
	for my $matched (reverse @$result) {
	    my($ms, $me, $pi) = @$matched;
	    next if $ms == $me;

	    $ms = max($ms - $block_start, 0);
	    $me -= $block_start;
	    my $s = substr($block, $ms, $me - $ms);

	    if ($opt_join) {
		if ($opt_n and $opt_linestyle eq 'line') {
		    $s =~ s/(?<!\A)\n(?!\z)/$mark/g;
		} else {
		    $s =~ s/(?<!\A)\n(?!\z)/$opt_joinby/g;
		}
	    }

	    # --random
	    if ($opt_random) {
		$pi = rand(@colors);
	    }
	    # --uniqcolor
	    elsif ($opt_uniqcolor) {
		$pi = $uniq_color->index($s);
	    }

	    substr($block, $ms, $me - $ms,
		   $need_color ? index_color($pi, $s) : $s);
	}
	if ($opt_n) {
	    if ($opt_linestyle eq 'line') {
		my $increment = $block =~ /[\n$mark]/ ? 1 : 0;
		$block =~ s{(?:($mark)|(?<=\n)|\A)(?=.)}{
			    my $s = $1 ? $opt_joinby
				       : _line("$line:");
			    $line += $increment;
			    $s;
			   }gse;
	    } else {
		$line += $block =~ tr/\n/\n/;
	    }
	}

	if ($need_filename and $opt_filestyle eq 'line') {
	    my $s = _file("$file:");
	    $block =~ s/^/$s/mg;
	}

	print $block;
	print "\n" if $opt_newline and not $block =~ /\n\z/;
	print _blockend($blockend) if $need_blockend;
    }
}


__END__


=head1 DESCRIPTION


=head2 MULTIPLE KEYWORDS


B<greple> has almost the same function as Unix command L<egrep(1)> but
the search is done in the manner similar to search engine.  For
example, next command print lines those contain all of `foo' and `bar'
and `baz'.

    greple 'foo bar baz' ...

Each word can be found in any order and/or any place in the string.
So this command find all of following texts.

    foo bar baz
    baz bar foo
    the foo, bar and baz

If you want to use OR syntax, prepend question (`?') mark on each
token, or use regular expression.

    greple 'foo bar baz ?yabba ?dabba ?doo'
    greple 'foo bar baz yabba|dabba|doo'

This command will print the line which contains all of `foo', `bar'
and `baz' and one or more from `yabba', `dabba' or `doo'.

NOT operator can be specified by prefixing the token by minus (`-')
sign.  Next example will show the line which contain both `foo' and
bar' but none of `yabba' or `dabba' or `doo'.

    greple 'foo bar -yabba -dabba -doo'

This can be written as this using B<-e> and B<-v> option.

    greple -e foo -e bar -v yabba -v dabba -v doo
    greple -e foo -e bar -v 'yabba|dabba|doo'

If `+' is placed to positive matching pattern, that pattern is marked
as required, and match required count is automatically set to the
number of required pattern.  So

    greple '+foo bar baz'

commands implicitly set the option C<--need 1>, and consequently print
all lines including `foo'.  If you want to search lines which includes
either or both of `bar' and `baz', use like this:

    greple '+foo bar baz' --need 2
    greple '+foo bar baz' --need +1

=head2 LINE ACROSS MATCH


B<greple> also search the pattern across the line boundaries.  This is
especially useful to handle Asian multi-byte text.  Japanese text can
be separated by newline almost any place of the text.  So the search
pattern may spread out on multiple lines.

As for ascii text, space character in the pattern matches any kind of
space including newline.  Next example will search the word sequence
of `foo', `bar' and 'baz', even they spread out to multiple lines.

    greple -e 'foo bar baz'

Option B<-e> is necessary because space is taken as a token separator
in the bare or B<--le> pattern.


=head1 OPTIONS


=head2 PATTERNS


If no specific option is given, B<greple> takes the first argument as
a search pattern specified by B<--le> option.  All of these patterns
can be specified multiple times.

Command itself is written in Perl, and any kind of Perl style regular
expression can be used in patterns.  See L<perlre(1)> for detail.

Note that multiple line modifier (C<m>) is set when executed, so put
C<(?-m)> at the beginning of regex if you want to explicitly disable
it.

Order of capture group in the pattern is not guaranteed.  Please avoid
to use direct index, and use relative or named capture group instead.
For example, repeated character can be written as S<C<(\w)\g{-1}>>
or S<C<(?E<lt>cE<gt>\w)\g{c}>>.

=over 7

=item B<--le>=I<pattern>

Treat the string as a collection of tokens separated by spaces.  Each
token is interpreted by the first character.  Token start with `-'
means negative pattern, `?' means alternative, and `+' does required.

Next example print lines which contains `foo' and `bar', and one or
more of `yabba' and 'dabba', and none of `baz' and `doo'.

    greple --le='foo bar -baz ?yabba ?dabba -doo'

Multiple `?' preceded tokens are treated all mixed together.  That
means `?A|B ?C|D' is equivalent to `?A|B|C|D'.  If you want to mean
`(A or B) and (C or D)', use AND syntax instead: `A|B C|D'.

If the pattern start with ampersand (`&'), it is treated as a
function, and the function is called instead of searching pattern.
Function call interface is same as the one for block/region options.

If you have a definition of I<odd_line> function in you F<.greplerc>,
which is described in this manual later, you can print odd number
lines like this:

    greple -n '&odd_line' file

This is the summary of start character for B<--le> option:

    +  Required pattern
    -  Negative match pattern
    ?  Alternative pattern
    &  Function call

=item B<-e> I<pattern>, B<--and>=I<pattern>

Specify positive match token.  Next two commands are equivalent.

    greple 'foo bar baz'
    greple -e foo -e bar -e baz

First character is not interpreted, so next commands will search the
pattern `-baz'.

    greple -e -baz

Space characters are treated specially by B<-e> and B<-v> options.
They are replaced by the pattern which matches any number of
white spaces including newline.  So the pattern can be expand to
multiple lines.  Next commands search the series of word `foo', `bar'
and `baz' even if they are separated by newlines.

    greple -e 'foo bar baz'

=item B<-r> I<pattern>, B<--must>=I<pattern>

Specify required match token.  Next two commands are equivalent.

    greple '+foo bar baz'
    greple -r foo -e bar -e baz

=item B<-v> I<pattern>, B<--not>=I<pattern>

Specify negative match token.  Because it does not affect to the bare
pattern argument, you can narrow down the search result like this.

    greple foo file
    greple foo file -v bar
    greple foo file -v bar -v baz

=item B<--re>=I<pattern>

Specify regular expression.  No special treatment for space and wide
characters.

=item B<--fe>=I<pattern>

Specify fixed string pattern, like fgrep.

=item B<-i>, B<--ignore-case>

Ignore case.

=item B<--need>=I<n>

=item B<--allow>=I<n>

Option to compromise matching condition.  Option B<--need> specifies
the required match count, and B<--allow> the number of negative
condition to be overlooked.

    greple --need=2 --allow=1 'foo bar baz -yabba -dabba -doo'

Above command prints the line which contains two or more from `foo',
`bar' and `baz', and does not include more than one of `yabba',
`dabba' or `doo'.

Using option B<--need>=I<1>, B<greple> produces same result as B<grep>
command.

    grep -e foo -e bar -e baz
    greple --need=1 -e foo -e bar -e baz

When the count I<n> is negative value, it is subtracted from default
value.

=item B<-f> I<file>, B<--file>=I<file>

Specify the file which contains search pattern.  When file contains
multiple lines, patterns on each lines are search in OR context.

Blank line and the line starting with sharp (#) character is ignored.
Two slashes (//) and following string are taken as a comment and
removed with preceding spaces.

Multiple file can be specified, but they will be mixed into single
pattern.

=back


=head2 STYLES


=over 7

=item B<-l>

List filename only.

=item B<-c>, B<--count>

Print count of matched block.

=item B<-n>, B<--line-number>

Show line number.

=item B<-h>, B<--no-filename>

Do not display filename.

=item B<-H>

Display filename always.

=item B<-o>, B<--only-matching>

Print matched string only.

=item B<-m> I<n>[,I<m>], B<--max-count>=I<n>[,I<m>]

Set the maximum count of blocks to be shown to I<n>.

Actually I<n> and I<m> are simply passed to perl L<splice> function as
I<offset> and I<length>.  Works like this:

    greple -m  10      # get first 10 blocks
    greple -m   0,-10  # get last 10 blocks
    greple -m   0,10   # remove first 10 blocks
    greple -m -10      # remove last 10 blocks
    greple -m  10,10   # remove 10 blocks from 10th (10-19)

This option does not affect to search performance and command exit
status.

=item B<-A>[I<n>], B<--after-context>[=I<n>]

=item B<-B>[I<n>], B<--before-context>[=I<n>]

=item B<-C>[I<n>], B<--context>[=I<n>]

Print I<n>-blocks before/after matched string.  The value I<n> can be
omitted and the default is 2.  When used with B<--paragraph> or
B<--block> option, I<n> means number of paragraph or block.

Actually, these options expand the area of logical operation.  It
means

    grep -C1 'foo bar baz'

matches following text.

    foo
    bar
    baz

Moreover

    greple -C1 'foo baz'

also matches this text, because matching blocks around `foo' and `bar'
overlaps each other and makes single block.

=item B<--join>

=item B<--joinby>=I<string>

Convert newline character found in matched string to empty or specified
I<string>.  Using B<--join> with B<-o> (only-matching) option, you can
collect searching sentence list in one per line form.  This is
sometimes useful for Japanese text processing.  For example, next
command prints the list of KATAKANA words, including those spread
across multiple lines.

    greple -ho --join '\p{InKatakana}+(\n\p{InKatakana}+)*'

Space separated word sequence can be processed with B<--joinby>
option.  Next example prints all `for *something*' pattern in pod
documents within Perl script.

    greple -Mperl --pod -ioe '\bfor \w+' --joinby ' '

=item B<--[no]newline>

Since B<greple> can handle arbitrary blocks other than normal text
lines, they sometimes do not end by newline character.  In that case,
extra newline is appended at the end of block to be shown.  Option
B<--nonewline> disables this behaviour.

=item B<--filestyle>=I<line>|I<once>|I<separate>, B<--fs>

Default style is I<line>, and B<greple> prints filename at the
beginning of each line.  Style I<once> prints the filename only once
at the first time.  Style I<separate> prints filename in the separate
line before each line or block.

=item B<--linestyle>=I<line>|I<separate>, B<--ls>

Default style is I<line>, and B<greple> prints line numbers at the
beginning of each line.  Style I<separate> prints line number in the
separate line before each line or block.

=item B<--separate>

Shortcut for B<--filestyle>=I<separate> B<--linestyle>=I<separate>.
This is convenient to use block mode search and visiting each location
from supporting tool, such as Emacs.

=back


=head2 FILES


=over 7

=item B<--glob>=I<pattern>

Get files matches to specified pattern and use them as a target files.
Using B<--chdir> and B<--glob> makes easy to use B<greple> for fixed
common job.

=item B<--chdir>=I<directory>

Change directory before processing files.  When multiple directories
are specified in B<--chdir> option, by using wildcard form or
repeating option, B<--glob> file expansion will be done for every
directories.

    greple --chdir '/usr/man/man?' --glob '*.[0-9]' ...

=item B<--readlist>

Get filenames from standard input.  Read standard input and use each
line as a filename for searching.  You can feed the output from other
command like L<find(1)> for B<greple> with this option.  Next example
searches string from files modified within 7 days:

    find . -mtime -7 -print | greple --readlist pattern

Using B<find> module, this can be done like:

    greple -Mfind . -mtime -7 -- pattern

=back


=head2 COLORS


=over 7

=item B<--color>=I<auto>|I<always>|I<never>, B<--nocolor>

Use terminal color capability to emphasize the matched text.  Default
is `auto': effective when STDOUT is a terminal and option B<-o> is not
given, not otherwise.  Option value `always' and `never' will work as
expected.

Option B<--nocolor> is alias for B<--color>=I<never>.

=item B<--colormap>=I<spec>

Specify color map.  Default is RD: RED and BOLD.

Color specification is combination of single uppercase character
representing 8 colors :

    R  Red
    G  Green
    B  Blue
    C  Cyan
    M  Magenta
    Y  Yellow
    K  Black
    W  White

and alternative (usually brighter) colors in lowercase:

    r, g, b, c, m, y, k, w

or RGB value and 24 grey levels if using ANSI 256 color terminal :

    000000 .. FFFFFF : 24bit RGB colors
    000 .. 555       : 6x6x6 RGB 216 colors
    L00 .. L23       : 24 grey levels

=over 4

Note that, when values are all same in 24bit RGB, it is converted to
24 grey level, otherwise 6x6x6 216 color.

=back

with other special effects :

    Z  Zero (reset)
    D  Double-struck (boldface)
    P  Pale (dark)
    I  Italic
    S  Stand-out (reverse video)
    V  Vanish (concealed)
    U  Underline
    F  Flash (blink)

    ;  No effect
    X  No effect

If the spec includes C</>, left side is considered for foreground
color and right side is for background.  If multiple colors are
given in same spec, all indicators are produced in the order of
their presence.  As a result, the last one takes effect.

Effect characters are case insensitive, and can be found anywhere and
in any order in color spec string.  Because C<X> and C<;> takes no
effect, you can use them to improve readability, like C<SxD;K/544>.

Samples:

    RGB  6x6x6    24bit           color
    ===  =======  =============   ==================
    B    005      0000FF        : blue foreground
     /M     /505        /FF00FF : magenta background
    K/W  000/555  000000/FFFFFF : black on white
    R/G  500/050  FF0000/00FF00 : red on green
    W/w  L03/L20  303030/c6c6c6 : grey on grey

Multiple colors can be specified separating by white space or comma,
or by repeating options.  Those colors will be applied for each
pattern keywords.  Next command will show word `foo' in red, `bar' in
green and `baz' in blue.

    greple --colormap='R G B' 'foo bar baz'

    greple --cm R -e foo --cm G -e bar --cm B -e baz

=item B<--colormap>=I<field>=I<spec>,I<field>=I<spec>,...

Another form of colormap option to specify the color for fields:

    FILE      File name
    LINE      Line number
    BLOCKEND  Block end mark

=item B<--colormap>=I<&func> B<--colormap>=I<sub{...}>

You can also set the name of perl subroutine name or definition to be
called handling matched words.  Target word is passed as variable
C<$_>, and the return value of the subroutine will be displayed.

Next command convert all words in C comment to upper case.

    greple --all '/\*(?s:.*?)\*/' --cm 'sub{uc}'

You can quote matched string instead of coloring (this emulates
deprecated option B<--quote>):

    greple --cm 'sub{"<".$_.">"}' ...

It is possible to use this definition with field names.  Next example
print line numbers in seven digits.

    greple -n --cm 'LINE=sub{s/(\d+)/sprintf("%07d",$1)/e;$_}'

Experimentally, function can be combined with other normal color
specifications.  Also the form I<&func;> can be repeated.

    greple --cm 'BF/544;sub{uc}'

    greple --cm 'R;&func1;&func2;&func3'

=item B<--[no]colorful>

Shortcut for B<--colormap>='I<RD GD BD CD MD YD>' in ANSI 16 colors
mode, and B<--colormap>='I<D/544 D/454 D/445 D/455 D/454 D/554>' and
other combination of 3, 4, 5 for 256 colors mode.  Enabled by default.

=item B<--ansicolor>=I<16>|I<256>|I<24bit>

If set as I<16>, use ANSI 16 colors as a default color set, otherwise
ANSI 256 colors.  When set as I<24bit>, 6 hex digits notation produces
24bit color sequence.  Default is I<256>.

=item B<--[no]256>

Shortcut for B<--ansicolor>=I<256> or I<16>.

=item B<--regioncolor>

Use different colors for each B<--inside>/B<outside> regions.
Disabled by default.

=item B<--uniqcolor>

Use different colors for different string matched.
Disabled by default.

Next example prints all words start by `color' and display them all in
different colors.

    greple --uniqcolor 'colou?r\w*'

=item B<--random>

Use random selected color to display matched string each time.
Disabled by default.

=item B<--face>=[-+]I<effect>

Set or unset specified I<effect> for all color specs.  Use `+'
(optional) to set, and `-' to unset.  Effect is a single character
expressing: S (Stand-out), U (Underline), D (Double-struck), F (Flash).

Next example remove D (double-struck) effect.

    greple --face -D

Multiple effects can be set/unset at once.

    greple --face SF-D

=back


=head2 BLOCKS


=over 7

=item B<-p>, B<--paragraph>

Print the paragraph which contains the pattern.  Each paragraph is
delimited by two or more successive newline characters by default.  Be
aware that an empty line is not paragraph delimiter if which contains
space characters.  Example:

    greple -np 'setuid script' /usr/man/catl/perl.l

    greple -pe '^struct sockaddr' /usr/include/sys/socket.h

It changes the unit of context specified by B<-A>, B<-B>, B<-C>
options.

=item B<--all>

Treat entire file contents as a single block.  This is almost
identical to following command.

    greple --block='(?s).*'

=item B<--block>=I<pattern>, B<--block>=I<&sub>

Specify the record block to display.  Default block is a single line.

Next example behave almost same as B<--paragraph> option, but is less
efficient.

    greple --block='(.+\n)+'

Next command treat the data as a series of 10-line blocks.

    greple -n --block='(.*\n){1,10}'

When blocks are not continuous and there are gaps between them, the
match occurred outside blocks are ignored.

If multiple block options are supplied, overlapping blocks are merged
into single block.

Please be aware that this option is sometimes quite time consuming,
because it finds all blocks before processing.

=item B<--blockend>=I<string>

Change the end mark displayed after B<-pABC> or B<--block> options.
Default value is "--\n".

=back


=head2 REGIONS


=over 7

=item B<--inside>=I<pattern>

=item B<--outside>=I<pattern>

Option B<--inside> and B<--outside> limit the text area to be matched.
For simple example, if you want to find string `and' not in the word
`command', it can be done like this.

    greple --outside=command and

The block can be larger and expand to multiple lines.  Next command
searches from C source, excluding comment part.

    greple --outside '(?s)/\*.*?\*/'

Next command searches only from POD part of the perl script.

    greple --inside='(?s)^=.*?(^=cut|\Z)'

When multiple B<inside> and B<outside> regions are specified, those
regions are mixed up in union way.

In multiple color environment, and if single keyword is specified,
matches in each B<--inside>/B<outside> regions are printed in
different colors.  Forcing this operation with multiple keywords, use
B<--regioncolor> option.

=item B<--inside>=I<&function>

=item B<--outside>=I<&function>

If the pattern name begins by ampersand (&) character, it is treated
as a name of subroutine which returns a list of blocks.  Using this
option, user can use arbitrary function to determine from what part of
the text they want to search.  User defined function can be defined in
F<.greplerc> file or by module option.

=item B<--include>=I<pattern>

=item B<--exclude>=I<pattern>

=item B<--include>=I<&function>

=item B<--exclude>=I<&function>

B<--include>/B<exclude> option behave exactly same as
B<--inside>/B<outside> when used alone.

When used in combination, B<--include>/B<exclude> are mixed in AND
manner, while B<--inside>/B<outside> are in OR.

Thus, in the next example, first line prints all matches, and second
does none.

    greple --inside PATTERN --outside PATTERN

    greple --include PATTERN --exclude PATTERN

You can make up desired matches using B<--inside>/B<outside> option,
then remove unnecessary part by B<--include>/B<exclude>

=item B<--strict>

Limit the match area strictly.

By default, B<--block>, B<--inside>/B<outside>,
B<--include>/B<exclude> option allows partial match within the
specified area.  For instance,

    greple --inside and command

matches pattern C<command> because the part of matched string is
included in specified inside-area.  Partial match fails when option
B<--strict> provided, and longer string never matches within shorter
area.

Interestingly enough, above example

    greple --include PATTERN --exclude PATTERN

produces output, as a matter of fact.  Think of the situation
searching, say, C<' PATTERN '> with this condition.  Matched area
includes surrounding spaces, and meets the both condition partially.
This match does not occur when option B<--strict> is given, either.

=back


=head2 CHARACTER CODE


=over 7

=item B<--icode>=I<code>

Target file is assumed to be encoded in utf8 by default.  Use this
option to set specific encoding.  When handling Japanese text, you may
choose from 7bit-jis (jis), euc-jp or shiftjis (sjis).  Multiple code
can be supplied using multiple option or combined code names with
space or comma, then file encoding is guessed from those code sets.
Use encoding name `guess' for automatic recognition from default code
list which is euc-jp and 7bit-jis.  Following commands are all
equivalent.

    greple --icode=guess ...
    greple --icode=euc-jp,7bit-jis ...
    greple --icode=euc-jp --icode=7bit-jis ...

Default code set are always included suspect code list.  If you have
just one code adding to suspect list, put + mark before the code name.
Next example does automatic code detection from euc-kr, ascii, utf8
and UTF-16/32.

    greple --icode=+euc-kr ...

If the string "B<binary>" is given as encoding name, no character
encoding is expeted and all files are processed as binary data.

=item B<--ocode>=I<code>

Specify output code.  Default is utf8.

=back


=head2 FILTER


=over 7

=item B<--if>=I<filter>, B<--if>=I<EXP>:I<filter>

You can specify filter command which is applied to each files before
search.  If only one filter command is specified, it is applied to all
files.  If filter information include colon, first field will be perl
expression to check the filename saved in variable $_.  If it
successes, next filter command is pushed.

    greple --if=rev perg
    greple --if='/\.tar$/:tar tvf -'

If the command doesn't accept standard input as processing data, you
may be able to use special device:

    greple --if='nm /dev/stdin' crypt /usr/lib/lib*

Filters for compressed and gzipped file is set by default unless
B<--noif> option is given.  Default action is like this:

    greple --if='s/\.Z$//:zcat --if='s/\.g?z$//:gunzip -c'

File with I<.gpg> suffix is filtered by B<gpg> command.  In that case,
passphrase is asked for each file.  If you want to input passphrase
only once to find from multiple files, use B<-Mpgp> module.

If the filter start with C<&>, perl subroutine is called instead of
external command.  You can define the subroutine in F<.greplerc> or
modules.  B<Greple> simply call the subroutine, so it should be
responsible for process control.

=item B<--noif>

Disable default input filter.  Which means compressed files will not
be decompressed automatically.

=item B<--of>=I<filter>, B<--of>=I<&func>

Specify output filter which process the output of B<greple> command.
Filter command can be specified in multiple times, and they are
invoked for each file to be processed.  So next command reset the line
number for each files.

    greple --of 'cat -n' string file1 file2 ...

If the filter start with C<&>, perl subroutine is called instead of
external command.  You can define the subroutine in F<.greplerc> or
modules.

Output filter command is executed only when matched string exists to
avoid invoking many unnecessary processes.  No effect for option
B<-c>.

=item B<--pf>=I<filter>, B<--pf>=I<&func>

Similar to B<--of> filter but invoked just once and takes care of
entire output from B<greple> command.

=back


=head2 RUNTIME FUNCTIONS


=over 7

=item B<--print>=I<function>, B<--print>=I<sub{...}>

Specify user defined function executed before data print.  Text to be
printed is replaced by the result of the function.  Arbitrary function
can be defined in F<.greplerc> file.  Matched data is placed in
variable C<$_>.  Other information is passed by key-value pair in the
arguments.  Filename is passed by C<file> key.  Matched information is
passed by C<matched> key, in the form of perl array reference:
C<[[start,end],[start,end]...]>.

Simplest function is B<--print>='I<sub{$_}>'.  Coloring capability can
be used like this:

    # ~/.greplerc
    __PERL__
    sub print_simple {
        my %attr = @_;
        for my $r (reverse @{$attr{matched}}) {
            my($s, $e) = @$r;
            substr($_, $s, $e - $s, color('B', substr($_, $s, $e - $s)));
        }
        $_;
    }

Then, you can use this function in the command line.

    greple --print=print_simple ...

It is possible to use multiple B<--print> options.  In that case,
second function will get the result of the first function.  The
command will print the final result of the last function.

=item B<--continue>

When B<--print> option is given, B<greple> will immediately print the
result returned from print function and finish the cycle.  Option
B<--continue> forces to continue normal printing process after print
function called.  So please be sure that all data being consistent.

=item B<--begin>=I<function>(I<...>), B<--begin>=I<function>=I<...>

Option B<--begin> specify the function executed at the beginning of
each file processing.  This I<function> have to be called from B<main>
package.  So if you define the function in the module package, use the
full package name or export properly.

=item B<--end>=I<function>(I<...>), B<--end>=I<function>=I<...>

Option B<--end> is almost same as B<--begin>, except that the function
is called after the file processing.

=item B<-M>I<module>::I<function(...)>, B<-M>I<module>::I<function=...>

Function can be given with module option, following module name.  In
this form, the function will be called with module package name.  So
you don't have to export it.  Because it is called only once at the
beginning of command execution, before starting file processing,
C<FILELABEL> parameter is not given exceptionally.

=back

For these run-time functions, optional argument list can be set in the
form of C<key> or C<key=value>, connected by comma.  These arguments
will be passed to the function in key => value list.  Sole key will
have the value one.  Also processing file name is passed with the key
of C<FILELABEL> constant.  As a result, the option in the next form:

    --begin function(key1,key2=val2)
    --begin function=key1,key2=val2

will be transformed into following function call:

    function(&FILELABEL => "filename", key1 => 1, key2 => "val2")

As described earlier, C<FILELABEL> parameter is not given to the
function specified with module option. So

    -Mmodule::function(key1,key2=val2)
    -Mmodule::function=key1,key2=val2

simply becomes:

    function(key1 => 1, key2 => "val2")

The function can be defined in F<.greplerc> or modules.  Assign the
arguments into hash, then you can access argument list as member of
the hash.  It's safe to delete FILELABEL key if you expect random
parameter is given.  Content of the target file can be accessed by
C<$_>.  Ampersand (C<&>) is required to avoid the hash key is
interpreted as a bare word.

    sub function {
	my %arg = @_;
	my $filename = delete $arg{&FILELABEL};
	$arg{key1};             # 1
	$arg{key2};             # "val2"
	$_;                     # contents
    }


=head2 OTHERS


=over 7

=item B<--norc>

Do not read startup file: F<~/.greplerc>.

=item B<--usage>

B<Greple> print usage and exit with option B<--usage>, or no valid
parameter is not specified.  In this case, module option is displayed
with help information if available.  If you want to see how they are
expanded, supply something not empty to B<--usage> option, like:

    greple -Mmodule --usage=expand

=item B<--man>

Show manual page.
Display module's manual page when used with B<-M> option.

=item B<--show>

Show module file contents.  Use with B<-M> option.

=item B<--require>=I<filename>

Include arbitrary perl program.

=begin comment

=item B<-d> I<flags>

Display informations.  Various kind of debug, diagnostic, monitor
information can be display by giving appropriate flag to -d option.

    d: directory information
    e: eval string
    f: processing file name
    m: misc debug information
    o: option related information
    p: run `ps' command before termination (on Unix)
    s: statistic information
    u: unused options
    v: internal match information

=end comment

=item B<--conceal> I<type>=I<val>

Conceal runtime errors.  Repeatable.  Types are:

=over 4

=item B<read>

(Default 1) Errors occured during file read.  Mainly unicode related
errors when reading binary or umbiguous text file.

=item B<skip>

(Default 0) File skip warings produced when fatal error was occured
during file read.  Occurs when reading binary files with automatic
character code recognition.

=item B<all>

Set same value for all types.

=back

=item B<--persist>

As B<greple> tries to read data as a character string, sometimes fails
to convert them into internal representation, and the file is skipped
without processing.  When option B<--persist> is specified, command
does not give up the file, and tries to read as binary data.

Next command will show strings in binary file.

    greple -o --re '(?a)\w{4,}' --persist --uc /bin/*

When processing all files as binary data, use B<--icode=binary>
instead.

=back


=head1 ENVIRONMENT and STARTUP FILE


Environment variable GREPLEOPTS is used as a default options.  They
are inserted before command line options.

Before starting execution, I<greple> reads the file named F<.greplerc>
on user's home directory.  Following directives can be used.

=over 7

=item B<option> I<name> string

Argument I<name> of `option' directive is user defined option name.
The rest are processed by I<shellwords> routine defined in
Text::ParseWords module.  Be sure that this module sometimes requires
escape backslashes.

Any kind of string can be used for option name but it is not combined
with other options.

    option --fromcode --outside='(?s)\/\*.*?\*\/'
    option --fromcomment --inside='(?s)\/\*.*?\*\/'

If the option named B<default> is defined, it will be used as a
default option.

For the purpose to include following arguments within replaced
strings, two special notations can be used in option definition.
String C<$E<lt>nE<gt>> is replaced by the I<n>th argument after the
substituted option, where I<n> is number start from one.  String
C<$E<lt>shiftE<gt>> is replaced by following command line argument and
the argument is removed from option list.

For example, when

    option --line --le &line=$<shift>

is defined, command

    greple --line 10,20-30,40

will be evaluated as this:

    greple --le &line=10,20-30,40

=item B<expand> I<name> I<string>

Define local option I<name>.  Command B<expand> is almost same as
command B<option> in terms of its function.  However, option defined
by this command is expanded in, and only in, the process of
definition, while option definition is expanded when command arguments
are processed.

This is similar to string macro defined by following B<define>
command.  But macro expantion is done by simple string replacement, so
you have to use B<expand> to define option composed by multiple
arguments.

=item B<define> I<name> string

Define macro.  This is similar to B<option>, but argument is not
processed by I<shellwords> and treated just a simple text, so
meta-characters can be included without escape.  Macro expansion is
done for option definition and other macro definition.  Macro is not
evaluated in command line option.  Use option directive if you want to
use in command line,

    define (#kana) \p{InKatakana}
    option --kanalist --nocolor -o --join --re '(#kana)+(\n(#kana)+)*'
    help   --kanalist List up Katakana string

=item B<help> I<name>

If `help' directive is used for same option name, it will be printed
in usage message.  If the help message is `ignore', corresponding line
won't show up in the usage.

=item B<builtin> I<spec> I<variable>

Define built-in option which should be processed by option parser.
Arguments are assumed to be L<Getopt::Long> style spec, and
I<variable> is string start with C<$>, C<@> or C<%>.  They will be
replaced by a reference to the object which the string represent.

See B<pgp> module for example.

=item B<autoload> I<module> I<options>

Define module which should be loaded automatically when specified
option is found in the command arguments.

For example,

    autoload -Mdig --dig

replaces option "I<--dig>" to "I<-Mdig --dig>", and I<dig> module is
loaded before processing I<--dig> option.

=back

Environment variable substitution is done for string specified by
`option' and `define' directives.  Use Perl syntax B<$ENV{NAME}> for
this purpose.  You can use this to make a portable module.

When I<greple> found C<__PERL__> line in F<.greplerc> file, the rest
of the file is evaluated as a Perl program.  You can define your own
subroutines which can be used by B<--inside>/B<outside>,
B<--include>/B<exclude>, B<--block> options.

For those subroutines, file content will be provided by global
variable C<$_>.  Expected response from the subroutine is the list of
array references, which is made up by start and end offset pairs.

For example, suppose that the following function is defined in your
F<.greplerc> file.  Start and end offset for each pattern match can be
taken as array element C<$-[0]> and C<$+[0]>.

    __PERL__
    sub odd_line {
        my @list;
        my $i;
        while (/.*\n/g) {
            push(@list, [ $-[0], $+[0] ]) if ++$i % 2;
        }
        @list;
    }

You can use next command to search pattern included in odd number
lines.

    % greple --inside '&odd_line' pattern files...


=head1 MODULE


Modules can be specified only at the beginning of command line by
B<-M>I<module> option.  Name I<module> is prepended by B<App::Greple>,
so place the module file in F<App/Greple/> directory in Perl library.

If the package name is declared properly, C<__DATA__> section in the
module file will be interpreted same as F<.greplerc> file content.

Using B<-M> without module argument will print available module list.
Option B<--man> will display module document when used with B<-M>
option.  Use B<--show> option to see the module itself.

See this sample module code.  This sample define options to search
from pod, comment and other segment in Perl script.  Those capability
can be implemented both in function and macro.

    package App::Greple::perl;

    BEGIN {
        use Exporter   ();
        our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);

        $VERSION = sprintf "%d.%03d", q$Revision: 7.1 $ =~ /(\d+)/g;

        @ISA         = qw(Exporter);
        @EXPORT      = qw(&pod &comment &podcomment);
        %EXPORT_TAGS = ( );
        @EXPORT_OK   = qw();
    }
    our @EXPORT_OK;

    END { }

    my $pod_re = qr{^=\w+(?s:.*?)(?:\Z|^=cut\s*\n)}m;
    my $comment_re = qr{^(?:[ \t]*#.*\n)+}m;

    sub pod {
        my @list;
        while (/$pod_re/g) {
            push(@list, [ $-[0], $+[0] ] );
        }
        @list;
    }
    sub comment {
        my @list;
        while (/$comment_re/g) {
            push(@list, [ $-[0], $+[0] ] );
        }
        @list;
    }
    sub podcomment {
        my @list;
        while (/$pod_re|$comment_re/g) {
            push(@list, [ $-[0], $+[0] ] );
        }
        @list;
    }

    1;

    __DATA__

    define :comment: ^(\s*#.*\n)+
    define :pod: ^=(?s:.*?)(?:\Z|^=cut\s*\n)

    #option --pod --inside :pod:
    #option --comment --inside :comment:
    #option --code --outside :pod:|:comment:

    option --pod --inside '&pod'
    option --comment --inside '&comment'
    option --code --outside '&podcomment'

You can use the module like this:

    greple -Mperl --pod default greple

    greple -Mperl --colorful --code --comment --pod default greple

If special subroutine B<initialize()> is defined in the module, it is
called at the beginning with C<Getopt::EX::Module> object as a
first argument.  Second argument is the reference to C<@ARGV>, and you
can modify actual C<@ARGV> using it.  See B<find> module as a sample.


=head1 HISTORY


Most capability of B<greple> is derived from B<mg> command, which has
been developing from early 1990's by the same author.  Because modern
standard B<grep> family command becomes to have similar capabilities,
it is a time to clean up entire functionalities, totally remodel the
option interfaces, and change the command name. (2013.11)


=head1 AUTHOR


Kazumasa Utashiro


=head1 SEE ALSO


L<grep(1)>, L<perl(1)>

L<github|http://kaz-utashiro.github.io/greple/>

L<Getopt::EX>

=head1 LICENSE


Copyright (c) 1991-2017 Kazumasa Utashiro

Use and redistribution for ANY PURPOSE are granted as long as all
copyright notices are retained.  Redistribution with modification is
allowed provided that you make your modified version obviously
distinguishable from the original one.  THIS SOFTWARE IS PROVIDED BY
THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES ARE
DISCLAIMED.