| 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__ |