File Coverage

blib/lib/Pod/Index/Search.pm

Criterion	Covered	Total	%
statement	72	75	96.0
branch	22	30	73.3
condition	6	8	75.0
subroutine	13	13	100.0
pod	3	4	75.0
total	116	130	89.2

package Pod::Index::Search;

use 5.008;
$VERSION = '0.14';

use strict;
use warnings;
use Search::Dict ();
use Pod::Index::Entry;
use Carp qw(croak);
use File::Spec::Functions;

sub new {
    my ($class, %args) = @_;

    my $self = bless {
        %args,
    }, $class;

    if ($self->{filename}) {
        open my $fh, "<", $self->{filename}
            or die "couldn't open $self->{filename}: $!\n";
        $self->{fh} = $fh;
    }

    unless ($self->{fh}) {
        require perlindex;
        $self->{fh} = *perlindex::DATA;
    }

    $self->{start} = tell $self->{fh};
    $self->{filemap} ||= sub {
        my ($podname)    = @_;
        my @path_elems   = split /::/, $podname;
        for my $inc (@INC) {
            my $file = catfile($inc, @path_elems);
            return "$file.pod" if -e "$file.pod";
            return "$file.pm"  if -e "$file.pm";
        }
        return undef;
    };

    return $self;
}

sub subtopics {
    my ($self, $keyword, %args) = @_;

    croak "need a keyword " unless defined $keyword;
    my $fh = $self->{fh};

    $self->look($keyword);

    my $i = $self->{nocase} ? 'i' : '';

    my $re_filter = qr/^\Q$keyword\E/i;
    my $re_select = $args{deep}
        ? qr/^((?$i)\Q$keyword\E,.*)/
        : qr/^((?$i)\Q$keyword\E,[^,]*)/;

    local $_;
    my @ret;
    my %seen;
    while (<$fh>) {
        my ($topic) = split /\t/;
        last unless $topic =~ $re_filter;

        if ($topic =~ $re_select and not $seen{$1}++) {
            push @ret, $1;
        }
    }
    return @ret;
}

# hack to make 'look' skip everything before __DATA__:
# everything before start always compares negatively
sub look {
    my ($self, $keyword) = @_;

    my $fh    = $self->{fh};
    my $start = $self->{start};

    # the search is case-insensitive (fold => 1), but the results are filtered
    # later if the user wanted it case-sensitive
    Search::Dict::look($fh, $keyword, {
        comp => sub {
            tell($fh) <= $start ? -1 : $_[0] cmp $_[1];
        },
        fold => 1,
    });
}

sub search {
    my ($self, $keyword) = @_;

    croak "need a keyword " unless defined $keyword;
    my $fh = $self->{fh};

    $self->look($keyword);

    local $_;
    my @ret;
    my $keyword_lc = lc $keyword;
    my %seen;
    while (<$fh>) {
        chomp;
        my ($entry, $podname, $line, $context) = split /\t/;
        last unless lc $entry eq $keyword_lc;
        next if !$self->{nocase} and $entry ne $keyword;
        next if $seen{"$podname\t$line"}++;
        push @ret, Pod::Index::Entry->new(
            keyword  => $entry,
            podname  => $podname,
            line     => $line,
            filename => $self->{filemap}($podname),
            context  => $context,
        );
    }
    return @ret;
}


1;

__END__