lib/Catalyst/IOC.pm

   1 package Catalyst::IOC;
   2 use strict;
   3 use warnings;
   4 use Bread::Board qw/depends_on/;
   5 use Catalyst::IOC::ConstructorInjection;
   6 no strict 'refs';
   7
   8 use Sub::Exporter -setup => {
   9     exports => [qw/
  10         depends_on
  11         component
  12         model
  13         container
  14     /],
  15     groups  => { default => [qw/
  16         depends_on
  17         component
  18         model
  19         container
  20     /]},
  21 };
  22
  23 sub container (&) {
  24     my $code = shift;
  25     my $caller = caller;
  26     ${"${caller}::customise_container"} = sub {
  27         local ${"${caller}::current_container"} = shift;
  28         $code->();
  29     };
  30 }
  31
  32 sub model (&)      { _subcontainer( shift, caller, 'model' )      }
  33 sub view (&)       { _subcontainer( shift, caller, 'view' )       }
  34 sub controller (&) { _subcontainer( shift, caller, 'controller' ) }
  35
  36 sub _subcontainer (&$$) {
  37     my ( $code, $caller, $subcontainer ) = @_;
  38     local ${"${caller}::current_container"} =
  39         ${"${caller}::current_container"}->get_sub_container($subcontainer);
  40     $code->();
  41 }
  42
  43 sub component ($;%) {
  44     my ($name, %args) = @_;
  45     my $caller = caller;
  46     $args{dependencies} ||= {};
  47     $args{dependencies}{application_name} = depends_on( '/application_name' );
  48
  49     my $lifecycle = $args{lifecycle};
  50     my %catalyst_lifecycles = map { $_ => 1 } qw/ COMPONENTSingleton Request /;
  51     $args{lifecycle} = $lifecycle
  52                      ? $catalyst_lifecycles{$lifecycle} ? "+Catalyst::IOC::LifeCycle::$lifecycle" : $lifecycle
  53                      : 'Singleton'
  54                      ;
  55
  56     # FIXME - check $args{type} here!
  57
  58     my $component_name = join '::', (
  59         ${"${caller}::current_container"}->resolve(service => '/application_name'),
  60         ucfirst(${"${caller}::current_container"}->name),
  61         $name
  62     );
  63
  64     my $service = Catalyst::IOC::ConstructorInjection->new(
  65         %args,
  66         name => $name,
  67         catalyst_component_name => $component_name,
  68     );
  69     ${"${caller}::current_container"}->add_service($service);
  70 }
  71
  72 1;
  73
  74 __END__
  75
  76 =pod
  77
  78 =head1 NAME
  79
  80 Catalyst::IOC - IOC for Catalyst, based on Bread::Board
  81
  82 =head1 SYNOPSIS
  83
  84     package MyApp::Container;
  85     use Catalyst::IOC;
  86
  87     sub BUILD {
  88         my $self = shift;
  89
  90         container $self => as {
  91             container model => as {
  92
  93                 # default component
  94                 component Foo => ();
  95
  96                 # model Bar needs model Foo to be built before
  97                 # and Bar's constructor gets Foo as a parameter
  98                 component Bar => ( dependencies => [
  99                     depends_on('/model/Foo'),
 100                 ]);
 101
 102                 # Baz is rebuilt once per HTTP request
 103                 component Baz => ( lifecycle => 'Request' );
 104
 105                 # built only once per application life time
 106                 component Quux => ( lifecycle => 'Singleton' );
 107
 108                 # built once per app life time and uses an external model,
 109                 # outside the default directory
 110                 # no need for wrappers or Catalyst::Model::Adaptor
 111                 component Fnar => (
 112                     lifecycle => 'Singleton',
 113                     class => 'My::External::Class',
 114                 );
 115             };
 116         }
 117     }
 118
 119 =head1 DESCRIPTION
 120
 121 =head1 METHODS
 122
 123 =head2 container
 124
 125 =head2 model
 126
 127 =head2 view
 128
 129 =head2 controller
 130
 131 =head2 component
 132
 133 =head1 AUTHORS
 134
 135 Catalyst Contributors, see Catalyst.pm
 136
 137 =head1 SEE ALSO
 138
 139 L<Bread::Board>
 140
 141 =head1 COPYRIGHT
 142
 143 This library is free software. You can redistribute it and/or modify it under
 144 the same terms as Perl itself.
 145
 146 =cut