view release on metacpan or  search on metacpan

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

    my $id_class = delete $element_info->{class}
        || 'Config::Model::' . $id_class_hash{$type};

    if ( not defined *{ $id_class . '::' } ) {
        my $file = $id_class . '.pm';
        $file =~ s!::!/!g;
        require $file;
    }

    $element_info->{container} = $element_info->{parent} = $self;
    $element_info->{element_name} = $element_name;
    $element_info->{instance}     = $self->{instance};

    return $self->{element}{$element_name} = $id_class->new(%$element_info);
}

# check validity of level and status declaration.
sub check_properties {
    my $self = shift;

    # a model should no longer contain attributes attached to
    # an element (like description, level ...). There are copied here
    # because Node needs them as hash or lists
    foreach my $bad (qw/description summary level status/) {
        die $self->config_class_name, ": illegal '$bad' parameter in model ",
            "(Should be handled by Config::Model directly)\n"
            if defined $self->{model}{$bad};
    }

    foreach my $elt_name ( @{ $self->{model}{element_list} } ) {

        foreach my $prop (qw/summary description/) {
            my $info_to_move = delete $self->{model}{element}{$elt_name}{$prop};
            $self->{$prop}{$elt_name} = $info_to_move
                if defined $info_to_move;
        }

        foreach my $prop ( keys %legal_properties ) {
            my $prop_v
                = delete $self->{model}{element}{$elt_name}{$prop}
                //  get_default_property($prop) ;
            $self->{$prop}{$elt_name} = $prop_v;

            croak "Config class $self->{config_class_name} error: ",
                "Unknown $prop: '$prop_v'. Expected ", join( " or ", keys %{ $self->{$prop} } )
                unless defined $legal_properties{$prop}{$prop_v};
        }
    }
    return;
}

sub init ($self, @args) {
    return if $self->{initialized};
    $self->{initialized} = 1;    # avoid recursions

    my $model = $self->{model};

    return unless defined $model->{rw_config};

    my $initial_load_backup = $self->instance->initial_load;
    $self->instance->initial_load_start;

    $self->{backend_mgr} ||= Config::Model::BackendMgr->new(
        # config_dir spec given by application info
        config_dir      => $self->instance->config_dir,
        node => $self,
        rw_config => $model->{rw_config}
    );

    $self->read_config_data( check => $self->read_check );
    # setup auto_write
    $self->backend_mgr->auto_write_init();

    $self->instance->initial_load($initial_load_backup);
    return;
}

sub read_config_data {
    my ( $self, %args ) = @_;

    my $model = $self->{model};

    if ( $self->location and $args{config_file} ) {
        die "read_config_data: cannot override config_file in non root node (",
            $self->location, ")\n";
    }

    # setup auto_read
    # may use an overridden config file
    return $self->backend_mgr->read_config_data(
        check           => $args{check},
        config_file     => $args{config_file} || $self->{config_file},
        auto_create     => $args{auto_create} || $self->instance->auto_create,
    );
}

around notify_change => sub ($orig, $self, %args) {
    if ($change_logger->is_trace) {
        my @with = map { "'$_' -> '". ($args{$_} // '<undef>') ."'"  } sort keys %args;
        $change_logger->trace("called for ", $self->name, " from ", join( ' ', caller ), " with ", join( ' ', @with ));
    }
    return if $self->instance->initial_load and not $args{really};

    $logger->trace( "called while needs_write is ", $self->needs_save, " for ", $self->name )
        if $logger->is_trace;

    if ( defined $self->backend_mgr ) {
        $self->needs_save(1);    # will trigger a save in config_file
        $self->$orig( %args, needs_save => 0 );
    }
    else {
        # save config_file will be done by a node above
        $self->$orig( %args, needs_save => 1 );
    }
    return;
};

sub is_auto_write_for_type ($self, @args) {
    return 0 unless defined $self->backend_mgr;
    return $self->backend_mgr->is_auto_write_for_type(@args);
}

sub name {
    my $self = shift;
    return $self->location() || $self->config_class_name;
}

sub get_type {
    return 'node';
}

sub get_cargo_type {
    return 'node';
}