Commit | Line | Data |
cd9c7aae |
1 | package Catalyst::IOC::Service::WithCOMPONENT; |
2 | use Moose::Role; |
3 | |
4 | with 'Bread::Board::Service'; |
5 | |
6 | # FIXME - just till I understand how it's supposed to be done |
7 | # Made this so that COMPONENT is executed once, |
8 | # and ACCEPT_CONTEXT every call. |
9 | has instance => ( |
10 | is => 'rw', |
11 | required => 0, |
12 | ); |
13 | |
14 | sub _build_constructor_name { 'COMPONENT' } |
15 | |
16 | around 'get' => sub { |
17 | my ( $orig, $self ) = @_; |
18 | |
19 | my $constructor = $self->constructor_name; |
20 | my $component = $self->class; |
21 | |
22 | unless ( $component->can( $constructor ) ) { |
23 | # FIXME - make some deprecation warnings |
24 | return $component; |
25 | } |
26 | |
27 | if ($self->instance) { |
28 | return $self->instance; |
29 | } |
30 | |
31 | my $instance = eval { $self->$orig() }; |
32 | |
33 | if ( my $error = $@ ) { |
34 | chomp $error; |
35 | Catalyst::Exception->throw( |
36 | message => qq/Couldn't instantiate component "$component", "$error"/ |
37 | ); |
38 | } |
39 | elsif (!blessed $instance) { |
40 | my $metaclass = Moose::Util::find_meta($component); |
41 | my $method_meta = $metaclass->find_method_by_name($constructor); |
42 | my $component_method_from = $method_meta->associated_metaclass->name; |
43 | my $value = defined($instance) ? $instance : 'undef'; |
44 | Catalyst::Exception->throw( |
45 | message => |
46 | qq/Couldn't instantiate component "$component", $constructor() method (from $component_method_from) didn't return an object-like value (value was $value)./ |
47 | ); |
48 | } |
49 | |
50 | $self->instance($instance); |
51 | |
52 | return $instance; |
53 | }; |
54 | |
55 | no Moose::Role; |
56 | 1; |
57 | |
58 | __END__ |
59 | |
60 | =pod |
61 | |
62 | =head1 NAME |
63 | |
64 | Catalyst::Service::WithCOMPONENT |
65 | |
66 | =head1 DESCRIPTION |
67 | |
68 | =head1 METHODS |
69 | |
70 | =head1 AUTHORS |
71 | |
72 | Catalyst Contributors, see Catalyst.pm |
73 | |
74 | =head1 COPYRIGHT |
75 | |
76 | This library is free software. You can redistribute it and/or modify it under |
77 | the same terms as Perl itself. |
78 | |
79 | =cut |