lib/Catalyst/IOC/Service/WithCOMPONENT.pm

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