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