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     container $self => as {
  44         service name => $self->name;
  45         service driver => $self->driver;
  46         service file => $self->file;
  47         service substitutions => $self->substitutions;
  48
  49         service extensions => (
  50             block => sub {
  51                 return \@{Config::Any->extensions};
  52             },
  53         );
  54
  55         service prefix => (
  56             block => sub {
  57                 return Catalyst::Utils::appprefix( shift->param('name') );
  58             },
  59             dependencies => [ depends_on('name') ],
  60          );
  61
  62         service path => (
  63             block => sub {
  64                 my $s = shift;
  65
  66                 return Catalyst::Utils::env_value( $s->param('name'), 'CONFIG' )
  67                 || $s->param('file')
  68                 || $s->param('name')->path_to( $s->param('prefix') );
  69             },
  70             dependencies => [ depends_on('file'), depends_on('name'), depends_on('prefix') ],
  71         );
  72
  73         service config => (
  74             block => sub {
  75                 my $s = shift;
  76
  77                 my $v = Data::Visitor::Callback->new(
  78                     plain_value => sub {
  79                         return unless defined $_;
  80                         return $self->_config_substitutions( $s->param('name'), $s->param('substitutions'), $_ );
  81                     }
  82
  83                 );
  84                 $v->visit( $s->param('raw_config') );
  85             },
  86             dependencies => [ depends_on('name'), depends_on('raw_config'), depends_on('substitutions') ],
  87         );
  88
  89         service raw_config => (
  90             block => sub {
  91                 my $s = shift;
  92
  93                 my @global = @{$s->param('global_config')};
  94                 my @locals = @{$s->param('local_config')};
  95
  96                 my $config = {};
  97                 for my $cfg (@global, @locals) {
  98                     for (keys %$cfg) {
  99                         $config = Catalyst::Utils::merge_hashes( $config, $cfg->{$_} );
 100                     }
 101                 }
 102                 return $config;
 103             },
 104             dependencies => [ depends_on('global_config'), depends_on('local_config') ],
 105         );
 106
 107         service global_files => (
 108             block => sub {
 109                 my $s = shift;
 110
 111                 my ( $path, $extension ) = @{$s->param('config_path')};
 112
 113                 my @extensions = @{$s->param('extensions')};
 114
 115                 my @files;
 116                 if ( $extension ) {
 117                     die "Unable to handle files with the extension '${extension}'" unless grep { $_ eq $extension } @extensions;
 118                     push @files, $path;
 119                 } else {
 120                     @files = map { "$path.$_" } @extensions;
 121                 }
 122                 return \@files;
 123             },
 124             dependencies => [ depends_on('extensions'), depends_on('config_path') ],
 125         );
 126
 127         service local_files => (
 128             block => sub {
 129                 my $s = shift;
 130
 131                 my ( $path, $extension ) = @{$s->param('config_path')};
 132                 my $suffix = $s->param('config_local_suffix');
 133
 134                 my @extensions = @{$s->param('extensions')};
 135
 136                 my @files;
 137                 if ( $extension ) {
 138                     die "Unable to handle files with the extension '${extension}'" unless grep { $_ eq $extension } @extensions;
 139                     $path =~ s{\.$extension}{_$suffix.$extension};
 140                     push @files, $path;
 141                 } else {
 142                     @files = map { "${path}_${suffix}.$_" } @extensions;
 143                 }
 144                 return \@files;
 145             },
 146             dependencies => [ depends_on('extensions'), depends_on('config_path'), depends_on('config_local_suffix') ],
 147         );
 148
 149         service global_config => (
 150             block => sub {
 151                 my $s = shift;
 152
 153                 my @files = @{$s->param('global_files')};
 154
 155                 my $cfg = Config::Any->load_files({
 156                     files       => \@files,
 157                     filter      => \&_fix_syntax,
 158                     use_ext     => 1,
 159                     driver_args => $s->param('driver'),
 160                 });
 161
 162                 return $cfg;
 163             },
 164             dependencies => [ depends_on('global_files') ],
 165         );
 166
 167         service local_config => (
 168             block => sub {
 169                 my $s = shift;
 170
 171                 my @files = @{$s->param('local_files')};
 172
 173                 my $cfg = Config::Any->load_files({
 174                     files       => \@files,
 175                     filter      => \&_fix_syntax,
 176                     use_ext     => 1,
 177                     driver_args => $s->param('driver'),
 178                 });
 179
 180                  return $cfg;
 181             },
 182             dependencies => [ depends_on('local_files') ],
 183         );
 184
 185         service config_path => (
 186             block => sub {
 187                 my $s = shift;
 188
 189                 my $path = $s->param('path');
 190                 my $prefix = $s->param('prefix');
 191
 192                 my ( $extension ) = ( $path =~ m{\.(.{1,4})$} );
 193
 194                 if ( -d $path ) {
 195                     $path =~ s{[\/\\]$}{};
 196                     $path .= "/$prefix";
 197                 }
 198
 199                 return [ $path, $extension ];
 200             },
 201             dependencies => [ depends_on('prefix'), depends_on('path') ],
 202         );
 203
 204         service config_local_suffix => (
 205             block => sub {
 206                 my $s = shift;
 207                 my $suffix = Catalyst::Utils::env_value( $s->param('name'), 'CONFIG_LOCAL_SUFFIX' ) || $self->config_local_suffix;
 208
 209                 return $suffix;
 210             },
 211             dependencies => [ depends_on('name') ],
 212         );
 213
 214     };
 215 }
 216
 217 sub _fix_syntax {
 218     my $config     = shift;
 219     my @components = (
 220         map +{
 221             prefix => $_ eq 'Component' ? '' : $_ . '::',
 222             values => delete $config->{ lc $_ } || delete $config->{ $_ }
 223         },
 224         grep { ref $config->{ lc $_ } || ref $config->{ $_ } }
 225             qw( Component Model M View V Controller C Plugin )
 226     );
 227
 228     foreach my $comp ( @components ) {
 229         my $prefix = $comp->{ prefix };
 230         foreach my $element ( keys %{ $comp->{ values } } ) {
 231             $config->{ "$prefix$element" } = $comp->{ values }->{ $element };
 232         }
 233     }
 234 }
 235
 236 sub _config_substitutions {
 237     my ($self, $name, $subs) = (shift, shift, shift);
 238
 239     $subs->{ HOME } ||= sub { shift->path_to( '' ); };
 240     $subs->{ ENV } ||=
 241         sub {
 242             my ( $c, $v ) = @_;
 243             if (! defined($ENV{$v})) {
 244                 Catalyst::Exception->throw( message =>
 245                     "Missing environment variable: $v" );
 246                 return "";
 247             } else {
 248                 return $ENV{ $v };
 249             }
 250         };
 251     $subs->{ path_to } ||= sub { shift->path_to( @_ ); };
 252     $subs->{ literal } ||= sub { return $_[ 1 ]; };
 253     my $subsre = join( '|', keys %$subs );
 254
 255     for ( @_ ) {
 256         my $arg = $_;
 257         $arg =~ s{__($subsre)(?:\((.+?)\))?__}{ $subs->{ $1 }->( $name, $2 ? split( /,/, $2 ) : () ) }eg;
 258         return $arg;
 259     }
 260 }
 261
 262 1;