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 => 'Bread::Board::Container',
  47 );
  48
  49 sub BUILD {
  50     my $self = shift;
  51
  52     $self->add_service(
  53         $self->${\"build_${_}_service"}
  54     ) for qw/
  55         substitutions
  56         file
  57         driver
  58         name
  59         prefix
  60         extensions
  61         path
  62         config
  63         raw_config
  64         global_files
  65         local_files
  66         global_config
  67         local_config
  68         config_local_suffix
  69         config_path
  70     /;
  71
  72     $self->add_sub_container(
  73         $self->${ \"build_${_}_subcontainer" }
  74     ) for qw/ model view controller /;
  75 }
  76
  77 sub build_model_subcontainer {
  78     my $self = shift;
  79
  80     return $self->sub_container_class->new( name => 'model' );
  81 }
  82
  83 sub build_view_subcontainer {
  84     my $self = shift;
  85
  86     return $self->sub_container_class->new( name => 'view' );
  87 }
  88
  89 sub build_controller_subcontainer {
  90     my $self = shift;
  91
  92     return $self->sub_container_class->new( name => 'controller' );
  93 }
  94
  95 sub build_name_service {
  96     my $self = shift;
  97
  98     return Bread::Board::Literal->new( name => 'name', value => $self->name );
  99 }
 100
 101 sub build_driver_service {
 102     my $self = shift;
 103
 104     return Bread::Board::Literal->new( name => 'driver', value => $self->driver );
 105 }
 106
 107 sub build_file_service {
 108     my $self = shift;
 109
 110     return Bread::Board::Literal->new( name => 'file', value => $self->file );
 111 }
 112
 113 sub build_substitutions_service {
 114     my $self = shift;
 115
 116     return Bread::Board::Literal->new( name => 'substitutions', value => $self->substitutions );
 117 }
 118
 119 sub build_extensions_service {
 120     my $self = shift;
 121
 122     return Bread::Board::BlockInjection->new(
 123         name => 'extensions',
 124         block => sub {
 125             return \@{Config::Any->extensions};
 126         },
 127     );
 128 }
 129
 130 sub build_prefix_service {
 131     my $self = shift;
 132
 133     return Bread::Board::BlockInjection->new(
 134         name => 'prefix',
 135         block => sub {
 136             return Catalyst::Utils::appprefix( shift->param('name') );
 137         },
 138         dependencies => [ depends_on('name') ],
 139     );
 140 }
 141
 142 sub build_path_service {
 143     my $self = shift;
 144
 145     return Bread::Board::BlockInjection->new(
 146         name => 'path',
 147         block => sub {
 148             my $s = shift;
 149
 150             return Catalyst::Utils::env_value( $s->param('name'), 'CONFIG' )
 151             || $s->param('file')
 152             || $s->param('name')->path_to( $s->param('prefix') );
 153         },
 154         dependencies => [ depends_on('file'), depends_on('name'), depends_on('prefix') ],
 155     );
 156 }
 157
 158 sub build_config_service {
 159     my $self = shift;
 160
 161     return Bread::Board::BlockInjection->new(
 162         name => 'config',
 163         block => sub {
 164             my $s = shift;
 165
 166             my $v = Data::Visitor::Callback->new(
 167                 plain_value => sub {
 168                     return unless defined $_;
 169                     return $self->_config_substitutions( $s->param('name'), $s->param('substitutions'), $_ );
 170                 }
 171
 172             );
 173             $v->visit( $s->param('raw_config') );
 174         },
 175         dependencies => [ depends_on('name'), depends_on('raw_config'), depends_on('substitutions') ],
 176     );
 177 }
 178
 179 sub build_raw_config_service {
 180     my $self = shift;
 181
 182     return Bread::Board::BlockInjection->new(
 183         name => 'raw_config',
 184         block => sub {
 185             my $s = shift;
 186
 187             my @global = @{$s->param('global_config')};
 188             my @locals = @{$s->param('local_config')};
 189
 190             my $config = {};
 191             for my $cfg (@global, @locals) {
 192                 for (keys %$cfg) {
 193                     $config = Catalyst::Utils::merge_hashes( $config, $cfg->{$_} );
 194                 }
 195             }
 196             return $config;
 197         },
 198         dependencies => [ depends_on('global_config'), depends_on('local_config') ],
 199     );
 200 }
 201
 202 sub build_global_files_service {
 203     my $self = shift;
 204
 205     return Bread::Board::BlockInjection->new(
 206         name => 'global_files',
 207         block => sub {
 208             my $s = shift;
 209
 210             my ( $path, $extension ) = @{$s->param('config_path')};
 211
 212             my @extensions = @{$s->param('extensions')};
 213
 214             my @files;
 215             if ( $extension ) {
 216                 die "Unable to handle files with the extension '${extension}'" unless grep { $_ eq $extension } @extensions;
 217                 push @files, $path;
 218             } else {
 219                 @files = map { "$path.$_" } @extensions;
 220             }
 221             return \@files;
 222         },
 223         dependencies => [ depends_on('extensions'), depends_on('config_path') ],
 224     );
 225 }
 226
 227 sub build_local_files_service {
 228     my $self = shift;
 229
 230     return Bread::Board::BlockInjection->new(
 231         name => 'local_files',
 232         block => sub {
 233             my $s = shift;
 234
 235             my ( $path, $extension ) = @{$s->param('config_path')};
 236             my $suffix = $s->param('config_local_suffix');
 237
 238             my @extensions = @{$s->param('extensions')};
 239
 240             my @files;
 241             if ( $extension ) {
 242                 die "Unable to handle files with the extension '${extension}'" unless grep { $_ eq $extension } @extensions;
 243                 $path =~ s{\.$extension}{_$suffix.$extension};
 244                 push @files, $path;
 245             } else {
 246                 @files = map { "${path}_${suffix}.$_" } @extensions;
 247             }
 248             return \@files;
 249         },
 250         dependencies => [ depends_on('extensions'), depends_on('config_path'), depends_on('config_local_suffix') ],
 251     );
 252 }
 253
 254 sub build_global_config_service {
 255     my $self = shift;
 256
 257     return Bread::Board::BlockInjection->new(
 258         name => 'global_config',
 259         block => sub {
 260             my $s = shift;
 261
 262             return Config::Any->load_files({
 263                 files       => $s->param('global_files'),
 264                 filter      => \&_fix_syntax,
 265                 use_ext     => 1,
 266                 driver_args => $s->param('driver'),
 267             });
 268         },
 269         dependencies => [ depends_on('global_files') ],
 270     );
 271 }
 272
 273 sub build_local_config_service {
 274     my $self = shift;
 275
 276     return Bread::Board::BlockInjection->new(
 277         name => 'local_config',
 278         block => sub {
 279             my $s = shift;
 280
 281             return Config::Any->load_files({
 282                 files       => $s->param('local_files'),
 283                 filter      => \&_fix_syntax,
 284                 use_ext     => 1,
 285                 driver_args => $s->param('driver'),
 286             });
 287         },
 288         dependencies => [ depends_on('local_files') ],
 289     );
 290 }
 291
 292 sub build_config_path_service {
 293     my $self = shift;
 294
 295     return Bread::Board::BlockInjection->new(
 296         name => 'config_path',
 297         block => sub {
 298             my $s = shift;
 299
 300             my $path = $s->param('path');
 301             my $prefix = $s->param('prefix');
 302
 303             my ( $extension ) = ( $path =~ m{\.(.{1,4})$} );
 304
 305             if ( -d $path ) {
 306                 $path =~ s{[\/\\]$}{};
 307                 $path .= "/$prefix";
 308             }
 309
 310             return [ $path, $extension ];
 311         },
 312         dependencies => [ depends_on('prefix'), depends_on('path') ],
 313     );
 314 }
 315
 316 sub build_config_local_suffix_service {
 317     my $self = shift;
 318
 319     return Bread::Board::BlockInjection->new(
 320         name => 'config_local_suffix',
 321         block => sub {
 322             my $s = shift;
 323             my $suffix = Catalyst::Utils::env_value( $s->param('name'), 'CONFIG_LOCAL_SUFFIX' ) || $self->config_local_suffix;
 324
 325             return $suffix;
 326         },
 327         dependencies => [ depends_on('name') ],
 328     );
 329 }
 330
 331 sub _fix_syntax {
 332     my $config     = shift;
 333     my @components = (
 334         map +{
 335             prefix => $_ eq 'Component' ? '' : $_ . '::',
 336             values => delete $config->{ lc $_ } || delete $config->{ $_ }
 337         },
 338         grep { ref $config->{ lc $_ } || ref $config->{ $_ } }
 339             qw( Component Model M View V Controller C Plugin )
 340     );
 341
 342     foreach my $comp ( @components ) {
 343         my $prefix = $comp->{ prefix };
 344         foreach my $element ( keys %{ $comp->{ values } } ) {
 345             $config->{ "$prefix$element" } = $comp->{ values }->{ $element };
 346         }
 347     }
 348 }
 349
 350 sub _config_substitutions {
 351     my ( $self, $name, $subs, $arg ) = @_;
 352
 353     $subs->{ HOME } ||= sub { shift->path_to( '' ); };
 354     $subs->{ ENV } ||=
 355         sub {
 356             my ( $c, $v ) = @_;
 357             if (! defined($ENV{$v})) {
 358                 Catalyst::Exception->throw( message =>
 359                     "Missing environment variable: $v" );
 360                 return "";
 361             } else {
 362                 return $ENV{ $v };
 363             }
 364         };
 365     $subs->{ path_to } ||= sub { shift->path_to( @_ ); };
 366     $subs->{ literal } ||= sub { return $_[ 1 ]; };
 367     my $subsre = join( '|', keys %$subs );
 368
 369     $arg =~ s{__($subsre)(?:\((.+?)\))?__}{ $subs->{ $1 }->( $name, $2 ? split( /,/, $2 ) : () ) }eg;
 370     return $arg;
 371 }
 372
 373 sub get_component {
 374     my ( $self, $type, $name, $args ) = @_;
 375     return $self->get_sub_container($type)->resolve( service => $name, parameters => { context => $args } );
 376 }
 377
 378 1;