view release on metacpan or  search on metacpan

lib/App/Greple/select.pm  view on Meta::CPAN

}

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\n";
    } else {
	say $name if $opt{no};
	die "SKIP $name\n";
    }
}

1;

__DATA__

option default \
	--prologue __PACKAGE__::prologue \
	--begin    __PACKAGE__::select

builtin   shebang=s @select_shebang
builtin   suffix=s  @select_suffix
builtin x-shebang=s @discard_shebang
builtin x-suffix=s  @discard_suffix

builtin   select-name=s @select_name
builtin   select-path=s @select_path
builtin   select-data=s @select_data
builtin x-select-name=s @discard_name
builtin x-select-path=s @discard_path
builtin x-select-data=s @discard_data

option   --select-longer   --select-data=^.{$<shift>,}
option --x-select-longer --x-select-data=^.{$<shift>,}

#  LocalWords:  greple shebang perl regex aka