1#
2# This file is part of Config-Model
3#
4# This software is Copyright (c) 2005-2021 by Dominique Dumont.
5#
6# This is free software, licensed under:
7#
8#   The GNU Lesser General Public License, Version 2.1, February 1999
9#
10package Config::Model::Backend::ShellVar 2.147;
11
12use Carp;
13use Mouse;
14use Config::Model::Exception;
15use File::Path;
16use Log::Log4perl qw(get_logger :levels);
17use Config::Model::BackendTrackOrder;
18
19extends 'Config::Model::Backend::Any';
20
21my $logger = get_logger("Backend::ShellVar");
22
23has tracker => (
24    is => 'ro',
25    isa => 'Config::Model::BackendTrackOrder',
26    lazy_build => 1,
27    handles => [qw/get_ordered_element_names/],
28);
29
30sub _build_tracker {
31    my $self = shift;
32    return Config::Model::BackendTrackOrder->new(
33        backend_obj => $self,
34        node => $self->node,
35    ) ;
36}
37
38sub annotation { return 1; }
39
40sub read {
41    my $self = shift;
42    my %args = @_;
43
44    # args are:
45    # object     => $obj,         # Config::Model::Node object
46    # root       => './my_test',  # fake root directory, userd for tests
47    # config_dir => /etc/foo',    # absolute path
48    # file       => 'foo.conf',   # file name
49    # file_path  => './my_test/etc/foo/foo.conf'
50    # check      => yes|no|skip
51
52    return 0 unless $args{file_path}->exists;    # no file to read
53    my $check = $args{check} || 'yes';
54
55    my @lines = $args{file_path}->lines_utf8;
56
57    # try to get global comments (comments before a blank line)
58    $self->read_global_comments( \@lines, '#' );
59
60    my @assoc = $self->associates_comments_with_data( \@lines, '#' );
61    foreach my $item (@assoc) {
62        my ( $data, $c ) = @$item;
63        my ($k,$v) = split /\s*=\s*/, $data, 2; # make reader quite tolerant
64        $v =~ s/^["']|["']$//g;
65        if ($logger->is_debug) {
66            my $msg = "Loading key '$k' value '$v'";
67            $msg .= " comment: '$c'" if $c;
68            $logger->debug($msg);
69        }
70        $self->tracker->register_element($k);
71        my $obj = $self->node->fetch_element($k);
72        $obj->store( value => $v, check => $check );
73        $obj->annotation($c) if $c;
74    }
75
76    return 1;
77}
78
79sub write {
80    my $self = shift;
81    my %args = @_;
82
83    # args are:
84    # object     => $obj,         # Config::Model::Node object
85    # root       => './my_test',  # fake root directory, userd for tests
86    # config_dir => /etc/foo',    # absolute path
87    # file       => 'foo.conf',   # file name
88    # file_path  => './my_test/etc/foo/foo.conf'
89    # check      => yes|no|skip
90
91    my $node = $args{object};
92
93    my @to_write;
94
95    # Using Config::Model::ObjTreeScanner would be overkill
96    foreach my $elt ( $self->get_ordered_element_names ) {
97        my $obj = $node->fetch_element($elt);
98        my $v   = $node->grab_value($elt);
99
100        next unless defined $v;
101
102        push @to_write, [ qq!$elt="$v"!, $obj->annotation ];
103    }
104
105    if (@to_write) {
106        my $res = $self->write_global_comment( '#' );
107        foreach my $line_ref (@to_write) {
108            $res .= $self->write_data_and_comments( '#', @$line_ref );
109        }
110        $args{file_path}->spew_utf8($res);
111    }
112
113    return 1;
114}
115
116no Mouse;
117__PACKAGE__->meta->make_immutable;
118
1191;
120
121# ABSTRACT: Read and write config as a C<SHELLVAR> data structure
122
123__END__
124
125=pod
126
127=encoding UTF-8
128
129=head1 NAME
130
131Config::Model::Backend::ShellVar - Read and write config as a C<SHELLVAR> data structure
132
133=head1 VERSION
134
135version 2.147
136
137=head1 SYNOPSIS
138
139 use Config::Model;
140
141 my $model = Config::Model->new;
142 $model->create_config_class (
143    name    => "MyClass",
144    element => [
145        [qw/foo bar/] => {qw/type leaf value_type string/}
146    ],
147
148   rw_config  => {
149     backend => 'ShellVar',
150     config_dir => '/tmp',
151     file  => 'foo.conf',
152     auto_create => 1,
153   }
154 );
155
156 my $inst = $model->instance(root_class_name => 'MyClass' );
157 my $root = $inst->config_root ;
158
159 $root->load('foo=FOO1 bar=BAR1' );
160
161 $inst->write_back ;
162
163File C<foo.conf> now contains:
164
165 ## This file was written by Config::Model
166 ## You may modify the content of this file. Configuration
167 ## modifications will be preserved. Modifications in
168 ## comments may be mangled.
169 ##
170 foo="FOO1"
171
172 bar="BAR1"
173
174=head1 DESCRIPTION
175
176This module is used directly by L<Config::Model> to read or write the
177content of a configuration tree written with C<SHELLVAR> syntax in
178C<Config::Model> configuration tree.
179
180Note that undefined values are skipped for list element. I.e. if a
181list element contains C<('a',undef,'b')>, the data structure
182contains C<'a','b'>.
183
184=head1 CONSTRUCTOR
185
186=head2 new
187
188Parameters: C<< ( node => $node_obj, name => 'shellvar' ) >>
189
190Inherited from L<Config::Model::Backend::Any>. The constructor is
191called by L<Config::Model::BackendMgr>.
192
193=head2 read
194
195Of all parameters passed to this read call-back, only C<file_path> is
196used.
197
198When a file is read, C<read> returns 1.
199
200=head2 write
201
202Of all parameters passed to this write call-back, only C<file_path> is
203used.
204
205C<write> returns 1.
206
207=head1 AUTHOR
208
209Dominique Dumont, (ddumont at cpan dot org)
210
211=head1 SEE ALSO
212
213L<Config::Model>,
214L<Config::Model::BackendMgr>,
215L<Config::Model::Backend::Any>,
216
217=head1 AUTHOR
218
219Dominique Dumont
220
221=head1 COPYRIGHT AND LICENSE
222
223This software is Copyright (c) 2005-2021 by Dominique Dumont.
224
225This is free software, licensed under:
226
227  The GNU Lesser General Public License, Version 2.1, February 1999
228
229=cut
230