view release on metacpan or  search on metacpan

lib/App/optex/util/filter.pm  view on Meta::CPAN

=item B<--osub> I<function>

=item B<--esub> I<function>

Set filter function.  These are shortcut for B<--if> B<&>I<function>
and such.

=item B<--psub> I<function>, B<--pf> I<&function>

Set pre-fork filter function.  This function is called before
executing the target command process, and expected to return text
data, that will be poured into target process's STDIN.  This allows
you to share information between pre-fork and output filter processes.

See L<App::optex::xform> for actual use case.

=item B<--set-io-color> IO=I<color>

Set color filter to filehandle.  You can set color filter for STDERR
like this:

    --set-io-color STDERR=R

Use comma to set multiple filehandles at once.

    --set-io-color STDIN=B,STDERR=R

=item B<--io-color>

Set default color to STDOUT and STDERR.

=back

=head1 DESCRIPTION

This module is a collection of sample utility functions for command
B<optex>.

Function can be called with option declaration.  Parameters for the
function are passed by name and value list: I<name>=I<value>.  Value 1
is assigned for the name without value.

In this example,

    optex -Mutil::function(debug,message=hello,count=3)

option I<debug> has value 1, I<message> has string "hello", and
I<count> also has string "3".

=head1 FUNCTION

=over 4

=cut

######################################################################
######################################################################
sub io_filter (&@) {
    my $sub = shift;
    my %opt = @_;
    local @ARGV;
    if ($opt{PREFORK}) {
	my $stdin = $sub->();
	$sub = sub { print $stdin };
	$opt{STDIN} = 1;
    }
    my $pid = do {
	if    ($opt{STDIN})  { open STDIN,  '-|' }
	elsif ($opt{STDOUT}) { open STDOUT, '|-' }
	elsif ($opt{STDERR}) { open STDERR, '|-' }
	else  { croak "Missing option" }
    } // die "fork: $!\n";;
    return $pid if $pid > 0;
    if ($opt{STDERR}) {
	open STDOUT, '>&', \*STDERR or die "dup: $!";
    }
    $sub->();
    close STDOUT;
    close STDERR;
    exit 0;
}

sub set {
    my %opt = @_;
    for my $io (qw(PREFORK STDIN STDOUT STDERR)) {
	my $filter = delete $opt{$io} // next;
	if ($filter =~ s/^&//) {
	    if ($filter !~ /::/) {
		$filter = join '::', __PACKAGE__, $filter;
	    }
	    use Getopt::EX::Func qw(parse_func);
	    my $func = parse_func($filter);
	    io_filter { $func->call() } $io => 1;
	}
	else {
	    io_filter { exec $filter or die "exec: $!\n" } $io => 1;
	}
    }
    %opt and die "Unknown parameter: " . Dumper \%opt;
    ();
}

=item B<set>(I<io>=I<command>)

=item B<set>(I<io>=&I<function>)

Primitive function to prepare input/output filter.  All options are
implemented by this function.  Takes C<STDIN>, C<STDOUT>, C<STDERR>,
C<PREFORK> as an I<io> name and I<command> or &I<function> as a vaule.

    mode function
    option --if   &set(STDIN=$<shift>)
    option --isub &set(STDIN=&$<shift>)

=cut

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

sub unctrl {
    while (<>) {
	s/([\000-\010\013-\037\177])/'^' . pack('c', ord($1)|0100)/ge;