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