line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Beam::Wire; |
2
|
|
|
|
|
|
|
our $VERSION = '1.023'; |
3
|
|
|
|
|
|
|
# ABSTRACT: Lightweight Dependency Injection Container |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
#pod =head1 SYNOPSIS |
6
|
|
|
|
|
|
|
#pod |
7
|
|
|
|
|
|
|
#pod # wire.yml |
8
|
|
|
|
|
|
|
#pod captain: |
9
|
|
|
|
|
|
|
#pod class: Person |
10
|
|
|
|
|
|
|
#pod args: |
11
|
|
|
|
|
|
|
#pod name: Malcolm Reynolds |
12
|
|
|
|
|
|
|
#pod rank: Captain |
13
|
|
|
|
|
|
|
#pod first_officer: |
14
|
|
|
|
|
|
|
#pod $class: Person |
15
|
|
|
|
|
|
|
#pod name: Zoë Alleyne Washburne |
16
|
|
|
|
|
|
|
#pod rank: Commander |
17
|
|
|
|
|
|
|
#pod |
18
|
|
|
|
|
|
|
#pod # script.pl |
19
|
|
|
|
|
|
|
#pod use Beam::Wire; |
20
|
|
|
|
|
|
|
#pod my $wire = Beam::Wire->new( file => 'wire.yml' ); |
21
|
|
|
|
|
|
|
#pod my $captain = $wire->get( 'captain' ); |
22
|
|
|
|
|
|
|
#pod print $captain->name; # "Malcolm Reynolds" |
23
|
|
|
|
|
|
|
#pod |
24
|
|
|
|
|
|
|
#pod =head1 DESCRIPTION |
25
|
|
|
|
|
|
|
#pod |
26
|
|
|
|
|
|
|
#pod Beam::Wire is a configuration module and a dependency injection |
27
|
|
|
|
|
|
|
#pod container. In addition to complex data structures, Beam::Wire configures |
28
|
|
|
|
|
|
|
#pod and creates plain old Perl objects. |
29
|
|
|
|
|
|
|
#pod |
30
|
|
|
|
|
|
|
#pod A dependency injection (DI) container creates an inversion of control: |
31
|
|
|
|
|
|
|
#pod Instead of manually creating all the dependent objects (also called |
32
|
|
|
|
|
|
|
#pod "services") before creating the main object that we actually want, a DI |
33
|
|
|
|
|
|
|
#pod container handles that for us: We describe the relationships between |
34
|
|
|
|
|
|
|
#pod objects, and the objects get built as needed. |
35
|
|
|
|
|
|
|
#pod |
36
|
|
|
|
|
|
|
#pod Dependency injection is sometimes called the opposite of garbage |
37
|
|
|
|
|
|
|
#pod collection. Rather than ensure objects are destroyed in the right order, |
38
|
|
|
|
|
|
|
#pod dependency injection makes sure objects are created in the right order. |
39
|
|
|
|
|
|
|
#pod |
40
|
|
|
|
|
|
|
#pod Using Beam::Wire in your application brings great flexibility, |
41
|
|
|
|
|
|
|
#pod allowing users to easily add their own code to customize how your |
42
|
|
|
|
|
|
|
#pod project behaves. |
43
|
|
|
|
|
|
|
#pod |
44
|
|
|
|
|
|
|
#pod For an L<introduction to the Beam::Wire service configuration format, |
45
|
|
|
|
|
|
|
#pod see Beam::Wire::Help::Config|Beam::Wire::Help::Config>. |
46
|
|
|
|
|
|
|
#pod |
47
|
|
|
|
|
|
|
#pod =cut |
48
|
|
|
|
|
|
|
|
49
|
24
|
|
|
24
|
|
3817056
|
use strict; |
|
24
|
|
|
|
|
118
|
|
|
24
|
|
|
|
|
626
|
|
50
|
24
|
|
|
24
|
|
110
|
use warnings; |
|
24
|
|
|
|
|
43
|
|
|
24
|
|
|
|
|
612
|
|
51
|
|
|
|
|
|
|
|
52
|
24
|
|
|
24
|
|
112
|
use Scalar::Util qw( blessed ); |
|
24
|
|
|
|
|
40
|
|
|
24
|
|
|
|
|
1017
|
|
53
|
24
|
|
|
24
|
|
11284
|
use Moo; |
|
24
|
|
|
|
|
239065
|
|
|
24
|
|
|
|
|
110
|
|
54
|
24
|
|
|
24
|
|
42112
|
use Config::Any; |
|
24
|
|
|
|
|
192862
|
|
|
24
|
|
|
|
|
771
|
|
55
|
24
|
|
|
24
|
|
209
|
use Module::Runtime qw( use_module ); |
|
24
|
|
|
|
|
50
|
|
|
24
|
|
|
|
|
125
|
|
56
|
24
|
|
|
24
|
|
12873
|
use Data::DPath qw ( dpath ); |
|
24
|
|
|
|
|
2172522
|
|
|
24
|
|
|
|
|
177
|
|
57
|
24
|
|
|
24
|
|
19980
|
use Path::Tiny qw( path ); |
|
24
|
|
|
|
|
203257
|
|
|
24
|
|
|
|
|
1444
|
|
58
|
24
|
|
|
24
|
|
187
|
use File::Basename qw( dirname ); |
|
24
|
|
|
|
|
47
|
|
|
24
|
|
|
|
|
1607
|
|
59
|
24
|
|
|
24
|
|
13125
|
use Types::Standard qw( :all ); |
|
24
|
|
|
|
|
1541254
|
|
|
24
|
|
|
|
|
260
|
|
60
|
24
|
|
|
24
|
|
1057363
|
use Data::Dumper; |
|
24
|
|
|
|
|
67
|
|
|
24
|
|
|
|
|
1896
|
|
61
|
24
|
|
|
24
|
|
14211
|
use Beam::Wire::Event::ConfigService; |
|
24
|
|
|
|
|
86
|
|
|
24
|
|
|
|
|
912
|
|
62
|
24
|
|
|
24
|
|
10700
|
use Beam::Wire::Event::BuildService; |
|
24
|
|
|
|
|
80
|
|
|
24
|
|
|
|
|
1195
|
|
63
|
24
|
|
|
24
|
|
162
|
use constant DEBUG => $ENV{BEAM_WIRE_DEBUG}; |
|
24
|
|
|
|
|
43
|
|
|
24
|
|
|
|
|
96309
|
|
64
|
|
|
|
|
|
|
with 'Beam::Emitter'; |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
#pod =attr file |
67
|
|
|
|
|
|
|
#pod |
68
|
|
|
|
|
|
|
#pod The path of the file where services are configured (typically a YAML |
69
|
|
|
|
|
|
|
#pod file). The file's contents should be a single hashref. The keys are |
70
|
|
|
|
|
|
|
#pod service names, and the values are L<service |
71
|
|
|
|
|
|
|
#pod configurations|Beam::Wire::Help::Config>. |
72
|
|
|
|
|
|
|
#pod |
73
|
|
|
|
|
|
|
#pod =cut |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
has file => ( |
76
|
|
|
|
|
|
|
is => 'ro', |
77
|
|
|
|
|
|
|
isa => InstanceOf['Path::Tiny'], |
78
|
|
|
|
|
|
|
coerce => sub { |
79
|
|
|
|
|
|
|
if ( !blessed $_[0] || !$_[0]->isa('Path::Tiny') ) { |
80
|
|
|
|
|
|
|
return path( $_[0] ); |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
return $_[0]; |
83
|
|
|
|
|
|
|
}, |
84
|
|
|
|
|
|
|
); |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
#pod =attr dir |
87
|
|
|
|
|
|
|
#pod |
88
|
|
|
|
|
|
|
#pod The directory path to use when searching for inner container files. |
89
|
|
|
|
|
|
|
#pod Defaults to the directory which contains the file specified by the |
90
|
|
|
|
|
|
|
#pod L<file attribute|/file>. |
91
|
|
|
|
|
|
|
#pod |
92
|
|
|
|
|
|
|
#pod =cut |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
has dir => ( |
95
|
|
|
|
|
|
|
is => 'ro', |
96
|
|
|
|
|
|
|
isa => InstanceOf['Path::Tiny'], |
97
|
|
|
|
|
|
|
lazy => 1, |
98
|
|
|
|
|
|
|
default => sub { $_[0]->file->parent }, |
99
|
|
|
|
|
|
|
coerce => sub { |
100
|
|
|
|
|
|
|
if ( !blessed $_[0] || !$_[0]->isa('Path::Tiny') ) { |
101
|
|
|
|
|
|
|
return path( $_[0] ); |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
return $_[0]; |
104
|
|
|
|
|
|
|
}, |
105
|
|
|
|
|
|
|
); |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
#pod =attr config |
108
|
|
|
|
|
|
|
#pod |
109
|
|
|
|
|
|
|
#pod The raw configuration data. By default, this data is loaded by |
110
|
|
|
|
|
|
|
#pod L<Config::Any|Config::Any> using the file specified by the L<file attribute|/file>. |
111
|
|
|
|
|
|
|
#pod |
112
|
|
|
|
|
|
|
#pod See L<Beam::Wire::Help::Config for details on what the configuration |
113
|
|
|
|
|
|
|
#pod data structure looks like|Beam::Wire::Help::Config>. |
114
|
|
|
|
|
|
|
#pod |
115
|
|
|
|
|
|
|
#pod If you don't want to load a file, you can specify this attribute in the |
116
|
|
|
|
|
|
|
#pod Beam::Wire constructor. |
117
|
|
|
|
|
|
|
#pod |
118
|
|
|
|
|
|
|
#pod =cut |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
has config => ( |
121
|
|
|
|
|
|
|
is => 'ro', |
122
|
|
|
|
|
|
|
isa => HashRef, |
123
|
|
|
|
|
|
|
lazy => 1, |
124
|
|
|
|
|
|
|
builder => 1 |
125
|
|
|
|
|
|
|
); |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
sub _build_config { |
128
|
25
|
|
|
25
|
|
275
|
my ( $self ) = @_; |
129
|
25
|
100
|
|
|
|
205
|
return {} if ( !$self->file ); |
130
|
20
|
|
|
|
|
94
|
return $self->_load_config( $self->file ); |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
#pod =attr services |
134
|
|
|
|
|
|
|
#pod |
135
|
|
|
|
|
|
|
#pod A hashref of cached services built from the L<configuration|/config>. If |
136
|
|
|
|
|
|
|
#pod you want to inject a pre-built object for other services to depend on, |
137
|
|
|
|
|
|
|
#pod add it here. |
138
|
|
|
|
|
|
|
#pod |
139
|
|
|
|
|
|
|
#pod =cut |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
has services => ( |
142
|
|
|
|
|
|
|
is => 'ro', |
143
|
|
|
|
|
|
|
isa => HashRef, |
144
|
|
|
|
|
|
|
lazy => 1, |
145
|
|
|
|
|
|
|
builder => 1, |
146
|
|
|
|
|
|
|
); |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
sub _build_services { |
149
|
86
|
|
|
86
|
|
975
|
my ( $self ) = @_; |
150
|
86
|
|
|
|
|
235
|
my $services = {}; |
151
|
86
|
|
|
|
|
1255
|
return $services; |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
#pod =attr meta_prefix |
155
|
|
|
|
|
|
|
#pod |
156
|
|
|
|
|
|
|
#pod The character that begins a meta-property inside of a service's C<args>. This |
157
|
|
|
|
|
|
|
#pod includes C<$ref>, C<$path>, C<$method>, and etc... |
158
|
|
|
|
|
|
|
#pod |
159
|
|
|
|
|
|
|
#pod The default value is C<$>. The empty string is allowed. |
160
|
|
|
|
|
|
|
#pod |
161
|
|
|
|
|
|
|
#pod =cut |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
has meta_prefix => ( |
164
|
|
|
|
|
|
|
is => 'ro', |
165
|
|
|
|
|
|
|
isa => Str, |
166
|
|
|
|
|
|
|
default => sub { q{$} }, |
167
|
|
|
|
|
|
|
); |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
#pod =method get |
170
|
|
|
|
|
|
|
#pod |
171
|
|
|
|
|
|
|
#pod my $service = $wire->get( $name ); |
172
|
|
|
|
|
|
|
#pod my $service = $wire->get( $name, %overrides ) |
173
|
|
|
|
|
|
|
#pod |
174
|
|
|
|
|
|
|
#pod The get method resolves and returns the service named C<$name>, creating |
175
|
|
|
|
|
|
|
#pod it, if necessary, with L<the create_service method|/create_service>. |
176
|
|
|
|
|
|
|
#pod |
177
|
|
|
|
|
|
|
#pod C<%overrides> is an optional list of name-value pairs. If specified, |
178
|
|
|
|
|
|
|
#pod get() will create an new, anonymous service that extends the named |
179
|
|
|
|
|
|
|
#pod service with the given config overrides. For example: |
180
|
|
|
|
|
|
|
#pod |
181
|
|
|
|
|
|
|
#pod # test.pl |
182
|
|
|
|
|
|
|
#pod use Beam::Wire; |
183
|
|
|
|
|
|
|
#pod my $wire = Beam::Wire->new( |
184
|
|
|
|
|
|
|
#pod config => { |
185
|
|
|
|
|
|
|
#pod foo => { |
186
|
|
|
|
|
|
|
#pod args => { |
187
|
|
|
|
|
|
|
#pod text => 'Hello, World!', |
188
|
|
|
|
|
|
|
#pod }, |
189
|
|
|
|
|
|
|
#pod }, |
190
|
|
|
|
|
|
|
#pod }, |
191
|
|
|
|
|
|
|
#pod ); |
192
|
|
|
|
|
|
|
#pod |
193
|
|
|
|
|
|
|
#pod my $foo = $wire->get( 'foo', args => { text => 'Hello, Chicago!' } ); |
194
|
|
|
|
|
|
|
#pod print $foo; # prints "Hello, Chicago!" |
195
|
|
|
|
|
|
|
#pod |
196
|
|
|
|
|
|
|
#pod This allows you to create factories out of any service, overriding service |
197
|
|
|
|
|
|
|
#pod configuration at run-time. |
198
|
|
|
|
|
|
|
#pod |
199
|
|
|
|
|
|
|
#pod If C<$name> contains a slash (C</>) character (e.g. C<foo/bar>), the left |
200
|
|
|
|
|
|
|
#pod side (C<foo>) will be used as the name of an inner container, and the |
201
|
|
|
|
|
|
|
#pod right side (C<bar>) is a service inside that container. For example, |
202
|
|
|
|
|
|
|
#pod these two lines are equivalent: |
203
|
|
|
|
|
|
|
#pod |
204
|
|
|
|
|
|
|
#pod $bar = $wire->get( 'foo/bar' ); |
205
|
|
|
|
|
|
|
#pod $bar = $wire->get( 'foo' )->get( 'bar' ); |
206
|
|
|
|
|
|
|
#pod |
207
|
|
|
|
|
|
|
#pod Inner containers can be nested as deeply as desired (C<foo/bar/baz/fuzz>). |
208
|
|
|
|
|
|
|
#pod |
209
|
|
|
|
|
|
|
#pod =cut |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
sub get { |
212
|
279
|
|
|
279
|
1
|
130690
|
my ( $self, $name, %override ) = @_; |
213
|
|
|
|
|
|
|
|
214
|
279
|
|
|
|
|
410
|
; print STDERR "Get service: $name\n" if DEBUG; |
215
|
|
|
|
|
|
|
|
216
|
279
|
100
|
|
|
|
914
|
if ( $name =~ q{/} ) { |
217
|
29
|
|
|
|
|
111
|
my ( $container_name, $service_name ) = split m{/}, $name, 2; |
218
|
29
|
|
|
|
|
98
|
my $container = $self->get( $container_name ); |
219
|
|
|
|
|
|
|
my $unsub_config = $container->on( configure_service => sub { |
220
|
12
|
|
|
12
|
|
7575
|
my ( $event ) = @_; |
221
|
12
|
|
|
|
|
96
|
$self->emit( configure_service => |
222
|
|
|
|
|
|
|
class => 'Beam::Wire::Event::ConfigService', |
223
|
|
|
|
|
|
|
service_name => join( '/', $container_name, $event->service_name ), |
224
|
|
|
|
|
|
|
config => $event->config, |
225
|
|
|
|
|
|
|
); |
226
|
29
|
|
|
|
|
187
|
} ); |
227
|
|
|
|
|
|
|
my $unsub_build = $container->on( build_service => sub { |
228
|
12
|
|
|
12
|
|
6871
|
my ( $event ) = @_; |
229
|
12
|
|
|
|
|
92
|
$self->emit( build_service => |
230
|
|
|
|
|
|
|
class => 'Beam::Wire::Event::BuildService', |
231
|
|
|
|
|
|
|
service_name => join( '/', $container_name, $event->service_name ), |
232
|
|
|
|
|
|
|
service => $event->service, |
233
|
|
|
|
|
|
|
); |
234
|
29
|
|
|
|
|
54111
|
} ); |
235
|
29
|
|
|
|
|
2934
|
my $service = $container->get( $service_name, %override ); |
236
|
29
|
|
|
|
|
75
|
$unsub_config->(); |
237
|
29
|
|
|
|
|
827
|
$unsub_build->(); |
238
|
29
|
|
|
|
|
774
|
return $service; |
239
|
|
|
|
|
|
|
} |
240
|
|
|
|
|
|
|
|
241
|
250
|
100
|
|
|
|
632
|
if ( keys %override ) { |
242
|
3
|
|
|
|
|
14
|
return $self->create_service( |
243
|
|
|
|
|
|
|
"\$anonymous extends $name", |
244
|
|
|
|
|
|
|
%override, |
245
|
|
|
|
|
|
|
extends => $name, |
246
|
|
|
|
|
|
|
); |
247
|
|
|
|
|
|
|
} |
248
|
|
|
|
|
|
|
|
249
|
247
|
|
|
|
|
4896
|
my $service = $self->services->{$name}; |
250
|
247
|
100
|
|
|
|
3459
|
if ( !$service ) { |
251
|
145
|
|
|
|
|
192
|
; printf STDERR 'Service "%s" does not exist. Creating.' . "\n", $name if DEBUG; |
252
|
|
|
|
|
|
|
|
253
|
145
|
|
|
|
|
389
|
my $config_ref = $self->get_config($name); |
254
|
145
|
100
|
|
|
|
1177
|
unless ( $config_ref ) { |
255
|
2
|
|
|
|
|
27
|
Beam::Wire::Exception::NotFound->throw( |
256
|
|
|
|
|
|
|
name => $name, |
257
|
|
|
|
|
|
|
file => $self->file, |
258
|
|
|
|
|
|
|
); |
259
|
|
|
|
|
|
|
} |
260
|
|
|
|
|
|
|
|
261
|
143
|
|
|
|
|
184
|
; print STDERR "Got service config: " . Dumper $config_ref if DEBUG; |
262
|
|
|
|
|
|
|
|
263
|
143
|
100
|
100
|
|
|
647
|
if ( ref $config_ref eq 'HASH' && $self->is_meta( $config_ref, 1 ) ) { |
264
|
136
|
|
|
|
|
233
|
my %config = %{ $self->normalize_config( $config_ref ) }; |
|
136
|
|
|
|
|
659
|
|
265
|
136
|
|
|
|
|
566
|
$service = $self->create_service( $name, %config ); |
266
|
129
|
100
|
100
|
|
|
509
|
if ( !$config{lifecycle} || lc $config{lifecycle} ne 'factory' ) { |
267
|
124
|
|
|
|
|
2180
|
$self->services->{$name} = $service; |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
else { |
271
|
7
|
|
|
|
|
20
|
$self->services->{$name} = $service = $self->find_refs( $name, $config_ref ); |
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
} |
274
|
|
|
|
|
|
|
|
275
|
238
|
|
|
|
|
1204
|
; print STDERR "Returning service: " . Dumper $service if DEBUG; |
276
|
|
|
|
|
|
|
|
277
|
238
|
|
|
|
|
910
|
return $service; |
278
|
|
|
|
|
|
|
} |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
#pod =method set |
281
|
|
|
|
|
|
|
#pod |
282
|
|
|
|
|
|
|
#pod $wire->set( $name => $service ); |
283
|
|
|
|
|
|
|
#pod |
284
|
|
|
|
|
|
|
#pod The set method configures and stores the specified C<$service> with the |
285
|
|
|
|
|
|
|
#pod specified C<$name>. Use this to add or replace built services. |
286
|
|
|
|
|
|
|
#pod |
287
|
|
|
|
|
|
|
#pod Like L<the get() method, above|/get>, C<$name> can contain a slash (C</>) |
288
|
|
|
|
|
|
|
#pod character to traverse through nested containers. |
289
|
|
|
|
|
|
|
#pod |
290
|
|
|
|
|
|
|
#pod =cut |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
## no critic ( ProhibitAmbiguousNames ) |
293
|
|
|
|
|
|
|
# This was named set() before I started using Perl::Critic, and will |
294
|
|
|
|
|
|
|
# continue to be named set() now that I no longer use Perl::Critic |
295
|
|
|
|
|
|
|
sub set { |
296
|
2
|
|
|
2
|
1
|
27
|
my ( $self, $name, $service ) = @_; |
297
|
2
|
100
|
|
|
|
8
|
if ( $name =~ q{/} ) { |
298
|
1
|
|
|
|
|
6
|
my ( $container_name, $service_name ) = split m{/}, $name, 2; |
299
|
1
|
|
|
|
|
4
|
return $self->get( $container_name )->set( $service_name, $service ); |
300
|
|
|
|
|
|
|
} |
301
|
1
|
|
|
|
|
16
|
$self->services->{$name} = $service; |
302
|
1
|
|
|
|
|
10
|
return; |
303
|
|
|
|
|
|
|
} |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
#pod =method get_config |
306
|
|
|
|
|
|
|
#pod |
307
|
|
|
|
|
|
|
#pod my $conf = $wire->get_config( $name ); |
308
|
|
|
|
|
|
|
#pod |
309
|
|
|
|
|
|
|
#pod Get the config with the given C<$name>. Like L<the get() method, |
310
|
|
|
|
|
|
|
#pod above|/get>, C<$name> can contain slash (C</>) characters to traverse |
311
|
|
|
|
|
|
|
#pod through nested containers. |
312
|
|
|
|
|
|
|
#pod |
313
|
|
|
|
|
|
|
#pod =cut |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
sub get_config { |
316
|
206
|
|
|
206
|
1
|
26074
|
my ( $self, $name ) = @_; |
317
|
206
|
100
|
|
|
|
590
|
if ( $name =~ q{/} ) { |
318
|
4
|
|
|
|
|
18
|
my ( $container_name, $service ) = split m{/}, $name, 2; |
319
|
4
|
|
|
|
|
8
|
my %inner_config = %{ $self->get( $container_name )->get_config( $service ) }; |
|
4
|
|
|
|
|
12
|
|
320
|
|
|
|
|
|
|
# Fix relative references to prefix the container name |
321
|
4
|
|
|
|
|
58
|
my ( $fixed_config ) = $self->fix_refs( $container_name, \%inner_config ); |
322
|
4
|
|
|
|
|
16
|
return $fixed_config; |
323
|
|
|
|
|
|
|
} |
324
|
202
|
|
|
|
|
3492
|
return $self->config->{$name}; |
325
|
|
|
|
|
|
|
} |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
#pod =method normalize_config |
328
|
|
|
|
|
|
|
#pod |
329
|
|
|
|
|
|
|
#pod my $out_conf = $self->normalize_config( $in_conf ); |
330
|
|
|
|
|
|
|
#pod |
331
|
|
|
|
|
|
|
#pod Normalize the given C<$in_conf> into to hash that L<the create_service |
332
|
|
|
|
|
|
|
#pod method|/create_service> expects. This method allows a service to be |
333
|
|
|
|
|
|
|
#pod defined with prefixed meta-names (C<$class> instead of C<class>) and |
334
|
|
|
|
|
|
|
#pod the arguments specified without prefixes. |
335
|
|
|
|
|
|
|
#pod |
336
|
|
|
|
|
|
|
#pod For example, these two services are identical. |
337
|
|
|
|
|
|
|
#pod |
338
|
|
|
|
|
|
|
#pod foo: |
339
|
|
|
|
|
|
|
#pod class: Foo |
340
|
|
|
|
|
|
|
#pod args: |
341
|
|
|
|
|
|
|
#pod fizz: buzz |
342
|
|
|
|
|
|
|
#pod |
343
|
|
|
|
|
|
|
#pod foo: |
344
|
|
|
|
|
|
|
#pod $class: Foo |
345
|
|
|
|
|
|
|
#pod fizz: buzz |
346
|
|
|
|
|
|
|
#pod |
347
|
|
|
|
|
|
|
#pod The C<$in_conf> must be a hash, and must already pass L<an is_meta |
348
|
|
|
|
|
|
|
#pod check|/is_meta>. |
349
|
|
|
|
|
|
|
#pod |
350
|
|
|
|
|
|
|
#pod =cut |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
sub normalize_config { |
353
|
178
|
|
|
178
|
1
|
377
|
my ( $self, $conf ) = @_; |
354
|
|
|
|
|
|
|
|
355
|
178
|
|
|
|
|
220
|
; print STDERR "In conf: " . Dumper $conf if DEBUG; |
356
|
|
|
|
|
|
|
|
357
|
178
|
|
|
|
|
348
|
my %meta = reverse $self->get_meta_names; |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
# Confs without prefixed keys can be used as-is |
360
|
178
|
100
|
|
|
|
577
|
return $conf if !grep { $meta{ $_ } } keys %$conf; |
|
333
|
|
|
|
|
1306
|
|
361
|
|
|
|
|
|
|
|
362
|
15
|
|
|
|
|
28
|
my %out_conf; |
363
|
15
|
|
|
|
|
44
|
for my $key ( keys %$conf ) { |
364
|
26
|
100
|
|
|
|
59
|
if ( $meta{ $key } ) { |
365
|
19
|
|
|
|
|
58
|
$out_conf{ $meta{ $key } } = $conf->{ $key }; |
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
else { |
368
|
7
|
|
|
|
|
19
|
$out_conf{ args }{ $key } = $conf->{ $key }; |
369
|
|
|
|
|
|
|
} |
370
|
|
|
|
|
|
|
} |
371
|
|
|
|
|
|
|
|
372
|
15
|
|
|
|
|
24
|
; print STDERR "Out conf: " . Dumper \%out_conf if DEBUG; |
373
|
|
|
|
|
|
|
|
374
|
15
|
|
|
|
|
82
|
return \%out_conf; |
375
|
|
|
|
|
|
|
} |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
#pod =method create_service |
378
|
|
|
|
|
|
|
#pod |
379
|
|
|
|
|
|
|
#pod my $service = $wire->create_service( $name, %config ); |
380
|
|
|
|
|
|
|
#pod |
381
|
|
|
|
|
|
|
#pod Create the service with the given C<$name> and C<%config>. Config can |
382
|
|
|
|
|
|
|
#pod contain the following keys: |
383
|
|
|
|
|
|
|
#pod |
384
|
|
|
|
|
|
|
#pod =over 4 |
385
|
|
|
|
|
|
|
#pod |
386
|
|
|
|
|
|
|
#pod =item class |
387
|
|
|
|
|
|
|
#pod |
388
|
|
|
|
|
|
|
#pod The class name of an object to create. Can be combined with C<method>, |
389
|
|
|
|
|
|
|
#pod and C<args>. An object of any class can be created with Beam::Wire. |
390
|
|
|
|
|
|
|
#pod |
391
|
|
|
|
|
|
|
#pod =item args |
392
|
|
|
|
|
|
|
#pod |
393
|
|
|
|
|
|
|
#pod The arguments to the constructor method. Used with C<class> and |
394
|
|
|
|
|
|
|
#pod C<method>. Can be a simple value, or a reference to an array or |
395
|
|
|
|
|
|
|
#pod hash which will be dereferenced and passed in to the constructor |
396
|
|
|
|
|
|
|
#pod as a list. |
397
|
|
|
|
|
|
|
#pod |
398
|
|
|
|
|
|
|
#pod If the C<class> consumes the L<Beam::Service role|Beam::Service>, |
399
|
|
|
|
|
|
|
#pod the service's C<name> and C<container> will be added to the C<args>. |
400
|
|
|
|
|
|
|
#pod |
401
|
|
|
|
|
|
|
#pod =item method |
402
|
|
|
|
|
|
|
#pod |
403
|
|
|
|
|
|
|
#pod The method to call to create the object. Only used with C<class>. |
404
|
|
|
|
|
|
|
#pod Defaults to C<"new">. |
405
|
|
|
|
|
|
|
#pod |
406
|
|
|
|
|
|
|
#pod This can also be an array of hashes which describe a list of methods |
407
|
|
|
|
|
|
|
#pod that will be called on the object. The first method should create the |
408
|
|
|
|
|
|
|
#pod object, and each subsequent method can be used to modify the object. The |
409
|
|
|
|
|
|
|
#pod hashes should contain a C<method> key, which is a string containing the |
410
|
|
|
|
|
|
|
#pod method to call, and optionally C<args> and C<return> keys. The C<args> |
411
|
|
|
|
|
|
|
#pod key works like the top-level C<args> key, above. The optional C<return> |
412
|
|
|
|
|
|
|
#pod key can have the special value C<"chain">, which will use the return |
413
|
|
|
|
|
|
|
#pod value from the method as the value for the service (L<The tutorial shows |
414
|
|
|
|
|
|
|
#pod examples of this|Beam::Wire::Help::Config/Multiple Constructor |
415
|
|
|
|
|
|
|
#pod Methods>). |
416
|
|
|
|
|
|
|
#pod |
417
|
|
|
|
|
|
|
#pod If an array is used, the top-level C<args> key is not used. |
418
|
|
|
|
|
|
|
#pod |
419
|
|
|
|
|
|
|
#pod =item value |
420
|
|
|
|
|
|
|
#pod |
421
|
|
|
|
|
|
|
#pod The value of this service. Can be a simple value, or a reference to an |
422
|
|
|
|
|
|
|
#pod array or hash. This value will be simply returned by this method, and is |
423
|
|
|
|
|
|
|
#pod mostly useful when using container files. |
424
|
|
|
|
|
|
|
#pod |
425
|
|
|
|
|
|
|
#pod C<value> can not be used with C<class> or C<extends>. |
426
|
|
|
|
|
|
|
#pod |
427
|
|
|
|
|
|
|
#pod =item config |
428
|
|
|
|
|
|
|
#pod |
429
|
|
|
|
|
|
|
#pod The path to a configuration file, relative to L<the dir attribute|/dir>. |
430
|
|
|
|
|
|
|
#pod The file will be read with L<Config::Any>, and the resulting data |
431
|
|
|
|
|
|
|
#pod structure returned. |
432
|
|
|
|
|
|
|
#pod |
433
|
|
|
|
|
|
|
#pod =item extends |
434
|
|
|
|
|
|
|
#pod |
435
|
|
|
|
|
|
|
#pod The name of a service to extend. The named service's configuration will |
436
|
|
|
|
|
|
|
#pod be merged with this configuration (via L<the merge_config |
437
|
|
|
|
|
|
|
#pod method|/merge_config>). |
438
|
|
|
|
|
|
|
#pod |
439
|
|
|
|
|
|
|
#pod This can be used in place of the C<class> key if the extended configuration |
440
|
|
|
|
|
|
|
#pod contains a class. |
441
|
|
|
|
|
|
|
#pod |
442
|
|
|
|
|
|
|
#pod =item with |
443
|
|
|
|
|
|
|
#pod |
444
|
|
|
|
|
|
|
#pod Compose a role into the object's class before creating the object. This |
445
|
|
|
|
|
|
|
#pod can be a single string, or an array reference of strings which are roles |
446
|
|
|
|
|
|
|
#pod to combine. |
447
|
|
|
|
|
|
|
#pod |
448
|
|
|
|
|
|
|
#pod This uses L<Moo::Role|Moo::Role> and L<the create_class_with_roles |
449
|
|
|
|
|
|
|
#pod method|Role::Tiny/create_class_with_roles>, which should work with any |
450
|
|
|
|
|
|
|
#pod class (as it uses L<the Role::Tiny module|Role::Tiny> under the hood). |
451
|
|
|
|
|
|
|
#pod |
452
|
|
|
|
|
|
|
#pod This can be used with the C<class> key. |
453
|
|
|
|
|
|
|
#pod |
454
|
|
|
|
|
|
|
#pod =item on |
455
|
|
|
|
|
|
|
#pod |
456
|
|
|
|
|
|
|
#pod Attach an event handler to a L<Beam::Emitter subclass|Beam::Emitter>. This |
457
|
|
|
|
|
|
|
#pod is an array of hashes of event names and handlers. A handler is made from |
458
|
|
|
|
|
|
|
#pod a service reference (C<$ref> or an anonymous service), and a subroutine to |
459
|
|
|
|
|
|
|
#pod call on that service (C<$sub>). |
460
|
|
|
|
|
|
|
#pod |
461
|
|
|
|
|
|
|
#pod For example: |
462
|
|
|
|
|
|
|
#pod |
463
|
|
|
|
|
|
|
#pod emitter: |
464
|
|
|
|
|
|
|
#pod class: My::Emitter |
465
|
|
|
|
|
|
|
#pod on: |
466
|
|
|
|
|
|
|
#pod - my_event: |
467
|
|
|
|
|
|
|
#pod $ref: my_handler |
468
|
|
|
|
|
|
|
#pod $sub: on_my_event |
469
|
|
|
|
|
|
|
#pod |
470
|
|
|
|
|
|
|
#pod This can be used with the C<class> key. |
471
|
|
|
|
|
|
|
#pod |
472
|
|
|
|
|
|
|
#pod =back |
473
|
|
|
|
|
|
|
#pod |
474
|
|
|
|
|
|
|
#pod This method uses L<the parse_args method|/parse_args> to parse the C<args> key, |
475
|
|
|
|
|
|
|
#pod L<resolving references|resolve_ref> as needed. |
476
|
|
|
|
|
|
|
#pod |
477
|
|
|
|
|
|
|
#pod =cut |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
sub create_service { |
480
|
152
|
|
|
152
|
1
|
15581
|
my ( $self, $name, %service_info ) = @_; |
481
|
|
|
|
|
|
|
|
482
|
152
|
|
|
|
|
199
|
; print STDERR "Creating service: " . Dumper \%service_info if DEBUG; |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
# Compose the parent ref into the copy, in case the parent changes |
485
|
152
|
|
|
|
|
439
|
%service_info = $self->merge_config( %service_info ); |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
# value and class/extends are mutually exclusive |
488
|
|
|
|
|
|
|
# must check after merge_config in case parent config has class/value |
489
|
150
|
100
|
100
|
|
|
433
|
if ( exists $service_info{value} && ( |
|
|
|
100
|
|
|
|
|
490
|
|
|
|
|
|
|
exists $service_info{class} || exists $service_info{extends} |
491
|
|
|
|
|
|
|
) |
492
|
|
|
|
|
|
|
) { |
493
|
6
|
|
|
|
|
36
|
Beam::Wire::Exception::InvalidConfig->throw( |
494
|
|
|
|
|
|
|
name => $name, |
495
|
|
|
|
|
|
|
file => $self->file, |
496
|
|
|
|
|
|
|
error => '"value" cannot be used with "class" or "extends"', |
497
|
|
|
|
|
|
|
); |
498
|
|
|
|
|
|
|
} |
499
|
144
|
100
|
|
|
|
323
|
if ( $service_info{value} ) { |
500
|
2
|
|
|
|
|
7
|
return $service_info{value}; |
501
|
|
|
|
|
|
|
} |
502
|
|
|
|
|
|
|
|
503
|
142
|
100
|
|
|
|
356
|
if ( $service_info{config} ) { |
504
|
7
|
|
|
|
|
25
|
my $conf_path = path( $service_info{config} ); |
505
|
7
|
100
|
|
|
|
230
|
if ( $self->file ) { |
506
|
2
|
|
|
|
|
7
|
$conf_path = path( $self->file )->parent->child( $conf_path ); |
507
|
|
|
|
|
|
|
} |
508
|
7
|
|
|
|
|
248
|
return $self->_load_config( "$conf_path" ); |
509
|
|
|
|
|
|
|
} |
510
|
|
|
|
|
|
|
|
511
|
135
|
100
|
|
|
|
288
|
if ( !$service_info{class} ) { |
512
|
2
|
|
|
|
|
25
|
Beam::Wire::Exception::InvalidConfig->throw( |
513
|
|
|
|
|
|
|
name => $name, |
514
|
|
|
|
|
|
|
file => $self->file, |
515
|
|
|
|
|
|
|
error => 'Service configuration incomplete. Missing one of "class", "value", "config"', |
516
|
|
|
|
|
|
|
); |
517
|
|
|
|
|
|
|
} |
518
|
|
|
|
|
|
|
|
519
|
133
|
|
|
|
|
587
|
$self->emit( configure_service => |
520
|
|
|
|
|
|
|
class => 'Beam::Wire::Event::ConfigService', |
521
|
|
|
|
|
|
|
service_name => $name, |
522
|
|
|
|
|
|
|
config => \%service_info, |
523
|
|
|
|
|
|
|
); |
524
|
|
|
|
|
|
|
|
525
|
133
|
|
|
|
|
112360
|
use_module( $service_info{class} ); |
526
|
|
|
|
|
|
|
|
527
|
133
|
100
|
|
|
|
57804
|
if ( my $with = $service_info{with} ) { |
528
|
4
|
100
|
|
|
|
16
|
my @roles = ref $with ? @{ $with } : ( $with ); |
|
2
|
|
|
|
|
8
|
|
529
|
4
|
|
|
|
|
32
|
my $class = Moo::Role->create_class_with_roles( $service_info{class}, @roles ); |
530
|
4
|
|
|
|
|
8787
|
$service_info{class} = $class; |
531
|
|
|
|
|
|
|
} |
532
|
|
|
|
|
|
|
|
533
|
133
|
|
100
|
|
|
558
|
my $method = $service_info{method} || "new"; |
534
|
133
|
|
|
|
|
196
|
my $service; |
535
|
133
|
100
|
|
|
|
404
|
if ( ref $method eq 'ARRAY' ) { |
536
|
2
|
|
|
|
|
3
|
for my $m ( @{$method} ) { |
|
2
|
|
|
|
|
5
|
|
537
|
4
|
|
|
|
|
7
|
my $method_name = $m->{method}; |
538
|
4
|
|
100
|
|
|
12
|
my $return = $m->{return} || q{}; |
539
|
4
|
|
|
|
|
15
|
delete $service_info{args}; |
540
|
4
|
|
|
|
|
13
|
my @args = $self->parse_args( $name, $service_info{class}, $m->{args} ); |
541
|
4
|
|
66
|
|
|
13
|
my $invocant = $service || $service_info{class}; |
542
|
4
|
|
|
|
|
48
|
my $output = $invocant->$method_name( @args ); |
543
|
4
|
100
|
100
|
|
|
138
|
$service = !$service || $return eq 'chain' ? $output |
544
|
|
|
|
|
|
|
: $service; |
545
|
|
|
|
|
|
|
} |
546
|
|
|
|
|
|
|
} |
547
|
|
|
|
|
|
|
else { |
548
|
131
|
|
|
|
|
531
|
my @args = $self->parse_args( $name, @service_info{"class","args"} ); |
549
|
131
|
100
|
66
|
|
|
1685
|
if ( $service_info{class}->can( 'DOES' ) && $service_info{class}->DOES( 'Beam::Service' ) ) { |
550
|
1
|
|
|
|
|
21
|
push @args, name => $name, container => $self; |
551
|
|
|
|
|
|
|
} |
552
|
131
|
|
|
|
|
2862
|
$service = $service_info{class}->$method( @args ); |
553
|
|
|
|
|
|
|
} |
554
|
|
|
|
|
|
|
|
555
|
132
|
100
|
|
|
|
41519
|
if ( $service_info{on} ) { |
556
|
7
|
|
|
|
|
34
|
my %meta = $self->get_meta_names; |
557
|
7
|
|
|
|
|
20
|
my @listeners; |
558
|
|
|
|
|
|
|
|
559
|
7
|
100
|
|
|
|
39
|
if ( ref $service_info{on} eq 'ARRAY' ) { |
|
|
50
|
|
|
|
|
|
560
|
1
|
|
|
|
|
3
|
@listeners = map { [ %$_ ] } @{ $service_info{on} }; |
|
2
|
|
|
|
|
8
|
|
|
1
|
|
|
|
|
3
|
|
561
|
|
|
|
|
|
|
} |
562
|
|
|
|
|
|
|
elsif ( ref $service_info{on} eq 'HASH' ) { |
563
|
6
|
|
|
|
|
12
|
for my $event ( keys %{ $service_info{on} } ) { |
|
6
|
|
|
|
|
23
|
|
564
|
6
|
100
|
|
|
|
22
|
if ( ref $service_info{on}{$event} eq 'ARRAY' ) { |
565
|
|
|
|
|
|
|
push @listeners, |
566
|
2
|
|
|
|
|
6
|
map {; [ $event => $_ ] } |
567
|
1
|
|
|
|
|
3
|
@{ $service_info{on}{$event} }; |
|
1
|
|
|
|
|
3
|
|
568
|
|
|
|
|
|
|
} |
569
|
|
|
|
|
|
|
else { |
570
|
5
|
|
|
|
|
19
|
push @listeners, [ $event => $service_info{on}{$event} ]; |
571
|
|
|
|
|
|
|
} |
572
|
|
|
|
|
|
|
} |
573
|
|
|
|
|
|
|
} |
574
|
|
|
|
|
|
|
|
575
|
7
|
|
|
|
|
17
|
for my $listener ( @listeners ) { |
576
|
9
|
|
|
|
|
256
|
my ( $event, $conf ) = @$listener; |
577
|
9
|
100
|
66
|
|
|
34
|
if ( $conf->{ $meta{method} } && !$conf->{ $meta{sub} } ) { |
578
|
1
|
|
|
|
|
5
|
_deprecated( 'warning: (deprecated) "$method" in event handlers is now "$sub" in service "' . $name . '"' ); |
579
|
|
|
|
|
|
|
} |
580
|
9
|
|
100
|
|
|
47
|
my $sub_name = delete $conf->{ $meta{sub} } || delete $conf->{ $meta{method} }; |
581
|
9
|
|
|
|
|
34
|
my ( $listen_svc ) = $self->find_refs( $name, $conf ); |
582
|
9
|
|
|
8
|
|
61
|
$service->on( $event => sub { $listen_svc->$sub_name( @_ ) } ); |
|
8
|
|
|
|
|
13240
|
|
583
|
|
|
|
|
|
|
} |
584
|
|
|
|
|
|
|
} |
585
|
|
|
|
|
|
|
|
586
|
132
|
|
|
|
|
97866
|
$self->emit( build_service => |
587
|
|
|
|
|
|
|
class => 'Beam::Wire::Event::BuildService', |
588
|
|
|
|
|
|
|
service_name => $name, |
589
|
|
|
|
|
|
|
service => $service, |
590
|
|
|
|
|
|
|
); |
591
|
|
|
|
|
|
|
|
592
|
132
|
|
|
|
|
104195
|
return $service; |
593
|
|
|
|
|
|
|
} |
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
#pod =method merge_config |
596
|
|
|
|
|
|
|
#pod |
597
|
|
|
|
|
|
|
#pod my %merged = $wire->merge_config( %config ); |
598
|
|
|
|
|
|
|
#pod |
599
|
|
|
|
|
|
|
#pod If C<%config> contains an C<extends> key, merge the extended config together |
600
|
|
|
|
|
|
|
#pod with this one, returning the merged service configuration. This works recursively, |
601
|
|
|
|
|
|
|
#pod so a service can extend a service that extends another service just fine. |
602
|
|
|
|
|
|
|
#pod |
603
|
|
|
|
|
|
|
#pod When merging, hashes are combined, with the child configuration taking |
604
|
|
|
|
|
|
|
#pod precedence. The C<args> key is handled specially to allow a hash of |
605
|
|
|
|
|
|
|
#pod args to be merged. |
606
|
|
|
|
|
|
|
#pod |
607
|
|
|
|
|
|
|
#pod The configuration returned is a safe copy and can be modified without |
608
|
|
|
|
|
|
|
#pod effecting the original config. |
609
|
|
|
|
|
|
|
#pod |
610
|
|
|
|
|
|
|
#pod =cut |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
sub merge_config { |
613
|
190
|
|
|
190
|
1
|
443
|
my ( $self, %service_info ) = @_; |
614
|
190
|
100
|
|
|
|
434
|
if ( $service_info{ extends } ) { |
615
|
37
|
|
|
|
|
96
|
my $base_config_ref = $self->get_config( $service_info{extends} ); |
616
|
37
|
100
|
|
|
|
281
|
unless ( $base_config_ref ) { |
617
|
|
|
|
|
|
|
Beam::Wire::Exception::NotFound->throw( |
618
|
|
|
|
|
|
|
name => $service_info{extends}, |
619
|
3
|
|
|
|
|
29
|
file => $self->file, |
620
|
|
|
|
|
|
|
); |
621
|
|
|
|
|
|
|
} |
622
|
34
|
|
|
|
|
87
|
my %base_config = %{ $self->normalize_config( $base_config_ref ) }; |
|
34
|
|
|
|
|
73
|
|
623
|
|
|
|
|
|
|
# Merge the args separately, to be a bit nicer about hashes of arguments |
624
|
34
|
|
|
|
|
59
|
my $args; |
625
|
34
|
100
|
100
|
|
|
139
|
if ( ref $service_info{args} eq 'HASH' && ref $base_config{args} eq 'HASH' ) { |
626
|
8
|
|
|
|
|
17
|
$args = { %{ delete $base_config{args} }, %{ delete $service_info{args} } }; |
|
8
|
|
|
|
|
23
|
|
|
8
|
|
|
|
|
27
|
|
627
|
|
|
|
|
|
|
} |
628
|
34
|
|
|
|
|
122
|
%service_info = ( $self->merge_config( %base_config ), %service_info ); |
629
|
34
|
100
|
|
|
|
101
|
if ( $args ) { |
630
|
8
|
|
|
|
|
17
|
$service_info{args} = $args; |
631
|
|
|
|
|
|
|
} |
632
|
|
|
|
|
|
|
} |
633
|
187
|
|
|
|
|
610
|
return %service_info; |
634
|
|
|
|
|
|
|
} |
635
|
|
|
|
|
|
|
|
636
|
|
|
|
|
|
|
#pod =method parse_args |
637
|
|
|
|
|
|
|
#pod |
638
|
|
|
|
|
|
|
#pod my @args = $wire->parse_args( $for_name, $class, $args ); |
639
|
|
|
|
|
|
|
#pod |
640
|
|
|
|
|
|
|
#pod Parse the arguments (C<$args>) for the given service (C<$for_name>) with |
641
|
|
|
|
|
|
|
#pod the given class (C<$class>). |
642
|
|
|
|
|
|
|
#pod |
643
|
|
|
|
|
|
|
#pod C<$args> can be an array reference, a hash reference, or a simple |
644
|
|
|
|
|
|
|
#pod scalar. The arguments will be searched for references using L<the |
645
|
|
|
|
|
|
|
#pod find_refs method|/find_refs>, and then a list of arguments will be |
646
|
|
|
|
|
|
|
#pod returned, ready to pass to the object's constructor. |
647
|
|
|
|
|
|
|
#pod |
648
|
|
|
|
|
|
|
#pod Nested containers are handled specially by this method: Their inner |
649
|
|
|
|
|
|
|
#pod references are not resolved by the parent container. This ensures that |
650
|
|
|
|
|
|
|
#pod references are always relative to the container they're in. |
651
|
|
|
|
|
|
|
#pod |
652
|
|
|
|
|
|
|
#pod =cut |
653
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
sub parse_args { |
655
|
135
|
|
|
135
|
1
|
323
|
my ( $self, $for, $class, $args ) = @_; |
656
|
135
|
100
|
|
|
|
327
|
return if not $args; |
657
|
111
|
|
|
|
|
156
|
my @args; |
658
|
111
|
100
|
|
|
|
361
|
if ( ref $args eq 'ARRAY' ) { |
|
|
100
|
|
|
|
|
|
659
|
20
|
|
|
|
|
40
|
@args = $self->find_refs( $for, @{$args} ); |
|
20
|
|
|
|
|
51
|
|
660
|
|
|
|
|
|
|
} |
661
|
|
|
|
|
|
|
elsif ( ref $args eq 'HASH' ) { |
662
|
|
|
|
|
|
|
# Hash args could be a ref |
663
|
|
|
|
|
|
|
# Subcontainers cannot scan for refs in their configs |
664
|
86
|
100
|
|
|
|
693
|
if ( $class->isa( 'Beam::Wire' ) ) { |
665
|
8
|
|
|
|
|
17
|
my %args = %{$args}; |
|
8
|
|
|
|
|
35
|
|
666
|
8
|
|
|
|
|
23
|
my $config = delete $args{config}; |
667
|
|
|
|
|
|
|
# Relative subcontainer files should be from the current |
668
|
|
|
|
|
|
|
# container's directory |
669
|
8
|
100
|
100
|
|
|
52
|
if ( exists $args{file} && !path( $args{file} )->is_absolute ) { |
670
|
2
|
|
|
|
|
201
|
$args{file} = $self->dir->child( $args{file} ); |
671
|
|
|
|
|
|
|
} |
672
|
8
|
|
|
|
|
325
|
@args = $self->find_refs( $for, %args ); |
673
|
8
|
100
|
|
|
|
29
|
if ( $config ) { |
674
|
2
|
|
|
|
|
5
|
push @args, config => $config; |
675
|
|
|
|
|
|
|
} |
676
|
|
|
|
|
|
|
} |
677
|
|
|
|
|
|
|
else { |
678
|
78
|
|
|
|
|
266
|
my ( $maybe_ref ) = $self->find_refs( $for, $args ); |
679
|
78
|
50
|
|
|
|
264
|
if ( blessed $maybe_ref ) { |
680
|
0
|
|
|
|
|
0
|
@args = ( $maybe_ref ); |
681
|
|
|
|
|
|
|
} |
682
|
|
|
|
|
|
|
else { |
683
|
78
|
0
|
|
|
|
406
|
@args = ref $maybe_ref eq 'HASH' ? %$maybe_ref |
|
|
50
|
|
|
|
|
|
684
|
|
|
|
|
|
|
: ref $maybe_ref eq 'ARRAY' ? @$maybe_ref |
685
|
|
|
|
|
|
|
: ( $maybe_ref ); |
686
|
|
|
|
|
|
|
} |
687
|
|
|
|
|
|
|
} |
688
|
|
|
|
|
|
|
} |
689
|
|
|
|
|
|
|
else { |
690
|
|
|
|
|
|
|
# Try anyway? |
691
|
5
|
|
|
|
|
8
|
@args = $args; |
692
|
|
|
|
|
|
|
} |
693
|
|
|
|
|
|
|
|
694
|
111
|
|
|
|
|
291
|
return @args; |
695
|
|
|
|
|
|
|
} |
696
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
#pod =method find_refs |
698
|
|
|
|
|
|
|
#pod |
699
|
|
|
|
|
|
|
#pod my @resolved = $wire->find_refs( $for_name, @args ); |
700
|
|
|
|
|
|
|
#pod |
701
|
|
|
|
|
|
|
#pod Go through the C<@args> and recursively resolve any references and |
702
|
|
|
|
|
|
|
#pod services found inside, returning the resolved result. References are |
703
|
|
|
|
|
|
|
#pod identified with L<the is_meta method|/is_meta>. |
704
|
|
|
|
|
|
|
#pod |
705
|
|
|
|
|
|
|
#pod If a reference contains a C<$ref> key, it will be resolved by L<the |
706
|
|
|
|
|
|
|
#pod resolve_ref method|/resolve_ref>. Otherwise, the reference will be |
707
|
|
|
|
|
|
|
#pod treated as an anonymous service, and passed directly to L<the |
708
|
|
|
|
|
|
|
#pod create_service method|/create_service>. |
709
|
|
|
|
|
|
|
#pod |
710
|
|
|
|
|
|
|
#pod This is used when L<creating a service|create_service> to ensure all |
711
|
|
|
|
|
|
|
#pod dependencies are created first. |
712
|
|
|
|
|
|
|
#pod |
713
|
|
|
|
|
|
|
#pod =cut |
714
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
sub find_refs { |
716
|
245
|
|
|
245
|
1
|
550
|
my ( $self, $for, @args ) = @_; |
717
|
|
|
|
|
|
|
|
718
|
245
|
|
|
|
|
285
|
; printf STDERR qq{Searching for refs for "%s": %s}, $for, Dumper \@args if DEBUG; |
719
|
|
|
|
|
|
|
|
720
|
245
|
|
|
|
|
325
|
my @out; |
721
|
245
|
|
|
|
|
416
|
my %meta = $self->get_meta_names; |
722
|
245
|
|
|
|
|
657
|
for my $arg ( @args ) { |
723
|
369
|
100
|
|
|
|
766
|
if ( ref $arg eq 'HASH' ) { |
|
|
100
|
|
|
|
|
|
724
|
137
|
100
|
|
|
|
261
|
if ( $self->is_meta( $arg ) ) { |
725
|
44
|
100
|
|
|
|
173
|
if ( $arg->{ $meta{ ref } } ) { |
726
|
36
|
|
|
|
|
126
|
push @out, $self->resolve_ref( $for, $arg ); |
727
|
|
|
|
|
|
|
} |
728
|
|
|
|
|
|
|
else { # Try to treat it as a service to create |
729
|
8
|
|
|
|
|
13
|
; print STDERR "Creating anonymous service: " . Dumper $arg if DEBUG; |
730
|
|
|
|
|
|
|
|
731
|
8
|
|
|
|
|
13
|
my %service_info = %{ $self->normalize_config( $arg ) }; |
|
8
|
|
|
|
|
26
|
|
732
|
8
|
|
|
|
|
77
|
push @out, $self->create_service( '$anonymous', %service_info ); |
733
|
|
|
|
|
|
|
} |
734
|
|
|
|
|
|
|
} |
735
|
|
|
|
|
|
|
else { |
736
|
93
|
|
|
|
|
175
|
push @out, { $self->find_refs( $for, %{$arg} ) }; |
|
93
|
|
|
|
|
357
|
|
737
|
|
|
|
|
|
|
} |
738
|
|
|
|
|
|
|
} |
739
|
|
|
|
|
|
|
elsif ( ref $arg eq 'ARRAY' ) { |
740
|
13
|
|
|
|
|
22
|
push @out, [ map { $self->find_refs( $for, $_ ) } @{$arg} ]; |
|
30
|
|
|
|
|
58
|
|
|
13
|
|
|
|
|
25
|
|
741
|
|
|
|
|
|
|
} |
742
|
|
|
|
|
|
|
else { |
743
|
219
|
|
|
|
|
392
|
push @out, $arg; # simple scalars |
744
|
|
|
|
|
|
|
} |
745
|
|
|
|
|
|
|
} |
746
|
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
# In case we only pass in one argument and want one return value |
748
|
245
|
100
|
|
|
|
1201
|
return wantarray ? @out : $out[-1]; |
749
|
|
|
|
|
|
|
} |
750
|
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
#pod =method is_meta |
752
|
|
|
|
|
|
|
#pod |
753
|
|
|
|
|
|
|
#pod my $is_meta = $wire->is_meta( $ref_hash, $root ); |
754
|
|
|
|
|
|
|
#pod |
755
|
|
|
|
|
|
|
#pod Returns true if the given hash reference describes some kind of |
756
|
|
|
|
|
|
|
#pod Beam::Wire service. This is used to identify service configuration |
757
|
|
|
|
|
|
|
#pod hashes inside of larger data structures. |
758
|
|
|
|
|
|
|
#pod |
759
|
|
|
|
|
|
|
#pod A service hash reference must contain at least one key, and must either |
760
|
|
|
|
|
|
|
#pod contain a L<prefixed|/meta_prefix> key that could create or reference an |
761
|
|
|
|
|
|
|
#pod object (one of C<class>, C<extends>, C<config>, C<value>, or C<ref>) or, |
762
|
|
|
|
|
|
|
#pod if the C<$root> flag exists, be made completely of unprefixed meta keys |
763
|
|
|
|
|
|
|
#pod (as returned by L<the get_meta_names method|/get_meta_names>). |
764
|
|
|
|
|
|
|
#pod |
765
|
|
|
|
|
|
|
#pod The C<$root> flag is used by L<the get method|/get> to allow unprefixed |
766
|
|
|
|
|
|
|
#pod meta keys in the top-level hash values. |
767
|
|
|
|
|
|
|
#pod |
768
|
|
|
|
|
|
|
#pod =cut |
769
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
sub is_meta { |
771
|
301
|
|
|
301
|
1
|
2028
|
my ( $self, $arg, $root ) = @_; |
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
# Only a hashref can be meta |
774
|
301
|
50
|
|
|
|
672
|
return unless ref $arg eq 'HASH'; |
775
|
|
|
|
|
|
|
|
776
|
301
|
|
|
|
|
858
|
my @keys = keys %$arg; |
777
|
301
|
100
|
|
|
|
627
|
return unless @keys; |
778
|
|
|
|
|
|
|
|
779
|
298
|
|
|
|
|
587
|
my %meta = $self->get_meta_names; |
780
|
298
|
|
|
|
|
1400
|
my %meta_names = map { $_ => 1 } values %meta; |
|
3874
|
|
|
|
|
6540
|
|
781
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
# A regular service does not need the prefix, but must consist |
783
|
|
|
|
|
|
|
# only of meta keys |
784
|
298
|
100
|
100
|
|
|
1066
|
return 1 if $root && scalar @keys eq grep { $meta{ $_ } } @keys; |
|
286
|
|
|
|
|
1555
|
|
785
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
# A meta service contains at least one of these keys, as these are |
787
|
|
|
|
|
|
|
# the keys that can create a service. All other keys are |
788
|
|
|
|
|
|
|
# modifiers |
789
|
|
|
|
|
|
|
return 1 |
790
|
795
|
|
|
|
|
1606
|
if grep { exists $arg->{ $_ } } |
791
|
159
|
100
|
|
|
|
307
|
map { $meta{ $_ } } |
|
795
|
|
|
|
|
1281
|
|
792
|
|
|
|
|
|
|
qw( ref class extends config value ); |
793
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
# Must not be meta |
795
|
101
|
|
|
|
|
532
|
return; |
796
|
|
|
|
|
|
|
} |
797
|
|
|
|
|
|
|
|
798
|
|
|
|
|
|
|
#pod =method get_meta_names |
799
|
|
|
|
|
|
|
#pod |
800
|
|
|
|
|
|
|
#pod my %meta_keys = $wire->get_meta_names; |
801
|
|
|
|
|
|
|
#pod |
802
|
|
|
|
|
|
|
#pod Get all the possible service keys with the L<meta prefix|/meta_prefix> already |
803
|
|
|
|
|
|
|
#pod attached. |
804
|
|
|
|
|
|
|
#pod |
805
|
|
|
|
|
|
|
#pod =cut |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
sub get_meta_names { |
808
|
878
|
|
|
878
|
1
|
1262
|
my ( $self ) = @_; |
809
|
878
|
|
|
|
|
1566
|
my $prefix = $self->meta_prefix; |
810
|
878
|
|
|
|
|
6629
|
my %meta = ( |
811
|
|
|
|
|
|
|
ref => "${prefix}ref", |
812
|
|
|
|
|
|
|
path => "${prefix}path", |
813
|
|
|
|
|
|
|
method => "${prefix}method", |
814
|
|
|
|
|
|
|
args => "${prefix}args", |
815
|
|
|
|
|
|
|
class => "${prefix}class", |
816
|
|
|
|
|
|
|
extends => "${prefix}extends", |
817
|
|
|
|
|
|
|
sub => "${prefix}sub", |
818
|
|
|
|
|
|
|
call => "${prefix}call", |
819
|
|
|
|
|
|
|
lifecycle => "${prefix}lifecycle", |
820
|
|
|
|
|
|
|
on => "${prefix}on", |
821
|
|
|
|
|
|
|
with => "${prefix}with", |
822
|
|
|
|
|
|
|
value => "${prefix}value", |
823
|
|
|
|
|
|
|
config => "${prefix}config", |
824
|
|
|
|
|
|
|
); |
825
|
878
|
50
|
|
|
|
7433
|
return wantarray ? %meta : \%meta; |
826
|
|
|
|
|
|
|
} |
827
|
|
|
|
|
|
|
|
828
|
|
|
|
|
|
|
#pod =method resolve_ref |
829
|
|
|
|
|
|
|
#pod |
830
|
|
|
|
|
|
|
#pod my @value = $wire->resolve_ref( $for_name, $ref_hash ); |
831
|
|
|
|
|
|
|
#pod |
832
|
|
|
|
|
|
|
#pod Resolves the given dependency from the configuration hash (C<$ref_hash>) |
833
|
|
|
|
|
|
|
#pod for the named service (C<$for_name>). Reference hashes contain the |
834
|
|
|
|
|
|
|
#pod following keys: |
835
|
|
|
|
|
|
|
#pod |
836
|
|
|
|
|
|
|
#pod =over 4 |
837
|
|
|
|
|
|
|
#pod |
838
|
|
|
|
|
|
|
#pod =item $ref |
839
|
|
|
|
|
|
|
#pod |
840
|
|
|
|
|
|
|
#pod The name of a service in the container. Required. |
841
|
|
|
|
|
|
|
#pod |
842
|
|
|
|
|
|
|
#pod =item $path |
843
|
|
|
|
|
|
|
#pod |
844
|
|
|
|
|
|
|
#pod A data path to pick some data out of the reference. Useful with C<value> |
845
|
|
|
|
|
|
|
#pod and C<config> services. |
846
|
|
|
|
|
|
|
#pod |
847
|
|
|
|
|
|
|
#pod # container.yml |
848
|
|
|
|
|
|
|
#pod bounties: |
849
|
|
|
|
|
|
|
#pod value: |
850
|
|
|
|
|
|
|
#pod malcolm: 50000 |
851
|
|
|
|
|
|
|
#pod zoe: 35000 |
852
|
|
|
|
|
|
|
#pod simon: 100000 |
853
|
|
|
|
|
|
|
#pod |
854
|
|
|
|
|
|
|
#pod captain: |
855
|
|
|
|
|
|
|
#pod class: Person |
856
|
|
|
|
|
|
|
#pod args: |
857
|
|
|
|
|
|
|
#pod name: Malcolm Reynolds |
858
|
|
|
|
|
|
|
#pod bounty: |
859
|
|
|
|
|
|
|
#pod $ref: bounties |
860
|
|
|
|
|
|
|
#pod $path: /malcolm |
861
|
|
|
|
|
|
|
#pod |
862
|
|
|
|
|
|
|
#pod =item $call |
863
|
|
|
|
|
|
|
#pod |
864
|
|
|
|
|
|
|
#pod Call a method on the referenced object and use the resulting value. This |
865
|
|
|
|
|
|
|
#pod may be a string, which will be the method name to call, or a hash with |
866
|
|
|
|
|
|
|
#pod C<$method> and C<$args>, which are the method name to call and the |
867
|
|
|
|
|
|
|
#pod arguments to that method, respectively. |
868
|
|
|
|
|
|
|
#pod |
869
|
|
|
|
|
|
|
#pod captain: |
870
|
|
|
|
|
|
|
#pod class: Person |
871
|
|
|
|
|
|
|
#pod args: |
872
|
|
|
|
|
|
|
#pod name: Malcolm Reynolds |
873
|
|
|
|
|
|
|
#pod location: |
874
|
|
|
|
|
|
|
#pod $ref: beacon |
875
|
|
|
|
|
|
|
#pod $call: get_location |
876
|
|
|
|
|
|
|
#pod bounty: |
877
|
|
|
|
|
|
|
#pod $ref: news |
878
|
|
|
|
|
|
|
#pod $call: |
879
|
|
|
|
|
|
|
#pod $method: get_bounty |
880
|
|
|
|
|
|
|
#pod $args: |
881
|
|
|
|
|
|
|
#pod name: mreynolds |
882
|
|
|
|
|
|
|
#pod |
883
|
|
|
|
|
|
|
#pod =back |
884
|
|
|
|
|
|
|
#pod |
885
|
|
|
|
|
|
|
#pod =cut |
886
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
sub resolve_ref { |
888
|
36
|
|
|
36
|
1
|
102
|
my ( $self, $for, $arg ) = @_; |
889
|
|
|
|
|
|
|
|
890
|
36
|
|
|
|
|
85
|
my %meta = $self->get_meta_names; |
891
|
|
|
|
|
|
|
|
892
|
36
|
|
|
|
|
87
|
my @ref; |
893
|
36
|
|
|
|
|
84
|
my $name = $arg->{ $meta{ref} }; |
894
|
36
|
|
|
|
|
146
|
my $service = $self->get( $name ); |
895
|
|
|
|
|
|
|
# resolve service ref w/path |
896
|
36
|
100
|
|
|
|
264
|
if ( my $path = $arg->{ $meta{path} } ) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
897
|
|
|
|
|
|
|
# locate foreign service data |
898
|
2
|
|
|
|
|
7
|
my $conf = $self->get_config($name); |
899
|
2
|
|
|
|
|
33
|
@ref = dpath( $path )->match($service); |
900
|
|
|
|
|
|
|
} |
901
|
|
|
|
|
|
|
elsif ( my $call = $arg->{ $meta{call} } ) { |
902
|
3
|
|
|
|
|
5
|
my ( $method, @args ); |
903
|
|
|
|
|
|
|
|
904
|
3
|
100
|
|
|
|
13
|
if ( ref $call eq 'HASH' ) { |
905
|
2
|
|
|
|
|
6
|
$method = $call->{ $meta{method} }; |
906
|
2
|
|
|
|
|
5
|
my $args = $call->{ $meta{args} }; |
907
|
|
|
|
|
|
|
@args = !$args ? () |
908
|
2
|
100
|
|
|
|
11
|
: ref $args eq 'ARRAY' ? @{ $args } |
|
1
|
50
|
|
|
|
3
|
|
909
|
|
|
|
|
|
|
: $args; |
910
|
|
|
|
|
|
|
} |
911
|
|
|
|
|
|
|
else { |
912
|
1
|
|
|
|
|
3
|
$method = $call; |
913
|
|
|
|
|
|
|
} |
914
|
|
|
|
|
|
|
|
915
|
3
|
|
|
|
|
15
|
@ref = $service->$method( @args ); |
916
|
|
|
|
|
|
|
} |
917
|
|
|
|
|
|
|
elsif ( my $method = $arg->{ $meta{method} } ) { |
918
|
3
|
|
|
|
|
14
|
_deprecated( 'warning: (deprecated) Using "$method" to get a value in a dependency is now "$call" in service "' . $for . '"' ); |
919
|
3
|
|
|
|
|
19
|
my $args = $arg->{ $meta{args} }; |
920
|
|
|
|
|
|
|
my @args = !$args ? () |
921
|
3
|
100
|
|
|
|
12
|
: ref $args eq 'ARRAY' ? @{ $args } |
|
1
|
100
|
|
|
|
3
|
|
922
|
|
|
|
|
|
|
: $args; |
923
|
3
|
|
|
|
|
14
|
@ref = $service->$method( @args ); |
924
|
|
|
|
|
|
|
} |
925
|
|
|
|
|
|
|
else { |
926
|
28
|
|
|
|
|
82
|
@ref = $service; |
927
|
|
|
|
|
|
|
} |
928
|
|
|
|
|
|
|
|
929
|
36
|
|
|
|
|
1418
|
return @ref; |
930
|
|
|
|
|
|
|
} |
931
|
|
|
|
|
|
|
|
932
|
|
|
|
|
|
|
#pod =method fix_refs |
933
|
|
|
|
|
|
|
#pod |
934
|
|
|
|
|
|
|
#pod my @fixed = $wire->fix_refs( $for_container_name, @args ); |
935
|
|
|
|
|
|
|
#pod |
936
|
|
|
|
|
|
|
#pod Similar to L<the find_refs method|/find_refs>. This method searches |
937
|
|
|
|
|
|
|
#pod through the C<@args> and recursively fixes any reference paths to be |
938
|
|
|
|
|
|
|
#pod absolute. References are identified with L<the is_meta |
939
|
|
|
|
|
|
|
#pod method|/is_meta>. |
940
|
|
|
|
|
|
|
#pod |
941
|
|
|
|
|
|
|
#pod This is used by L<the get_config method|/get_config> to ensure that the |
942
|
|
|
|
|
|
|
#pod configuration can be passed directly in to L<the create_service |
943
|
|
|
|
|
|
|
#pod method|create_service>. |
944
|
|
|
|
|
|
|
#pod |
945
|
|
|
|
|
|
|
#pod =cut |
946
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
sub fix_refs { |
948
|
19
|
|
|
19
|
1
|
44
|
my ( $self, $container_name, @args ) = @_; |
949
|
19
|
|
|
|
|
27
|
my @out; |
950
|
19
|
|
|
|
|
35
|
my %meta = $self->get_meta_names; |
951
|
19
|
|
|
|
|
47
|
for my $arg ( @args ) { |
952
|
22
|
100
|
|
|
|
54
|
if ( ref $arg eq 'HASH' ) { |
|
|
100
|
|
|
|
|
|
953
|
9
|
100
|
|
|
|
22
|
if ( $self->is_meta( $arg, 1 ) ) { |
954
|
|
|
|
|
|
|
#; print STDERR 'Fixing refs for arg: ' . Dumper $arg; |
955
|
6
|
|
|
|
|
25
|
my %new = %$arg; |
956
|
6
|
|
|
|
|
20
|
for my $key ( keys %new ) { |
957
|
10
|
100
|
|
|
|
50
|
if ( $key =~ /(?:ref|extends)$/ ) { |
958
|
3
|
|
|
|
|
15
|
$new{ $key } = join( q{/}, $container_name, $new{$key} ); |
959
|
|
|
|
|
|
|
} |
960
|
|
|
|
|
|
|
else { |
961
|
7
|
|
|
|
|
24
|
( $new{ $key } ) = $self->fix_refs( $container_name, $new{ $key } ); |
962
|
|
|
|
|
|
|
} |
963
|
|
|
|
|
|
|
} |
964
|
|
|
|
|
|
|
#; print STDERR 'Fixed refs for arg: ' . Dumper \%new; |
965
|
6
|
|
|
|
|
17
|
push @out, \%new; |
966
|
|
|
|
|
|
|
} |
967
|
|
|
|
|
|
|
else { |
968
|
3
|
|
|
|
|
9
|
push @out, { $self->fix_refs( $container_name, %{$arg} ) }; |
|
3
|
|
|
|
|
16
|
|
969
|
|
|
|
|
|
|
} |
970
|
|
|
|
|
|
|
} |
971
|
|
|
|
|
|
|
elsif ( ref $arg eq 'ARRAY' ) { |
972
|
3
|
|
|
|
|
5
|
push @out, [ map { $self->fix_refs( $container_name, $_ ) } @{$arg} ]; |
|
5
|
|
|
|
|
10
|
|
|
3
|
|
|
|
|
7
|
|
973
|
|
|
|
|
|
|
} |
974
|
|
|
|
|
|
|
else { |
975
|
10
|
|
|
|
|
22
|
push @out, $arg; # simple scalars |
976
|
|
|
|
|
|
|
} |
977
|
|
|
|
|
|
|
} |
978
|
19
|
|
|
|
|
78
|
return @out; |
979
|
|
|
|
|
|
|
} |
980
|
|
|
|
|
|
|
|
981
|
|
|
|
|
|
|
|
982
|
|
|
|
|
|
|
#pod =method new |
983
|
|
|
|
|
|
|
#pod |
984
|
|
|
|
|
|
|
#pod my $wire = Beam::Wire->new( %attributes ); |
985
|
|
|
|
|
|
|
#pod |
986
|
|
|
|
|
|
|
#pod Create a new container. |
987
|
|
|
|
|
|
|
#pod |
988
|
|
|
|
|
|
|
#pod =cut |
989
|
|
|
|
|
|
|
|
990
|
|
|
|
|
|
|
sub BUILD { |
991
|
96
|
|
|
96
|
0
|
2676
|
my ( $self ) = @_; |
992
|
|
|
|
|
|
|
|
993
|
96
|
100
|
100
|
|
|
731
|
if ( $self->file && !path( $self->file )->exists ) { |
994
|
1
|
|
|
|
|
61
|
my $file = $self->file; |
995
|
1
|
|
|
|
|
6
|
Beam::Wire::Exception::Constructor->throw( |
996
|
|
|
|
|
|
|
attr => 'file', |
997
|
|
|
|
|
|
|
error => qq{Container file '$file' does not exist}, |
998
|
|
|
|
|
|
|
); |
999
|
|
|
|
|
|
|
} |
1000
|
|
|
|
|
|
|
|
1001
|
|
|
|
|
|
|
# Create all the eager services |
1002
|
95
|
|
|
|
|
1483
|
my %meta = $self->get_meta_names; |
1003
|
95
|
|
|
|
|
248
|
for my $key ( keys %{ $self->config } ) { |
|
95
|
|
|
|
|
1814
|
|
1004
|
179
|
|
|
|
|
3806
|
my $config = $self->config->{$key}; |
1005
|
179
|
100
|
|
|
|
1380
|
if ( ref $config eq 'HASH' ) { |
1006
|
174
|
|
66
|
|
|
764
|
my $lifecycle = $config->{lifecycle} || $config->{ $meta{lifecycle} }; |
1007
|
174
|
100
|
100
|
|
|
521
|
if ( $lifecycle && $lifecycle eq 'eager' ) { |
1008
|
1
|
|
|
|
|
4
|
$self->get($key); |
1009
|
|
|
|
|
|
|
} |
1010
|
|
|
|
|
|
|
} |
1011
|
|
|
|
|
|
|
} |
1012
|
94
|
|
|
|
|
872
|
return; |
1013
|
|
|
|
|
|
|
} |
1014
|
|
|
|
|
|
|
|
1015
|
|
|
|
|
|
|
my %deprecated_warnings; |
1016
|
|
|
|
|
|
|
sub _deprecated { |
1017
|
4
|
|
|
4
|
|
8
|
my ( $warning ) = @_; |
1018
|
4
|
50
|
|
|
|
14
|
return if $deprecated_warnings{ $warning }; |
1019
|
4
|
|
|
|
|
55
|
warn $deprecated_warnings{ $warning } = $warning . "\n"; |
1020
|
|
|
|
|
|
|
} |
1021
|
|
|
|
|
|
|
|
1022
|
|
|
|
|
|
|
# Load a config file |
1023
|
|
|
|
|
|
|
sub _load_config { |
1024
|
27
|
|
|
27
|
|
104
|
my ( $self, $path ) = @_; |
1025
|
27
|
|
|
|
|
55
|
local $Config::Any::YAML::NO_YAML_XS_WARNING = 1; |
1026
|
|
|
|
|
|
|
|
1027
|
27
|
|
|
|
|
42
|
my $loader; |
1028
|
27
|
|
|
|
|
44
|
eval { |
1029
|
27
|
|
|
|
|
322
|
$loader = Config::Any->load_files( { |
1030
|
|
|
|
|
|
|
files => [$path], use_ext => 1, flatten_to_hash => 1 |
1031
|
|
|
|
|
|
|
} ); |
1032
|
|
|
|
|
|
|
}; |
1033
|
27
|
100
|
|
|
|
405074
|
if ( $@ ) { |
1034
|
1
|
|
|
|
|
16
|
Beam::Wire::Exception::Config->throw( |
1035
|
|
|
|
|
|
|
file => $self->file, |
1036
|
|
|
|
|
|
|
config_error => $@, |
1037
|
|
|
|
|
|
|
); |
1038
|
|
|
|
|
|
|
} |
1039
|
|
|
|
|
|
|
|
1040
|
26
|
50
|
|
|
|
128
|
return "HASH" eq ref $loader ? (values(%{$loader}))[0] : {}; |
|
26
|
|
|
|
|
758
|
|
1041
|
|
|
|
|
|
|
} |
1042
|
|
|
|
|
|
|
|
1043
|
|
|
|
|
|
|
# Check config file for known issues and report |
1044
|
|
|
|
|
|
|
# Optionally attempt to get all configured items for complete test |
1045
|
|
|
|
|
|
|
# Intended for use with beam-wire script |
1046
|
|
|
|
|
|
|
sub validate { |
1047
|
4
|
|
|
4
|
0
|
1921
|
my $error_count = 0; |
1048
|
4
|
|
|
|
|
14
|
my @valid_dependency_nodes = qw( class method args extends lifecycle on config ); |
1049
|
4
|
|
|
|
|
8
|
my ( $self, $instantiate, $show_all_errors ) = @_; |
1050
|
|
|
|
|
|
|
|
1051
|
4
|
|
|
|
|
7
|
while ( my ( $name, $v ) = each %{ $self->{config} } ) { |
|
4
|
|
|
|
|
18
|
|
1052
|
|
|
|
|
|
|
|
1053
|
4
|
50
|
|
|
|
9
|
if ($instantiate) { |
1054
|
0
|
0
|
|
|
|
0
|
if ($show_all_errors) { |
1055
|
0
|
|
|
|
|
0
|
eval { |
1056
|
0
|
|
|
|
|
0
|
$self->get($name); |
1057
|
|
|
|
|
|
|
}; |
1058
|
0
|
0
|
|
|
|
0
|
print $@ if $@; |
1059
|
|
|
|
|
|
|
} |
1060
|
|
|
|
|
|
|
else { |
1061
|
0
|
|
|
|
|
0
|
$self->get($name); |
1062
|
|
|
|
|
|
|
} |
1063
|
0
|
|
|
|
|
0
|
next; |
1064
|
|
|
|
|
|
|
}; |
1065
|
|
|
|
|
|
|
|
1066
|
4
|
|
|
|
|
6
|
my %config = %{ $self->get_config($name) }; |
|
4
|
|
|
|
|
9
|
|
1067
|
4
|
|
|
|
|
51
|
%config = $self->merge_config(%config); |
1068
|
|
|
|
|
|
|
|
1069
|
3
|
50
|
66
|
|
|
21
|
if ( exists $config{value} && ( exists $config{class} || exists $config{extends})) { |
|
|
|
66
|
|
|
|
|
1070
|
3
|
|
|
|
|
4
|
$error_count++; |
1071
|
3
|
50
|
|
|
|
6
|
if ($show_all_errors) { |
1072
|
0
|
|
|
|
|
0
|
print qq(Invalid config for service '$name': "value" cannot be used with "class" or "extends"\n); |
1073
|
0
|
|
|
|
|
0
|
next; |
1074
|
|
|
|
|
|
|
} |
1075
|
|
|
|
|
|
|
|
1076
|
|
|
|
|
|
|
Beam::Wire::Exception::InvalidConfig->throw( |
1077
|
3
|
|
|
|
|
15
|
name => $name, |
1078
|
|
|
|
|
|
|
file => $self->file, |
1079
|
|
|
|
|
|
|
error => '"value" cannot be used with "class" or "extends"', |
1080
|
|
|
|
|
|
|
); |
1081
|
|
|
|
|
|
|
} |
1082
|
|
|
|
|
|
|
|
1083
|
0
|
0
|
|
|
|
0
|
if ( $config{config} ) { |
1084
|
0
|
|
|
|
|
0
|
my $conf_path = path( $config{config} ); |
1085
|
0
|
0
|
|
|
|
0
|
if ( $self->file ) { |
1086
|
0
|
|
|
|
|
0
|
$conf_path = path( $self->file )->parent->child($conf_path); |
1087
|
|
|
|
|
|
|
} |
1088
|
0
|
|
|
|
|
0
|
%config = %{ $self->_load_config("$conf_path") }; |
|
0
|
|
|
|
|
0
|
|
1089
|
|
|
|
|
|
|
} |
1090
|
|
|
|
|
|
|
|
1091
|
0
|
0
|
0
|
|
|
0
|
unless ( $config{value} || $config{class} || $config{extends} ) { |
|
|
|
0
|
|
|
|
|
1092
|
0
|
|
|
|
|
0
|
next; |
1093
|
|
|
|
|
|
|
} |
1094
|
|
|
|
|
|
|
|
1095
|
0
|
0
|
|
|
|
0
|
if ($config{class}) { |
1096
|
0
|
0
|
|
|
|
0
|
eval "require " . $config{class} if $config{class}; |
1097
|
|
|
|
|
|
|
} |
1098
|
|
|
|
|
|
|
#TODO: check method chain & serial |
1099
|
|
|
|
|
|
|
} |
1100
|
0
|
|
|
|
|
|
return $error_count; |
1101
|
|
|
|
|
|
|
} |
1102
|
|
|
|
|
|
|
|
1103
|
|
|
|
|
|
|
#pod =head1 EXCEPTIONS |
1104
|
|
|
|
|
|
|
#pod |
1105
|
|
|
|
|
|
|
#pod If there is an error internal to Beam::Wire, an exception will be thrown. If there is an |
1106
|
|
|
|
|
|
|
#pod error with creating a service or calling a method, the exception thrown will be passed- |
1107
|
|
|
|
|
|
|
#pod through unaltered. |
1108
|
|
|
|
|
|
|
#pod |
1109
|
|
|
|
|
|
|
#pod =head2 Beam::Wire::Exception |
1110
|
|
|
|
|
|
|
#pod |
1111
|
|
|
|
|
|
|
#pod The base exception class |
1112
|
|
|
|
|
|
|
#pod |
1113
|
|
|
|
|
|
|
#pod =cut |
1114
|
|
|
|
|
|
|
|
1115
|
|
|
|
|
|
|
package Beam::Wire::Exception; |
1116
|
24
|
|
|
24
|
|
212
|
use Moo; |
|
24
|
|
|
|
|
319
|
|
|
24
|
|
|
|
|
147
|
|
1117
|
|
|
|
|
|
|
with 'Throwable'; |
1118
|
24
|
|
|
24
|
|
8206
|
use Types::Standard qw( :all ); |
|
24
|
|
|
|
|
55
|
|
|
24
|
|
|
|
|
146
|
|
1119
|
24
|
|
|
24
|
|
1039932
|
use overload q{""} => sub { $_[0]->error }; |
|
24
|
|
|
6
|
|
63
|
|
|
24
|
|
|
|
|
316
|
|
|
6
|
|
|
|
|
15165
|
|
1120
|
|
|
|
|
|
|
|
1121
|
|
|
|
|
|
|
has error => ( |
1122
|
|
|
|
|
|
|
is => 'ro', |
1123
|
|
|
|
|
|
|
isa => Str, |
1124
|
|
|
|
|
|
|
); |
1125
|
|
|
|
|
|
|
|
1126
|
|
|
|
|
|
|
#pod =head2 Beam::Wire::Exception::Constructor |
1127
|
|
|
|
|
|
|
#pod |
1128
|
|
|
|
|
|
|
#pod An exception creating a Beam::Wire object |
1129
|
|
|
|
|
|
|
#pod |
1130
|
|
|
|
|
|
|
#pod =cut |
1131
|
|
|
|
|
|
|
|
1132
|
|
|
|
|
|
|
package Beam::Wire::Exception::Constructor; |
1133
|
24
|
|
|
24
|
|
2721
|
use Moo; |
|
24
|
|
|
|
|
58
|
|
|
24
|
|
|
|
|
175
|
|
1134
|
24
|
|
|
24
|
|
9656
|
use Types::Standard qw( :all ); |
|
24
|
|
|
|
|
56
|
|
|
24
|
|
|
|
|
136
|
|
1135
|
|
|
|
|
|
|
extends 'Beam::Wire::Exception'; |
1136
|
|
|
|
|
|
|
|
1137
|
|
|
|
|
|
|
has attr => ( |
1138
|
|
|
|
|
|
|
is => 'ro', |
1139
|
|
|
|
|
|
|
isa => Str, |
1140
|
|
|
|
|
|
|
required => 1, |
1141
|
|
|
|
|
|
|
); |
1142
|
|
|
|
|
|
|
|
1143
|
|
|
|
|
|
|
#pod =head2 Beam::Wire::Exception::Config |
1144
|
|
|
|
|
|
|
#pod |
1145
|
|
|
|
|
|
|
#pod An exception loading the configuration file. |
1146
|
|
|
|
|
|
|
#pod |
1147
|
|
|
|
|
|
|
#pod =cut |
1148
|
|
|
|
|
|
|
|
1149
|
|
|
|
|
|
|
package Beam::Wire::Exception::Config; |
1150
|
24
|
|
|
24
|
|
1033286
|
use Moo; |
|
24
|
|
|
|
|
62
|
|
|
24
|
|
|
|
|
196
|
|
1151
|
24
|
|
|
24
|
|
9427
|
use Types::Standard qw( :all ); |
|
24
|
|
|
|
|
57
|
|
|
24
|
|
|
|
|
158
|
|
1152
|
|
|
|
|
|
|
extends 'Beam::Wire::Exception'; |
1153
|
|
|
|
|
|
|
|
1154
|
|
|
|
|
|
|
has file => ( |
1155
|
|
|
|
|
|
|
is => 'ro', |
1156
|
|
|
|
|
|
|
isa => Maybe[InstanceOf['Path::Tiny']], |
1157
|
|
|
|
|
|
|
); |
1158
|
|
|
|
|
|
|
|
1159
|
|
|
|
|
|
|
has config_error => ( |
1160
|
|
|
|
|
|
|
is => 'ro', |
1161
|
|
|
|
|
|
|
isa => Str, |
1162
|
|
|
|
|
|
|
required => 1, |
1163
|
|
|
|
|
|
|
); |
1164
|
|
|
|
|
|
|
|
1165
|
|
|
|
|
|
|
has '+error' => ( |
1166
|
|
|
|
|
|
|
lazy => 1, |
1167
|
|
|
|
|
|
|
default => sub { |
1168
|
|
|
|
|
|
|
my ( $self ) = @_; |
1169
|
|
|
|
|
|
|
return sprintf 'Could not load container file "%s": Error from config parser: %s', |
1170
|
|
|
|
|
|
|
$self->file, |
1171
|
|
|
|
|
|
|
$self->config_error; |
1172
|
|
|
|
|
|
|
}, |
1173
|
|
|
|
|
|
|
); |
1174
|
|
|
|
|
|
|
|
1175
|
|
|
|
|
|
|
#pod =head2 Beam::Wire::Exception::Service |
1176
|
|
|
|
|
|
|
#pod |
1177
|
|
|
|
|
|
|
#pod An exception with service information inside |
1178
|
|
|
|
|
|
|
#pod |
1179
|
|
|
|
|
|
|
#pod =cut |
1180
|
|
|
|
|
|
|
|
1181
|
|
|
|
|
|
|
package Beam::Wire::Exception::Service; |
1182
|
24
|
|
|
24
|
|
1034684
|
use Moo; |
|
24
|
|
|
|
|
63
|
|
|
24
|
|
|
|
|
207
|
|
1183
|
24
|
|
|
24
|
|
9856
|
use Types::Standard qw( :all ); |
|
24
|
|
|
|
|
72
|
|
|
24
|
|
|
|
|
189
|
|
1184
|
|
|
|
|
|
|
extends 'Beam::Wire::Exception'; |
1185
|
|
|
|
|
|
|
|
1186
|
|
|
|
|
|
|
has name => ( |
1187
|
|
|
|
|
|
|
is => 'ro', |
1188
|
|
|
|
|
|
|
isa => Str, |
1189
|
|
|
|
|
|
|
required => 1, |
1190
|
|
|
|
|
|
|
); |
1191
|
|
|
|
|
|
|
|
1192
|
|
|
|
|
|
|
has file => ( |
1193
|
|
|
|
|
|
|
is => 'ro', |
1194
|
|
|
|
|
|
|
isa => Maybe[InstanceOf['Path::Tiny']], |
1195
|
|
|
|
|
|
|
); |
1196
|
|
|
|
|
|
|
|
1197
|
|
|
|
|
|
|
#pod =head2 Beam::Wire::Exception::NotFound |
1198
|
|
|
|
|
|
|
#pod |
1199
|
|
|
|
|
|
|
#pod The requested service or configuration was not found. |
1200
|
|
|
|
|
|
|
#pod |
1201
|
|
|
|
|
|
|
#pod =cut |
1202
|
|
|
|
|
|
|
|
1203
|
|
|
|
|
|
|
package Beam::Wire::Exception::NotFound; |
1204
|
24
|
|
|
24
|
|
1033126
|
use Moo; |
|
24
|
|
|
|
|
67
|
|
|
24
|
|
|
|
|
205
|
|
1205
|
|
|
|
|
|
|
extends 'Beam::Wire::Exception::Service'; |
1206
|
|
|
|
|
|
|
|
1207
|
|
|
|
|
|
|
has '+error' => ( |
1208
|
|
|
|
|
|
|
lazy => 1, |
1209
|
|
|
|
|
|
|
default => sub { |
1210
|
|
|
|
|
|
|
my ( $self ) = @_; |
1211
|
|
|
|
|
|
|
my $name = $self->name; |
1212
|
|
|
|
|
|
|
my $file = $self->file; |
1213
|
|
|
|
|
|
|
return "Service '$name' not found" . ( $file ? " in file '$file'" : '' ); |
1214
|
|
|
|
|
|
|
}, |
1215
|
|
|
|
|
|
|
); |
1216
|
|
|
|
|
|
|
|
1217
|
|
|
|
|
|
|
#pod =head2 Beam::Wire::Exception::InvalidConfig |
1218
|
|
|
|
|
|
|
#pod |
1219
|
|
|
|
|
|
|
#pod The configuration is invalid: |
1220
|
|
|
|
|
|
|
#pod |
1221
|
|
|
|
|
|
|
#pod =over 4 |
1222
|
|
|
|
|
|
|
#pod |
1223
|
|
|
|
|
|
|
#pod =item * |
1224
|
|
|
|
|
|
|
#pod |
1225
|
|
|
|
|
|
|
#pod Both "value" and "class" or "extends" are defined. These are mutually-exclusive. |
1226
|
|
|
|
|
|
|
#pod |
1227
|
|
|
|
|
|
|
#pod =back |
1228
|
|
|
|
|
|
|
#pod |
1229
|
|
|
|
|
|
|
#pod =cut |
1230
|
|
|
|
|
|
|
|
1231
|
|
|
|
|
|
|
package Beam::Wire::Exception::InvalidConfig; |
1232
|
24
|
|
|
24
|
|
11946
|
use Moo; |
|
24
|
|
|
|
|
56
|
|
|
24
|
|
|
|
|
118
|
|
1233
|
|
|
|
|
|
|
extends 'Beam::Wire::Exception::Service'; |
1234
|
|
|
|
|
|
|
use overload q{""} => sub { |
1235
|
7
|
|
|
7
|
|
15596
|
my ( $self ) = @_; |
1236
|
7
|
|
|
|
|
20
|
my $file = $self->file; |
1237
|
|
|
|
|
|
|
|
1238
|
7
|
100
|
|
|
|
60
|
sprintf "Invalid config for service '%s': %s%s", |
1239
|
|
|
|
|
|
|
$self->name, |
1240
|
|
|
|
|
|
|
$self->error, |
1241
|
|
|
|
|
|
|
( $file ? " in file '$file'" : "" ), |
1242
|
|
|
|
|
|
|
; |
1243
|
24
|
|
|
24
|
|
9444
|
}; |
|
24
|
|
|
|
|
62
|
|
|
24
|
|
|
|
|
290
|
|
1244
|
|
|
|
|
|
|
|
1245
|
|
|
|
|
|
|
#pod =head1 EVENTS |
1246
|
|
|
|
|
|
|
#pod |
1247
|
|
|
|
|
|
|
#pod The container emits the following events. |
1248
|
|
|
|
|
|
|
#pod |
1249
|
|
|
|
|
|
|
#pod =head2 configure_service |
1250
|
|
|
|
|
|
|
#pod |
1251
|
|
|
|
|
|
|
#pod This event is emitted when a new service is configured, but before it is |
1252
|
|
|
|
|
|
|
#pod instantiated or any classes loaded. This allows altering of the |
1253
|
|
|
|
|
|
|
#pod configuration before the service is built. Already-built services will |
1254
|
|
|
|
|
|
|
#pod not fire this event. |
1255
|
|
|
|
|
|
|
#pod |
1256
|
|
|
|
|
|
|
#pod Event handlers get a L<Beam::Wire::Event::ConfigService> object as their |
1257
|
|
|
|
|
|
|
#pod only argument. |
1258
|
|
|
|
|
|
|
#pod |
1259
|
|
|
|
|
|
|
#pod This event will bubble up from child containers. |
1260
|
|
|
|
|
|
|
#pod |
1261
|
|
|
|
|
|
|
#pod =head2 build_service |
1262
|
|
|
|
|
|
|
#pod |
1263
|
|
|
|
|
|
|
#pod This event is emitted when a new service is built. Cached services will |
1264
|
|
|
|
|
|
|
#pod not fire this event. |
1265
|
|
|
|
|
|
|
#pod |
1266
|
|
|
|
|
|
|
#pod Event handlers get a L<Beam::Wire::Event::BuildService> object as their |
1267
|
|
|
|
|
|
|
#pod only argument. |
1268
|
|
|
|
|
|
|
#pod |
1269
|
|
|
|
|
|
|
#pod This event will bubble up from child containers. |
1270
|
|
|
|
|
|
|
#pod |
1271
|
|
|
|
|
|
|
#pod =cut |
1272
|
|
|
|
|
|
|
|
1273
|
|
|
|
|
|
|
1; |
1274
|
|
|
|
|
|
|
|
1275
|
|
|
|
|
|
|
__END__ |
1276
|
|
|
|
|
|
|
|
1277
|
|
|
|
|
|
|
=pod |
1278
|
|
|
|
|
|
|
|
1279
|
|
|
|
|
|
|
=encoding UTF-8 |
1280
|
|
|
|
|
|
|
|
1281
|
|
|
|
|
|
|
=head1 NAME |
1282
|
|
|
|
|
|
|
|
1283
|
|
|
|
|
|
|
Beam::Wire - Lightweight Dependency Injection Container |
1284
|
|
|
|
|
|
|
|
1285
|
|
|
|
|
|
|
=head1 VERSION |
1286
|
|
|
|
|
|
|
|
1287
|
|
|
|
|
|
|
version 1.023 |
1288
|
|
|
|
|
|
|
|
1289
|
|
|
|
|
|
|
=head1 SYNOPSIS |
1290
|
|
|
|
|
|
|
|
1291
|
|
|
|
|
|
|
# wire.yml |
1292
|
|
|
|
|
|
|
captain: |
1293
|
|
|
|
|
|
|
class: Person |
1294
|
|
|
|
|
|
|
args: |
1295
|
|
|
|
|
|
|
name: Malcolm Reynolds |
1296
|
|
|
|
|
|
|
rank: Captain |
1297
|
|
|
|
|
|
|
first_officer: |
1298
|
|
|
|
|
|
|
$class: Person |
1299
|
|
|
|
|
|
|
name: Zoë Alleyne Washburne |
1300
|
|
|
|
|
|
|
rank: Commander |
1301
|
|
|
|
|
|
|
|
1302
|
|
|
|
|
|
|
# script.pl |
1303
|
|
|
|
|
|
|
use Beam::Wire; |
1304
|
|
|
|
|
|
|
my $wire = Beam::Wire->new( file => 'wire.yml' ); |
1305
|
|
|
|
|
|
|
my $captain = $wire->get( 'captain' ); |
1306
|
|
|
|
|
|
|
print $captain->name; # "Malcolm Reynolds" |
1307
|
|
|
|
|
|
|
|
1308
|
|
|
|
|
|
|
=head1 DESCRIPTION |
1309
|
|
|
|
|
|
|
|
1310
|
|
|
|
|
|
|
Beam::Wire is a configuration module and a dependency injection |
1311
|
|
|
|
|
|
|
container. In addition to complex data structures, Beam::Wire configures |
1312
|
|
|
|
|
|
|
and creates plain old Perl objects. |
1313
|
|
|
|
|
|
|
|
1314
|
|
|
|
|
|
|
A dependency injection (DI) container creates an inversion of control: |
1315
|
|
|
|
|
|
|
Instead of manually creating all the dependent objects (also called |
1316
|
|
|
|
|
|
|
"services") before creating the main object that we actually want, a DI |
1317
|
|
|
|
|
|
|
container handles that for us: We describe the relationships between |
1318
|
|
|
|
|
|
|
objects, and the objects get built as needed. |
1319
|
|
|
|
|
|
|
|
1320
|
|
|
|
|
|
|
Dependency injection is sometimes called the opposite of garbage |
1321
|
|
|
|
|
|
|
collection. Rather than ensure objects are destroyed in the right order, |
1322
|
|
|
|
|
|
|
dependency injection makes sure objects are created in the right order. |
1323
|
|
|
|
|
|
|
|
1324
|
|
|
|
|
|
|
Using Beam::Wire in your application brings great flexibility, |
1325
|
|
|
|
|
|
|
allowing users to easily add their own code to customize how your |
1326
|
|
|
|
|
|
|
project behaves. |
1327
|
|
|
|
|
|
|
|
1328
|
|
|
|
|
|
|
For an L<introduction to the Beam::Wire service configuration format, |
1329
|
|
|
|
|
|
|
see Beam::Wire::Help::Config|Beam::Wire::Help::Config>. |
1330
|
|
|
|
|
|
|
|
1331
|
|
|
|
|
|
|
=head1 ATTRIBUTES |
1332
|
|
|
|
|
|
|
|
1333
|
|
|
|
|
|
|
=head2 file |
1334
|
|
|
|
|
|
|
|
1335
|
|
|
|
|
|
|
The path of the file where services are configured (typically a YAML |
1336
|
|
|
|
|
|
|
file). The file's contents should be a single hashref. The keys are |
1337
|
|
|
|
|
|
|
service names, and the values are L<service |
1338
|
|
|
|
|
|
|
configurations|Beam::Wire::Help::Config>. |
1339
|
|
|
|
|
|
|
|
1340
|
|
|
|
|
|
|
=head2 dir |
1341
|
|
|
|
|
|
|
|
1342
|
|
|
|
|
|
|
The directory path to use when searching for inner container files. |
1343
|
|
|
|
|
|
|
Defaults to the directory which contains the file specified by the |
1344
|
|
|
|
|
|
|
L<file attribute|/file>. |
1345
|
|
|
|
|
|
|
|
1346
|
|
|
|
|
|
|
=head2 config |
1347
|
|
|
|
|
|
|
|
1348
|
|
|
|
|
|
|
The raw configuration data. By default, this data is loaded by |
1349
|
|
|
|
|
|
|
L<Config::Any|Config::Any> using the file specified by the L<file attribute|/file>. |
1350
|
|
|
|
|
|
|
|
1351
|
|
|
|
|
|
|
See L<Beam::Wire::Help::Config for details on what the configuration |
1352
|
|
|
|
|
|
|
data structure looks like|Beam::Wire::Help::Config>. |
1353
|
|
|
|
|
|
|
|
1354
|
|
|
|
|
|
|
If you don't want to load a file, you can specify this attribute in the |
1355
|
|
|
|
|
|
|
Beam::Wire constructor. |
1356
|
|
|
|
|
|
|
|
1357
|
|
|
|
|
|
|
=head2 services |
1358
|
|
|
|
|
|
|
|
1359
|
|
|
|
|
|
|
A hashref of cached services built from the L<configuration|/config>. If |
1360
|
|
|
|
|
|
|
you want to inject a pre-built object for other services to depend on, |
1361
|
|
|
|
|
|
|
add it here. |
1362
|
|
|
|
|
|
|
|
1363
|
|
|
|
|
|
|
=head2 meta_prefix |
1364
|
|
|
|
|
|
|
|
1365
|
|
|
|
|
|
|
The character that begins a meta-property inside of a service's C<args>. This |
1366
|
|
|
|
|
|
|
includes C<$ref>, C<$path>, C<$method>, and etc... |
1367
|
|
|
|
|
|
|
|
1368
|
|
|
|
|
|
|
The default value is C<$>. The empty string is allowed. |
1369
|
|
|
|
|
|
|
|
1370
|
|
|
|
|
|
|
=head1 METHODS |
1371
|
|
|
|
|
|
|
|
1372
|
|
|
|
|
|
|
=head2 get |
1373
|
|
|
|
|
|
|
|
1374
|
|
|
|
|
|
|
my $service = $wire->get( $name ); |
1375
|
|
|
|
|
|
|
my $service = $wire->get( $name, %overrides ) |
1376
|
|
|
|
|
|
|
|
1377
|
|
|
|
|
|
|
The get method resolves and returns the service named C<$name>, creating |
1378
|
|
|
|
|
|
|
it, if necessary, with L<the create_service method|/create_service>. |
1379
|
|
|
|
|
|
|
|
1380
|
|
|
|
|
|
|
C<%overrides> is an optional list of name-value pairs. If specified, |
1381
|
|
|
|
|
|
|
get() will create an new, anonymous service that extends the named |
1382
|
|
|
|
|
|
|
service with the given config overrides. For example: |
1383
|
|
|
|
|
|
|
|
1384
|
|
|
|
|
|
|
# test.pl |
1385
|
|
|
|
|
|
|
use Beam::Wire; |
1386
|
|
|
|
|
|
|
my $wire = Beam::Wire->new( |
1387
|
|
|
|
|
|
|
config => { |
1388
|
|
|
|
|
|
|
foo => { |
1389
|
|
|
|
|
|
|
args => { |
1390
|
|
|
|
|
|
|
text => 'Hello, World!', |
1391
|
|
|
|
|
|
|
}, |
1392
|
|
|
|
|
|
|
}, |
1393
|
|
|
|
|
|
|
}, |
1394
|
|
|
|
|
|
|
); |
1395
|
|
|
|
|
|
|
|
1396
|
|
|
|
|
|
|
my $foo = $wire->get( 'foo', args => { text => 'Hello, Chicago!' } ); |
1397
|
|
|
|
|
|
|
print $foo; # prints "Hello, Chicago!" |
1398
|
|
|
|
|
|
|
|
1399
|
|
|
|
|
|
|
This allows you to create factories out of any service, overriding service |
1400
|
|
|
|
|
|
|
configuration at run-time. |
1401
|
|
|
|
|
|
|
|
1402
|
|
|
|
|
|
|
If C<$name> contains a slash (C</>) character (e.g. C<foo/bar>), the left |
1403
|
|
|
|
|
|
|
side (C<foo>) will be used as the name of an inner container, and the |
1404
|
|
|
|
|
|
|
right side (C<bar>) is a service inside that container. For example, |
1405
|
|
|
|
|
|
|
these two lines are equivalent: |
1406
|
|
|
|
|
|
|
|
1407
|
|
|
|
|
|
|
$bar = $wire->get( 'foo/bar' ); |
1408
|
|
|
|
|
|
|
$bar = $wire->get( 'foo' )->get( 'bar' ); |
1409
|
|
|
|
|
|
|
|
1410
|
|
|
|
|
|
|
Inner containers can be nested as deeply as desired (C<foo/bar/baz/fuzz>). |
1411
|
|
|
|
|
|
|
|
1412
|
|
|
|
|
|
|
=head2 set |
1413
|
|
|
|
|
|
|
|
1414
|
|
|
|
|
|
|
$wire->set( $name => $service ); |
1415
|
|
|
|
|
|
|
|
1416
|
|
|
|
|
|
|
The set method configures and stores the specified C<$service> with the |
1417
|
|
|
|
|
|
|
specified C<$name>. Use this to add or replace built services. |
1418
|
|
|
|
|
|
|
|
1419
|
|
|
|
|
|
|
Like L<the get() method, above|/get>, C<$name> can contain a slash (C</>) |
1420
|
|
|
|
|
|
|
character to traverse through nested containers. |
1421
|
|
|
|
|
|
|
|
1422
|
|
|
|
|
|
|
=head2 get_config |
1423
|
|
|
|
|
|
|
|
1424
|
|
|
|
|
|
|
my $conf = $wire->get_config( $name ); |
1425
|
|
|
|
|
|
|
|
1426
|
|
|
|
|
|
|
Get the config with the given C<$name>. Like L<the get() method, |
1427
|
|
|
|
|
|
|
above|/get>, C<$name> can contain slash (C</>) characters to traverse |
1428
|
|
|
|
|
|
|
through nested containers. |
1429
|
|
|
|
|
|
|
|
1430
|
|
|
|
|
|
|
=head2 normalize_config |
1431
|
|
|
|
|
|
|
|
1432
|
|
|
|
|
|
|
my $out_conf = $self->normalize_config( $in_conf ); |
1433
|
|
|
|
|
|
|
|
1434
|
|
|
|
|
|
|
Normalize the given C<$in_conf> into to hash that L<the create_service |
1435
|
|
|
|
|
|
|
method|/create_service> expects. This method allows a service to be |
1436
|
|
|
|
|
|
|
defined with prefixed meta-names (C<$class> instead of C<class>) and |
1437
|
|
|
|
|
|
|
the arguments specified without prefixes. |
1438
|
|
|
|
|
|
|
|
1439
|
|
|
|
|
|
|
For example, these two services are identical. |
1440
|
|
|
|
|
|
|
|
1441
|
|
|
|
|
|
|
foo: |
1442
|
|
|
|
|
|
|
class: Foo |
1443
|
|
|
|
|
|
|
args: |
1444
|
|
|
|
|
|
|
fizz: buzz |
1445
|
|
|
|
|
|
|
|
1446
|
|
|
|
|
|
|
foo: |
1447
|
|
|
|
|
|
|
$class: Foo |
1448
|
|
|
|
|
|
|
fizz: buzz |
1449
|
|
|
|
|
|
|
|
1450
|
|
|
|
|
|
|
The C<$in_conf> must be a hash, and must already pass L<an is_meta |
1451
|
|
|
|
|
|
|
check|/is_meta>. |
1452
|
|
|
|
|
|
|
|
1453
|
|
|
|
|
|
|
=head2 create_service |
1454
|
|
|
|
|
|
|
|
1455
|
|
|
|
|
|
|
my $service = $wire->create_service( $name, %config ); |
1456
|
|
|
|
|
|
|
|
1457
|
|
|
|
|
|
|
Create the service with the given C<$name> and C<%config>. Config can |
1458
|
|
|
|
|
|
|
contain the following keys: |
1459
|
|
|
|
|
|
|
|
1460
|
|
|
|
|
|
|
=over 4 |
1461
|
|
|
|
|
|
|
|
1462
|
|
|
|
|
|
|
=item class |
1463
|
|
|
|
|
|
|
|
1464
|
|
|
|
|
|
|
The class name of an object to create. Can be combined with C<method>, |
1465
|
|
|
|
|
|
|
and C<args>. An object of any class can be created with Beam::Wire. |
1466
|
|
|
|
|
|
|
|
1467
|
|
|
|
|
|
|
=item args |
1468
|
|
|
|
|
|
|
|
1469
|
|
|
|
|
|
|
The arguments to the constructor method. Used with C<class> and |
1470
|
|
|
|
|
|
|
C<method>. Can be a simple value, or a reference to an array or |
1471
|
|
|
|
|
|
|
hash which will be dereferenced and passed in to the constructor |
1472
|
|
|
|
|
|
|
as a list. |
1473
|
|
|
|
|
|
|
|
1474
|
|
|
|
|
|
|
If the C<class> consumes the L<Beam::Service role|Beam::Service>, |
1475
|
|
|
|
|
|
|
the service's C<name> and C<container> will be added to the C<args>. |
1476
|
|
|
|
|
|
|
|
1477
|
|
|
|
|
|
|
=item method |
1478
|
|
|
|
|
|
|
|
1479
|
|
|
|
|
|
|
The method to call to create the object. Only used with C<class>. |
1480
|
|
|
|
|
|
|
Defaults to C<"new">. |
1481
|
|
|
|
|
|
|
|
1482
|
|
|
|
|
|
|
This can also be an array of hashes which describe a list of methods |
1483
|
|
|
|
|
|
|
that will be called on the object. The first method should create the |
1484
|
|
|
|
|
|
|
object, and each subsequent method can be used to modify the object. The |
1485
|
|
|
|
|
|
|
hashes should contain a C<method> key, which is a string containing the |
1486
|
|
|
|
|
|
|
method to call, and optionally C<args> and C<return> keys. The C<args> |
1487
|
|
|
|
|
|
|
key works like the top-level C<args> key, above. The optional C<return> |
1488
|
|
|
|
|
|
|
key can have the special value C<"chain">, which will use the return |
1489
|
|
|
|
|
|
|
value from the method as the value for the service (L<The tutorial shows |
1490
|
|
|
|
|
|
|
examples of this|Beam::Wire::Help::Config/Multiple Constructor |
1491
|
|
|
|
|
|
|
Methods>). |
1492
|
|
|
|
|
|
|
|
1493
|
|
|
|
|
|
|
If an array is used, the top-level C<args> key is not used. |
1494
|
|
|
|
|
|
|
|
1495
|
|
|
|
|
|
|
=item value |
1496
|
|
|
|
|
|
|
|
1497
|
|
|
|
|
|
|
The value of this service. Can be a simple value, or a reference to an |
1498
|
|
|
|
|
|
|
array or hash. This value will be simply returned by this method, and is |
1499
|
|
|
|
|
|
|
mostly useful when using container files. |
1500
|
|
|
|
|
|
|
|
1501
|
|
|
|
|
|
|
C<value> can not be used with C<class> or C<extends>. |
1502
|
|
|
|
|
|
|
|
1503
|
|
|
|
|
|
|
=item config |
1504
|
|
|
|
|
|
|
|
1505
|
|
|
|
|
|
|
The path to a configuration file, relative to L<the dir attribute|/dir>. |
1506
|
|
|
|
|
|
|
The file will be read with L<Config::Any>, and the resulting data |
1507
|
|
|
|
|
|
|
structure returned. |
1508
|
|
|
|
|
|
|
|
1509
|
|
|
|
|
|
|
=item extends |
1510
|
|
|
|
|
|
|
|
1511
|
|
|
|
|
|
|
The name of a service to extend. The named service's configuration will |
1512
|
|
|
|
|
|
|
be merged with this configuration (via L<the merge_config |
1513
|
|
|
|
|
|
|
method|/merge_config>). |
1514
|
|
|
|
|
|
|
|
1515
|
|
|
|
|
|
|
This can be used in place of the C<class> key if the extended configuration |
1516
|
|
|
|
|
|
|
contains a class. |
1517
|
|
|
|
|
|
|
|
1518
|
|
|
|
|
|
|
=item with |
1519
|
|
|
|
|
|
|
|
1520
|
|
|
|
|
|
|
Compose a role into the object's class before creating the object. This |
1521
|
|
|
|
|
|
|
can be a single string, or an array reference of strings which are roles |
1522
|
|
|
|
|
|
|
to combine. |
1523
|
|
|
|
|
|
|
|
1524
|
|
|
|
|
|
|
This uses L<Moo::Role|Moo::Role> and L<the create_class_with_roles |
1525
|
|
|
|
|
|
|
method|Role::Tiny/create_class_with_roles>, which should work with any |
1526
|
|
|
|
|
|
|
class (as it uses L<the Role::Tiny module|Role::Tiny> under the hood). |
1527
|
|
|
|
|
|
|
|
1528
|
|
|
|
|
|
|
This can be used with the C<class> key. |
1529
|
|
|
|
|
|
|
|
1530
|
|
|
|
|
|
|
=item on |
1531
|
|
|
|
|
|
|
|
1532
|
|
|
|
|
|
|
Attach an event handler to a L<Beam::Emitter subclass|Beam::Emitter>. This |
1533
|
|
|
|
|
|
|
is an array of hashes of event names and handlers. A handler is made from |
1534
|
|
|
|
|
|
|
a service reference (C<$ref> or an anonymous service), and a subroutine to |
1535
|
|
|
|
|
|
|
call on that service (C<$sub>). |
1536
|
|
|
|
|
|
|
|
1537
|
|
|
|
|
|
|
For example: |
1538
|
|
|
|
|
|
|
|
1539
|
|
|
|
|
|
|
emitter: |
1540
|
|
|
|
|
|
|
class: My::Emitter |
1541
|
|
|
|
|
|
|
on: |
1542
|
|
|
|
|
|
|
- my_event: |
1543
|
|
|
|
|
|
|
$ref: my_handler |
1544
|
|
|
|
|
|
|
$sub: on_my_event |
1545
|
|
|
|
|
|
|
|
1546
|
|
|
|
|
|
|
This can be used with the C<class> key. |
1547
|
|
|
|
|
|
|
|
1548
|
|
|
|
|
|
|
=back |
1549
|
|
|
|
|
|
|
|
1550
|
|
|
|
|
|
|
This method uses L<the parse_args method|/parse_args> to parse the C<args> key, |
1551
|
|
|
|
|
|
|
L<resolving references|resolve_ref> as needed. |
1552
|
|
|
|
|
|
|
|
1553
|
|
|
|
|
|
|
=head2 merge_config |
1554
|
|
|
|
|
|
|
|
1555
|
|
|
|
|
|
|
my %merged = $wire->merge_config( %config ); |
1556
|
|
|
|
|
|
|
|
1557
|
|
|
|
|
|
|
If C<%config> contains an C<extends> key, merge the extended config together |
1558
|
|
|
|
|
|
|
with this one, returning the merged service configuration. This works recursively, |
1559
|
|
|
|
|
|
|
so a service can extend a service that extends another service just fine. |
1560
|
|
|
|
|
|
|
|
1561
|
|
|
|
|
|
|
When merging, hashes are combined, with the child configuration taking |
1562
|
|
|
|
|
|
|
precedence. The C<args> key is handled specially to allow a hash of |
1563
|
|
|
|
|
|
|
args to be merged. |
1564
|
|
|
|
|
|
|
|
1565
|
|
|
|
|
|
|
The configuration returned is a safe copy and can be modified without |
1566
|
|
|
|
|
|
|
effecting the original config. |
1567
|
|
|
|
|
|
|
|
1568
|
|
|
|
|
|
|
=head2 parse_args |
1569
|
|
|
|
|
|
|
|
1570
|
|
|
|
|
|
|
my @args = $wire->parse_args( $for_name, $class, $args ); |
1571
|
|
|
|
|
|
|
|
1572
|
|
|
|
|
|
|
Parse the arguments (C<$args>) for the given service (C<$for_name>) with |
1573
|
|
|
|
|
|
|
the given class (C<$class>). |
1574
|
|
|
|
|
|
|
|
1575
|
|
|
|
|
|
|
C<$args> can be an array reference, a hash reference, or a simple |
1576
|
|
|
|
|
|
|
scalar. The arguments will be searched for references using L<the |
1577
|
|
|
|
|
|
|
find_refs method|/find_refs>, and then a list of arguments will be |
1578
|
|
|
|
|
|
|
returned, ready to pass to the object's constructor. |
1579
|
|
|
|
|
|
|
|
1580
|
|
|
|
|
|
|
Nested containers are handled specially by this method: Their inner |
1581
|
|
|
|
|
|
|
references are not resolved by the parent container. This ensures that |
1582
|
|
|
|
|
|
|
references are always relative to the container they're in. |
1583
|
|
|
|
|
|
|
|
1584
|
|
|
|
|
|
|
=head2 find_refs |
1585
|
|
|
|
|
|
|
|
1586
|
|
|
|
|
|
|
my @resolved = $wire->find_refs( $for_name, @args ); |
1587
|
|
|
|
|
|
|
|
1588
|
|
|
|
|
|
|
Go through the C<@args> and recursively resolve any references and |
1589
|
|
|
|
|
|
|
services found inside, returning the resolved result. References are |
1590
|
|
|
|
|
|
|
identified with L<the is_meta method|/is_meta>. |
1591
|
|
|
|
|
|
|
|
1592
|
|
|
|
|
|
|
If a reference contains a C<$ref> key, it will be resolved by L<the |
1593
|
|
|
|
|
|
|
resolve_ref method|/resolve_ref>. Otherwise, the reference will be |
1594
|
|
|
|
|
|
|
treated as an anonymous service, and passed directly to L<the |
1595
|
|
|
|
|
|
|
create_service method|/create_service>. |
1596
|
|
|
|
|
|
|
|
1597
|
|
|
|
|
|
|
This is used when L<creating a service|create_service> to ensure all |
1598
|
|
|
|
|
|
|
dependencies are created first. |
1599
|
|
|
|
|
|
|
|
1600
|
|
|
|
|
|
|
=head2 is_meta |
1601
|
|
|
|
|
|
|
|
1602
|
|
|
|
|
|
|
my $is_meta = $wire->is_meta( $ref_hash, $root ); |
1603
|
|
|
|
|
|
|
|
1604
|
|
|
|
|
|
|
Returns true if the given hash reference describes some kind of |
1605
|
|
|
|
|
|
|
Beam::Wire service. This is used to identify service configuration |
1606
|
|
|
|
|
|
|
hashes inside of larger data structures. |
1607
|
|
|
|
|
|
|
|
1608
|
|
|
|
|
|
|
A service hash reference must contain at least one key, and must either |
1609
|
|
|
|
|
|
|
contain a L<prefixed|/meta_prefix> key that could create or reference an |
1610
|
|
|
|
|
|
|
object (one of C<class>, C<extends>, C<config>, C<value>, or C<ref>) or, |
1611
|
|
|
|
|
|
|
if the C<$root> flag exists, be made completely of unprefixed meta keys |
1612
|
|
|
|
|
|
|
(as returned by L<the get_meta_names method|/get_meta_names>). |
1613
|
|
|
|
|
|
|
|
1614
|
|
|
|
|
|
|
The C<$root> flag is used by L<the get method|/get> to allow unprefixed |
1615
|
|
|
|
|
|
|
meta keys in the top-level hash values. |
1616
|
|
|
|
|
|
|
|
1617
|
|
|
|
|
|
|
=head2 get_meta_names |
1618
|
|
|
|
|
|
|
|
1619
|
|
|
|
|
|
|
my %meta_keys = $wire->get_meta_names; |
1620
|
|
|
|
|
|
|
|
1621
|
|
|
|
|
|
|
Get all the possible service keys with the L<meta prefix|/meta_prefix> already |
1622
|
|
|
|
|
|
|
attached. |
1623
|
|
|
|
|
|
|
|
1624
|
|
|
|
|
|
|
=head2 resolve_ref |
1625
|
|
|
|
|
|
|
|
1626
|
|
|
|
|
|
|
my @value = $wire->resolve_ref( $for_name, $ref_hash ); |
1627
|
|
|
|
|
|
|
|
1628
|
|
|
|
|
|
|
Resolves the given dependency from the configuration hash (C<$ref_hash>) |
1629
|
|
|
|
|
|
|
for the named service (C<$for_name>). Reference hashes contain the |
1630
|
|
|
|
|
|
|
following keys: |
1631
|
|
|
|
|
|
|
|
1632
|
|
|
|
|
|
|
=over 4 |
1633
|
|
|
|
|
|
|
|
1634
|
|
|
|
|
|
|
=item $ref |
1635
|
|
|
|
|
|
|
|
1636
|
|
|
|
|
|
|
The name of a service in the container. Required. |
1637
|
|
|
|
|
|
|
|
1638
|
|
|
|
|
|
|
=item $path |
1639
|
|
|
|
|
|
|
|
1640
|
|
|
|
|
|
|
A data path to pick some data out of the reference. Useful with C<value> |
1641
|
|
|
|
|
|
|
and C<config> services. |
1642
|
|
|
|
|
|
|
|
1643
|
|
|
|
|
|
|
# container.yml |
1644
|
|
|
|
|
|
|
bounties: |
1645
|
|
|
|
|
|
|
value: |
1646
|
|
|
|
|
|
|
malcolm: 50000 |
1647
|
|
|
|
|
|
|
zoe: 35000 |
1648
|
|
|
|
|
|
|
simon: 100000 |
1649
|
|
|
|
|
|
|
|
1650
|
|
|
|
|
|
|
captain: |
1651
|
|
|
|
|
|
|
class: Person |
1652
|
|
|
|
|
|
|
args: |
1653
|
|
|
|
|
|
|
name: Malcolm Reynolds |
1654
|
|
|
|
|
|
|
bounty: |
1655
|
|
|
|
|
|
|
$ref: bounties |
1656
|
|
|
|
|
|
|
$path: /malcolm |
1657
|
|
|
|
|
|
|
|
1658
|
|
|
|
|
|
|
=item $call |
1659
|
|
|
|
|
|
|
|
1660
|
|
|
|
|
|
|
Call a method on the referenced object and use the resulting value. This |
1661
|
|
|
|
|
|
|
may be a string, which will be the method name to call, or a hash with |
1662
|
|
|
|
|
|
|
C<$method> and C<$args>, which are the method name to call and the |
1663
|
|
|
|
|
|
|
arguments to that method, respectively. |
1664
|
|
|
|
|
|
|
|
1665
|
|
|
|
|
|
|
captain: |
1666
|
|
|
|
|
|
|
class: Person |
1667
|
|
|
|
|
|
|
args: |
1668
|
|
|
|
|
|
|
name: Malcolm Reynolds |
1669
|
|
|
|
|
|
|
location: |
1670
|
|
|
|
|
|
|
$ref: beacon |
1671
|
|
|
|
|
|
|
$call: get_location |
1672
|
|
|
|
|
|
|
bounty: |
1673
|
|
|
|
|
|
|
$ref: news |
1674
|
|
|
|
|
|
|
$call: |
1675
|
|
|
|
|
|
|
$method: get_bounty |
1676
|
|
|
|
|
|
|
$args: |
1677
|
|
|
|
|
|
|
name: mreynolds |
1678
|
|
|
|
|
|
|
|
1679
|
|
|
|
|
|
|
=back |
1680
|
|
|
|
|
|
|
|
1681
|
|
|
|
|
|
|
=head2 fix_refs |
1682
|
|
|
|
|
|
|
|
1683
|
|
|
|
|
|
|
my @fixed = $wire->fix_refs( $for_container_name, @args ); |
1684
|
|
|
|
|
|
|
|
1685
|
|
|
|
|
|
|
Similar to L<the find_refs method|/find_refs>. This method searches |
1686
|
|
|
|
|
|
|
through the C<@args> and recursively fixes any reference paths to be |
1687
|
|
|
|
|
|
|
absolute. References are identified with L<the is_meta |
1688
|
|
|
|
|
|
|
method|/is_meta>. |
1689
|
|
|
|
|
|
|
|
1690
|
|
|
|
|
|
|
This is used by L<the get_config method|/get_config> to ensure that the |
1691
|
|
|
|
|
|
|
configuration can be passed directly in to L<the create_service |
1692
|
|
|
|
|
|
|
method|create_service>. |
1693
|
|
|
|
|
|
|
|
1694
|
|
|
|
|
|
|
=head2 new |
1695
|
|
|
|
|
|
|
|
1696
|
|
|
|
|
|
|
my $wire = Beam::Wire->new( %attributes ); |
1697
|
|
|
|
|
|
|
|
1698
|
|
|
|
|
|
|
Create a new container. |
1699
|
|
|
|
|
|
|
|
1700
|
|
|
|
|
|
|
=head1 EXCEPTIONS |
1701
|
|
|
|
|
|
|
|
1702
|
|
|
|
|
|
|
If there is an error internal to Beam::Wire, an exception will be thrown. If there is an |
1703
|
|
|
|
|
|
|
error with creating a service or calling a method, the exception thrown will be passed- |
1704
|
|
|
|
|
|
|
through unaltered. |
1705
|
|
|
|
|
|
|
|
1706
|
|
|
|
|
|
|
=head2 Beam::Wire::Exception |
1707
|
|
|
|
|
|
|
|
1708
|
|
|
|
|
|
|
The base exception class |
1709
|
|
|
|
|
|
|
|
1710
|
|
|
|
|
|
|
=head2 Beam::Wire::Exception::Constructor |
1711
|
|
|
|
|
|
|
|
1712
|
|
|
|
|
|
|
An exception creating a Beam::Wire object |
1713
|
|
|
|
|
|
|
|
1714
|
|
|
|
|
|
|
=head2 Beam::Wire::Exception::Config |
1715
|
|
|
|
|
|
|
|
1716
|
|
|
|
|
|
|
An exception loading the configuration file. |
1717
|
|
|
|
|
|
|
|
1718
|
|
|
|
|
|
|
=head2 Beam::Wire::Exception::Service |
1719
|
|
|
|
|
|
|
|
1720
|
|
|
|
|
|
|
An exception with service information inside |
1721
|
|
|
|
|
|
|
|
1722
|
|
|
|
|
|
|
=head2 Beam::Wire::Exception::NotFound |
1723
|
|
|
|
|
|
|
|
1724
|
|
|
|
|
|
|
The requested service or configuration was not found. |
1725
|
|
|
|
|
|
|
|
1726
|
|
|
|
|
|
|
=head2 Beam::Wire::Exception::InvalidConfig |
1727
|
|
|
|
|
|
|
|
1728
|
|
|
|
|
|
|
The configuration is invalid: |
1729
|
|
|
|
|
|
|
|
1730
|
|
|
|
|
|
|
=over 4 |
1731
|
|
|
|
|
|
|
|
1732
|
|
|
|
|
|
|
=item * |
1733
|
|
|
|
|
|
|
|
1734
|
|
|
|
|
|
|
Both "value" and "class" or "extends" are defined. These are mutually-exclusive. |
1735
|
|
|
|
|
|
|
|
1736
|
|
|
|
|
|
|
=back |
1737
|
|
|
|
|
|
|
|
1738
|
|
|
|
|
|
|
=head1 EVENTS |
1739
|
|
|
|
|
|
|
|
1740
|
|
|
|
|
|
|
The container emits the following events. |
1741
|
|
|
|
|
|
|
|
1742
|
|
|
|
|
|
|
=head2 configure_service |
1743
|
|
|
|
|
|
|
|
1744
|
|
|
|
|
|
|
This event is emitted when a new service is configured, but before it is |
1745
|
|
|
|
|
|
|
instantiated or any classes loaded. This allows altering of the |
1746
|
|
|
|
|
|
|
configuration before the service is built. Already-built services will |
1747
|
|
|
|
|
|
|
not fire this event. |
1748
|
|
|
|
|
|
|
|
1749
|
|
|
|
|
|
|
Event handlers get a L<Beam::Wire::Event::ConfigService> object as their |
1750
|
|
|
|
|
|
|
only argument. |
1751
|
|
|
|
|
|
|
|
1752
|
|
|
|
|
|
|
This event will bubble up from child containers. |
1753
|
|
|
|
|
|
|
|
1754
|
|
|
|
|
|
|
=head2 build_service |
1755
|
|
|
|
|
|
|
|
1756
|
|
|
|
|
|
|
This event is emitted when a new service is built. Cached services will |
1757
|
|
|
|
|
|
|
not fire this event. |
1758
|
|
|
|
|
|
|
|
1759
|
|
|
|
|
|
|
Event handlers get a L<Beam::Wire::Event::BuildService> object as their |
1760
|
|
|
|
|
|
|
only argument. |
1761
|
|
|
|
|
|
|
|
1762
|
|
|
|
|
|
|
This event will bubble up from child containers. |
1763
|
|
|
|
|
|
|
|
1764
|
|
|
|
|
|
|
=head1 ENVIRONMENT VARIABLES |
1765
|
|
|
|
|
|
|
|
1766
|
|
|
|
|
|
|
=over 4 |
1767
|
|
|
|
|
|
|
|
1768
|
|
|
|
|
|
|
=item BEAM_WIRE_DEBUG |
1769
|
|
|
|
|
|
|
|
1770
|
|
|
|
|
|
|
If set, print a bunch of internal debugging information to STDERR. |
1771
|
|
|
|
|
|
|
|
1772
|
|
|
|
|
|
|
=back |
1773
|
|
|
|
|
|
|
|
1774
|
|
|
|
|
|
|
=head1 AUTHORS |
1775
|
|
|
|
|
|
|
|
1776
|
|
|
|
|
|
|
=over 4 |
1777
|
|
|
|
|
|
|
|
1778
|
|
|
|
|
|
|
=item * |
1779
|
|
|
|
|
|
|
|
1780
|
|
|
|
|
|
|
Doug Bell <preaction@cpan.org> |
1781
|
|
|
|
|
|
|
|
1782
|
|
|
|
|
|
|
=item * |
1783
|
|
|
|
|
|
|
|
1784
|
|
|
|
|
|
|
Al Newkirk <anewkirk@ana.io> |
1785
|
|
|
|
|
|
|
|
1786
|
|
|
|
|
|
|
=back |
1787
|
|
|
|
|
|
|
|
1788
|
|
|
|
|
|
|
=head1 CONTRIBUTORS |
1789
|
|
|
|
|
|
|
|
1790
|
|
|
|
|
|
|
=for stopwords Ben Moon Bruce Armstrong Diab Jerius Kent Fredric Mohammad S Anwar mohawk2 |
1791
|
|
|
|
|
|
|
|
1792
|
|
|
|
|
|
|
=over 4 |
1793
|
|
|
|
|
|
|
|
1794
|
|
|
|
|
|
|
=item * |
1795
|
|
|
|
|
|
|
|
1796
|
|
|
|
|
|
|
Ben Moon <guiltydolphin@gmail.com> |
1797
|
|
|
|
|
|
|
|
1798
|
|
|
|
|
|
|
=item * |
1799
|
|
|
|
|
|
|
|
1800
|
|
|
|
|
|
|
Bruce Armstrong <bruce@armstronganchor.net> |
1801
|
|
|
|
|
|
|
|
1802
|
|
|
|
|
|
|
=item * |
1803
|
|
|
|
|
|
|
|
1804
|
|
|
|
|
|
|
Diab Jerius <djerius@cfa.harvard.edu> |
1805
|
|
|
|
|
|
|
|
1806
|
|
|
|
|
|
|
=item * |
1807
|
|
|
|
|
|
|
|
1808
|
|
|
|
|
|
|
Kent Fredric <kentnl@cpan.org> |
1809
|
|
|
|
|
|
|
|
1810
|
|
|
|
|
|
|
=item * |
1811
|
|
|
|
|
|
|
|
1812
|
|
|
|
|
|
|
Mohammad S Anwar <mohammad.anwar@yahoo.com> |
1813
|
|
|
|
|
|
|
|
1814
|
|
|
|
|
|
|
=item * |
1815
|
|
|
|
|
|
|
|
1816
|
|
|
|
|
|
|
mohawk2 <mohawk2@users.noreply.github.com> |
1817
|
|
|
|
|
|
|
|
1818
|
|
|
|
|
|
|
=back |
1819
|
|
|
|
|
|
|
|
1820
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
1821
|
|
|
|
|
|
|
|
1822
|
|
|
|
|
|
|
This software is copyright (c) 2018 by Doug Bell. |
1823
|
|
|
|
|
|
|
|
1824
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
1825
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
1826
|
|
|
|
|
|
|
|
1827
|
|
|
|
|
|
|
=cut |