File Coverage

blib/lib/Algorithm/Dependency/Weight.pm
Criterion Covered Total %
statement 42 43 97.7
branch 8 18 44.4
condition n/a
subroutine 12 12 100.0
pod 5 5 100.0
total 67 78 85.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<their>
40             dependencies (n2) recursively downwards.
41            
42             If calculated using a normal L<Algorithm::Dependency> 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<Algorithm::Dependency::Weight> 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<Algorithm::Dependency> 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   27 use strict;
  2         19  
  2         30  
67 2     2   31 use List::Util ();
  2         18  
  2         157  
68 2     2   46 use Algorithm::Dependency ();
  2         19  
  2         20  
69 2     2   33 use Params::Util qw{_INSTANCE _IDENTIFIER};
  2         18  
  2         36  
70              
71 2     2   32 use vars qw{$VERSION};
  2         17  
  2         67  
72             BEGIN {
73 2     2   27 $VERSION = '1.102';
74             }
75              
76              
77              
78              
79              
80             #####################################################################
81             # Constructor and Accessors
82              
83             =pod
84            
85             =head2 new @params
86            
87             The C<new> constructor creates a new C<Algorithm::Dependency::Weight>
88             object. It takes a number of key/value pairs as parameters (although
89             at the present time only one).
90            
91             =over 4
92            
93             =item source => $Source
94            
95             The C<source> param is mostly the same as for L<Algorithm::Dependency>.
96             The one addition is that as a source you can provide an
97             L<Algorithm::Dependency> object, and the L<Algorithm::Dependency::Source>
98             for that will be used.
99            
100             =back
101            
102             Returns a new C<Algorithm::Dependency::Weight> object, or C<undef> on error.
103            
104             =cut
105              
106             sub new {
107 3     3 1 31 my $class = shift;
108 3         34 my %args = @_;
109              
110             # Get the source object, or derive it from an existing alg-dep
111 3 50       42 my $source = _INSTANCE($args{source}, 'Algorithm::Dependency')
    50          
112             ? $args{source}->source
113             : _INSTANCE($args{source}, 'Algorithm::Dependency::Source')
114             or return undef;
115              
116             # Build the alg-dep object we use
117 3 50       158 my $algdep = Algorithm::Dependency->new(
118             source         => $source,
119             ignore_orphans => 1,
120             ) or return undef;
121              
122             # Create the basic object
123 3         174 my $self = bless {
124             source => $source,
125             algdep => $algdep,
126             weight => {},
127             }, $class;
128              
129 3         36 $self;
130             }
131              
132             =pod
133            
134             =head2 source
135            
136             The C<source> accessor returns the source used for the weight calculations.
137            
138             This will be either the one passed to the constructor, or the source from
139             inside the C<Algorithm::Dependency> object passed as the C<source> param
140             (B<not> the object itself, B<its> source).
141            
142             =cut
143              
144 4     4 1 64 sub source { $_[0]->{source} }
145              
146              
147              
148              
149              
150             #####################################################################
151             # Algorithm::Dependency::Weight Methods
152              
153             =pod
154            
155             =head2 weight $name
156            
157             The C<weight> method takes the name of a single item and calculates its
158             weight based on the configuration of the C<Algorithm::Dependency::Weight>
159             object.
160            
161             Returns the weight as a scalar (which in the naive case will be an
162             integer, but in more complex uses may be any real number), or C<undef>
163             on error.
164            
165             =cut
166              
167             sub weight {
168 34     34 1 295 my $self = shift;
169 34 50       445 my $id = _IDENTIFIER(shift) or return undef;
170 34 50       3991 $self->{weight}->{$id} or
171             $self->{weight}->{$id} = $self->_weight($id);
172             }
173              
174             sub _weight {
175 34     34   321 my $self = shift;
176 34 50       476 my $items = $self->{algdep}->schedule($_[0]) or return undef;
177 34         46712 scalar(@$items);
178             }
179              
180             =pod
181            
182             =head2 weight_hash @names
183            
184             The C<weight_hash> method takes a list of item names, and calculates
185             their weights.
186            
187             Returns a reference to a C<HASH> with the item names as keys and weights
188             as values, or C<undef> on error.
189            
190             =cut
191              
192             sub weight_hash {
193 2     2 1 762 my $self = shift;
194 2         44 my @names = @_;
195              
196             # Iterate over the list
197 2         20 my %hash = ();
198 2         60 foreach my $name ( @names ) {
199 10 50       106 if ( $self->{weight}->{$name} ) {
200 10         100 $hash{$name} = $self->{weight}->{$name};
201 10         90 next;
202             }
203 0 0       0 $hash{$name} = $self->weight($name) or return undef;
204             }
205              
206 2         39 \%hash;
207             }
208              
209             =pod
210            
211             =head2 weight_all
212            
213             The C<weight_all> method provides the one-shot method for getting the
214             weights of all items at once. Please note that this does not do
215             anything different or special, but is slightly faster than iterating
216             yourself.
217            
218             Returns a reference to a C<HASH> with the item names as keys and weights
219             as values, or C<undef> on error.
220            
221             =cut
222              
223             sub weight_all {
224 1     1 1 11 my $self = shift;
225 1         13 my @items = $self->source->items;
226 1 50       15 defined $items[0] or return undef;
227 1         10 $self->weight_hash( map { $_->id } @items );
  6         67  
228             }
229              
230             1;
231              
232             =pod
233            
234             =head1 TO DO
235            
236             - Add support for non-naive weights via either custom code or method name
237            
238             =head1 SUPPORT
239            
240             Bugs should be submitted via the CPAN bug tracker, located at
241            
242             L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Algorithm-Dependency>
243            
244             For general comments, contact the author.
245            
246             =head1 AUTHOR
247            
248             Adam Kennedy E<lt>cpan@ali.asE<gt>, L<http://ali.as/>
249            
250             =head1 SEE ALSO
251            
252             L<Algorithm::Dependency>, L<Algorithm::Dependency::Source>
253            
254             =head1 COPYRIGHT
255            
256             Copyright (c) 2003 - 2005 Adam Kennedy. All rights reserved.
257            
258             This program is free software; you can redistribute
259             it and/or modify it under the same terms as Perl itself.
260            
261             The full text of the license can be found in the
262             LICENSE file included with this module.
263            
264             =cut
265