line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Algorithm::Dependency::Ordered; |
2
|
|
|
|
|
|
|
# ABSTRACT: Implements an ordered dependency hierarchy |
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
#pod =pod |
5
|
|
|
|
|
|
|
#pod |
6
|
|
|
|
|
|
|
#pod =head1 DESCRIPTION |
7
|
|
|
|
|
|
|
#pod |
8
|
|
|
|
|
|
|
#pod Algorithm::Dependency::Ordered implements the most common variety of |
9
|
|
|
|
|
|
|
#pod L, the one in which the dependencies of an item must |
10
|
|
|
|
|
|
|
#pod be acted upon before the item itself can be acted upon. |
11
|
|
|
|
|
|
|
#pod |
12
|
|
|
|
|
|
|
#pod In use and semantics, this should be used in exactly the same way as for the |
13
|
|
|
|
|
|
|
#pod main parent class. Please note that the output of the C method is |
14
|
|
|
|
|
|
|
#pod NOT changed, as the order of the depends is not assumed to be important. |
15
|
|
|
|
|
|
|
#pod Only the output of the C method is modified to ensure the correct |
16
|
|
|
|
|
|
|
#pod order. |
17
|
|
|
|
|
|
|
#pod |
18
|
|
|
|
|
|
|
#pod For API details, see L. |
19
|
|
|
|
|
|
|
#pod |
20
|
|
|
|
|
|
|
#pod =cut |
21
|
|
|
|
|
|
|
|
22
|
4
|
|
|
4
|
|
76048
|
use 5.005; |
|
4
|
|
|
|
|
24
|
|
23
|
4
|
|
|
4
|
|
22
|
use strict; |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
84
|
|
24
|
4
|
|
|
4
|
|
542
|
use Algorithm::Dependency (); |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
1332
|
|
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
our $VERSION = '1.112'; |
27
|
|
|
|
|
|
|
our @ISA = 'Algorithm::Dependency'; |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
sub schedule { |
31
|
48
|
|
|
48
|
1
|
39416
|
my $self = shift; |
32
|
48
|
|
|
|
|
100
|
my $source = $self->{source}; |
33
|
48
|
50
|
|
|
|
152
|
my @items = @_ or return undef; |
34
|
48
|
50
|
|
|
|
165
|
return undef if grep { ! $source->item($_) } @items; |
|
48
|
|
|
|
|
140
|
|
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
# The actual items to select will be the same as for the unordered |
37
|
|
|
|
|
|
|
# version, so we can simplify the algorithm greatly by using the |
38
|
|
|
|
|
|
|
# normal unordered ->schedule method to get the starting list. |
39
|
48
|
|
|
|
|
138
|
my $rv = $self->SUPER::schedule( @items ); |
40
|
48
|
100
|
|
|
|
148
|
my @queue = $rv ? @$rv : return undef; |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
# Get a working copy of the selected index |
43
|
47
|
|
|
|
|
65
|
my %selected = %{ $self->{selected} }; |
|
47
|
|
|
|
|
139
|
|
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
# If at any time we check every item in the stack without finding |
46
|
|
|
|
|
|
|
# a suitable candidate for addition to the schedule, we have found |
47
|
|
|
|
|
|
|
# a circular reference error. We need to create a marker to track this. |
48
|
47
|
|
|
|
|
91
|
my $error_marker = ''; |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
# Begin the processing loop |
51
|
47
|
|
|
|
|
69
|
my @schedule = (); |
52
|
47
|
|
|
|
|
117
|
while ( my $id = shift @queue ) { |
53
|
|
|
|
|
|
|
# Have we checked every item in the stack? |
54
|
135
|
50
|
|
|
|
285
|
return undef if $id eq $error_marker; |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
# Are there any un-met dependencies |
57
|
135
|
50
|
|
|
|
289
|
my $Item = $self->{source}->item($id) or return undef; |
58
|
135
|
|
|
|
|
289
|
my @missing = grep { ! $selected{$_} } $Item->depends; |
|
151
|
|
|
|
|
357
|
|
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
# Remove orphans if we are ignoring them |
61
|
135
|
100
|
|
|
|
284
|
if ( $self->{ignore_orphans} ) { |
62
|
1
|
|
|
|
|
2
|
@missing = grep { $self->{source}->item($_) } @missing; |
|
1
|
|
|
|
|
3
|
|
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
135
|
100
|
|
|
|
269
|
if ( @missing ) { |
66
|
|
|
|
|
|
|
# Set the error marker if not already |
67
|
41
|
100
|
|
|
|
88
|
$error_marker = $id unless $error_marker; |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
# Add the id back to the end of the queue |
70
|
41
|
|
|
|
|
73
|
push @queue, $id; |
71
|
41
|
|
|
|
|
104
|
next; |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
# All dependencies have been met. Add the item to the schedule and |
75
|
|
|
|
|
|
|
# to the selected index, and clear the error marker. |
76
|
94
|
|
|
|
|
186
|
push @schedule, $id; |
77
|
94
|
|
|
|
|
149
|
$selected{$id} = 1; |
78
|
94
|
|
|
|
|
239
|
$error_marker = ''; |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
# All items have been added |
82
|
47
|
|
|
|
|
179
|
\@schedule; |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
1; |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
__END__ |