This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Also add all utilities for building from units to repo
[metaconfig.git] / 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_l = 0;
8 my $opt_w = 0;
9 GetOptions (
10     "w|word!"   => \$opt_w,
11     "l|list!"   => \$opt_l,
12     ) or die "usage: metagrep [-w] [-l] pattern\n";
13
14 use Cwd qw(getcwd abs_path);
15 use File::Find;
16
17 my $pat = shift or die "usage: metagrep pattern\n";
18 $opt_w and $pat = "\\b$pat\\b";
19 $pat = qr/$pat/i;
20
21 my $cwd    = getcwd;
22 my $mcpath = abs_path "/pro/3gl/CPAN/metaconfig" or die "cannot cd metaconfig\n";
23
24 my $onmeta = $cwd =~ m{CPAN/meta[^/]+$} ? 1 : 0;
25
26 my @dir = ($mcpath, "$mcpath/dist/U");
27 my %dir; # I don't want a file for which any path component symlinks
28 find (sub {
29     -l and return;
30     -d and $dir{$File::Find::name}++;
31     }, @dir);
32
33 print STDERR "<$pat>\n";
34 my %seen;
35 find (sub {
36     -l and return;
37     -f or  return;
38     m/\.U$/ or return;
39
40     exists $dir{$File::Find::dir} or return;
41     #print STDERR "$File::Find::dir - $_\n";
42
43     $File::Find::dir =~ m{^(?:$cwd/)?dist-3} and return;
44
45     open my $f, "<$_" or die "$File::Find::name: $!\n";
46     my $fnm = $File::Find::name;
47     $fnm =~ s{^$cwd/}{};
48     for (grep /$pat/, <$f>) {
49         if ($opt_l) {
50             $seen{$fnm}++ or print "$fnm\n";
51             next;
52             }
53         print "$fnm:$_";
54         }
55     }, @dir);