File Coverage

blib/lib/App/Greple/select.pm

Criterion	Covered	Total	%
statement	21	64	32.8
branch	0	22	0.0
condition			n/a
subroutine	7	22	31.8
pod	0	8	0.0
total	28	116	24.1

=head1 NAME

select - Greple module to select files

=head1 SYNOPSIS

greple -Mdig -Mselect ... --dig .

  FILENAME
    --suffix           file suffixes
    --select-name      regex match for file name
    --select-path      regex match for file path
    --x-suffix	       exclusive version of --suffix
    --x-select-name    exclusive version of --select-name
    --x-select-path    exclusive version of --select-path

  DATA
    --shebang          included in #! line
    --select-data      regex match for file data
    --select-longer=#  contain lines longer than #
    --x-shebang        exclusive version of --shebang
    --x-select-data    exclusive version of --select-data
    --x-select-longer  exclusive version of --select-longer

=head1 DESCRIPTION

Greple's B<-Mselect> module allows to filter files using their name
and content data.  It is usually supposed to be used along with
B<-Mfind> or B<-Mdig> module.

For example, next command scan files end with C<.pl> and C<.pm> under
current directory.

    greple -Mdig -Mselect --suffix=pl,pm foobar --dig .

This is almost equivalent to the next command using B<--dig> option
with extra conditional expression for B command.

    greple -Mdig foobar --dig . -name '*.p[lm]'

The problems is that the above command does not search perl command
script without suffixes.  Next command looks for both files looking at
C<#!> (shebang) line.

    greple -Mdig -Mselect --suffix=pl,pm --shebang perl foobar --dig .

Generic option B<--select-name>, B<--select-path> and B<--select-data>
take regular expression and works for arbitrary use.

=head2 ORDER and DEFAULT

Besides normal inclusive rules, there is exclusive rules which start
with B<--x-> option name.

As for the order of rules, all exclusive rules are checked first, then
inclusive rules are applied.

When no rules are matched, default action is taken.  If no inclusive
rule exists, it is selected.  Otherwise discarded.

=head1 OPTIONS

=head2 FILENAME

=over 7

=item B<--suffix>=I

Specify one or more file name suffixes connecting by comma (C<,>).
They will be converted to C expression and compared
to the file name.

=item B<--select-name>=I

Specify regular expression and it is compared to the file name.  Next
command search Makefiles under any directory.

    greple -Mselect --select-name '^Makefile.*'

=item B<--select-path>=I

Specify regular expression and it is compared to the file path.

=item B<--x-suffix>=I

=item B<--x-select-name>=I

=item B<--x-select-path>=I

These are reverse version of corresponding options.  File is not
selected when matched.

=back

=head2 DATA

=over 7

=item B<--shebang>=I

This option test if a given string is included in the first line of
the file start with C<#!> (aka shebang) mark.  Multiple names can be
specified connecting by command (C<,>).  Given string is converted to
the next regular expression:

    /\A #! .*\b (aa|bb|cc)/x

=item B<--select-data>=I

Specify regular expression and it is compared to the file content
data.  Multi-line modifier is enabled by default.

=item B<--x-shebang>=I

=item B<--x-select-data>=I

These are reverse version of corresponding options.  File is not
selected when matched.

=item B<--select-longer>=I

=item B<--x-select-longer>=I

Search or ignore files which contain lines longer than I.

=back

=head2 SEE ALSO

L

=cut

package App::Greple::select;

use v5.14;
use warnings;
use Hash::Util qw(lock_keys);
use Data::Dumper;
use App::Greple::Common;

our @select_shebang;
our @select_suffix;
our @select_name;
our @select_path;
our @select_data;

our @discard_shebang;
our @discard_suffix;
our @discard_name;
our @discard_path;
our @discard_data;

my %opt;
my $select = __PACKAGE__->new();

sub new {
    my $class = shift;
    my $obj = bless { include => [],
		      exclude => [] }, $class;
    lock_keys %$obj;
    $obj;
}

sub include { @{shift->{include}} }

sub exclude { @{shift->{exclude}} }

package #
    FilterEnt
{
    sub new {
	my $class = shift;
	bless [ @_ ], $class;
    }
    sub type   { shift->[0] }
    sub regex  { shift->[1] }
    sub action { shift->[2] }
}

sub add {
    my $obj = shift;
    my($type, $regex, $action) = @_;
    my $list = $action ? $obj->{include} : $obj->{exclude};
    push @{$list}, FilterEnt->new($type, $regex, $action);
}

sub check {
    my $obj = shift;
    my($path, $data) = @_;
    my $name = $path =~ s{\A.*/}{}r;
    for my $f ($obj->exclude, $obj->include) {
	my $type = $f->type;
	my $compare = { name => \$name ,
			path => \$path ,
			data =>  $data }->{$type} or die;
	${$compare} =~ $f->regex and return $f->action;
    }
    return $obj->include ? 0 : 1;
}

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

sub opt {
    while (my($k, $v) = splice @_, 0, 2) {
	$opt{$k} = $v;
    }
}

use List::Util qw(reduce);

sub prologue {
    for (
	[ \@select_shebang,  q/,/, data => 1, sub { qr/\A\#!.*\b\Q$_[0]\E/ } ],
	[ \@discard_shebang, q/,/, data => 0, sub { qr/\A\#!.*\b\Q$_[0]\E/ } ],
	[ \@select_suffix,   q/,/, name => 1, sub { qr/\.\Q$_[0]\E$/ } ],
	[ \@discard_suffix,  q/,/, name => 0, sub { qr/\.\Q$_[0]\E$/ } ],
	[ \@select_data,     q//,  data => 1 ],
	[ \@discard_data,    q//,  data => 0 ],
	[ \@select_name,     q//,  name => 1 ],
	[ \@discard_name,    q//,  name => 0 ],
	[ \@select_path,     q//,  path => 1 ],
	[ \@discard_path,    q//,  path => 0 ],
	) {
	my($list, $split, $type, $action, $re) = @$_;
	do {
	    map { $select->add($type, $_, $action) }
	    map { $re ? $re->($_) : qr/$_/m }
	    map { $split ? split($split, $_) : $_ }
	    @$list;
	};
    }
}

sub select {
    my %arg = @_;
    my $name = delete $arg{&FILELABEL} or die;
    if ($select->check($name, *_)) {
	say $name if $opt{yes};
	$opt{die} and die "SKIP $name";
    } else {
	say $name if $opt{no};
	die "SKIP $name";
    }
}

1;

__DATA__