lib/Catalyst/IOC/Service/WithCOMPONENT.pm

   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