bin/metagrep

   1 #!/pro/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Getopt::Long qw(:config bundling nopermute passthrough);
   7 my $opt_w = 0;
   8 GetOptions (
   9     "-w"        => \$opt_w,
  10     ) or die "usage: metagrep [-w] pattern\n";
  11
  12 use Cwd qw(getcwd abs_path);
  13 use File::Find;
  14
  15 my $pat = shift or die "usage: metagrep pattern\n";
  16 $opt_w and $pat = "\\b$pat\\b";
  17 $pat = qr/$pat/i;
  18
  19 my $cwd    = getcwd;
  20 my $mcpath = abs_path "/pro/3gl/CPAN/metaconfig" or die "cannot cd metaconfig\n";
  21
  22 my $onmeta = $cwd =~ m{CPAN/meta[^/]+$} ? 1 : 0;
  23
  24 my %dir; # I don't want a file for which any path component symlinks
  25 find (sub {
  26     -l and return;
  27     -d and $dir{$File::Find::name}++;
  28     }, $mcpath);
  29
  30 print STDERR "<$pat>\n";
  31 find (sub {
  32     -l and return;
  33     -f or  return;
  34     m/\.U$/ or return;
  35
  36     exists $dir{$File::Find::dir} or return;
  37     #print STDERR "$File::Find::dir - $_\n";
  38
  39     open my $f, "<$_" or die "$File::Find::name: $!\n";
  40     my $fnm = $File::Find::name;
  41     $fnm =~ s{^$cwd/}{};
  42     print map { "$fnm:$_" } grep /$pat/, <$f>;
  43     }, $mcpath);