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