lib/Catalyst/IOC/ConstructorInjection.pm

   1 package Catalyst::IOC::ConstructorInjection;
   2 use Moose;
   3 extends 'Bread::Board::ConstructorInjection';
   4
   5 with 'Catalyst::IOC::Service::WithAcceptContext';
   6
   7 sub _build_constructor_name { 'COMPONENT' }
   8
   9 sub get {
  10     my $self = shift;
  11
  12     my $constructor = $self->constructor_name;
  13     my $config      = $self->param('config')->{ $self->params->{suffix} } || {};
  14     my $class       = $self->param('class');
  15     my $component   = $self->class;
  16
  17     unless ( $self->class->can( $constructor ) ) {
  18         # FIXME - make some deprecation warnings
  19         return $component;
  20     }
  21
  22     # Stash catalyst_component_name in the config here, so that custom COMPONENT
  23     # methods also pass it. local to avoid pointlessly shitting in config
  24     # for the debug screen, as $component is already the key name.
  25     local $config->{catalyst_component_name} = $self->class;
  26
  27     my $instance = eval { $component->$constructor( $class, $config ) };
  28
  29     if ( my $error = $@ ) {
  30         chomp $error;
  31         Catalyst::Exception->throw(
  32             message => qq/Couldn't instantiate component "$component", "$error"/
  33         );
  34     }
  35     elsif (!blessed $instance) {
  36         my $metaclass = Moose::Util::find_meta($component);
  37         my $method_meta = $metaclass->find_method_by_name('COMPONENT');
  38         my $component_method_from = $method_meta->associated_metaclass->name;
  39         my $value = defined($instance) ? $instance : 'undef';
  40         Catalyst::Exception->throw(
  41             message =>
  42             qq/Couldn't instantiate component "$component", COMPONENT() method (from $component_method_from) didn't return an object-like value (value was $value)./
  43         );
  44     }
  45
  46     return $instance;
  47 }
  48
  49 __PACKAGE__->meta->make_immutable;
  50
  51 no Moose; 1;
  52
  53 __END__
  54
  55 =pod
  56
  57 =head1 NAME
  58
  59 Catalyst::IOC::BlockInjection
  60
  61 =head1 AUTHORS
  62
  63 Catalyst Contributors, see Catalyst.pm
  64
  65 =head1 COPYRIGHT
  66
  67 This library is free software. You can redistribute it and/or modify it under
  68 the same terms as Perl itself.
  69
  70 =cut