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