Skip to content

Instantly share code, notes, and snippets.

@Ovid
Created March 2, 2012 11:16
  • Star 1 You must be signed in to star a gist
  • Fork 3 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save Ovid/1957853 to your computer and use it in GitHub Desktop.
perlfind -- perldoc on steroids
#!/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.
@Ovid
Copy link
Author

Ovid commented Apr 6, 2012

Actually, it sometimes freezes for me. This is very strange!

@Ovid
Copy link
Author

Ovid commented Apr 6, 2012

I don't have the time to debug this right now, but it looks like File::Find::Rule is hanging.

@Ovid
Copy link
Author

Ovid commented Apr 6, 2012

I've just updated the gist above. Grab the new copy and run it with --verbose.

@vfilatov
Copy link

vfilatov commented Apr 6, 2012

./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

@vfilatov
Copy link

vfilatov commented Apr 6, 2012

looks like 'grep' does not get a pattern to search

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment