File Coverage

blib/lib/Bread/Board/Service.pm
Criterion Covered Total %
statement 32 38 84.2
branch 8 12 66.6
condition n/a
subroutine 10 10 100.0
pod 5 5 100.0
total 55 65 84.6


line stmt bran cond sub pod time code
1             package Bread::Board::Service;
2             our $AUTHORITY = 'cpan:STEVAN';
3             # ABSTRACT: Base service role
4             $Bread::Board::Service::VERSION = '0.37';
5 63     63   24077 use Moose::Role;
  63         8966934  
  63         306  
6 63     63   341587 use Module::Runtime ();
  63         154  
  63         1718  
7              
8 63     63   416 use Moose::Util::TypeConstraints 'find_type_constraint';
  63         145  
  63         326  
9              
10             with 'Bread::Board::Traversable';
11              
12             has 'name' => (
13             is => 'rw',
14             isa => 'Str',
15             required => 1
16             );
17              
18             has 'params' => (
19             traits => [ 'Hash' ],
20             is => 'rw',
21             isa => 'HashRef',
22             lazy => 1,
23             builder => 'init_params',
24             clearer => 'clear_params',
25             handles => {
26             get_param => 'get',
27             get_param_keys => 'keys',
28             _clear_param => 'delete',
29             _set_param => 'set',
30             }
31             );
32              
33             has 'is_locked' => (
34             is => 'rw',
35             isa => 'Bool',
36             default => sub { 0 }
37             );
38              
39             has 'lifecycle' => (
40             is => 'rw',
41             isa => 'Str',
42             trigger => sub {
43             my ($self, $lifecycle) = @_;
44             if ($self->does('Bread::Board::LifeCycle')) {
45             my $base = (Class::MOP::class_of($self)->superclasses)[0];
46             Class::MOP::class_of($base)->rebless_instance_back($self);
47             return if $lifecycle eq 'Null';
48             }
49              
50             my $lifecycle_role = $lifecycle =~ /^\+/
51             ? substr($lifecycle, 1)
52             : "Bread::Board::LifeCycle::${lifecycle}";
53             Module::Runtime::require_module($lifecycle_role);
54             Class::MOP::class_of($lifecycle_role)->apply($self);
55             }
56             );
57              
58 224     224 1 1413 sub init_params { +{} }
59             sub param {
60 89     89 1 367 my $self = shift;
61 89 100       583 return $self->get_param_keys if scalar @_ == 0;
62 79 50       2598 return $self->get_param( $_[0] ) if scalar @_ == 1;
63 0 0       0 ((scalar @_ % 2) == 0)
64             || confess "parameter assignment must be an even numbered list";
65 0         0 my %new = @_;
66 0         0 while (my ($key, $value) = each %new) {
67 0         0 $self->set_param( $key => $value );
68             }
69 0         0 return;
70             }
71              
72             {
73             my %mergeable_params = (
74             dependencies => {
75             interface => 'Bread::Board::Service::WithDependencies',
76             constraint => 'Bread::Board::Service::Dependencies',
77             },
78             parameters => {
79             interface => 'Bread::Board::Service::WithParameters',
80             constraint => 'Bread::Board::Service::Parameters',
81             },
82             );
83              
84             sub clone_and_inherit_params {
85 7     7 1 27 my ($self, %params) = @_;
86              
87             confess "Changing a service's class is not possible when inheriting"
88 7 100       475 unless $params{service_class} eq blessed $self;
89              
90 3         13 for my $p (keys %mergeable_params) {
91 6 100       19 if (exists $params{$p}) {
92 2 50       8 if ($self->does($mergeable_params{$p}->{interface})) {
93 2         95 my $type = find_type_constraint $mergeable_params{$p}->{constraint};
94              
95 2         199 my $val = $type->assert_coerce($params{$p});
96              
97             $params{$p} = {
98 2         67 %{ $self->$p },
99 2         174 %{ $val },
  2         13  
100             };
101             }
102             else {
103 0         0 confess "Trying to add $p to a service not supporting them";
104             }
105             }
106             }
107              
108 3         22 $self->clone(%params);
109             }
110             }
111              
112             requires 'get';
113              
114 213     213 1 6032 sub lock { (shift)->is_locked(1) }
115 213     213 1 5973 sub unlock { (shift)->is_locked(0) }
116              
117 63     63   67427 no Moose::Util::TypeConstraints; no Moose::Role; 1;
  63     63   175  
  63         413  
  63         9734  
  63         170  
  63         311  
118              
119             __END__
120              
121             =pod
122              
123             =encoding UTF-8
124              
125             =head1 NAME
126              
127             Bread::Board::Service - Base service role
128              
129             =head1 VERSION
130              
131             version 0.37
132              
133             =head1 DESCRIPTION
134              
135             This role is the basis for all services in L<Bread::Board>. It
136             provides (or requires the implementation of) the minimum necessary
137             building blocks: creating an instance, setting/getting parameters,
138             instance lifecycle.
139              
140             =head1 ATTRIBUTES
141              
142             =head2 C<name>
143              
144             Read/write string, required. Every service needs a name, by which it
145             can be referenced when L<fetching it|Bread::Board::Traversable/fetch>.
146              
147             =head2 C<is_locked>
148              
149             Boolean, defaults to false. Used during L<dependency
150             resolution|Bread::Board::Service::WithDependencies/resolve_dependencies>
151             to detect loops.
152              
153             =head2 C<lifecycle>
154              
155             $service->lifecycle('Singleton');
156              
157             Read/write string; it should be either a partial class name under the
158             C<Bread::Board::LifeCycle::> namespace (like C<Singleton> for
159             C<Bread::Board::LifeCycle::Singleton>) or a full class name prefixed
160             with C<+> (like C<+My::Special::Lifecycle>). The name is expected to
161             refer to a loadable I<role>, which will be applied to the service
162             instance.
163              
164             =head1 METHODS
165              
166             =head2 C<lock>
167              
168             Locks the service; you should never need to call this method in normal
169             code.
170              
171             =head2 C<unlock>
172              
173             Unlocks the service; you should never need to call this method in
174             normal code.
175              
176             =head2 C<get>
177              
178             my $value = $service->get();
179              
180             This method I<must> be implemented by the consuming class. It's
181             expected to instantiate whatever object or value this service should
182             resolve to.
183              
184             =head2 C<init_params>
185              
186             Builder for the service parameters, defaults to returning an empty
187             hashref.
188              
189             =head2 C<clear_params>
190              
191             Clearer of the service parameters.
192              
193             =head2 C<param>
194              
195             my @param_names = $service->param();
196             my $param_value = $service->param($param_name);
197             $service->param($name1=>$value1,$name2=>$value2);
198              
199             Getter/setter for the service parameters; notice that calling this
200             method with no arguments returns the list of parameter names.
201              
202             I<Please note>: these are not the same as the L<parameters for a
203             parametric service|Bread::Board::Service::WithParameters> (although
204             those will be copied here before C<get> is called), nor are they the
205             same thing as L<dependencies|Bread::Board::Service::WithDependencies>
206             (although the resolved dependencies will be copied here before C<get>
207             is called).
208              
209             =head2 C<clone_and_inherit_params>
210              
211             When declaring a service using the L<< C<service> helper
212             function|Bread::Board/service >>, if the name you use starts with a
213             C<'+'>, the service definition will extend an existing service with
214             the given name (without the C<'+'>). This method implements the
215             extension semantics: the C<dependencies> and C<parameters> options
216             will be merged with the existing values, rather than overridden.
217              
218             =head1 AUTHOR
219              
220             Stevan Little <stevan@iinteractive.com>
221              
222             =head1 BUGS
223              
224             Please report any bugs or feature requests on the bugtracker website
225             https://github.com/stevan/BreadBoard/issues
226              
227             When submitting a bug or request, please include a test-file or a
228             patch to an existing test-file that illustrates the bug or desired
229             feature.
230              
231             =head1 COPYRIGHT AND LICENSE
232              
233             This software is copyright (c) 2019, 2017, 2016, 2015, 2014, 2013, 2011, 2009 by Infinity Interactive.
234              
235             This is free software; you can redistribute it and/or modify it under
236             the same terms as the Perl 5 programming language system itself.
237              
238             =cut