yet_anothor_catalyst_config.pm

package MyApp::Config;

use strict;
use warnings;
use base qw( Class::Singleton );
use Config::Any;
use Data::Visitor::Callback;
use Catalyst::Utils ();
use Path::Class;

our $Debug = 0;

sub _new_instance {
    my $class = shift;
    my $self = $class->new( @_ );
    return $self;
}

sub new {
    my $class = shift;
    unless ( $ENV{MYAPP_CONFIG_LOCAL_SUFFIX} ) {
        do '/etc/MyApp-conf.pl' or die "$class: $!";
    }
    my $self  = bless {}, $class;
    my @files = $self->find_files;
    my $cfg   = Config::Any->load_files( {
        files   => \@files,
        filter  => \&_fix_syntax,
        use_ext => 1,
    } );
    # map the array of hashrefs to a simple hash                                                        
    my %configs = map { %$_ } @$cfg;

    # split the responses into normal and local cfg                                                     
    my $local_suffix = $self->get_config_local_suffix;
    my ( @main, @locals );
    for ( sort keys %configs ) {
        if ( m{$local_suffix\.}ms ) {
            push @locals, $_;
        }
        else {
            push @main, $_;
        }
    }

    # load all the normal cfgs, then the local cfgs last so they can override                           
    # normal cfgs                                                                                       
    my %config;
    for my $file ( @main, @locals ) {
        for my $key ( keys %{ $configs{ $file } } ) {
            $config{ $key } = $configs{$file}->{$key};
        }
    }

    my $v = Data::Visitor::Callback->new(
        plain_value => sub {
            return unless defined $_;
            $self->config_substitutions( $_ );
        }
    );
    $v->visit( \%config );
    $self->{ $_ } = $config{ $_ } for keys %config;

    return $self;
}

sub load_config {
    my $self = shift;
    my $ref = shift;
    my ( $file, $config ) = %$ref;
    $self->{ $_ } = $config->{ $_ } for keys %$config;
    warn "Loaded Config $file" if $Debug;
    return;
}

sub find_files {
    my $self = shift;
    my ( $path, $extension ) = $self->get_config_path;
    my $suffix = $self->get_config_local_suffix;
    my @extensions = @{ Config::Any->extensions };
    my @files;
    if ( $extension ) {
        die "Unable to handle files with the extension '${extension}'"
            unless grep { $_ eq $extension } @extensions;
        ( my $local = $path ) =~ s{\.$extension}{_$suffix.$extension};
        push @files, $path, $local;
    }
    else {
        @files = map { ( "$path.$_", "${path}_${suffix}.$_" ) } @extensions;
    }
    @files;
}

sub get_config_path {
    my $self = shift;
    (my $appname = ref $self || $self) =~ s/^([^:]+).*$/$1/;
    my $prefix  = Catalyst::Utils::appprefix( $appname );
    my $path    = Catalyst::Utils::env_value( $appname, 'CONFIG' )
                  || $self->path_to( $prefix );
    my ( $extension ) = ( $path =~ m{\.(.{1,4})$} );
    if ( -d $path ) {
        $path =~ s{[\/\\]$}{};
        $path .= "/$prefix";
    }
    return ( $path, $extension );
}

sub get_config_local_suffix {
    my $self = shift;
    (my $appname = ref $self || $self) =~ s/^([^:]+).*$/$1/;
    my $suffix = Catalyst::Utils::env_value( $appname, 'CONFIG_LOCAL_SUFFIX' )
                 || 'local';
    return $suffix;
}

sub _fix_syntax {
    my $config     = shift;
    my @components = (
        map +{
            prefix => $_ eq 'Component' ? '' : $_ . '::',
            values => delete $config->{ lc $_ } || delete $config->{ $_ }
        },
        grep { ref $config->{ lc $_ } || ref $config->{ $_ } }
            qw( Component Model M View V Controller C Plugin )
    );

    foreach my $comp ( @components ) {
        my $prefix = $comp->{ prefix };
        foreach my $element ( keys %{ $comp->{ values } } ) {
            $config->{ "$prefix$element" } = $comp->{ values }->{ $element };
        }
    }
}

sub config_substitutions {
    my $self = shift;
    my $subs = {};
    $subs->{ HOME } ||= sub { shift->path_to( '' ); };
    $subs->{ ENV }  ||=
        sub {
            my ( $self, $v ) = @_;
            if ( !defined( $ENV{ $v } ) ) {
                warn "Missing environment variable: $v";
                return "";
            } else {
                return $ENV{ $v };
            }
        };
    $subs->{ path_to } ||= sub { shift->path_to( @_ ); };
    $subs->{ literal } ||= sub { return $_[ 1 ]; };
    my $subsre = join( '|', keys %$subs );
    for ( @_ ) {
        s{__($subsre)(?:\((.+?)\))?__}
         {$subs->{ $1 }->( $self, $2 ? split( /,/, $2 ) : () ) }eg;
    }
}

sub path_to {
    my ( $self, @path ) = @_;
    my $class = ref $self || $self;
    my $home = Catalyst::Utils::home( $class );
    my $path = Path::Class::Dir->new( $home, @path );
    if ( -d $path ) { return $path }
    else { return Path::Class::File->new( $home, @path ) }
}

1;