App::Perldoc::Search - implementation for perldoc-search

  App::Perldoc::Search->run( 'thing_to_search_for' )

  App::Perldoc::Search->run( '--help' )

  App::Perldoc::Search->run( '-G' => '\.pm', 'thing_to_search_for' )

    App::Perldoc::Search->run( @options );

  perldoc-search --help
  perldoc App::Perldoc::Search

package App::Perldoc::Search;
BEGIN {
  $App::Perldoc::Search::VERSION = '0.07';
}

use 5.006;
use strict;
use warnings;
use File::Find ();
use Getopt::Long ();
use Pod::Usage ();
use IO::File ();
use App::Perldoc::Search::_Parser ();

sub run {
    my ( $class, @argv ) = @_;

    # Read optional options.
    local *ARGV = \ @argv;
    my $file_match_rx = qr/\.p(?:od|mc?)$/;
    Getopt::Long::GetOptions(
        'G=s'   => sub { $file_match_rx = qr/$_[1]/ },
        'help'  => \ &_help,
        'l'     => \ my $list_files )
      or _error_help();

    # Validate pattern.
    if ( ! @argv ) {
        _error_help( -exitval => 1 );
    }
    my $pattern = shift @ARGV;

    # Get search path
    my @search_path = @ARGV ? @ARGV : @INC;

    # Search all files.
    File::Find::find({
        follow_fast => 1,
        no_chdir => 1,
        wanted => sub {
            return if
                ! /$file_match_rx/
                || ! -f;

            # Open the documentation.
            my $fh = IO::File->new;
            $fh->open( $_ )
                or return; # TODO

            # Read the documentation.
            my $text;
            IO::Handle->input_record_separator( undef );
            $text = $fh->getline;

            # Try a fast match to avoid parsing.
            return if $text !~ $pattern;

            # Prepare for searching.
            my $searcher = App::Perldoc::Search::_Parser->new;
            $searcher->{pattern} = $pattern;

            # Search the document.
            IO::Handle->input_record_separator( "\n" );
            $fh->seek( 0, 0 );
            $searcher->parse_from_filehandle( $fh );
            return if ! $searcher->{matched};

            # Extract document name.
            my $name = $searcher->{name} || $_;

            # Report.
            if ($list_files) {
                print "$_\n";
            }
            else {
                print "$name\n"
                    or warn "Can't write: $!";
            }
        }},
        @search_path );

    return;
}

sub _help {
    Pod::Usage::pod2usage(
        -verbose => 2,
        -exitval => 0,
        -output  => \*STDOUT );
    # NOT REACHED
}

sub _error_help {
    Pod::Usage::pod2usage(
        -verbose => 2,
        -exitval => 2,
        -output  => \*STDERR,
        @_ );
    # NOT REACHED
}

q(Soviet Jesus's gift at Christmas of a blow-up doll to Debbie would always turn to be the most enigmatic);