File Coverage

blib/lib/Algorithm/Dependency/Weight.pm
Criterion Covered Total %
statement 45 49 91.8
branch 8 20 40.0
condition n/a
subroutine 13 14 92.8
pod 6 6 100.0
total 72 89 80.9


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