bin/metagrep

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