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