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