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 = shift;
  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_${_}_subcontainer" }
  78     ) for qw/ model view controller /;
  79 }
  80
  81 sub build_model_subcontainer {
  82     my $self = shift;
  83
  84     return $self->new_sub_container(
  85         name => 'model',
  86     );
  87 }
  88
  89 sub build_view_subcontainer {
  90     my $self = shift;
  91
  92     return $self->new_sub_container(
  93         name => 'view',
  94     );
  95 }
  96
  97 sub build_controller_subcontainer {
  98     my $self = shift;
  99
 100     return $self->new_sub_container(
 101         name => 'controller',
 102     );
 103 }
 104
 105 sub build_default_model {
 106     Bread::Board::BlockInjection->new(
 107         block => sub {
 108             shift->param('config')->{default_model};
 109         },
 110         dependencies => [ depends_on('config') ],
 111     );
 112 }
 113
 114 sub build_default_view {
 115     Bread::Board::BlockInjection->new(
 116         name => 'default_view',
 117         block => sub {
 118             shift->param('config')->{default_view};
 119         },
 120         dependencies => [ depends_on('config') ],
 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_name = 'default_' . $sub_container_name;
 409         my $default      = $self->resolve( service => $default_name )
 410             if $self->has_service($default_name);
 411
 412         return $sub_container->get_component( $default, $c, @args )
 413             if $default && $sub_container->has_service( $default );
 414
 415         # this is never a controller, so this is safe
 416         $c->log->warn( "Calling \$c->$sub_container_name() is not supported unless you specify one of:" );
 417         $c->log->warn( "* \$c->config(default_$sub_container_name => 'the name of the default $sub_container_name to use')" );
 418         $c->log->warn( "* \$c->stash->{current_$sub_container_name} # the name of the view to use for this request" );
 419         $c->log->warn( "* \$c->stash->{current_${sub_container_name}_instance} # the instance of the $sub_container_name to use for this request" );
 420     }
 421
 422     return $sub_container->get_component_regexp( $name, $c, @args )
 423         if ref $name;
 424
 425     return $sub_container->get_component( $name, $c, @args )
 426         if $sub_container->has_service( $name );
 427
 428     $c->log->warn(
 429         "Attempted to use $sub_container_name '$name', " .
 430         "but it does not exist"
 431     );
 432
 433     return;
 434 }
 435
 436 1;
 437
 438 __END__
 439
 440 =pod
 441
 442 =head1 NAME
 443
 444 Catalyst::Container - IOC for Catalyst components
 445
 446 =head1 METHODS
 447
 448 =head2 build_model_subcontainer
 449
 450 =head2 build_view_subcontainer
 451
 452 =head2 build_controller_subcontainer
 453
 454 =head2 build_name_service
 455
 456 =head2 build_driver_service
 457
 458 =head2 build_file_service
 459
 460 =head2 build_substitutions_service
 461
 462 =head2 build_extensions_service
 463
 464 =head2 build_prefix_service
 465
 466 =head2 build_path_service
 467
 468 =head2 build_config_service
 469
 470 =head2 build_raw_config_service
 471
 472 =head2 build_global_files_service
 473
 474 =head2 build_local_files_service
 475
 476 =head2 build_global_config_service
 477
 478 =head2 build_local_config_service
 479
 480 =head2 build_config_path_service
 481
 482 =head2 build_config_local_suffix_service
 483
 484 =head2 _fix_syntax
 485
 486 =head2 _config_substitutions
 487
 488 =head1 AUTHORS
 489
 490 Catalyst Contributors, see Catalyst.pm
 491
 492 =head1 COPYRIGHT
 493
 494 This library is free software. You can redistribute it and/or modify it under
 495 the same terms as Perl itself.
 496
 497 =cut