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