File Coverage

blib/lib/CPAN/02Packages/Search.pm

Criterion	Covered	Total	%
statement	15	43	34.8
branch	0	18	0.0
condition	0	3	0.0
subroutine	5	9	55.5
pod	0	2	0.0
total	20	75	26.6

package CPAN::02Packages::Search;
use strict;
use warnings;

use Search::Dict ();
use Symbol ();
use Tie::Handle::SkipHeader;

our $VERSION = '0.100';

sub new {
    my ($class, %argv) = @_;
    my $fh = $argv{fh};
    if (!$fh) {
        my $file = $argv{file};
        my $skip_header = exists $argv{skip_header} ? $argv{skip_header} : 1;
        $fh = $class->_open($file, $skip_header);
    }
    bless { fh => $fh }, $class;
}

sub _open {
    my ($class, $file, $skip_header) = @_;
    if ($skip_header) {
        my $fh = Symbol::gensym;
        tie *$fh, 'Tie::Handle::SkipHeader', '<', $file or die "$!: $file\n";
        return $fh;
    }
    open my $fh, "<", $file or die "$!: $file\n";
    $fh;
}

sub search {
    my ($self, $package) = @_;
    my $fh = $self->{fh};
    seek $fh, 0, 0;
    my $pos = Search::Dict::look $fh, $package, { xfrm => \&_xform_package, fold => 1 };
    return if $pos == -1 || eof $fh;
    while (my $line = <$fh>) {
        last if $line !~ /\A\Q$package\E\s+/i;
        chomp $line;
        my ($_package, $version, $path) = split /\s+/, $line, 4;
        if ($package eq $_package) {
            $version = undef if $version eq 'undef';
            return { version => $version, path => $path };
        }
    }
    return;
}

sub _xform_package { (split " ", $_[0], 2)[0] }

1;
__END__