File Coverage

lib/Config/Parser.pm
Criterion Covered Total %
statement 106 117 90.6
branch 39 56 69.6
condition 8 10 80.0
subroutine 17 17 100.0
pod 4 7 57.1
total 174 207 84.0


line stmt bran cond sub pod time code
1             package Config::Parser;
2 10     10   8510 use strict;
  10         1593  
  10         1753  
3 10     10   1507 use warnings;
  10         1824  
  10         2946  
4 10     10   47 use parent 'Config::AST';
  10         12  
  10         64  
5 10     10   547 use Carp;
  10         15  
  10         503  
6 10     10   49 use Cwd qw(abs_path);
  10         14  
  10         380  
7 10     10   4210 use Text::ParseWords;
  10         12134  
  10         542  
8 10     10   4644 use mro;
  10         6237  
  10         33  
9              
10             our $VERSION = "1.04";
11              
12             sub new {
13 11     11 1 13759 my $class = shift;
14 11         37 local %_ = @_;
15 11         19 my $loaded = 0;
16              
17 11         20 my @parseargs;
18 11 50       46 if (my $filename = delete $_{filename}) {
19 0         0 push @parseargs, $filename;
20 0         0 foreach my $k (qw(fh line)) {
21 0 0       0 if (my $v = delete $_{$k}) {
22 0         0 push @parseargs, ($k, $v);
23             }
24             }
25             }
26              
27 11         98 my $self = $class->SUPER::new(%_);
28            
29 11 50       706 if (my $lex = delete $_{lexicon}) {
30 0         0 $self->lexicon($lex);
31             } else {
32 11         88 $self->lexicon({ '*' => '*' });
33 66 100       414 my @cl = grep { $_ ne __PACKAGE__ && $_->isa(__PACKAGE__) }
34 11         775 reverse @{mro::get_linear_isa($class)};
  11         60  
35 11         24 my $dict;
36 11 50       32 if (@cl) {
37 11         24 foreach my $c (@cl) {
38 33 100       263 if (my ($file, $line, $data) = $c->findsynt) {
39 11         111 my $d = $self->loadsynt($file, $line, $data);
40 11 50       30 if ($d) {
41 11   50     18 $dict = { %{$dict // {}}, %$d }
  11         88  
42             }
43             }
44 33 100       106 last if $c eq $class;
45             }
46             }
47 11 50       85 $self->lexicon($dict) if $dict;
48             }
49              
50 11         3158 $self->init;
51 11 50       32 if (@parseargs) {
52 0         0 $self->parse(@parseargs);
53 0 0       0 $self->commit or croak "configuration failed";
54             }
55            
56 11         39 return $self;
57             }
58              
59       11 1   sub init {}
60       3 1   sub mangle {}
61              
62             sub commit {
63 9     9 1 111 my $self = shift;
64 9         54 my $res = $self->SUPER::commit;
65 9 100       2931 $self->mangle if $res;
66 9         583 return $res;
67             }
68              
69             sub findsynt {
70 33     33 0 57 my $class = shift;
71 33         43 my $file = $class;
72 33         95 $file =~ s{::}{/}g;
73 33         58 $file .= '.pm';
74 33 50       1121 $file = abs_path($INC{$file})
75             or croak "can't find module file for $class";
76 33         169 local ($/, *FILE);
77 33 50       964 open FILE, $file or croak "Can't open $file";
78 33         1283 my ($text, $data) = split /(?m)^__DATA__$/, , 2;
79 33         333 close FILE;
80 33 100       182 return ($file, 1+($text =~ tr/\n//), $data) if $data;
81 22         168 return ();
82             }
83              
84             sub loadsynt {
85 11     11 0 35 my ($self, $file, $line, $data) = @_;
86 10 50   10   5731 open(my $fh, '<', \$data)
  10         130  
  10         44  
  11         332  
87             or croak "can't open filehandle for data string";
88 11 50       6445 $self->parse($file,
89             fh => $fh,
90             line => $line)
91             or croak "Failed to parse template at $file:$line";
92 11         36 close $fh;
93              
94 11         20 my @sections;
95             my $lex = $self->as_hash(sub {
96 95     95   2631 my ($what, $name, $val) = @_;
97 95 100       192 $name = '*' if $name eq 'ANY';
98 95 100       168 if ($what eq 'section') {
99 39         69 $val->{section} = {};
100 39         58 push @sections, $val;
101 39         103 ($name, $val->{section});
102             } else {
103 56         134 my @words = parse_line('\s+', 0, $val);
104 56         2942 my $ret = {};
105 56         82 $val = shift @words;
106              
107 56 100 66     319 if ($val eq 'STRING') {
    100          
    100          
    50          
    100          
108             # nothing
109             } elsif ($val eq 'NUMBER' || $val eq 'DECIMAL') {
110 6         14 $ret->{re} = '^\d+$';
111             } elsif ($val eq 'OCTAL') {
112 3         11 $ret->{re} = '^[0-7]+$';
113             } elsif ($val eq 'HEX') {
114 0         0 $ret->{re} = '^([0-9][A-Fa-f])+$';
115             } elsif ($val =~ /^BOOL(EAN)?$/) {
116 6         24 $ret->{check} = \&check_bool;
117             } else {
118 3         17 unshift @words, $val;
119             }
120              
121 56   100     299 while (($val = $words[0])
122             && $val =~ /^:(?.+?)(?:\s*=\s*(?.*))?$/) {
123 10   100 10   12218 $ret->{$+{kw}} = $+{val} // 1;
  10         3203  
  10         3396  
  38         373  
124 38         157 shift @words;
125             }
126 56 100       136 if (@words) {
127 9 50       34 if ($ret->{array}) {
128 0         0 $ret->{default} = [@words];
129             } else {
130 9         35 $ret->{default} = join(' ', @words);
131             }
132             }
133 56         169 ($name, $ret);
134             }
135 11         156 })->{section};
136             # Process eventual __options__ keywords
137 11         211 foreach my $s (@sections) {
138 39 100       102 if (exists($s->{section}{__options__})) {
139 3         7 @{$s}{keys %{$s->{section}{__options__}}}
  3         8  
140 3         6 = values %{$s->{section}{__options__}};
  3         10  
141 3         9 delete $s->{section}{__options__};
142             }
143             }
144 11         48 return $lex;
145             }
146              
147             sub check_bool {
148 1     1 0 224 my ($self, $valref, undef, $locus) = @_;
149 1         9 my %bv = (
150             yes => 1,
151             no => 0,
152             true => 1,
153             false => 0,
154             on => 1,
155             off => 0,
156             t => 1,
157             nil => 0,
158             1 => 1,
159             0 => 0
160             );
161            
162 1 50       4 if (exists($bv{$$valref})) {
163 1         2 $$valref = $bv{$$valref};
164 1         3 return 1;
165             }
166 0           $self->error("$$valref is not a valid boolean value", locus => $locus);
167 0           return 0;
168             }
169              
170             1;
171              
172             =head1 NAME
173              
174             Config::Parser - base class for configuration file parsers
175              
176             =head1 DESCRIPTION
177              
178             B provides a framework for writing configuration file
179             parsers. It is an intermediate layer between the abstract syntax tree
180             (L) and implementation of a parser for a particular
181             configuration file format.
182              
183             It takes a I approach. That means that the implementer
184             creates a derived class that implements a parser on top of B.
185             Application writers write an example of configuration file in the B<__DATA__>
186             section of their application, which defines the statements that are allowed
187             in a valid configuration. This example is then processed by the parser
188             implementation to create an instance of the parser, which is then used to
189             process the actual configuration file.
190              
191             Let's illustrate this on a practical example. Suppose you need a parser for
192             a simple configuration file, which consists of keyword/value pairs. In each
193             pair, the keyword is separated from the value by an equals sign. Pairs are
194             delimited by newlines. Leading and trailing whitespace characters on a line
195             are ignored as well as are empty lines. Comments begin with a hash sign and
196             end with a newline.
197              
198             You create the class, say B, inherited from
199             B. The method B in this class implements the actual
200             parser.
201              
202             Application writer decides what keywords are allowed in a valid configuration
203             file and what are their values and describes them in the B<__DATA__> section
204             of his program (normally in a class derived from B, in
205             the same format as the actual configuration file. For example:
206              
207             __DATA__
208             basedir = STRING :mandatory
209             mode = OCTAL
210             size = NUMBER :array
211              
212             This excerpt defines a configuration with three allowed statements. Uppercase
213             values to the right of the equals sign are data types. Values starting with
214             a colon are flags that define the semantics of the values. This section
215             declares that three keywords are allowed. The B keyword takes
216             string as its argument and must be present in a valid configuration. The
217             B expects octal number as its argument. The B keyword takes
218             a number. Multiple B statements are collapsed into an array.
219              
220             To parse the actual configuration file, the programmer creates an instance
221             of the B class, passing it the name of the file as its
222             argument:
223              
224             $cf = new Config::Parse::KV($filename);
225              
226             This call first parses the B<__DATA__> section and builds validation rules,
227             then it parses the actual configuration from B<$filename>. Finally, it
228             applies the validation rules to the created syntax tree. If all rules pass,
229             the configuration is correct and the constructor returns a valid object.
230             Otherwise, it issues proper diagnostics and croaks.
231              
232             Upon successful return, the B<$cf> object is used to obtain the actual
233             configuration values as needed.
234              
235             Notice that syntax declarations in the B<__DATA__> section always follow the
236             actual configuration file format, that's why we call them I
237             example>. For instance, the syntax definition for a configuration file in
238             Apache-like format would look like
239              
240             __DATA__
241            
242             basedir STRING :mandatory
243             mode OCTAL
244             size NUMBER :array
245            
246              
247             =head1 CONSTRUCTOR
248              
249             =head2 $cfg = new Config::Parser(%hash)
250              
251             Creates a new parser object. Keyword arguments are:
252              
253             =over 4
254              
255             =item B
256              
257             Name of the file to parse. If supplied, the constructor will call
258             the B and B methods automatically and will croak if
259             the latter returns false. The B method is given B,
260             B and B keyword-value pairs (if present) as its arguments.
261              
262             If not supplied, the caller is supposed to call both methods later.
263              
264             =item B
265              
266             Optional line where the configuration starts in B. It is used to
267             keep track of statement location in the file for correct diagnostics. If
268             not supplied, B<1> is assumed.
269              
270             Valid only together with B.
271              
272             =item B
273              
274             File handle to read from. If it is not supplied, new handle will be
275             created by using B on the supplied filename.
276              
277             Valid only together with B.
278              
279             =item B
280              
281             Dictionary of allowed configuration statements in the file. You will not
282             need this parameter. It is listed here for completeness sake. Refer to
283             the L constructor for details.
284              
285             =back
286              
287             =head1 USER HOOKS
288              
289             These are the methods provided for implementers to do any implementation-
290             specific tasks. Default implementations are empty placeholders.
291              
292             =head2 $cfg->init
293              
294             Called after creation of the base object, when parsing of the syntax
295             definition has finished. Implementers can use it to do any
296             implementation-specific initialization.
297              
298             =head2 $cfg->mangle
299              
300             Called after successful parsing. It can be used to modify the created
301             source tree.
302              
303             =head1 PARSER METHODS
304              
305             The following two methods are derived from L. They are
306             called internally by the constructor, if the file name is supplied.
307              
308             =head2 $cfg->parse($filename, %opts)
309              
310             Parses the configuration from B<$filename>. Optional arguments are:
311              
312             =over 4
313              
314             =item B
315              
316             File handle to read from. If it is not supplied, new handle will be
317             created by using B on the supplied filename.
318              
319             =item B
320              
321             Line to start numbering of lines from. It is used to keep track of
322             statement location in the file for correct diagnostics. If not supplied,
323             B<1> is assumed.
324              
325             =back
326              
327             =head2 $cfg->commit
328              
329             Finalizes the syntax tree. Returns true on success, and false on errors.
330              
331             =head1 SYNTAX DEFINITION
332              
333             Syntax definition is a textual description of statements allowed in
334             a configuration file. It is written in the format of the configuration
335             file itself and is parsed using the same object (derivative of
336             B) that will be used later to parse the actual configuration.
337              
338             Syntax definitions are gathered from the B<__DATA__> blocks of
339             subclasses of B.
340              
341             In a syntax definition the value of each statement consists of optional
342             data type followed by zero or more options delimited with whitespace.
343              
344             Valid data types are:
345              
346             =over 4
347              
348             =item B
349              
350             String value.
351              
352             =item B or B
353              
354             Decimal number.
355              
356             =item B
357              
358             Octal number.
359              
360             =item B
361              
362             Hex number.
363              
364             =item B or B
365              
366             Boolean value. Allowed values are:
367             B, B, B, B, B<1>, for C and
368             B, B, B, B, B<0>, for C.
369              
370             =back
371              
372             If the data type is omitted, no checking is performed unless specified
373             otherwise by other options (see the B<:re> and B<:check> options below).
374              
375             Options are special names prefixed with a colon. Option names follow
376             the keywords from the L keyword lexicon value. An option
377             can be followed by an equals sign and its value. If an option is used
378             without arguments, the value B<1> is implied.
379              
380             Any word not recognized as an option or its value starts the I
381             value>.
382              
383             Available options are described below:
384              
385             =over 4
386              
387             =item B<:mandatory>
388              
389             Marks the statement as a mandatory one. If such a statement is missing from
390             the configuration file, the parser action depends on whether the default value
391             is supplied. If it is, the statement will be inserted in the parse tree with
392             the default value. Otherwise, a diagnostic message will be printed and the
393             constructor will return B.
394              
395             =item B<:default>
396              
397             Argument supplies the default value for this setting.
398              
399             =item B<:array>
400              
401             If the value is 1, declares that the statement is an array. Multiple
402             occurrences of the statement will be accumulated. They can be retrieved as
403             a reference to an array when the parsing is finished.
404              
405             =item B<:re = >I
406              
407             Defines a regular expression which the value must match in order to be
408             accepted. This provides a more elaborate mechanism of checking than the
409             data types. In fact, data types are converted to the appropriate B<:re>
410             options internally, for example B becomes B<:re = "^[0-7]+$">.
411             If data type and B<:re> are used together, B<:re> takes precedence.
412              
413             =item B<:select = >I
414              
415             Argument is the name of a method to call in order to decide
416             whether to apply this definition. The method will be called as
417              
418             $cfg->{ \$method }($node, @path)
419              
420             where $node is the B object (use
421             B<$vref-Evalue>, to obtain the actual value), and B<@path> is its pathname.
422              
423             =item B<:check = >I
424              
425             Argument is the name of a method which will be invoked after parsing the
426             statement in order to verify its value. This provides the most flexible
427             way of verification (the other two being the B<:re> option and data type
428             declaration). The method will be invoked as follows:
429              
430             $cfg->{ \$method }($valref, $prev_value, $locus)
431              
432             where B<$valref> is a reference to the value, and B<$prev_value> is the
433             value of the previous instance of this setting. The method must return
434             B, if the value is OK for that setting. In that case, it is allowed
435             to modify the value referenced by B<$valref>. If the value is erroneous,
436             the method must issue an appropriate error message using B<$cfg-Eerror>,
437             and return 0.
438              
439             =back
440              
441             To specify options for a section, use the reserved keyword B<__options__>.
442             Its value is the list of options as described above. After processing, the
443             keyword itself is removed from the lexicon.
444              
445             =head1 OTHER METHODS
446              
447             =head2 $cfg->check($valref, $prev, $locus)
448              
449             This method implements syntax checking and translation for C data
450             types. If B<$$valref> is one of the valid boolean values (as described
451             above), it translates it to B<1> or B<0>, stores that value in B<$valref>,
452             and returns 1. Otherwise, it emits error message using B<$cfg->error> and
453             returns 0.
454              
455             =head1 SEE ALSO
456              
457             L(3).
458              
459             =cut
460              
461