App-Greple

 view release on metacpan or  search on metacpan

script/greple  view on Meta::CPAN

    PROGRESS => "B",
    TOP      => "",
    MIDDLE   => "",
    BOTTOM   => "",
    );

our @colors;

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

my @default_color =
    $opt_ansicolor eq '16'
    ? qw(RD GD BD CD MD YD)
    : qw(000D/544 000D/454 000D/445
	 000D/455 000D/545 000D/554
	 000D/543 000D/453 000D/435
	 000D/534 000D/354 000D/345
	 000D/444
	 000D/433 000D/343 000D/334
	 000D/344 000D/434 000D/443
	 000D/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::RGB24 = 1;
}

for my $opt (@opt_face) {
    while ($opt =~ /(?<mk>[-+=]) (?<s>[^-+=]*) | (?<s>[^-+=]+) /xg) {
	my($mk, $s) = ($+{mk} // '', $+{s});
	for my $c (@colors) {
	    if ($mk eq '-') {
		$c =~ s/[\Q$s\E]//g if $s ne '';
	    } elsif ($mk eq '=') {
		$c = $s;
	    } elsif ($s ne '') {
		$c .= "^" if $c ne '';
		$c .= $s;
	    }
	}
    }
}

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

if (!$need_color) {
    $Getopt::EX::Colormap::NO_COLOR = 1;
}

my %_esc = ( t => "\t", n => "\n", r => "\r", f => "\f" );
sub expand_escape {
    $_[0] =~ s{\\(.)}{$_esc{$1} // $1}egr;
}

$_ = expand_escape($_) for values %opt_format;

my $blockend = "--";
if (defined $opt_blockend) {
    $blockend = expand_escape($opt_blockend);
}

my $_file     = sub { $color_handler->color('FILE' , sprintf($opt_format{FILE}, $_[0])) };
my $_line     = sub { $color_handler->color('LINE' , sprintf($opt_format{LINE}, $_[0])) };
my $_block    = sub { $color_handler->color('BLOCK', sprintf($opt_format{BLOCK}, $_[0])) };
my $_text     = sub { $color_handler->color('TEXT' , $_[0]) };
my $_blockend = $color_handler->color('BLOCKEND', $blockend);
my $_top      = $color_handler->color('TOP'     , $opt_frame_top);
my $_middle   = $color_handler->color('MIDDLE'  , $opt_frame_middle);
my $_bottom   = $color_handler->color('BOTTOM'  , $opt_frame_bottom);

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

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

my $uniq_color = UniqIndex->new(
    ignore_newline => 1,
    prepare => \@opt_uniqsub,
    );

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

# --colorindex
my %color_index = map { uc $_ => 1 } $opt_colorindex =~ /\w/g;
my $indexer = do {
    if ($color_index{S}) {
	@colors = shuffle @colors;
    }
    if ($color_index{A} or $color_index{D}) {
	my $i = 0;
	Indexer->new(
	    index   => sub { $i++   },
	    reset   => sub { $i = 0 },
	    block   => $color_index{B},
	    reverse => $color_index{D},
	    );
    }
    elsif ($color_index{R}) {
	Indexer->new(index => sub { int rand @colors });
    }
    else { undef }
};
my $opt_uniqcolor = $color_index{U};

# -dc
if ($opt_d{c}) {
    my $dump = sub {
	local $_ = Dumper shift;

script/greple  view on Meta::CPAN

    I  3 Italic
    U  4 Underline
    F  5 Flash (blink: slow)
    Q  6 Quick (blink: rapid)
    S  7 Stand out (reverse video)
    H  8 Hide (concealed)
    X  9 Cross out
    E    Erase Line

    ;    No effect
    /    Toggle foreground/background
    ^    Reset to foreground
    @    Reset index list

If the spec includes C</>, left side is considered as foreground color
and right side as 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.  Character C<;> does nothing and
can be used just for readability, like C<SD;K/544>.

If the special reset symbol C<@> is encountered, the index list is
reset to empty at that point.  The reset symbol must be used alone and
may not be combined with other characters.

Example:

    RGB  6x6x6    12bit      24bit           color name
    ===  =======  =========  =============  ==================
    B    005      #00F       (0,0,255)      <blue>
     /M     /505      /#F0F   /(255,0,255)  /<magenta>
    K/W  000/555  #000/#FFF  000000/FFFFFF  <black>/<white>
    R/G  500/050  #F00/#0F0  FF0000/00FF00  <red>/<green>
    W/w  L03/L20  #333/#ccc  303030/c6c6c6  <dimgrey>/<lightgrey>

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 C<foo> in red, C<bar>
in green and C<baz> in blue.

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

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

Coloring capability is implemented in L<Getopt::EX::Colormap> module.

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

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

    FILE      File name
    LINE      Line number
    TEXT      Unmatched normal text
    BLOCKEND  Block end mark
    PROGRESS  Progress status with -dnf option

The C<BLOCKEND> mark is colored with C<E> effect provided by
L<Getopt::EX> module, which allows to fill up the line with background
color.  This effect uses irregular escape
sequence, and you may need to define C<LESSANSIENDCHARS> environment
as "mK" to see the result with L<less> command.

=item B<--colormap>=C<&func>

=item B<--colormap>=C<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 C<--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 C<&func;> can be repeated.

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

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

When color for 'TEXT' field is specified, whole text including matched
part is passed to the function, exceptionally.  It is not recommended
to use user defined function for 'TEXT' field.

=item B<--colorsub>=C<...>, B<--cs>=C<...>

C<--colorsub> or C<--cs> is a shortcut for subroutine colormap.  It
simply enclose the argument by C<sub{ ... }> expression.  So

    greple --cm 'sub{uc}'

can be written as simple as this.

    greple --cs uc

You can not use this option for labeled color.

=item B<--[no]colorful>

Shortcut for C<--colormap>='C<RD GD BD CD MD YD>' in ANSI 16 colors
mode, and C<--colormap>='C<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.

When single pattern is specified, first color in colormap is used for
the pattern.  If multiple patterns and multiple colors are specified,
each pattern is colored with corresponding color cyclically.

Option C<--regioncolor> and C<--colorindex> change this behavior.

script/greple  view on Meta::CPAN

=item B<--alert> [ C<size>=#, C<time>=# ]

Set alert parameter for large file.  B<Greple> scans whole file
content to know line borders, and it takes several seconds or more if
it contains large number of lines.

By default, if the target file contains more than B<512 * 1024
characters> (I<size>), B<2 seconds> timer will start (I<time>).  Alert
message is shown when the timer expired.

To disable this alert, set the size as zero:

    --alert size=0

=item B<-Mdebug>, B<-d>I<x>

Debug option is described in L<App::Greple::debug> module.

=back


=head1 ENVIRONMENT and STARTUP FILE


=over 7

=item B<GREPLEOPTS>

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

=item B<GREPLE_NORC>

If set non-empty string, startup file F<~/.greplerc> is not processed.

=item B<DEBUG_GETOPT>

Enable L<Getopt::Long> debug option.

=item B<DEBUG_GETOPTEX>

Enable L<Getopt::EX> debug option.

=item B<NO_COLOR>

If true, all coloring capability with ANSI terminal sequence is
disabled.  See L<https://no-color.org/>.

=back

Before starting execution, B<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 B<option> directive is user defined option name.
The rest are processed by C<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 expansion 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 B<help> directive is used for same option name, it will be printed
in usage message.  If the help message is C<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 --git

replaces option "C<--dig>" to "C<-Mdig --dig>", so that B<dig> module
is loaded before processing C<--dig> option.

=back

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

When B<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 C<--inside>/C<--outside>,
C<--include>/C<--exclude>, C<--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;



( run in 1.704 second using v1.01-cache-2.11-cpan-39bf76dae61 )