view release on metacpan or  search on metacpan

lib/Config/Model/IdElementReference.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::IdElementReference 2.162;

use Mouse;

use Carp;
use Config::Model::ValueComputer;
use Log::Log4perl qw(get_logger :levels);

my $logger = get_logger("Tree::Element::IdElementReference");

# config_elt is a reference to the object that called new
has config_elt => ( is => 'ro', isa => 'Config::Model::AnyThing', required => 1, weak_ref => 1 );
has refer_to => ( is => 'ro', isa => 'Maybe[Str]' );
has computed_refer_to => ( is => 'ro', isa => 'Maybe[HashRef]' );

sub BUILD {
    my $self = shift;

    my $found = scalar grep { defined $self->$_; } qw/refer_to computed_refer_to/;

    if ( not $found ) {
        Config::Model::Exception::Model->throw(
            object  => $self->config_elt,
            message => "missing " . "refer_to or computed_refer_to parameter"
        );
    }
    elsif ( $found > 1 ) {
        Config::Model::Exception::Model->throw(
            object  => $self->config_elt,
            message => "cannot specify both " . "refer_to and computed_refer_to parameters"
        );
    }

    my $rft    = $self->{refer_to};
    my $crft   = $self->{computed_refer_to} || {};
    my %c_args = %$crft;

    my $refer_path =
        defined $rft
        ? $rft
        : delete $c_args{formula};

    # split refer_path on + then create as many ValueComputer as
    # required
    my @references = split /\s+\+\s+/, $refer_path;

    foreach my $single_path (@references) {
        push @{ $self->{compute} }, Config::Model::ValueComputer->new(
            formula   => $single_path,
            variables => {},
            %c_args,
            value_object => $self->{config_elt},
            value_type   => 'string'               # a reference is always a string
        );
    }

    return $self;
}

# internal

# FIXME: do not call back value object -> may recurse
sub get_choice_from_referred_to {
    my $self = shift;

    my $config_elt  = $self->{config_elt};
    my @enum_choice = $config_elt->get_default_choice;

    foreach my $compute_obj ( @{ $self->{compute} } ) {
        my $user_spec = $compute_obj->compute;

        next unless defined $user_spec;

        my @path = split( /\s+/, $user_spec );