File Coverage

blib/lib/Algorithm/Dependency/Ordered.pm
Criterion Covered Total %
statement 40 40 100.0
branch 12 16 75.0
condition n/a
subroutine 6 6 100.0
pod 1 1 100.0
total 59 63 93.7


line stmt bran cond sub pod time code
1             package Algorithm::Dependency::Ordered;
2              
3             =pod
4            
5             =head1 NAME
6            
7             Algorithm::Dependency::Ordered - Implements an ordered dependency heirachy
8            
9             =head1 DESCRIPTION
10            
11             Algorithm::Dependency::Ordered implements the most common variety of
12             L<Algorithm::Dependency>, the one in which the dependencies of an item must
13             be acted upon before the item itself can be acted upon.
14            
15             In use and semantics, this should be used in exactly the same way as for the
16             main parent class. Please note that the output of the C<depends> method is
17             NOT changed, as the order of the depends is not assumed to be important.
18             Only the output of the C<schedule> method is modified to ensure the correct
19             order.
20            
21             For API details, see L<Algorithm::Dependency>.
22            
23             =cut
24              
25 4     4   135 use 5.005;
  4         65  
  4         39  
26 4     4   62 use strict;
  4         36  
  4         127  
27 4     4   87 use base 'Algorithm::Dependency';
  4         38  
  4         76  
28              
29 4     4   63 use vars qw{$VERSION};
  4         46  
  4         56  
30             BEGIN {
31 4     4   126 $VERSION = '1.102';
32             }
33              
34              
35              
36              
37              
38             sub schedule {
39 48     48 1 459 my $self = shift;
40 48         467 my $source = $self->{source};
41 48 50       538 my @items = @_ or return undef;
42 48 50       442 return undef if grep { ! $source->item($_) } @items;
  48         604  
43              
44             # The actual items to select will be the same as for the unordered
45             # version, so we can simplify the algorithm greatly by using the
46             # normal unordered ->schedule method to get the starting list.
47 48         1157 my $rv = $self->SUPER::schedule( @items );
48 48 100       604 my @queue = $rv ? @$rv : return undef;
49              
50             # Get a working copy of the selected index
51 47         439 my %selected = %{ $self->{selected} };
  47         649  
52              
53             # If at any time we check every item in the stack without finding
54             # a suitable candidate for addition to the schedule, we have found
55             # a circular reference error. We need to create a marker to track this.
56 47         459 my $error_marker = '';
57              
58             # Begin the processing loop
59 47         442 my @schedule = ();
60 47         587 while ( my $id = shift @queue ) {
61             # Have we checked every item in the stack?
62 135 50       1367 return undef if $id eq $error_marker;
63              
64             # Are there any un-met dependencies
65 135 50       1985 my $Item = $self->{source}->item($id) or return undef;
66 135         3469 my @missing = grep { ! $selected{$_} } $Item->depends;
  151         1802  
67              
68             # Remove orphans if we are ignoring them
69 135 100       1564 if ( $self->{ignore_orphans} ) {
70 1         10 @missing = grep { $self->{source}->item($_) } @missing;
  1         12  
71             }
72              
73 135 100       1432 if ( @missing ) {
74             # Set the error marker if not already
75 41 100       394 $error_marker = $id unless $error_marker;
76              
77             # Add the id back to the end of the queue
78 41         486 push @queue, $id;
79 41         453 next;
80             }
81              
82             # All dependencies have been met. Add the item to the schedule and
83             # to the selected index, and clear the error marker.
84 94         888 push @schedule, $id;
85 94         11692 $selected{$id} = 1;
86 94         3543 $error_marker  = '';
87             }
88              
89             # All items have been added
90 47         721 \@schedule;
91             }
92              
93             1;
94              
95             =pod
96            
97             =head1 SUPPORT
98            
99             Bugs should be submitted via the CPAN bug tracker, located at
100            
101             L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Algorithm-Dependency>
102            
103             For general comments, contact the author.
104            
105             =head1 AUTHOR
106            
107             Adam Kennedy E<lt>cpan@ali.asE<gt>, L<http://ali.as/>
108            
109             =head1 SEE ALSO
110            
111             L<Algorithm::Dependency>
112            
113             =head1 COPYRIGHT
114            
115             Copyright (c) 2003 - 2005 Adam Kennedy. All rights reserved.
116            
117             This program is free software; you can redistribute
118             it and/or modify it under the same terms as Perl itself.
119            
120             The full text of the license can be found in the
121             LICENSE file included with this module.
122            
123             =cut
124