| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Algorithm::Dependency::Source; | 
| 2 |  |  |  |  |  |  | # ABSTRACT: Implements a source of hierarchy items | 
| 3 |  |  |  |  |  |  |  | 
| 4 |  |  |  |  |  |  | #pod =pod | 
| 5 |  |  |  |  |  |  | #pod | 
| 6 |  |  |  |  |  |  | #pod =head1 DESCRIPTION | 
| 7 |  |  |  |  |  |  | #pod | 
| 8 |  |  |  |  |  |  | #pod The Algorithm::Dependency::Source class provides an abstract parent class for | 
| 9 |  |  |  |  |  |  | #pod implementing sources for the hierarchy data the algorithm will use. For an | 
| 10 |  |  |  |  |  |  | #pod example of an implementation of this, see | 
| 11 |  |  |  |  |  |  | #pod L, which is bundled with the main | 
| 12 |  |  |  |  |  |  | #pod L package. | 
| 13 |  |  |  |  |  |  | #pod | 
| 14 |  |  |  |  |  |  | #pod =head1 METHODS | 
| 15 |  |  |  |  |  |  | #pod | 
| 16 |  |  |  |  |  |  | #pod =cut | 
| 17 |  |  |  |  |  |  |  | 
| 18 | 8 |  |  | 8 |  | 129 | use 5.005; | 
|  | 8 |  |  |  |  | 29 |  | 
| 19 | 8 |  |  | 8 |  | 50 | use strict; | 
|  | 8 |  |  |  |  | 17 |  | 
|  | 8 |  |  |  |  | 209 |  | 
| 20 | 8 |  |  | 8 |  | 45 | use Algorithm::Dependency (); | 
|  | 8 |  |  |  |  | 16 |  | 
|  | 8 |  |  |  |  | 150 |  | 
| 21 | 8 |  |  | 8 |  | 41 | use Params::Util qw{_SET}; | 
|  | 8 |  |  |  |  | 14 |  | 
|  | 8 |  |  |  |  | 4514 |  | 
| 22 |  |  |  |  |  |  |  | 
| 23 |  |  |  |  |  |  | our $VERSION = '1.111'; | 
| 24 |  |  |  |  |  |  |  | 
| 25 |  |  |  |  |  |  |  | 
| 26 |  |  |  |  |  |  | ##################################################################### | 
| 27 |  |  |  |  |  |  | # Constructor | 
| 28 |  |  |  |  |  |  |  | 
| 29 |  |  |  |  |  |  | #pod =pod | 
| 30 |  |  |  |  |  |  | #pod | 
| 31 |  |  |  |  |  |  | #pod =head2 new @arguments | 
| 32 |  |  |  |  |  |  | #pod | 
| 33 |  |  |  |  |  |  | #pod Although you cannot directly use the C constructor for | 
| 34 |  |  |  |  |  |  | #pod C, it will work the same in all subclasses. | 
| 35 |  |  |  |  |  |  | #pod | 
| 36 |  |  |  |  |  |  | #pod The constructor takes zero or more subclass specific arguments to define the | 
| 37 |  |  |  |  |  |  | #pod location of the source of the items, and returns a new object. Although it | 
| 38 |  |  |  |  |  |  | #pod may check that the arguments you passed are valid, the source will usually | 
| 39 |  |  |  |  |  |  | #pod NOT actually load the items from the source, instead deferring the loading | 
| 40 |  |  |  |  |  |  | #pod until you need to use the items. | 
| 41 |  |  |  |  |  |  | #pod | 
| 42 |  |  |  |  |  |  | #pod Returns a new object on success, or C on error. | 
| 43 |  |  |  |  |  |  | #pod | 
| 44 |  |  |  |  |  |  | #pod =cut | 
| 45 |  |  |  |  |  |  |  | 
| 46 |  |  |  |  |  |  | sub new { | 
| 47 | 10 |  |  | 10 | 1 | 25 | my $class = shift; | 
| 48 |  |  |  |  |  |  |  | 
| 49 |  |  |  |  |  |  | # This can't be created directly, it must be through | 
| 50 |  |  |  |  |  |  | # a SUPER::new call | 
| 51 | 10 | 50 |  |  |  | 36 | if ( $class eq __PACKAGE__ ) { | 
| 52 | 0 |  |  |  |  | 0 | die "Cannot directly instantiate Algorithm::Dependency::Source." | 
| 53 |  |  |  |  |  |  | . " You must use a subclass"; | 
| 54 |  |  |  |  |  |  | } | 
| 55 |  |  |  |  |  |  |  | 
| 56 |  |  |  |  |  |  | # Create the basic object | 
| 57 | 10 |  |  |  |  | 50 | my $self = bless { | 
| 58 |  |  |  |  |  |  | # Has the source been loaded | 
| 59 |  |  |  |  |  |  | loaded      => 0, | 
| 60 |  |  |  |  |  |  |  | 
| 61 |  |  |  |  |  |  | # Indexes | 
| 62 |  |  |  |  |  |  | items_hash  => undef, | 
| 63 |  |  |  |  |  |  | items_array => undef, | 
| 64 |  |  |  |  |  |  | }, $class; | 
| 65 |  |  |  |  |  |  |  | 
| 66 | 10 |  |  |  |  | 57 | $self; | 
| 67 |  |  |  |  |  |  | } | 
| 68 |  |  |  |  |  |  |  | 
| 69 |  |  |  |  |  |  | #pod =pod | 
| 70 |  |  |  |  |  |  | #pod | 
| 71 |  |  |  |  |  |  | #pod =head2 load | 
| 72 |  |  |  |  |  |  | #pod | 
| 73 |  |  |  |  |  |  | #pod The C method is the public method used to actually load the items from | 
| 74 |  |  |  |  |  |  | #pod their storage location into the the source object. The method will | 
| 75 |  |  |  |  |  |  | #pod automatically called, as needed, in most circumstances. You would generally | 
| 76 |  |  |  |  |  |  | #pod only want to use C manually if you think there may be some uncertainty | 
| 77 |  |  |  |  |  |  | #pod that the source will load correctly, and want to check it will work. | 
| 78 |  |  |  |  |  |  | #pod | 
| 79 |  |  |  |  |  |  | #pod Returns true if the items are loaded successfully, or C on error. | 
| 80 |  |  |  |  |  |  | #pod | 
| 81 |  |  |  |  |  |  | #pod =cut | 
| 82 |  |  |  |  |  |  |  | 
| 83 |  |  |  |  |  |  | sub load { | 
| 84 | 10 |  |  | 10 | 1 | 5962 | my $self = shift; | 
| 85 |  |  |  |  |  |  |  | 
| 86 |  |  |  |  |  |  | # If this is a reload, clean up in preperation | 
| 87 | 10 | 50 |  |  |  | 38 | if ( $self->{loaded} ) { | 
| 88 | 0 |  |  |  |  | 0 | $self->{loaded}      = 0; | 
| 89 | 0 |  |  |  |  | 0 | $self->{items_hash}  = undef; | 
| 90 | 0 |  |  |  |  | 0 | $self->{items_array} = undef; | 
| 91 |  |  |  |  |  |  | } | 
| 92 |  |  |  |  |  |  |  | 
| 93 |  |  |  |  |  |  | # Pass through to the real loader | 
| 94 | 10 |  |  |  |  | 42 | my $items = $self->_load_item_list; | 
| 95 | 10 | 50 |  |  |  | 32 | return $items unless $items; | 
| 96 | 10 | 50 |  |  |  | 334 | unless ( _SET($items, 'Algorithm::Dependency::Item') ) { | 
| 97 | 0 |  |  |  |  | 0 | die( ref($self) . "::_load_item_list did not return an Algorithm::Dependency::Item set" ); | 
| 98 |  |  |  |  |  |  | } | 
| 99 |  |  |  |  |  |  |  | 
| 100 |  |  |  |  |  |  | # Add the items | 
| 101 | 10 |  |  |  |  | 474 | foreach my $item ( @$items ) { | 
| 102 |  |  |  |  |  |  | # Have we added this one already? | 
| 103 | 100 |  |  |  |  | 211 | my $id = $item->id; | 
| 104 | 100 | 50 |  |  |  | 233 | if ( $self->{items_hash}->{ $id } ) { | 
| 105 |  |  |  |  |  |  | # Duplicate entry | 
| 106 | 0 |  |  |  |  | 0 | return undef; | 
| 107 |  |  |  |  |  |  | } | 
| 108 |  |  |  |  |  |  |  | 
| 109 |  |  |  |  |  |  | # Add it | 
| 110 | 100 |  |  |  |  | 143 | push @{ $self->{items_array} }, $item; | 
|  | 100 |  |  |  |  | 184 |  | 
| 111 | 100 |  |  |  |  | 228 | $self->{items_hash}->{$id} = $item; | 
| 112 |  |  |  |  |  |  | } | 
| 113 |  |  |  |  |  |  |  | 
| 114 | 10 |  |  |  |  | 55 | $self->{loaded} = 1; | 
| 115 |  |  |  |  |  |  | } | 
| 116 |  |  |  |  |  |  |  | 
| 117 |  |  |  |  |  |  | #pod =pod | 
| 118 |  |  |  |  |  |  | #pod | 
| 119 |  |  |  |  |  |  | #pod =head2 item $name | 
| 120 |  |  |  |  |  |  | #pod | 
| 121 |  |  |  |  |  |  | #pod The C  method fetches and returns the item object specified by the  | 
| 122 |  |  |  |  |  |  | #pod name argument. | 
| 123 |  |  |  |  |  |  | #pod | 
| 124 |  |  |  |  |  |  | #pod Returns an L object on success, or C if | 
| 125 |  |  |  |  |  |  | #pod the named item does not exist in the source. | 
| 126 |  |  |  |  |  |  | #pod | 
| 127 |  |  |  |  |  |  | #pod =cut | 
| 128 |  |  |  |  |  |  |  | 
| 129 |  |  |  |  |  |  | sub item { | 
| 130 | 1037 |  |  | 1037 | 1 | 1622 | my $self = shift; | 
| 131 | 1037 | 50 | 33 |  |  | 4603 | my $id   = (defined $_[0] and ! ref $_[0] and $_[0] ne '') ? shift : return undef; | 
| 132 | 1037 | 50 | 33 |  |  | 2385 | $self->{loaded} or $self->load or return undef; | 
| 133 |  |  |  |  |  |  |  | 
| 134 |  |  |  |  |  |  | # Return the item (or undef) | 
| 135 | 1037 |  |  |  |  | 3106 | $self->{items_hash}->{$id}; | 
| 136 |  |  |  |  |  |  | } | 
| 137 |  |  |  |  |  |  |  | 
| 138 |  |  |  |  |  |  | #pod =pod | 
| 139 |  |  |  |  |  |  | #pod | 
| 140 |  |  |  |  |  |  | #pod =head2 items | 
| 141 |  |  |  |  |  |  | #pod | 
| 142 |  |  |  |  |  |  | #pod The C method returns, as a list of objects, all of the items | 
| 143 |  |  |  |  |  |  | #pod contained in the source. The item objects will be returned in the same order | 
| 144 |  |  |  |  |  |  | #pod as that in the storage location. | 
| 145 |  |  |  |  |  |  | #pod | 
| 146 |  |  |  |  |  |  | #pod Returns a list of L objects on success, or | 
| 147 |  |  |  |  |  |  | #pod C on error. | 
| 148 |  |  |  |  |  |  | #pod | 
| 149 |  |  |  |  |  |  | #pod =cut | 
| 150 |  |  |  |  |  |  |  | 
| 151 |  |  |  |  |  |  | sub items { | 
| 152 | 14 |  |  | 14 | 1 | 8245 | my $self = shift; | 
| 153 | 14 | 50 | 66 |  |  | 391 | $self->{loaded} or $self->load or return undef; | 
| 154 | 14 |  |  |  |  | 26 | @{ $self->{items_array} }; | 
|  | 14 |  |  |  |  | 60 |  | 
| 155 |  |  |  |  |  |  | } | 
| 156 |  |  |  |  |  |  |  | 
| 157 |  |  |  |  |  |  | #pod =pod | 
| 158 |  |  |  |  |  |  | #pod | 
| 159 |  |  |  |  |  |  | #pod =head2 missing_dependencies | 
| 160 |  |  |  |  |  |  | #pod | 
| 161 |  |  |  |  |  |  | #pod By default, we are lenient with missing dependencies if the item is never | 
| 162 |  |  |  |  |  |  | #pod used. For systems where having a missing dependency can be very bad, the | 
| 163 |  |  |  |  |  |  | #pod C method checks all Items to make sure their | 
| 164 |  |  |  |  |  |  | #pod dependencies exist. | 
| 165 |  |  |  |  |  |  | #pod | 
| 166 |  |  |  |  |  |  | #pod If there are any missing dependencies, returns a reference to an array of | 
| 167 |  |  |  |  |  |  | #pod their ids. If there are no missing dependencies, returns 0. Returns | 
| 168 |  |  |  |  |  |  | #pod C on error. | 
| 169 |  |  |  |  |  |  | #pod | 
| 170 |  |  |  |  |  |  | #pod =cut | 
| 171 |  |  |  |  |  |  |  | 
| 172 |  |  |  |  |  |  | sub missing_dependencies { | 
| 173 | 5 |  |  | 5 | 1 | 2909 | my $self = shift; | 
| 174 | 5 | 50 | 66 |  |  | 29 | $self->{loaded} or $self->load or return undef; | 
| 175 |  |  |  |  |  |  |  | 
| 176 |  |  |  |  |  |  | # Merged the depends of all the items, and see if | 
| 177 |  |  |  |  |  |  | # any are missing. | 
| 178 | 4 |  |  |  |  | 12 | my %missing = map  { $_ => 1           } | 
| 179 | 34 |  |  |  |  | 74 | grep { ! $self->item($_) } | 
| 180 | 5 |  |  |  |  | 39 | map  { $_->depends       } | 
|  | 40 |  |  |  |  | 90 |  | 
| 181 |  |  |  |  |  |  | $self->items; | 
| 182 | 5 | 100 |  |  |  | 46 | %missing ? [ sort keys %missing ] : 0; | 
| 183 |  |  |  |  |  |  | } | 
| 184 |  |  |  |  |  |  |  | 
| 185 |  |  |  |  |  |  |  | 
| 186 |  |  |  |  |  |  |  | 
| 187 |  |  |  |  |  |  |  | 
| 188 |  |  |  |  |  |  |  | 
| 189 |  |  |  |  |  |  | ##################################################################### | 
| 190 |  |  |  |  |  |  | # Catch unimplemented methods in subclasses | 
| 191 |  |  |  |  |  |  |  | 
| 192 |  |  |  |  |  |  | sub _load_item_list { | 
| 193 | 0 |  |  | 0 |  |  | die "Class $_[0] failed to define the method _load_item_list"; | 
| 194 |  |  |  |  |  |  | } | 
| 195 |  |  |  |  |  |  |  | 
| 196 |  |  |  |  |  |  | 1; | 
| 197 |  |  |  |  |  |  |  | 
| 198 |  |  |  |  |  |  | __END__ |