view release on metacpan or  search on metacpan

lib/Config/Model/ListId.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::ListId 2.166;

use 5.20.0;
use Mouse;

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

use Carp;
extends qw/Config::Model::AnyId/;

with "Config::Model::Role::Grab";
with "Config::Model::Role::ComputeFunction";
with "Config::Model::Role::Utils";
# this requires backup method from Config::Model::AnyThing
with "Config::Model::Role::WarpSubject";

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

my $logger = get_logger("Tree::Element::Id::List");
my $user_logger = get_logger("User");

has data => (
    is      => 'rw',
    isa     => 'ArrayRef',
    default => sub { []; },
    traits  => ['Array'],
    handles => {
        _sort_data   => 'sort_in_place',
        _all_data    => 'elements',
        _splice_data => 'splice',
    } );

# compatibility with HashId
has index_type => ( is => 'ro', isa => 'Str', default => 'integer' );
has auto_create_ids => ( is => 'rw' );

sub BUILD {
    my $self = shift;

    foreach my $wrong (qw/max_nb min_index default_keys/) {
        Config::Model::Exception::Model->throw(
            object => $self,
            error  => "Cannot use $wrong with " . $self->get_type . " element"
        ) if defined $self->{$wrong};
    }

    if ( delete $self->{migrate_keys_from} ) {
        $user_logger->warn(
            $self->name, "Using migrate_keys_from with ",
            "list element is obsolete and ignored. Use migrate_values_from"
        );
    }

    # Supply the mandatory parameter
    return $self;
}

sub set_properties ($self, @args) {

    $self->SUPER::set_properties(@args);

    # remove unwanted items
    my $data = $self->{data};

    return unless defined $self->{max_index};

    # delete entries that no longer fit the constraints imposed by the
    # warp mechanism
    foreach my $k ( 0 .. $#{$data} ) {
        next unless $k > $self->{max_index};
        $logger->trace( "set_properties: ", $self->name, " deleting index $k" );
        delete $data->[$k];
    }