File Coverage

blib/lib/IOC/Service.pm
Criterion Covered Total %
statement 76 85 89.4
branch 24 28 85.7
condition 10 15 66.6
subroutine 23 26 88.4
pod 6 6 100.0
total 139 160 86.8


line stmt bran cond sub pod time code
1              
2             package IOC::Service;
3              
4 23     23   93173 use strict;
  23         47  
  23         1011  
5 23     23   149 use warnings;
  23         43  
  23         1204  
6              
7             our $VERSION = '0.08';
8              
9 23     23   136 use Scalar::Util qw(blessed);
  23         61  
  23         1578  
10              
11 23     23   711 use IOC::Exceptions;
  23         176  
  23         18666  
12              
13             sub new {
14 72     72 1 24196 my ($_class, $name, $block) = @_;
15 72   33     366 my $class = ref($_class) || $_class;
16 72         143 my $service = {};
17 72         180 bless($service, $class);
18 72         237 $service->_init($name, $block);
19 68         392 return $service;
20             }
21              
22             sub _init {
23 100     100   187 my ($self, $name, $block) = @_;
24 100 100       324 (defined($name)) || throw IOC::InsufficientArguments "Service object cannot be created without a name";
25 99 100 100     607 (defined($block) && ref($block) eq 'CODE')
26             || throw IOC::InsufficientArguments "Service object cannot be created without CODE block";
27             # set the defaults
28 96         395 $self->{_instance} = undef;
29             # assign constructor args
30 96         202 $self->{name} = $name;
31 96         182 $self->{block} = $block;
32             # container is optional
33 96         248 $self->{container} = undef;
34             }
35              
36             sub name {
37 99     99 1 1347 my ($self) = @_;
38 99         310 return $self->{name};
39             }
40              
41             sub setContainer {
42 101     101 1 6966 my ($self, $container) = @_;
43 101 100 100     962 (blessed($container) && $container->isa('IOC::Container'))
44             || throw IOC::InsufficientArguments "container argument is incorrect";
45 97         199 $self->{container} = $container;
46 97         234 $self;
47             }
48              
49             sub removeContainer {
50 1     1 1 3 my ($self) = @_;
51 1         4 $self->{container} = undef;
52 1         2 $self;
53             }
54              
55             sub instance {
56 107     107 1 6239 my ($self) = @_;
57 107 100       329 unless (defined $self->{_instance}) {
58 73 100       207 (defined($self->{container}))
59             || throw IOC::IllegalOperation "Cannot create a service instance without setting container";
60 72         438 my $instance = $self->{block}->($self->{container});
61 67 100       5338 $self->{_instance} = $instance unless defined $self->{_instance};
62 67 100       379 (defined($self->{_instance}))
63             || throw IOC::InitializationError "Service creation block returned undefined value";
64             }
65 100         282 return $self->{_instance};
66             }
67              
68             sub deferred {
69 7     7 1 10 my ($self) = @_;
70 7         29 return IOC::Service::Deferred->new($self);
71             }
72              
73             sub DESTROY {
74 71     71   25622 my ($self) = @_;
75             # remove the connnection to the instance
76             # but do not attempt to DESTROY it, that
77             # should be left up to the instance itself
78 71 100       236 $self->{_instance} = undef if defined $self->{_instance};
79             # remove the container instance as well
80             # no need to DESTROY this either since
81             # not only could it still have other services
82             # in it, but it it highly likely that the
83             # call to DESTROY this object came from
84             # its container anyway
85 71 100       1114 $self->{container} = undef if defined $self->{container};
86             }
87              
88             package IOC::Service::Deferred;
89              
90 23     23   235 use strict;
  23         73  
  23         866  
91 23     23   135 use warnings;
  23         38  
  23         8626  
92              
93             our $VERSION = '0.02';
94              
95             use overload '%{}' => sub {
96 21 100   21   80 return $_[0] if (caller)[0] eq 'IOC::Service::Deferred';
97 1         24 $_[0] = $_[0]->{service}->instance();
98 1         6 $_[0]
99             },
100 1     1   4 '@{}' => sub { $_[0] = $_[0]->{service}->instance(); $_[0] },
  1         6  
101 0     0   0 '${}' => sub { $_[0] = $_[0]->{service}->instance(); $_[0] },
  0         0  
102 0     0   0 '&{}' => sub { $_[0] = $_[0]->{service}->instance(); $_[0] },
  0         0  
103             nomethod => sub {
104 0     0   0 $_[0] = $_[0]->{service}->instance();
105 0 0 0     0 return overload::StrVal($_[0]) if ($_[3] eq '""' && !overload::Method($_[0], $_[3]));
106 0 0       0 if (my $func = overload::Method($_[0], $_[3])) {
107 0         0 return $_[0]->$func($_[1], $_[2]);
108             }
109 0         0 throw IOC::MethodNotFound "Could not find a method for overloaded '$_[3]' operator";
110 23     23   149 };
  23         65  
  23         443  
111              
112 23     23   4166 use Scalar::Util qw(blessed);
  23         42  
  23         9051  
113              
114             sub new {
115 10     10   3212 my ($class, $service) = @_;
116 10 100 100     113 (blessed($service) && $service->isa('IOC::Service'))
117             || throw IOC::InsufficientArguments "You can only defer an IOC::Service object";
118 7         2032 return bless { service => $service }, $class;
119             }
120              
121             sub can {
122 1     1   4 $_[0] = $_[0]->{service}->instance();
123 1         10 (shift)->can(shift);
124             }
125              
126             sub isa {
127 6     6   462 $_[0] = $_[0]->{service}->instance();
128 6         42 (shift)->isa(shift);
129             }
130              
131 7     7   25 sub DESTROY { (shift)->{service} = undef }
132              
133             sub AUTOLOAD {
134 4     4   507 my ($subname) = our $AUTOLOAD =~ /([^:]+)$/;
135 4         79 $_[0] = $_[0]->{service}->instance();
136 4         25 my $func = $_[0]->can($subname);
137 4 100       119 (ref($func) eq 'CODE')
138             || throw IOC::MethodNotFound "You cannot call '$subname'";
139 3         21 goto &$func;
140             }
141              
142             1;
143              
144             __END__