lib/Catalyst/IOC/Container.pm

   1 package Catalyst::IOC::Container;
   2 use Bread::Board qw/depends_on/;
   3 use Moose;
   4 use Config::Any;
   5 use Data::Visitor::Callback;
   6 use Catalyst::Utils ();
   7 use List::Util qw(first);
   8 use Devel::InnerPackage ();
   9 use Hash::Util qw/lock_hash/;
  10 use MooseX::Types::LoadableClass qw/ LoadableClass /;
  11 use Moose::Util;
  12 use Scalar::Util qw/refaddr/;
  13 use Catalyst::IOC::BlockInjection;
  14 use Catalyst::IOC::ConstructorInjection;
  15 use Module::Pluggable::Object ();
  16 use namespace::autoclean;
  17
  18 extends 'Bread::Board::Container';
  19
  20 has config_local_suffix => (
  21     is      => 'ro',
  22     isa     => 'Str',
  23     default => 'local',
  24 );
  25
  26 has driver => (
  27     is      => 'ro',
  28     isa     => 'HashRef',
  29     default => sub { +{} },
  30 );
  31
  32 has file => (
  33     is      => 'ro',
  34     isa     => 'Str',
  35     default => '',
  36 );
  37
  38 has substitutions => (
  39     is      => 'ro',
  40     isa     => 'HashRef',
  41     default => sub { +{} },
  42 );
  43
  44 has sub_container_class => (
  45     isa     => LoadableClass,
  46     is      => 'ro',
  47     coerce  => 1,
  48     default => 'Catalyst::IOC::SubContainer',
  49     handles => {
  50         new_sub_container => 'new',
  51     }
  52 );
  53
  54 sub BUILD {
  55     my ( $self, $params ) = @_;
  56
  57     $self->add_service(
  58         $self->${\"build_${_}_service"}
  59     ) for qw/
  60         substitutions
  61         file
  62         driver
  63         catalyst_application
  64         prefix
  65         extensions
  66         path
  67         config
  68         raw_config
  69         global_files
  70         local_files
  71         global_config
  72         local_config
  73         class_config
  74         config_local_suffix
  75         config_path
  76         locate_components
  77         home
  78         root_dir
  79     /;
  80
  81     my $config = $self->resolve( service => 'config' );
  82
  83     # don't force default_component to be undef if the config wasn't set
  84     my @default_view  = $config->{default_view}
  85                       ? ( default_component => $config->{default_view} )
  86                       : ( )
  87                       ;
  88     my @default_model = $config->{default_model}
  89                       ? ( default_component => $config->{default_model} )
  90                       : ( )
  91                       ;
  92
  93     $self->add_sub_container(
  94         $self->build_component_subcontainer
  95     );
  96
  97     $self->add_sub_container(
  98         $self->build_controller_subcontainer
  99     );
 100
 101     $self->add_sub_container(
 102         $self->build_view_subcontainer( @default_view )
 103     );
 104
 105     $self->add_sub_container(
 106         $self->build_model_subcontainer( @default_model )
 107     );
 108
 109     {
 110         no strict 'refs';
 111         no warnings 'once';
 112         my $class = ref $self;
 113         ${ $class . '::customise_container' }->($self)
 114             if ${ $class . '::customise_container' };
 115     }
 116 }
 117
 118 sub build_model_subcontainer {
 119     my $self = shift;
 120
 121     return $self->new_sub_container( @_,
 122         name => 'model',
 123     );
 124 }
 125
 126 sub build_view_subcontainer {
 127     my $self = shift;
 128
 129     return $self->new_sub_container( @_,
 130         name => 'view',
 131     );
 132 }
 133
 134 sub build_controller_subcontainer {
 135     my $self = shift;
 136
 137     return $self->new_sub_container(
 138         name => 'controller',
 139     );
 140 }
 141
 142 sub build_component_subcontainer {
 143     my $self = shift;
 144
 145     return Bread::Board::Container->new(
 146         name => 'component',
 147     );
 148 }
 149
 150 sub build_home_service {
 151     my $self = shift;
 152
 153     return Bread::Board::BlockInjection->new(
 154         lifecycle => 'Singleton',
 155         name => 'home',
 156         block => sub {
 157             my $self  = shift;
 158             my $class = $self->param('catalyst_application');
 159
 160             if ( my $env = Catalyst::Utils::env_value( $class, 'HOME' ) ) {
 161                 return $env;
 162             }
 163
 164             if ( my $home = $self->param('home_flag') ) {
 165                 return $home;
 166             }
 167
 168             return Catalyst::Utils::home($class);
 169         },
 170         parameters   => {
 171             home_flag => { is => 'ro', isa => 'Str|Undef', required => 0 }
 172         },
 173         dependencies => [ depends_on('catalyst_application') ],
 174     );
 175 }
 176
 177 sub build_root_dir_service {
 178     my $self = shift;
 179
 180     return Bread::Board::BlockInjection->new(
 181         lifecycle => 'Singleton',
 182         name => 'root_dir',
 183         block => sub {
 184             my $self = shift;
 185
 186             return Path::Class::Dir->new( $self->param('home') )->subdir('root');
 187         },
 188         dependencies => [ depends_on('home') ],
 189     );
 190 }
 191
 192 sub build_catalyst_application_service {
 193     my $self = shift;
 194
 195     return Bread::Board::Literal->new( name => 'catalyst_application', value => $self->name );
 196 }
 197
 198 sub build_driver_service {
 199     my $self = shift;
 200
 201     return Bread::Board::Literal->new( name => 'driver', value => $self->driver );
 202 }
 203
 204 sub build_file_service {
 205     my $self = shift;
 206
 207     return Bread::Board::Literal->new( name => 'file', value => $self->file );
 208 }
 209
 210 sub build_substitutions_service {
 211     my $self = shift;
 212
 213     return Bread::Board::Literal->new( name => 'substitutions', value => $self->substitutions );
 214 }
 215
 216 sub build_extensions_service {
 217     my $self = shift;
 218
 219     return Bread::Board::BlockInjection->new(
 220         lifecycle => 'Singleton',
 221         name => 'extensions',
 222         block => sub {
 223             return \@{Config::Any->extensions};
 224         },
 225     );
 226 }
 227
 228 sub build_prefix_service {
 229     my $self = shift;
 230
 231     return Bread::Board::BlockInjection->new(
 232         lifecycle => 'Singleton',
 233         name => 'prefix',
 234         block => sub {
 235             return Catalyst::Utils::appprefix( shift->param('catalyst_application') );
 236         },
 237         dependencies => [ depends_on('catalyst_application') ],
 238     );
 239 }
 240
 241 sub build_path_service {
 242     my $self = shift;
 243
 244     return Bread::Board::BlockInjection->new(
 245         lifecycle => 'Singleton',
 246         name => 'path',
 247         block => sub {
 248             my $s = shift;
 249
 250             return Catalyst::Utils::env_value( $s->param('catalyst_application'), 'CONFIG' )
 251             || $s->param('file')
 252             || $s->param('catalyst_application')->path_to( $s->param('prefix') );
 253         },
 254         dependencies => [ depends_on('file'), depends_on('catalyst_application'), depends_on('prefix') ],
 255     );
 256 }
 257
 258 sub build_config_service {
 259     my $self = shift;
 260
 261     return Bread::Board::BlockInjection->new(
 262         lifecycle => 'Singleton',
 263         name => 'config',
 264         block => sub {
 265             my $s = shift;
 266
 267             my $v = Data::Visitor::Callback->new(
 268                 plain_value => sub {
 269                     return unless defined $_;
 270                     return $self->_config_substitutions( $s->param('catalyst_application'), $s->param('substitutions'), $_ );
 271                 }
 272
 273             );
 274             $v->visit( $s->param('raw_config') );
 275         },
 276         dependencies => [ depends_on('catalyst_application'), depends_on('raw_config'), depends_on('substitutions') ],
 277     );
 278 }
 279
 280 sub build_raw_config_service {
 281     my $self = shift;
 282
 283     return Bread::Board::BlockInjection->new(
 284         lifecycle => 'Singleton',
 285         name => 'raw_config',
 286         block => sub {
 287             my $s = shift;
 288
 289             my @global = @{$s->param('global_config')};
 290             my @locals = @{$s->param('local_config')};
 291
 292             my $config = $s->param('class_config');
 293
 294             for my $cfg (@global, @locals) {
 295                 for (keys %$cfg) {
 296                     $config = Catalyst::Utils::merge_hashes( $config, $cfg->{$_} );
 297                 }
 298             }
 299
 300             return $config;
 301         },
 302         dependencies => [ depends_on('global_config'), depends_on('local_config'), depends_on('class_config') ],
 303     );
 304 }
 305
 306 sub build_global_files_service {
 307     my $self = shift;
 308
 309     return Bread::Board::BlockInjection->new(
 310         lifecycle => 'Singleton',
 311         name => 'global_files',
 312         block => sub {
 313             my $s = shift;
 314
 315             my ( $path, $extension ) = @{$s->param('config_path')};
 316
 317             my @extensions = @{$s->param('extensions')};
 318
 319             my @files;
 320             if ( $extension ) {
 321                 die "Unable to handle files with the extension '${extension}'" unless grep { $_ eq $extension } @extensions;
 322                 push @files, $path;
 323             } else {
 324                 @files = map { "$path.$_" } @extensions;
 325             }
 326             return \@files;
 327         },
 328         dependencies => [ depends_on('extensions'), depends_on('config_path') ],
 329     );
 330 }
 331
 332 sub build_local_files_service {
 333     my $self = shift;
 334
 335     return Bread::Board::BlockInjection->new(
 336         lifecycle => 'Singleton',
 337         name => 'local_files',
 338         block => sub {
 339             my $s = shift;
 340
 341             my ( $path, $extension ) = @{$s->param('config_path')};
 342             my $suffix = $s->param('config_local_suffix');
 343
 344             my @extensions = @{$s->param('extensions')};
 345
 346             my @files;
 347             if ( $extension ) {
 348                 die "Unable to handle files with the extension '${extension}'" unless grep { $_ eq $extension } @extensions;
 349                 $path =~ s{\.$extension}{_$suffix.$extension};
 350                 push @files, $path;
 351             } else {
 352                 @files = map { "${path}_${suffix}.$_" } @extensions;
 353             }
 354             return \@files;
 355         },
 356         dependencies => [ depends_on('extensions'), depends_on('config_path'), depends_on('config_local_suffix') ],
 357     );
 358 }
 359
 360 sub build_class_config_service {
 361     my $self = shift;
 362
 363     return Bread::Board::BlockInjection->new(
 364         lifecycle => 'Singleton',
 365         name => 'class_config',
 366         block => sub {
 367             my $s   = shift;
 368             my $app = $s->param('catalyst_application');
 369
 370             # Container might be called outside Catalyst context
 371             return {} unless Class::MOP::is_class_loaded($app);
 372
 373             # config might not have been defined
 374             return $app->config || {};
 375         },
 376         dependencies => [ depends_on('catalyst_application') ],
 377     );
 378 }
 379
 380 sub build_global_config_service {
 381     my $self = shift;
 382
 383     return Bread::Board::BlockInjection->new(
 384         lifecycle => 'Singleton',
 385         name => 'global_config',
 386         block => sub {
 387             my $s = shift;
 388
 389             return Config::Any->load_files({
 390                 files       => $s->param('global_files'),
 391                 filter      => \&_fix_syntax,
 392                 use_ext     => 1,
 393                 driver_args => $s->param('driver'),
 394             });
 395         },
 396         dependencies => [ depends_on('global_files') ],
 397     );
 398 }
 399
 400 sub build_local_config_service {
 401     my $self = shift;
 402
 403     return Bread::Board::BlockInjection->new(
 404         lifecycle => 'Singleton',
 405         name => 'local_config',
 406         block => sub {
 407             my $s = shift;
 408
 409             return Config::Any->load_files({
 410                 files       => $s->param('local_files'),
 411                 filter      => \&_fix_syntax,
 412                 use_ext     => 1,
 413                 driver_args => $s->param('driver'),
 414             });
 415         },
 416         dependencies => [ depends_on('local_files') ],
 417     );
 418 }
 419
 420 sub build_config_path_service {
 421     my $self = shift;
 422
 423     return Bread::Board::BlockInjection->new(
 424         lifecycle => 'Singleton',
 425         name => 'config_path',
 426         block => sub {
 427             my $s = shift;
 428
 429             my $path = $s->param('path');
 430             my $prefix = $s->param('prefix');
 431
 432             my ( $extension ) = ( $path =~ m{\.(.{1,4})$} );
 433
 434             if ( -d $path ) {
 435                 $path =~ s{[\/\\]$}{};
 436                 $path .= "/$prefix";
 437             }
 438
 439             return [ $path, $extension ];
 440         },
 441         dependencies => [ depends_on('prefix'), depends_on('path') ],
 442     );
 443 }
 444
 445 sub build_config_local_suffix_service {
 446     my $self = shift;
 447
 448     return Bread::Board::BlockInjection->new(
 449         lifecycle => 'Singleton',
 450         name => 'config_local_suffix',
 451         block => sub {
 452             my $s = shift;
 453             my $suffix = Catalyst::Utils::env_value( $s->param('catalyst_application'), 'CONFIG_LOCAL_SUFFIX' ) || $self->config_local_suffix;
 454
 455             return $suffix;
 456         },
 457         dependencies => [ depends_on('catalyst_application') ],
 458     );
 459 }
 460
 461 sub build_locate_components_service {
 462     my $self = shift;
 463
 464     return Bread::Board::BlockInjection->new(
 465         lifecycle => 'Singleton',
 466         name      => 'locate_components',
 467         block     => sub {
 468             my $s      = shift;
 469             my $class  = $s->param('catalyst_application');
 470             my $config = $s->param('config')->{ setup_components };
 471
 472             Catalyst::Exception->throw(
 473                 qq{You are using search_extra config option. That option is\n} .
 474                 qq{deprecated, please refer to the documentation for\n} .
 475                 qq{other ways of achieving the same results.\n}
 476             ) if delete $config->{ search_extra };
 477
 478             my @paths = qw( ::Controller ::C ::Model ::M ::View ::V );
 479
 480             my $locator = Module::Pluggable::Object->new(
 481                 search_path => [ map { s/^(?=::)/$class/; $_; } @paths ],
 482                 %$config
 483             );
 484
 485             return [ $locator->plugins ];
 486         },
 487         dependencies => [ depends_on('catalyst_application'), depends_on('config') ],
 488     );
 489 }
 490
 491 sub setup_components {
 492     my $self = shift;
 493     my $class = $self->resolve( service => 'catalyst_application' );
 494     my @comps = @{ $self->resolve( service => 'locate_components' ) };
 495     my %comps = map { $_ => 1 } @comps;
 496     my $deprecatedcatalyst_component_names = 0;
 497
 498     my $app_locate_components_addr = refaddr(
 499         $class->can('locate_components')
 500     );
 501     my $cat_locate_components_addr = refaddr(
 502         Catalyst->can('locate_components')
 503     );
 504
 505     if ($app_locate_components_addr != $cat_locate_components_addr) {
 506         # FIXME - why not just say: @comps = $class->locate_components() ?
 507         $class->log->warn(qq{You have overridden locate_components. That } .
 508             qq{no longer works. Please refer to the documentation to achieve } .
 509             qq{similar results.\n}
 510         );
 511     }
 512
 513     for my $component ( @comps ) {
 514
 515         # We pass ignore_loaded here so that overlay files for (e.g.)
 516         # Model::DBI::Schema sub-classes are loaded - if it's in @comps
 517         # we know M::P::O found a file on disk so this is safe
 518
 519         Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
 520     }
 521
 522     for my $component (@comps) {
 523         $self->add_component( $component );
 524         # FIXME - $instance->expand_modules() is broken
 525         my @expanded_components = $self->expand_component_module( $component );
 526
 527         if (
 528             !$deprecatedcatalyst_component_names &&
 529             ($deprecatedcatalyst_component_names = $component =~ m/::[CMV]::/) ||
 530             ($deprecatedcatalyst_component_names = grep { /::[CMV]::/ } @expanded_components)
 531         ) {
 532             # FIXME - should I be calling warn here?
 533             # Maybe it's time to remove it, or become fatal
 534             $class->log->warn(qq{Your application is using the deprecated ::[MVC]:: type naming scheme.\n}.
 535                 qq{Please switch your class names to ::Model::, ::View:: and ::Controller: as appropriate.\n}
 536             );
 537         }
 538
 539         for my $component (@expanded_components) {
 540             $self->add_component( $component )
 541                 unless $comps{$component};
 542         }
 543     }
 544 }
 545
 546 sub _fix_syntax {
 547     my $config     = shift;
 548     my @components = (
 549         map +{
 550             prefix => $_ eq 'Component' ? '' : $_ . '::',
 551             values => delete $config->{ lc $_ } || delete $config->{ $_ }
 552         },
 553         grep { ref $config->{ lc $_ } || ref $config->{ $_ } }
 554             qw( Component Model M View V Controller C Plugin )
 555     );
 556
 557     foreach my $comp ( @components ) {
 558         my $prefix = $comp->{ prefix };
 559         foreach my $element ( keys %{ $comp->{ values } } ) {
 560             $config->{ "$prefix$element" } = $comp->{ values }->{ $element };
 561         }
 562     }
 563 }
 564
 565 sub _config_substitutions {
 566     my ( $self, $name, $subs, $arg ) = @_;
 567
 568     $subs->{ HOME } ||= sub { shift->path_to( '' ); };
 569     $subs->{ ENV } ||=
 570         sub {
 571             my ( $c, $v ) = @_;
 572             if (! defined($ENV{$v})) {
 573                 Catalyst::Exception->throw( message =>
 574                     "Missing environment variable: $v" );
 575                 return "";
 576             } else {
 577                 return $ENV{ $v };
 578             }
 579         };
 580     $subs->{ path_to } ||= sub { shift->path_to( @_ ); };
 581     $subs->{ literal } ||= sub { return $_[ 1 ]; };
 582     my $subsre = join( '|', keys %$subs );
 583
 584     $arg =~ s{__($subsre)(?:\((.+?)\))?__}{ $subs->{ $1 }->( $name, $2 ? split( /,/, $2 ) : () ) }eg;
 585     return $arg;
 586 }
 587
 588 sub get_component_from_sub_container {
 589     my ( $self, $sub_container_name, $name, $c, @args ) = @_;
 590
 591     my $sub_container = $self->get_sub_container( $sub_container_name );
 592
 593     if (!$name) {
 594         my $default = $sub_container->default_component;
 595
 596         return $sub_container->get_component( $default, $c, @args )
 597             if $default && $sub_container->has_service( $default );
 598
 599         # FIXME - should I be calling $c->log->warn here?
 600         # this is never a controller, so this is safe
 601         $c->log->warn( "Calling \$c->$sub_container_name() is not supported unless you specify one of:" );
 602         $c->log->warn( "* \$c->config(default_$sub_container_name => 'the name of the default $sub_container_name to use')" );
 603         $c->log->warn( "* \$c->stash->{current_$sub_container_name} # the name of the view to use for this request" );
 604         $c->log->warn( "* \$c->stash->{current_${sub_container_name}_instance} # the instance of the $sub_container_name to use for this request" );
 605
 606         return;
 607     }
 608
 609     return $sub_container->get_component_regexp( $name, $c, @args )
 610         if ref $name;
 611
 612     return $sub_container->get_component( $name, $c, @args )
 613         if $sub_container->has_service( $name );
 614
 615     $c->log->warn(
 616         "Attempted to use $sub_container_name '$name', " .
 617         "but it does not exist"
 618     );
 619
 620     return;
 621 }
 622
 623 sub find_component {
 624     my ( $self, $component, @args ) = @_;
 625     my ( $type, $name ) = _get_component_type_name($component);
 626     my @result;
 627
 628     return $self->get_component_from_sub_container(
 629         $type, $name, @args
 630     ) if $type;
 631
 632     my $query = ref $component
 633               ? $component
 634               : qr{^$component$}
 635               ;
 636
 637     for my $subcontainer_name (qw/model view controller/) {
 638         my $subcontainer = $self->get_sub_container( $subcontainer_name );
 639         my @components   = $subcontainer->get_service_list;
 640         @result          = grep { m{$component} } @components;
 641
 642         return map { $subcontainer->get_component( $_, @args ) } @result
 643             if @result;
 644     }
 645
 646     # one last search for things like $c->comp(qr/::M::/)
 647     @result = $self->_find_component_regexp(
 648         $component, @args
 649     ) if !@result and ref $component;
 650
 651     # it expects an empty list on failed searches
 652     return @result;
 653 }
 654
 655 sub _find_component_regexp {
 656     my ( $self, $component, $ctx, @args ) = @_;
 657     my @result;
 658
 659     my @components = grep { m{$component} } keys %{ $self->get_all_components($ctx) };
 660
 661     for (@components) {
 662         my ($type, $name) = _get_component_type_name($_);
 663
 664         push @result, $self->get_component_from_sub_container(
 665             $type, $name, $ctx, @args
 666         ) if $type;
 667     }
 668
 669     return @result;
 670 }
 671
 672 # FIXME
 673 # what exactly should this method return?
 674 # By default, for back-compatibility, we have two services for each component:
 675 #   - one in the model|view|controller sub-container
 676 #   - and another in the component sub-container
 677 # the latter is a Singleton, it executes the COMPONENT method, and the first
 678 # is executed at every call, executing ACCEPT_CONTEXT. It's just a layer.
 679 #
 680 # So the one in $type sub-container is pretty useless by default. But when the
 681 # user overrides the container (which is what we want), the sub-container they
 682 # will use is precisely $type, not 'component'. So for now, I'm returning both
 683 # services, to decide later what to do.
 684 sub get_all_component_services {
 685     my $self = shift;
 686
 687     my %components;
 688     my $components_container = $self->get_sub_container('component');
 689
 690     foreach my $type (qw/model view controller /) {
 691         my $container = $self->get_sub_container($type);
 692
 693         for my $component ($container->get_service_list) {
 694             my $comp_service = $container->get_service($component);
 695
 696             my $key    = $comp_service->catalyst_component_name;
 697             my %values = (
 698                 type    => $type,
 699                 service => $comp_service,
 700             );
 701
 702             my $comp_name = "${type}_${component}";
 703             if ($components_container->has_service($comp_name)) {
 704                 $values{backcompat_service} = $components_container->get_service($comp_name);
 705             }
 706
 707             $components{$key} = \%values;
 708         }
 709     }
 710
 711     return lock_hash %components;
 712 }
 713
 714 sub get_all_singleton_lifecycle_components {
 715     my $self = shift;
 716
 717     my %components;
 718     my $components_container = $self->get_sub_container('component');
 719
 720     foreach my $type (qw/model view controller /) {
 721         my $container = $self->get_sub_container($type);
 722
 723         for my $component ($container->get_service_list) {
 724             my $comp_service = $container->get_service($component);
 725
 726             my $key       = $comp_service->catalyst_component_name;
 727             my $lifecycle = $comp_service->lifecycle;
 728             my $comp_name = "${type}_${component}";
 729
 730             if (defined $lifecycle && $lifecycle eq 'Singleton') {
 731                 $components{$key} = $comp_service->get;
 732             }
 733             elsif ($components_container->has_service($comp_name)) {
 734                 $components{$key} = $components_container->get_service($comp_name)->get;
 735             }
 736         }
 737     }
 738
 739     return lock_hash %components;
 740 }
 741
 742 sub get_all_components {
 743     my ($self, $class) = @_;
 744     my %components;
 745
 746     # FIXME - if we're getting from these containers, we need to either:
 747     #   - pass 'ctx' and 'accept_context_args' OR
 748     #   - make these params optional
 749     # big problem when setting up the dispatcher - this method is called
 750     # as $container->get_all_components('MyApp'). What to do with Request
 751     # life cycles?
 752     foreach my $type (qw/model view controller /) {
 753         my $container = $self->get_sub_container($type);
 754
 755         for my $component ($container->get_service_list) {
 756             my $comp_service = $container->get_service($component);
 757
 758             $components{$comp_service->catalyst_component_name} = $comp_service->get(ctx => $class);
 759         }
 760     }
 761
 762     return lock_hash %components;
 763 }
 764
 765 sub add_component {
 766     my ( $self, $component ) = @_;
 767     my ( $type, $name ) = _get_component_type_name($component);
 768
 769     return unless $type;
 770
 771     # The 'component' sub-container will create the object, and store it's
 772     # instance, which, by default, will live throughout the application.
 773     # The model/view/controller sub-containers only reference the instance
 774     # held in the aforementioned sub-container, and execute the ACCEPT_CONTEXT
 775     # sub every time they are called, when it exists.
 776     my $instance_container       = $self->get_sub_container('component');
 777     my $accept_context_container = $self->get_sub_container($type);
 778
 779     # Custom containers might have added the service already
 780     # We don't want to override that
 781     return if $accept_context_container->has_service( $name );
 782
 783     my $component_service_name = "${type}_${name}";
 784
 785     $instance_container->add_service(
 786         Catalyst::IOC::ConstructorInjection->new(
 787             name      => $component_service_name,
 788             catalyst_component_name => $component,
 789             class     => $component,
 790             lifecycle => 'Singleton',
 791             dependencies => [
 792                 depends_on( '/catalyst_application' ),
 793             ],
 794         ),
 795     );
 796     # XXX - FIXME - We have to explicitly build the service here,
 797     #               causing the COMPONENT method to be called early here, as otherwise
 798     #               if the component method defines other classes (e.g. the
 799     #               ACCEPT_CONTEXT injection Model::DBIC::Schema does)
 800     #               then they won't be found by Devel::InnerPackage
 801     # see also t/aggregate/unit_core_component_loading.t
 802     $instance_container->get_service($component_service_name)->get;
 803
 804     $accept_context_container->add_service(
 805         Catalyst::IOC::BlockInjection->new(
 806             name         => $name,
 807             catalyst_component_name => $component,
 808             dependencies => [
 809                 depends_on( "/component/$component_service_name" ),
 810             ],
 811             block => sub { shift->param($component_service_name) },
 812         )
 813     );
 814 }
 815
 816 # FIXME: should this sub exist?
 817 # should it be moved to Catalyst::Utils,
 818 # or replaced by something already existing there?
 819 sub _get_component_type_name {
 820     my ( $component ) = @_;
 821     my $result;
 822
 823     while ( !$result and (my $index = index $component, '::') > 0 ) {
 824         my $type   = lc substr $component, 0, $index;
 825         $component = substr $component, $index + 2;
 826         $result    = first { $type eq $_ or $type eq substr($_, 0, 1) }
 827                          qw{ model view controller };
 828     }
 829
 830     return ($result, $component);
 831 }
 832
 833 sub expand_component_module {
 834     my ( $class, $module ) = @_;
 835     return Devel::InnerPackage::list_packages( $module );
 836 }
 837
 838 __PACKAGE__->meta->make_immutable;
 839
 840 1;
 841
 842 __END__
 843
 844 =pod
 845
 846 =head1 NAME
 847
 848 Catalyst::Container - IOC for Catalyst components
 849
 850 =head1 SYNOPSIS
 851
 852 =head1 DESCRIPTION
 853
 854 =head1 METHODS
 855
 856 =head1 Methods for Building Containers
 857
 858 =head2 build_component_subcontainer
 859
 860 Container that stores all components, i.e. all models, views and controllers
 861 together. Each service is an instance of the actual component, and by default
 862 it lives while the application is running. Retrieving components from this
 863 sub-container will instantiate the component, if it hasn't been instantiated
 864 already, but will not execute ACCEPT_CONTEXT.
 865
 866 =head2 build_model_subcontainer
 867
 868 Container that stores references for all models that are inside the components
 869 sub-container. Retrieving a model triggers ACCEPT_CONTEXT, if it exists.
 870
 871 =head2 build_view_subcontainer
 872
 873 Same as L<build_model_subcontainer>, but for views.
 874
 875 =head2 build_controller_subcontainer
 876
 877 Same as L<build_model_subcontainer>, but for controllers.
 878
 879 =head1 Methods for Building Services
 880
 881 =head2 build_catalyst_application_service
 882
 883 Name of the application (such as MyApp).
 884
 885 =head2 build_home_service
 886
 887 The application home directory. All the files (including classes, scripts, etc)
 888 created for this application are in this directory, or in a sub-directory below
 889 this one.
 890
 891 =head2 build_root_dir_service
 892
 893 Inside the application home (as explained in L</build_home_service>), there is
 894 a root directory. This is where all templates and static files are.
 895
 896 =head2 build_driver_service
 897
 898 Config options passed directly to the driver being used.
 899
 900 =head2 build_file_service
 901
 902 ?
 903
 904 =head2 build_substitutions_service
 905
 906 This method substitutes macros found with calls to a function. There are a
 907 number of default macros:
 908
 909 =over
 910
 911 =item * C<__HOME__> - replaced with C<$c-E<gt>path_to('')>
 912
 913 =item * C<__ENV(foo)__> - replaced with the value of C<$ENV{foo}>
 914
 915 =item * C<__path_to(foo/bar)__> - replaced with C<$c-E<gt>path_to('foo/bar')>
 916
 917 =item * C<__literal(__FOO__)__> - leaves __FOO__ alone (allows you to use
 918 C<__DATA__> as a config value, for example)
 919
 920 =back
 921
 922 The parameter list is split on comma (C<,>). You can override this method to
 923 do your own string munging, or you can define your own macros in
 924 C<< <MyApp->config( 'Plugin::ConfigLoader' => { substitutions => { ... } } ) >>.
 925 Example:
 926
 927     MyApp->config( 'Plugin::ConfigLoader' => {
 928         substitutions => {
 929             baz => sub { my $c = shift; qux( @_ ); },
 930         },
 931     });
 932
 933 The above will respond to C<__baz(x,y)__> in config strings.
 934
 935 =head2 build_extensions_service
 936
 937 Config::Any's available config file extensions (e.g. xml, json, pl, etc).
 938
 939 =head2 build_prefix_service
 940
 941 The prefix, based on the application name, that will be used to look-up the
 942 config files (which will be in the format $prefix.$extension). If the app is
 943 MyApp::Foo, the prefix will be myapp_foo.
 944
 945 =head2 build_path_service
 946
 947 The path to the config file (or environment variable, if defined).
 948
 949 =head2 build_config_service
 950
 951 The resulting configuration for the application, after it has successfully
 952 been loaded, and all substitutions have been made.
 953
 954 =head2 build_raw_config_service
 955
 956 The merge of local_config and global_config hashes, before substitutions.
 957
 958 =head2 build_global_files_service
 959
 960 Gets all files for config that don't have the local_suffix, such as myapp.conf.
 961
 962 =head2 build_local_files_service
 963
 964 Gets all files for config that have the local_suffix, such as myapp_local.conf.
 965
 966 =head2 build_global_config_service
 967
 968 Reads config from global_files.
 969
 970 =head2 build_local_config_service
 971
 972 Reads config from local_files.
 973
 974 =head2 build_class_config_service
 975
 976 Reads config set from the application's class attribute config,
 977 i.e. MyApp->config( name => 'MyApp', ... )
 978
 979 =head2 build_config_path_service
 980
 981 Splits the path to the config file, and returns on array ref containing
 982 the path to the config file minus the extension in the first position,
 983 and the extension in the second.
 984
 985 =head2 build_config_local_suffix_service
 986
 987 Determines the suffix of files used to override the main config. By default
 988 this value is C<local>, which will load C<myapp_local.conf>.  The suffix can
 989 be specified in the following order of preference:
 990
 991 =over
 992
 993 =item * C<$ENV{ MYAPP_CONFIG_LOCAL_SUFFIX }>
 994
 995 =item * C<$ENV{ CATALYST_CONFIG_LOCAL_SUFFIX }>
 996
 997 =back
 998
 999 The first one of these values found replaces the default of C<local> in the
1000 name of the local config file to be loaded.
1001
1002 For example, if C< $ENV{ MYAPP_CONFIG_LOCAL_SUFFIX }> is set to C<testing>,
1003 ConfigLoader will try and load C<myapp_testing.conf> instead of
1004 C<myapp_local.conf>.
1005
1006 =head2 build_locate_components_service
1007
1008 This method is meant to provide a list of component modules that should be
1009 setup for the application.  By default, it will use L<Module::Pluggable>.
1010
1011 Specify a C<setup_components> config option to pass additional options directly
1012 to L<Module::Pluggable>.
1013
1014 =head1 Other methods
1015
1016 =head2 get_component_from_sub_container($sub_container, $name, $c, @args)
1017
1018 Looks for components in a given sub-container (such as controller, model or
1019 view), and returns the searched component. If $name is undef, it returns the
1020 default component (such as default_view, if $sub_container is 'view'). If
1021 $name is a regexp, it returns an array of matching components. Otherwise, it
1022 looks for the component with name $name.
1023
1024 =head2 get_all_components
1025
1026 Fetches all the components, in each of the sub_containers model, view and
1027 controller, and returns a read-only hash. The keys are the class names, and
1028 the values are the blessed objects. This is what is returned by $c->components.
1029
1030 =head2 add_component
1031
1032 Adds a component to the appropriate sub-container. The sub-container is guessed
1033 by the component name given.
1034
1035 =head2 find_component
1036
1037 Searches for components in all containers. If $component is the full class
1038 name, the sub-container is guessed, and it gets the searched component in there.
1039 Otherwise, it looks for a component with that name in all sub-containers. If
1040 $component is a regexp it calls _find_component_regexp and matches all
1041 components against that regexp.
1042
1043 =head2 expand_component_module
1044
1045 Components found by C<locate_components> will be passed to this method, which
1046 is expected to return a list of component (package) names to be set up.
1047
1048 =head2 setup_components
1049
1050 Uses locate_components service to list the components, and adds them to the
1051 appropriate sub-containers, using add_component().
1052
1053 =head1 AUTHORS
1054
1055 Catalyst Contributors, see Catalyst.pm
1056
1057 =head1 COPYRIGHT
1058
1059 This library is free software. You can redistribute it and/or modify it under
1060 the same terms as Perl itself.
1061
1062 =cut