line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package PAR::Repository::Query; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
19667
|
use 5.006; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
30
|
|
4
|
1
|
|
|
1
|
|
3
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
34
|
|
5
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
30
|
|
6
|
|
|
|
|
|
|
|
7
|
1
|
|
|
1
|
|
4
|
use Carp qw/croak/; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
1160
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
our $VERSION = '0.14'; |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
=head1 NAME |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
PAR::Repository::Query - Implements repository queries |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
=head1 SYNOPSIS |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
use PAR::Repository; |
18
|
|
|
|
|
|
|
# or: |
19
|
|
|
|
|
|
|
use PAR::Repository::Client; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
=head1 DESCRIPTION |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
This module is for internal use by L or |
24
|
|
|
|
|
|
|
L only. Both modules inherit from this. |
25
|
|
|
|
|
|
|
C implements a unified query interface for |
26
|
|
|
|
|
|
|
both the server- and client-side components of PAR repositories. |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
If you decide to inherit from this class (for whatever reason), |
29
|
|
|
|
|
|
|
you should provide at least two methods: C which returns |
30
|
|
|
|
|
|
|
a L object representing the modules DBM file. |
31
|
|
|
|
|
|
|
(See L for details.) And C which is |
32
|
|
|
|
|
|
|
the equivalent for the scripts DBM file. |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
=head2 EXPORT |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
None. But the methods are callable on C and |
37
|
|
|
|
|
|
|
C objects. |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
=head1 METHODS |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
Following is a list of class and instance methods. |
42
|
|
|
|
|
|
|
(Instance methods until otherwise mentioned.) |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
There is no C object. |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
=cut |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
=head2 query_module |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
Polls the repository for modules matching certain criteria. |
51
|
|
|
|
|
|
|
Takes named arguments. Either a C or a C parameter |
52
|
|
|
|
|
|
|
must be present but not both. |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
Returns a reference to an array containing alternating distribution |
55
|
|
|
|
|
|
|
file names and module versions. This method returns the following |
56
|
|
|
|
|
|
|
structure |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
[ 'Foo-Bar-0.01-any_arch-5.8.7.par', '0.01', ... ] |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
that means the module was found in the distribution |
61
|
|
|
|
|
|
|
F and the copy in that file has version |
62
|
|
|
|
|
|
|
0.01. |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
Parameters: |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
=over 2 |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
=item B |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
The name of the module to look for. This is used for an exact match. |
71
|
|
|
|
|
|
|
If you want to find C in C, use the C parameter. |
72
|
|
|
|
|
|
|
Only one of C and C may be specified. |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
=item B |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
Same as C, but interpreted as a regular expression. |
77
|
|
|
|
|
|
|
Only one of C and C may be specified. |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
=item B |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
Can be used to reduce the number of matches to a specific architecture. |
82
|
|
|
|
|
|
|
Always interpreted as a regular expression. |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=back |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
=cut |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub query_module { |
89
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
90
|
|
|
|
|
|
|
# $self->verbose(2, "Entering query_module()"); |
91
|
0
|
0
|
|
|
|
|
croak("query_module() called with uneven number of arguments.") |
92
|
|
|
|
|
|
|
if @_ % 2; |
93
|
0
|
|
|
|
|
|
my %args = @_; |
94
|
|
|
|
|
|
|
|
95
|
0
|
|
|
|
|
|
my $name = $args{name}; |
96
|
0
|
|
|
|
|
|
my $regex = $args{regex}; |
97
|
|
|
|
|
|
|
|
98
|
0
|
0
|
0
|
|
|
|
if (defined $name and defined $regex) { |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
99
|
0
|
|
|
|
|
|
croak("query_module() accepts only one of 'name' and 'regex' parameters."); |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
elsif (not defined $name and not defined $regex) { |
102
|
0
|
|
|
|
|
|
croak("query_module() needs one of 'name' and 'regex' parameters."); |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
elsif (defined $name) { |
105
|
0
|
|
|
|
|
|
$regex = qr/^\Q$name\E$/; |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
else { # regex defined |
108
|
0
|
0
|
|
|
|
|
$regex = qr/$regex/ if not ref($regex) eq 'Regexp'; |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
|
111
|
0
|
0
|
|
|
|
|
my ($modh, $modfile) = $self->modules_dbm |
112
|
|
|
|
|
|
|
or die("Could not get modules DBM."); |
113
|
|
|
|
|
|
|
|
114
|
0
|
|
|
|
|
|
my @modules; |
115
|
|
|
|
|
|
|
|
116
|
0
|
|
|
|
|
|
my $arch_regex = $args{arch}; |
117
|
0
|
0
|
0
|
|
|
|
$arch_regex = qr/$arch_regex/ |
118
|
|
|
|
|
|
|
if defined $arch_regex and not ref($arch_regex) eq 'Regexp'; |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
# iterate over all modules in the mod_dbm hash |
121
|
0
|
|
|
|
|
|
while (my ($mod_name, $dists) = each(%$modh)) { |
122
|
|
|
|
|
|
|
# skip non-matching |
123
|
0
|
0
|
|
|
|
|
next if $mod_name !~ $regex; |
124
|
|
|
|
|
|
|
|
125
|
0
|
0
|
|
|
|
|
if (defined $arch_regex) { |
126
|
0
|
|
|
|
|
|
while (my ($distname, $version) = each(%$dists)) { |
127
|
0
|
|
|
|
|
|
(undef, undef, my $arch, undef) |
128
|
|
|
|
|
|
|
= PAR::Dist::parse_dist_name($distname); |
129
|
0
|
0
|
|
|
|
|
next if $arch !~ $arch_regex; |
130
|
0
|
|
|
|
|
|
push @modules, [$distname, $version]; |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
else { |
134
|
0
|
|
|
|
|
|
while (my ($distname, $version) = each(%$dists)) { |
135
|
0
|
|
|
|
|
|
push @modules, [$distname, $version]; |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
|
140
|
0
|
|
|
|
|
|
my %seen; |
141
|
|
|
|
|
|
|
# sort return list alphabetically |
142
|
|
|
|
|
|
|
return [ |
143
|
0
|
|
|
|
|
|
map { @$_ } |
|
0
|
|
|
|
|
|
|
144
|
0
|
|
|
|
|
|
sort { $a->[0] cmp $b->[0] } |
145
|
0
|
|
|
|
|
|
grep { not $seen{$_->[0] . '|' . $_->[1]}++ } |
146
|
|
|
|
|
|
|
@modules |
147
|
|
|
|
|
|
|
]; |
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
=head2 query_script |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
Note: Usually, you probably want to use C |
153
|
|
|
|
|
|
|
instead. The usage of both methods is very similar (and described |
154
|
|
|
|
|
|
|
right below), but the data structure returned differes somewhat. |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
Polls the repository for scripts matching certain criteria. |
157
|
|
|
|
|
|
|
Takes named arguments. Either a C or a C parameter |
158
|
|
|
|
|
|
|
must be present but not both. |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
Returns a reference to an array containing alternating distribution |
161
|
|
|
|
|
|
|
file names and script versions. This method returns the following |
162
|
|
|
|
|
|
|
structure |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
[ 'Foo-Bar-0.01-any_arch-5.8.7.par', '0.01', ... ] |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
that means the script was found in the distribution |
167
|
|
|
|
|
|
|
F and the copy in that file has version |
168
|
|
|
|
|
|
|
0.01. |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
Parameters: |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
=over 2 |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
=item B |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
The name of the script to look for. This is used for an exact match. |
177
|
|
|
|
|
|
|
If you want to find C in C, use the C parameter. |
178
|
|
|
|
|
|
|
Only one of C and C may be specified. |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
=item B |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
Same as C, but interpreted as a regular expression. |
183
|
|
|
|
|
|
|
Only one of C and C may be specified. |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
=item B |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
Can be used to reduce the number of matches to a specific architecture. |
188
|
|
|
|
|
|
|
Always interpreted as a regular expression. |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
=back |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
=cut |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
# FIXME: factor out common code from query_script and query_module! |
195
|
|
|
|
|
|
|
sub query_script { |
196
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
197
|
|
|
|
|
|
|
# $self->verbose(2, "Entering query_script()"); |
198
|
|
|
|
|
|
|
|
199
|
0
|
|
|
|
|
|
my $scripts = $self->query_script_hash(@_); |
200
|
|
|
|
|
|
|
|
201
|
0
|
|
|
|
|
|
my %seen; |
202
|
|
|
|
|
|
|
# sort return list alphabetically |
203
|
|
|
|
|
|
|
return [ |
204
|
0
|
|
|
|
|
|
map { @$_ } |
|
0
|
|
|
|
|
|
|
205
|
0
|
|
|
|
|
|
sort { $a->[0] cmp $b->[0] } |
206
|
0
|
|
|
|
|
|
grep { not $seen{$_->[0] . '|' . $_->[1]}++ } |
207
|
|
|
|
|
|
|
map { |
208
|
0
|
|
|
|
|
|
my $scripthash = $scripts->{$_}; |
209
|
0
|
|
|
|
|
|
map { [$_, $scripthash->{$_}] } keys %$scripthash; |
|
0
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
keys %$scripts |
212
|
|
|
|
|
|
|
]; |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
=head2 query_script_hash |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
Works exactly the same as C except it returns |
219
|
|
|
|
|
|
|
a different resulting structure which includes the matching |
220
|
|
|
|
|
|
|
script's name: |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
{ 'fooscript' => { 'Foo-Bar-0.01-any_arch-5.8.7.par' => '0.01', ... }, ... } |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
that means the script C was found in the distribution |
225
|
|
|
|
|
|
|
F and the copy in that file has version |
226
|
|
|
|
|
|
|
0.01. |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
Parameters are the same as for C |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
=cut |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
# FIXME: factor out common code from query_script_hash and query_module! |
233
|
|
|
|
|
|
|
sub query_script_hash { |
234
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
235
|
|
|
|
|
|
|
# $self->verbose(2, "Entering query_script_hash()"); |
236
|
0
|
0
|
|
|
|
|
croak("query_script() or query_script_hash() called with uneven number of arguments.") |
237
|
|
|
|
|
|
|
if @_ % 2; |
238
|
0
|
|
|
|
|
|
my %args = @_; |
239
|
|
|
|
|
|
|
|
240
|
0
|
|
|
|
|
|
my $name = $args{name}; |
241
|
0
|
|
|
|
|
|
my $regex = $args{regex}; |
242
|
|
|
|
|
|
|
|
243
|
0
|
0
|
0
|
|
|
|
if (defined $name and defined $regex) { |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
244
|
0
|
|
|
|
|
|
croak("query_script() or query_script_hash() accepts only one of 'name' and 'regex' parameters."); |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
elsif (not defined $name and not defined $regex) { |
247
|
0
|
|
|
|
|
|
croak("query_script() or query_script_hash() needs one of 'name' and 'regex' parameters."); |
248
|
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
|
elsif (defined $name) { |
250
|
0
|
|
|
|
|
|
$regex = qr/^\Q$name\E$/; |
251
|
|
|
|
|
|
|
} |
252
|
|
|
|
|
|
|
else { # regex defined |
253
|
0
|
0
|
|
|
|
|
$regex = qr/$regex/ if not ref($regex) eq 'Regexp'; |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
|
256
|
0
|
0
|
|
|
|
|
my ($scrh, $scrfile) = $self->scripts_dbm |
257
|
|
|
|
|
|
|
or die("Could not get scripts DBM."); |
258
|
|
|
|
|
|
|
|
259
|
0
|
|
|
|
|
|
my %scripts; |
260
|
|
|
|
|
|
|
|
261
|
0
|
|
|
|
|
|
my $arch_regex = $args{arch}; |
262
|
0
|
0
|
0
|
|
|
|
$arch_regex = qr/$arch_regex/ |
263
|
|
|
|
|
|
|
if defined $arch_regex and not ref($arch_regex) eq 'Regexp'; |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
# iterate over all scripts in the scripts hash |
266
|
0
|
|
|
|
|
|
while (my ($scr_name, $dists) = each(%$scrh)) { |
267
|
|
|
|
|
|
|
# skip non-matching |
268
|
0
|
0
|
|
|
|
|
next if $scr_name !~ $regex; |
269
|
|
|
|
|
|
|
|
270
|
0
|
|
|
|
|
|
while (my ($distname, $version) = each(%$dists)) { |
271
|
0
|
0
|
|
|
|
|
if (defined $arch_regex) { |
272
|
0
|
|
|
|
|
|
(undef, undef, my $arch, undef) |
273
|
|
|
|
|
|
|
= PAR::Dist::parse_dist_name($distname); |
274
|
0
|
0
|
|
|
|
|
next if $arch !~ $arch_regex; |
275
|
|
|
|
|
|
|
} |
276
|
0
|
0
|
|
|
|
|
$scripts{$scr_name} = {} if not exists $scripts{$scr_name}; |
277
|
0
|
|
|
|
|
|
$scripts{$scr_name}{$distname} = $version; # distname => version |
278
|
|
|
|
|
|
|
} |
279
|
|
|
|
|
|
|
} |
280
|
|
|
|
|
|
|
|
281
|
0
|
|
|
|
|
|
return \%scripts; |
282
|
|
|
|
|
|
|
} |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
=head2 query_dist |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
Polls the repository for distributions matching certain criteria. |
289
|
|
|
|
|
|
|
Takes named arguments. Either a C or a C parameter |
290
|
|
|
|
|
|
|
must be present but not both. |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
Returns a reference to an array containing alternating distribution |
293
|
|
|
|
|
|
|
file names and hash references. The hashes contain module names |
294
|
|
|
|
|
|
|
and associated versions in the distribution. |
295
|
|
|
|
|
|
|
This method returns the following structure |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
[ |
298
|
|
|
|
|
|
|
'Foo-Bar-0.01-any_arch-5.8.7.par', |
299
|
|
|
|
|
|
|
{Foo::Bar => '0.01', Foo::Bar::Baz => '0.02'}, |
300
|
|
|
|
|
|
|
... |
301
|
|
|
|
|
|
|
] |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
that means the distribution F matched and |
304
|
|
|
|
|
|
|
that distribution contains the modules C and C |
305
|
|
|
|
|
|
|
with versions 0.01 and 0.02 respectively. |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
Parameters: |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
=over 2 |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
=item B |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
The name of the distribution to look for. This is used for an exact match. |
314
|
|
|
|
|
|
|
If you want to find C in C, |
315
|
|
|
|
|
|
|
use the C parameter. |
316
|
|
|
|
|
|
|
Only one of C and C may be specified. |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
=item B |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
Same as C, but interpreted as a regular expression. |
321
|
|
|
|
|
|
|
Only one of C and C may be specified. |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
=item B |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
Can be used to reduce the number of matches to a specific architecture. |
326
|
|
|
|
|
|
|
Always interpreted as a regular expression. |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
=back |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
=cut |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
sub query_dist { |
333
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
334
|
|
|
|
|
|
|
# $self->verbose(2, "Entering query_dist()"); |
335
|
0
|
0
|
|
|
|
|
croak("query_dist() called with uneven number of arguments.") |
336
|
|
|
|
|
|
|
if @_ % 2; |
337
|
0
|
|
|
|
|
|
my %args = @_; |
338
|
|
|
|
|
|
|
|
339
|
0
|
|
|
|
|
|
my $name = $args{name}; |
340
|
0
|
|
|
|
|
|
my $regex = $args{regex}; |
341
|
|
|
|
|
|
|
|
342
|
0
|
0
|
0
|
|
|
|
if (defined $name and defined $regex) { |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
343
|
0
|
|
|
|
|
|
croak("query_dist() accepts only one of 'name' and 'regex' parameters."); |
344
|
|
|
|
|
|
|
} |
345
|
|
|
|
|
|
|
elsif (not defined $name and not defined $regex) { |
346
|
0
|
|
|
|
|
|
croak("query_dist() needs one of 'name' and 'regex' parameters."); |
347
|
|
|
|
|
|
|
} |
348
|
|
|
|
|
|
|
elsif (defined $name) { |
349
|
0
|
|
|
|
|
|
$regex = qr/^\Q$name\E$/; |
350
|
|
|
|
|
|
|
} |
351
|
|
|
|
|
|
|
else { # regex defined |
352
|
0
|
0
|
|
|
|
|
$regex = qr/$regex/ if not ref($regex) eq 'Regexp'; |
353
|
|
|
|
|
|
|
} |
354
|
|
|
|
|
|
|
|
355
|
0
|
0
|
|
|
|
|
my ($modh, $modfile) = $self->modules_dbm |
356
|
|
|
|
|
|
|
or die("Could not get modules DBM."); |
357
|
|
|
|
|
|
|
|
358
|
0
|
|
|
|
|
|
my %dists; |
359
|
|
|
|
|
|
|
|
360
|
0
|
|
|
|
|
|
my $arch_regex = $args{arch}; |
361
|
0
|
0
|
0
|
|
|
|
$arch_regex = qr/$arch_regex/ |
362
|
|
|
|
|
|
|
if defined $arch_regex and not ref($arch_regex) eq 'Regexp'; |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
# iterate over all modules in the mod_dbm hash |
365
|
0
|
|
|
|
|
|
while (my ($mod_name, $this_dists) = each(%$modh)) { |
366
|
|
|
|
|
|
|
# get the distributions for the module |
367
|
0
|
|
|
|
|
|
my $this_dists = $modh->{$mod_name}; |
368
|
|
|
|
|
|
|
|
369
|
0
|
|
|
|
|
|
while (my ($dist_name, $dist) = each(%$this_dists)) { |
370
|
|
|
|
|
|
|
# skip non-matching |
371
|
0
|
0
|
|
|
|
|
next if $dist_name !~ $regex; |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
# skip non-matching archs |
374
|
0
|
0
|
|
|
|
|
if (defined $arch_regex) { |
375
|
0
|
|
|
|
|
|
(undef, undef, my $arch, undef) |
376
|
|
|
|
|
|
|
= PAR::Dist::parse_dist_name($dist_name); |
377
|
0
|
0
|
|
|
|
|
next if $arch !~ $arch_regex; |
378
|
|
|
|
|
|
|
} |
379
|
|
|
|
|
|
|
|
380
|
0
|
|
|
|
|
|
$dists{$dist_name}{$mod_name} = $dist; |
381
|
|
|
|
|
|
|
} |
382
|
|
|
|
|
|
|
} |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
# sort return list alphabetically |
385
|
|
|
|
|
|
|
return [ |
386
|
0
|
|
|
|
|
|
map { @$_ } |
|
0
|
|
|
|
|
|
|
387
|
0
|
|
|
|
|
|
sort { $a->[0] cmp $b->[0] } |
388
|
0
|
|
|
|
|
|
map { [$_, $dists{$_}] } |
389
|
|
|
|
|
|
|
keys %dists |
390
|
|
|
|
|
|
|
]; |
391
|
|
|
|
|
|
|
} |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
1; |
396
|
|
|
|
|
|
|
__END__ |