lib/Catalyst/IOC/Container.pm

   1 package Catalyst::IOC::Container;
   2 use Bread::Board;
   3 use Moose;
   4 use Config::Any;
   5 use Data::Visitor::Callback;
   6 use Catalyst::Utils ();
   7 use Hash::Util qw/lock_hash/;
   8 use MooseX::Types::LoadableClass qw/ LoadableClass /;
   9 use Moose::Util;
  10 use Catalyst::IOC::BlockInjection;
  11 use namespace::autoclean;
  12
  13 extends 'Bread::Board::Container';
  14
  15 has config_local_suffix => (
  16     is      => 'ro',
  17     isa     => 'Str',
  18     default => 'local',
  19 );
  20
  21 has driver => (
  22     is      => 'ro',
  23     isa     => 'HashRef',
  24     default => sub { +{} },
  25 );
  26
  27 has file => (
  28     is      => 'ro',
  29     isa     => 'Str',
  30     default => '',
  31 );
  32
  33 has substitutions => (
  34     is      => 'ro',
  35     isa     => 'HashRef',
  36     default => sub { +{} },
  37 );
  38
  39 has name => (
  40     is      => 'ro',
  41     isa     => 'Str',
  42     default => 'MyApp',
  43 );
  44
  45 has sub_container_class => (
  46     isa     => LoadableClass,
  47     is      => 'ro',
  48     coerce  => 1,
  49     default => 'Catalyst::IOC::SubContainer',
  50     handles => {
  51         new_sub_container => 'new',
  52     }
  53 );
  54
  55 sub BUILD {
  56     my ( $self, $params ) = @_;
  57
  58     $self->add_service(
  59         $self->${\"build_${_}_service"}
  60     ) for qw/
  61         substitutions
  62         file
  63         driver
  64         name
  65         prefix
  66         extensions
  67         path
  68         config
  69         raw_config
  70         global_files
  71         local_files
  72         global_config
  73         local_config
  74         config_local_suffix
  75         config_path
  76     /;
  77
  78     $self->add_sub_container(
  79         $self->build_controller_subcontainer
  80     );
  81
  82     # FIXME - the config should be merged at this point
  83     my $config        = $self->resolve( service => 'config' );
  84     my $default_view  = $params->{default_view}  || $config->{default_view};
  85     my $default_model = $params->{default_model} || $config->{default_model};
  86
  87     $self->add_sub_container(
  88         $self->build_view_subcontainer(
  89             default_component => $default_view,
  90         )
  91     );
  92
  93     $self->add_sub_container(
  94         $self->build_model_subcontainer(
  95             default_component => $default_model,
  96         )
  97     );
  98 }
  99
 100 sub build_model_subcontainer {
 101     my $self = shift;
 102
 103     return $self->new_sub_container( @_,
 104         name => 'model',
 105     );
 106 }
 107
 108 sub build_view_subcontainer {
 109     my $self = shift;
 110
 111     return $self->new_sub_container( @_,
 112         name => 'view',
 113     );
 114 }
 115
 116 sub build_controller_subcontainer {
 117     my $self = shift;
 118
 119     return $self->new_sub_container(
 120         name => 'controller',
 121     );
 122 }
 123
 124 sub build_name_service {
 125     my $self = shift;
 126
 127     return Bread::Board::Literal->new( name => 'name', value => $self->name );
 128 }
 129
 130 sub build_driver_service {
 131     my $self = shift;
 132
 133     return Bread::Board::Literal->new( name => 'driver', value => $self->driver );
 134 }
 135
 136 sub build_file_service {
 137     my $self = shift;
 138
 139     return Bread::Board::Literal->new( name => 'file', value => $self->file );
 140 }
 141
 142 sub build_substitutions_service {
 143     my $self = shift;
 144
 145     return Bread::Board::Literal->new( name => 'substitutions', value => $self->substitutions );
 146 }
 147
 148 sub build_extensions_service {
 149     my $self = shift;
 150
 151     return Bread::Board::BlockInjection->new(
 152         name => 'extensions',
 153         block => sub {
 154             return \@{Config::Any->extensions};
 155         },
 156     );
 157 }
 158
 159 sub build_prefix_service {
 160     my $self = shift;
 161
 162     return Bread::Board::BlockInjection->new(
 163         name => 'prefix',
 164         block => sub {
 165             return Catalyst::Utils::appprefix( shift->param('name') );
 166         },
 167         dependencies => [ depends_on('name') ],
 168     );
 169 }
 170
 171 sub build_path_service {
 172     my $self = shift;
 173
 174     return Bread::Board::BlockInjection->new(
 175         name => 'path',
 176         block => sub {
 177             my $s = shift;
 178
 179             return Catalyst::Utils::env_value( $s->param('name'), 'CONFIG' )
 180             || $s->param('file')
 181             || $s->param('name')->path_to( $s->param('prefix') );
 182         },
 183         dependencies => [ depends_on('file'), depends_on('name'), depends_on('prefix') ],
 184     );
 185 }
 186
 187 sub build_config_service {
 188     my $self = shift;
 189
 190     return Bread::Board::BlockInjection->new(
 191         name => 'config',
 192         block => sub {
 193             my $s = shift;
 194
 195             my $v = Data::Visitor::Callback->new(
 196                 plain_value => sub {
 197                     return unless defined $_;
 198                     return $self->_config_substitutions( $s->param('name'), $s->param('substitutions'), $_ );
 199                 }
 200
 201             );
 202             $v->visit( $s->param('raw_config') );
 203         },
 204         dependencies => [ depends_on('name'), depends_on('raw_config'), depends_on('substitutions') ],
 205     );
 206 }
 207
 208 sub build_raw_config_service {
 209     my $self = shift;
 210
 211     return Bread::Board::BlockInjection->new(
 212         name => 'raw_config',
 213         block => sub {
 214             my $s = shift;
 215
 216             my @global = @{$s->param('global_config')};
 217             my @locals = @{$s->param('local_config')};
 218
 219             my $config = {};
 220             for my $cfg (@global, @locals) {
 221                 for (keys %$cfg) {
 222                     $config = Catalyst::Utils::merge_hashes( $config, $cfg->{$_} );
 223                 }
 224             }
 225             return $config;
 226         },
 227         dependencies => [ depends_on('global_config'), depends_on('local_config') ],
 228     );
 229 }
 230
 231 sub build_global_files_service {
 232     my $self = shift;
 233
 234     return Bread::Board::BlockInjection->new(
 235         name => 'global_files',
 236         block => sub {
 237             my $s = shift;
 238
 239             my ( $path, $extension ) = @{$s->param('config_path')};
 240
 241             my @extensions = @{$s->param('extensions')};
 242
 243             my @files;
 244             if ( $extension ) {
 245                 die "Unable to handle files with the extension '${extension}'" unless grep { $_ eq $extension } @extensions;
 246                 push @files, $path;
 247             } else {
 248                 @files = map { "$path.$_" } @extensions;
 249             }
 250             return \@files;
 251         },
 252         dependencies => [ depends_on('extensions'), depends_on('config_path') ],
 253     );
 254 }
 255
 256 sub build_local_files_service {
 257     my $self = shift;
 258
 259     return Bread::Board::BlockInjection->new(
 260         name => 'local_files',
 261         block => sub {
 262             my $s = shift;
 263
 264             my ( $path, $extension ) = @{$s->param('config_path')};
 265             my $suffix = $s->param('config_local_suffix');
 266
 267             my @extensions = @{$s->param('extensions')};
 268
 269             my @files;
 270             if ( $extension ) {
 271                 die "Unable to handle files with the extension '${extension}'" unless grep { $_ eq $extension } @extensions;
 272                 $path =~ s{\.$extension}{_$suffix.$extension};
 273                 push @files, $path;
 274             } else {
 275                 @files = map { "${path}_${suffix}.$_" } @extensions;
 276             }
 277             return \@files;
 278         },
 279         dependencies => [ depends_on('extensions'), depends_on('config_path'), depends_on('config_local_suffix') ],
 280     );
 281 }
 282
 283 sub build_global_config_service {
 284     my $self = shift;
 285
 286     return Bread::Board::BlockInjection->new(
 287         name => 'global_config',
 288         block => sub {
 289             my $s = shift;
 290
 291             return Config::Any->load_files({
 292                 files       => $s->param('global_files'),
 293                 filter      => \&_fix_syntax,
 294                 use_ext     => 1,
 295                 driver_args => $s->param('driver'),
 296             });
 297         },
 298         dependencies => [ depends_on('global_files') ],
 299     );
 300 }
 301
 302 sub build_local_config_service {
 303     my $self = shift;
 304
 305     return Bread::Board::BlockInjection->new(
 306         name => 'local_config',
 307         block => sub {
 308             my $s = shift;
 309
 310             return Config::Any->load_files({
 311                 files       => $s->param('local_files'),
 312                 filter      => \&_fix_syntax,
 313                 use_ext     => 1,
 314                 driver_args => $s->param('driver'),
 315             });
 316         },
 317         dependencies => [ depends_on('local_files') ],
 318     );
 319 }
 320
 321 sub build_config_path_service {
 322     my $self = shift;
 323
 324     return Bread::Board::BlockInjection->new(
 325         name => 'config_path',
 326         block => sub {
 327             my $s = shift;
 328
 329             my $path = $s->param('path');
 330             my $prefix = $s->param('prefix');
 331
 332             my ( $extension ) = ( $path =~ m{\.(.{1,4})$} );
 333
 334             if ( -d $path ) {
 335                 $path =~ s{[\/\\]$}{};
 336                 $path .= "/$prefix";
 337             }
 338
 339             return [ $path, $extension ];
 340         },
 341         dependencies => [ depends_on('prefix'), depends_on('path') ],
 342     );
 343 }
 344
 345 sub build_config_local_suffix_service {
 346     my $self = shift;
 347
 348     return Bread::Board::BlockInjection->new(
 349         name => 'config_local_suffix',
 350         block => sub {
 351             my $s = shift;
 352             my $suffix = Catalyst::Utils::env_value( $s->param('name'), 'CONFIG_LOCAL_SUFFIX' ) || $self->config_local_suffix;
 353
 354             return $suffix;
 355         },
 356         dependencies => [ depends_on('name') ],
 357     );
 358 }
 359
 360 sub _fix_syntax {
 361     my $config     = shift;
 362     my @components = (
 363         map +{
 364             prefix => $_ eq 'Component' ? '' : $_ . '::',
 365             values => delete $config->{ lc $_ } || delete $config->{ $_ }
 366         },
 367         grep { ref $config->{ lc $_ } || ref $config->{ $_ } }
 368             qw( Component Model M View V Controller C Plugin )
 369     );
 370
 371     foreach my $comp ( @components ) {
 372         my $prefix = $comp->{ prefix };
 373         foreach my $element ( keys %{ $comp->{ values } } ) {
 374             $config->{ "$prefix$element" } = $comp->{ values }->{ $element };
 375         }
 376     }
 377 }
 378
 379 sub _config_substitutions {
 380     my ( $self, $name, $subs, $arg ) = @_;
 381
 382     $subs->{ HOME } ||= sub { shift->path_to( '' ); };
 383     $subs->{ ENV } ||=
 384         sub {
 385             my ( $c, $v ) = @_;
 386             if (! defined($ENV{$v})) {
 387                 Catalyst::Exception->throw( message =>
 388                     "Missing environment variable: $v" );
 389                 return "";
 390             } else {
 391                 return $ENV{ $v };
 392             }
 393         };
 394     $subs->{ path_to } ||= sub { shift->path_to( @_ ); };
 395     $subs->{ literal } ||= sub { return $_[ 1 ]; };
 396     my $subsre = join( '|', keys %$subs );
 397
 398     $arg =~ s{__($subsre)(?:\((.+?)\))?__}{ $subs->{ $1 }->( $name, $2 ? split( /,/, $2 ) : () ) }eg;
 399     return $arg;
 400 }
 401
 402 sub get_component_from_sub_container {
 403     my ( $self, $sub_container_name, $name, $c, @args ) = @_;
 404
 405     my $sub_container = $self->get_sub_container( $sub_container_name );
 406
 407     if (!$name) {
 408         my $default = $sub_container->default_component;
 409
 410         return $sub_container->get_component( $default, $c, @args )
 411             if $default && $sub_container->has_service( $default );
 412
 413         # FIXME - should I be calling $c->log->warn here?
 414         # this is never a controller, so this is safe
 415         $c->log->warn( "Calling \$c->$sub_container_name() is not supported unless you specify one of:" );
 416         $c->log->warn( "* \$c->config(default_$sub_container_name => 'the name of the default $sub_container_name to use')" );
 417         $c->log->warn( "* \$c->stash->{current_$sub_container_name} # the name of the view to use for this request" );
 418         $c->log->warn( "* \$c->stash->{current_${sub_container_name}_instance} # the instance of the $sub_container_name to use for this request" );
 419
 420         return;
 421     }
 422
 423     return $sub_container->get_component_regexp( $name, $c, @args )
 424         if ref $name;
 425
 426     return $sub_container->get_component( $name, $c, @args )
 427         if $sub_container->has_service( $name );
 428
 429     $c->log->warn(
 430         "Attempted to use $sub_container_name '$name', " .
 431         "but it does not exist"
 432     );
 433
 434     return;
 435 }
 436
 437 sub find_component {
 438     my ( $self, $component, $c, @args ) = @_;
 439     my ( $type, $name ) = _get_component_type_name($component);
 440     my @result;
 441
 442     return $self->get_component_from_sub_container(
 443         $type, $name, $c, @args
 444     ) if $type;
 445
 446     my $query = ref $component
 447               ? $component
 448               : qr{^$component$}
 449               ;
 450
 451     for my $subcontainer_name (qw/model view controller/) {
 452         my $subcontainer = $self->get_sub_container( $subcontainer_name );
 453         my @components   = $subcontainer->get_service_list;
 454         @result          = grep { m{$component} } @components;
 455
 456         return map { $subcontainer->get_component( $_, $c, @args ) } @result
 457             if @result;
 458     }
 459
 460     # FIXME - I guess I shouldn't be calling $c->components here
 461     # one last search for things like $c->comp(qr/::M::/)
 462     @result = $self->find_component_regexp(
 463         $c->components, $component, $c, @args
 464     ) if !@result and ref $component;
 465
 466     # it expects an empty list on failed searches
 467     return @result;
 468 }
 469
 470 sub find_component_regexp {
 471     my ( $self, $components, $component, @args ) = @_;
 472     my @result;
 473
 474     my @components = grep { m{$component} } keys %{ $components };
 475
 476     for (@components) {
 477         my ($type, $name) = _get_component_type_name($_);
 478
 479         push @result, $self->get_component_from_sub_container(
 480             $type, $name, @args
 481         ) if $type;
 482     }
 483
 484     return @result;
 485 }
 486
 487 # FIXME sorry for the name again :)
 488 sub get_components_types {
 489     my ( $self ) = @_;
 490     my @comps_types;
 491
 492     for my $sub_container_name (qw/model view controller/) {
 493         my $sub_container = $self->get_sub_container($sub_container_name);
 494         for my $service ( $sub_container->get_service_list ) {
 495             my $comp     = $self->resolve(service => $service);
 496             my $compname = ref $comp || $comp;
 497             my $type     = ref $comp ? 'instance' : 'class';
 498             push @comps_types, [ $compname, $type ];
 499         }
 500     }
 501
 502     return @comps_types;
 503 }
 504
 505 sub get_all_components {
 506     my $self = shift;
 507     my %components;
 508
 509     my $containers = {
 510         map { $_ => $self->get_sub_container($_) } qw(model view controller)
 511     };
 512
 513     for my $container (keys %$containers) {
 514         for my $component ($containers->{$container}->get_service_list) {
 515             my $comp = $containers->{$container}->resolve(
 516                 service => $component
 517             );
 518             my $comp_name = ref $comp || $comp;
 519             $components{$comp_name} = $comp;
 520         }
 521     }
 522
 523     return lock_hash %components;
 524 }
 525
 526 sub add_component {
 527     my ( $self, $component, $class ) = @_;
 528     my ( $type, $name ) = _get_component_type_name($component);
 529
 530     return unless $type;
 531
 532     $self->get_sub_container($type)->add_service(
 533         Catalyst::IOC::BlockInjection->new(
 534             name  => $name,
 535             block => sub { $self->setup_component( $component, $class ) },
 536         )
 537     );
 538 }
 539
 540 # FIXME: should this sub exist?
 541 # should it be moved to Catalyst::Utils,
 542 # or replaced by something already existing there?
 543 sub _get_component_type_name {
 544     my ( $component ) = @_;
 545
 546     my @parts = split /::/, $component;
 547
 548     while (my $type = shift @parts) {
 549         return ('controller', join '::', @parts)
 550             if $type =~ /^(c|controller)$/i;
 551
 552         return ('model', join '::', @parts)
 553             if $type =~ /^(m|model)$/i;
 554
 555         return ('view', join '::', @parts)
 556             if $type =~ /^(v|view)$/i;
 557     }
 558
 559     return (undef, $component);
 560 }
 561
 562 # FIXME ugly and temporary
 563 # Just moved it here the way it was, so we can work on it here in the container
 564 sub setup_component {
 565     my ( $self, $component, $class ) = @_;
 566
 567     unless ( $component->can( 'COMPONENT' ) ) {
 568         return $component;
 569     }
 570
 571     # FIXME I know this isn't the "Dependency Injection" way of doing things,
 572     # its just temporary
 573     my $suffix = Catalyst::Utils::class2classsuffix( $component );
 574     my $config = $self->resolve(service => 'config')->{ $suffix } || {};
 575
 576     # Stash catalyst_component_name in the config here, so that custom COMPONENT
 577     # methods also pass it. local to avoid pointlessly shitting in config
 578     # for the debug screen, as $component is already the key name.
 579     local $config->{catalyst_component_name} = $component;
 580
 581     my $instance = eval { $component->COMPONENT( $class, $config ); };
 582
 583     if ( my $error = $@ ) {
 584         chomp $error;
 585         Catalyst::Exception->throw(
 586             message => qq/Couldn't instantiate component "$component", "$error"/
 587         );
 588     }
 589     elsif (!blessed $instance) {
 590         my $metaclass = Moose::Util::find_meta($component);
 591         my $method_meta = $metaclass->find_method_by_name('COMPONENT');
 592         my $component_method_from = $method_meta->associated_metaclass->name;
 593         my $value = defined($instance) ? $instance : 'undef';
 594         Catalyst::Exception->throw(
 595             message =>
 596             qq/Couldn't instantiate component "$component", COMPONENT() method (from $component_method_from) didn't return an object-like value (value was $value)./
 597         );
 598     }
 599
 600     return $instance;
 601 }
 602
 603
 604 1;
 605
 606 __END__
 607
 608 =pod
 609
 610 =head1 NAME
 611
 612 Catalyst::Container - IOC for Catalyst components
 613
 614 =head1 SYNOPSIS
 615
 616 =head1 DESCRIPTION
 617
 618 =head1 METHODS
 619
 620 =head1 Containers
 621
 622 =head2 build_model_subcontainer
 623
 624 Container that stores all models.
 625
 626 =head2 build_view_subcontainer
 627
 628 Container that stores all views.
 629
 630 =head2 build_controller_subcontainer
 631
 632 Container that stores all controllers.
 633
 634 =head1 Services
 635
 636 =head2 build_name_service
 637
 638 Name of the application.
 639
 640 =head2 build_driver_service
 641
 642 Config options passed directly to the driver being used.
 643
 644 =head2 build_file_service
 645
 646 ?
 647
 648 =head2 build_substitutions_service
 649
 650 Executes all the substitutions in config. See L</_config_substitutions> method.
 651
 652 =head2 build_extensions_service
 653
 654 =head2 build_prefix_service
 655
 656 =head2 build_path_service
 657
 658 =head2 build_config_service
 659
 660 =head2 build_raw_config_service
 661
 662 =head2 build_global_files_service
 663
 664 =head2 build_local_files_service
 665
 666 =head2 build_global_config_service
 667
 668 =head2 build_local_config_service
 669
 670 =head2 build_config_path_service
 671
 672 =head2 build_config_local_suffix_service
 673
 674 Determines the suffix of files used to override the main config. By default
 675 this value is C<local>, which will load C<myapp_local.conf>.  The suffix can
 676 be specified in the following order of preference:
 677
 678 =over
 679
 680 =item * C<$ENV{ MYAPP_CONFIG_LOCAL_SUFFIX }>
 681
 682 =item * C<$ENV{ CATALYST_CONFIG_LOCAL_SUFFIX }>
 683
 684 =back
 685
 686 The first one of these values found replaces the default of C<local> in the
 687 name of the local config file to be loaded.
 688
 689 For example, if C< $ENV{ MYAPP_CONFIG_LOCAL_SUFFIX }> is set to C<testing>,
 690 ConfigLoader will try and load C<myapp_testing.conf> instead of
 691 C<myapp_local.conf>.
 692
 693 =head2 get_component_from_sub_container($sub_container, $name, $c, @args)
 694
 695 Looks for components in a given subcontainer (such as controller, model or view), and returns the searched component. If $name is undef, it returns the default component (such as default_view, if $sub_container is 'view'). If $name is a regexp, it returns an array of matching components. Otherwise, it looks for the component with name $name.
 696
 697 =head2 get_components_types
 698
 699 =head2 get_all_components
 700
 701 Fetches all the components, in each of the sub_containers model, view and controller, and returns a readonly hash. The keys are the class names, and the values are the blessed objects. This is what is returned by $c->components.
 702
 703 =head2 add_component
 704
 705 Adds a component to the appropriate subcontainer. The subcontainer is guessed by the component name given.
 706
 707 =head2 find_component
 708
 709 Searches for components in all containers. If $component is the full class name, the subcontainer is guessed, and it gets the searched component in there. Otherwise, it looks for a component with that name in all subcontainers. If $component is a regexp, it calls the method below, find_component_regexp, and matches all components against that regexp.
 710
 711 =head2 find_component_regexp
 712
 713 Finds components that match a given regexp. Used internally, by find_component.
 714
 715 =head2 setup_component
 716
 717 =head2 _fix_syntax
 718
 719 =head2 _config_substitutions
 720
 721 This method substitutes macros found with calls to a function. There are a
 722 number of default macros:
 723
 724 =over
 725
 726 =item * C<__HOME__> - replaced with C<$c-E<gt>path_to('')>
 727
 728 =item * C<__ENV(foo)__> - replaced with the value of C<$ENV{foo}>
 729
 730 =item * C<__path_to(foo/bar)__> - replaced with C<$c-E<gt>path_to('foo/bar')>
 731
 732 =item * C<__literal(__FOO__)__> - leaves __FOO__ alone (allows you to use
 733 C<__DATA__> as a config value, for example)
 734
 735 =back
 736
 737 The parameter list is split on comma (C<,>). You can override this method to
 738 do your own string munging, or you can define your own macros in
 739 C<MyApp-E<gt>config-E<gt>{ 'Plugin::ConfigLoader' }-E<gt>{ substitutions }>.
 740 Example:
 741
 742     MyApp->config->{ 'Plugin::ConfigLoader' }->{ substitutions } = {
 743         baz => sub { my $c = shift; qux( @_ ); }
 744     }
 745
 746 The above will respond to C<__baz(x,y)__> in config strings.
 747
 748 =head1 AUTHORS
 749
 750 Catalyst Contributors, see Catalyst.pm
 751
 752 =head1 COPYRIGHT
 753
 754 This library is free software. You can redistribute it and/or modify it under
 755 the same terms as Perl itself.
 756
 757 =cut