Config-Grammar-1.13000755001750001750 013444516770 13017 5ustar00dwsdws000000000000README100644001750001750 112513444516770 13757 0ustar00dwsdws000000000000Config-Grammar-1.13Config::Grammar =============== Config::Grammar is a Perl module to parse configuration files by following a grammar, which specifies how the configuration file should look like. The configuration files are nice to work with for humans and the error messages are helpful because it tells right away that for example you are setting a variable which isn't defined. Config::Grammar supports many advanced features, that you can read about in its documentation (type 'man Config::Grammar' or 'perldoc lib/Config/Grammar.pm' in this directory) See also: https://metacpan.org/release/Config-Grammar Changes100644001750001750 432713444516770 14401 0ustar00dwsdws000000000000Config-Grammar-1.13Revision history for Perl extension Config::Grammar. 2019-03-20 * Released 1.13 * Fix spelling error in manpage (fixes #3, patch by Salvatore Bonaccorso) * Use encoding in Dynamic.pm as well (Fritz Zaucker) 2016-09-09 * Released 1.12 * Fixes 'Name "Config::Grammar::File" used only once' (patch by Salvatore Bonaccorso) * Fix spelling error in manpage (patch by Salvatore Bonaccorso) * Use Dist::Zilla to prepare the Perl distribution for CPAN 2016-02-08 * Released 1.11 * Allow specification of file encoding (Fritz Zaucker) 2007-09-25 * Released 1.10 * Split module in Config::Grammar and Config::Grammar::Dynamic, where only Config::Grammar::Dynamic can process _dyn, _dyndoc and _recursive directives * Move documentation-generating code to Config::Grammar::Document 2007-08-29 * Released 1.03 * fix example in POD (Fritz Zaucker) 2005-08-15 * Released 1.02 * Fixed bug with @defines (the substituted text was sometimes modified erroneously, reported by Niko Tyni and Tobias Oetiker) 2005-03-09 * Released 1.01 * License: same as Perl * Obfuscate the email of the authors to make life a little bit harder for spammers 2005-03-08 * Released 1.00 * Renamed from ISG::ParseConfig to Config::Grammar for publication on CPAN 2005-02-21 * Implemented _dyndoc, _varlist and _sub for sections (Niko Tyni) 2005-01-10 * Implemented _dyn, _default, _recursive, and _inherited (Niko Tyni) 2004-08-17 * Allow special input files like "program|" 2004-02-09 * Added _example propperty for pod and template generation 2002-10-10 * More verbatim _text sections 2002-08-28 * Added maketmpl methode 2002-03-12 * Implemented @define, make makepod return a string and not an array 2002-01-28 * Fixed quote parsing in tables 2002-01-09 * Added Documentation to the _text section documentation 2001-10-20 * Improved Rendering of _doc information 2001-09-19 * Added _sub error parsing and _doc self documentation 2001-09-04 * Remove space before comments, more strict variable definition 2001-05-11 * Initial Version for policy 0.3 t000755001750001750 013444516770 13203 5ustar00dwsdws000000000000Config-Grammar-1.13dyn.t100644001750001750 630213444516770 14323 0ustar00dwsdws000000000000Config-Grammar-1.13/t#!/usr/bin/perl -w use strict; use lib 'lib'; use lib 't'; use Test; use DebugDump; BEGIN { plan tests => 7; } use Config::Grammar::Dynamic; ok(1); # _dyn, _dyndoc, _varlist, _sub for sections my $sub = sub { my ($val, $list) = @_; return "Should get a second argument" unless ref $list eq 'ARRAY'; for ($val) { /4/ and do { @$list and return "b wasn't first?"; next; }; /2/ and do { 1 == @$list or return "a wasn't second?"; $list->[0] eq 'b' or return "b wasn't before a?"; next; }; /3/ and do { 2 == @$list or return "c wasn't third?"; $list->[0] eq 'b' or return "c: b wasn't first?"; $list->[1] eq 'a' or return "c: a wasn't second?"; next; }; return "unexpected value"; } return undef; }; my $parser = new Config::Grammar::Dynamic({ _sections => [ 'test' ], _vars => [ qw(a) ], a => { _dyn => sub { my $name = shift; die("\$name should be 'a'") unless $name eq 'a'; my $val = shift; my $grammar = shift; return unless $val == 2; push @{$grammar->{_vars}}, ('b', 'c'); $grammar->{c}{_default} = 5; }, _sub => sub { my $val = shift; my $nothing = shift; return "Shouldn't get a second argument" if defined $nothing; return undef; }, _dyndoc => { 1 => q{Values other than 2 have no effect}, 2 => q{This creates new variables 'b' and 'c'}, }, }, test => { _sub => sub { my $name = shift; return "\$name should be 'test', but got '$name'" unless $name eq 'test'; return undef; }, _sections => [ '/s+/' ], '/s+/' => { _varlist => 1, _vars => [ qw(a b c) ], _dyn => sub { my ($re, $name, $grammar) = @_; die("\$re should be '/s+/'") unless $re eq '/s+/'; my $realre = qr/s+/; die("\$name should match \$re") unless $name =~ $realre; pop @{$grammar->{_vars}} if length($name) > 2; }, _sub => sub { my $name = shift; my $re = qr/s+/; die("\$name should match \$re") unless $name =~ $re; return undef; }, _dyndoc => { s => q{Less than three 's' letters have no effect}, ss => q{Less than three 's' letters still have no effect}, sss => q{More than two 's' letters do have an effect}, }, a => { _sub => $sub }, b => { _sub => $sub }, c => { _sub => $sub }, }, }, }); # dyn1.cfg should fail: # a = 3 # b = 3 # dyn2.cfg should be OK and result in c==5 # a = 2 # b = 3 # *** test *** # +s # b = 4 # a = 2 # c = 3 if (@ARGV and $ARGV[0] eq '--gen') { open(P, ">t/dyn2.pod"); print P $parser->makepod; close P; my $cfg = $parser->parse('t/dyn2.cfg'); defined $cfg or die("ERROR: $parser->{err}"); open(P, ">t/dyn2.dump"); print P DebugDump::debug_dump($cfg); close P; open(P, ">t/dyn2.templ"); print P $parser->maketmpl; close P; exit 0; } { open(F, "; close F; my $pod2 = $parser->makepod; ok($pod2, $pod); } { open(F, "; close F; my $tmpl2 = $parser->maketmpl; ok($tmpl2, $tmpl); } my $cfg = $parser->parse('t/dyn1.cfg'); ok($cfg, undef); $cfg = $parser->parse('t/dyn2.cfg'); defined $cfg or die("ERROR: $parser->{err}"); ok($cfg->{a}, 2); ok($cfg->{b}, 3); ok($cfg->{c}, 5); LICENSE100644001750001750 4367113444516770 14140 0ustar00dwsdws000000000000Config-Grammar-1.13This software is copyright (c) 2019 by David Schweikert. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2019 by David Schweikert. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2019 by David Schweikert. This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End dist.ini100644001750001750 37413444516770 14530 0ustar00dwsdws000000000000Config-Grammar-1.13name = Config-Grammar author = David Schweikert license = Perl_5 copyright_holder = David Schweikert [@Filter] -bundle = @Basic -remove = Readme [@Git] [AutoPrereqs] [VersionFromModule] [MetaJSON] [GithubMeta] issues = 1 META.yml100644001750001750 142313444516770 14351 0ustar00dwsdws000000000000Config-Grammar-1.13--- abstract: 'A grammar-based, user-friendly config parser' author: - 'David Schweikert ' build_requires: Test: '0' Test::Simple: '0' lib: '0' vars: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Config-Grammar requires: base: '0' strict: '0' resources: bugtracker: https://github.com/schweikert/Config-Grammar/issues homepage: https://github.com/schweikert/Config-Grammar repository: https://github.com/schweikert/Config-Grammar.git version: '1.13' x_generated_by_perl: v5.24.1 x_serialization_backend: 'YAML::Tiny version 1.73' MANIFEST100644001750001750 102613444516770 14230 0ustar00dwsdws000000000000Config-Grammar-1.13# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.012. Changes LICENSE MANIFEST META.json META.yml Makefile.PL README dist.ini lib/Config/Grammar.pm lib/Config/Grammar.pm~ lib/Config/Grammar/Document.pm lib/Config/Grammar/Dynamic.pm t/DebugDump.pm t/dyn.t t/dyn1.cfg t/dyn2.cfg t/dyn2.dump t/dyn2.pod t/dyn2.templ t/example.conf t/example.parsed t/example.pod t/example.t t/example.tmpl t/inherit.cfg t/inherit.dump t/inherit.pod t/inherit.t t/inherit.templ t/sub_error.t t/sub_error1.conf t/sub_error2.conf META.json100644001750001750 254413444516770 14526 0ustar00dwsdws000000000000Config-Grammar-1.13{ "abstract" : "A grammar-based, user-friendly config parser", "author" : [ "David Schweikert " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Config-Grammar", "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "base" : "0", "strict" : "0" } }, "test" : { "requires" : { "Test" : "0", "Test::Simple" : "0", "lib" : "0", "vars" : "0" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/schweikert/Config-Grammar/issues" }, "homepage" : "https://github.com/schweikert/Config-Grammar", "repository" : { "type" : "git", "url" : "https://github.com/schweikert/Config-Grammar.git", "web" : "https://github.com/schweikert/Config-Grammar" } }, "version" : "1.13", "x_generated_by_perl" : "v5.24.1", "x_serialization_backend" : "JSON::XS version 3.03" } dyn2.pod100644001750001750 320513444516770 14723 0ustar00dwsdws000000000000Config-Grammar-1.13/tThe following variables can be set in this section: =over =item B This variable I modifies the grammar based on its value. =back =head2 *** test *** The following sections are valid on level 1: =over =item B<+/s+/> The grammar of this section is I modified based on its name. The following variables can be set in this section: =over =item B =item B =item B =back Dynamical grammar changes for example instances of this section: =over =item B: Less than three 's' letters have no effect No changes that can be automatically described. (End of dynamical grammar changes for example instance C.) =item B: Less than three 's' letters still have no effect No changes that can be automatically described. (End of dynamical grammar changes for example instance C.) =item B: More than two 's' letters do have an effect The following variables are not valid anymore: =over =item c =back (End of dynamical grammar changes for example instance C.) =back (End of dynamical grammar changes for example instances of section C.) =back Dynamical grammar changes for example values of variable C: =over =item B<1>: Values other than 2 have no effect No changes that can be automatically described. (End of dynamical grammar changes for variable C example value C<1>.) =item B<2>: This creates new variables 'b' and 'c' The following new variables are valid: =over =item B =item B Default value: c = 5 =back (End of dynamical grammar changes for variable C example value C<2>.) =back (End of dynamical grammar changes for example values of variable C.) dyn2.cfg100644001750001750 11413444516770 14654 0ustar00dwsdws000000000000Config-Grammar-1.13/ta = 2 b = 3 *** test *** +s b = 4 a = 2 c = 3 dyn1.cfg100644001750001750 1513444516770 14633 0ustar00dwsdws000000000000Config-Grammar-1.13/ta = 3 b = 3 inherit.t100644001750001750 553213444516770 15177 0ustar00dwsdws000000000000Config-Grammar-1.13/t#!/usr/bin/perl -w use strict; use lib 'lib'; use lib 't'; use Test; use DebugDump; BEGIN { plan tests => 28; } use Config::Grammar::Dynamic; ok(1); # _default, _inherited, _recursive my $parser = new Config::Grammar::Dynamic({ _sections => [ 'top' ], _vars => [ (qw(a b c d)) ], _recursive => [ 'top' ], a => { _doc => "The 'A' variable", _default => 5, }, b => { _doc => "The 'B' variable", _default => 6, }, c => { _doc => "The 'C' variable", }, d => { _doc => "The 'D' variable", _default => 11 }, top => { _sections => [ 'bottom' ], _vars => [ (qw(a b c d)) ], _inherited => [ (qw(a b)) ], a => { _doc => "The 'A' variable", _default => 7, }, b => { _doc => "The 'B' variable", _default => 8, }, c => { _doc => "The 'C' variable", _default => 9, }, d => { _doc => "The 'D' variable", }, bottom => { _vars => [ (qw(a b c d)) ], _inherited => [ (qw(b d)) ], a => { _doc => "The 'A' variable"}, b => { _doc => "The 'B' variable", _default => 8, }, c => { _doc => "The 'C' variable", _default => 9, }, d => { _doc => "The 'D' variable", }, }, }, }); # inherit.cfg: # b = 4 # d = 1 # *** top *** # c = 2 # +bottom # d = 3 # +top # a = 5 # ++top # b = 6 # +++bottom # c = 7 if (@ARGV and $ARGV[0] eq '--gen') { open(P, ">t/inherit.pod"); print P $parser->makepod; close P; my $cfg = $parser->parse('t/inherit.cfg'); defined $cfg or die("ERROR: $parser->{err}"); open(P, ">t/inherit.dump"); print P DebugDump::debug_dump($cfg); close P; open(P, ">t/inherit.templ"); print P $parser->maketmpl; close P; exit 0; } { open(F, "; close F; my $pod2 = $parser->makepod; ok($pod, $pod2); } { open(F, "; close F; my $tmpl2 = $parser->maketmpl; ok($tmpl, $tmpl2); } my $cfg = $parser->parse('t/inherit.cfg'); defined $cfg or die("ERROR: $parser->{err}"); ok($cfg->{a}, 5); ok($cfg->{top}{a}, 7); ok($cfg->{top}{bottom}{a}, undef); ok($cfg->{b}, 4); ok($cfg->{top}{b}, 4); ok($cfg->{top}{bottom}{b}, 4); ok($cfg->{c}, undef); ok($cfg->{top}{c}, 2); ok($cfg->{top}{bottom}{c}, 9); ok($cfg->{d}, 1); ok($cfg->{top}{d}, undef); ok($cfg->{top}{bottom}{d}, 3); ok($cfg->{top}{top}{a}, 5); ok($cfg->{top}{top}{b}, 4); ok($cfg->{top}{top}{c}, 9); ok($cfg->{top}{top}{d}, undef); ok($cfg->{top}{top}{top}{a}, 5); ok($cfg->{top}{top}{top}{b}, 6); ok($cfg->{top}{top}{top}{c}, 9); ok($cfg->{top}{top}{top}{d}, undef); ok($cfg->{top}{top}{top}{bottom}{a}, undef); ok($cfg->{top}{top}{top}{bottom}{b}, 6); ok($cfg->{top}{top}{top}{bottom}{c}, 7); ok($cfg->{top}{top}{top}{bottom}{d}, undef); { open(F, "; close F; ok($dump, DebugDump::debug_dump($cfg)); } # $cfg2 = $parser->parse('t/inherit1.cfg'); example.t100644001750001750 474213444516770 15172 0ustar00dwsdws000000000000Config-Grammar-1.13/t#!/usr/sepp/bin/perl-5.6.1 -w use lib 'lib'; use lib 't'; use strict; use Test; use DebugDump; BEGIN { plan tests => 6; } use Config::Grammar; ok(1); my $RE_IP = '\d+\.\d+\.\d+\.\d+'; # 192.168.116.12 my $RE_MAC = '[0-9a-f]{2}(?::[0-9a-f]{2}){5}'; # 00:50:fe:bc:65:13 my $RE_HOST = '\S+'; my $parser = Config::Grammar->new({ _sections => [ 'network', 'hosts', 'text' ], network => { _vars => [ 'dns' ], _sections => [ "/$RE_IP/" ], dns => { _doc => "address of the dns server", _example => "10.12.33.2", _re => $RE_HOST, _re_error => 'dns must be an host name or ip address', }, "/$RE_IP/" => { _doc => "Ip Adress", _example => "192.168.98.3", _vars => [ 'dns', 'netmask', 'gateway' ], dns => { _doc => "address of the dns server", _example => "10.12.33.3", _re => $RE_HOST, _re_error => 'dns must be an host name or ip address' }, netmask => { _doc => "Netmask", _example => "255.255.255.0", _re => $RE_IP, _re_error => 'netmask must be a dotted ip address' }, gateway => { _doc => "Default Gateway address in IP notation", _example => "10.12.33.1", _re => $RE_IP, _re_error => 'gateway must be a dotted ip address' }, }, }, hosts => { _doc => "Details about the hosts", _table => { _doc => "Description of all the Hosts", _key => 0, _columns => 3, 0 => { _doc => "Ethernet Address", _example => "2:3:3:a:fb:cc:12:2", _re => $RE_MAC, _re_error => 'first column must be an ethernet mac address', }, 1 => { _doc => "IP Address", _example => "10.1.43.32", _re => $RE_IP, _re_error => 'second column must be a dotted ip address', }, }, }, text => { _text => {}, } }); ok(2); my $cfg = $parser->parse('t/example.conf'); defined $cfg or die "ERROR: $parser->{err}\n"; ok(2); open(PARSED, 't/example.parsed') or do { print DebugDump::debug_dump($cfg); die; }; $/ = undef; my $expect = ; close PARSED; my $is = DebugDump::debug_dump($cfg); ok($is, $expect); open(POD, 't/example.pod'); my $pod_expected = ; my $pod = $parser->makepod; ok($pod, $pod_expected); close POD; open(TMPL, 't/example.tmpl'); my $tmpl_expected = ; my $tmpl = $parser->maketmpl; ok($tmpl, $tmpl_expected); close TMPL; # vi: ft=perl sw=4 dyn2.dump100644001750001750 46113444516770 15067 0ustar00dwsdws000000000000Config-Grammar-1.13/t{ a => '2' b => '3' c => '5' test => { s => { _varlist => [ 'b' 'a' 'c' ] a => '2' b => '4' c => '3' } } } Makefile.PL100644001750001750 215613444516770 15056 0ustar00dwsdws000000000000Config-Grammar-1.13# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.012. use strict; use warnings; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( "ABSTRACT" => "A grammar-based, user-friendly config parser", "AUTHOR" => "David Schweikert ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0 }, "DISTNAME" => "Config-Grammar", "LICENSE" => "perl", "NAME" => "Config::Grammar", "PREREQ_PM" => { "base" => 0, "strict" => 0 }, "TEST_REQUIRES" => { "Test" => 0, "Test::Simple" => 0, "lib" => 0, "vars" => 0 }, "VERSION" => "1.13", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "Test" => 0, "Test::Simple" => 0, "base" => 0, "lib" => 0, "strict" => 0, "vars" => 0 ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); dyn2.templ100644001750001750 15713444516770 15245 0ustar00dwsdws000000000000Config-Grammar-1.13/t# a = * no example * # *** test *** # +/s+/ # a = * no example * # b = * no example * # c = * no example * sub_error.t100644001750001750 163413444516770 15536 0ustar00dwsdws000000000000Config-Grammar-1.13/t#!/usr/sepp/bin/perl-5.6.1 -w use lib 'lib'; use strict; use Test::Simple tests => 3; use Config::Grammar; my $parser = Config::Grammar->new({ _vars => [ 'var' ], _sections => [ 'table' ], _mandatory => [ 'var', 'table' ], var => { _sub => sub { $_[0] eq 'test' ? return undef : return 'error' }, }, table => { _table => { _columns => 1, 0 => { _sub => sub { $_[0] eq 'test' ? return undef : return 'error'; }, } } } }); ok(defined $parser, 'new works'); my $cfg = $parser->parse('t/sub_error1.conf'); if(defined $cfg) { ok(0, 'no error for variables'), } else { ok($parser->{err} eq 't/sub_error1.conf, line 1: error', '_sub error for variables'); } $cfg = $parser->parse('t/sub_error2.conf'); if(defined $cfg) { ok(0, 'no error for table columns'), } else { ok($parser->{err} eq 't/sub_error2.conf, line 5: error', '_sub error for table columns'); } # vi: ft=perl sw=4 example.pod100644001750001750 150013444516770 15476 0ustar00dwsdws000000000000Config-Grammar-1.13/t=head2 *** network *** The following variables can be set in this section: =over =item B address of the dns server Example: dns = 10.12.33.2 =back The following sections are valid on level 1: =over =item B<+/\d+\.\d+\.\d+\.\d+/> Ip Adress The following variables can be set in this section: =over =item B address of the dns server Example: dns = 10.12.33.3 =item B Netmask Example: netmask = 255.255.255.0 =item B Default Gateway address in IP notation Example: gateway = 10.12.33.1 =back =back =head2 *** hosts *** Details about the hosts Description of all the Hosts =over =item column 0 Ethernet Address Example: 2:3:3:a:fb:cc:12:2 =item column 1 IP Address Example: 10.1.43.32 =item column 2 Unspecific Content =back =head2 *** text *** Unspecified Text content inherit.pod100644001750001750 240113444516770 15506 0ustar00dwsdws000000000000Config-Grammar-1.13/tThe following variables can be set in this section: =over =item B The 'A' variable Default value: a = 5 =item B The 'B' variable Default value: b = 6 =item B The 'C' variable =item B The 'D' variable Default value: d = 11 =back =head2 *** top *** This section is I: it can contain subsection(s) with the same syntax. The following variables can be set in this section: =over =item B The 'A' variable This variable I its value from the parent section if nothing is specified here. Default value: a = 7 =item B The 'B' variable This variable I its value from the parent section if nothing is specified here. Default value: b = 8 =item B The 'C' variable Default value: c = 9 =item B The 'D' variable =back The following sections are valid on level 1: =over =item B<+bottom> The following variables can be set in this section: =over =item B The 'A' variable =item B The 'B' variable This variable I its value from the parent section if nothing is specified here. Default value: b = 8 =item B The 'C' variable Default value: c = 9 =item B The 'D' variable This variable I its value from the parent section if nothing is specified here. =back =back inherit.cfg100644001750001750 12413444516770 15443 0ustar00dwsdws000000000000Config-Grammar-1.13/tb = 4 d = 1 *** top *** c = 2 +bottom d = 3 +top a = 5 ++top b = 6 +++bottom c = 7 DebugDump.pm100644001750001750 171513444516770 15561 0ustar00dwsdws000000000000Config-Grammar-1.13/tpackage DebugDump; use vars qw($VERSION); $VERSION=1.1; sub debug_dump($;$); sub debug_dump($;$) { my $ref = shift; my $indent = shift || ''; my $out = ''; my $type = ref $ref; if(not $type) { if(defined $ref) { $out .= $indent."'$ref'\n"; } else { $out .= $indent."undef\n"; } } elsif($type eq 'SCALAR' ) { $out .= $indent."-> $$ref\n"; } elsif($type eq 'ARRAY' ) { $out .= $indent."[\n"; foreach my $e (@$ref) { $out .= debug_dump($e, $indent.' '); } $out .= $indent."]\n"; } elsif($type eq 'HASH' ) { $out .= $indent."{\n"; foreach my $k (sort keys %$ref) { $out .= $indent." $k =>\n"; $out .= debug_dump($ref->{$k}, $indent.' '); } $out .= $indent."}\n"; } else { $out .= $indent.$type."\n"; } return $out; } 1; # vi: sw=4 et example.tmpl100644001750001750 35113444516770 15653 0ustar00dwsdws000000000000Config-Grammar-1.13/t# *** network *** # dns = 10.12.33.2 # +/\d+\.\d+\.\d+\.\d+/ # ( ex. 192.168.98.3 ) # dns = 10.12.33.3 # netmask = 255.255.255.0 # gateway = 10.12.33.1 # *** hosts *** # table # "2:3:3:a:fb:cc:12:2" "10.1.43.32" "C2" # *** text *** example.conf100644001750001750 53413444516770 15627 0ustar00dwsdws000000000000Config-Grammar-1.13/t@define TEST isg.ee *** network *** dns = 192.168.7.87 + 192.168.7.64 netmask = 255.255.255.192 gateway = 192.168.7.65 *** hosts *** 00:50:fe:bc:65:11 192.168.7.97 plain.hades 00:50:fe:bc:65:12 192.168.7.98 TEST.hades 00:50:fe:bc:65:14 192.168.7.99 isg.ee.hades *** text *** bla bla # bla test testing inherit.dump100644001750001750 130613444516770 15674 0ustar00dwsdws000000000000Config-Grammar-1.13/t{ a => '5' b => '4' d => '1' top => { a => '7' b => '4' bottom => { b => '4' c => '9' d => '3' } c => '2' top => { a => '5' b => '4' c => '9' top => { a => '5' b => '6' bottom => { b => '6' c => '7' } c => '9' } } } } inherit.templ100644001750001750 44013444516770 16026 0ustar00dwsdws000000000000Config-Grammar-1.13/t# a = * no example * # b = * no example * # c = * no example * # d = * no example * # *** top *** # a = * no example * # b = * no example * # c = * no example * # d = * no example * # +bottom # a = * no example * # b = * no example * # c = * no example * # d = * no example * example.parsed100644001750001750 130013444516770 16170 0ustar00dwsdws000000000000Config-Grammar-1.13/t{ hosts => { 00:50:fe:bc:65:11 => [ '00:50:fe:bc:65:11' '192.168.7.97' 'plain.hades' ] 00:50:fe:bc:65:12 => [ '00:50:fe:bc:65:12' '192.168.7.98' 'isg.ee.hades' ] 00:50:fe:bc:65:14 => [ '00:50:fe:bc:65:14' '192.168.7.99' 'isg.ee.hades' ] } network => { 192.168.7.64 => { gateway => '192.168.7.65' netmask => '255.255.255.192' } dns => '192.168.7.87' } text => { _text => 'bla bla # bla test testing ' } } sub_error2.conf100644001750001750 3713444516770 16236 0ustar00dwsdws000000000000Config-Grammar-1.13/tvar = test *** table *** bla sub_error1.conf100644001750001750 3713444516770 16235 0ustar00dwsdws000000000000Config-Grammar-1.13/tvar = bla *** table *** test Config000755001750001750 013444516770 14713 5ustar00dwsdws000000000000Config-Grammar-1.13/libGrammar.pm100644001750001750 6723713444516770 17036 0ustar00dwsdws000000000000Config-Grammar-1.13/lib/Configpackage Config::Grammar; use strict; $Config::Grammar::VERSION = '1.13'; sub new($$) { my $proto = shift; my $grammar = shift; my $class = ref($proto) || $proto; my $self = {grammar => $grammar}; bless($self, $class); return $self; } sub err($) { my $self = shift; return $self->{'err'}; } sub _make_error($$) { my $self = shift; my $text = shift; $self->{'err'} = "$self->{file}, line $self->{line}: $text"; } sub _peek($) { my $a = shift; return $a->[$#$a]; } sub _quotesplit($) { my $line = shift; my @items; while ($line ne "") { if ($line =~ s/^"((?:\\.|[^"])*)"\s*//) { my $frag = $1; $frag =~ s/\\(.)/$1/g; push @items, $frag; } elsif ($line =~ s/^'((?:\\.|[^'])*)'\s*//) { my $frag = $1; $frag =~ s/\\(.)/$1/g; push @items, $frag; } elsif ($line =~ s/^((?:\\.|[^\s])*)(?:\s+|$)//) { my $frag = $1; $frag =~ s/\\(.)/$1/g; push @items, $frag; } else { die "Internal parser error for '$line'"; } } return @items; } sub _check_mandatory($$$$) { my $self = shift; my $g = shift; my $c = shift; my $section = shift; # check _mandatory sections, variables and tables if (defined $g->{_mandatory}) { for (@{$g->{_mandatory}}) { if (not defined $g->{$_}) { $g->{$_} = {}; } if (not defined $c->{$_}) { if (defined $section) { $self->{'err'} .= "$self->{file} ($section): "; } else { $self->{'err'} = "$self->{file}: "; } if (defined $g->{$_}{_is_section}) { $self->{'err'} .= "mandatory (sub)section '$_' not defined"; } elsif ($_ eq '_table') { $self->{'err'} .= "mandatory table not defined"; } else { $self->{'err'} .= "mandatory variable '$_' not defined"; } return 0; } } } for (keys %$c) { # do some cleanup ref $c->{$_} eq 'HASH' or next; defined $c->{$_}{_is_section} or next; $self->_check_mandatory($g->{$c->{$_}{_grammar}}, $c->{$_}, defined $section ? "$section/$_" : "$_") or return 0; delete $c->{$_}{_is_section}; delete $c->{$_}{_grammar}; delete $c->{$_}{_order_count} if exists $c->{$_}{_order_count}; } return 1; } ######### SECTIONS ######### # search grammar definition of a section sub _search_section($$) { my $self = shift; my $name = shift; if (not defined $self->{grammar}{_sections}) { $self->_make_error("no sections are allowed"); return undef; } # search exact match for (@{$self->{grammar}{_sections}}) { if ($name eq $_) { return $_; } } # search regular expression for (@{$self->{grammar}{_sections}}) { if (m|^/(.*)/$|) { if ($name =~ /^$1$/) { return $_; } } } # no match $self->_make_error("unknown section '$name'"); return undef; } # fill in default values for this section sub _fill_defaults ($) { my $self = shift; my $g = $self->{grammar}; my $c = $self->{cfg}; if ($g->{_vars}) { for my $var (@{$g->{_vars}}) { next if exists $c->{$var}; my $value = $g->{$var}{_default} if exists $g->{$var}{_default}; next unless defined $value; $c->{$var} = $value; } } } sub _next_level($$$) { my $self = shift; my $name = shift; # section name if (defined $self->{section}) { $self->{section} .= "/$name"; } else { $self->{section} = $name; } # grammar context my $s = $self->_search_section($name); return 0 unless defined $s; if (not defined $self->{grammar}{$s}) { $self->_make_error("Config::Grammar internal error (no grammar for $s)"); return 0; } push @{$self->{grammar_stack}}, $self->{grammar}; $self->{grammar} = $self->{grammar}{$s}; # support for inherited values # note that we have to do this on the way down # and keep track of which values were inherited # so that we can propagate the values even further # down if needed my %inherited; if ($self->{grammar}{_inherited}) { for my $var (@{$self->{grammar}{_inherited}}) { next unless exists $self->{cfg}{$var}; my $value = $self->{cfg}{$var}; next unless defined $value; next if ref $value; # it's a section $inherited{$var} = $value; } } # config context my $order; if (defined $self->{grammar}{_order}) { if (defined $self->{cfg}{_order_count}) { $order = ++$self->{cfg}{_order_count}; } else { $order = $self->{cfg}{_order_count} = 0; } } if (defined $self->{cfg}{$name}) { $self->_make_error('section or variable already exists'); return 0; } $self->{cfg}{$name} = { %inherited }; # inherit the values push @{$self->{cfg_stack}}, $self->{cfg}; $self->{cfg} = $self->{cfg}{$name}; # keep track of the inherited values here; # we delete it on the way up in _prev_level() $self->{cfg}{_inherited} = \%inherited; # list of already defined variables on this level if (defined $self->{grammar}{_varlist}) { $self->{cfg}{_varlist} = []; } # meta data for _mandatory test $self->{grammar}{_is_section} = 1; $self->{cfg}{_is_section} = 1; $self->{cfg}{_grammar} = $s; $self->{cfg}{_order} = $order if defined $order; # increase level $self->{level}++; return 1; } sub _prev_level($) { my $self = shift; # fill in the values from _default keywords when going up $self->_fill_defaults; # section name if (defined $self->{section}) { if ($self->{section} =~ /\//) { $self->{section} =~ s/\/.*?$//; } else { $self->{section} = undef; } } # clean up the _inherited hash, we won't need it anymore delete $self->{cfg}{_inherited}; # config context $self->{cfg} = pop @{$self->{cfg_stack}}; # grammar context $self->{grammar} = pop @{$self->{grammar_stack}}; # decrease level $self->{level}--; } sub _goto_level($$$) { my $self = shift; my $level = shift; my $name = shift; # _text is multi-line. Check when changing level $self->_check_text($self->{section}) or return 0; if ($level > $self->{level}) { if ($level > $self->{level} + 1) { $self->_make_error("section nesting error"); return 0; } $self->_next_level($name) or return 0; } else { while ($self->{level} > $level) { $self->_prev_level; } if ($level != 0) { $self->_prev_level; $self->_next_level($name) or return 0; } } return 1; } ######### VARIABLES ######### # search grammar definition of a variable sub _search_variable($$) { my $self = shift; my $name = shift; if (not defined $self->{grammar}{_vars}) { $self->_make_error("no variables are allowed"); return undef; } # search exact match for (@{$self->{grammar}{_vars}}) { if ($name eq $_) { return $_; } } # search regular expression for (@{$self->{grammar}{_vars}}) { if (m|^/(.*)/$|) { if ($name =~ /^$1$/) { return $_; } } } # no match $self->_make_error("unknown variable '$name'"); return undef; } sub _set_variable($$$) { my $self = shift; my $key = shift; my $value = shift; my $gn = $self->_search_variable($key); defined $gn or return 0; my $varlistref; if (defined $self->{grammar}{_varlist}) { $varlistref = $self->{cfg}{_varlist}; } if (defined $self->{grammar}{$gn}) { my $g = $self->{grammar}{$gn}; # check regular expression if (defined $g->{_re}) { $value =~ /^$g->{_re}$/ or do { if (defined $g->{_re_error}) { $self->_make_error($g->{_re_error}); } else { $self->_make_error("syntax error in value of '$key'"); } return 0; } } if (defined $g->{_sub}){ my $error = &{$g->{_sub}}($value, $varlistref); if (defined $error){ $self->_make_error($error); return 0; } } } $self->{cfg}{$key} = $value; push @{$varlistref}, $key if ref $varlistref; return 1; } ######### PARSER ######### sub _parse_table($$) { my $self = shift; local $_ = shift; my $g = $self->{grammar}{_table}; defined $g or do { $self->_make_error("table syntax error"); return 0; }; my @l = _quotesplit $_; # check number of columns my $columns = $g->{_columns}; if (defined $columns and $#l + 1 != $columns) { $self->_make_error("row must have $columns columns (has " . ($#l + 1) . ")"); return 0; } # check columns my $n = 0; for my $c (@l) { my $gc = $g->{$n}; defined $gc or next; # regular expression if (defined $gc->{_re}) { $c =~ /^$gc->{_re}$/ or do { if (defined $gc->{_re_error}) { $self->_make_error("column ".($n+1).": $gc->{_re_error}"); } else { $self->_make_error("syntax error in column ".($n+1)); } return 0; }; } if (defined $gc->{_sub}){ my $error = &{$gc->{_sub}}($c); if (defined $error) { $self->_make_error($error); return 0; } } $n++; } # hash (keyed table) if (defined $g->{_key}) { my $kn = $g->{_key}; if ($kn < 0 or $kn > $#l) { $self->_make_error("grammar error: key out of bounds"); } my $k = $l[$kn]; if (defined $self->{cfg}{$k}) { $self->_make_error("table row $k already defined"); return 0; } $self->{cfg}{$k} = \@l; } # list (unkeyed table) else { push @{$self->{cfg}{_table}}, \@l; } return 1; } sub _parse_text($$) { my ($self, $line) = @_; $self->{cfg}{_text} .= $line; return 1; } sub _check_text($$) { my ($self, $name) = @_; my $g = $self->{grammar}{_text}; defined $g or return 1; # chop empty lines at beginning and end if(defined $self->{cfg}{_text}) { $self->{cfg}{_text} =~ s/\A([ \t]*[\n\r]+)*//m; $self->{cfg}{_text} =~ s/^([ \t]*[\n\r]+)*\Z//m; } if (defined $g->{_re}) { $self->{cfg}{_text} =~ /^$g->{_re}$/ or do { if (defined $g->{_re_error}) { $self->_make_error($g->{_re_error}); } else { $self->_make_error("syntax error"); } return 0; } } if (defined $g->{_sub}){ my $error = &{$g->{_sub}}($self->{cfg}{_text}); if (defined $error) { $self->_make_error($error); return 0; } } return 1; } sub _parse_file($$); sub _parse_line($$$) { my $self = shift; local $_ = shift; my $source = shift; /^\@include\s+["']?(.*)["']?$/ and do { my $inc = $1; if ( ( $^O eq 'win32' and $inc !~ m|^(?:[a-z]:)?[/\\]|i and $self->{file} =~ m|^(.+)[\\/][^/]+$| ) or ( $inc !~ m|^/| and $self->{file} =~ m|^(.+)/[^/]+$| ) ){ $inc = "$1/$inc"; } push @{$self->{file_stack}}, $self->{file}; push @{$self->{line_stack}}, $self->{line}; $self->_parse_file($inc) or return 0; $self->{file} = pop @{$self->{file_stack}}; $self->{line} = pop @{$self->{line_stack}}; return 1; }; /^\@define\s+(\S+)\s+(.*)$/ and do { $self->{defines}{$1}=$2; return 1; }; if(defined $self->{defines}) { for my $d (keys %{$self->{defines}}) { s/$d/$self->{defines}{$d}/g; } } /^\*\*\*\s*(.*?)\s*\*\*\*$/ and do { my $name = $1; $self->_goto_level(1, $name) or return 0; $self->_check_section_sub($name) or return 0; return 1; }; /^(\++)\s*(.*)$/ and do { my $level = length $1; my $name = $2; $self->_goto_level($level + 1, $name) or return 0; $self->_check_section_sub($name) or return 0; return 1; }; if (defined $self->{grammar}{_text}) { $self->_parse_text($source) or return 0; return 1; } /^(\S+)\s*=\s*(.*)$/ and do { if (defined $self->{cfg}{$1}) { if (exists $self->{cfg}{_inherited}{$1}) { # it's OK to override any inherited values delete $self->{cfg}{_inherited}{$1}; delete $self->{cfg}{$1}; } else { $self->_make_error('variable already defined'); return 0; } } $self->_set_variable($1, $2) or return 0; return 1; }; $self->_parse_table($_) or return 0; return 1; } sub _check_section_sub($$) { my $self = shift; my $name = shift; my $g = $self->{grammar}; if (defined $g->{_sub}){ my $error = &{$g->{_sub}}($name); if (defined $error){ $self->_make_error($error); return 0; } } return 1; } sub _parse_file($$) { my $self = shift; my $file = shift; unless ($file) { $self->{'err'} = "no filename given" ; return undef;}; my $fh; my $mode = "<"; $mode .= ":encoding($self->{encoding})" if $self->{encoding}; open($fh, $mode, "$file") or do { $self->{'err'} = "can't open $file: $!"; return undef; }; $self->{file} = $file; local $_; my $source = ''; while (<$fh>) { $source .= $_; chomp; s/^\s+//; s/\s+$//; # trim s/\s*#.*$//; # comments next if $_ eq ''; # empty lines while (/\\$/) {# continuation s/\\$//; my $n = <$fh>; last if not defined $n; chomp $n; $n =~ s/^\s+//; $n =~ s/\s+$//; # trim $_ .= ' ' . $n; } $self->{line} = $.; $self->_parse_line($_, $source) or do{ close $fh; return 0; }; $source = ''; } close $fh; return 1; } sub makepod($) { my $pod = eval { require Config::Grammar::Document; return Config::Grammar::Document::makepod(@_); }; defined $pod or die "ERROR: install Config::Grammar::Document in order to use makepod(): $@\n"; return $pod; } sub maketmpl ($@) { my $pod = eval { require Config::Grammar::Document; return Config::Grammar::Document::maketmpl(@_); }; defined $pod or die "ERROR: install Config::Grammar::Document in order to use maketmpl()\n"; return $pod; } sub makemintmpl ($@) { my $pod = eval { require Config::Grammar::Document; return Config::Grammar::Document::makemintmpl(@_); }; defined $pod or die "ERROR: install Config::Grammar::Document in order to use makemintmpl()\n"; return $pod; } sub parse($$$) { my $self = shift; my $file = shift; my $args = shift; $self->{encoding} = $args->{encoding} if ref $args eq 'HASH'; $self->{cfg} = {}; $self->{level} = 0; $self->{cfg_stack} = []; $self->{grammar_stack} = []; $self->{file_stack} = []; $self->{line_stack} = []; $self->_parse_file($file) or return undef; $self->_goto_level(0, undef) or return undef; # fill in the top level values from _default keywords $self->_fill_defaults; $self->_check_mandatory($self->{grammar}, $self->{cfg}, undef) or return undef; return $self->{cfg}; } 1; __END__ =head1 NAME Config::Grammar - A grammar-based, user-friendly config parser =head1 SYNOPSIS use Config::Grammar; my $args = { encoding => 'utf8' }; # the second parameter to parse() is optional my $parser = Config::Grammar->new(\%grammar); my $cfg = $parser->parse('app.cfg', $args) or die "ERROR: $parser->{err}\n"; my $pod = $parser->makepod(); my $ex = $parser->maketmpl('TOP','SubNode'); my $minex = $parser->maketmplmin('TOP','SubNode'); =head1 DESCRIPTION Config::Grammar is a module to parse configuration files. The optional second parameter to the parse() method can be used to specify the file encoding to use for opening the file (see documentation for Perl's use open pragma). The configuration may consist of multiple-level sections with assignments and tabular data. The parsed data will be returned as a hash containing the whole configuration. Config::Grammar uses a grammar that is supplied upon creation of a Config::Grammar object to parse the configuration file and return helpful error messages in case of syntax errors. Using the B method you can generate documentation of the configuration file format. The B method can generate a template configuration file. If your grammar contains regexp matches, the template will not be all that helpful as Config::Grammar is not smart enough to give you sensible template data based in regular expressions. The related function B generates a minimal configuration template without examples, regexps or comments and thus allows an experienced user to fill in the configuration data more efficiently. =head2 Grammar Definition The grammar is a multiple-level hash of hashes, which follows the structure of the configuration. Each section or variable is represented by a hash with the same structure. Each hash contains special keys starting with an underscore such as '_sections', '_vars', '_sub' or '_re' to denote meta data with information about that section or variable. Other keys are used to structure the hash according to the same nesting structure of the configuration itself. The starting hash given as parameter to 'new' contains the "root section". =head3 Special Section Keys =over 12 =item _sections Array containing the list of sub-sections of this section. Each sub-section must then be represented by a sub-hash in this hash with the same name of the sub-section. The sub-section can also be a regular expression denoted by the syntax '/re/', where re is the regular-expression. In case a regular expression is used, a sub-hash named with the same '/re/' must be included in this hash. =item _vars Array containing the list of variables (assignments) in this section. Analogous to sections, regular expressions can be used. =item _mandatory Array containing the list of mandatory sections and variables. =item _inherited Array containing the list of the variables that should be assigned the same value as in the parent section if nothing is specified here. =item _table Hash containing the table grammar (see Special Table Keys). If not specified, no table is allowed in this section. The grammar of the columns if specified by sub-hashes named with the column number. =item _text Section contains free-form text. Only sections and @includes statements will be interpreted, the rest will be added in the returned hash under '_text' as string. B<_text> is a hash reference which can contain a B<_re> and a B<_re_error> key which will be used to scrutanize the text ... if the hash is empty, all text will be accepted. =item _order If defined, a '_order' element will be put in every hash containing the sections with a number that determines the order in which the sections were defined. =item _doc Describes what this section is about =item _sub A function pointer. It is called for every instance of this section, with the real name of the section passed as its first argument. This is probably only useful for the regexp sections. If the function returns a defined value it is assumed that the test was not successful and an error is generated with the returned string as content. =back =head3 Special Variable Keys =over 12 =item _re Regular expression upon which the value will be checked. =item _re_error String containing the returned error in case the regular expression doesn't match (if not specified, a generic 'syntax error' message will be returned). =item _sub A function pointer. It called for every value, with the value passed as its first argument. If the function returns a defined value it is assumed that the test was not successful and an error is generated with the returned string as content. If the '_varlist' key (see above) is defined in this section, the '_sub' function will also receive an array reference as the second argument. The array contains a list of those variables already defined in the same section. This can be used to enforce the order of the variables. =item _default A default value that will be assigned to the variable if none is specified or inherited. =item _doc Description of the variable. =item _example A one line example for the content of this variable. =back =head3 Special Table Keys =over 12 =item _columns Number of columns. If not specified, it will not be enforced. =item _key If defined, the specified column number will be used as key in a hash in the returned hash. If not defined, the returned hash will contain a '_table' element with the contents of the table as array. The rows of the tables are stored as arrays. =item _sub they work analog to the description in the previous section. =item _doc describes the content of the column. =item _example example for the content of this column =back =head3 Special Text Keys =over 12 =item _re Regular expression upon which the text will be checked (everything as a single line). =item _re_error String containing the returned error in case the regular expression doesn't match (if not specified, a generic 'syntax error' message will be returned). =item _sub they work analog to the description in the previous section. =item _doc Ditto. =item _example Potential multi line example for the content of this text section =back =head2 Configuration Syntax =head3 General Syntax '#' denotes a comment up to the end-of-line, empty lines are allowed and space at the beginning and end of lines is trimmed. '\' at the end of the line marks a continued line on the next line. A single space will be inserted between the concatenated lines. '@include filename' is used to include another file. Include works relative to the directory where the parent file is in. '@define a some value' will replace all occurrences of 'a' in the following text with 'some value'. Fields in tables that contain white space can be enclosed in either C<'> or C<">. Whitespace can also be escaped with C<\>. Quotes inside quotes are allowed but must be escaped with a backslash as well. =head3 Sections Config::Grammar supports hierarchical configurations through sections, whose syntax is as follows: =over 15 =item Level 1 *** section name *** =item Level 2 + section name =item Level 3 ++ section name =item Level n, n>1 +..+ section name (number of '+' determines level) =back =head3 Assignments Assignments take the form: 'variable = value', where value can be any string (can contain whitespaces and special characters). The spaces before and after the equal sign are optional. =head3 Tabular Data The data is interpreted as one or more columns separated by spaces. =head2 Example =head3 Code use Data::Dumper; use Config::Grammar; my $RE_IP = '\d+\.\d+\.\d+\.\d+'; my $RE_MAC = '[0-9a-f]{2}(?::[0-9a-f]{2}){5}'; my $RE_HOST = '\S+'; my $parser = Config::Grammar->new({ _sections => [ 'network', 'hosts' ], network => { _vars => [ 'dns' ], _sections => [ "/$RE_IP/" ], dns => { _doc => "address of the dns server", _example => "ns1.oetiker.xs", _re => $RE_HOST, _re_error => 'dns must be an host name or ip address', }, "/$RE_IP/" => { _doc => "Ip Adress", _example => '10.2.3.2', _vars => [ 'netmask', 'gateway' ], netmask => { _doc => "Netmask", _example => "255.255.255.0", _re => $RE_IP, _re_error => 'netmask must be a dotted ip address' }, gateway => { _doc => "Default Gateway address in IP notation", _example => "10.22.12.1", _re => $RE_IP, _re_error => 'gateway must be a dotted ip address' }, }, }, hosts => { _doc => "Details about the hosts", _table => { _doc => "Description of all the Hosts", _key => 0, _columns => 3, 0 => { _doc => "Ethernet Address", _example => "0:3:3:d:a:3:dd:a:cd", _re => $RE_MAC, _re_error => 'first column must be an ethernet mac address', }, 1 => { _doc => "IP Address", _example => "10.11.23.1", _re => $RE_IP, _re_error => 'second column must be a dotted ip address', }, 2 => { _doc => "Host Name", _example => "tardis", }, }, }, }); my $args = { encoding => 'utf8' }; # the second parameter to parse() is optional my $cfg = $parser->parse('test.cfg', $args) or die "ERROR: $parser->{err}\n"; print Dumper($cfg); print $parser->makepod; =head3 Configuration *** network *** dns = 192.168.7.87 + 192.168.7.64 netmask = 255.255.255.192 gateway = 192.168.7.65 *** hosts *** 00:50:fe:bc:65:11 192.168.7.97 plain.hades 00:50:fe:bc:65:12 192.168.7.98 isg.ee.hades 00:50:fe:bc:65:14 192.168.7.99 isg.ee.hades =head3 Result { 'hosts' => { '00:50:fe:bc:65:11' => [ '00:50:fe:bc:65:11', '192.168.7.97', 'plain.hades' ], '00:50:fe:bc:65:12' => [ '00:50:fe:bc:65:12', '192.168.7.98', 'isg.ee.hades' ], '00:50:fe:bc:65:14' => [ '00:50:fe:bc:65:14', '192.168.7.99', 'isg.ee.hades' ] }, 'network' => { '192.168.7.64' => { 'netmask' => '255.255.255.192', 'gateway' => '192.168.7.65' }, 'dns' => '192.168.7.87' } }; =head1 SEE ALSO L =head1 COPYRIGHT Copyright (c) 2000-2005 by ETH Zurich. All rights reserved. Copyright (c) 2007 by David Schweikert. All rights reserved. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHORS David Schweikert, Tobias Oetiker, Niko Tyni =cut # Emacs Configuration # # Local Variables: # mode: cperl # eval: (cperl-set-style "PerlStyle") # mode: flyspell # mode: flyspell-prog # End: # # vi: sw=4 Grammar.pm~100644001750001750 6723613444516770 17233 0ustar00dwsdws000000000000Config-Grammar-1.13/lib/Configpackage Config::Grammar; use strict; $Config::Grammar::VERSION = '1.11'; sub new($$) { my $proto = shift; my $grammar = shift; my $class = ref($proto) || $proto; my $self = {grammar => $grammar}; bless($self, $class); return $self; } sub err($) { my $self = shift; return $self->{'err'}; } sub _make_error($$) { my $self = shift; my $text = shift; $self->{'err'} = "$self->{file}, line $self->{line}: $text"; } sub _peek($) { my $a = shift; return $a->[$#$a]; } sub _quotesplit($) { my $line = shift; my @items; while ($line ne "") { if ($line =~ s/^"((?:\\.|[^"])*)"\s*//) { my $frag = $1; $frag =~ s/\\(.)/$1/g; push @items, $frag; } elsif ($line =~ s/^'((?:\\.|[^'])*)'\s*//) { my $frag = $1; $frag =~ s/\\(.)/$1/g; push @items, $frag; } elsif ($line =~ s/^((?:\\.|[^\s])*)(?:\s+|$)//) { my $frag = $1; $frag =~ s/\\(.)/$1/g; push @items, $frag; } else { die "Internal parser error for '$line'"; } } return @items; } sub _check_mandatory($$$$) { my $self = shift; my $g = shift; my $c = shift; my $section = shift; # check _mandatory sections, variables and tables if (defined $g->{_mandatory}) { for (@{$g->{_mandatory}}) { if (not defined $g->{$_}) { $g->{$_} = {}; } if (not defined $c->{$_}) { if (defined $section) { $self->{'err'} .= "$self->{file} ($section): "; } else { $self->{'err'} = "$self->{file}: "; } if (defined $g->{$_}{_is_section}) { $self->{'err'} .= "mandatory (sub)section '$_' not defined"; } elsif ($_ eq '_table') { $self->{'err'} .= "mandatory table not defined"; } else { $self->{'err'} .= "mandatory variable '$_' not defined"; } return 0; } } } for (keys %$c) { # do some cleanup ref $c->{$_} eq 'HASH' or next; defined $c->{$_}{_is_section} or next; $self->_check_mandatory($g->{$c->{$_}{_grammar}}, $c->{$_}, defined $section ? "$section/$_" : "$_") or return 0; delete $c->{$_}{_is_section}; delete $c->{$_}{_grammar}; delete $c->{$_}{_order_count} if exists $c->{$_}{_order_count}; } return 1; } ######### SECTIONS ######### # search grammar definition of a section sub _search_section($$) { my $self = shift; my $name = shift; if (not defined $self->{grammar}{_sections}) { $self->_make_error("no sections are allowed"); return undef; } # search exact match for (@{$self->{grammar}{_sections}}) { if ($name eq $_) { return $_; } } # search regular expression for (@{$self->{grammar}{_sections}}) { if (m|^/(.*)/$|) { if ($name =~ /^$1$/) { return $_; } } } # no match $self->_make_error("unknown section '$name'"); return undef; } # fill in default values for this section sub _fill_defaults ($) { my $self = shift; my $g = $self->{grammar}; my $c = $self->{cfg}; if ($g->{_vars}) { for my $var (@{$g->{_vars}}) { next if exists $c->{$var}; my $value = $g->{$var}{_default} if exists $g->{$var}{_default}; next unless defined $value; $c->{$var} = $value; } } } sub _next_level($$$) { my $self = shift; my $name = shift; # section name if (defined $self->{section}) { $self->{section} .= "/$name"; } else { $self->{section} = $name; } # grammar context my $s = $self->_search_section($name); return 0 unless defined $s; if (not defined $self->{grammar}{$s}) { $self->_make_error("Config::Grammar internal error (no grammar for $s)"); return 0; } push @{$self->{grammar_stack}}, $self->{grammar}; $self->{grammar} = $self->{grammar}{$s}; # support for inherited values # note that we have to do this on the way down # and keep track of which values were inherited # so that we can propagate the values even further # down if needed my %inherited; if ($self->{grammar}{_inherited}) { for my $var (@{$self->{grammar}{_inherited}}) { next unless exists $self->{cfg}{$var}; my $value = $self->{cfg}{$var}; next unless defined $value; next if ref $value; # it's a section $inherited{$var} = $value; } } # config context my $order; if (defined $self->{grammar}{_order}) { if (defined $self->{cfg}{_order_count}) { $order = ++$self->{cfg}{_order_count}; } else { $order = $self->{cfg}{_order_count} = 0; } } if (defined $self->{cfg}{$name}) { $self->_make_error('section or variable already exists'); return 0; } $self->{cfg}{$name} = { %inherited }; # inherit the values push @{$self->{cfg_stack}}, $self->{cfg}; $self->{cfg} = $self->{cfg}{$name}; # keep track of the inherited values here; # we delete it on the way up in _prev_level() $self->{cfg}{_inherited} = \%inherited; # list of already defined variables on this level if (defined $self->{grammar}{_varlist}) { $self->{cfg}{_varlist} = []; } # meta data for _mandatory test $self->{grammar}{_is_section} = 1; $self->{cfg}{_is_section} = 1; $self->{cfg}{_grammar} = $s; $self->{cfg}{_order} = $order if defined $order; # increase level $self->{level}++; return 1; } sub _prev_level($) { my $self = shift; # fill in the values from _default keywords when going up $self->_fill_defaults; # section name if (defined $self->{section}) { if ($self->{section} =~ /\//) { $self->{section} =~ s/\/.*?$//; } else { $self->{section} = undef; } } # clean up the _inherited hash, we won't need it anymore delete $self->{cfg}{_inherited}; # config context $self->{cfg} = pop @{$self->{cfg_stack}}; # grammar context $self->{grammar} = pop @{$self->{grammar_stack}}; # decrease level $self->{level}--; } sub _goto_level($$$) { my $self = shift; my $level = shift; my $name = shift; # _text is multi-line. Check when changing level $self->_check_text($self->{section}) or return 0; if ($level > $self->{level}) { if ($level > $self->{level} + 1) { $self->_make_error("section nesting error"); return 0; } $self->_next_level($name) or return 0; } else { while ($self->{level} > $level) { $self->_prev_level; } if ($level != 0) { $self->_prev_level; $self->_next_level($name) or return 0; } } return 1; } ######### VARIABLES ######### # search grammar definition of a variable sub _search_variable($$) { my $self = shift; my $name = shift; if (not defined $self->{grammar}{_vars}) { $self->_make_error("no variables are allowed"); return undef; } # search exact match for (@{$self->{grammar}{_vars}}) { if ($name eq $_) { return $_; } } # search regular expression for (@{$self->{grammar}{_vars}}) { if (m|^/(.*)/$|) { if ($name =~ /^$1$/) { return $_; } } } # no match $self->_make_error("unknown variable '$name'"); return undef; } sub _set_variable($$$) { my $self = shift; my $key = shift; my $value = shift; my $gn = $self->_search_variable($key); defined $gn or return 0; my $varlistref; if (defined $self->{grammar}{_varlist}) { $varlistref = $self->{cfg}{_varlist}; } if (defined $self->{grammar}{$gn}) { my $g = $self->{grammar}{$gn}; # check regular expression if (defined $g->{_re}) { $value =~ /^$g->{_re}$/ or do { if (defined $g->{_re_error}) { $self->_make_error($g->{_re_error}); } else { $self->_make_error("syntax error in value of '$key'"); } return 0; } } if (defined $g->{_sub}){ my $error = &{$g->{_sub}}($value, $varlistref); if (defined $error){ $self->_make_error($error); return 0; } } } $self->{cfg}{$key} = $value; push @{$varlistref}, $key if ref $varlistref; return 1; } ######### PARSER ######### sub _parse_table($$) { my $self = shift; local $_ = shift; my $g = $self->{grammar}{_table}; defined $g or do { $self->_make_error("table syntax error"); return 0; }; my @l = _quotesplit $_; # check number of columns my $columns = $g->{_columns}; if (defined $columns and $#l + 1 != $columns) { $self->_make_error("row must have $columns columns (has " . ($#l + 1) . ")"); return 0; } # check columns my $n = 0; for my $c (@l) { my $gc = $g->{$n}; defined $gc or next; # regular expression if (defined $gc->{_re}) { $c =~ /^$gc->{_re}$/ or do { if (defined $gc->{_re_error}) { $self->_make_error("column ".($n+1).": $gc->{_re_error}"); } else { $self->_make_error("syntax error in column ".($n+1)); } return 0; }; } if (defined $gc->{_sub}){ my $error = &{$gc->{_sub}}($c); if (defined $error) { $self->_make_error($error); return 0; } } $n++; } # hash (keyed table) if (defined $g->{_key}) { my $kn = $g->{_key}; if ($kn < 0 or $kn > $#l) { $self->_make_error("grammar error: key out of bounds"); } my $k = $l[$kn]; if (defined $self->{cfg}{$k}) { $self->_make_error("table row $k already defined"); return 0; } $self->{cfg}{$k} = \@l; } # list (unkeyed table) else { push @{$self->{cfg}{_table}}, \@l; } return 1; } sub _parse_text($$) { my ($self, $line) = @_; $self->{cfg}{_text} .= $line; return 1; } sub _check_text($$) { my ($self, $name) = @_; my $g = $self->{grammar}{_text}; defined $g or return 1; # chop empty lines at beginning and end if(defined $self->{cfg}{_text}) { $self->{cfg}{_text} =~ s/\A([ \t]*[\n\r]+)*//m; $self->{cfg}{_text} =~ s/^([ \t]*[\n\r]+)*\Z//m; } if (defined $g->{_re}) { $self->{cfg}{_text} =~ /^$g->{_re}$/ or do { if (defined $g->{_re_error}) { $self->_make_error($g->{_re_error}); } else { $self->_make_error("syntax error"); } return 0; } } if (defined $g->{_sub}){ my $error = &{$g->{_sub}}($self->{cfg}{_text}); if (defined $error) { $self->_make_error($error); return 0; } } return 1; } sub _parse_file($$); sub _parse_line($$$) { my $self = shift; local $_ = shift; my $source = shift; /^\@include\s+["']?(.*)["']?$/ and do { my $inc = $1; if ( ( $^O eq 'win32' and $inc !~ m|^(?:[a-z]:)?[/\\]|i and $self->{file} =~ m|^(.+)[\\/][^/]+$| ) or ( $inc !~ m|^/| and $self->{file} =~ m|^(.+)/[^/]+$| ) ){ $inc = "$1/$inc"; } push @{$self->{file_stack}}, $self->{file}; push @{$self->{line_stack}}, $self->{line}; $self->_parse_file($inc) or return 0; $self->{file} = pop @{$self->{file_stack}}; $self->{line} = pop @{$self->{line_stack}}; return 1; }; /^\@define\s+(\S+)\s+(.*)$/ and do { $self->{defines}{$1}=$2; return 1; }; if(defined $self->{defines}) { for my $d (keys %{$self->{defines}}) { s/$d/$self->{defines}{$d}/g; } } /^\*\*\*\s*(.*?)\s*\*\*\*$/ and do { my $name = $1; $self->_goto_level(1, $name) or return 0; $self->_check_section_sub($name) or return 0; return 1; }; /^(\++)\s*(.*)$/ and do { my $level = length $1; my $name = $2; $self->_goto_level($level + 1, $name) or return 0; $self->_check_section_sub($name) or return 0; return 1; }; if (defined $self->{grammar}{_text}) { $self->_parse_text($source) or return 0; return 1; } /^(\S+)\s*=\s*(.*)$/ and do { if (defined $self->{cfg}{$1}) { if (exists $self->{cfg}{_inherited}{$1}) { # it's OK to override any inherited values delete $self->{cfg}{_inherited}{$1}; delete $self->{cfg}{$1}; } else { $self->_make_error('variable already defined'); return 0; } } $self->_set_variable($1, $2) or return 0; return 1; }; $self->_parse_table($_) or return 0; return 1; } sub _check_section_sub($$) { my $self = shift; my $name = shift; my $g = $self->{grammar}; if (defined $g->{_sub}){ my $error = &{$g->{_sub}}($name); if (defined $error){ $self->_make_error($error); return 0; } } return 1; } sub _parse_file($$) { my $self = shift; my $file = shift; unless ($file) { $self->{'err'} = "no filename given" ; return undef;}; my $fh; my $mode = "<"; $mode .= ":encoding($self->{encoding})" if $self->{encoding}; open($fh, $mode, "$file") or do { $self->{'err'} = "can't open $file: $!"; return undef; }; $self->{file} = $file; local $_; my $source = ''; while (<$fh>) { $source .= $_; chomp; s/^\s+//; s/\s+$//; # trim s/\s*#.*$//; # comments next if $_ eq ''; # empty lines while (/\\$/) {# continuation s/\\$//; my $n = <$fh>; last if not defined $n; chomp $n; $n =~ s/^\s+//; $n =~ s/\s+$//; # trim $_ .= ' ' . $n; } $self->{line} = $.; $self->_parse_line($_, $source) or do{ close $fh; return 0; }; $source = ''; } close $fh; return 1; } sub makepod($) { my $pod = eval { require Config::Grammar::Document; return Config::Grammar::Document::makepod(@_); }; defined $pod or die "ERROR: install Config::Grammar::Document in order to use makepod(): $@\n"; return $pod; } sub maketmpl ($@) { my $pod = eval { require Config::Grammar::Document; return Config::Grammar::Document::maketmpl(@_); }; defined $pod or die "ERROR: install Config::Grammar::Document in order to use maketmpl()\n"; return $pod; } sub makemintmpl ($@) { my $pod = eval { require Config::Grammar::Document; return Config::Grammar::Document::makemintmpl(@_); }; defined $pod or die "ERROR: install Config::Grammar::Document in order to use makemintmpl()\n"; return $pod; } sub parse($$$) { my $self = shift; my $file = shift; my $args = shift; $self->{encoding} = $args->{encoding}; $self->{cfg} = {}; $self->{level} = 0; $self->{cfg_stack} = []; $self->{grammar_stack} = []; $self->{file_stack} = []; $self->{line_stack} = []; $self->_parse_file($file) or return undef; $self->_goto_level(0, undef) or return undef; # fill in the top level values from _default keywords $self->_fill_defaults; $self->_check_mandatory($self->{grammar}, $self->{cfg}, undef) or return undef; return $self->{cfg}; } 1; __END__ =head1 NAME Config::Grammar - A grammar-based, user-friendly config parser =head1 SYNOPSIS use Config::Grammar; my $args = { encoding => 'utf8' }; # the second parameter to parse() is optional my $parser = Config::Grammar->new(\%grammar); my $cfg = $parser->parse('app.cfg', $args) or die "ERROR: $parser->{err}\n"; my $pod = $parser->makepod(); my $ex = $parser->maketmpl('TOP','SubNode'); my $minex = $parser->maketmplmin('TOP','SubNode'); =head1 DESCRIPTION Config::Grammar is a module to parse configuration files. The optional second parameter to the parse() method can be used to specify the file encoding to use for opening the file (see documentation for Perl's use open pragma). The configuration may consist of multiple-level sections with assignments and tabular data. The parsed data will be returned as a hash containing the whole configuration. Config::Grammar uses a grammar that is supplied upon creation of a Config::Grammar object to parse the configuration file and return helpful error messages in case of syntax errors. Using the B method you can generate documentation of the configuration file format. The B method can generate a template configuration file. If your grammar contains regexp matches, the template will not be all that helpful as Config::Grammar is not smart enough to give you sensible template data based in regular expressions. The related function B generates a minimal configuration template without examples, regexps or comments and thus allows an experienced user to fill in the configuration data more efficiently. =head2 Grammar Definition The grammar is a multiple-level hash of hashes, which follows the structure of the configuration. Each section or variable is represented by a hash with the same structure. Each hash contains special keys starting with an underscore such as '_sections', '_vars', '_sub' or '_re' to denote meta data with information about that section or variable. Other keys are used to structure the hash according to the same nesting structure of the configuration itself. The starting hash given as parameter to 'new' contains the "root section". =head3 Special Section Keys =over 12 =item _sections Array containing the list of sub-sections of this section. Each sub-section must then be represented by a sub-hash in this hash with the same name of the sub-section. The sub-section can also be a regular expression denoted by the syntax '/re/', where re is the regular-expression. In case a regular expression is used, a sub-hash named with the same '/re/' must be included in this hash. =item _vars Array containing the list of variables (assignments) in this section. Analogous to sections, regular expressions can be used. =item _mandatory Array containing the list of mandatory sections and variables. =item _inherited Array containing the list of the variables that should be assigned the same value as in the parent section if nothing is specified here. =item _table Hash containing the table grammar (see Special Table Keys). If not specified, no table is allowed in this section. The grammar of the columns if specified by sub-hashes named with the column number. =item _text Section contains free-form text. Only sections and @includes statements will be interpreted, the rest will be added in the returned hash under '_text' as string. B<_text> is a hash reference which can contain a B<_re> and a B<_re_error> key which will be used to scrutanize the text ... if the hash is empty, all text will be accepted. =item _order If defined, a '_order' element will be put in every hash containing the sections with a number that determines the order in which the sections were defined. =item _doc Describes what this section is about =item _sub A function pointer. It is called for every instance of this section, with the real name of the section passed as its first argument. This is probably only useful for the regexp sections. If the function returns a defined value it is assumed that the test was not successful and an error is generated with the returned string as content. =back =head3 Special Variable Keys =over 12 =item _re Regular expression upon which the value will be checked. =item _re_error String containing the returned error in case the regular expression doesn't match (if not specified, a generic 'syntax error' message will be returned). =item _sub A function pointer. It called for every value, with the value passed as its first argument. If the function returns a defined value it is assumed that the test was not successful and an error is generated with the returned string as content. If the '_varlist' key (see above) is defined in this section, the '_sub' function will also receive an array reference as the second argument. The array contains a list of those variables already defined in the same section. This can be used to enforce the order of the variables. =item _default A default value that will be assigned to the variable if none is specified or inherited. =item _doc Description of the variable. =item _example A one line example for the content of this variable. =back =head3 Special Table Keys =over 12 =item _columns Number of columns. If not specified, it will not be enforced. =item _key If defined, the specified column number will be used as key in a hash in the returned hash. If not defined, the returned hash will contain a '_table' element with the contents of the table as array. The rows of the tables are stored as arrays. =item _sub they work analog to the description in the previous section. =item _doc describes the content of the column. =item _example example for the content of this column =back =head3 Special Text Keys =over 12 =item _re Regular expression upon which the text will be checked (everything as a single line). =item _re_error String containing the returned error in case the regular expression doesn't match (if not specified, a generic 'syntax error' message will be returned). =item _sub they work analog to the description in the previous section. =item _doc Ditto. =item _example Potential multi line example for the content of this text section =back =head2 Configuration Syntax =head3 General Syntax '#' denotes a comment up to the end-of-line, empty lines are allowed and space at the beginning and end of lines is trimmed. '\' at the end of the line marks a continued line on the next line. A single space will be inserted between the concatenated lines. '@include filename' is used to include another file. Include works relative to the directory where the parent file is in. '@define a some value' will replace all occurrences of 'a' in the following text with 'some value'. Fields in tables that contain white space can be enclosed in either C<'> or C<">. Whitespace can also be escaped with C<\>. Quotes inside quotes are allowed but must be escaped with a backslash as well. =head3 Sections Config::Grammar supports hierarchical configurations through sections, whose syntax is as follows: =over 15 =item Level 1 *** section name *** =item Level 2 + section name =item Level 3 ++ section name =item Level n, n>1 +..+ section name (number of '+' determines level) =back =head3 Assignments Assignements take the form: 'variable = value', where value can be any string (can contain whitespaces and special characters). The spaces before and after the equal sign are optional. =head3 Tabular Data The data is interpreted as one or more columns separated by spaces. =head2 Example =head3 Code use Data::Dumper; use Config::Grammar; my $RE_IP = '\d+\.\d+\.\d+\.\d+'; my $RE_MAC = '[0-9a-f]{2}(?::[0-9a-f]{2}){5}'; my $RE_HOST = '\S+'; my $parser = Config::Grammar->new({ _sections => [ 'network', 'hosts' ], network => { _vars => [ 'dns' ], _sections => [ "/$RE_IP/" ], dns => { _doc => "address of the dns server", _example => "ns1.oetiker.xs", _re => $RE_HOST, _re_error => 'dns must be an host name or ip address', }, "/$RE_IP/" => { _doc => "Ip Adress", _example => '10.2.3.2', _vars => [ 'netmask', 'gateway' ], netmask => { _doc => "Netmask", _example => "255.255.255.0", _re => $RE_IP, _re_error => 'netmask must be a dotted ip address' }, gateway => { _doc => "Default Gateway address in IP notation", _example => "10.22.12.1", _re => $RE_IP, _re_error => 'gateway must be a dotted ip address' }, }, }, hosts => { _doc => "Details about the hosts", _table => { _doc => "Description of all the Hosts", _key => 0, _columns => 3, 0 => { _doc => "Ethernet Address", _example => "0:3:3:d:a:3:dd:a:cd", _re => $RE_MAC, _re_error => 'first column must be an ethernet mac address', }, 1 => { _doc => "IP Address", _example => "10.11.23.1", _re => $RE_IP, _re_error => 'second column must be a dotted ip address', }, 2 => { _doc => "Host Name", _example => "tardis", }, }, }, }); my $args = { encoding => 'utf8' }; # the second parameter to parse() is optional my $cfg = $parser->parse('test.cfg', $args) or die "ERROR: $parser->{err}\n"; print Dumper($cfg); print $parser->makepod; =head3 Configuration *** network *** dns = 192.168.7.87 + 192.168.7.64 netmask = 255.255.255.192 gateway = 192.168.7.65 *** hosts *** 00:50:fe:bc:65:11 192.168.7.97 plain.hades 00:50:fe:bc:65:12 192.168.7.98 isg.ee.hades 00:50:fe:bc:65:14 192.168.7.99 isg.ee.hades =head3 Result { 'hosts' => { '00:50:fe:bc:65:11' => [ '00:50:fe:bc:65:11', '192.168.7.97', 'plain.hades' ], '00:50:fe:bc:65:12' => [ '00:50:fe:bc:65:12', '192.168.7.98', 'isg.ee.hades' ], '00:50:fe:bc:65:14' => [ '00:50:fe:bc:65:14', '192.168.7.99', 'isg.ee.hades' ] }, 'network' => { '192.168.7.64' => { 'netmask' => '255.255.255.192', 'gateway' => '192.168.7.65' }, 'dns' => '192.168.7.87' } }; =head1 SEE ALSO L =head1 COPYRIGHT Copyright (c) 2000-2005 by ETH Zurich. All rights reserved. Copyright (c) 2007 by David Schweikert. All rights reserved. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHORS David Schweikert, Tobias Oetiker, Niko Tyni =cut # Emacs Configuration # # Local Variables: # mode: cperl # eval: (cperl-set-style "PerlStyle") # mode: flyspell # mode: flyspell-prog # End: # # vi: sw=4 Grammar000755001750001750 013444516770 16301 5ustar00dwsdws000000000000Config-Grammar-1.13/lib/ConfigDynamic.pm100644001750001750 4167613444516770 20421 0ustar00dwsdws000000000000Config-Grammar-1.13/lib/Config/Grammarpackage Config::Grammar::Dynamic; use strict; use Config::Grammar; use base qw(Config::Grammar); $Config::Grammar::Dynamic::VERSION = $Config::Grammar::VERSION; sub _deepcopy { # this handles circular references on consecutive levels, # but breaks if there are any levels in between # the makepod() and maketmpl() methods have the same limitation my $what = shift; return $what unless ref $what; for (ref $what) { /^ARRAY$/ and return [ map { $_ eq $what ? $_ : _deepcopy($_) } @$what ]; /^HASH$/ and return { map { $_ => $what->{$_} eq $what ? $what->{$_} : _deepcopy($what->{$_}) } keys %$what }; /^CODE$/ and return $what; # we don't need to copy the subs /^Regexp$/ and return $what; # neither Regexp objects } die "Cannot _deepcopy reference type @{[ref $what]}"; } sub _next_level($$$) { my $self = shift; my $name = shift; # section name if (defined $self->{section}) { $self->{section} .= "/$name"; } else { $self->{section} = $name; } # grammar context my $s = $self->_search_section($name); return 0 unless defined $s; if (not defined $self->{grammar}{$s}) { $self->_make_error("Config::Grammar internal error (no grammar for $s)"); return 0; } push @{$self->{grammar_stack}}, $self->{grammar}; if ($s =~ m|^/(.*)/$|) { # for sections specified by a regexp, we create # a new branch with a deep copy of the section # grammar so that any _dyn sub further below will edit # just this branch $self->{grammar}{$name} = _deepcopy($self->{grammar}{$s}); # put it at the head of the section list $self->{grammar}{_sections} ||= []; unshift @{$self->{grammar}{_sections}}, $name; } # support for recursive sections # copy the section syntax to the subsection if ($self->{grammar}{_recursive} and grep { $_ eq $s } @{$self->{grammar}{_recursive}}) { $self->{grammar}{$name}{_sections} ||= []; $self->{grammar}{$name}{_recursive} ||= []; push @{$self->{grammar}{$name}{_sections}}, $s; push @{$self->{grammar}{$name}{_recursive}}, $s; my $grammarcopy = _deepcopy($self->{grammar}{$name}); if (exists $self->{grammar}{$name}{$s}) { # there's syntax for a variable by the same name too # make sure we don't lose it %{$self->{grammar}{$name}{$s}} = ( %$grammarcopy, %{$self->{grammar}{$name}{$s}} ); } else { $self->{grammar}{$name}{$s} = $grammarcopy; } } # this uses the copy created above for regexp sections # and the original for non-regexp sections (where $s == $name) $self->{grammar} = $self->{grammar}{$name}; # support for inherited values # note that we have to do this on the way down # and keep track of which values were inherited # so that we can propagate the values even further # down if needed my %inherited; if ($self->{grammar}{_inherited}) { for my $var (@{$self->{grammar}{_inherited}}) { next unless exists $self->{cfg}{$var}; my $value = $self->{cfg}{$var}; next unless defined $value; next if ref $value; # it's a section $inherited{$var} = $value; } } # config context my $order; if (defined $self->{grammar}{_order}) { if (defined $self->{cfg}{_order_count}) { $order = ++$self->{cfg}{_order_count}; } else { $order = $self->{cfg}{_order_count} = 0; } } if (defined $self->{cfg}{$name}) { $self->_make_error('section or variable already exists'); return 0; } $self->{cfg}{$name} = { %inherited }; # inherit the values push @{$self->{cfg_stack}}, $self->{cfg}; $self->{cfg} = $self->{cfg}{$name}; # keep track of the inherited values here; # we delete it on the way up in _prev_level() $self->{cfg}{_inherited} = \%inherited; # list of already defined variables on this level if (defined $self->{grammar}{_varlist}) { $self->{cfg}{_varlist} = []; } # meta data for _mandatory test $self->{grammar}{_is_section} = 1; $self->{cfg}{_is_section} = 1; # this uses the copy created above for regexp sections # and the original for non-regexp sections (where $s == $name) $self->{cfg}{_grammar} = $name; $self->{cfg}{_order} = $order if defined $order; # increase level $self->{level}++; # if there's a _dyn sub, apply it if (defined $self->{grammar}{_dyn}) { &{$self->{grammar}{_dyn}}($s, $name, $self->{grammar}); } return 1; } # find variables in old grammar list 'listname' # that aren't in the corresponding list in the new grammar # and list them as a POD document, possibly with a callback # function 'docfunc' sub _findmissing($$$;$) { my $old = shift; my $new = shift; my $listname = shift; my $docfunc = shift; my @doc; if ($old->{$listname}) { my %newlist; if ($new->{$listname}) { @newlist{@{$new->{$listname}}} = undef; } for my $v (@{$old->{$listname}}) { next if exists $newlist{$v}; if ($docfunc) { push @doc, &$docfunc($old, $v) } else { push @doc, "=item $v"; } } } return @doc; } # find variables in new grammar list 'listname' # that aren't in the corresponding list in the new grammar # # this is just _findmissing with the arguments swapped sub _findnew($$$;$) { my $old = shift; my $new = shift; my $listname = shift; my $docfunc = shift; return _findmissing($new, $old, $listname, $docfunc); } # compare two lists for element equality sub _listseq($$); sub _listseq($$) { my ($k, $l) = @_; my $length = @$k; return 0 unless @$l == $length; for (my $i=0; $i<$length; $i++) { return 0 unless $k->[$i] eq $l->[$i]; } return 1; } # diff two grammar trees, documenting the differences sub _diffgrammars($$); sub _diffgrammars($$) { my $old = shift; my $new = shift; my @doc; my @vdoc; @vdoc = _findmissing($old, $new, '_vars'); push @doc, "The following variables are not valid anymore:", "=over" , @vdoc, "=back" if @vdoc; @vdoc = _findnew($old, $new, '_vars', \&_describevar); push @doc, "The following new variables are valid:", "=over" , @vdoc, "=back" if @vdoc; @vdoc = _findmissing($old, $new, '_sections'); push @doc, "The following subsections are not valid anymore:", "=over" , @vdoc, "=back" if @vdoc; @vdoc = _findnew($old, $new, '_sections', sub { my ($tree, $sec) = @_; my @tdoc; _genpod($tree->{$sec}, 0, \@tdoc); return @tdoc; }); push @doc, "The following new subsections are defined:", "=over" , @vdoc, "=back" if @vdoc; for (@{$old->{_sections}}) { next unless exists $new->{$_}; @vdoc = _diffgrammars($old->{$_}, $new->{$_}); push @doc, "Syntax changes for subsection B<$_>", "=over", @vdoc, "=back" if @vdoc; } return @doc; } sub _describevar { my $tree = shift; my $var = shift; my $mandatory = ( $tree->{_mandatory} and grep {$_ eq $var} @{$tree->{_mandatory}} ) ? " I<(mandatory setting)>" : ""; my @doc; push @doc, "=item B<$var>".$mandatory; push @doc, $tree->{$var}{_doc} if $tree->{$var}{_doc} ; my $inherited = ( $tree->{_inherited} and grep {$_ eq $var} @{$tree->{_inherited}}); push @doc, "This variable I its value from the parent section if nothing is specified here." if $inherited; push @doc, "This variable I modifies the grammar based on its value." if $tree->{$var}{_dyn}; push @doc, "Default value: $var = $tree->{$var}{_default}" if ($tree->{$var}{_default}); push @doc, "Example: $var = $tree->{$var}{_example}" if ($tree->{$var}{_example}); return @doc; } sub _genpod($$$); sub _genpod($$$) { my ($tree, $level, $doc) = @_; my %dyndoc; if ($tree->{_vars}){ push @{$doc}, "The following variables can be set in this section:"; push @{$doc}, "=over"; foreach my $var (@{$tree->{_vars}}){ push @{$doc}, _describevar($tree, $var); } push @{$doc}, "=back"; } if ($tree->{_text}){ push @{$doc}, ($tree->{_text}{_doc} or "Unspecified Text content"); if ($tree->{_text}{_example}){ my $ex = $tree->{_text}{_example}; chomp $ex; $ex = map {" $_"} split /\n/, $ex; push @{$doc}, "Example:\n\n$ex\n"; } } if ($tree->{_table}){ push @{$doc}, ($tree->{_table}{_doc} or "This section can contain a table ". "with the following structure:" ); push @{$doc}, "=over"; for (my $i=0;$i < $tree->{_table}{_columns}; $i++){ push @{$doc}, "=item column $i"; push @{$doc}, ($tree->{_table}{$i}{_doc} or "Unspecific Content"); push @{$doc}, "Example: $tree->{_table}{$i}{_example}" if ($tree->{_table}{$i}{_example}) } push @{$doc}, "=back"; } if ($tree->{_sections}){ if ($level > 0) { push @{$doc}, "The following sections are valid on level $level:"; push @{$doc}, "=over"; } foreach my $section (@{$tree->{_sections}}){ my $mandatory = ( $tree->{_mandatory} and grep {$_ eq $section} @{$tree->{_mandatory}} ) ? " I<(mandatory section)>" : ""; push @{$doc}, ($level > 0) ? "=item B<".("+" x $level)."$section>$mandatory" : "=head2 *** $section ***$mandatory"; if ($tree eq $tree->{$section}) { push @{$doc}, "This subsection has the same syntax as its parent."; next; } push @{$doc}, ($tree->{$section}{_doc}) if $tree->{$section}{_doc}; push @{$doc}, "The grammar of this section is I modified based on its name." if $tree->{$section}{_dyn}; if ($tree->{_recursive} and grep {$_ eq $section} @{$tree->{_recursive}}) { push @{$doc}, "This section is I: it can contain subsection(s) with the same syntax."; } _genpod ($tree->{$section},$level+1,$doc); next unless $tree->{$section}{_dyn} and $tree->{$section}{_dyndoc}; push @{$doc}, "Dynamical grammar changes for example instances of this section:"; push @{$doc}, "=over"; for my $name (sort keys %{$tree->{$section}{_dyndoc}}) { my $newtree = _deepcopy($tree->{$section}); push @{$doc}, "=item B<$name>: $tree->{$section}{_dyndoc}{$name}"; &{$tree->{$section}{_dyn}}($section, $name, $newtree); my @tdoc = _diffgrammars($tree->{$section}, $newtree); if (@tdoc) { push @{$doc}, @tdoc; } else { push @{$doc}, "No changes that can be automatically described."; } push @{$doc}, "(End of dynamical grammar changes for example instance C<$name>.)"; } push @{$doc}, "=back"; push @{$doc}, "(End of dynamical grammar changes for example instances of section C<$section>.)"; } push @{$doc}, "=back" if $level > 0 } if ($tree->{_vars}) { for my $var (@{$tree->{_vars}}) { next unless $tree->{$var}{_dyn} and $tree->{$var}{_dyndoc}; push @{$doc}, "Dynamical grammar changes for example values of variable C<$var>:"; push @{$doc}, "=over"; for my $val (sort keys %{$tree->{$var}{_dyndoc}}) { my $newtree = _deepcopy($tree); push @{$doc}, "=item B<$val>: $tree->{$var}{_dyndoc}{$val}"; &{$tree->{$var}{_dyn}}($var, $val, $newtree); my @tdoc = _diffgrammars($tree, $newtree); if (@tdoc) { push @{$doc}, @tdoc; } else { push @{$doc}, "No changes that can be automatically described."; } push @{$doc}, "(End of dynamical grammar changes for variable C<$var> example value C<$val>.)"; } push @{$doc}, "=back"; push @{$doc}, "(End of dynamical grammar changes for example values of variable C<$var>.)"; } } }; sub makepod($) { my $self = shift; my $tree = $self->{grammar}; my @doc; _genpod($tree,0,\@doc); return join("\n\n", @doc)."\n"; } sub _set_variable($$$) { my $self = shift; my $key = shift; my $value = shift; my $gn = $self->_search_variable($key); defined $gn or return 0; my $varlistref; if (defined $self->{grammar}{_varlist}) { $varlistref = $self->{cfg}{_varlist}; } if (defined $self->{grammar}{$gn}) { my $g = $self->{grammar}{$gn}; # check regular expression if (defined $g->{_re}) { $value =~ /^$g->{_re}$/ or do { if (defined $g->{_re_error}) { $self->_make_error($g->{_re_error}); } else { $self->_make_error("syntax error in value of '$key'"); } return 0; } } if (defined $g->{_sub}){ my $error = &{$g->{_sub}}($value, $varlistref); if (defined $error){ $self->_make_error($error); return 0; } } # if there's a _dyn sub, apply it if (defined $g->{_dyn}) { &{$g->{_dyn}}($key, $value, $self->{grammar}); } } $self->{cfg}{$key} = $value; push @{$varlistref}, $key if ref $varlistref; return 1; } sub parse($$) { my $self = shift; my $file = shift; my $args = shift; $self->{encoding} = $args->{encoding} if ref $args eq 'HASH'; $self->{cfg} = {}; $self->{level} = 0; $self->{cfg_stack} = []; $self->{grammar_stack} = []; $self->{file_stack} = []; $self->{line_stack} = []; # we work with a copy of the grammar so the _dyn subs may change it local $self->{grammar} = _deepcopy($self->{grammar}); $self->_parse_file($file) or return undef; $self->_goto_level(0, undef) or return undef; # fill in the top level values from _default keywords $self->_fill_defaults; $self->_check_mandatory($self->{grammar}, $self->{cfg}, undef) or return undef; return $self->{cfg}; } =head1 NAME Config::Grammar::Dynamic - A grammar-based, user-friendly config parser =head1 DESCRIPTION Config::Grammar::Dynamic is like Config::Grammar but with some additional features useful for building configuration grammars that are dynamic, i.e. where the syntax changes according to configuration entries in the same file. The following keys can be additionally specified in the grammar when using this module: =head2 Special Section Keys =over 12 =item _dyn A subroutine reference (function pointer) that will be called when a new section of this syntax is encountered. The subroutine will get three arguments: the syntax of the section name (string or regexp), the actual name encountered (this will be the same as the first argument for non-regexp sections) and a reference to the grammar tree of the section. This subroutine can then modify the grammar tree dynamically. =item _dyndoc A hash reference that lists interesting names for the section that should be documented. The keys of the hash are the names and the values in the hash are strings that can contain an explanation for the name. The _dyn() subroutine is then called for each of these names and the differences of the resulting grammar and the original one are documented. This module can currently document differences in the _vars list, listing new variables and removed ones, and differences in the _sections list, listing the new and removed sections. =item _recursive Array containing the list of those sub-sections that are I, ie. that can contain a new sub-section with the same syntax as themselves. The same effect can be accomplished with circular references in the grammar tree or a suitable B<_dyn> section subroutine (see below}, so this facility is included just for convenience. =back =head2 Special Variable Keys =over 12 =item _dyn A subroutine reference (function pointer) that will be called when the variable is assigned some value in the config file. The subroutine will get three arguments: the name of the variable, the value assigned and a reference to the grammar tree of this section. This subroutine can then modify the grammar tree dynamically. Note that no _dyn() call is made for default and inherited values of the variable. =item _dyndoc A hash reference that lists interesting values for the variable that should be documented. The keys of the hash are the values and the values in the hash are strings that can contain an explanation for the value. The _dyn() subroutine is then called for each of these values and the differences of the resulting grammar and the original one are documented. This module can currently document differences in the _vars list, listing new variables and removed ones, and differences in the _sections list, listing the new and removed sections. =back =head1 COPYRIGHT Copyright (c) 2000-2005 by ETH Zurich. All rights reserved. Copyright (c) 2007 by David Schweikert. All rights reserved. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHORS David Schweikert, Tobias Oetiker, Niko Tyni =cut # Emacs Configuration # # Local Variables: # mode: cperl # eval: (cperl-set-style "PerlStyle") # mode: flyspell # mode: flyspell-prog # End: # # vi: sw=4 Document.pm100644001750001750 1434513444516770 20604 0ustar00dwsdws000000000000Config-Grammar-1.13/lib/Config/Grammarpackage Config::Grammar::Document; # This is a helper class for Config::Grammar implementing the logic # of its documentation-generating methods. # # This code is placed here instead of Config::Grammar in order to make # the main module leaner. These methods are only used in special cases. # Note that the installation of this module is optional: if you don't install # it, the make...() methods just won't work. sub _describevar { my $tree = shift; my $var = shift; my $mandatory = ( $tree->{_mandatory} and grep {$_ eq $var} @{$tree->{_mandatory}} ) ? " I<(mandatory setting)>" : ""; my @doc; push @doc, "=item B<$var>".$mandatory; push @doc, $tree->{$var}{_doc} if $tree->{$var}{_doc} ; my $inherited = ( $tree->{_inherited} and grep {$_ eq $var} @{$tree->{_inherited}}); push @doc, "This variable I its value from the parent section if nothing is specified here." if $inherited; push @doc, "Default value: $var = $tree->{$var}{_default}" if ($tree->{$var}{_default}); push @doc, "Example: $var = $tree->{$var}{_example}" if ($tree->{$var}{_example}); return @doc; } sub _genpod($$$); sub _genpod($$$) { my ($tree, $level, $doc) = @_; if ($tree->{_vars}){ push @{$doc}, "The following variables can be set in this section:"; push @{$doc}, "=over"; foreach my $var (@{$tree->{_vars}}){ push @{$doc}, _describevar($tree, $var); } push @{$doc}, "=back"; } if ($tree->{_text}){ push @{$doc}, ($tree->{_text}{_doc} or "Unspecified Text content"); if ($tree->{_text}{_example}){ my $ex = $tree->{_text}{_example}; chomp $ex; $ex = map {" $_"} split /\n/, $ex; push @{$doc}, "Example:\n\n$ex\n"; } } if ($tree->{_table}){ push @{$doc}, ($tree->{_table}{_doc} or "This section can contain a table ". "with the following structure:" ); push @{$doc}, "=over"; for (my $i=0;$i < $tree->{_table}{_columns}; $i++){ push @{$doc}, "=item column $i"; push @{$doc}, ($tree->{_table}{$i}{_doc} or "Unspecific Content"); push @{$doc}, "Example: $tree->{_table}{$i}{_example}" if ($tree->{_table}{$i}{_example}) } push @{$doc}, "=back"; } if ($tree->{_sections}){ if ($level > 0) { push @{$doc}, "The following sections are valid on level $level:"; push @{$doc}, "=over"; } foreach my $section (@{$tree->{_sections}}){ my $mandatory = ( $tree->{_mandatory} and grep {$_ eq $section} @{$tree->{_mandatory}} ) ? " I<(mandatory section)>" : ""; push @{$doc}, ($level > 0) ? "=item B<".("+" x $level)."$section>$mandatory" : "=head2 *** $section ***$mandatory"; if ($tree eq $tree->{$section}) { push @{$doc}, "This subsection has the same syntax as its parent."; next; } push @{$doc}, ($tree->{$section}{_doc}) if $tree->{$section}{_doc}; _genpod($tree->{$section},$level+1,$doc); } push @{$doc}, "=back" if $level > 0 } }; sub makepod($) { my $self = shift; my $tree = $self->{grammar}; my @doc; _genpod($tree,0,\@doc); return join("\n\n", @doc)."\n"; } sub _gentmpl($$$@); sub _gentmpl($$$@){ my $tree = shift; my $complete = shift; my $level = shift; my $doc = shift; my @start = @_; if (scalar @start ) { my $section = shift @start; my $secex =''; my $prefix = ''; $prefix = "# " unless $tree->{_mandatory} and grep {$_ eq $section} @{$tree->{_mandatory}}; if ($tree->{$section}{_example}) { $secex = " # ( ex. $tree->{$section}{_example} )"; } if($complete) { push @{$doc}, $prefix. (($level > 0) ? ("+" x $level)."$section" : "*** $section ***").$secex; } else { my $minsection=$section =~ m|^/| ? "" : $section; push @{$doc},(($level > 0) ? ("+" x $level)."$minsection" : "*** $minsection ***"); } my $match; foreach my $s (@{$tree->{_sections}}){ if ($s =~ m|^/.+/$| and $section =~ /$s/ or $s eq $section) { _gentmpl ($tree->{$s},$complete,$level+1,$doc,@start) unless $tree eq $tree->{$s}; $match = 1; } } push @{$doc}, "# Section $section is not a valid choice" unless $match; } else { if ($tree->{_vars}){ foreach my $var (@{$tree->{_vars}}){ my $mandatory= ($tree->{_mandatory} and grep {$_ eq $var} @{$tree->{_mandatory}}); if($complete) { push @{$doc}, "# $var = ". ($tree->{$var}{_example} || ' * no example *'); push @{$doc}, "$var=" if $mandatory; } else { push @{$doc}, ($mandatory?"":"# ")."$var="; next unless $tree->{_mandatory} and grep {$_ eq $var} @{$tree->{_mandatory}}; } } } if ($tree->{_text} and $complete){ if ($tree->{_text}{_example}){ my $ex = $tree->{_text}{_example}; chomp $ex; $ex = map {"# $_"} split /\n/, $ex; push @{$doc}, "$ex\n"; } } if ($tree->{_table} and $complete){ my $table = "# table\n#"; for (my $i=0;$i < $tree->{_table}{_columns}; $i++){ $table .= ' "'.($tree->{_table}{$i}{_example} || "C$i").'"'; } push @{$doc}, $table; } if ($tree->{_sections}){ foreach my $section (@{$tree->{_sections}}){ my $opt = ""; unless( $tree->{_mandatory} and grep {$_ eq $section} @{$tree->{_mandatory}} ) { $opt="\n# optional section\n" if $complete; } my $prefix = ''; $prefix = "# " unless $tree->{_mandatory} and grep {$_ eq $section} @{$tree->{_mandatory}}; my $secex =""; if ($section =~ m|^/.+/$| && $tree->{$section}{_example}) { $secex = " # ( ex. $tree->{$section}{_example} )" if $complete; } if($complete) { push @{$doc}, $prefix. (($level > 0) ? ("+" x $level)."$section" : "*** $section ***"). $secex; } else { my $minsection=$section =~ m|^/| ? "" : $section; push @{$doc},(($level > 0) ? ("+" x $level)."$minsection" : "*** $minsection ***"); } _gentmpl ($tree->{$section},$complete,$level+1,$doc,@start) unless $tree eq $tree->{$section}; } } } }; sub maketmpl ($@) { my $self = shift; my @start = @_; my $tree = $self->{grammar}; my @tmpl; _gentmpl $tree,1,0,\@tmpl,@start; return join("\n", @tmpl)."\n"; } sub makemintmpl ($@) { my $self = shift; my @start = @_; my $tree = $self->{grammar}; my @tmpl; _gentmpl $tree,0,0,\@tmpl,@start; return join("\n", @tmpl)."\n"; } 1;