File Coverage

blib/lib/CPAN/02Packages/Search.pm
Criterion Covered Total %
statement 15 46 32.6
branch 0 18 0.0
condition 0 6 0.0
subroutine 5 9 55.5
pod 0 2 0.0
total 20 81 24.6


line stmt bran cond sub pod time code
1             package CPAN::02Packages::Search;
2 1     1   66684 use strict;
  1         3  
  1         28  
3 1     1   5 use warnings;
  1         2  
  1         23  
4              
5 1     1   535 use IO::Handle;
  1         6061  
  1         41  
6 1     1   490 use Search::Dict ();
  1         1005  
  1         51  
7 1     1   394 use Tie::Handle::SkipHeader;
  1         3756  
  1         470  
8              
9             our $VERSION = '0.002';
10              
11             sub new {
12 0     0 0   my ($class, %argv) = @_;
13 0           my $file = $argv{file};
14 0 0         my $skip_header = exists $argv{skip_header} ? $argv{skip_header} : 1;
15 0           my $self = bless { file => $file, skip_header => $skip_header }, $class;
16 0           $self->_fh;
17 0           $self;
18             }
19              
20             sub _fh {
21 0     0     my $self = shift;
22 0 0 0       return $self->{fh} if defined $self->{pid} && $self->{pid} == $$;
23 0           my $file = $self->{file};
24 0 0         if ($self->{skip_header}) {
25 0           my $fh = IO::Handle->new;
26 0 0         tie *$fh, 'Tie::Handle::SkipHeader', '<', $file or die "$!: $file\n";
27 0           $self->{fh} = $fh;
28             } else {
29 0 0         open my $fh, "<", $file or die "$!: $file\n";
30 0           $self->{fh} = $fh;
31             }
32 0           $self->{pid} = $$;
33 0           $self->{fh};
34             }
35              
36             sub search {
37 0     0 0   my ($self, $package) = @_;
38 0           my $fh = $self->_fh;
39 0           seek $fh, 0, 0;
40 0           my $pos = Search::Dict::look $fh, $package, { xfrm => \&_xform_package, fold => 1 };
41 0 0 0       return if $pos == -1 || eof $fh;
42 0           while (my $line = <$fh>) {
43 0 0         last if $line !~ /\A\Q$package\E\s+/i;
44 0           chomp $line;
45 0           my ($_package, $version, $path) = split /\s+/, $line, 4;
46 0 0         if ($package eq $_package) {
47 0 0         $version = undef if $version eq 'undef';
48 0           return { version => $version, path => $path };
49             }
50             }
51 0           return;
52             }
53              
54 0     0     sub _xform_package { (split " ", $_[0], 2)[0] }
55              
56             1;
57             __END__