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 Catalyst::IOC::BlockInjection;
  10 use namespace::autoclean;
  11
  12 extends 'Bread::Board::Container';
  13
  14 has config_local_suffix => (
  15     is      => 'ro',
  16     isa     => 'Str',
  17     default => 'local',
  18 );
  19
  20 has driver => (
  21     is      => 'ro',
  22     isa     => 'HashRef',
  23     default => sub { +{} },
  24 );
  25
  26 has file => (
  27     is      => 'ro',
  28     isa     => 'Str',
  29     default => '',
  30 );
  31
  32 has substitutions => (
  33     is      => 'ro',
  34     isa     => 'HashRef',
  35     default => sub { +{} },
  36 );
  37
  38 has name => (
  39     is      => 'ro',
  40     isa     => 'Str',
  41     default => 'TestApp',
  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         name
  64         prefix
  65         extensions
  66         path
  67         config
  68         raw_config
  69         global_files
  70         local_files
  71         global_config
  72         local_config
  73         config_local_suffix
  74         config_path
  75     /;
  76
  77     $self->add_sub_container(
  78         $self->build_controller_subcontainer
  79     );
  80
  81     my $config        = $self->resolve( service => 'config' );
  82     my $default_view  = $params->{default_view}  || $config->{default_view};
  83     my $default_model = $params->{default_model} || $config->{default_model};
  84
  85     $self->add_sub_container(
  86         $self->build_view_subcontainer(
  87             default_component => $default_view,
  88         )
  89     );
  90
  91     $self->add_sub_container(
  92         $self->build_model_subcontainer(
  93             default_component => $default_model,
  94         )
  95     );
  96 }
  97
  98 sub build_model_subcontainer {
  99     my $self = shift;
 100
 101     return $self->new_sub_container( @_,
 102         name => 'model',
 103     );
 104 }
 105
 106 sub build_view_subcontainer {
 107     my $self = shift;
 108
 109     return $self->new_sub_container( @_,
 110         name => 'view',
 111     );
 112 }
 113
 114 sub build_controller_subcontainer {
 115     my $self = shift;
 116
 117     return $self->new_sub_container(
 118         name => 'controller',
 119     );
 120 }
 121
 122 sub build_name_service {
 123     my $self = shift;
 124
 125     return Bread::Board::Literal->new( name => 'name', value => $self->name );
 126 }
 127
 128 sub build_driver_service {
 129     my $self = shift;
 130
 131     return Bread::Board::Literal->new( name => 'driver', value => $self->driver );
 132 }
 133
 134 sub build_file_service {
 135     my $self = shift;
 136
 137     return Bread::Board::Literal->new( name => 'file', value => $self->file );
 138 }
 139
 140 sub build_substitutions_service {
 141     my $self = shift;
 142
 143     return Bread::Board::Literal->new( name => 'substitutions', value => $self->substitutions );
 144 }
 145
 146 sub build_extensions_service {
 147     my $self = shift;
 148
 149     return Bread::Board::BlockInjection->new(
 150         name => 'extensions',
 151         block => sub {
 152             return \@{Config::Any->extensions};
 153         },
 154     );
 155 }
 156
 157 sub build_prefix_service {
 158     my $self = shift;
 159
 160     return Bread::Board::BlockInjection->new(
 161         name => 'prefix',
 162         block => sub {
 163             return Catalyst::Utils::appprefix( shift->param('name') );
 164         },
 165         dependencies => [ depends_on('name') ],
 166     );
 167 }
 168
 169 sub build_path_service {
 170     my $self = shift;
 171
 172     return Bread::Board::BlockInjection->new(
 173         name => 'path',
 174         block => sub {
 175             my $s = shift;
 176
 177             return Catalyst::Utils::env_value( $s->param('name'), 'CONFIG' )
 178             || $s->param('file')
 179             || $s->param('name')->path_to( $s->param('prefix') );
 180         },
 181         dependencies => [ depends_on('file'), depends_on('name'), depends_on('prefix') ],
 182     );
 183 }
 184
 185 sub build_config_service {
 186     my $self = shift;
 187
 188     return Bread::Board::BlockInjection->new(
 189         name => 'config',
 190         block => sub {
 191             my $s = shift;
 192
 193             my $v = Data::Visitor::Callback->new(
 194                 plain_value => sub {
 195                     return unless defined $_;
 196                     return $self->_config_substitutions( $s->param('name'), $s->param('substitutions'), $_ );
 197                 }
 198
 199             );
 200             $v->visit( $s->param('raw_config') );
 201         },
 202         dependencies => [ depends_on('name'), depends_on('raw_config'), depends_on('substitutions') ],
 203     );
 204 }
 205
 206 sub build_raw_config_service {
 207     my $self = shift;
 208
 209     return Bread::Board::BlockInjection->new(
 210         name => 'raw_config',
 211         block => sub {
 212             my $s = shift;
 213
 214             my @global = @{$s->param('global_config')};
 215             my @locals = @{$s->param('local_config')};
 216
 217             my $config = {};
 218             for my $cfg (@global, @locals) {
 219                 for (keys %$cfg) {
 220                     $config = Catalyst::Utils::merge_hashes( $config, $cfg->{$_} );
 221                 }
 222             }
 223             return $config;
 224         },
 225         dependencies => [ depends_on('global_config'), depends_on('local_config') ],
 226     );
 227 }
 228
 229 sub build_global_files_service {
 230     my $self = shift;
 231
 232     return Bread::Board::BlockInjection->new(
 233         name => 'global_files',
 234         block => sub {
 235             my $s = shift;
 236
 237             my ( $path, $extension ) = @{$s->param('config_path')};
 238
 239             my @extensions = @{$s->param('extensions')};
 240
 241             my @files;
 242             if ( $extension ) {
 243                 die "Unable to handle files with the extension '${extension}'" unless grep { $_ eq $extension } @extensions;
 244                 push @files, $path;
 245             } else {
 246                 @files = map { "$path.$_" } @extensions;
 247             }
 248             return \@files;
 249         },
 250         dependencies => [ depends_on('extensions'), depends_on('config_path') ],
 251     );
 252 }
 253
 254 sub build_local_files_service {
 255     my $self = shift;
 256
 257     return Bread::Board::BlockInjection->new(
 258         name => 'local_files',
 259         block => sub {
 260             my $s = shift;
 261
 262             my ( $path, $extension ) = @{$s->param('config_path')};
 263             my $suffix = $s->param('config_local_suffix');
 264
 265             my @extensions = @{$s->param('extensions')};
 266
 267             my @files;
 268             if ( $extension ) {
 269                 die "Unable to handle files with the extension '${extension}'" unless grep { $_ eq $extension } @extensions;
 270                 $path =~ s{\.$extension}{_$suffix.$extension};
 271                 push @files, $path;
 272             } else {
 273                 @files = map { "${path}_${suffix}.$_" } @extensions;
 274             }
 275             return \@files;
 276         },
 277         dependencies => [ depends_on('extensions'), depends_on('config_path'), depends_on('config_local_suffix') ],
 278     );
 279 }
 280
 281 sub build_global_config_service {
 282     my $self = shift;
 283
 284     return Bread::Board::BlockInjection->new(
 285         name => 'global_config',
 286         block => sub {
 287             my $s = shift;
 288
 289             return Config::Any->load_files({
 290                 files       => $s->param('global_files'),
 291                 filter      => \&_fix_syntax,
 292                 use_ext     => 1,
 293                 driver_args => $s->param('driver'),
 294             });
 295         },
 296         dependencies => [ depends_on('global_files') ],
 297     );
 298 }
 299
 300 sub build_local_config_service {
 301     my $self = shift;
 302
 303     return Bread::Board::BlockInjection->new(
 304         name => 'local_config',
 305         block => sub {
 306             my $s = shift;
 307
 308             return Config::Any->load_files({
 309                 files       => $s->param('local_files'),
 310                 filter      => \&_fix_syntax,
 311                 use_ext     => 1,
 312                 driver_args => $s->param('driver'),
 313             });
 314         },
 315         dependencies => [ depends_on('local_files') ],
 316     );
 317 }
 318
 319 sub build_config_path_service {
 320     my $self = shift;
 321
 322     return Bread::Board::BlockInjection->new(
 323         name => 'config_path',
 324         block => sub {
 325             my $s = shift;
 326
 327             my $path = $s->param('path');
 328             my $prefix = $s->param('prefix');
 329
 330             my ( $extension ) = ( $path =~ m{\.(.{1,4})$} );
 331
 332             if ( -d $path ) {
 333                 $path =~ s{[\/\\]$}{};
 334                 $path .= "/$prefix";
 335             }
 336
 337             return [ $path, $extension ];
 338         },
 339         dependencies => [ depends_on('prefix'), depends_on('path') ],
 340     );
 341 }
 342
 343 sub build_config_local_suffix_service {
 344     my $self = shift;
 345
 346     return Bread::Board::BlockInjection->new(
 347         name => 'config_local_suffix',
 348         block => sub {
 349             my $s = shift;
 350             my $suffix = Catalyst::Utils::env_value( $s->param('name'), 'CONFIG_LOCAL_SUFFIX' ) || $self->config_local_suffix;
 351
 352             return $suffix;
 353         },
 354         dependencies => [ depends_on('name') ],
 355     );
 356 }
 357
 358 sub _fix_syntax {
 359     my $config     = shift;
 360     my @components = (
 361         map +{
 362             prefix => $_ eq 'Component' ? '' : $_ . '::',
 363             values => delete $config->{ lc $_ } || delete $config->{ $_ }
 364         },
 365         grep { ref $config->{ lc $_ } || ref $config->{ $_ } }
 366             qw( Component Model M View V Controller C Plugin )
 367     );
 368
 369     foreach my $comp ( @components ) {
 370         my $prefix = $comp->{ prefix };
 371         foreach my $element ( keys %{ $comp->{ values } } ) {
 372             $config->{ "$prefix$element" } = $comp->{ values }->{ $element };
 373         }
 374     }
 375 }
 376
 377 sub _config_substitutions {
 378     my ( $self, $name, $subs, $arg ) = @_;
 379
 380     $subs->{ HOME } ||= sub { shift->path_to( '' ); };
 381     $subs->{ ENV } ||=
 382         sub {
 383             my ( $c, $v ) = @_;
 384             if (! defined($ENV{$v})) {
 385                 Catalyst::Exception->throw( message =>
 386                     "Missing environment variable: $v" );
 387                 return "";
 388             } else {
 389                 return $ENV{ $v };
 390             }
 391         };
 392     $subs->{ path_to } ||= sub { shift->path_to( @_ ); };
 393     $subs->{ literal } ||= sub { return $_[ 1 ]; };
 394     my $subsre = join( '|', keys %$subs );
 395
 396     $arg =~ s{__($subsre)(?:\((.+?)\))?__}{ $subs->{ $1 }->( $name, $2 ? split( /,/, $2 ) : () ) }eg;
 397     return $arg;
 398 }
 399
 400 sub get_component_from_sub_container {
 401     my ( $self, $sub_container_name, $name, $c, @args ) = @_;
 402
 403     my $sub_container = $self->get_sub_container( $sub_container_name );
 404
 405     if (!$name) {
 406         my $default = $sub_container->default_component;
 407
 408         return $sub_container->get_component( $default, $c, @args )
 409             if $default && $sub_container->has_service( $default );
 410
 411         # this is never a controller, so this is safe
 412         $c->log->warn( "Calling \$c->$sub_container_name() is not supported unless you specify one of:" );
 413         $c->log->warn( "* \$c->config(default_$sub_container_name => 'the name of the default $sub_container_name to use')" );
 414         $c->log->warn( "* \$c->stash->{current_$sub_container_name} # the name of the view to use for this request" );
 415         $c->log->warn( "* \$c->stash->{current_${sub_container_name}_instance} # the instance of the $sub_container_name to use for this request" );
 416
 417         return;
 418     }
 419
 420     return $sub_container->get_component_regexp( $name, $c, @args )
 421         if ref $name;
 422
 423     return $sub_container->get_component( $name, $c, @args )
 424         if $sub_container->has_service( $name );
 425
 426     $c->log->warn(
 427         "Attempted to use $sub_container_name '$name', " .
 428         "but it does not exist"
 429     );
 430
 431     return;
 432 }
 433
 434 sub find_component {
 435     my ( $self, $component, $c, @args ) = @_;
 436     my ( $type, $name ) = Catalyst::_get_component_type_name($component);
 437     my @result;
 438
 439     return $self->get_component_from_sub_container(
 440         $type, $name, $c, @args
 441     ) if $type;
 442
 443     my $query = ref $component
 444               ? $component
 445               : qr{^$component$}
 446               ;
 447
 448     for my $subcontainer_name (qw/model view controller/) {
 449         my $subcontainer = $self->get_sub_container($subcontainer_name);
 450         my @components   = $subcontainer->get_service_list;
 451         @result          = grep { m{$component} } @components;
 452
 453         return map { $subcontainer->get_component( $_, $c, @args ) } @result
 454             if @result;
 455     }
 456
 457     # one last search for things like $c->comp(qr/::M::/)
 458     @result = $self->find_component_regexp(
 459         $c->components, $component, $c, @args
 460     ) if !@result and ref $component;
 461
 462     # it expects an empty list on failed searches
 463     return @result;
 464 }
 465
 466 sub find_component_regexp {
 467     my ( $self, $components, $component, @args ) = @_;
 468     my @result;
 469
 470     my @components = grep { m{$component} } keys %{ $components };
 471
 472     for (@components) {
 473         # FIXME this is naughty enough being called inside Catalyst.pm
 474         # find some alternative for this sub and remember to delete here
 475         my ($type, $name) = Catalyst::_get_component_type_name($_);
 476
 477         push @result, $self->get_component_from_sub_container(
 478             $type, $name, @args
 479         ) if $type;
 480     }
 481
 482     return @result;
 483 }
 484
 485 # FIXME sorry for the name again :)
 486 sub get_components_types {
 487     my ( $self ) = @_;
 488     my @comps_types;
 489
 490     for my $sub_container_name (qw/model view controller/) {
 491         my $sub_container = $self->get_sub_container($sub_container_name);
 492         for my $service ( $sub_container->get_service_list ) {
 493             my $comp     = $self->resolve(service => $service);
 494             my $compname = ref $comp || $comp;
 495             my $type     = ref $comp ? 'instance' : 'class';
 496             push @comps_types, [ $compname, $type ];
 497         }
 498     }
 499
 500     return @comps_types;
 501 }
 502
 503 sub get_all_components {
 504     my $self = shift;
 505     my %components;
 506
 507     my $containers = {
 508         map { $_ => $self->get_sub_container($_) } qw(model view controller)
 509     };
 510
 511     for my $container (keys %$containers) {
 512         for my $component ($containers->{$container}->get_service_list) {
 513             my $comp = $containers->{$container}->resolve(
 514                 service => $component
 515             );
 516             my $comp_name = ref $comp || $comp;
 517             $components{$comp_name} = $comp;
 518         }
 519     }
 520
 521     return lock_hash %components;
 522 }
 523
 524 1;
 525
 526 __END__
 527
 528 =pod
 529
 530 =head1 NAME
 531
 532 Catalyst::Container - IOC for Catalyst components
 533
 534 =head1 METHODS
 535
 536 =head2 build_model_subcontainer
 537
 538 =head2 build_view_subcontainer
 539
 540 =head2 build_controller_subcontainer
 541
 542 =head2 build_name_service
 543
 544 =head2 build_driver_service
 545
 546 =head2 build_file_service
 547
 548 =head2 build_substitutions_service
 549
 550 =head2 build_extensions_service
 551
 552 =head2 build_prefix_service
 553
 554 =head2 build_path_service
 555
 556 =head2 build_config_service
 557
 558 =head2 build_raw_config_service
 559
 560 =head2 build_global_files_service
 561
 562 =head2 build_local_files_service
 563
 564 =head2 build_global_config_service
 565
 566 =head2 build_local_config_service
 567
 568 =head2 build_config_path_service
 569
 570 =head2 build_config_local_suffix_service
 571
 572 =head2 get_component_from_sub_container
 573
 574 =head2 get_components_types
 575
 576 =head2 get_all_components
 577
 578 =head2 find_component
 579
 580 =head2 find_component_regexp
 581
 582 =head2 _fix_syntax
 583
 584 =head2 _config_substitutions
 585
 586 =head1 AUTHORS
 587
 588 Catalyst Contributors, see Catalyst.pm
 589
 590 =head1 COPYRIGHT
 591
 592 This library is free software. You can redistribute it and/or modify it under
 593 the same terms as Perl itself.
 594
 595 =cut