line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package DhMakePerl::Utils; |
2
|
|
|
|
|
|
|
|
3
|
5
|
|
|
5
|
|
549299
|
use strict; |
|
5
|
|
|
|
|
16
|
|
|
5
|
|
|
|
|
250
|
|
4
|
5
|
|
|
5
|
|
40
|
use warnings; |
|
5
|
|
|
|
|
19
|
|
|
5
|
|
|
|
|
567
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
our $VERSION = '0.71'; |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
=head1 NAME |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
DhMakePerl::Utils - helper routines for dh-make-perl and alike |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
=head1 SYNOPSIS |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
use DhMakePerl::Utils qw(is_core_module); |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
my $v = is_core_module('Test::More', '1.002'); |
17
|
|
|
|
|
|
|
my $v = nice_perl_ver('5.010001'); |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
=cut |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
our @EXPORT_OK = qw( |
22
|
|
|
|
|
|
|
find_core_perl_dependency |
23
|
|
|
|
|
|
|
apt_cache |
24
|
|
|
|
|
|
|
find_cpan_module find_cpan_distribution |
25
|
|
|
|
|
|
|
is_core_module |
26
|
|
|
|
|
|
|
nice_perl_ver |
27
|
|
|
|
|
|
|
split_version_relation |
28
|
|
|
|
|
|
|
); |
29
|
|
|
|
|
|
|
|
30
|
5
|
|
|
5
|
|
121
|
use base 'Exporter'; |
|
5
|
|
|
|
|
11
|
|
|
5
|
|
|
|
|
880
|
|
31
|
|
|
|
|
|
|
|
32
|
5
|
|
|
5
|
|
105
|
use 5.10.0; |
|
5
|
|
|
|
|
19
|
|
33
|
|
|
|
|
|
|
|
34
|
5
|
|
|
5
|
|
4225
|
use AptPkg::Cache; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
use Module::CoreList (); |
36
|
|
|
|
|
|
|
use Debian::Dependency; |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
=head1 FUNCTIONS |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
None of he following functions is exported by default. |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
=over |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
=item apt_cache |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
Evaluate the creation of an AptPkg::Cache, and return it on success |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
=cut |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
sub apt_cache { |
51
|
|
|
|
|
|
|
my $apt_cache; |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
eval { |
54
|
|
|
|
|
|
|
$apt_cache = AptPkg::Cache->new; |
55
|
|
|
|
|
|
|
}; |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
warn "Error initializing AptPkg::Cache: $@" if $@; |
58
|
|
|
|
|
|
|
$apt_cache; |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
=item find_cpan_module |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
Returns CPAN::Module object that corresponds to the supplied argument. Returns |
64
|
|
|
|
|
|
|
undef if no module is found by CPAN. |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
If the CPAN module needs to be configured in some way, that should be done |
67
|
|
|
|
|
|
|
before calling this function. |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=cut |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
sub find_cpan_module { |
72
|
|
|
|
|
|
|
my( $name ) = @_; |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
my $mod; |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
# expand() returns a list of matching items when called in list |
77
|
|
|
|
|
|
|
# context, so after retrieving it, we try to match exactly what |
78
|
|
|
|
|
|
|
# the user asked for. Specially important when there are |
79
|
|
|
|
|
|
|
# different modules which only differ in case. |
80
|
|
|
|
|
|
|
# |
81
|
|
|
|
|
|
|
# This Closes: #451838 |
82
|
|
|
|
|
|
|
my @mod = CPAN::Shell->expand( 'Module', '/^' . $name . '$/' ); |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
foreach (@mod) { |
85
|
|
|
|
|
|
|
my $file = $_->cpan_file(); |
86
|
|
|
|
|
|
|
$file =~ s#.*/##; # remove directory |
87
|
|
|
|
|
|
|
$file =~ s/(.*)-.*/$1/; # remove version and extension |
88
|
|
|
|
|
|
|
$file =~ s/-/::/g; # convert dashes to colons |
89
|
|
|
|
|
|
|
if ( $file eq $name ) { |
90
|
|
|
|
|
|
|
$mod = $_; |
91
|
|
|
|
|
|
|
last; |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
$mod = shift @mod unless ($mod); |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
return $mod; |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=item find_cpan_distribution |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
Returns CPAN::Distribution object that corresponds to the supplied argument. |
102
|
|
|
|
|
|
|
Returns undef if no distribution is found by CPAN. |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
If the CPAN module needs to be configured in some way, that should be done |
105
|
|
|
|
|
|
|
before calling this function. |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=cut |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
sub find_cpan_distribution { |
110
|
|
|
|
|
|
|
my( $name ) = @_; |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
$name =~ s/::/-/g; |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
return CPAN::Shell->expand( 'Distribution', |
115
|
|
|
|
|
|
|
"/\\/$name-[^\\/]+\\.(tar|zip)/" ); |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
=item is_core_module I, I |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
Returns the version of the C package containing the given I (at |
121
|
|
|
|
|
|
|
least version I). |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
Returns C if I is not a core module. |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
=cut |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
sub is_core_module { |
128
|
|
|
|
|
|
|
my ( $module, $ver ) = @_; |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
my $v = Module::CoreList->first_release($module, $ver); # 5.009002 |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
return unless defined $v; |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
$v = version->new($v); # v5.9.2 |
135
|
|
|
|
|
|
|
( $v = $v->normal ) =~ s/^v//; # "5.9.2" |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
return $v; |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
=item nice_perl_ver I |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
Re-formats perl version to match Debian's perl package versions. |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
For example C<5.010> (and C<5.01>) is converted to C<5.10>. |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
=cut |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
sub nice_perl_ver { |
149
|
|
|
|
|
|
|
my( $v ) = @_; |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
if( $v =~ /\.(\d+)$/ and $v !~ /\..+\./ ) { # do nothing for 5.9.1 |
152
|
|
|
|
|
|
|
my $minor = $1; |
153
|
|
|
|
|
|
|
if( length($minor) % 3 ) { |
154
|
|
|
|
|
|
|
# right-pad with zeroes so that the number of digits after the dot |
155
|
|
|
|
|
|
|
# is a multiple of 3 |
156
|
|
|
|
|
|
|
$minor .= '0' x ( 3 - length($minor) % 3 ); |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
my $ver = 0 + substr( $minor, 0, 3 ); |
160
|
|
|
|
|
|
|
if( length($minor) > 3 ) { |
161
|
|
|
|
|
|
|
$ver .= '.' . ( 0 + substr( $minor, 3 ) ); |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
$v =~ s/\.\d+$/.$ver/; |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
$v .= '.0' if $v =~ /^\d+\.\d+$/; # force three-component version |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
return $v; |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
=item core_module_perls I[, I] |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
Returns a list of Perl versions that have I. If I is |
174
|
|
|
|
|
|
|
given, the list contains only Perl versions containing I at least |
175
|
|
|
|
|
|
|
version I. |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
=cut |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
sub core_module_perls { |
180
|
|
|
|
|
|
|
my( $module, $version ) = @_; |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
my @ret; |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
$version = version->new($version) if $version; |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
for my $v( |
187
|
|
|
|
|
|
|
sort keys %Module::CoreList::version ){ |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
# Module::CoreList::version includes families (i.e. "5") as well as |
190
|
|
|
|
|
|
|
# full versions, skip the families. |
191
|
|
|
|
|
|
|
next unless ($v =~ /^\d+\.\d+(?:\.|$)/); |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
next unless exists $Module::CoreList::version{$v}{$module}; |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
my $found = $Module::CoreList::version{$v}{$module}; |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
push @ret, $v |
198
|
|
|
|
|
|
|
if not $version |
199
|
|
|
|
|
|
|
or $found and version->new($found) >= $version; |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
return @ret; |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
=item find_core_perl_dependency( $module[, $version] ) |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
return a dependency on perl containing the required module version. If the |
208
|
|
|
|
|
|
|
module is not available in any perl released by Debian, return undef. |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
=cut |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
our %debian_perl = ( |
213
|
|
|
|
|
|
|
'5.8' => { |
214
|
|
|
|
|
|
|
min => Dpkg::Version->new('5.8.8'), |
215
|
|
|
|
|
|
|
max => Dpkg::Version->new('5.8.8'), |
216
|
|
|
|
|
|
|
}, |
217
|
|
|
|
|
|
|
'5.10' => { |
218
|
|
|
|
|
|
|
min => Dpkg::Version->new('5.10.0'), |
219
|
|
|
|
|
|
|
max => Dpkg::Version->new('5.10.1'), |
220
|
|
|
|
|
|
|
}, |
221
|
|
|
|
|
|
|
); |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
sub find_core_perl_dependency { |
224
|
|
|
|
|
|
|
my ( $module, $version ) = @_; |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
if ( $module eq 'perl' ) { |
227
|
|
|
|
|
|
|
return Debian::Dependency->new('perl') unless $version; |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
return Debian::Dependency->new( 'perl', nice_perl_ver($version) ); |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
my $perl_dep; |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
my @perl_releases = core_module_perls( $module, $version ); |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
for my $v (@perl_releases) { |
237
|
|
|
|
|
|
|
$v = nice_perl_ver($v); |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
$v =~ /^(\d+\.\d+)(?:\.|$)/; |
240
|
|
|
|
|
|
|
my $major = $1 or die "[$v] is a strange version"; |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
# we want to avoid depending on things like 5.8.9 which aren't in |
243
|
|
|
|
|
|
|
# Debian and can contain stuff newer than in 5.10.0 |
244
|
|
|
|
|
|
|
if ( $debian_perl{$major} |
245
|
|
|
|
|
|
|
and $debian_perl{$major}{max} >= $v ) |
246
|
|
|
|
|
|
|
{ |
247
|
|
|
|
|
|
|
return Debian::Dependency->new( 'perl', $v ); |
248
|
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
# not a core module |
252
|
|
|
|
|
|
|
return undef; |
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
=item split_version_relation I |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
Splits the string, typically found in dependency fields' values in CPAN META |
258
|
|
|
|
|
|
|
into relation and version. If no relation is found in the string, C<< >= >> is |
259
|
|
|
|
|
|
|
assumed. |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
Returns a list of relation and version. The relation is suitable for using in |
262
|
|
|
|
|
|
|
Debian package dependency version requirements. |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
For example |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
=over |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
=item split_version_relation('0.45') returns ( '>=', '0.45' ) |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
=item split_version_relation('< 0.56') returns ( '<<', '0.56' ) |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
=back |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
=cut |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
sub split_version_relation { |
277
|
|
|
|
|
|
|
my $in = shift; |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
$in =~ s/^\s*([<>=!])\s*//; |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
my $rel = $1 // '>='; |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
$rel = '>>' if $rel eq '>'; |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
$rel = '<<' if $rel eq '<'; |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
return ( $rel, $in ); |
288
|
|
|
|
|
|
|
} |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
=back |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
=over |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
=item Copyright (C) 2008, 2009, 2010 Damyan Ivanov |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
=back |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it under |
301
|
|
|
|
|
|
|
the terms of the GNU General Public License version 2 as published by the Free |
302
|
|
|
|
|
|
|
Software Foundation. |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
This program is distributed in the hope that it will be useful, but WITHOUT ANY |
305
|
|
|
|
|
|
|
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A |
306
|
|
|
|
|
|
|
PARTICULAR PURPOSE. See the GNU General Public License for more details. |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
You should have received a copy of the GNU General Public License along with |
309
|
|
|
|
|
|
|
this program; if not, write to the Free Software Foundation, Inc., 51 Franklin |
310
|
|
|
|
|
|
|
Street, Fifth Floor, Boston, MA 02110-1301 USA. |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
=cut |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
1; # End of DhMakePerl |