better de-dup metagrep

[metaconfig.git] / bin / metagrep

#!/usr/bin/perl

use 5.12.0;
use warnings;

our $VERSION = "0.01 - 20181213";
our $CMD = $0 =~ s{.*/}{}r;

sub usage {
    my $err = shift and select STDERR;
    say "usage: $CMD [-l] [-w] [-F] [-v[#]] pattern";
    say "    -w     --word         Word-anchored matches";
    say "    -l     --list         List matched filenames only";
    say "    -F     --fixed        Fixed pattern (quotemeta regex)";
    say "    -v [#] --verbose[=#]  Verbosity";
    exit $err;
    } # usage

use Getopt::Long qw(:config bundling nopermute passthrough);
GetOptions (
    "w|word!"		=> \(my $opt_w = 0),
    "l|list!"		=> \(my $opt_l = 0),
    "F|fixed!"		=> \(my $opt_F = 0),
    "v|verbose:1"	=> \(my $opt_v = 0),
    ) or die "usage: metagrep [-w] [-l] [-F] pattern\n";

use Cwd qw(getcwd abs_path);
use File::Find;
use FindBin;

my $pat = shift or die "usage: metagrep pattern\n";
$opt_F and $pat = quotemeta $pat;
$opt_w and $pat = "\\b$pat\\b";
$pat = qr/$pat/i;

my $cwd    = getcwd;
my $mcpath = abs_path "$FindBin::Bin/../";
my $onmeta = $cwd =~ m{CPAN/meta[^/]+$} ? 1 : 0;

my @dir = grep { -d } $mcpath, $onmeta ? "dist/U" : "$mcpath/dist/U";
my %dir; # I don't want a file for which any path component symlinks
find (sub {
    -l and return;
    -d and $dir{$File::Find::name}++;
    }, @dir);

print STDERR "<$pat>\n";
my %seen;
find (sub {
    -l					and return;
    -f					or  return;
    m/\.U$/				or  return;

    exists $dir{$File::Find::dir}	or  return;
    $opt_v and warn "$File::Find::dir - $_\n";

    $seen{abs_path ($_)}++		and return;

    my $fqdn = abs_path ($File::Find::dir);
    $fqdn =~ m{/dist-3}			and return;
    $fqdn =~ m{/_metaconfig_perl}	and return;

    my $fnm = $File::Find::name;
    $fnm =~ s{^$cwd/}{};
    open my $f, "<$_" or die "$fnm: $!\n";
    for (grep /$pat/, <$f>) {
	if ($opt_l) {
	    print "$fnm\n";
	    return;
	    }
	print "$fnm:$_";
	}
    }, @dir);