File Coverage

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 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 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, I and I of the caller.
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 method.
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 String, Required)>
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 module with the supplied I
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 to the object namespace.
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 String, Optional)>
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 treleaven I net>
453              
454             =cut
455              
456              
457             1;