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