lib/Catalyst/IOC/ConstructorInjection.pm

   1 package Catalyst::IOC::ConstructorInjection;
   2 use Moose;
   3 extends 'Bread::Board::ConstructorInjection';
   4
   5 with 'Bread::Board::Service::WithClass',
   6      'Bread::Board::Service::WithDependencies',
   7      'Bread::Board::Service::WithParameters',
   8      'Catalyst::IOC::Service::WithAcceptContext';
   9
  10 sub _build_constructor_name { 'COMPONENT' }
  11
  12 sub get {
  13     my $self = shift;
  14
  15     my $constructor = $self->constructor_name;
  16     my $component   = $self->class;
  17     my $params      = $self->params;
  18     my $config      = $params->{config}->{ $self->param('suffix') } || {};
  19     my $app_name    = $params->{application_name};
  20
  21     unless ( $component->can( $constructor ) ) {
  22         # FIXME - make some deprecation warnings
  23         return $component;
  24     }
  25
  26     # Stash catalyst_component_name in the config here, so that custom COMPONENT
  27     # methods also pass it. local to avoid pointlessly shitting in config
  28     # for the debug screen, as $component is already the key name.
  29     local $config->{catalyst_component_name} = $component;
  30
  31     my $instance = eval { $component->$constructor( $app_name, $config ) };
  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('COMPONENT');
  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", COMPONENT() method (from $component_method_from) didn't return an object-like value (value was $value)./
  47         );
  48     }
  49
  50     return $instance;
  51 }
  52
  53 __PACKAGE__->meta->make_immutable;
  54
  55 no Moose; 1;
  56
  57 __END__
  58
  59 =pod
  60
  61 =head1 NAME
  62
  63 Catalyst::IOC::BlockInjection
  64
  65 =head1 AUTHORS
  66
  67 Catalyst Contributors, see Catalyst.pm
  68
  69 =head1 COPYRIGHT
  70
  71 This library is free software. You can redistribute it and/or modify it under
  72 the same terms as Perl itself.
  73
  74 =cut