-
-
Save Ovid/1957853 to your computer and use it in GitHub Desktop.
| #!/usr/bin/env perl | |
| use strict; | |
| use warnings; | |
| use Carp qw(cluck); | |
| use autodie ':all'; | |
| use Getopt::Long 2.33 qw(:config auto_help); | |
| use File::Find::Rule; | |
| use File::Basename 'basename'; | |
| use Term::ProgressBar; | |
| $0 = basename($0); | |
| my $perldoc = $ENV{PERLDOC} || 'perldoc'; | |
| GetOptions( | |
| verbose => \my $VERBOSE, | |
| 'perldoc=s' => \$perldoc, | |
| 'all' => \my $all, | |
| ) or die; | |
| my $term = shift @ARGV || 'strict'; | |
| if ( my $doc = get_main_doc( $perldoc, $term ) ) { | |
| exec $perldoc, $doc; | |
| } | |
| elsif ( is_func( $perldoc, $term ) ) { | |
| exec $perldoc, '-f', $term; | |
| } | |
| elsif ( is_var( $perldoc, $term ) ) { | |
| exec $perldoc, '-v', $term; | |
| } | |
| elsif ( is_faq( $perldoc, $term ) ) { | |
| exec $perldoc, '-q', $term; | |
| } | |
| elsif ( my @files_with_count = do_grep( $all, $term ) ) { | |
| foreach my $aref (@files_with_count) { | |
| my ( $file, $count ) = @$aref; | |
| print "$count hits: $file\n"; | |
| } | |
| } | |
| else { | |
| warn "Could not find '$term'"; | |
| unless ($all) { | |
| warn "You can try a brute force search with: $0 --all $term\n"; | |
| } | |
| } | |
| exit; | |
| sub get_main_doc { | |
| my ( $perldoc, $term ) = @_; | |
| my @results = _exec( $perldoc, '-l', $term ); | |
| if ( @results > 1 ) { | |
| my $results = join "\n" => @results; | |
| cluck "Found more than one result for: $term\n\n$results\n"; | |
| } | |
| return $results[0]; | |
| } | |
| sub is_func { | |
| my ( $perldoc, $term ) = @_; | |
| my $is_func = _exec( $perldoc, '-f', $term ); | |
| return $is_func; | |
| } | |
| sub is_var { | |
| my ( $perldoc, $term ) = @_; | |
| my $is_var = _exec( $perldoc, '-v', "'$term'" ); | |
| return $is_var; | |
| } | |
| sub is_faq { | |
| my ( $perldoc, $term ) = @_; | |
| my $is_faq = _exec( $perldoc, '-q', "'$term'" ); | |
| return $is_faq; | |
| } | |
| sub do_grep { | |
| my ( $all, $term ) = @_; | |
| return unless $all; | |
| warn "Could not find '$term'. Falling back to brute force search."; | |
| my @paths = @INC, map { split /:/ } $ENV{PERL5LIB}; | |
| if ( $VERBOSE ) { | |
| my $locations = join "\n\t" => "Searching in:", @paths; | |
| warn "$locations\n"; | |
| } | |
| my @files = File::Find::Rule->file->name('*.pod')->in(@paths); | |
| my $count = @files; | |
| if ( $VERBOSE ) { | |
| warn "Found $count matching files\n"; | |
| } | |
| my @files_with_count; | |
| my $progress = Term::ProgressBar->new({count => scalar @files}); | |
| my $num_searched = 0; | |
| foreach my $file (@files) { | |
| my @count = _exec( 'grep', '-c', $term, $file ); | |
| $num_searched++; | |
| if ( $count[0] ) { | |
| push @files_with_count => [ $file, $count[0] ]; | |
| } | |
| $progress->update($num_searched); | |
| } | |
| @files_with_count = sort { $b->[1] <=> $a->[1] } @files_with_count; | |
| return @files_with_count; | |
| } | |
| sub _exec { | |
| my @command = @_; | |
| if ($VERBOSE) { | |
| warn "Executing: @command\n"; | |
| } | |
| chomp( my @results = qx(@command 2>/dev/null) ); | |
| return @results; | |
| } | |
| __END__ | |
| =head1 NAME | |
| perlfind - perldoc on steroids | |
| =head1 SYNOPSIS | |
| perlfind '$@' | |
| perlfind Scalar::Util | |
| perlfind file | |
| perlfind die | |
| perlfind __DATA__ --all | |
| =head1 DESCRIPTION | |
| Tired of C<perldoc>? Try C<perlfind> I<anything>. It will return the first | |
| matching perldoc document found for I<anything>, in the following precedence | |
| order. | |
| =over 4 | |
| =item 1. C<perldoc MODULE> | |
| =item 2. C<perldoc -f FUNCTION> | |
| =item 3. C<perldoc -v VARIABLE> | |
| =item 4. C<perldoc -q FAQKEYWORD> | |
| =item 5. A brute force grep of C<@INC> and C<$ENV{PERL5LIB>. | |
| =back | |
| Note that the brute force grep requires L</Term::ProgressBar> and | |
| L</File::Find::Rule>. You must also specify the C<--all> option. | |
| =head1 OPTIONS | |
| --perldoc=/path/to/perldoc Force an explicit path to your perldoc | |
| --verbose Show how we're searching | |
| --all Fall back to brute force if we fail | |
| =head1 CAVEATS | |
| It's a hack. | |
| =head1 BUGS | |
| Probably. | |
| =head1 AUTHOR | |
| Curtis "Ovid" Poe | |
| =head1 LICENSE | |
| Copyright (c) 2012 Curtis "Ovid" Poe (ovid@cpan.org). All rights reserved. | |
| This module is free software; you can redistribute it and/or modify it under | |
| the same terms as Perl itself. | |
| This program is distributed in the hope that it will be useful, but WITHOUT ANY | |
| WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A | |
| PARTICULAR PURPOSE. |
I've just updated the gist above. Grab the new copy and run it with --verbose.
./gistfile1.pl --verbose --all '$@'
Executing: perldoc -l $@
Executing: perldoc -f $@
Executing: perldoc -v '$@'
Executing: perldoc -q '$@'
Could not find '$@'. Falling back to brute force search. at ./gistfile1.pl line 83.
Use of uninitialized value $_ in split at ./gistfile1.pl line 85.
Searching in:
/etc/perl
/usr/local/lib/perl/5.10.1
/usr/local/share/perl/5.10.1
/usr/lib/perl5
/usr/share/perl5
/usr/lib/perl/5.10
/usr/share/perl/5.10
/usr/local/lib/site_perl
.
Found 282 matching files
0% [ ]Executing: grep -c $@ /usr/local/lib/perl/5.10.1/perllocal.pod
^C
looks like 'grep' does not get a pattern to search
I don't have the time to debug this right now, but it looks like File::Find::Rule is hanging.