lib/Catalyst/Container.pm

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