File Coverage

blib/lib/Config/Model/Backend/PerlFile.pm
Criterion Covered Total %
statement 41 41 100.0
branch 3 4 75.0
condition 1 2 50.0
subroutine 10 10 100.0
pod 2 2 100.0
total 57 59 96.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 5.10.1;
12 2     2   24 use Carp;
  2         7  
13 2     2   11 use strict;
  2         3  
  2         109  
14 2     2   10 use warnings;
  2         4  
  2         48  
15 2     2   10 use Config::Model::Exception;
  2         8  
  2         52  
16 2     2   11 use File::Path;
  2         4  
  2         54  
17 2     2   10 use Log::Log4perl qw(get_logger :levels);
  2         3  
  2         92  
18 2     2   11  
  2         4  
  2         12  
19             use base qw/Config::Model::Backend::Any/;
20 2     2   263  
  2         4  
  2         742  
21             my $logger = get_logger("Backend::PerlFile");
22              
23             my $self = shift;
24             my %args = @_;
25 12     12 1 39  
26 12         91 # args is:
27             # object => $obj, # Config::Model::Node object
28             # root => './my_test', # fake root directory, userd for tests
29             # config_dir => /etc/foo', # absolute path
30             # file => 'foo.conf', # file name
31             # file_path => './my_test/etc/foo/foo.conf'
32             # check => yes|no|skip
33              
34             my $file_path = $args{file_path};
35             return 0 unless -r $file_path;
36 12         32 $file_path = "./$file_path" unless $file_path =~ m!^\.?/!;
37 12 100       60 $logger->info("Read Perl data from $file_path");
38 9 50       168  
39 9         129 my $pdata = do $file_path || die "Cannot open $file_path:$?";
40             $self->node->load_data($pdata);
41 9   50     3205 return 1;
42 9         87 }
43 9         69  
44             my $self = shift;
45             my %args = @_;
46              
47 5     5 1 10 # args is:
48 5         23 # object => $obj, # Config::Model::Node object
49             # root => './my_test', # fake root directory, userd for tests
50             # config_dir => /etc/foo', # absolute path
51             # file => 'foo.conf', # file name
52             # file_path => './my_test/etc/foo/foo.conf'
53             # check => yes|no|skip
54              
55             my $file_path = $args{file_path};
56             $logger->info("Write perl data to $file_path");
57              
58 5         15 my $p_data = $self->node->dump_as_data(
59 5         24 skip_auto_write => 'perl_file',
60             check => $args{check}
61             );
62             my $dumper = Data::Dumper->new( [$p_data] );
63             $dumper->Terse(1);
64 5         111  
65 5         51 $args{file_path}->spew_utf8( $dumper->Dump, ";\n" );
66 5         181  
67             return 1;
68 5         46 }
69              
70 5         3585 1;
71              
72             # ABSTRACT: Read and write config as a Perl data structure
73              
74              
75             =pod
76              
77             =encoding UTF-8
78              
79             =head1 NAME
80              
81             Config::Model::Backend::PerlFile - Read and write config as a Perl data structure
82              
83             =head1 VERSION
84              
85             version 2.151
86              
87             =head1 SYNOPSIS
88              
89             use Config::Model ;
90             use Data::Dumper ;
91              
92             # define configuration tree object
93             my $model = Config::Model->new ;
94             $model ->create_config_class (
95             name => "MyClass",
96             element => [
97             [qw/foo bar/] => {
98             type => 'leaf',
99             value_type => 'string'
100             },
101             baz => {
102             type => 'hash',
103             index_type => 'string' ,
104             cargo => {
105             type => 'leaf',
106             value_type => 'string',
107             },
108             },
109             ],
110             rw_config => {
111             backend => 'perl_file' ,
112             config_dir => '/tmp',
113             file => 'foo.pl',
114             auto_create => 1,
115             },
116             ) ;
117              
118             my $inst = $model->instance(root_class_name => 'MyClass' );
119              
120             my $root = $inst->config_root ;
121              
122             my $steps = 'foo=yada bar="bla bla" baz:en=hello
123             baz:fr=bonjour baz:hr="dobar dan"';
124             $root->load( steps => $steps ) ;
125             $inst->write_back ;
126              
127             Now, C</tmp/foo.pl> contains:
128              
129             {
130             bar => 'bla bla',
131             baz => {
132             en => 'hello',
133             fr => 'bonjour',
134             hr => 'dobar dan'
135             },
136             foo => 'yada'
137             }
138              
139             =head1 DESCRIPTION
140              
141             This module is used directly by L<Config::Model> to read or write the
142             content of a configuration tree written with Perl syntax in
143             C<Config::Model> configuration tree.
144              
145             Note:
146              
147             =over 4
148              
149             =item *
150              
151             Undefined values are skipped for list element. I.e. if a
152             list element contains C<('a',undef,'b')>, the data structure
153             contains C<'a','b'>.
154              
155             =item *
156              
157             Perl file is not created (and may be deleted) when no data is to be
158             written.
159              
160             =back
161              
162             =head1 backend parameter
163              
164             =head2 config_dir
165              
166             Mandoatory parameter to specify where is the Perl configuration file.
167              
168             =head1 CONSTRUCTOR
169              
170             =head2 new
171              
172             Inherited from L<Config::Model::Backend::Any>. The constructor is
173             called by L<Config::Model::BackendMgr>.
174              
175             =head2 read
176              
177             Of all parameters passed to this read call-back, only C<ifile_path> is
178             used. This parameter must be L<IO::File> object already opened for
179             read.
180              
181             It can also be undef. In which case C<read> returns 0.
182              
183             When a file is read, C<read> returns 1.
184              
185             =head2 write
186              
187             Of all parameters passed to this write call-back, only C<file_path> is
188             used. This parameter must be a L<Path::Tiny> object.
189              
190             C<write> returns 1.
191              
192             =head1 AUTHOR
193              
194             Dominique Dumont, (ddumont at cpan dot org)
195              
196             =head1 SEE ALSO
197              
198             L<Config::Model>,
199             L<Config::Model::BackendMgr>,
200             L<Config::Model::Backend::Any>,
201              
202             =head1 AUTHOR
203              
204             Dominique Dumont
205              
206             =head1 COPYRIGHT AND LICENSE
207              
208             This software is Copyright (c) 2005-2022 by Dominique Dumont.
209              
210             This is free software, licensed under:
211              
212             The GNU Lesser General Public License, Version 2.1, February 1999
213              
214             =cut