File: PlainFile.pm

package info (click to toggle)
libconfig-model-perl 2.155-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 2,172 kB
  • sloc: perl: 15,117; makefile: 19
file content (326 lines) | stat: -rw-r--r-- 9,041 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
package Config::Model::Backend::PlainFile;

use 5.10.1;
use Carp;
use Mouse;
use Config::Model::Exception;
use Path::Tiny;
use Log::Log4perl qw(get_logger :levels);

extends 'Config::Model::Backend::Any';

with "Config::Model::Role::ComputeFunction";
with "Config::Model::Role::FileHandler";

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

my $logger = get_logger("Backend::PlainFile");

sub annotation { return 0; }

# remember that a read backend (and its config file(s)) is attached to a node
# OTOH, PlainFile backend deal with files that are attached to elements of a node.
# Hence the files must not be managed by backend manager.

# file not opened by BackendMgr
# file_path is undef
sub skip_open { return 1; }

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

    my $obj = $args{object}->fetch_element( name => $args{elt} );
    return $args{file} ? $obj->compute_string($args{file}) : $args{elt};
}

## no critic (Subroutines::ProhibitBuiltinHomonyms)
sub read ($self, %args) {
    # args are:
    # object     => $obj,         # Config::Model::Node object
    # root       => './my_test',  # fake root directory, userd for tests
    # config_dir => /etc/foo',    # absolute path
    # file       => 'foo.conf',   # file name
    # file_path  => './my_test/etc/foo/foo.conf'
    # check      => yes|no|skip

    my $check = $args{check} || 'yes';
    my $node  = $args{object};
    $logger->trace( "called on node ", $node->name );

    # read data from leaf element from the node
    # do not trigger warp when getting element names
    foreach my $elt ( $node->get_element_names(all => 1) ) {
        my $obj = $args{object}->fetch_element( name => $elt );

        my $file_name = $self->get_file_name(%args, elt => $elt);
        my $dir = $self->get_tuned_config_dir(%args);
        my $file = $dir->child($file_name);

        $logger->trace("looking to read plainfile $file for ", $obj->location);

        my $type = $obj->get_type;

        if ( $type eq 'leaf' ) {
            $self->read_leaf( $obj, $elt, $check, $file, \%args );
        }
        elsif ( $type eq 'list' ) {
            $self->read_list( $obj, $elt, $check, $file, \%args );
        }
        elsif ( $type eq 'hash' ) {
            $self->read_hash( $obj, $elt, $check, $file, \%args );
        }
        else {
            $logger->debug("PlainFile read skipped $type $elt");
        }

    }

    return 1;
}

sub read_leaf {
    my ( $self, $obj, $elt, $check, $file, $args ) = @_;

    return unless $file->exists;

    my $v = $file->slurp_utf8;
    chomp($v) unless $obj->value_type eq 'string';
    if ($logger->is_trace) {
        (my $str = $v) =~ s/\n.*/[...]/s;
        $logger->trace("storing leaf value '$str' from $file ");
    }
    $obj->store( value => $v, check => $check );
    return;
}

sub read_list {
    my ( $self, $obj, $elt, $check, $file, $args ) = @_;

    return unless $file->exists;

    my @v = $file->lines_utf8({ chomp => 1});
    $logger->trace("storing list value @v from $file ");

    $obj->store_set(@v);
    return;
}

sub read_hash {
    my ( $self, $obj, $elt, $check, $file, $args ) = @_;
    $logger->debug("PlainFile read skipped hash $elt");
    return;
}

sub write ($self, %args){
    # args are:
    # object     => $obj,         # Config::Model::Node object
    # root       => './my_test',  # fake root directory, userd for tests
    # config_dir => /etc/foo',    # absolute path read
    # file       => 'foo.conf',   # file name
    # file_path  => './my_test/etc/foo/foo.conf'
    # check      => yes|no|skip

    my $check = $args{check} || 'yes';
    my $cfg_dir = $args{config_dir};
    my $dir = $self->get_tuned_config_dir(%args);
    $dir->mkpath({ mode => oct(755) } ) unless $dir->is_dir;

    my $node = $args{object};
    $logger->debug( "PlainFile write called on node ", $node->name );

    # write data from leaf element from the node
    foreach my $elt ( $node->get_element_name() ) {
        my $obj = $args{object}->fetch_element( name => $elt );

        my $file_name = $self->get_file_name(%args, elt => $elt);
        my $file = $dir->child($file_name);

        $logger->trace("looking to write plainfile $file for ", $obj->location);

        my $type = $obj->get_type;
        my @v;

        if ( $type eq 'leaf' ) {
            my $v = $obj->fetch( check => $args{check} );
            $v .= "\n" if defined $v and $obj->value_type ne 'string';
            push @v, $v if defined $v;
        }
        elsif ( $type eq 'list' ) {
            @v = map { "$_\n" } $obj->fetch_all_values;
        }
        else {
            $logger->debug("PlainFile write skipped $type $elt");
            next;
        }

        if (@v) {
            $logger->trace("PlainFile write opening $file to write $elt");
            $file->spew_utf8(@v);
            $file->chmod($args{file_mode}) if $args{file_mode};
        }
        elsif ($file->exists) {
            $logger->trace("PlainFile delete $file");
            $file->remove;
        }
    }

    return 1;
}

## no critic (Subroutines::ProhibitBuiltinHomonyms)
sub delete ($self, %args) {
    # args are:
    # object     => $obj,         # Config::Model::Node object
    # root       => './my_test',  # fake root directory, userd for tests
    # config_dir => /etc/foo',    # absolute path read
    # file       => 'foo.conf',   # file name
    # file_path  => './my_test/etc/foo/foo.conf'
    # check      => yes|no|skip

    my $dir = $self->get_tuned_config_dir(%args);
    my $node = $args{object};
    $logger->debug( "PlainFile delete called on deleted node");

    # write data from leaf element from the node
    foreach my $elt ( $node->get_element_name() ) {
        my $obj = $node->fetch_element( name => $elt );

        my $file_name = $self->get_file_name(%args, elt => $elt);
        my $file = $dir->child( $file_name );
        $logger->info( "Removing $file (deleted node)" );
        $file->remove;
    }
    return;
}

no Mouse;
__PACKAGE__->meta->make_immutable;

1;

# ABSTRACT: Read and write config as plain file

__END__

=head1 SYNOPSIS

 use Config::Model;

 my $model = Config::Model->new;

 my $inst = $model->create_config_class(
    name => "WithPlainFile",
    element => [ 
        [qw/source new/] => { qw/type leaf value_type uniline/ },
    ],
    rw_config  => {
      backend => 'plain_file',
      config_dir => '/tmp',
    },
 );
 
 my $inst = $model->instance(root_class_name => 'WithPlainFile' );
 my $root = $inst->config_root ;

 $root->load('source=foo new=yes' );

 $inst->write_back ;

Now C</tmp> directory contains 2 files: C<source> and C<new>
with C<foo> and C<yes> inside.

=head1 DESCRIPTION

This module is used directly by L<Config::Model> to read or write the
content of a configuration tree written in several files.
Each element of the node is written in a plain file.

=head1 Element type and file mapping

Element values are written in one or several files depending on their type.

=over

=item leaf

The leaf value is written in one file. This file can have several lines if the leaf
type is C<string>

=item list

The list content is written in one file. Each line of the file is a
value of the list.

=item hash

Not supported

=back

=head1 File mapping

By default, the configuration file is named after the element name
(like in synopsis above).

The C<file> parameter can also be used to specify a file name that
take into account the path in the tree using C<&index()> and
C<&element()> functions from L<Config::Model::Role::ComputeFunction>.

For instance, with the following model:

    class_name => "Foo",
    element => [
        string_a => { type => 'leaf', value_type => 'string'}
        string_b => { type => 'leaf', value_type => 'string'}
    ],
    rw_config => {
        backend => 'PlainFile',
        config_dir => 'foo',
        file => '&element(-).&element',
        file_mode => 0644,  # optional
    }

If the configuration is loaded with C<example string_a=something
string_b=else>, this backend writes "C<something>" in file
C<example.string_a> and C<else> in file C<example.string_b>.

C<file_mode> parameter can be used to set the mode of the written
file. C<file_mode> value can be in any form supported by
L<Path::Tiny/chmod>.

=head1 Methods

=head2 read_leaf

Parameters: C<(obj, elt, check, file, args)>

Called by L<read> method to read the file of a leaf element. C<args>
contains the arguments passed to L<read> method.

=head2 read_hash (obj,elt,check,file,args);

Like L<read_leaf> for hash elements.

=head2 read_list

Parameters: C<(obj, elt, check, file, args)>

Like L<read_leaf> for list elements.

=head2 write

C<write> writes a file for each element of the calling class. Works only for
leaf and list elements. Other element type are skipped. Always return 1 (unless it died before).

=head1 AUTHOR

Dominique Dumont, (ddumont at cpan dot org)

=head1 SEE ALSO

L<Config::Model>, 
L<Config::Model::BackendMgr>, 
L<Config::Model::Backend::Any>, 

=cut