view release on metacpan or  search on metacpan

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

    return ;
}

sub accept_regexp {
    my ($self) = @_;

    return @{ $self->{model}{accept_list} || [] };
}

sub reset_accepted_element_model {
    my ( $self, $element_name, $accept_model ) = @_;

    my $model = dclone $accept_model ;
    delete $model->{name_match};
    my $accept_after = delete $model->{accept_after};

    foreach my $info_to_move (qw/description summary/) {
        my $moved_data = delete $model->{$info_to_move};
        next unless defined $moved_data;
        $self->{$info_to_move}{$element_name} = $moved_data;
    }

    foreach my $info_to_move (qw/level status/) {
        $self->reset_element_property(
            element  => $element_name,
            property => $info_to_move
        );
    }

    $self->{model}{element}{$element_name} = $model;

    #add to element list...
    if ($accept_after) {
        insert_after_string( $accept_after, $element_name, @{ $self->{model}{element_list} } );
    }
    else {
        push @{ $self->{model}{element_list} }, $element_name;
    }

    return ($model);
}

sub element_exists {
    my $self         = shift;
    my $element_name = shift;

    return defined $self->{model}{element}{$element_name} ? 1 : 0;
}

sub is_element_defined ($self, $elt_name) {
    return defined $self->{element}{ $elt_name };
}

sub get ($self, @args) {
    my %args         = _resolve_arg_shortcut(\@args, 'path');
    my $path    = delete $args{path};
    my $get_obj = delete $args{get_obj} || 0;
    $path =~ s!^/!!;
    return $self unless length($path);
    my ( $item, $new_path ) = split m!/!, $path, 2;
    $logger->trace("get: path $path, item $item");
    my $elt = $self->fetch_element( name => $item, %args );

    return unless defined $elt;
    return $elt if ( ( $elt->get_type ne 'leaf' or $get_obj ) and not defined $new_path );
    return $elt->get( path => $new_path, get_obj => $get_obj, %args );
}

sub set ($self, $path, @args) {
    $path =~ s!^/!!;
    my ( $item, $new_path ) = split m!/!, $path, 2;
    if ( $item =~ /([\w\-]+)\[(\d+)\]/ ) {
        return $self->fetch_element($1)->fetch_with_id($2)->set( $new_path, @args );
    }
    else {
        return $self->fetch_element($item)->set( $new_path, @args );
    }
}

sub load ($self, @args) {
    my $loader = Config::Model::Loader->new( start_node => $self );

    my %args = _resolve_arg_shortcut(\@args, 'steps');
    if ( defined $args{step} || defined $args{steps}) {
        return $loader->load( %args );
    }
    Config::Model::Exception::Load->throw(
        object  => $self,
        message => "load called with no 'steps' parameter",
    );
    return;
}

sub load_data ($self, @args) {
    my %args         = _resolve_arg_shortcut(\@args, 'data');

    my $raw_perl_data = delete $args{data};
    my $check         = $self->_check_check( $args{check} );

    if (
        not defined $raw_perl_data
        or (
            ref($raw_perl_data) ne 'HASH'

            #and not $raw_perl_data->isa( 'HASH' )
        )
        ) {
        Config::Model::Exception::LoadData->throw(
            object     => $self,
            message    => "load_data called with non hash ref arg",
            wrong_data => $raw_perl_data,
        ) if $check eq 'yes';
        return;
    }

    my $perl_data = dclone $raw_perl_data ;

    $logger->info(
        "Node load_data (",
        $self->location,
        ") will load elt ",
        join( ' ', sort keys %$perl_data ) );

    my $has_stored = 0;
    # data must be loaded according to the element order defined by
    # the model. This will not load not yet accepted parameters
    foreach my $elt ( @{ $self->{model}{element_list} } ) {
        $logger->trace("check element $elt");
        next unless defined $perl_data->{$elt};

        if (   $self->is_element_available( name => $elt )