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 # FIXME - Why do any of these attributes need to be rw?
  14 has config_local_suffix => (
  15     is      => 'rw',
  16     isa     => 'Str',
  17     default => 'local',
  18 );
  19
  20 has driver => (
  21     is      => 'rw',
  22     isa     => 'HashRef',
  23     default => sub { +{} },
  24 );
  25
  26 has file => (
  27     is      => 'rw',
  28     isa     => 'Str',
  29     default => '',
  30 );
  31
  32 has substitutions => (
  33     is      => 'rw',
  34     isa     => 'HashRef',
  35     default => sub { +{} },
  36 );
  37
  38 has name => (
  39     is      => 'rw',
  40     isa     => 'Str',
  41     default => 'TestApp',
  42 );
  43
  44 has sub_container_class => (
  45     isa     => LoadableClass,
  46     is      => 'ro',
  47     coerce  => 1,
  48     default => 'Catalyst::IOC::SubContainer',
  49     handles => {
  50         new_sub_container => 'new',
  51     }
  52 );
  53
  54 sub BUILD {
  55     my $self = shift;
  56
  57     $self->add_service(
  58         $self->${\"build_${_}_service"}
  59     ) for qw/
  60         substitutions
  61         file
  62         driver
  63         name
  64         prefix
  65         extensions
  66         path
  67         config
  68         raw_config
  69         global_files
  70         local_files
  71         global_config
  72         local_config
  73         config_local_suffix
  74         config_path
  75     /;
  76
  77     $self->add_sub_container(
  78         $self->${ \"build_${_}_subcontainer" }
  79     ) for qw/ model view controller /;
  80 }
  81
  82 sub build_model_subcontainer {
  83     my $self = shift;
  84
  85     return $self->new_sub_container( name => 'model' );
  86 }
  87
  88 sub build_view_subcontainer {
  89     my $self = shift;
  90
  91     return $self->new_sub_container( name => 'view' );
  92 }
  93
  94 sub build_controller_subcontainer {
  95     my $self = shift;
  96
  97     return $self->new_sub_container( name => 'controller' );
  98 }
  99
 100 sub build_name_service {
 101     my $self = shift;
 102
 103     return Bread::Board::Literal->new( name => 'name', value => $self->name );
 104 }
 105
 106 sub build_driver_service {
 107     my $self = shift;
 108
 109     return Bread::Board::Literal->new( name => 'driver', value => $self->driver );
 110 }
 111
 112 sub build_file_service {
 113     my $self = shift;
 114
 115     return Bread::Board::Literal->new( name => 'file', value => $self->file );
 116 }
 117
 118 sub build_substitutions_service {
 119     my $self = shift;
 120
 121     return Bread::Board::Literal->new( name => 'substitutions', value => $self->substitutions );
 122 }
 123
 124 sub build_extensions_service {
 125     my $self = shift;
 126
 127     return Bread::Board::BlockInjection->new(
 128         name => 'extensions',
 129         block => sub {
 130             return \@{Config::Any->extensions};
 131         },
 132     );
 133 }
 134
 135 sub build_prefix_service {
 136     my $self = shift;
 137
 138     return Bread::Board::BlockInjection->new(
 139         name => 'prefix',
 140         block => sub {
 141             return Catalyst::Utils::appprefix( shift->param('name') );
 142         },
 143         dependencies => [ depends_on('name') ],
 144     );
 145 }
 146
 147 sub build_path_service {
 148     my $self = shift;
 149
 150     return Bread::Board::BlockInjection->new(
 151         name => 'path',
 152         block => sub {
 153             my $s = shift;
 154
 155             return Catalyst::Utils::env_value( $s->param('name'), 'CONFIG' )
 156             || $s->param('file')
 157             || $s->param('name')->path_to( $s->param('prefix') );
 158         },
 159         dependencies => [ depends_on('file'), depends_on('name'), depends_on('prefix') ],
 160     );
 161 }
 162
 163 sub build_config_service {
 164     my $self = shift;
 165
 166     return Bread::Board::BlockInjection->new(
 167         name => 'config',
 168         block => sub {
 169             my $s = shift;
 170
 171             my $v = Data::Visitor::Callback->new(
 172                 plain_value => sub {
 173                     return unless defined $_;
 174                     return $self->_config_substitutions( $s->param('name'), $s->param('substitutions'), $_ );
 175                 }
 176
 177             );
 178             $v->visit( $s->param('raw_config') );
 179         },
 180         dependencies => [ depends_on('name'), depends_on('raw_config'), depends_on('substitutions') ],
 181     );
 182 }
 183
 184 sub build_raw_config_service {
 185     my $self = shift;
 186
 187     return Bread::Board::BlockInjection->new(
 188         name => 'raw_config',
 189         block => sub {
 190             my $s = shift;
 191
 192             my @global = @{$s->param('global_config')};
 193             my @locals = @{$s->param('local_config')};
 194
 195             my $config = {};
 196             for my $cfg (@global, @locals) {
 197                 for (keys %$cfg) {
 198                     $config = Catalyst::Utils::merge_hashes( $config, $cfg->{$_} );
 199                 }
 200             }
 201             return $config;
 202         },
 203         dependencies => [ depends_on('global_config'), depends_on('local_config') ],
 204     );
 205 }
 206
 207 sub build_global_files_service {
 208     my $self = shift;
 209
 210     return Bread::Board::BlockInjection->new(
 211         name => 'global_files',
 212         block => sub {
 213             my $s = shift;
 214
 215             my ( $path, $extension ) = @{$s->param('config_path')};
 216
 217             my @extensions = @{$s->param('extensions')};
 218
 219             my @files;
 220             if ( $extension ) {
 221                 die "Unable to handle files with the extension '${extension}'" unless grep { $_ eq $extension } @extensions;
 222                 push @files, $path;
 223             } else {
 224                 @files = map { "$path.$_" } @extensions;
 225             }
 226             return \@files;
 227         },
 228         dependencies => [ depends_on('extensions'), depends_on('config_path') ],
 229     );
 230 }
 231
 232 sub build_local_files_service {
 233     my $self = shift;
 234
 235     return Bread::Board::BlockInjection->new(
 236         name => 'local_files',
 237         block => sub {
 238             my $s = shift;
 239
 240             my ( $path, $extension ) = @{$s->param('config_path')};
 241             my $suffix = $s->param('config_local_suffix');
 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                 $path =~ s{\.$extension}{_$suffix.$extension};
 249                 push @files, $path;
 250             } else {
 251                 @files = map { "${path}_${suffix}.$_" } @extensions;
 252             }
 253             return \@files;
 254         },
 255         dependencies => [ depends_on('extensions'), depends_on('config_path'), depends_on('config_local_suffix') ],
 256     );
 257 }
 258
 259 sub build_global_config_service {
 260     my $self = shift;
 261
 262     return Bread::Board::BlockInjection->new(
 263         name => 'global_config',
 264         block => sub {
 265             my $s = shift;
 266
 267             return Config::Any->load_files({
 268                 files       => $s->param('global_files'),
 269                 filter      => \&_fix_syntax,
 270                 use_ext     => 1,
 271                 driver_args => $s->param('driver'),
 272             });
 273         },
 274         dependencies => [ depends_on('global_files') ],
 275     );
 276 }
 277
 278 sub build_local_config_service {
 279     my $self = shift;
 280
 281     return Bread::Board::BlockInjection->new(
 282         name => 'local_config',
 283         block => sub {
 284             my $s = shift;
 285
 286             return Config::Any->load_files({
 287                 files       => $s->param('local_files'),
 288                 filter      => \&_fix_syntax,
 289                 use_ext     => 1,
 290                 driver_args => $s->param('driver'),
 291             });
 292         },
 293         dependencies => [ depends_on('local_files') ],
 294     );
 295 }
 296
 297 sub build_config_path_service {
 298     my $self = shift;
 299
 300     return Bread::Board::BlockInjection->new(
 301         name => 'config_path',
 302         block => sub {
 303             my $s = shift;
 304
 305             my $path = $s->param('path');
 306             my $prefix = $s->param('prefix');
 307
 308             my ( $extension ) = ( $path =~ m{\.(.{1,4})$} );
 309
 310             if ( -d $path ) {
 311                 $path =~ s{[\/\\]$}{};
 312                 $path .= "/$prefix";
 313             }
 314
 315             return [ $path, $extension ];
 316         },
 317         dependencies => [ depends_on('prefix'), depends_on('path') ],
 318     );
 319 }
 320
 321 sub build_config_local_suffix_service {
 322     my $self = shift;
 323
 324     return Bread::Board::BlockInjection->new(
 325         name => 'config_local_suffix',
 326         block => sub {
 327             my $s = shift;
 328             my $suffix = Catalyst::Utils::env_value( $s->param('name'), 'CONFIG_LOCAL_SUFFIX' ) || $self->config_local_suffix;
 329
 330             return $suffix;
 331         },
 332         dependencies => [ depends_on('name') ],
 333     );
 334 }
 335
 336 sub _fix_syntax {
 337     my $config     = shift;
 338     my @components = (
 339         map +{
 340             prefix => $_ eq 'Component' ? '' : $_ . '::',
 341             values => delete $config->{ lc $_ } || delete $config->{ $_ }
 342         },
 343         grep { ref $config->{ lc $_ } || ref $config->{ $_ } }
 344             qw( Component Model M View V Controller C Plugin )
 345     );
 346
 347     foreach my $comp ( @components ) {
 348         my $prefix = $comp->{ prefix };
 349         foreach my $element ( keys %{ $comp->{ values } } ) {
 350             $config->{ "$prefix$element" } = $comp->{ values }->{ $element };
 351         }
 352     }
 353 }
 354
 355 sub _config_substitutions {
 356     my ( $self, $name, $subs, $arg ) = @_;
 357
 358     $subs->{ HOME } ||= sub { shift->path_to( '' ); };
 359     $subs->{ ENV } ||=
 360         sub {
 361             my ( $c, $v ) = @_;
 362             if (! defined($ENV{$v})) {
 363                 Catalyst::Exception->throw( message =>
 364                     "Missing environment variable: $v" );
 365                 return "";
 366             } else {
 367                 return $ENV{ $v };
 368             }
 369         };
 370     $subs->{ path_to } ||= sub { shift->path_to( @_ ); };
 371     $subs->{ literal } ||= sub { return $_[ 1 ]; };
 372     my $subsre = join( '|', keys %$subs );
 373
 374     $arg =~ s{__($subsre)(?:\((.+?)\))?__}{ $subs->{ $1 }->( $name, $2 ? split( /,/, $2 ) : () ) }eg;
 375     return $arg;
 376 }
 377
 378 1;
 379
 380 __END__
 381
 382 =pod
 383
 384 =head1 NAME
 385
 386 Catalyst::Container - IOC for Catalyst components
 387
 388 =head1 METHODS
 389
 390 =head2 build_model_subcontainer
 391
 392 =head2 build_view_subcontainer
 393
 394 =head2 build_controller_subcontainer
 395
 396 =head2 build_name_service
 397
 398 =head2 build_driver_service
 399
 400 =head2 build_file_service
 401
 402 =head2 build_substitutions_service
 403
 404 =head2 build_extensions_service
 405
 406 =head2 build_prefix_service
 407
 408 =head2 build_path_service
 409
 410 =head2 build_config_service
 411
 412 =head2 build_raw_config_service
 413
 414 =head2 build_global_files_service
 415
 416 =head2 build_local_files_service
 417
 418 =head2 build_global_config_service
 419
 420 =head2 build_local_config_service
 421
 422 =head2 build_config_path_service
 423
 424 =head2 build_config_local_suffix_service
 425
 426 =head2 _fix_syntax
 427
 428 =head2 _config_substitutions
 429
 430 =head1 AUTHORS
 431
 432 Catalyst Contributors, see Catalyst.pm
 433
 434 =head1 COPYRIGHT
 435
 436 This library is free software. You can redistribute it and/or modify it under
 437 the same terms as Perl itself.
 438
 439 =cut