| blib/lib/Anansi/Class.pm | |||
|---|---|---|---|
| Criterion | Covered | Total | % |
| statement | 6 | 77 | 7.7 |
| branch | 0 | 50 | 0.0 |
| condition | n/a | ||
| subroutine | 2 | 11 | 18.1 |
| pod | 8 | 8 | 100.0 |
| total | 16 | 146 | 10.9 |
| line | stmt | bran | cond | sub | pod | time | code |
|---|---|---|---|---|---|---|---|
| 1 | package Anansi::Class; | ||||||
| 2 | |||||||
| 3 | |||||||
| 4 | =head1 NAME | ||||||
| 5 | |||||||
| 6 | Anansi::Class - A base module definition | ||||||
| 7 | |||||||
| 8 | =head1 SYNOPSIS | ||||||
| 9 | |||||||
| 10 | package Anansi::Example; | ||||||
| 11 | |||||||
| 12 | use base qw(Anansi::Class); | ||||||
| 13 | |||||||
| 14 | sub finalise { | ||||||
| 15 | my ($self, %parameters) = @_; | ||||||
| 16 | } | ||||||
| 17 | |||||||
| 18 | sub initialise { | ||||||
| 19 | my ($self, %parameters) = @_; | ||||||
| 20 | } | ||||||
| 21 | |||||||
| 22 | 1; | ||||||
| 23 | |||||||
| 24 | package main; | ||||||
| 25 | |||||||
| 26 | use Anansi::Example; | ||||||
| 27 | |||||||
| 28 | my $object = Anansi::Example->new(); | ||||||
| 29 | |||||||
| 30 | 1; | ||||||
| 31 | |||||||
| 32 | =head1 DESCRIPTION | ||||||
| 33 | |||||||
| 34 | This is a base module definition that manages the creation and destruction of | ||||||
| 35 | module object instances including embedded objects and ensures that destruction | ||||||
| 36 | can only occur when an object is no longer used. Makes use of | ||||||
| 37 | L |
||||||
| 38 | |||||||
| 39 | =cut | ||||||
| 40 | |||||||
| 41 | |||||||
| 42 | our $VERSION = '0.09'; | ||||||
| 43 | |||||||
| 44 | 1 | 1 | 51922 | use Anansi::ObjectManager; | |||
| 1 | 346 | ||||||
| 1 | 1394 | ||||||
| 45 | |||||||
| 46 | |||||||
| 47 | =head1 METHODS | ||||||
| 48 | |||||||
| 49 | =cut | ||||||
| 50 | |||||||
| 51 | |||||||
| 52 | =head2 DESTROY | ||||||
| 53 | |||||||
| 54 | =over 4 | ||||||
| 55 | |||||||
| 56 | =item self I<(Blessed Hash, Required)> | ||||||
| 57 | |||||||
| 58 | An object of this namespace. | ||||||
| 59 | |||||||
| 60 | =back | ||||||
| 61 | |||||||
| 62 | Performs module object instance clean-up actions. Calls the | ||||||
| 63 | L |
||||||
| 64 | Indirectly called by the perl interpreter. | ||||||
| 65 | |||||||
| 66 | =cut | ||||||
| 67 | |||||||
| 68 | |||||||
| 69 | sub DESTROY { | ||||||
| 70 | 0 | 0 | 0 | my ($self) = @_; | |||
| 71 | 0 | 0 | my $objectManager = Anansi::ObjectManager->new(); | ||||
| 72 | 0 | 0 | 0 | if(1 == $objectManager->registrations($self)) { | |||
| 73 | 0 | 0 | $self->finalise(); | ||||
| 74 | 0 | 0 | $objectManager->obsolete( | ||||
| 75 | USER => $self, | ||||||
| 76 | ); | ||||||
| 77 | 0 | 0 | $objectManager->unregister($self); | ||||
| 78 | } | ||||||
| 79 | } | ||||||
| 80 | |||||||
| 81 | |||||||
| 82 | =head2 finalise | ||||||
| 83 | |||||||
| 84 | $OBJECT->finalise(); | ||||||
| 85 | |||||||
| 86 | $OBJECT->SUPER::finalise(); | ||||||
| 87 | |||||||
| 88 | =over 4 | ||||||
| 89 | |||||||
| 90 | =item self I<(Blessed Hash, Required)> | ||||||
| 91 | |||||||
| 92 | An object of this namespace. | ||||||
| 93 | |||||||
| 94 | =back | ||||||
| 95 | |||||||
| 96 | A virtual method. Called just prior to module instance object destruction. | ||||||
| 97 | |||||||
| 98 | =cut | ||||||
| 99 | |||||||
| 100 | |||||||
| 101 | sub finalise { | ||||||
| 102 | 0 | 0 | 1 | 0 | my ($self) = @_; | ||
| 103 | } | ||||||
| 104 | |||||||
| 105 | |||||||
| 106 | =head2 implicate | ||||||
| 107 | |||||||
| 108 | sub implicate { | ||||||
| 109 | my ($self, $caller, $parameter) = @_; | ||||||
| 110 | if('EXAMPLE_VARIABLE' eq $parameter) { | ||||||
| 111 | return \EXAMPLE_VARIABLE; | ||||||
| 112 | } | ||||||
| 113 | try { | ||||||
| 114 | return $self->SUPER::implicate($caller, $parameter); | ||||||
| 115 | } | ||||||
| 116 | return if($@); | ||||||
| 117 | } | ||||||
| 118 | |||||||
| 119 | =over 4 | ||||||
| 120 | |||||||
| 121 | =item self I<(Blessed Hash, Required)> | ||||||
| 122 | |||||||
| 123 | An object of this namespace. | ||||||
| 124 | |||||||
| 125 | =item caller I<(Array, Required)> | ||||||
| 126 | |||||||
| 127 | An array containing the I |
||||||
| 128 | |||||||
| 129 | =item parameter I<(String, Required)> | ||||||
| 130 | |||||||
| 131 | A string containing the name to import. | ||||||
| 132 | |||||||
| 133 | =back | ||||||
| 134 | |||||||
| 135 | A virtual method. Performs one module instance name import. Called for each | ||||||
| 136 | name to import. | ||||||
| 137 | |||||||
| 138 | =cut | ||||||
| 139 | |||||||
| 140 | |||||||
| 141 | sub implicate { | ||||||
| 142 | 0 | 0 | 1 | 0 | my ($self, $caller, $parameter) = @_; | ||
| 143 | 0 | 0 | 0 | try { | |||
| 144 | 0 | 0 | return $self->SUPER::implicate($caller, $parameter); | ||||
| 145 | } | ||||||
| 146 | return if($@); | ||||||
| 147 | } | ||||||
| 148 | |||||||
| 149 | |||||||
| 150 | =head2 import | ||||||
| 151 | |||||||
| 152 | use Anansi::Example qw(EXAMPLE_VARIABLE); | ||||||
| 153 | |||||||
| 154 | =over 4 | ||||||
| 155 | |||||||
| 156 | =item self I<(Blessed Hash, Required)> | ||||||
| 157 | |||||||
| 158 | An object of this namespace. | ||||||
| 159 | |||||||
| 160 | =item parameters I<(Array, Optional)> | ||||||
| 161 | |||||||
| 162 | An array containing all of the names to import. | ||||||
| 163 | |||||||
| 164 | =back | ||||||
| 165 | |||||||
| 166 | Performs all required module name imports. Indirectly called via an extending | ||||||
| 167 | module. | ||||||
| 168 | |||||||
| 169 | =cut | ||||||
| 170 | |||||||
| 171 | |||||||
| 172 | sub import { | ||||||
| 173 | 1 | 1 | 11 | my ($self, @parameters) = @_; | |||
| 174 | 1 | 5 | my $caller = caller(); | ||||
| 175 | 1 | 18 | foreach my $parameter (@parameters) { | ||||
| 176 | 0 | my $value = $self->implicate($caller, $parameter); | |||||
| 177 | 0 | 0 | *{$caller.'::'.$parameter} = $value if(defined($value)); | ||||
| 0 | |||||||
| 178 | } | ||||||
| 179 | } | ||||||
| 180 | |||||||
| 181 | |||||||
| 182 | =head2 initialise | ||||||
| 183 | |||||||
| 184 | $OBJECT->initialise(); | ||||||
| 185 | |||||||
| 186 | $OBJECT->SUPER::initialise(); | ||||||
| 187 | |||||||
| 188 | =over 4 | ||||||
| 189 | |||||||
| 190 | =item self I<(Blessed Hash, Required)> | ||||||
| 191 | |||||||
| 192 | An object of this namespace. | ||||||
| 193 | |||||||
| 194 | =item parameters I<(Hash, Optional)> | ||||||
| 195 | |||||||
| 196 | Named parameters that were supplied to the I |
||||||
| 197 | |||||||
| 198 | =back | ||||||
| 199 | |||||||
| 200 | A virtual method. Called just after module instance object creation. | ||||||
| 201 | |||||||
| 202 | =cut | ||||||
| 203 | |||||||
| 204 | |||||||
| 205 | sub initialise { | ||||||
| 206 | 0 | 0 | 1 | my ($self, %parameters) = @_; | |||
| 207 | } | ||||||
| 208 | |||||||
| 209 | |||||||
| 210 | =head2 new | ||||||
| 211 | |||||||
| 212 | my $object = Anansi::Example->new(); | ||||||
| 213 | |||||||
| 214 | my $object = Anansi::Example->new( | ||||||
| 215 | SETTING => 'example', | ||||||
| 216 | ); | ||||||
| 217 | |||||||
| 218 | =over 4 | ||||||
| 219 | |||||||
| 220 | =item class I<(Blessed Hash B |
||||||
| 221 | |||||||
| 222 | Either an object or a string of this namespace. | ||||||
| 223 | |||||||
| 224 | =item parameters I<(Hash, Optional)> | ||||||
| 225 | |||||||
| 226 | Named parameters. | ||||||
| 227 | |||||||
| 228 | =back | ||||||
| 229 | |||||||
| 230 | Instantiates an object instance of a module. Calls the | ||||||
| 231 | L |
||||||
| 232 | after the object is instantiated. Indirectly called via an extending module | ||||||
| 233 | through inheritance. | ||||||
| 234 | |||||||
| 235 | =cut | ||||||
| 236 | |||||||
| 237 | |||||||
| 238 | sub new { | ||||||
| 239 | 0 | 0 | 1 | my ($class, %parameters) = @_; | |||
| 240 | 0 | 0 | return if(ref($class) =~ /^(ARRAY|CODE|FORMAT|GLOB|HASH|IO|LVALUE|REF|Regexp|SCALAR|VSTRING)$/i); | ||||
| 241 | 0 | 0 | $class = ref($class) if(ref($class) !~ /^$/); | ||||
| 242 | 0 | my $self = { | |||||
| 243 | NAMESPACE => $class, | ||||||
| 244 | PACKAGE => __PACKAGE__, | ||||||
| 245 | }; | ||||||
| 246 | 0 | bless($self, $class); | |||||
| 247 | 0 | my $objectManager = Anansi::ObjectManager->new(); | |||||
| 248 | 0 | $objectManager->register($self); | |||||
| 249 | 0 | $self->initialise(%parameters); | |||||
| 250 | 0 | return $self; | |||||
| 251 | } | ||||||
| 252 | |||||||
| 253 | |||||||
| 254 | =head2 old | ||||||
| 255 | |||||||
| 256 | $object->old(); | ||||||
| 257 | |||||||
| 258 | =over 4 | ||||||
| 259 | |||||||
| 260 | =item self I<(Blessed Hash, Required)> | ||||||
| 261 | |||||||
| 262 | An object of this namespace. | ||||||
| 263 | |||||||
| 264 | =item parameters I<(Hash, Optional)> | ||||||
| 265 | |||||||
| 266 | Named parameters. | ||||||
| 267 | |||||||
| 268 | =back | ||||||
| 269 | |||||||
| 270 | Enables a module instance object to be externally destroyed. | ||||||
| 271 | |||||||
| 272 | =cut | ||||||
| 273 | |||||||
| 274 | |||||||
| 275 | sub old { | ||||||
| 276 | 0 | 0 | 1 | my ($self, %parameters) = @_; | |||
| 277 | 0 | $self->DESTROY(); | |||||
| 278 | } | ||||||
| 279 | |||||||
| 280 | |||||||
| 281 | =head2 used | ||||||
| 282 | |||||||
| 283 | $object->used('EXAMPLE'); | ||||||
| 284 | |||||||
| 285 | =over 4 | ||||||
| 286 | |||||||
| 287 | =item self I<(Blessed Hash, Required)> | ||||||
| 288 | |||||||
| 289 | An object of this namespace. | ||||||
| 290 | |||||||
| 291 | =item parameters I<(Array, Optional)> | ||||||
| 292 | |||||||
| 293 | An array of strings containing the names of blessed objects currently in use by | ||||||
| 294 | this object. | ||||||
| 295 | |||||||
| 296 | =back | ||||||
| 297 | |||||||
| 298 | Releases a module instance object to enable it to be destroyed. | ||||||
| 299 | |||||||
| 300 | =cut | ||||||
| 301 | |||||||
| 302 | |||||||
| 303 | sub used { | ||||||
| 304 | 0 | 0 | 1 | my ($self, @parameters) = @_; | |||
| 305 | 0 | my $objectManager = Anansi::ObjectManager->new(); | |||||
| 306 | 0 | foreach my $key (@parameters) { | |||||
| 307 | 0 | 0 | next if(!defined($self->{$key})); | ||||
| 308 | 0 | 0 | next if(!defined($self->{$key}->{IDENTIFICATION})); | ||||
| 309 | 0 | $objectManager->obsolete( | |||||
| 310 | USER => $self, | ||||||
| 311 | USES => $self->{$key}, | ||||||
| 312 | ); | ||||||
| 313 | 0 | delete $self->{$key}; | |||||
| 314 | } | ||||||
| 315 | } | ||||||
| 316 | |||||||
| 317 | |||||||
| 318 | =head2 uses | ||||||
| 319 | |||||||
| 320 | $object->uses( | ||||||
| 321 | EXAMPLE => $example, | ||||||
| 322 | ); | ||||||
| 323 | |||||||
| 324 | $object->uses( | ||||||
| 325 | EXAMPLE => 'Anansi::Example', | ||||||
| 326 | ); | ||||||
| 327 | $object->{EXAMPLE}->doSomething(); | ||||||
| 328 | |||||||
| 329 | =over 4 | ||||||
| 330 | |||||||
| 331 | =item self I<(Blessed Hash, Required)> | ||||||
| 332 | |||||||
| 333 | An object of this namespace. | ||||||
| 334 | |||||||
| 335 | =item parameters I<(Hash, Optional)> | ||||||
| 336 | |||||||
| 337 | A hash containing keys that represent the name to associate with the string | ||||||
| 338 | namespace or object within the associated values. | ||||||
| 339 | |||||||
| 340 | =back | ||||||
| 341 | |||||||
| 342 | Binds module instance objects to the current object to ensure that the objects | ||||||
| 343 | are not prematurely destroyed. Adds the I |
||||||
| 344 | |||||||
| 345 | =cut | ||||||
| 346 | |||||||
| 347 | |||||||
| 348 | sub uses { | ||||||
| 349 | 0 | 0 | 1 | my ($self, %parameters) = @_; | |||
| 350 | 0 | my $objectManager = Anansi::ObjectManager->new(); | |||||
| 351 | 0 | $objectManager->current( | |||||
| 352 | USER => $self, | ||||||
| 353 | USES => [values %parameters], | ||||||
| 354 | ); | ||||||
| 355 | 0 | while(my ($key, $value) = each(%parameters)) { | |||||
| 356 | 0 | 0 | next if(!defined($value->{IDENTIFICATION})); | ||||
| 357 | 0 | 0 | $self->{$key} = $value if(!defined($self->{KEY})); | ||||
| 358 | } | ||||||
| 359 | } | ||||||
| 360 | |||||||
| 361 | |||||||
| 362 | =head2 using | ||||||
| 363 | |||||||
| 364 | my $names = $object->using(); | ||||||
| 365 | foreach my $name (@{$names}) { | ||||||
| 366 | $object->{$name}->doSomething(); | ||||||
| 367 | } | ||||||
| 368 | |||||||
| 369 | $object->using('EXAMPLE')->doSomething(); | ||||||
| 370 | |||||||
| 371 | if(1 == $object->using( | ||||||
| 372 | 'EXAMPLE', | ||||||
| 373 | 'ANOTHER', | ||||||
| 374 | )); | ||||||
| 375 | |||||||
| 376 | =over 4 | ||||||
| 377 | |||||||
| 378 | =item self I<(Blessed Hash, Required)> | ||||||
| 379 | |||||||
| 380 | An object of this namespace. | ||||||
| 381 | |||||||
| 382 | =item parameters I<(Array B |
||||||
| 383 | |||||||
| 384 | A string or an array of strings containing the names of blessed objects | ||||||
| 385 | currently in use by this object. | ||||||
| 386 | |||||||
| 387 | =back | ||||||
| 388 | |||||||
| 389 | Either returns an array of strings containing the names of the blessed objects | ||||||
| 390 | currently in use by this object or the blessed object represented by the single | ||||||
| 391 | specified name or whether the specified names represent blessed objects with a | ||||||
| 392 | B<1> I<(one)> for yes and B<0> I<(zero)> for no. | ||||||
| 393 | |||||||
| 394 | =cut | ||||||
| 395 | |||||||
| 396 | |||||||
| 397 | sub using { | ||||||
| 398 | 0 | 0 | 1 | my ($self, @parameters) = @_; | |||
| 399 | 0 | 0 | if(0 == scalar(@parameters)) { | ||||
| 0 | |||||||
| 400 | } elsif(1 == scalar(@parameters)) { | ||||||
| 401 | 0 | 0 | return if(ref($parameters[0]) !~ /^$/); | ||||
| 402 | 0 | 0 | return if($parameters[0] =~ /^\s*$/); | ||||
| 403 | } else { | ||||||
| 404 | 0 | foreach my $parameter (@parameters) { | |||||
| 405 | 0 | 0 | return 0 if(ref($parameter) !~ /^$/); | ||||
| 406 | 0 | 0 | return 0 if($parameter =~ /^\s*$/); | ||||
| 407 | } | ||||||
| 408 | } | ||||||
| 409 | 0 | my $objectManager = Anansi::ObjectManager->new(); | |||||
| 410 | 0 | my $uses = $objectManager->user($self); | |||||
| 411 | 0 | 0 | if(defined($uses)) { | ||||
| 0 | |||||||
| 0 | |||||||
| 412 | } elsif(0 == scalar(@parameters)) { | ||||||
| 413 | 0 | return; | |||||
| 414 | } elsif(1 == scalar(@parameters)) { | ||||||
| 415 | 0 | return 0; | |||||
| 416 | } else { | ||||||
| 417 | 0 | return []; | |||||
| 418 | } | ||||||
| 419 | 0 | my %identifiers = map { $objectManager->identification($_) => 1 } (@{$uses}); | |||||
| 0 | |||||||
| 0 | |||||||
| 420 | 0 | my %names; | |||||
| 421 | 0 | foreach my $name (keys(%{$self})) { | |||||
| 0 | |||||||
| 422 | 0 | 0 | next if(ref($self->{$name}) =~ /^(|ARRAY|CODE|FORMAT|GLOB|HASH|IO|LVALUE|REF|Regexp|SCALAR|VSTRING)$/i); | ||||
| 423 | 0 | 0 | next if(!defined(${$self->{$name}}{IDENTIFICATION})); | ||||
| 0 | |||||||
| 424 | 0 | 0 | next if(!defined($identifiers{${$self->{$name}}{IDENTIFICATION}})); | ||||
| 0 | |||||||
| 425 | 0 | $names{$name} = ${$self->{$name}}{IDENTIFICATION}; | |||||
| 0 | |||||||
| 426 | } | ||||||
| 427 | 0 | 0 | if(0 == scalar(@parameters)) { | ||||
| 0 | |||||||
| 428 | 0 | return [(keys(%names))]; | |||||
| 429 | } elsif(1 == scalar(@parameters)) { | ||||||
| 430 | 0 | 0 | return if(!defined($names{$parameters[0]})); | ||||
| 431 | 0 | return $self->{$parameters[0]}; | |||||
| 432 | } | ||||||
| 433 | 0 | foreach my $parameter (@parameters) { | |||||
| 434 | 0 | 0 | return 0 if(!defined($names{$parameter})); | ||||
| 435 | } | ||||||
| 436 | 0 | return 1; | |||||
| 437 | } | ||||||
| 438 | |||||||
| 439 | |||||||
| 440 | =head1 NOTES | ||||||
| 441 | |||||||
| 442 | This module is designed to make it simple, easy and quite fast to code your | ||||||
| 443 | design in perl. If for any reason you feel that it doesn't achieve these goals | ||||||
| 444 | then please let me know. I am here to help. All constructive criticisms are | ||||||
| 445 | also welcomed. | ||||||
| 446 | |||||||
| 447 | =cut | ||||||
| 448 | |||||||
| 449 | |||||||
| 450 | =head1 AUTHOR | ||||||
| 451 | |||||||
| 452 | Kevin Treleaven |
||||||
| 453 | |||||||
| 454 | =cut | ||||||
| 455 | |||||||
| 456 | |||||||
| 457 | 1; |