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