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 12 12 100.0
pod 0 2 0.0
total 73 80 91.2


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