line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#!/usr/bin/perl |
2
|
|
|
|
|
|
|
# -*- perl -*- |
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
# |
5
|
|
|
|
|
|
|
# Author: Slaven Rezic |
6
|
|
|
|
|
|
|
# |
7
|
|
|
|
|
|
|
# Copyright (C) 2009,2010,2012,2013,2014 Slaven Rezic. All rights reserved. |
8
|
|
|
|
|
|
|
# This program is free software; you can redistribute it and/or |
9
|
|
|
|
|
|
|
# modify it under the same terms as Perl itself. |
10
|
|
|
|
|
|
|
# |
11
|
|
|
|
|
|
|
# Mail: slaven@rezic.de |
12
|
|
|
|
|
|
|
# WWW: http://www.rezic.de/eserte/ |
13
|
|
|
|
|
|
|
# |
14
|
|
|
|
|
|
|
|
15
|
3
|
|
|
3
|
|
306946
|
use strict; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
117
|
|
16
|
3
|
|
|
3
|
|
16
|
use warnings; |
|
3
|
|
|
|
|
18
|
|
|
3
|
|
|
|
|
91
|
|
17
|
|
|
|
|
|
|
|
18
|
3
|
|
|
3
|
|
2432
|
use CPAN::DistnameInfo (); |
|
3
|
|
|
|
|
2997
|
|
|
3
|
|
|
|
|
229
|
|
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
###################################################################### |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
{ |
23
|
|
|
|
|
|
|
package Parse::CPAN::Packages::Fast; |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
our $VERSION = '0.08'; |
26
|
|
|
|
|
|
|
$VERSION =~ s{_}{}; |
27
|
|
|
|
|
|
|
|
28
|
3
|
|
|
3
|
|
2068
|
use IO::Uncompress::Gunzip qw($GunzipError); |
|
3
|
|
|
|
|
116832
|
|
|
3
|
|
|
|
|
367
|
|
29
|
3
|
|
|
3
|
|
2785
|
use CPAN::Version (); |
|
3
|
|
|
|
|
6542
|
|
|
3
|
|
|
|
|
144
|
|
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
# Note: this function is possibly interactive, i.e. if CPAN.pm was |
32
|
|
|
|
|
|
|
# never configured, or if CPAN's Config.pm needs reconfiguration. |
33
|
|
|
|
|
|
|
sub _default_packages_file_interactive { |
34
|
0
|
|
|
0
|
|
0
|
my($class) = @_; |
35
|
0
|
|
|
|
|
0
|
require CPAN; |
36
|
3
|
|
|
3
|
|
23
|
no warnings 'once'; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
328
|
|
37
|
0
|
|
|
|
|
0
|
local $CPAN::Be_Silent = 1; |
38
|
0
|
|
|
|
|
0
|
CPAN::HandleConfig->load; |
39
|
0
|
|
|
|
|
0
|
my $packages_file = $CPAN::Config->{keep_source_where} . "/modules/02packages.details.txt.gz"; |
40
|
0
|
|
|
|
|
0
|
$packages_file; |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
# Note: this function is guaranteed to be non-interactive, but it |
44
|
|
|
|
|
|
|
# is using just default locations to look at the CPAN config, or |
45
|
|
|
|
|
|
|
# the 02packages files. |
46
|
|
|
|
|
|
|
sub _default_packages_file_batch { |
47
|
2
|
|
|
2
|
|
9844
|
my($class) = @_; |
48
|
|
|
|
|
|
|
|
49
|
2
|
|
|
|
|
5
|
my $home_cpandir = do { |
50
|
3
|
|
|
3
|
|
14
|
no warnings 'uninitialized'; # HOME may be uninitialized on some systems e.g. Windows |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
2088
|
|
51
|
2
|
|
|
|
|
8
|
"$ENV{HOME}/.cpan"; |
52
|
|
|
|
|
|
|
}; |
53
|
2
|
50
|
|
|
|
13
|
if (!$INC{"CPAN/MyConfig.pm"}) { |
54
|
2
|
|
|
|
|
7
|
my $home_myconfig = "$home_cpandir/CPAN/MyConfig.pm"; |
55
|
2
|
50
|
|
|
|
76
|
if (-r $home_myconfig) { |
56
|
2
|
|
|
|
|
8
|
local @INC = ($home_cpandir); |
57
|
2
|
|
|
|
|
5
|
eval { require CPAN::MyConfig }; |
|
2
|
|
|
|
|
1460
|
|
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
} |
60
|
2
|
50
|
33
|
|
|
26
|
if ($INC{"CPAN/MyConfig.pm"} && $CPAN::Config->{keep_source_where}) { |
61
|
2
|
|
|
|
|
9
|
my $packages_file = $CPAN::Config->{keep_source_where} . "/modules/02packages.details.txt.gz"; |
62
|
2
|
50
|
33
|
|
|
96
|
if (-r $packages_file && -s $packages_file) { |
63
|
2
|
|
|
|
|
29
|
return $packages_file; |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
# Cannot find a usable CPAN::MyConfig, try a default location |
68
|
0
|
|
|
|
|
0
|
my $packages_file = "$home_cpandir/sources/modules/02packages.details.txt.gz"; |
69
|
0
|
0
|
0
|
|
|
0
|
if (-r $packages_file && -s $packages_file) { |
70
|
0
|
|
|
|
|
0
|
return $packages_file; |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
0
|
|
|
|
|
0
|
undef; |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
*_default_packages_file = \&_default_packages_file_interactive; |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
sub new { |
79
|
3
|
|
|
3
|
1
|
102683
|
my($class, $packages_file) = @_; |
80
|
|
|
|
|
|
|
|
81
|
3
|
50
|
|
|
|
15
|
if (!$packages_file) { |
82
|
0
|
|
|
|
|
0
|
$packages_file = $class->_default_packages_file; |
83
|
0
|
0
|
|
|
|
0
|
if (!$packages_file) { |
84
|
0
|
|
|
|
|
0
|
die "packages file not specified and cannot be determined from CPAN.pm configuration"; |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
3
|
|
|
|
|
8
|
my %pkg_to_dist; |
89
|
|
|
|
|
|
|
my %dist_to_pkgs; |
90
|
0
|
|
|
|
|
0
|
my %pkg_ver; |
91
|
|
|
|
|
|
|
|
92
|
3
|
50
|
|
|
|
33
|
my $FH = IO::Uncompress::Gunzip->new($packages_file) |
93
|
|
|
|
|
|
|
or die "Can't open $packages_file: $GunzipError"; |
94
|
|
|
|
|
|
|
# overread header |
95
|
3
|
|
|
|
|
8833
|
while(<$FH>) { |
96
|
20
|
100
|
|
|
|
1210
|
last if /^$/; |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
# read payload |
99
|
3
|
|
|
|
|
13
|
while(<$FH>) { |
100
|
291826
|
|
|
|
|
20500235
|
my($pkg, $ver, $dist) = split; |
101
|
291826
|
|
|
|
|
1420884
|
$pkg_to_dist{$pkg} = $dist; |
102
|
291826
|
|
|
|
|
819637
|
$pkg_ver{$pkg} = $ver; |
103
|
291826
|
|
|
|
|
377340
|
push @{ $dist_to_pkgs{$dist} }, $pkg; |
|
291826
|
|
|
|
|
1638151
|
|
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
|
106
|
3
|
|
|
|
|
131
|
bless { pkg_to_dist => \%pkg_to_dist, |
107
|
|
|
|
|
|
|
dist_to_pkgs => \%dist_to_pkgs, |
108
|
|
|
|
|
|
|
pkg_ver => \%pkg_ver, |
109
|
|
|
|
|
|
|
}, $class; |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
sub package { |
113
|
1
|
|
|
1
|
0
|
4
|
my($self, $package_name) = @_; |
114
|
1
|
50
|
|
|
|
11
|
return undef if !exists $self->{pkg_ver}{$package_name}; |
115
|
1
|
|
|
|
|
15
|
Parse::CPAN::Packages::Fast::Package->new($package_name, $self); |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
sub packages { |
119
|
1
|
|
|
1
|
1
|
285
|
my $self = shift; |
120
|
1
|
|
|
|
|
3
|
keys %{ $self->{pkg_ver} }; |
|
1
|
|
|
|
|
95193
|
|
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
sub package_count { |
124
|
1
|
|
|
1
|
0
|
752
|
my $self = shift; |
125
|
1
|
|
|
|
|
1
|
scalar keys %{ $self->{pkg_ver} }; |
|
1
|
|
|
|
|
13
|
|
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
sub distribution { |
129
|
0
|
|
|
0
|
1
|
0
|
my($self, $distribution_name) = @_; |
130
|
0
|
0
|
|
|
|
0
|
die "Distribution $distribution_name does not exist" if !exists $self->{dist_to_pkgs}{$distribution_name}; # XXX die or not? |
131
|
0
|
|
|
|
|
0
|
Parse::CPAN::Packages::Fast::Distribution->new($distribution_name, $self); |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
sub distributions { |
135
|
1
|
|
|
1
|
0
|
3
|
my $self = shift; |
136
|
1
|
|
|
|
|
4
|
map { Parse::CPAN::Packages::Fast::Distribution->new($_, $self) } keys %{ $self->{dist_to_pkgs} }; |
|
30892
|
|
|
|
|
75305
|
|
|
1
|
|
|
|
|
19053
|
|
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
sub distribution_count { |
140
|
1
|
|
|
1
|
0
|
3
|
my $self = shift; |
141
|
1
|
|
|
|
|
5
|
my @dists = $self->distributions; |
142
|
1
|
|
|
|
|
8519
|
scalar @dists; |
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
sub latest_distribution { |
146
|
3
|
|
|
3
|
0
|
1165
|
my($self, $distribution_name) = @_; |
147
|
3
|
|
|
|
|
35
|
my @candidates; |
148
|
3
|
|
|
|
|
7
|
for my $candidate (keys %{ $self->{dist_to_pkgs} }) { |
|
3
|
|
|
|
|
39489
|
|
149
|
61786
|
100
|
|
|
|
250900
|
if ($candidate =~ m{^./../.*/\Q$distribution_name}) { |
150
|
|
|
|
|
|
|
# Possibly pure CPAN::DistnameInfo is somewhat faster |
151
|
|
|
|
|
|
|
# than Parse::CPAN::Packages::Fast::Distribution (no |
152
|
|
|
|
|
|
|
# inside-out handling, no additional DESTROY) |
153
|
6
|
|
|
|
|
81
|
my $d = CPAN::DistnameInfo->new($candidate); |
154
|
3
|
|
|
3
|
|
19
|
no warnings 'uninitialized'; # Some distributions have no parseable dist name |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
3114
|
|
155
|
6
|
50
|
|
|
|
789
|
if ($d->dist eq $distribution_name) { |
156
|
6
|
|
|
|
|
76
|
push @candidates, $d; |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
} |
160
|
3
|
50
|
|
|
|
18925
|
return if !@candidates; # XXX die or not? |
161
|
3
|
|
|
|
|
18
|
my $best_candidate = pop @candidates; |
162
|
3
|
|
|
|
|
42
|
my $best_candidate_version = $best_candidate->version; |
163
|
3
|
|
|
|
|
40
|
for my $candidate (@candidates) { |
164
|
3
|
|
|
|
|
18
|
my $this_version = $candidate->version; |
165
|
3
|
100
|
|
|
|
42
|
if (CPAN::Version->vlt($best_candidate_version, $this_version)) { |
166
|
2
|
|
|
|
|
153
|
$best_candidate = $candidate; |
167
|
2
|
|
|
|
|
29
|
$best_candidate_version = $this_version; |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
} |
170
|
3
|
|
|
|
|
64
|
Parse::CPAN::Packages::Fast::Distribution->new($best_candidate->pathname, $self); |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
sub latest_distributions { |
174
|
2
|
|
|
2
|
0
|
7
|
my $self = shift; |
175
|
2
|
|
|
|
|
6
|
my %latest_dist; |
176
|
2
|
|
|
|
|
7
|
for my $pathname (keys %{ $self->{dist_to_pkgs} }) { |
|
2
|
|
|
|
|
40625
|
|
177
|
61784
|
|
|
|
|
169669
|
my $d = Parse::CPAN::Packages::Fast::Distribution->new($pathname, $self); |
178
|
61784
|
|
|
|
|
171535
|
my $dist = $d->dist; |
179
|
61784
|
100
|
|
|
|
281784
|
next if !defined $dist; |
180
|
61716
|
100
|
|
|
|
189964
|
if (!exists $latest_dist{$dist}) { |
181
|
58236
|
|
|
|
|
199949
|
$latest_dist{$dist} = $d; |
182
|
|
|
|
|
|
|
} else { |
183
|
3480
|
100
|
|
|
|
13727
|
if (CPAN::Version->vlt($latest_dist{$dist}->version, $d->version)) { |
184
|
1598
|
|
|
|
|
94005
|
$latest_dist{$dist} = $d; |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
} |
187
|
|
|
|
|
|
|
} |
188
|
2
|
|
|
|
|
116088
|
values %latest_dist; |
189
|
|
|
|
|
|
|
} |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
sub latest_distribution_count { |
192
|
1
|
|
|
1
|
0
|
3
|
my $self = shift; |
193
|
1
|
|
|
|
|
6
|
my @dists = $self->latest_distributions; |
194
|
1
|
|
|
|
|
6544
|
scalar @dists; |
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
# Addition: fast module lookup without loading whole packages file |
198
|
|
|
|
|
|
|
# Not yet official! |
199
|
|
|
|
|
|
|
sub _module_lookup { |
200
|
13
|
50
|
|
13
|
|
38071
|
die "Usage?" if @_ != 4; |
201
|
13
|
|
|
|
|
62
|
my($class, $module, $orig_packages_file, $cache_file) = @_; |
202
|
13
|
|
|
|
|
1619
|
require Search::Dict; |
203
|
13
|
|
|
|
|
1420
|
my $pwhfh = $class->_get_plain_packages_fh($orig_packages_file, $cache_file); |
204
|
13
|
|
|
|
|
34
|
my $skey = "$module "; |
205
|
13
|
50
|
|
|
|
49
|
return if Search::Dict::look($pwhfh, $skey, 0, 1) == -1; |
206
|
13
|
|
|
|
|
8636
|
while () { |
207
|
13
|
|
|
|
|
136
|
my $got = <$pwhfh>; |
208
|
13
|
100
|
|
|
|
51
|
if (index($got, $skey) == 0) { |
209
|
12
|
|
|
|
|
17
|
chomp $got; |
210
|
12
|
|
|
|
|
50
|
my($pkg, $ver, $dist) = split /\s+/, $got; |
211
|
|
|
|
|
|
|
return { |
212
|
12
|
|
|
|
|
293
|
package => $pkg, |
213
|
|
|
|
|
|
|
version => $ver, |
214
|
|
|
|
|
|
|
dist => $dist, |
215
|
|
|
|
|
|
|
}; |
216
|
|
|
|
|
|
|
} |
217
|
1
|
50
|
|
|
|
60
|
return if lc(substr($got, 0, length($skey))) gt lc($skey); |
218
|
0
|
0
|
|
|
|
0
|
return if eof($pwhfh); |
219
|
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
sub _get_plain_packages_fh { |
223
|
13
|
50
|
|
13
|
|
44
|
die "Usage?" if @_ != 3; |
224
|
13
|
|
|
|
|
27
|
my(undef, $orig_packages_file, $cache_file) = @_; |
225
|
13
|
50
|
|
|
|
425
|
die "$orig_packages_file does not exist" if !-e $orig_packages_file; |
226
|
13
|
100
|
66
|
|
|
678
|
if (!-e $cache_file || -M $cache_file > -M $orig_packages_file) { |
227
|
1
|
50
|
|
|
|
15
|
my $ifh = IO::Uncompress::Gunzip->new($orig_packages_file) |
228
|
|
|
|
|
|
|
or die "Can't open $orig_packages_file: $GunzipError"; |
229
|
1
|
|
|
|
|
2366
|
require File::Temp; |
230
|
1
|
|
|
|
|
6
|
require File::Basename; |
231
|
1
|
50
|
|
|
|
78
|
my($tmpfh,$tmpfile) = File::Temp::tempfile(DIR => File::Basename::dirname($cache_file)) |
232
|
|
|
|
|
|
|
or die "Can't create temporary file: $!"; |
233
|
1
|
|
|
|
|
580
|
while (<$ifh>) { |
234
|
9
|
100
|
|
|
|
516
|
last if /^$/; |
235
|
|
|
|
|
|
|
} |
236
|
|
|
|
|
|
|
{ |
237
|
1
|
|
|
|
|
3
|
local $/ = \8192; |
|
1
|
|
|
|
|
6
|
|
238
|
1
|
|
|
|
|
5
|
while (<$ifh>) { |
239
|
1507
|
|
|
|
|
1325129
|
print $tmpfh $_; |
240
|
|
|
|
|
|
|
} |
241
|
|
|
|
|
|
|
} |
242
|
1
|
50
|
|
|
|
117
|
close $tmpfh |
243
|
|
|
|
|
|
|
or die "Error while writing temporary file $tmpfile: $!"; |
244
|
1
|
50
|
|
|
|
168
|
rename $tmpfile, $cache_file |
245
|
|
|
|
|
|
|
or die "While renaming $tmpfile to $cache_file: $!"; |
246
|
|
|
|
|
|
|
} |
247
|
13
|
50
|
|
|
|
839
|
open my $fh, $cache_file |
248
|
|
|
|
|
|
|
or die "Can't open $cache_file: $!"; |
249
|
13
|
|
|
|
|
39
|
$fh; |
250
|
|
|
|
|
|
|
} |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
} |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
###################################################################### |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
{ |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
package Parse::CPAN::Packages::Fast::Package; |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
our $VERSION = $Parse::CPAN::Packages::Fast::VERSION; |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
# Use inside-out technique for this member, to hide it in dumps etc. |
263
|
|
|
|
|
|
|
my %obj_to_packages; |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
sub new { |
266
|
4
|
|
|
4
|
|
10
|
my($class, $package_name, $packages) = @_; |
267
|
4
|
|
|
|
|
28
|
my $self = bless { package => $package_name, |
268
|
|
|
|
|
|
|
version => $packages->{pkg_ver}{$package_name}, |
269
|
|
|
|
|
|
|
}, 'Parse::CPAN::Packages::Fast::Package'; |
270
|
4
|
|
|
|
|
27
|
$obj_to_packages{$self} = $packages; |
271
|
4
|
|
|
|
|
17
|
$self; |
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
for my $method (qw(package version)) { |
275
|
3
|
|
|
3
|
|
25
|
no strict 'refs'; |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
695
|
|
276
|
6
|
|
|
6
|
|
1116
|
*{$method} = sub { shift->{$method} }; |
277
|
|
|
|
|
|
|
} |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
sub distribution { |
280
|
2
|
|
|
2
|
|
4
|
my $self = shift; |
281
|
2
|
|
|
|
|
8
|
my $packages = $obj_to_packages{$self}; |
282
|
2
|
|
|
|
|
12
|
my $dist = $packages->{pkg_to_dist}->{$self->package}; |
283
|
2
|
|
|
|
|
10
|
Parse::CPAN::Packages::Fast::Distribution->new($dist, $packages); |
284
|
|
|
|
|
|
|
} |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
sub prefix { |
287
|
1
|
|
|
1
|
|
3
|
my $self = shift; |
288
|
1
|
|
|
|
|
5
|
$self->distribution->prefix; |
289
|
|
|
|
|
|
|
} |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
sub DESTROY { |
292
|
4
|
|
|
4
|
|
46800
|
my $self = shift; |
293
|
4
|
|
|
|
|
347265
|
delete $obj_to_packages{$self}; |
294
|
|
|
|
|
|
|
} |
295
|
|
|
|
|
|
|
} |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
###################################################################### |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
{ |
300
|
|
|
|
|
|
|
package Parse::CPAN::Packages::Fast::Distribution; |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
our $VERSION = $Parse::CPAN::Packages::Fast::VERSION; |
303
|
|
|
|
|
|
|
|
304
|
3
|
|
|
3
|
|
42
|
use base qw(CPAN::DistnameInfo); |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
6605
|
|
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
# Use inside-out technique for this member, to hide it in dumps etc. |
307
|
|
|
|
|
|
|
my %obj_to_packages; |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
sub new { |
310
|
92681
|
|
|
92681
|
|
187812
|
my($class, $pathname, $packages) = @_; |
311
|
92681
|
|
|
|
|
299490
|
my $self = $class->SUPER::new($pathname); |
312
|
92681
|
|
|
|
|
6401608
|
$obj_to_packages{$self} = $packages; |
313
|
92681
|
|
|
|
|
226113
|
$self; |
314
|
|
|
|
|
|
|
} |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
sub prefix { |
317
|
2
|
|
|
2
|
|
1008
|
my $self = shift; |
318
|
2
|
|
|
|
|
16
|
my $prefix = $self->pathname; |
319
|
2
|
|
|
|
|
11
|
$prefix =~ s{^authors/id/}{}; |
320
|
2
|
|
|
|
|
17
|
$prefix; |
321
|
|
|
|
|
|
|
} |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
sub contains { |
324
|
1
|
|
|
1
|
|
3
|
my $self = shift; |
325
|
1
|
|
|
|
|
4
|
my $packages = $obj_to_packages{$self}; |
326
|
1
|
|
|
|
|
4
|
map { Parse::CPAN::Packages::Fast::Package->new($_, $packages) } @{ $packages->{dist_to_pkgs}{$self->pathname} }; |
|
3
|
|
|
|
|
17
|
|
|
1
|
|
|
|
|
7
|
|
327
|
|
|
|
|
|
|
} |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
sub DESTROY { |
330
|
92681
|
|
|
92681
|
|
402745
|
my $self = shift; |
331
|
92681
|
|
|
|
|
688946
|
delete $obj_to_packages{$self}; |
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
# Methods found in original Parse::CPAN::Packages::Distribution |
335
|
|
|
|
|
|
|
sub add_package { |
336
|
0
|
|
|
0
|
|
|
die "NYI"; |
337
|
|
|
|
|
|
|
} |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
# Would be nice to have: |
340
|
|
|
|
|
|
|
sub is_latest_distribution { |
341
|
0
|
|
|
0
|
|
|
die "NYI"; |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
} |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
###################################################################### |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
1; |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
__END__ |