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