view release on metacpan or  search on metacpan

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

use Mouse;
use Mouse::Util::TypeConstraints;
use MouseX::StrictConstructor;

use Parse::RecDescent 1.90.0;

use Data::Dumper ();
use Config::Model::Exception;
use Config::Model::ValueComputer;
use Config::Model::IdElementReference;
use Config::Model::Warper;
use Config::Model::Value::Update;

use Log::Log4perl qw(get_logger :levels);
use Scalar::Util qw/weaken/;
use Carp;
use Storable qw/dclone/;
use Path::Tiny;
use List::Util qw(any) ;
extends qw/Config::Model::AnyThing/;

with "Config::Model::Role::WarpMaster";
with "Config::Model::Role::Grab";
with "Config::Model::Role::HelpAsText";
with "Config::Model::Role::ComputeFunction";

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

my $logger        = get_logger("Tree::Element::Value");
my $user_logger   = get_logger("User");
my $change_logger = get_logger("Anything::Change");
my $fix_logger    = get_logger("Anything::Fix");

our $nowarning = 0;    # global variable to silence warnings. Only used for tests

enum ValueType => qw/boolean enum uniline string integer number reference file dir/;

has fixes => ( is => 'rw', isa => 'ArrayRef', default => sub { [] } );

has [qw/warp compute computed_refer_to backup migrate_from/] =>
    ( is => 'rw', isa => 'Maybe[HashRef]' );

has compute_obj => (
    is      => 'ro',
    isa     => 'Maybe[Config::Model::ValueComputer]',
    builder => '_build_compute_obj',
    lazy    => 1
);

has [qw/write_as/] => ( is => 'rw', isa => 'Maybe[ArrayRef]' );

has [qw/refer_to _data replace_follow/] => ( is => 'rw', isa => 'Maybe[Str]' );

has value_type => ( is => 'rw', isa => 'ValueType' );

my @common_int_params = qw/min max mandatory /;
has \@common_int_params => ( is => 'ro', isa => 'Maybe[Int]' );

my @common_hash_params = qw/replace assert update warn_if_match warn_unless_match warn_if warn_unless help/;
has \@common_hash_params => ( is => 'ro', isa => 'Maybe[HashRef]' );

has update_obj => (
    is => 'ro',
    isa => 'Undef|Config::Model::Value::Update',
    handles => [qw/get_update_value/],
    lazy => 1,
    builder => sub ($self) {
        if (my $ref = $self->update) {
            return Config::Model::Value::Update->new(%$ref, location => $self->location);
        }
    }
);

my @common_list_params = qw/choice/;
has \@common_list_params => ( is => 'ro', isa => 'Maybe[ArrayRef]' );

my @common_str_params = qw/default upstream_default convert match grammar warn/;
has \@common_str_params => ( is => 'ro', isa => 'Maybe[Str]' );

my @warp_accessible_params =
    ( @common_int_params, @common_str_params, @common_list_params, @common_hash_params );

my @allowed_warp_params = ( @warp_accessible_params, qw/level help/ );
my @backup_list         = ( @allowed_warp_params,    qw/migrate_from/ );

has compute_is_upstream_default =>
    ( is => 'ro', isa => 'Bool', lazy => 1, builder => '_compute_is_upstream_default' );

sub _compute_is_upstream_default {
    my $self = shift;
    return 0 unless defined $self->compute;
    return $self->compute_obj->use_as_upstream_default;
}

has compute_is_default =>
    ( is => 'ro', isa => 'Bool', lazy => 1, builder => '_compute_is_default' );

sub _compute_is_default {
    my $self = shift;
    return 0 unless defined $self->compute;
    return !$self->compute_obj->use_as_upstream_default;
}

has error_list => (
    is      => 'ro',
    isa     => 'ArrayRef',
    default => sub { [] },
    traits  => ['Array'],
    handles => {
        add_error    => 'push',
        clear_errors => 'clear',
        has_error    => 'count',
        all_errors   => 'elements',
        is_ok        => 'is_empty'
    } );

sub error_msg  ($self) {
    my $msg = '';
    if ($self->has_error) {
        my @add;
        push @add, $self->compute_obj->compute_info if $self->compute_obj;
        push @add, $self->{_migrate_from}->compute_info if $self->{_migrate_from};
        $msg = join("\n", $self->all_errors, @add);
    }
    return $msg;
}

has warning_list => (
    is      => 'ro',
    isa     => 'ArrayRef',
    default => sub { [] },
    traits  => ['Array'],
    handles => {
        add_warning    => 'push',
        clear_warnings => 'clear',