line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
package IOC::Container; |
3
|
|
|
|
|
|
|
|
4
|
22
|
|
|
22
|
|
321579
|
use strict; |
|
22
|
|
|
|
|
50
|
|
|
22
|
|
|
|
|
888
|
|
5
|
22
|
|
|
22
|
|
266
|
use warnings; |
|
22
|
|
|
|
|
40
|
|
|
22
|
|
|
|
|
1108
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
our $VERSION = '0.14'; |
8
|
|
|
|
|
|
|
|
9
|
22
|
|
|
22
|
|
156
|
use Scalar::Util qw(blessed); |
|
22
|
|
|
|
|
45
|
|
|
22
|
|
|
|
|
3210
|
|
10
|
|
|
|
|
|
|
|
11
|
22
|
|
|
22
|
|
11772
|
use IOC::Interfaces; |
|
22
|
|
|
|
|
60
|
|
|
22
|
|
|
|
|
621
|
|
12
|
22
|
|
|
22
|
|
3996
|
use IOC::Exceptions; |
|
22
|
|
|
|
|
60
|
|
|
22
|
|
|
|
|
770
|
|
13
|
|
|
|
|
|
|
|
14
|
22
|
|
|
22
|
|
22074
|
use IOC::Visitor::ServiceLocator; |
|
22
|
|
|
|
|
154
|
|
|
22
|
|
|
|
|
706
|
|
15
|
|
|
|
|
|
|
|
16
|
22
|
|
|
22
|
|
156
|
use base 'IOC::Visitable'; |
|
22
|
|
|
|
|
41
|
|
|
22
|
|
|
|
|
68452
|
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
sub new { |
19
|
90
|
|
|
90
|
1
|
37747
|
my ($_class, $name) = @_; |
20
|
90
|
|
33
|
|
|
529
|
my $class = ref($_class) || $_class; |
21
|
90
|
|
|
|
|
180
|
my $container = {}; |
22
|
90
|
|
|
|
|
229
|
bless($container, $class); |
23
|
90
|
|
|
|
|
362
|
$container->_init($name); |
24
|
90
|
|
|
|
|
364
|
return $container; |
25
|
|
|
|
|
|
|
} |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
sub _init { |
28
|
90
|
|
|
90
|
|
222
|
my ($self, $name) = @_; |
29
|
90
|
|
|
|
|
404
|
$self->{services} = {}; |
30
|
90
|
|
|
|
|
247
|
$self->{service_locks} = {}; |
31
|
90
|
|
|
|
|
228
|
$self->{proxies} = {}; |
32
|
90
|
|
|
|
|
300
|
$self->{sub_containers} = {}; |
33
|
90
|
|
|
|
|
630
|
$self->{parent_container} = undef; |
34
|
90
|
|
100
|
|
|
587
|
$self->{name} = $name || 'default'; |
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
sub name { |
38
|
68
|
|
|
68
|
1
|
4882
|
my ($self) = @_; |
39
|
68
|
|
|
|
|
348
|
return $self->{name}; |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
# parent containers |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
sub setParentContainer { |
45
|
32
|
|
|
32
|
1
|
321
|
my ($self, $parent_container) = @_; |
46
|
32
|
100
|
100
|
|
|
425
|
(blessed($parent_container) && $parent_container->isa('IOC::Container')) |
47
|
|
|
|
|
|
|
|| throw IOC::InsufficientArguments "You must provide an IOC::Container object as a parent container"; |
48
|
28
|
|
|
|
|
68
|
$self->{parent_container} = $parent_container; |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
sub getParentContainer { |
52
|
9
|
|
|
9
|
1
|
22
|
my ($self) = @_; |
53
|
9
|
|
|
|
|
46
|
return $self->{parent_container}; |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
sub isRootContainer { |
57
|
30
|
|
|
30
|
1
|
48
|
my ($self) = @_; |
58
|
30
|
100
|
|
|
|
221
|
return defined($self->{parent_container}) ? 0 : 1; |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
sub findRootContainer { |
62
|
13
|
|
|
13
|
1
|
27
|
my ($self) = @_; |
63
|
13
|
100
|
|
|
|
52
|
return $self if $self->isRootContainer(); |
64
|
4
|
|
|
|
|
7
|
my $current = $self; |
65
|
4
|
|
|
|
|
10
|
$current = $current->getParentContainer() until $current->isRootContainer(); |
66
|
4
|
|
|
|
|
11
|
return $current; |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
# sub containers |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
sub addSubContainer { |
72
|
33
|
|
|
33
|
1
|
239
|
my ($self, $container) = @_; |
73
|
33
|
100
|
100
|
|
|
409
|
(blessed($container) && $container->isa('IOC::Container')) |
74
|
|
|
|
|
|
|
|| throw IOC::InsufficientArguments "You must provide an IOC::Container object as a sub-container"; |
75
|
29
|
|
|
|
|
93
|
my $name = $container->name(); |
76
|
29
|
100
|
|
|
|
43
|
(!exists ${$self->{sub_containers}}{$name}) |
|
29
|
|
|
|
|
122
|
|
77
|
|
|
|
|
|
|
|| throw IOC::ContainerAlreadyExists "Duplicate Sub-Container Name '${name}' in container '" . $self->{name} . "'"; |
78
|
28
|
|
|
|
|
110
|
$self->{sub_containers}->{$name} = $container; |
79
|
28
|
|
|
|
|
90
|
$container->setParentContainer($self); |
80
|
28
|
|
|
|
|
84
|
$self; |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
sub addSubContainers { |
84
|
7
|
|
|
7
|
1
|
53
|
my ($self, @containers) = @_; |
85
|
7
|
100
|
|
|
|
31
|
(@containers) || throw IOC::InsufficientArguments "You must provide at least one IOC::Container to add"; |
86
|
6
|
|
|
|
|
27
|
$self->addSubContainer($_) foreach @containers; |
87
|
6
|
|
|
|
|
23
|
$self; |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
sub hasSubContainer { |
91
|
12
|
|
|
12
|
1
|
356
|
my ($self, $name) = @_; |
92
|
12
|
100
|
|
|
|
41
|
(defined($name)) || throw IOC::InsufficientArguments "You must supply a name of a sub-container"; |
93
|
11
|
100
|
|
|
|
12
|
return (exists ${$self->{sub_containers}}{$name}) ? 1 : 0; |
|
11
|
|
|
|
|
63
|
|
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
sub hasSubContainers { |
97
|
35
|
|
|
35
|
1
|
5860
|
my ($self) = @_; |
98
|
35
|
100
|
|
|
|
32
|
return scalar(keys(%{$self->{sub_containers}})) ? 1 : 0; |
|
35
|
|
|
|
|
191
|
|
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
sub getSubContainerList { |
102
|
11
|
|
|
11
|
1
|
892
|
my ($self) = @_; |
103
|
11
|
|
|
|
|
17
|
return keys %{$self->{sub_containers}}; |
|
11
|
|
|
|
|
72
|
|
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
sub getSubContainer { |
107
|
49
|
|
|
49
|
1
|
2190
|
my ($self, $name) = @_; |
108
|
49
|
100
|
|
|
|
131
|
(defined($name)) || throw IOC::InsufficientArguments "You must supply a name of a sub-container"; |
109
|
48
|
100
|
|
|
|
80
|
(exists ${$self->{sub_containers}}{$name}) |
|
48
|
|
|
|
|
323
|
|
110
|
|
|
|
|
|
|
|| throw IOC::ContainerNotFound "There is no subcontainer by the name '${name}' in container '" . $self->{name} . "'"; |
111
|
45
|
|
|
|
|
182
|
return $self->{sub_containers}->{$name}; |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
sub getAllSubContainers { |
115
|
9
|
|
|
9
|
1
|
12
|
my ($self) = @_; |
116
|
9
|
|
|
|
|
10
|
return values %{$self->{sub_containers}}; |
|
9
|
|
|
|
|
43
|
|
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
sub accept { |
120
|
54
|
|
|
54
|
1
|
13548
|
my ($self, $visitor) = @_; |
121
|
54
|
100
|
100
|
|
|
552
|
(blessed($visitor) && $visitor->isa('IOC::Visitor')) |
122
|
|
|
|
|
|
|
|| throw IOC::InsufficientArguments "You must pass an IOC::Visitor object to the visit method"; |
123
|
50
|
|
|
|
|
193
|
return $visitor->visit($self); |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
# services |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
sub register { |
129
|
101
|
|
|
101
|
1
|
5585
|
my ($self, $service) = @_; |
130
|
101
|
100
|
100
|
|
|
5140
|
(blessed($service) && $service->isa('IOC::Service')) |
131
|
|
|
|
|
|
|
|| throw IOC::InsufficientArguments "You must provide a valid IOC::Service object to register"; |
132
|
97
|
|
|
|
|
429
|
my $name = $service->name(); |
133
|
97
|
100
|
|
|
|
162
|
(!exists ${$self->{services}}{$name}) |
|
97
|
|
|
|
|
461
|
|
134
|
|
|
|
|
|
|
|| throw IOC::ServiceAlreadyExists "Duplicate Service Name '${name}'"; |
135
|
96
|
|
|
|
|
383
|
$service->setContainer($self); |
136
|
96
|
|
|
|
|
273
|
$self->{services}->{$name} = $service; |
137
|
96
|
|
|
|
|
303
|
$self; |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
sub unregister { |
141
|
3
|
|
|
3
|
1
|
100
|
my ($self, $name) = @_; |
142
|
3
|
100
|
|
|
|
22
|
(defined($name)) || throw IOC::InsufficientArguments "You must provide a service name to unregister"; |
143
|
2
|
100
|
|
|
|
3
|
(exists ${$self->{services}}{$name}) |
|
2
|
|
|
|
|
18
|
|
144
|
|
|
|
|
|
|
|| throw IOC::ServiceNotFound "Unknown Service '${name}'"; |
145
|
1
|
|
|
|
|
3
|
my $service = $self->{services}->{$name}; |
146
|
1
|
|
|
|
|
7
|
$service->removeContainer(); |
147
|
1
|
|
|
|
|
3
|
delete $self->{services}->{$name}; |
148
|
1
|
|
|
|
|
14
|
return $service; |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
sub registerWithProxy { |
152
|
1
|
|
|
1
|
1
|
2
|
my ($self, $service, $proxy) = @_; |
153
|
1
|
|
|
|
|
5
|
$self->register($service); |
154
|
1
|
|
|
|
|
3
|
$self->addProxy($service->name(), $proxy); |
155
|
1
|
|
|
|
|
5
|
$self; |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
sub addProxy { |
159
|
8
|
|
|
8
|
1
|
2940
|
my ($self, $name, $proxy) = @_; |
160
|
8
|
100
|
|
|
|
31
|
(defined($name)) || throw IOC::InsufficientArguments "You must provide a valid service name"; |
161
|
7
|
100
|
100
|
|
|
74
|
(blessed($proxy) && $proxy->isa('IOC::Proxy')) |
162
|
|
|
|
|
|
|
|| throw IOC::InsufficientArguments "You must provide a valid IOC::Proxy object to register"; |
163
|
3
|
100
|
|
|
|
4
|
(exists ${$self->{services}}{$name}) |
|
3
|
|
|
|
|
23
|
|
164
|
|
|
|
|
|
|
|| throw IOC::ServiceNotFound "Unknown Service '${name}'"; |
165
|
2
|
|
|
|
|
5
|
$self->{proxies}->{$name} = $proxy; |
166
|
2
|
|
|
|
|
7
|
$self; |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
sub get { |
170
|
131
|
|
|
131
|
1
|
12906
|
my ($self, $name, %params) = @_; |
171
|
131
|
100
|
|
|
|
393
|
(defined($name)) || throw IOC::InsufficientArguments "You must provide a name of the service"; |
172
|
130
|
100
|
|
|
|
163
|
(exists ${$self->{services}}{$name}) |
|
130
|
|
|
|
|
472
|
|
173
|
|
|
|
|
|
|
|| throw IOC::ServiceNotFound "Unknown Service '${name}'"; |
174
|
|
|
|
|
|
|
# a literal object can have no dependencies, |
175
|
|
|
|
|
|
|
# and therefore can have no circular refs, so |
176
|
|
|
|
|
|
|
# we can optimize their usage there as well |
177
|
128
|
100
|
|
|
|
1067
|
return $self->{services}->{$name}->instance() |
178
|
|
|
|
|
|
|
if $self->{services}->{$name}->isa('IOC::Service::Literal'); |
179
|
103
|
100
|
|
|
|
7485
|
if ($self->_isServiceLocked($name)) { |
180
|
|
|
|
|
|
|
# NOTE: |
181
|
|
|
|
|
|
|
# if the service is parameterized |
182
|
|
|
|
|
|
|
# then we cannot defer it - SL |
183
|
7
|
50
|
|
|
|
46
|
($self->{services}->{$name}->isa('IOC::Service::Parameterized')) |
184
|
|
|
|
|
|
|
&& throw IOC::IllegalOperation "The service '$name' is locked, cannot defer a parameterized instance"; |
185
|
|
|
|
|
|
|
# otherwise ... |
186
|
7
|
|
|
|
|
33
|
return $self->{services}->{$name}->deferred(); |
187
|
|
|
|
|
|
|
} |
188
|
96
|
|
|
|
|
309
|
$self->_lockService($name); |
189
|
96
|
|
|
|
|
504
|
my $instance = $self->{services}->{$name}->instance(%params); |
190
|
96
|
|
|
|
|
624
|
$self->_unlockService($name); |
191
|
96
|
100
|
100
|
|
|
667
|
if (blessed($instance) && ref($instance) !~ /\:\:\_\:\:Proxy$/) { |
192
|
69
|
100
|
|
|
|
131
|
return $self->{proxies}->{$name}->wrap($instance) if exists ${$self->{proxies}}{$name}; |
|
69
|
|
|
|
|
369
|
|
193
|
|
|
|
|
|
|
} |
194
|
94
|
|
|
|
|
450
|
return $instance; |
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
sub find { |
198
|
33
|
|
|
33
|
1
|
6560
|
my ($self, $path, $extra_args) = @_; |
199
|
33
|
100
|
|
|
|
107
|
(defined($path)) |
200
|
|
|
|
|
|
|
|| throw IOC::InsufficientArguments "You must provide a path of find a service"; |
201
|
32
|
|
|
|
|
183
|
return $self->accept(IOC::Visitor::ServiceLocator->new($path, $extra_args)); |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
sub hasService { |
205
|
28
|
|
|
28
|
1
|
76
|
my ($self, $name) = @_; |
206
|
28
|
100
|
|
|
|
67
|
(defined($name)) || throw IOC::InsufficientArguments "You must provide a name of the service"; |
207
|
27
|
100
|
|
|
|
28
|
return (exists ${$self->{services}}{$name}) ? 1 : 0; |
|
27
|
|
|
|
|
147
|
|
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
sub getServiceList { |
211
|
6
|
|
|
6
|
1
|
1974
|
my ($self) = @_; |
212
|
6
|
|
|
|
|
13
|
return keys %{$self->{services}}; |
|
6
|
|
|
|
|
75
|
|
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
sub DESTROY { |
216
|
78
|
|
|
78
|
|
1853
|
my ($self) = @_; |
217
|
|
|
|
|
|
|
# this will not DESTROY all the |
218
|
|
|
|
|
|
|
# sub-containers it holds, since |
219
|
|
|
|
|
|
|
# a sub-container might be still |
220
|
|
|
|
|
|
|
# refered to elsewhere. |
221
|
78
|
|
|
|
|
168
|
$self->{sub_containers} = undef; |
222
|
|
|
|
|
|
|
# and the same with the parent |
223
|
78
|
|
|
|
|
142
|
$self->{parent_container} = undef; |
224
|
|
|
|
|
|
|
# this will DESTROY all the |
225
|
|
|
|
|
|
|
# services it holds, since |
226
|
|
|
|
|
|
|
# a service can only have one |
227
|
|
|
|
|
|
|
# container, then this is okay |
228
|
|
|
|
|
|
|
# to do that, otherwise we would |
229
|
|
|
|
|
|
|
# need to deal with that. |
230
|
78
|
|
|
|
|
117
|
foreach my $service (values %{$self->{services}}) { |
|
78
|
|
|
|
|
1087
|
|
231
|
40
|
50
|
|
|
|
208
|
defined $service && $service->DESTROY; |
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
# private methods |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
sub _lockService { |
238
|
96
|
|
|
96
|
|
153
|
my ($self, $name) = @_; |
239
|
96
|
|
|
|
|
174
|
$self->{lock_level}++; |
240
|
96
|
|
|
|
|
297
|
$self->{service_locks}->{$name} = $self->{lock_level}; |
241
|
|
|
|
|
|
|
# use Data::Dumper; |
242
|
|
|
|
|
|
|
# print "locking '$name' -> our locks are: " . Dumper($self->{service_locks}); |
243
|
|
|
|
|
|
|
} |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
sub _unlockService { |
246
|
96
|
|
|
96
|
|
157
|
my ($self, $name) = @_; |
247
|
96
|
|
|
|
|
168
|
$self->{lock_level}--; |
248
|
96
|
|
|
|
|
345
|
delete $self->{service_locks}->{$name}; |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
sub _isServiceLocked { |
252
|
103
|
|
|
103
|
|
184
|
my ($self, $name) = @_; |
253
|
103
|
|
|
|
|
129
|
return (exists ${$self->{service_locks}}{$name}); |
|
103
|
|
|
|
|
495
|
|
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
1; |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
__END__ |