view release on metacpan or  search on metacpan

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

use v5.20;

use strict;
use warnings;

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/;

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

sub fetch_preset {
    my $self = shift;
    return $self->map_write_as( $self->{preset} );
}

sub clear ($self, @args){
    $self->store(value => undef, @args);
    return;
}

sub clear_preset {
    my $self = shift;
    delete $self->{preset};
    return defined $self->{layered} || defined $self->{data};
}

sub fetch_layered {
    my $self = shift;
    return $self->map_write_as( $self->{layered} );
}

sub clear_layered {
    my $self = shift;
    delete $self->{layered};
    return defined $self->{preset} || defined $self->{data};
}

sub get ($self, @args) {
    my %args = @args > 1 ? @args : ( path => $args[0] );
    my $path = delete $args{path};
    if ($path) {
        Config::Model::Exception::User->throw(
            object  => $self,
            message => "get() called with a value with non-empty path: '$path'"
        );
    }
    return $self->fetch(%args);
}

sub set ($self, $path, @data) {
    if ($path) {
        Config::Model::Exception::User->throw(
            object  => $self,
            message => "set() called with a value with non-empty path: '$path'"
        );
    }
    return $self->store(@data);
}

#These methods are important when this leaf value is used as a warp
#master, or a variable in a compute formula.

# register a dependency, This information may be used by external
# tools
sub register_dependency {
    my $self  = shift;
    my $slave = shift;

    unshift @{ $self->{depend_on_me} }, $slave;

    # weaken only applies to the passed reference, and there's no way
    # to duplicate a weak ref. Only a strong ref is created.
    weaken( $self->{depend_on_me}[0] );
    return;
}

sub get_depend_slave {
    my $self = shift;

    my @result = ();
    push @result, @{ $self->{depend_on_me} }
        if defined $self->{depend_on_me};

    push @result, $self->get_warped_slaves;

    # needs to clean up weak ref to object that were destroyed
    return grep { defined $_ } @result;
}

__PACKAGE__->meta->make_immutable;

1;

# ABSTRACT:	 Strongly typed configuration value

__END__

=pod

=encoding UTF-8

=head1 NAME

Config::Model::Value - Strongly typed configuration value

=head1 VERSION

version 2.162

=head1 SYNOPSIS

 use Config::Model;

 # define configuration tree object
 my $model = Config::Model->new;
 $model ->create_config_class (
    name => "MyClass",

    element => [

        [qw/foo bar/] => {
            type	   => 'leaf',
            value_type => 'string',
            description => 'foobar',
        }
        ,
        country => {
            type =>		  'leaf',
            value_type => 'enum',
            choice =>	   [qw/France US/],
            description => 'big countries',
        }
    ,