File Coverage

blib/lib/Config/INI/Writer.pm
Criterion Covered Total %
statement 93 93 100.0
branch 24 28 85.7
condition 13 18 72.2
subroutine 22 22 100.0
pod 17 18 94.4
total 169 179 94.4


line stmt bran cond sub pod time code
1 1     1   1005 use v5.12.0;
  1         3  
2 1     1   5 use warnings;
  1         1  
  1         36  
3             package Config::INI::Writer 0.029;
4              
5 1     1   322 use Mixin::Linewise::Writers;
  1         1143  
  1         5  
6             # ABSTRACT: a subclassable .ini-file emitter
7              
8 1     1   333 use Carp ();
  1         2  
  1         1044  
9             our @CARP_NOT = qw(Mixin::Linewise::Writers);
10              
11             #pod =head1 SYNOPSIS
12             #pod
13             #pod If C<$hash> contains:
14             #pod
15             #pod {
16             #pod '_' => { admin => 'rjbs' },
17             #pod rjbs => {
18             #pod awesome => 'yes',
19             #pod height => q{5' 10"},
20             #pod },
21             #pod mj => {
22             #pod awesome => 'totally',
23             #pod height => '23"',
24             #pod },
25             #pod }
26             #pod
27             #pod Then when your program contains:
28             #pod
29             #pod Config::INI::Writer->write_file($hash, 'family.ini');
30             #pod
31             #pod F will contains:
32             #pod
33             #pod admin = rjbs
34             #pod
35             #pod [rjbs]
36             #pod awesome = yes
37             #pod height = 5' 10"
38             #pod
39             #pod [mj]
40             #pod awesome = totally
41             #pod height = 23"
42             #pod
43             #pod =head1 DESCRIPTION
44             #pod
45             #pod Config::INI::Writer is I config module implementing I
46             #pod slightly different take on the undeniably easy to read L<".ini" file
47             #pod format|Config::INI>. Its default behavior is quite similar to that of
48             #pod L, on which it is based.
49             #pod
50             #pod The chief difference is that Config::INI::Writer is designed to be subclassed
51             #pod to allow for side-effects and self-reconfiguration to occur during the course
52             #pod of reading its input.
53             #pod
54             #pod =head1 METHODS FOR WRITING CONFIG
55             #pod
56             #pod There are three writer methods, C, C, and
57             #pod C. The first two are implemented in terms of the third. It
58             #pod iterates over a collection of data, emitting lines to the filehandle as it
59             #pod goes. The lines are generated by events produced by iterating over the data.
60             #pod Those events are detailed below in the L section.
61             #pod
62             #pod The given data should be a hashref of hashrefs:
63             #pod
64             #pod {
65             #pod section_name_1 => { prop1 => 'value1', prop2 => 'value2' },
66             #pod section_name_2 => ...
67             #pod }
68             #pod
69             #pod ...or an arrayref of section name and arrayref pairs:
70             #pod
71             #pod [
72             #pod section_name_1 => [ prop1 => 'value1', prop2 => 'value2' ],
73             #pod section_name_2 => ...
74             #pod ]
75             #pod
76             #pod ...or a combination of those:
77             #pod
78             #pod [
79             #pod section_name_1 => { prop1 => 'value1', prop2 => 'value2' },
80             #pod section_name_2 => [ prop3 => 'value3', prop4 => 'value4' ],
81             #pod section_name_3 => ...
82             #pod ]
83             #pod
84             #pod
85             #pod All the reader methods throw an exception when they encounter an error.
86             #pod
87             #pod =head2 write_file
88             #pod
89             #pod Config::INI::Writer->write_file($input, $filename);
90             #pod
91             #pod This method writes out the configuration represented by C<$data> to the file
92             #pod named by C<$filename>. If a file by that name exists, it is overwritten.
93             #pod
94             #pod This method will either succeed or raise an exception. (Its return value is
95             #pod not defined.)
96             #pod
97             #pod =head2 write_string
98             #pod
99             #pod my $string = Config::INI::Writer->write_string($input);
100             #pod
101             #pod This method returns a string containing the INI content describing the given
102             #pod data.
103             #pod
104             #pod =head2 write_handle
105             #pod
106             #pod Config::INI::Writer->write_handle($input, $handle);
107             #pod
108             #pod This method writes the data in C<$data> to the IO::Handle-like object in
109             #pod C<$handle>. This method should either succeed or throw an exception.
110             #pod
111             #pod =cut
112              
113             sub write_handle {
114 16     16 1 24939 my ($invocant, $input, $handle) = @_;
115              
116 16 100       46 my $self = ref $invocant ? $invocant : $invocant->new;
117              
118 16         28 $input = $self->preprocess_input($input);
119              
120 15         35 $self->validate_input($input);
121              
122 12         23 my $starting_section_name = $self->starting_section;
123              
124 12         24 SECTION: for (my $i = 0; $i < $#$input; $i += 2) {
125 21         36 my ($section_name, $section_data) = @$input[ $i, $i + 1 ];
126              
127 21         40 $self->change_section($section_name);
128 21 50       29 $handle->print($self->stringify_section($section_data))
129             or Carp::croak "error writing section $section_name: $!";
130 21         166 $self->finish_section;
131             }
132             }
133              
134             #pod =head1 METHODS FOR SUBCLASSING
135             #pod
136             #pod These are the methods you need to understand and possibly change when
137             #pod subclassing Config::INI::Reader to handle a different format of input.
138             #pod
139             #pod =head2 preprocess_input
140             #pod
141             #pod my $processed_input = $writer->preprocess_input($input_data);
142             #pod
143             #pod This method is called to ensure that the data given to the C methods
144             #pod are in a canonical form for processing and emitting. The default
145             #pod implementation converts hashrefs to arrayrefs and, if the input is a hashref,
146             #pod moves the L to the beginning of the produced arrayref.
147             #pod
148             #pod In other words, given:
149             #pod
150             #pod {
151             #pod section_1 => { a => 1, b => 2 },
152             #pod section_2 => { c => 3, c => 4 },
153             #pod _ => { d => 5, e => 6 },
154             #pod }
155             #pod
156             #pod This method will return:
157             #pod
158             #pod [
159             #pod _ => [ d => 5, e => 6 ],
160             #pod section_2 => [ c => 3, c => 4 ],
161             #pod section_1 => [ a => 1, b => 2 ],
162             #pod ]
163             #pod
164             #pod The only guaranteed ordering when hashes are provided as input is that the
165             #pod starting section will appear first.
166             #pod
167             #pod =cut
168              
169             sub preprocess_input {
170 16     16 1 28 my ($self, $data) = @_;
171              
172 16         19 my @new_data;
173              
174 16 100       37 if (ref $data eq 'HASH') {
    100          
175 8         18 my $starting_section_name = $self->starting_section;
176              
177 8         21 for my $name (
178             $starting_section_name,
179 11         31 grep { $_ ne $starting_section_name } keys %$data
180             ) {
181 16         22 my $props = $data->{ $name };
182 16 100       30 next unless defined $props;
183 11 50 50     53 push @new_data,
184             $name => ((ref($props) || '') eq 'HASH') ? [ %$props ] : $props;
185             }
186             } elsif (ref $data eq 'ARRAY') {
187 7         19 for (my $i = 0; $i < $#$data; $i += 2) {
188 14         24 my ($name, $props) = @$data[ $i, $i + 1 ];
189 14 100       40 push @new_data, $name, (ref $props eq 'HASH') ? [ %$props ] : $props;
190             }
191             } else {
192 1         2 my $class = ref $self;
193 1         89 Carp::croak "can't output $data via $class";
194             }
195              
196 15         29 return \@new_data;
197             }
198              
199             #pod =head2 validate_section_name
200             #pod
201             #pod Carp::croak "section name contains illegal character"
202             #pod if not $writer->is_valid_section_name($name);
203             #pod
204             #pod =cut
205              
206             sub is_valid_section_name {
207 25     25 0 33 my ($self, $name) = @_;
208 25         331 return $name !~ qr/(?:\n|\s;|^\s|\s$)/;
209             }
210              
211             #pod =head2 is_valid_property_name
212             #pod
213             #pod Carp::croak "property name contains illegal character"
214             #pod if not $writer->is_valid_property_name($name);
215             #pod
216             #pod =cut
217              
218             sub is_valid_property_name {
219 49     49 1 67 my ($self, $property) = @_;
220 49         204 return $property !~ qr/(?:\n|\s;|^\s|\s|=$)/;
221             }
222              
223             #pod =head2 is_valid_value
224             #pod
225             #pod Carp::croak "value contains illegal character"
226             #pod if not $writer->is_valid_value($name);
227             #pod
228             #pod =cut
229              
230             sub is_valid_value {
231 45     45 1 68 my ($self, $value) = @_;
232 45         202 return $value !~ qr/(?:\n|\s;|^\s|\s$)/;
233             }
234              
235             #pod =head2 validate_input
236             #pod
237             #pod $writer->validate_input($input);
238             #pod
239             #pod This method is called on the input data once they've been preprocessed by
240             #pod C>.
241             #pod
242             #pod It ensures that the processed input is structurally sound before beginning to
243             #pod output it. For example, it ensures that no property is ever assigned more than
244             #pod once in a given section.
245             #pod
246             #pod This method either raises an exception or it doesn't.
247             #pod
248             #pod =cut
249              
250             sub validate_input {
251 15     15 1 23 my ($self, $input) = @_;
252              
253 15         20 my %seen;
254 15         35 for (my $i = 0; $i < $#$input; $i += 2) {
255 25         40 my ($name, $props) = @$input[ $i, $i + 1 ];
256 25   100     85 $seen{ $name } ||= {};
257              
258 25 100       44 Carp::croak "illegal section name '$name'"
259             if not $self->is_valid_section_name($name);
260              
261 23         57 for (my $j = 0; $j < $#$props; $j += 2) {
262 49         57 my $property = $props->[ $j ];
263 49         57 my $value = $props->[ $j + 1 ];
264              
265 49 50       77 Carp::croak "property name '$property' contains illegal character"
266             if not $self->is_valid_property_name($property);
267              
268 49 50 66     108 Carp::croak "value for $name.$property contains illegal character"
269             if defined $value and not $self->is_valid_value($value);
270              
271 49 100       185 if ( $seen{ $name }{ $property }++ ) {
272 1         161 Carp::croak "multiple assignments found for $name.$property";
273             }
274             }
275             }
276             }
277              
278             #pod =head2 change_section
279             #pod
280             #pod $writer->change_section($section_name);
281             #pod
282             #pod This method is called each time a new section is going to be written out. If
283             #pod the same section appears twice in a row in the input, this method will still be
284             #pod called between instances of that section.
285             #pod
286             #pod In other words, given this input:
287             #pod
288             #pod [
289             #pod section_1 => [ a => 1 ],
290             #pod section_1 => [ b => 2 ],
291             #pod ]
292             #pod
293             #pod C will be called twice: once before the first C and
294             #pod once before the second C.
295             #pod
296             #pod =cut
297              
298             sub change_section {
299 21     21 1 25 my ($self, $section_name) = @_;
300              
301 21         36 $self->{current_section} = $section_name;
302             }
303              
304             #pod =head2 current_section
305             #pod
306             #pod $writer->current_section
307             #pod
308             #pod This method returns the section currently being written out.
309             #pod
310             #pod =cut
311              
312             sub current_section {
313 58     58 1 65 my ($self) = @_;
314 58         331 return $self->{current_section};
315             }
316              
317             #pod =head2 finish_section
318             #pod
319             #pod $writer->finish_section
320             #pod
321             #pod This method is called after all of the current section's properties have been
322             #pod written.
323             #pod
324             #pod =cut
325              
326             sub finish_section {
327 21     21 1 28 my ($self) = @_;
328 21         31 return $self->{did_section}{ $self->current_section }++;
329             }
330              
331             #pod =head2 done_sections
332             #pod
333             #pod my @names = $writer->done_sections;
334             #pod
335             #pod This method returns a list of all sections that have been written out and
336             #pod finished. The fact that a section name is returned by C does
337             #pod not mean that there will be no more data for that section, but that at least
338             #pod one entire set of data has been written out for it.
339             #pod
340             #pod =cut
341              
342             sub done_sections {
343 23     23 1 27 my ($self) = @_;
344 23         24 return keys %{ $self->{did_section} };
  23         65  
345             }
346              
347             #pod =head2 stringify_section
348             #pod
349             #pod my $string = $writer->stringify_section($props);
350             #pod
351             #pod This method returns a string assigning all the properties set in the given
352             #pod data. This still will include the section header, if needed. (The only case
353             #pod in which it is not needed is when the C> method
354             #pod returns false, no other sections have been done, and the section about to be
355             #pod stringified is the C>.
356             #pod
357             #pod This method is implemented in terms of C> and
358             #pod C>.
359             #pod
360             #pod =cut
361              
362             sub stringify_section {
363 21     21 1 30 my ($self, $section_data) = @_;
364              
365 21         27 my $output = '';
366              
367 21         30 my $current_section_name = $self->current_section;
368 21         28 my $starting_section_name = $self->starting_section;
369              
370 21 100 66     72 unless (
      100        
      66        
371             $starting_section_name
372             and $starting_section_name eq $current_section_name
373             and ! $self->done_sections
374             and ! $self->explicit_starting_header
375             ) {
376 16         23 $output .= $self->stringify_section_header($self->current_section);
377             }
378              
379 21         36 $output .= $self->stringify_section_data($section_data);
380              
381 21         58 return $output;
382             }
383              
384             #pod =head2 stringify_section_data
385             #pod
386             #pod my $string = $writer->stringify_section_data($props)
387             #pod
388             #pod This method returns a string containing a series of lines, each containing a
389             #pod value assignment for the given properties.
390             #pod
391             #pod =cut
392              
393             sub stringify_section_data {
394 21     21 1 29 my ($self, $values) = @_;
395              
396 21         24 my $output = '';
397              
398 21         37 for (my $i = 0; $i < $#$values; $i += 2) {
399 47         89 $output .= $self->stringify_value_assignment(@$values[ $i, $i + 1]);
400             }
401              
402 21         37 return $output;
403             }
404              
405             #pod =head2 stringify_value_assignment
406             #pod
407             #pod my $string = $writer->stringify_value_assignment($name => $value);
408             #pod
409             #pod This method returns a string that assigns a value to a named property. If the
410             #pod value is undefined, an empty string is returned.
411             #pod
412             #pod =cut
413              
414             sub stringify_value_assignment {
415 47     47 1 68 my ($self, $name, $value) = @_;
416              
417 47 100       72 return '' unless defined $value;
418              
419 43         73 return $name . ' = ' . $self->stringify_value($value) . "\n";
420             }
421              
422             #pod =head2 stringify_value
423             #pod
424             #pod my $string = $writer->stringify_value($value);
425             #pod
426             #pod This method returns the string that will represent the given value in a
427             #pod property assignment.
428             #pod
429             #pod =cut
430              
431             sub stringify_value {
432 43     43 1 64 my ($self, $value) = @_;
433              
434 43   50     58 $value //= q{};
435              
436 43         117 return $value;
437             }
438              
439             #pod =head2 stringify_section_header
440             #pod
441             #pod my $string = $writer->stringify_section_header($section_name);
442             #pod
443             #pod This method returns the string (a line) that represents the given section name.
444             #pod Basically, this returns:
445             #pod
446             #pod [section_name]
447             #pod
448             #pod =cut
449              
450             sub stringify_section_header {
451 16     16 1 25 my ($self, $section_name) = @_;
452              
453 16         19 my $output = '';
454 16 100       23 $output .= "\n" if $self->done_sections;
455 16         29 $output .= "[$section_name]\n";
456              
457 16         27 return $output;
458             }
459              
460             #pod =head2 starting_section
461             #pod
462             #pod This method returns the name of the starting section. If this section appears
463             #pod first (as it will, when given a hashref as input) and if
464             #pod C> returns false, its section header can be
465             #pod omitted.
466             #pod
467             #pod =cut
468              
469 41     41 1 53 sub starting_section { return '_' }
470              
471             #pod =head2 explicit_starting_header
472             #pod
473             #pod If this method returns true (which it does I, by default), then the
474             #pod section header for the starting section will be emitted, even if it appears
475             #pod first.
476             #pod
477             #pod =cut
478              
479 5     5 1 13 sub explicit_starting_header { 0 }
480              
481             #pod =head2 new
482             #pod
483             #pod
484             #pod my $reader = Config::INI::Writer->new;
485             #pod
486             #pod This method returns a new writer. This generally does not need to be called by
487             #pod anything but the various C methods, which create a writer object only
488             #pod ephemerally.
489             #pod
490             #pod =cut
491              
492             sub new {
493 16     16 1 921 my ($class) = @_;
494              
495 16         39 my $self = bless { did_section => {} } => $class;
496              
497 16         37 return $self;
498             }
499              
500             1;
501              
502             __END__