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__ |