view release on metacpan or  search on metacpan

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

    foreach my $path ( sort $self->nodes_to_write_back ) {
        $logger->info("write_back called on node $path");

        if ( $path and $self->{config_file} ) {
            $logger->warn("write_back: cannot override config_file in non root node ($path)");
            delete  $self->{config_file}
        }

        $self->_write_back_node(%args, path => $path, force_write => $force_write) ;
    }
    $self->clear_changes;
    return;
}

sub _write_back_node ($self, %args) {
    my $path = delete $args{path};
    my $force_write   = delete $args{force_write};

    my $node = $self->config_root->grab(
        step => $path,
        type => 'node',
        mode => 'loose',
        autoadd => 0,
    );

    foreach my $wb_info (@{ $self->write_back_node_info($path) }) {
        my ($backend, $cb) = @$wb_info;

        my @wb_args = (
            %args,
            config_file   => $self->{config_file},
            force         => $force_write,
            backup        => $self->backup,
        );

        if (defined $node and ($node->needs_save or $force_write)) {
            my $dir = $args{config_dir};
            mkpath( $dir, 0, oct(755) ) if $dir and not -d $dir;

            # exit when write is successfull
            my $res = $cb->(@wb_args);
            $logger->info( "write_back called with $backend backend, result is ",
                           defined $res ? $res : '<undef>' );
        }

        if (not defined $node) {
            $logger->debug("deleting file for deleted node $path");
            $cb->(@wb_args, force_delete => 1);
            $self->delete_write_back($path);
        }
    }

    $logger->trace( "write_back on node '$path' done" );
    return;
}

sub save {
    goto &write_back;
}

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

    my $hook = sub {
        my ($scanner, $data_ref,$node,@element_list) = @_;
        if ($node->can('update')) {
            my $loc = $node->location;
            say "Calling update on node '$loc'" if $loc and not $args{quiet};
            push (@$data_ref, $node->update(%args))
        } ;
    };

    my $leaf_cb = sub ($scanner, $data_ref,$node,$element_name,$index, $leaf_object) {
        push @$data_ref, $leaf_object->update_from_file();
    };

    my $root = $self->config_root ;

    my @msgs ;
    Config::Model::ObjTreeScanner->new(
        node_content_hook => $hook,
        check => ($args{quiet} ? 'no' : 'yes'),
        leaf_cb => $leaf_cb,
        file_value_cb => $leaf_cb,
        dir_value_cb => $leaf_cb,
    )->scan_node( \@msgs, $root );

    return @msgs;
}

sub DEMOLISH {
    my $self = shift;
    $self->clear_write_back; # avoid reference loops
    return;
}

__PACKAGE__->meta->make_immutable;

1;

# ABSTRACT: Instance of configuration tree

__END__

=pod

=encoding UTF-8

=head1 NAME

Config::Model::Instance - Instance of configuration tree

=head1 VERSION

version 2.162

=head1 SYNOPSIS

 use Config::Model;
 use File::Path ;