line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Algorithm::Dependency::Weight; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
=pod |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=head1 NAME |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
Algorithm::Dependency::Weight - Calculate dependency 'weights' |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=head1 SYNOPSIS |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
# Create a source from a file |
12
|
|
|
|
|
|
|
my $Source = Algorithm::Dependency::Source->new( 'file.txt' ); |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
# Create a Weight algorithm object |
15
|
|
|
|
|
|
|
my $alg = Algorithm::Dependency::Weight->new( source => $Source ); |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
# Find the weight for a single item |
18
|
|
|
|
|
|
|
my $weight = $alg->weight('foo'); |
19
|
|
|
|
|
|
|
print "The weight of 'foo' is $weight\n"; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
# Or a group |
22
|
|
|
|
|
|
|
my $hash = $alg->weight_hash('foo', 'bar', 'baz'); |
23
|
|
|
|
|
|
|
print "The weight of 'foo', 'bar', and 'bar' are $hash->{foo}," |
24
|
|
|
|
|
|
|
. " $hash->{bar} and $hash->{baz} respectively\n"; |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
# Or all of the items |
27
|
|
|
|
|
|
|
my $all = $alg->weight_all; |
28
|
|
|
|
|
|
|
print "The following is a list from heaviest to lightest:\n"; |
29
|
|
|
|
|
|
|
foreach ( sort { $all->{$b} <=> $all->{$a} } keys %$all ) { |
30
|
|
|
|
|
|
|
print "$_: $all->{$_}\n"; |
31
|
|
|
|
|
|
|
} |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
=head1 DESCRIPTION |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
In dependency systems, it can often be very useful to calculate |
36
|
|
|
|
|
|
|
an aggregate or sum for one or all items. For example, to find |
37
|
|
|
|
|
|
|
the "naive install weight" of a Perl distribution (where "naive" |
38
|
|
|
|
|
|
|
means you treat each distribution equally), you would want the |
39
|
|
|
|
|
|
|
distribtion (1) + all its dependencies (n) + all B |
40
|
|
|
|
|
|
|
dependencies (n2) recursively downwards. |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
If calculated using a normal L object, the |
43
|
|
|
|
|
|
|
result would be (in a simple systems) equal to: |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
# Create your normal (non-ordered alg:dep) |
46
|
|
|
|
|
|
|
my $dependency = Algorithm::Dependency->new( ... ); |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
# Find the naive weight for an item |
49
|
|
|
|
|
|
|
my $weight = scalar($dependency->schedule('itemname')); |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
C provides a way of doing this |
52
|
|
|
|
|
|
|
with a little more sophistication, and in a way that should work |
53
|
|
|
|
|
|
|
reasonable well across all the L family. |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
Please note that the this might be a little (or more than a little) |
56
|
|
|
|
|
|
|
slower than it could be for the limited case of generating weights |
57
|
|
|
|
|
|
|
for all of the items at once in a dependency system with no selected |
58
|
|
|
|
|
|
|
items and no circular dependencies. BUT you can at least rely on |
59
|
|
|
|
|
|
|
this class to do the job properly regardless of the particulars of |
60
|
|
|
|
|
|
|
the situation, which is probably more important. |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
=head2 METHODS |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
=cut |
65
|
|
|
|
|
|
|
|
66
|
2
|
|
|
2
|
|
32857
|
use 5.005; |
|
2
|
|
|
|
|
7
|
|
|
2
|
|
|
|
|
78
|
|
67
|
2
|
|
|
2
|
|
10
|
use strict; |
|
2
|
|
|
|
|
20
|
|
|
2
|
|
|
|
|
57
|
|
68
|
2
|
|
|
2
|
|
11
|
use List::Util (); |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
28
|
|
69
|
2
|
|
|
2
|
|
621
|
use Algorithm::Dependency (); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
47
|
|
70
|
2
|
|
|
2
|
|
11
|
use Params::Util qw{_INSTANCE _STRING}; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
113
|
|
71
|
|
|
|
|
|
|
|
72
|
2
|
|
|
2
|
|
9
|
use vars qw{$VERSION}; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
80
|
|
73
|
|
|
|
|
|
|
BEGIN { |
74
|
2
|
|
|
2
|
|
1174
|
$VERSION = '1.110'; |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
##################################################################### |
82
|
|
|
|
|
|
|
# Constructor and Accessors |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=pod |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
=head2 new @params |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
The C constructor creates a new C |
89
|
|
|
|
|
|
|
object. It takes a number of key/value pairs as parameters (although |
90
|
|
|
|
|
|
|
at the present time only one). |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
=over 4 |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
=item source => $Source |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
The C param is mostly the same as for L. |
97
|
|
|
|
|
|
|
The one addition is that as a source you can provide an |
98
|
|
|
|
|
|
|
L object, and the L |
99
|
|
|
|
|
|
|
for that will be used. |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
=back |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
Returns a new C object, or C on error. |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
=cut |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
sub new { |
108
|
3
|
|
|
3
|
1
|
6
|
my $class = shift; |
109
|
3
|
|
|
|
|
8
|
my %args = @_; |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
# Get the source object, or derive it from an existing alg-dep |
112
|
3
|
50
|
|
|
|
46
|
my $source = _INSTANCE($args{source}, 'Algorithm::Dependency') |
|
|
50
|
|
|
|
|
|
113
|
|
|
|
|
|
|
? $args{source}->source |
114
|
|
|
|
|
|
|
: _INSTANCE($args{source}, 'Algorithm::Dependency::Source') |
115
|
|
|
|
|
|
|
or return undef; |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
# Build the alg-dep object we use |
118
|
3
|
50
|
|
|
|
16
|
my $algdep = Algorithm::Dependency->new( |
119
|
|
|
|
|
|
|
source => $source, |
120
|
|
|
|
|
|
|
ignore_orphans => 1, |
121
|
|
|
|
|
|
|
) or return undef; |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
# Create the basic object |
124
|
3
|
|
|
|
|
15
|
my $self = bless { |
125
|
|
|
|
|
|
|
source => $source, |
126
|
|
|
|
|
|
|
algdep => $algdep, |
127
|
|
|
|
|
|
|
weight => {}, |
128
|
|
|
|
|
|
|
}, $class; |
129
|
|
|
|
|
|
|
|
130
|
3
|
|
|
|
|
10
|
$self; |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
=pod |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
=head2 source |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
The C accessor returns the source used for the weight calculations. |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
This will be either the one passed to the constructor, or the source from |
140
|
|
|
|
|
|
|
inside the C object passed as the C param |
141
|
|
|
|
|
|
|
(B the object itself, B source). |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
=cut |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
sub source { |
146
|
4
|
|
|
4
|
1
|
1433
|
$_[0]->{source} |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
##################################################################### |
154
|
|
|
|
|
|
|
# Algorithm::Dependency::Weight Methods |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
=pod |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
=head2 weight $name |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
The C method takes the name of a single item and calculates its |
161
|
|
|
|
|
|
|
weight based on the configuration of the C |
162
|
|
|
|
|
|
|
object. |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
Returns the weight as a scalar (which in the naive case will be an |
165
|
|
|
|
|
|
|
integer, but in more complex uses may be any real number), or C |
166
|
|
|
|
|
|
|
on error. |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
=cut |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
sub weight { |
171
|
34
|
|
|
34
|
1
|
15809
|
my $self = shift; |
172
|
34
|
50
|
|
|
|
122
|
my $id = defined(_STRING($_[0])) ? shift : return undef; |
173
|
34
|
50
|
|
|
|
130
|
$self->{weight}->{$id} or |
174
|
|
|
|
|
|
|
$self->{weight}->{$id} = $self->_weight($id); |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
sub _weight { |
178
|
34
|
|
|
34
|
|
34
|
my $self = shift; |
179
|
34
|
50
|
|
|
|
110
|
my $items = $self->{algdep}->schedule($_[0]) or return undef; |
180
|
34
|
|
|
|
|
266
|
scalar(@$items); |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=pod |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
=head2 weight_merged @names |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
The C method takes the name of a set of items and |
188
|
|
|
|
|
|
|
calculates an aggregated weight for the whole set. |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
Returns the weight as a scalar, or C on error. |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
=cut |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
sub weight_merged { |
195
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
196
|
0
|
0
|
|
|
|
0
|
my $items = $self->{algdep}->schedule(@_) or return undef; |
197
|
0
|
|
|
|
|
0
|
scalar(@$items); |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
=pod |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
=head2 weight_hash @names |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
The C method takes a list of item names, and calculates |
205
|
|
|
|
|
|
|
their weights. |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
Returns a reference to a C with the item names as keys and weights |
208
|
|
|
|
|
|
|
as values, or C on error. |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
=cut |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
sub weight_hash { |
213
|
2
|
|
|
2
|
1
|
2
|
my $self = shift; |
214
|
2
|
|
|
|
|
5
|
my @names = @_; |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
# Iterate over the list |
217
|
2
|
|
|
|
|
3
|
my %hash = (); |
218
|
2
|
|
|
|
|
5
|
foreach my $name ( @names ) { |
219
|
10
|
50
|
|
|
|
20
|
if ( $self->{weight}->{$name} ) { |
220
|
10
|
|
|
|
|
14
|
$hash{$name} = $self->{weight}->{$name}; |
221
|
10
|
|
|
|
|
12
|
next; |
222
|
|
|
|
|
|
|
} |
223
|
0
|
0
|
|
|
|
0
|
$hash{$name} = $self->weight($name) or return undef; |
224
|
|
|
|
|
|
|
} |
225
|
|
|
|
|
|
|
|
226
|
2
|
|
|
|
|
11
|
\%hash; |
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
=pod |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
=head2 weight_all |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
The C method provides the one-shot method for getting the |
234
|
|
|
|
|
|
|
weights of all items at once. Please note that this does not do |
235
|
|
|
|
|
|
|
anything different or special, but is slightly faster than iterating |
236
|
|
|
|
|
|
|
yourself. |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
Returns a reference to a C with the item names as keys and weights |
239
|
|
|
|
|
|
|
as values, or C on error. |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
=cut |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
sub weight_all { |
244
|
1
|
|
|
1
|
1
|
391
|
my $self = shift; |
245
|
1
|
|
|
|
|
3
|
my @items = $self->source->items; |
246
|
1
|
50
|
|
|
|
2
|
defined $items[0] or return undef; |
247
|
1
|
|
|
|
|
2
|
$self->weight_hash( map { $_->id } @items ); |
|
6
|
|
|
|
|
42
|
|
248
|
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
1; |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
=pod |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
=head1 TO DO |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
- Add support for non-naive weights via either custom code or method name |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
=head1 SUPPORT |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
Bugs should be submitted via the CPAN bug tracker, located at |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
L |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
For general comments, contact the author. |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
=head1 AUTHOR |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
Adam Kennedy Eadamk@cpan.orgE |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
=head1 SEE ALSO |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
L, L |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
=head1 COPYRIGHT |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
Copyright 2003 - 2009 Adam Kennedy. |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
This program is free software; you can redistribute |
279
|
|
|
|
|
|
|
it and/or modify it under the same terms as Perl itself. |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
The full text of the license can be found in the |
282
|
|
|
|
|
|
|
LICENSE file included with this module. |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
=cut |