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