File Coverage

blib/lib/Config/Model/Backend/ShellVar.pm
Criterion Covered Total %
statement 56 59 94.9
branch 7 12 58.3
condition 1 2 50.0
subroutine 11 11 100.0
pod 3 3 100.0
total 78 87 89.6


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