view release on metacpan or  search on metacpan

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

use Mouse;
use MouseX::StrictConstructor;

# use Scalar::Util qw(weaken) ;
use Carp;
use Parse::RecDescent 1.90.0;
use Data::Dumper ();
use Log::Log4perl qw(get_logger :levels);

use vars qw($compute_grammar $compute_parser);

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

my $logger = get_logger("ValueComputer");

# allow_override is intercepted and handled by Value object

has formula    => ( is => 'ro', isa => 'Str', required => 1 );
has value_type => ( is => 'ro', isa => 'Str', required => 1 );

# value_object is mostly used for error messages
has value_object => (
    is => 'ro',
    isa => 'Config::Model::AnyThing',
    required => 1,
    weak_ref => 1,
    handles => [qw/grab grab_value location index element/],
);

has variables => ( is => 'ro', isa => 'HashRef', default => sub { {} } );
has replace   => ( is => 'ro', isa => 'HashRef', default => sub { {} } );
has [qw/use_eval allow_override use_as_upstream_default/] =>
    ( is => 'ro', isa => 'Bool', default => 0 );

has allow_user_override => (
    is   => 'ro',
    isa  => 'Bool',
    lazy => 1,
    builder =>
        sub { my $self = shift; return $self->allow_override || $self->use_as_upstream_default; } );

has need_quote => ( is => 'ro', isa => 'Bool', builder => '_need_quote', lazy => 1 );

sub _need_quote {
    my $self = shift;

    my $need_quote = 0;
    $need_quote = 1 if $self->{use_eval} and $self->{value_type} !~ /(integer|number|boolean)/;
    return $need_quote;
}

has undef_is => ( is => 'ro', isa => 'Maybe[Str]' );

has undef_replacement => (
    is      => 'ro',
    isa     => 'Maybe[Str]',
    builder => '_build_undef_replacement',
    lazy    => 1
);

sub _build_undef_replacement {
    my $self = shift;