view release on metacpan or  search on metacpan

lib/Config/Model/Warper.pm  view on Meta::CPAN

#
# This file is part of Config-Model
#
# This software is Copyright (c) 2005-2022 by Dominique Dumont.
#
# This is free software, licensed under:
#
#   The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Warper 2.162;

use Mouse;

use Log::Log4perl qw(get_logger :levels);
use Data::Dumper;
use Storable qw/dclone/;
use Config::Model::Exception;
use List::MoreUtils qw/any/;
use Carp;

use feature qw/postderef signatures/;
no warnings qw/experimental::postderef experimental::signatures/;

has 'follow' => ( is => 'ro', isa => 'HashRef[Str]', required => 1 );
has 'rules'  => ( is => 'ro', isa => 'ArrayRef',     required => 1 );

has 'warped_object' => (
    is       => 'ro',
    isa      => 'Config::Model::AnyThing',
    handles  => ['needs_check'],
    weak_ref => 1,
    required => 1
);

has '_values' => (
    traits  => ['Hash'],
    is      => 'ro',
    isa     => 'HashRef[HashRef | Str | Undef ]',
    default => sub { {} },
    handles => {
        _set_value  => 'set',
        _get_value  => 'get',
        _value_keys => 'keys',
    },
);

sub _get_value_gist {
    my $self = shift;
    my $warper_name  = shift;
    my $item = $self->_get_value($warper_name);

    return ref($item) eq 'HASH' ? join(',', each %$item) : $item;
}

has [qw/ _computed_masters _warped_nodes _registered_values/] => (
    is => 'rw',
    isa => 'HashRef',
    init_arg => undef, # can't use this param in constructor
    default => sub { {} },
);

has allowed => ( is => 'rw', isa => 'ArrayRef' );
has morph   => ( is => 'ro', isa => 'Bool' );

my $logger = get_logger("Warper");

# create the object, check args, but don't do anything else
sub BUILD ($self,$) {
    $logger->trace( "Warper new: created for " . $self->name );
    $self->check_warp_args;

    $self->register_to_all_warp_masters;
    $self->refresh_values_from_master;
    $self->do_warp;
    return;
}

# should be called only at startup
sub register_to_all_warp_masters ($self) {
    my $follow = $self->follow;

    # now, follow is only { w1 => 'warp1', w2 => 'warp2'}
    foreach my $warper_name ( keys %$follow ) {
        $self->register_to_one_warp_master($warper_name);
    }