This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
prctl needs unistd on Android
[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_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);