File Coverage

blib/lib/Bread/Board/Service/Inferred.pm
Criterion Covered Total %
statement 68 69 98.5
branch 33 38 86.8
condition 12 15 80.0
subroutine 7 7 100.0
pod 1 1 100.0
total 121 130 93.0


line stmt bran cond sub pod time code
1             package Bread::Board::Service::Inferred;
2             our $AUTHORITY = 'cpan:STEVAN';
3             # ABSTRACT: Helper for inferring a service from a Moose object
4             $Bread::Board::Service::Inferred::VERSION = '0.37';
5 53     53   397 use Moose;
  53         134  
  53         432  
6 53     53   340386 use Moose::Util::TypeConstraints 'find_type_constraint';
  53         138  
  53         461  
7              
8 53     53   23154 use Try::Tiny;
  53         206  
  53         3225  
9 53     53   394 use Bread::Board::Types;
  53         125  
  53         1581  
10 53     53   351 use Bread::Board::ConstructorInjection;
  53         141  
  53         42717  
11              
12             has 'current_container' => (
13             is => 'ro',
14             isa => 'Bread::Board::Container',
15             required => 1,
16             );
17              
18             has 'service' => (
19             is => 'ro',
20             isa => 'Bread::Board::ConstructorInjection',
21             predicate => 'has_service',
22             );
23              
24             has 'service_args' => (
25             is => 'ro',
26             isa => 'HashRef',
27             lazy => 1,
28             default => sub { +{} }
29             );
30              
31             has 'infer_params' => (
32             is => 'ro',
33             isa => 'Bool',
34             default => sub { 0 },
35             );
36              
37             sub infer_service {
38 35     35 1 84 my $self = shift;
39 35         72 my $type = shift;
40 35   100     195 my $seen = shift || {};
41 35         135 my $type_constraint = find_type_constraint( $type );
42 35         4434 my $current_container = $self->current_container;
43              
44             # the type must exist ...
45 35 50       100 (defined $type_constraint)
46             || confess "$type is not an existing valid Moose type";
47              
48             # the type must be either
49             # a class type, or a subtype
50             # of object.
51 35 50 66     293 ($type_constraint->isa('Moose::Meta::TypeConstraint::Class')
52             ||
53             $type_constraint->is_subtype_of('Object'))
54             || confess 'Only class types, role types, or subtypes of Object can be inferred. '
55             . 'I don\'t know what to do with type (' . $type_constraint->name . ')';
56              
57 35         2398 my %params = (
58             name => 'type:' . $type,
59             );
60              
61 35 100       1239 if ($self->has_service) {
62 1         30 my $service = $self->service;
63 1         33 %params = (
64             %params,
65             name => $service->name,
66             class => $service->class,
67             dependencies => $service->dependencies,
68             parameters => $service->parameters,
69             );
70             }
71             else {
72             %params = (
73             %params,
74 34         106 %{ $self->service_args }
  34         1035  
75             );
76             }
77              
78             # if the class is specified, then
79             # we can use that reliably, otherwise
80             # we need to try and figure out the
81             # class name ...
82 35 100       128 unless ( exists $params{'class'} ) {
83             # if it is a class type, it is easy
84 28 100       120 if ($type_constraint->isa('Moose::Meta::TypeConstraint::Class')) {
85 27         942 $params{'class'} = $type_constraint->class;
86             }
87             # if it is not a class type, then
88             # we will make the assumption that
89             # the name of the type constraint
90             # is also the name of the class.
91             else {
92 1         30 $params{'class'} = $type_constraint->name;
93             }
94             }
95              
96             my $meta = Class::MOP::class_of($params{'class'})
97 35   33     451 || confess "Could not get the meta object for class(" . $params{'class'} . ")";
98              
99 35 50       680 ($meta->isa('Moose::Meta::Class'))
    100          
100             || confess "We can only infer Moose classes"
101             . ($meta->isa('Moose::Meta::Role')
102             ? (', ' . $meta->name . ' is a role and therefore not concrete enough')
103             : '');
104              
105             my @required_attributes = grep {
106 34 100       157 $_->is_required && $_->has_type_constraint
  36         3123  
107             } $meta->get_all_attributes;
108              
109 34   100     1818 $params{'dependencies'} ||= {};
110 34   100     185 $params{'parameters'} ||= {};
111              
112             # defer this for now ...
113 34         95 $seen->{ $type } = $params{'name'};
114              
115 34         96 foreach my $attribute (@required_attributes) {
116 32         126 my $name = $attribute->name;
117              
118 32 100       97 next if exists $params{'dependencies'}->{ $name };
119              
120 30         995 my $type_constraint = $attribute->type_constraint;
121 30 100       1253 my $type_name = $type_constraint->isa('Moose::Meta::TypeConstraint::Class')
122             ? $type_constraint->class
123             : $type_constraint->name;
124              
125 30         232 my $service;
126 30 100       150 if ($current_container->has_type_mapping_for( $type_name )) {
    100          
127 11         44 $service = $current_container->get_type_mapping_for( $type_name )
128             }
129             elsif ( exists $seen->{ $type_name } ) {
130 1 50       7 if ( blessed($seen->{ $type_name }) ) {
131             # if the type has already been
132             # inferred, then we use it
133 0         0 $service = $seen->{ $type_name };
134             }
135             else {
136             # if not, then we have to use
137             # the built in laziness and
138             # make it a dependency
139             $service = Bread::Board::Dependency->new(
140 1         36 service_path => $seen->{ $type_name }
141             );
142             }
143             }
144             else {
145 18 100 100     181 if (
146             $type_constraint->isa('Moose::Meta::TypeConstraint::Class')
147             ||
148             $type_constraint->is_subtype_of('Object')
149             ) {
150 11         670 $service = Bread::Board::Service::Inferred->new(
151             current_container => $self->current_container
152             )->infer_service(
153             $type_name,
154             $seen
155             );
156             } else {
157 7 100       3274 if ($self->infer_params) {
158 6         22 $params{'parameters'}->{ $name } = { isa => $type_name };
159             }
160             else {
161 1         221 confess 'Only class types, role types, or subtypes of Object can be inferred. '
162             . 'I don\'t know what to do with type (' . $type_name . ')';
163             }
164             }
165             }
166              
167 26 100       463 $params{'dependencies'}->{ $name } = $service
168             if defined $service;
169             }
170              
171 30 100       1026 if ( $self->infer_params ) {
172             map {
173 2 50       102 $params{'parameters'}->{ $_->name } = {
174             optional => 1,
175             ($_->has_type_constraint
176             ? ( isa => $_->type_constraint )
177             : ())
178             };
179             } grep {
180 22         133 ( not $_->is_required )
  25         1718  
181             } $meta->get_all_attributes
182             }
183              
184             # NOTE:
185             # this is always going to be
186             # constructor injection because
187             # that is what we do when we
188             # infer. No other type of
189             # injection makes sense here.
190             # - SL
191 30         576 my $service;
192 30 100       1122 if ($self->has_service) {
193 1         42 $service = $self->service->clone(%params);
194             }
195             else {
196 29         990 $service = Bread::Board::ConstructorInjection->new(%params);
197             }
198              
199             # NOTE:
200             # We need to do this so that
201             # anything created by a typemap
202             # can still also refer back to
203             # an actual service in the parent
204             # container.
205             # - SL
206 30         973 $self->current_container->add_service( $service );
207              
208 30         175 $service;
209             }
210              
211             __PACKAGE__->meta->make_immutable;
212              
213 53     53   509 no Moose; 1;
  53         178  
  53         356  
214              
215             __END__
216              
217             =pod
218              
219             =encoding UTF-8
220              
221             =head1 NAME
222              
223             Bread::Board::Service::Inferred - Helper for inferring a service from a Moose object
224              
225             =head1 VERSION
226              
227             version 0.37
228              
229             =head1 DESCRIPTION
230              
231             CAUTION, EXPERIMENTAL FEATURE.
232              
233             Docs to come, as well as refactoring.
234              
235             =head1 METHODS
236              
237             =head2 C<infer_service>
238              
239             =head1 AUTHOR
240              
241             Stevan Little <stevan@iinteractive.com>
242              
243             =head1 BUGS
244              
245             Please report any bugs or feature requests on the bugtracker website
246             https://github.com/stevan/BreadBoard/issues
247              
248             When submitting a bug or request, please include a test-file or a
249             patch to an existing test-file that illustrates the bug or desired
250             feature.
251              
252             =head1 COPYRIGHT AND LICENSE
253              
254             This software is copyright (c) 2019, 2017, 2016, 2015, 2014, 2013, 2011, 2009 by Infinity Interactive.
255              
256             This is free software; you can redistribute it and/or modify it under
257             the same terms as the Perl 5 programming language system itself.
258              
259             =cut