bin/metagrep

   1 #!/usr/bin/perl
   2
   3 use 5.12.0;
   4 use warnings;
   5
   6 our $VERSION = "0.01 - 20181213";
   7 our $CMD = $0 =~ s{.*/}{}r;
   8
   9 sub usage {
  10     my $err = shift and select STDERR;
  11     say "usage: $CMD [-l] [-w] [-F] [-v[#]] pattern";
  12     say "    -w     --word         Word-anchored matches";
  13     say "    -l     --list         List matched filenames only";
  14     say "    -F     --fixed        Fixed pattern (quotemeta regex)";
  15     say "    -v [#] --verbose[=#]  Verbosity";
  16     exit $err;
  17     } # usage
  18
  19 use Getopt::Long qw(:config bundling nopermute passthrough);
  20 GetOptions (
  21     "w|word!"           => \(my $opt_w = 0),
  22     "l|list!"           => \(my $opt_l = 0),
  23     "F|fixed!"          => \(my $opt_F = 0),
  24     "v|verbose:1"       => \(my $opt_v = 0),
  25     ) or die "usage: metagrep [-w] [-l] [-F] pattern\n";
  26
  27 use Cwd qw(getcwd abs_path);
  28 use File::Find;
  29 use FindBin;
  30
  31 my $pat = shift or die "usage: metagrep pattern\n";
  32 $opt_F and $pat = quotemeta $pat;
  33 $opt_w and $pat = "\\b$pat\\b";
  34 $pat = qr/$pat/i;
  35
  36 my $cwd    = getcwd;
  37 my $mcpath = abs_path "$FindBin::Bin/../";
  38 my $onmeta = $cwd =~ m{CPAN/meta[^/]+$} ? 1 : 0;
  39
  40 my @dir = grep { -d } $mcpath, $onmeta ? "dist/U" : "$mcpath/dist/U";
  41 my %dir; # I don't want a file for which any path component symlinks
  42 find (sub {
  43     -l and return;
  44     -d and $dir{$File::Find::name}++;
  45     }, @dir);
  46
  47 print STDERR "<$pat>\n";
  48 my %seen;
  49 find (sub {
  50     -l                                  and return;
  51     -f                                  or  return;
  52     m/\.U$/                             or  return;
  53
  54     exists $dir{$File::Find::dir}       or  return;
  55     $opt_v and warn "$File::Find::dir - $_\n";
  56
  57     $seen{abs_path ($_)}++              and return;
  58
  59     my $fqdn = abs_path ($File::Find::dir);
  60     $fqdn =~ m{/dist-3}                 and return;
  61     $fqdn =~ m{/_metaconfig_perl}       and return;
  62
  63     my $fnm = $File::Find::name;
  64     $fnm =~ s{^$cwd/}{};
  65     open my $f, "<$_" or die "$fnm: $!\n";
  66     for (grep /$pat/, <$f>) {
  67         if ($opt_l) {
  68             print "$fnm\n";
  69             return;
  70             }
  71         print "$fnm:$_";
  72         }
  73     }, @dir);