File Coverage

blib/lib/Beam/Wire.pm
Criterion Covered Total %
statement 361 381 94.7
branch 129 156 82.6
condition 49 61 80.3
subroutine 49 49 100.0
pod 12 14 85.7
total 600 661 90.7


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