File Coverage

blib/lib/Eixo/Base/Singleton.pm
Criterion Covered Total %
statement 49 50 98.0
branch 12 16 75.0
condition n/a
subroutine 11 11 100.0
pod 0 2 0.0
total 72 79 91.1


line stmt bran cond sub pod time code
1             package Eixo::Base::Singleton;
2              
3 4     4   14 use strict;
  4         4  
  4         85  
4 4     4   12 use Eixo::Base::Clase;
  4         2  
  4         30  
5              
6             sub make_singleton{
7 9     9 0 49 my ($clase, %args) = @_;
8              
9 4     4   15 no strict 'refs';
  4         4  
  4         132  
10              
11 4     4   12 no warnings 'redefine';
  4         4  
  4         1027  
12              
13 9 100       7 return if(defined(&{$clase . '::SINGLETON'}));
  9         66  
14              
15 6         22 my $instance = $clase->new(%args);
16              
17 6         16 *{$clase . '::SINGLETON'} = sub {
18            
19 2     2   2 return $instance;
20              
21 6         15 };
22              
23 6         19 *{$clase . '::AUTOLOAD'} = sub {
24              
25 24     24   162 my ($attribute) = our $AUTOLOAD =~ /\:(\w+)$/;
26              
27 24 50       101 if(my $method = $instance->can('__' . $attribute)){
28            
29 24         64 $instance->$method(@_[1..$#_]);
30            
31             }
32             else{
33 0         0 die($AUTOLOAD . ' method not found');
34             }
35              
36 6         20 };
37            
38 6 50       28 if($instance->can('initialize')){
39              
40 6         16 $instance->initialize();
41             }
42              
43 6         17 $instance;
44             }
45              
46             sub new{
47 8     8 0 14 my ($class, @args) = @_;
48            
49 8 100       65 my $self = ($class->can('SINGLETON')) ? $class->SINGLETON : undef;
50            
51 8 100       14 if($self){
52 2         3 $self->__chainInitialize;
53              
54 2         4 $self->initialize(@args);
55             }
56             else{
57 6         8 $self = bless({}, $class);
58              
59 6         32 $self->__chainInitialize;
60            
61 6 50       32 $self->__initialize if($self->can('__initialize'));
62              
63             }
64              
65              
66 8         21 $self;
67              
68             }
69              
70              
71              
72             sub __createSetterGetter{
73 17     17   18 my ($class, $attribute, $value) = @_;
74              
75 4     4   21 no strict 'refs';
  4         4  
  4         594  
76              
77 17 50       16 unless(defined(&{$class . '::__' . $attribute})){
  17         64  
78              
79 17         65 *{$class . '::__' . $attribute} = sub {
80              
81 24     24   15 my ($self, $value) = @_;
82              
83 24 100       43 if(defined($value)){
84            
85 6         8 $self->{$attribute} = $value;
86            
87 6         12 $self;
88             }
89             else{
90            
91 18         83 $self->{$attribute};
92             }
93              
94 17         50 };
95              
96             }
97             }
98              
99              
100             1;