File Coverage

blib/lib/Anansi/Class.pm
Criterion Covered Total %
statement 6 120 5.0
branch 0 84 0.0
condition n/a
subroutine 2 13 15.3
pod 10 10 100.0
total 18 227 7.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.10';
43              
44 1     1   75064 use Anansi::ObjectManager;
  1         186  
  1         1498  
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 method prior to dereferencing the object.
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 identification
107              
108             =over 4
109              
110             =item self I<(Blessed Hash, Required)>
111              
112             An object of this namespace.
113              
114             =back
115              
116             Returns this object's unique identification or B on error.
117              
118             =cut
119              
120              
121             sub identification {
122 0     0 1 0 my ($self) = @_;
123 0 0       0 return if(ref($self) =~ /^(|ARRAY|CODE|FORMAT|GLOB|HASH|IO|LVALUE|REF|Regexp|SCALAR|VSTRING)$/i);
124 0         0 my $result;
125 0         0 eval {
126 0         0 $result = $self->isa('Anansi::Class');
127             };
128 0 0       0 return if($@);
129 0 0       0 return if(!$result);
130 0 0       0 return if(!defined($self->{Anansi}));
131 0 0       0 return if(ref($self->{Anansi}) !~ /^HASH$/i);
132 0 0       0 return if(!defined(${$self->{Anansi}}{ObjectManager}));
  0         0  
133 0 0       0 return if(ref(${$self->{Anansi}}{ObjectManager}) !~ /^HASH$/i);
  0         0  
134 0 0       0 return if(!defined(${${$self->{Anansi}}{ObjectManager}}{IDENTIFICATION}));
  0         0  
  0         0  
135 0 0       0 return if(ref(${${$self->{Anansi}}{ObjectManager}}{IDENTIFICATION}) !~ /^$/);
  0         0  
  0         0  
136 0 0       0 return if(${${$self->{Anansi}}{ObjectManager}}{IDENTIFICATION} =~ /^\s*$/);
  0         0  
  0         0  
137 0         0 return ${${$self->{Anansi}}{ObjectManager}}{IDENTIFICATION};
  0         0  
  0         0  
138             }
139              
140              
141             =head2 implicate
142              
143             sub implicate {
144             my ($self, $caller, $parameter) = @_;
145             if('EXAMPLE_VARIABLE' eq $parameter) {
146             return \EXAMPLE_VARIABLE;
147             }
148             try {
149             return $self->SUPER::implicate($caller, $parameter);
150             }
151             return if($@);
152             }
153              
154             =over 4
155              
156             =item self I<(Blessed Hash, Required)>
157              
158             An object of this namespace.
159              
160             =item caller I<(Array, Required)>
161              
162             An array containing the I, I and I of the caller.
163              
164             =item parameter I<(String, Required)>
165              
166             A string containing the name to import.
167              
168             =back
169              
170             A virtual method. Performs one module instance name import. Called for each
171             name to import.
172              
173             =cut
174              
175              
176             sub implicate {
177 0     0 1 0 my ($self, $caller, $parameter) = @_;
178 0 0       0 try {
179 0         0 return $self->SUPER::implicate($caller, $parameter);
180             }
181             return if($@);
182             }
183              
184              
185             =head2 import
186              
187             use Anansi::Example qw(EXAMPLE_VARIABLE);
188              
189             =over 4
190              
191             =item self I<(Blessed Hash, Required)>
192              
193             An object of this namespace.
194              
195             =item parameters I<(Array, Optional)>
196              
197             An array containing all of the names to import.
198              
199             =back
200              
201             Performs all required module name imports. Indirectly called via an extending
202             module.
203              
204             =cut
205              
206              
207             sub import {
208 1     1   15 my ($self, @parameters) = @_;
209 1         17 my $caller = caller();
210 1         16 foreach my $parameter (@parameters) {
211 0           my $value = $self->implicate($caller, $parameter);
212 0 0         *{$caller.'::'.$parameter} = $value if(defined($value));
  0            
213             }
214             }
215              
216              
217             =head2 initialise
218              
219             $OBJECT->initialise();
220              
221             $OBJECT->SUPER::initialise();
222              
223             =over 4
224              
225             =item self I<(Blessed Hash, Required)>
226              
227             An object of this namespace.
228              
229             =item parameters I<(Hash, Optional)>
230              
231             Named parameters that were supplied to the I method.
232              
233             =back
234              
235             A virtual method. Called just after module instance object creation.
236              
237             =cut
238              
239              
240             sub initialise {
241 0     0 1   my ($self, %parameters) = @_;
242             }
243              
244              
245             =head2 namespace
246              
247             =over 4
248              
249             =item self I<(Blessed Hash, Required)>
250              
251             An object of this namespace.
252              
253             =back
254              
255             Returns this object's namespace or B on error.
256              
257             =cut
258              
259              
260             sub namespace {
261 0     0 1   my ($self) = @_;
262 0 0         return if(ref($self) =~ /^(|ARRAY|CODE|FORMAT|GLOB|HASH|IO|LVALUE|REF|Regexp|SCALAR|VSTRING)$/i);
263 0           return ref($self);
264             }
265              
266              
267             =head2 new
268              
269             my $object = Anansi::Example->new();
270              
271             my $object = Anansi::Example->new(
272             SETTING => 'example',
273             );
274              
275             =over 4
276              
277             =item class I<(Blessed Hash B String, Required)>
278              
279             Either an object or a string of this namespace.
280              
281             =item parameters I<(Hash, Optional)>
282              
283             Named parameters.
284              
285             =back
286              
287             Instantiates an object instance of a module. Calls the
288             L module with the supplied I
289             after the object is instantiated. Indirectly called via an extending module
290             through inheritance.
291              
292             =cut
293              
294              
295             sub new {
296 0     0 1   my ($class, %parameters) = @_;
297 0 0         return if(ref($class) =~ /^(ARRAY|CODE|FORMAT|GLOB|HASH|IO|LVALUE|REF|Regexp|SCALAR|VSTRING)$/i);
298 0 0         $class = ref($class) if(ref($class) !~ /^$/);
299 0           my $self = {
300             NAMESPACE => $class,
301             PACKAGE => __PACKAGE__,
302             };
303 0           bless($self, $class);
304 0           my $objectManager = Anansi::ObjectManager->new();
305 0           $objectManager->register($self);
306 0           $self->initialise(%parameters);
307 0           return $self;
308             }
309              
310              
311             =head2 old
312              
313             $object->old();
314              
315             =over 4
316              
317             =item self I<(Blessed Hash, Required)>
318              
319             An object of this namespace.
320              
321             =item parameters I<(Hash, Optional)>
322              
323             Named parameters.
324              
325             =back
326              
327             Enables a module instance object to be externally destroyed.
328              
329             =cut
330              
331              
332             sub old {
333 0     0 1   my ($self, %parameters) = @_;
334 0           $self->DESTROY();
335             }
336              
337              
338             =head2 used
339              
340             $object->used('EXAMPLE');
341              
342             =over 4
343              
344             =item self I<(Blessed Hash, Required)>
345              
346             An object of this namespace.
347              
348             =item parameters I<(Array, Optional)>
349              
350             An array of strings containing the names of blessed objects currently in use by
351             this object.
352              
353             =back
354              
355             Releases a module instance object to enable it to be destroyed.
356              
357             =cut
358              
359              
360             sub used {
361 0     0 1   my ($self, @parameters) = @_;
362 0           my $objectManager = Anansi::ObjectManager->new();
363 0           foreach my $key (@parameters) {
364 0 0         next if(!defined($self->{$key}));
365 0 0         next if(!defined($self->{$key}->{Anansi}));
366 0 0         next if(!defined($self->{$key}->{Anansi}->{ObjectManager}));
367 0 0         next if(!defined($self->{$key}->{Anansi}->{ObjectManager}->{IDENTIFICATION}));
368             $objectManager->obsolete(
369             USER => $self,
370 0           USES => $self->{$key},
371             );
372 0           delete $self->{$key};
373             }
374             }
375              
376              
377             =head2 uses
378              
379             $object->uses(
380             EXAMPLE => $example,
381             );
382              
383             $object->uses(
384             EXAMPLE => 'Anansi::Example',
385             );
386             $object->{EXAMPLE}->doSomething();
387              
388             =over 4
389              
390             =item self I<(Blessed Hash, Required)>
391              
392             An object of this namespace.
393              
394             =item parameters I<(Hash, Optional)>
395              
396             A hash containing keys that represent the name to associate with the string
397             namespace or object within the associated values.
398              
399             =back
400              
401             Binds module instance objects to the current object to ensure that the objects
402             are not prematurely destroyed. Adds the I to the object namespace.
403              
404             =cut
405              
406              
407             sub uses {
408 0     0 1   my ($self, %parameters) = @_;
409 0           my $objectManager = Anansi::ObjectManager->new();
410 0           $objectManager->current(
411             USER => $self,
412             USES => [values %parameters],
413             );
414 0           while(my ($key, $value) = each(%parameters)) {
415 0 0         next if(!defined($value->{Anansi}));
416 0 0         next if(!defined($value->{Anansi}->{ObjectManager}));
417 0 0         next if(!defined($value->{Anansi}->{ObjectManager}->{IDENTIFICATION}));
418 0 0         $self->{$key} = $value if(!defined($self->{KEY}));
419             }
420             }
421              
422              
423             =head2 using
424              
425             my $names = $object->using();
426             foreach my $name (@{$names}) {
427             $object->{$name}->doSomething();
428             }
429              
430             $object->using('EXAMPLE')->doSomething();
431              
432             if(1 == $object->using(
433             'EXAMPLE',
434             'ANOTHER',
435             ));
436              
437             =over 4
438              
439             =item self I<(Blessed Hash, Required)>
440              
441             An object of this namespace.
442              
443             =item parameters I<(Array B String, Optional)>
444              
445             A string or an array of strings containing the names of blessed objects
446             currently in use by this object.
447              
448             =back
449              
450             Either returns an array of strings containing the names of the blessed objects
451             currently in use by this object or the blessed object represented by the single
452             specified name or whether the specified names represent blessed objects with a
453             B<1> I<(one)> for yes and B<0> I<(zero)> for no.
454              
455             =cut
456              
457              
458             sub using {
459 0     0 1   my ($self, @parameters) = @_;
460 0 0         if(0 == scalar(@parameters)) {
    0          
461             } elsif(1 == scalar(@parameters)) {
462 0 0         return if(ref($parameters[0]) !~ /^$/);
463 0 0         return if($parameters[0] =~ /^\s*$/);
464             } else {
465 0           foreach my $parameter (@parameters) {
466 0 0         return 0 if(ref($parameter) !~ /^$/);
467 0 0         return 0 if($parameter =~ /^\s*$/);
468             }
469             }
470 0           my $objectManager = Anansi::ObjectManager->new();
471 0           my $uses = $objectManager->user($self);
472 0 0         if(defined($uses)) {
    0          
    0          
473             } elsif(0 == scalar(@parameters)) {
474 0           return;
475             } elsif(1 == scalar(@parameters)) {
476 0           return 0;
477             } else {
478 0           return [];
479             }
480 0           my %identifiers = map { $objectManager->identification($_) => 1 } (@{$uses});
  0            
  0            
481 0           my %names;
482 0           foreach my $name (keys(%{$self})) {
  0            
483 0 0         next if(ref($self->{$name}) =~ /^(|ARRAY|CODE|FORMAT|GLOB|HASH|IO|LVALUE|REF|Regexp|SCALAR|VSTRING)$/i);
484 0 0         next if(!defined(${$self->{$name}}{Anansi}));
  0            
485 0 0         next if(!defined(${${$self->{$name}}{Anansi}}{ObjectManager}));
  0            
  0            
486 0 0         next if(!defined(${${${$self->{$name}}{Anansi}}{ObjectManager}}{IDENTIFICATION}));
  0            
  0            
  0            
487 0 0         next if(!defined($identifiers{${${${$self->{$name}}{Anansi}}{ObjectManager}}{IDENTIFICATION}}));
  0            
  0            
  0            
488 0           $names{$name} = ${${${$self->{$name}}{Anansi}}{ObjectManager}}{IDENTIFICATION};
  0            
  0            
  0            
489             }
490 0 0         if(0 == scalar(@parameters)) {
    0          
491 0           return [(keys(%names))];
492             } elsif(1 == scalar(@parameters)) {
493 0 0         return if(!defined($names{$parameters[0]}));
494 0           return $self->{$parameters[0]};
495             }
496 0           foreach my $parameter (@parameters) {
497 0 0         return 0 if(!defined($names{$parameter}));
498             }
499 0           return 1;
500             }
501              
502              
503             =head1 NOTES
504              
505             This module is designed to make it simple, easy and quite fast to code your
506             design in perl. If for any reason you feel that it doesn't achieve these goals
507             then please let me know. I am here to help. All constructive criticisms are
508             also welcomed.
509              
510             =cut
511              
512              
513             =head1 AUTHOR
514              
515             Kevin Treleaven treleaven I net>
516              
517             =cut
518              
519              
520             1;
521