File Coverage

blib/lib/App/Greple/tee.pm

Criterion	Covered	Total	%
statement	97	109	88.9
branch	28	42	66.6
condition	15	21	71.4
subroutine	22	22	100.0
pod	0	10	0.0
total	162	204	79.4

=encoding utf-8

=head1 NAME

App::Greple::tee - module to replace matched text by the external command result

=head1 SYNOPSIS

    greple -Mtee command -- ...

=head1 VERSION

Version 1.05

=head1 DESCRIPTION

Greple's B<-Mtee> module sends matched text part to the given filter
command, and replace them by the command result.  The idea is derived
from the command called B.  It is like bypassing partial data to
the external filter command.

Filter command follows module declaration (C<-Mtee>) and terminates by
two dashes (C<-->).  For example, next command call command C
command with C arguments for the matched word in the data.

    greple -Mtee tr a-z A-Z -- '\w+' ...

Above command convert all matched words from lower-case to upper-case.
Actually this example itself is not so useful because B can do
the same thing more effectively with B<--cm> option.

By default, the command is executed as a single process, and all
matched data is sent to the process mixed together.  If the matched
text does not end with newline, it is added before sending and removed
after receiving.  Input and output data are mapped line by line, so
the number of lines of input and output must be identical.

Using B<--discrete> option, individual command is called for each
matched text area.  You can tell the difference by following commands.

    greple -Mtee cat -n -- copyright LICENSE
    greple -Mtee cat -n -- copyright LICENSE --discrete

Lines of input and output data do not have to be identical when used
with B<--discrete> option.

=head1 OPTIONS

=over 7

=item B<--discrete>

Invoke new command individually for every matched part.

=item B<--bulkmode>

With the <--discrete> option, each command is executed on demand.  The
<--bulkmode> option causes all conversions to be performed at once.

=item B<--crmode>

This option replaces all newline characters in the middle of each
block with carriage return characters.  Carriage returns contained in
the result of executing the command are reverted back to the newline
character. Thus, blocks consisting of multiple lines can be processed
in batches without using the B<--discrete> option.

This works well with L command's B<--crmode> option, which
joins CR-separated text and outputs folded lines separated by CR.

=item B<--fillup>

Combine a sequence of non-blank lines into a single line before
passing them to the filter command.  Newline characters between wide
width characters (Japanese, Chinese) are deleted, and other newline
characters are replaced with spaces.  Korean (Hangul) is treated
like ASCII text and joined with space.

=item B<--squeeze>

Combines two or more consecutive newline characters into one.

=item B<-ML> B<--offload> I

L's B<--offload> option is implemented in the different
module L (B<-ML>).

    greple -Mtee cat -n -- -ML --offload 'seq 10 20'

You can also use the B<-ML> module to process only even-numbered lines
as follows.

    greple -Mtee cat -n -- -ML 2::2

=back

=head1 CONFIGURATION

Module parameters can be set with B module using
the following syntax:

    greple -Mtee::config(discrete) ...
    greple -Mtee::config(fillup,crmode) ...

This is useful when combined with shell aliases or module files.

Available parameters are: B, B, B,
B, B, B, B.

=head1 FUNCTION CALL

Instead of an external command, you can call a Perl function by
prefixing the command name with C<&>.

    greple -Mtee '&App::ansifold::ansifold' -w40 -- ...

The function is executed in a forked child process, so it must follow
these requirements:

=over 4

=item *

Read matched text from B

=item *

Print converted result to B

=item *

Arguments are passed via both C<@ARGV> and C<@_>

=back

Any fully qualified function name can be used:

    greple -Mtee '&Your::Module::function' -- ...

The module is automatically loaded if not already loaded.

For convenience, the following short aliases are available:

=over 4

=item B<&ansicolumn>

Calls C.

=item B<&ansifold>

Calls C.

=item B<&cat-v>

Calls Cnew-Erun(@_)>.

=back

Using a function call avoids the overhead of forking an external
process for each invocation, which can significantly improve
performance when used with the B<--discrete> option.

=head1 LEGACIES

The B<--blocks> option is no longer needed now that the B<--stretch>
(B<-S>) option has been implemented in B.  You can simply
perform the following.

    greple -Mtee cat -n -- --all -SE foo

It is not recommended to use B<--blocks> as it may be deprecated in
the future.


=over 7

=item B<--blocks>

Normally, the area matching the specified search pattern is sent to
the external command. If this option is specified, not the matched
area but the entire block containing it will be processed.

For example, to send lines containing the pattern C to the
external command, you need to specify the pattern which matches to
entire line:

    greple -Mtee cat -n -- '^.*foo.*\n' --all

But with the B<--blocks> option, it can be done as simply as follows:

    greple -Mtee cat -n -- foo --blocks

With B<--blocks> option, this module behave more like L's
B<-g> option.  Otherwise, the behavior is similar to L with
the B<-o> option.

Do not use the B<--blocks> with the B<--all> option, since the block
will be the entire data.

=back

=head1 WHY DO NOT USE TEIP

First of all, whenever you can do it with the B command, use
it. It is an excellent tool and much faster than B.

Because B is designed to process document files, it has many
features that are appropriate for it, such as match area controls. It
might be worth using B to take advantage of those features.

Also, B cannot handle multiple lines of data as a single unit,
while B can execute individual commands on a data chunk
consisting of multiple lines.

=head1 EXAMPLE

Next command will find text blocks inside L style document
included in Perl module file.

    greple --inside '^=(?s:.*?)(^=cut|\z)' --re '^([\w\pP].+\n)+' tee.pm

You can translate them by DeepL service by executing the above command
convined with B<-Mtee> module which calls B command like this:

    greple -Mtee deepl text --to JA - -- --fillup ...

The dedicated module L is more effective
for this purpose, though.  In fact, the implementation hint of B
module came from B module.

=head1 EXAMPLE 2

Next command will find some indented part in LICENSE document.

    greple --re '^[ ]{2}[a-z][)] .+\n([ ]{5}.+\n)*' -C LICENSE

      a) distribute a Standard Version of the executables and library files,
         together with instructions (in the manual page or equivalent) on where to
         get the Standard Version.

      b) accompany the distribution with the machine-readable source of the Package
         with your modifications.

You can reformat this part by using B module with B
command.  Using both B<--crmode> options together allows efficient
processing of multi-line blocks:

    greple -Mtee ansifold -sw40 --prefix '     ' --crmode -- --crmode --re ...

      a) distribute a Standard Version of
         the executables and library files,
         together with instructions (in the
         manual page or equivalent) on where
         to get the Standard Version.

      b) accompany the distribution with the
         machine-readable source of the
         Package with your modifications.

The B<--discrete> option can also be used but will start multiple
processes, so it takes longer to execute.

=head1 EXAMPLE 3

Consider a situation where you want to grep for strings from
non-header lines. For example, you may want to search for Docker image
names from the C command, but leave the header line.
You can do it by following command.

    greple -Mtee grep perl -- -ML 2: --discrete --all

Option C<-ML 2:> retrieves the second to last lines and sends
them to the C command.  The option --discrete is required
because the number of lines of input and output changes, but since the
command is only executed once, there is no performance drawback.

If you try to do the same thing with the B command,
C will give an error because the number of output
lines is less than the number of input lines. However, there is no
problem with the result obtained.

=head1 INSTALL

=head2 CPANMINUS

    $ cpanm App::Greple::tee

=head1 SEE ALSO

L, L

L

L, L

L

L

L, L

=head1 AUTHOR

Kazumasa Utashiro

=head1 LICENSE

Copyright © 2023-2026 Kazumasa Utashiro.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

package App::Greple::tee;

our $VERSION = "1.05";

use v5.24;
use warnings;
use experimental 'refaliasing';
use Carp;
use List::Util qw(sum first);
use Text::ParseWords qw(shellwords);
use Command::Run;
use Data::Dumper;
use Getopt::EX::Config;
use App::Greple::tee::Autoload qw(resolve);

my $config = Getopt::EX::Config->new(
    debug => 0,
    blocks => 0,
    discrete => 0,
    fillup => 0,
    squeeze => 0,
    bulkmode => 0,
    crmode => 0,
    nofork => 1,
    use => '',
);

our $command;
\our $debug    = \$config->{debug};
\our $blocks   = \$config->{blocks};
\our $discrete = \$config->{discrete};
\our $fillup   = \$config->{fillup};
\our $squeeze  = \$config->{squeeze};
\our $bulkmode = \$config->{bulkmode};
\our $crmode   = \$config->{crmode};
\our $nofork   = \$config->{nofork};

my($mod, $argv);

sub initialize {
    ($mod, $argv) = @_;
    if (defined (my $i = first { $argv->[$_] eq '--' } keys @$argv)) {
	if (my @command = splice @$argv, 0, $i) {
	    $command = \@command;
	}
	shift @$argv eq '--' or die;
    }
}

sub finalize {
    ($mod, $argv) = @_;
    for my $mod (grep length, split /,/, $config->{use}) {
	eval "require $mod; $mod->import()";
	die $@ if $@;
    }
}

use Unicode::EastAsianWidth;

sub InConcatScript {
    return <<"END";
+App::Greple::tee::InFullwidth
-utf8::Hangul
END
}

sub InFullwidthPunctuation {
    return <<"END";
+App::Greple::tee::InFullwidth
&utf8::Punctuation
END
}

sub fillup_block {
    (my $s1, local $_, my $s2) = $_[0] =~ /\A(\s*)(.*?)(\s*)\z/s or die;
    s/(?<=\p{InFullwidthPunctuation})\n//g;
    s/(?<=\p{InConcatScript})\n(?=\p{InConcatScript})//g;
    s/[ ]*\n[ ]*/ /g;
    $s1 . $_ . $s2;
}

sub fillup_paragraphs {
    local *_ = @_ > 0 ? \$_[0] : \$_;
    s{^.+(?:\n.+)*}{ fillup_block ${^MATCH} }pmge;
}

sub call {
    my $data = shift;
    $command // return $data;
    my $exec = Command::Run->new;
    if ($discrete and $fillup) {
	fillup_paragraphs $data;
    }
    if (ref $command ne 'ARRAY') {
	$command = [ shellwords $command ];
    }
    my @command = @$command;
    # Resolve &function to code reference
    if (@command and $command[0] =~ /^&(.+)/) {
	shift @command;
	unshift @command, resolve($1);
    }
    my %run_opt = (stdin => $data);
    if ($config->{nofork} and ref $command[0] eq 'CODE') {
	$run_opt{nofork} = 1;
	$run_opt{raw} = 1;
    }
    my $out = $exec->command(@command)->with(%run_opt)->update->data // '';
    if ($squeeze) {
	$out =~ s/\n\n+/\n/g;
    }
    $out;
}

sub bundle_call {
    if ($fillup) {
	fillup_paragraphs for @_;
    }
    my @chop = grep { $_[$_] =~ s/(?
    my @lines = map { int tr/\n/\n/ } @_;
    my $lines = sum @lines;
    my $out = call join '', @_;
    my @out = $out =~ /.*\n/g;
    if (@out < $lines) {
	die "Unexpected short response:\n\n$out\n";
    } elsif (@out > $lines) {
	warn "Unexpected long response:\n\n$out\n";
    }
    my @ret = map { join '', splice @out, 0, $_ } @lines;
    chop for @ret[@chop];
    return @ret;
}

my @bundle;

sub postgrep {
    my $grep = shift;
    if ($blocks) {
	$grep->{RESULT} = [
	    [ [ 0, length ],
	      map {
		  [ $_->[0][0], $_->[0][1], 0, $grep->{callback}->[0] ]
	      } $grep->result
	    ] ];
    }
    return if $discrete and not $bulkmode;
    @bundle = my @block = ();
    for my $r ($grep->result) {
	my($b, @match) = @$r;
	for my $m (@match) {
	    push @block, $grep->cut(@$m);
	}
    }

    if ($crmode) {
	s/\n(?!\z)/\r/g for @block;
    }

    @bundle = do {
	if ($discrete) {
	    map { call $_ } @block;
	} else {
	    bundle_call @block;
	}
    } if @block;

    if ($crmode) {
	s/\r/\n/g for @bundle;
    }
}

sub callback {
    if ($discrete and not $bulkmode) {
	call { @_ }->{match};
    }
    else {
	shift @bundle // die;
    }
}

1;

__DATA__