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