File Coverage

blib/lib/Config/Entities.pm

Criterion	Covered	Total	%
statement	132	139	94.9
branch	57	74	77.0
condition	16	21	76.1
subroutine	21	21	100.0
pod	4	4	100.0
total	230	259	88.8

use strict;
use warnings;

package Config::Entities;
$Config::Entities::VERSION = '1.07';
# ABSTRACT: An multi-level overridable perl based configuration module
# PODNAME: Config::Entities

use Cwd qw(abs_path);
use Data::Dumper;
use File::Find;
use File::Spec;
use Log::Any;

my $logger = Log::Any->get_logger();

sub new {
    my ( $class, @args ) = @_;
    return bless( {}, $class )->_init(@args);
}

sub as_hashref {
    return _copy(@_);
}

sub _copy {
    my ($value) = @_;

    my $ref = ref($value);
    if ($ref) {
        if ( $ref eq 'ARRAY' ) {
            return [ map { _copy($_) } @$value ];
        }
        elsif ( $ref eq 'HASH' || $value->isa('Config::Entities') ) {
            return { map { $_ => _copy( $value->{$_} ) } keys(%$value) };
        }
        elsif ( $ref eq 'SCALAR' ) {
            return $value;
        }
        else {
            croak("unsupported type '$ref'");
        }
    }
    else {
        return $value;
    }
}

sub _add_properties {
    my ( $self, $properties, $more_properties ) = @_;

    foreach my $key ( keys( %{$more_properties} ) ) {
        $properties->{$key} = $more_properties->{$key};
    }
}

sub fill {
    my ( $self, $coordinate, $hashref, %options ) = @_;

    my @entity = $self->get_entity( $coordinate, %options );
    foreach my $key ( keys(%$hashref) ) {
        if ( ref( $entity[0] ) eq 'HASH' && exists( $entity[0]->{$key} ) ) {
            $hashref->{$key} = $entity[0]->{$key};
        }
        elsif ( $hashref->{$key} && $hashref->{$key} eq 'Config::Entities::entity' ) {
            $hashref->{$key} = $entity[0];
        }
        elsif ( $options{ancestry} ) {
            for ( my $index = 1; $index < scalar(@entity); $index++ ) {
                if ( defined( $entity[$index]->{$key} ) ) {
                    $hashref->{$key} = $entity[$index]->{$key};
                    last;
                }
            }
        }
    }

    return $hashref;
}

sub get_entity {
    my ( $self, $coordinate, %options ) = @_;

    my @result = ($self);
    if ($coordinate) {
        foreach my $coordinate_part ( split( /\./, $coordinate ) ) {
            my $child = $result[0]->{$coordinate_part};
            return if ( !defined($child) );
            unshift( @result, $child );
        }
    }
    return $options{ancestry} ? @result : shift(@result);
}

sub _init {
    my ( $self, @args ) = @_;

    # if last arg is a hash, it is an options hash
    my $options =
        ref( $args[$#args] ) eq 'HASH'
        ? pop(@args)
        : {};

    # all other args are entities roots
    my @entities_roots = @args;

    my $properties = {};
    if ( $options->{properties_file} ) {

        # merge in properties from files
        my @properties_files =
            ref( $options->{properties_file} ) eq 'ARRAY'
            ? @{ $options->{properties_file} }
            : ( $options->{properties_file} );

        foreach my $properties_file (@properties_files) {
            $self->_add_properties( $properties, do($properties_file) );
        }
    }
    if ( $options->{properties} ) {

        # merge in direct properties
        $self->_add_properties( $properties, $options->{properties} );
    }

    if ( $options->{entity} ) {
        foreach my $key ( keys( %{ $options->{entity} } ) ) {
            _merge( $self, $key, $options->{entity}{$key} );
        }
    }

    if ( scalar(@entities_roots) ) {
        find(
            sub {
                if ( $_ =~ /^(.*)\.pmc?$/ && -f $File::Find::name ) {
                    my $key = $1;

                    my $hashref     = $self;
                    my @directories = File::Spec->splitdir(
                        substr( $File::Find::dir, length($File::Find::topdir) ) );
                    if ( scalar(@directories) ) {
                        shift(@directories) while ( !$directories[0] );
                        foreach my $dir (@directories) {
                            if ( !defined( $hashref->{$dir} ) ) {
                                $hashref->{$dir} = {};
                            }
                            $hashref = $hashref->{$dir};
                        }
                    }

                    my $entity;
                    {
                        # export %properties to the entity file
                        local $Config::Entities::properties = $properties;
                        ## no critic (ProhibitNoStrict)
                        no strict 'vars';
                        local %properties = $properties ? %$properties : ();
                        $entity = do($File::Find::name);
                        ## use critic
                    }
                    $logger->warn( 'unable to compile ', $File::Find::name, ': ', $@, "\n" )
                        if ($@);
                    _merge( $hashref, $key, $entity );
                }
            },
            map { Cwd::abs_path($_) } @entities_roots
        );
    }

    &$_($self) foreach $self->_inherit( undef, $self );

    return $self;
}

sub _inherit {
    my ( $self, $parent, $child ) = @_;

    my @after_inherit = ();
    if ($child) {
        my $ref = ref($child);
        if ( $ref eq 'HASH' || $ref eq 'Config::Entities' ) {
            if ( $parent && $child->{'Config::Entities::inherit'} ) {
                push(
                    @after_inherit,
                    $self->_inherit_each(
                        delete( $child->{'Config::Entities::inherit'} ),
                        $parent, $child
                    )
                );
            }
            push( @after_inherit, $self->_inherit( $child, $child->{$_} ) ) foreach keys(%$child);
        }
    }
    return @after_inherit;
}

sub _inherit_each {
    my ( $self, $inherit, $parent, $child ) = @_;

    my @after_inherit = ();
    if ( ref($inherit) eq 'ARRAY' ) {
        foreach my $spec (@$inherit) {
            my $spec_ref = ref($spec);
            if ($spec_ref) {
                if ( $spec_ref eq 'HASH' ) {
                    push( @after_inherit, $self->_inherit_spec( $spec, $parent, $child ) );
                }
                else {
                    croak('invalid inherit');
                }
            }
            elsif ( defined( $parent->{$spec} ) ) {
                $child->{$spec} = $parent->{$spec}
                    unless ( defined( $child->{$spec} ) );
            }
        }
    }
    return @after_inherit;
}

sub _inherit_spec {
    my ( $self, $spec, $parent, $child ) = @_;

    if ( $spec->{name} ) {
        my $as = $spec->{as} || $spec->{name};
        $child->{$as} = $parent->{ $spec->{name} }
            unless ( defined( $child->{$as} ) );
    }
    elsif ( $spec->{coordinate} ) {
        my $as = $spec->{as};
        unless ($as) {
            $as = $spec->{coordinate};
            $as =~ s/^.*\.//;
        }

        return sub {
            my ($entities) = @_;
            $child->{$as} = _copy( $entities->get_entity( $spec->{coordinate} ) );
            _merge( $child, $as, $spec->{using} ) if ( $spec->{using} );
        };
    }
    return;
}

sub _merge {
    my ( $hashref, $key, $value ) = @_;

    if ( ref($value) eq 'HASH' ) {

        # transfer key/value pairs from hashref
        # will merge rather than replace...
        if ( !defined( $hashref->{$key} ) ) {
            $hashref->{$key} = {};
        }
        $hashref = $hashref->{$key};

        while ( my ( $sub_key, $sub_value ) = each(%$value) ) {
            _merge( $hashref, $sub_key, $sub_value );
        }
    }
    else {
        # anything not a hashref will replace
        $hashref->{$key} = $value;
    }
}

1;

__END__