Config-Scoped-0.22000755004006000346 011727425565 14665 5ustar00gaissmaikizinfra000000000000Config-Scoped-0.22/Changes000444004006000346 473611727425565 16327 0ustar00gaissmaikizinfra0000000000000.22 -- Mon, 12 Mar 2012 13:42:19 +0100 - only pod tweaks 0.21 -- Sat, 04 Feb 2012 17:54:24 +0100 - minor doc tweaks, minor pod typos 0.20 -- Fri, 03 Feb 2012 21:10:36 +0100 - cpantesters reported problems since R::RD 1.967003 - took the chance to rewrite without precompiled grammar and patched P::RD 0.13 -- Thu Dec 3 10:46:09 MET 2009 - POD now written by a native speaker, thanks Steven! - only documentation changes 0.12_03 -- Wed Dec 2 11:24:07 MET 2009 - still wrestling with make dist 0.12_02 -- Tue Dec 1 12:00:34 MET 2009 - fix wrong MANIFEST and dist 0.12_01 -- Fri Nov 27 14:50:53 MET 2009 - only documentation changes - POD now written by a native speaker, thanks Steven! 0.12 -- Mi 9. Apr 22:48:49 CEST 2008 - version upgrade from developer to working release 0.11_03 -- Mi 9. Apr 01:10:56 CEST 2008 - fix version in precompiled grammar 0.11_02 -- Mi 9. Apr 00:52:04 CEST 2008 - grml, Makefile.PL missing in dist, wrong MANIFEST.SKIP 0.11_01 -- Di 8. Apr 18:38:43 CEST 2008 - fix version requirement for Parse::RecDescent - fix meta-character in macro expansion - no interface changes 0.11 -- Sun Aug 8 23:35:23 CEST 2004 - collapsed localization statements in the grammar file where possible - some minor interface changes - some minor pod changes - added test for parsing perl datastructures 0.10 -- Thu Aug 5 09:52:48 CEST 2004 - precompile dependencies revisited, no new features 0.09 -- Thu Aug 4 14:19:55 CEST 2004 - again Makefile.PL munging and version information in precompiled package, no new features, just distribution fiddling 0.08 -- Wed Aug 4 11:57:07 CEST 2004 - new P::RD->Precompile patch in order to stuff a VERSION into the precompiled package. - new P::RD->Precompile patch in order to stuff some POD into the precompiled package. 0.07 -- Tue Aug 3 21:30:50 CEST 2004 - new() must be called with a Class name and not with a ref. See Merlyn's fight againt this 0.06 -- Tue Aug 3 20:38:57 CEST 2004 - arrgh, typo in SYNOPSYS. - Version synchronize with Precomp.pm - import override for Parse::RecDescent 0.05 -- Mon Aug 2 17:09:56 CEST 2004 allow lowercase conversion for parameters and declarations 0.04 -- Mon Aug 2 12:58:11 CEST 2004 test problem's with tar and patched P::RD on Win32 solved 0.03 -- Sun Aug 1 21:32:34 CEST 2004 Macro's expand now in eval blocks unconditionally 0.02 -- Sun Aug 1 15:23:27 CEST 2004 solved problems with permissions and file paths on Win32 0.01 -- Sat Jul 31 22:40:16 CEST 2004 Initial release uploaded to CPAN Config-Scoped-0.22/META.yml000444004006000346 256711727425565 16305 0ustar00gaissmaikizinfra000000000000--- abstract: 'feature rich configuration file parser' author: - 'Karl Gaissmaier ' build_requires: Module::Build: 0 Test::More: 0 configure_requires: Module::Build: 0 generated_by: 'Module::Build version 0.3607' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Config-Scoped provides: Config::Scoped: file: lib/Config/Scoped.pm version: 0.22 Config::Scoped::Error: file: lib/Config/Scoped/Error.pm version: 0.22 Config::Scoped::Error::IO: file: lib/Config/Scoped/Error.pm version: 0.22 Config::Scoped::Error::Parse: file: lib/Config/Scoped/Error.pm version: 0.22 Config::Scoped::Error::Validate: file: lib/Config/Scoped/Error.pm version: 0.22 Config::Scoped::Error::Validate::Declaration: file: lib/Config/Scoped/Error.pm version: 0.22 Config::Scoped::Error::Validate::Macro: file: lib/Config/Scoped/Error.pm version: 0.22 Config::Scoped::Error::Validate::Parameter: file: lib/Config/Scoped/Error.pm version: 0.22 Config::Scoped::Error::Validate::Permissions: file: lib/Config/Scoped/Error.pm version: 0.22 requires: Carp: 0 Digest::MD5: 0 Error: 0 File::Basename: 0 File::Spec: 0 Parse::RecDescent: 1.94 Safe: 0 Storable: 0 resources: license: http://dev.perl.org/licenses/ version: 0.22 Config-Scoped-0.22/MANIFEST000444004006000346 112011727425565 16145 0ustar00gaissmaikizinfra000000000000Build.PL Changes example/cfgtest.pl lib/Config/Scoped.pm lib/Config/Scoped.pod lib/Config/Scoped/Error.pm MANIFEST This list of files META.yml README t/01-basics.t t/02-perm.t t/03-scalars.t t/04-macros.t t/05-include.t t/06-quote.t t/07-block.t t/08-comments.t t/09-hashes.t t/10-lists.t t/11-eval.t t/12-param.t t/13-decl.t t/14-except.t t/15-cache.t t/16-warn.t t/17-perldsc.t t/91_pod.t t/92_pod-coverage.t t/files/basic.cfg t/files/cache-test.cfg t/files/fvalid.cfg t/files/include.cfg t/files/increc1 t/files/increc2 t/files/increc3 t/files/macros.cfg t/files/null t/files/scalar.cfg Config-Scoped-0.22/Build.PL000444004006000346 145211727425565 16320 0ustar00gaissmaikizinfra000000000000use strict; use warnings; use Module::Build; my $builder = Module::Build->new( module_name => 'Config::Scoped', create_readme => 1, license => 'perl', dist_author => 'Karl Gaissmaier ', requires => { 'Parse::RecDescent' => '1.94', Error => 0, Storable => 0, Safe => 0, Carp => 0, 'File::Spec' => 0, 'File::Basename' => 0, 'Digest::MD5' => 0, }, build_requires => { 'Module::Build' => '0', 'Test::More' => '0', }, configure_requires => { 'Module::Build' => 0, }, add_to_cleanup => [qw/Config-Scoped-* Makefile* Debian_CPANTS.*/], ); $builder->create_build_script(); Config-Scoped-0.22/README000444004006000346 5744411727425565 15740 0ustar00gaissmaikizinfra000000000000NAME Config::Scoped - feature rich configuration file parser SYNOPSIS use Config::Scoped; $cs = Config::Scoped->new( file => $config_file, ... ); $cfg_hash = $cs->parse; ABSTRACT Config::Scoped is a configuration file parser. Features * recursive data structures with scalars, lists, and hashes * simplified syntax with minimal punctuation * parses many Perl data structures without eval, do or require * Perl quoting syntax: single quotes (''), double quotes(""), and here-docs (<new $cs = Config::Scoped->new( file => $config_file, lc => $lc, safe => $compartment, warnings => $warnings, your_key => $your_value, { ... }, ); Creates and returns a new Config::Scoped object. The following parameters are optional. $config_file The configuration file to parse. If omitted, then a $config_string must be provided to the parse method (see below). $lc If true, all declaration and parameter names will be converted to lower case. $compartment A Safe compartment for evaluating Perl code blocks in the configuration file. Defaults to a Safe compartment with no extra shares and the :default operator tag. $warnings may be the literal string 'on' or 'off' to set all warnings simultan. Or define a hash reference with the following keys to set each warning as specified. $warnings = { declaration => 'off', digests => 'off', macro => 'off', parameter => 'off', permissions => 'off', your_warning => 'off', }; All warnings are on by default. Arbitrary key/value pairs will be stored in the $cs object. This is useful primarily for subclassing. $cs->parse $cfg_hash = $cs->parse; $cfg_hash = $cs->parse(text => $config_string); Parses the configuration and returns a reference to the config hash. The first form parses the $config_file that was provided to the constructor. If $config_file was not provided to the constructor, this form dies. The second form parses the $config_string. This method must only be called once. $cs->store_cache $cs->store_cache; $cs->store_cache(cache => $cache_file); Stores the config hash on disk for rapid retrieval. If $config_file was provided to the constructor, then the stored form includes checksums of $config_file and any included files. The first form writes to $config_file.dump The second form writes to $cache_file. If $config_file was not provided to the constructor, the first form dies. $cs->retrieve_cache $cfg_hash = $cs->retrieve_cache; $cfg_hash = $cs->retrieve_cache>(cache => $cache_file); Retrieves the $config hash from a file that was created by store_cache. The first form reads $config_file.dump The second form reads $cache_file. If $config_file was not provided to the constructor, the first form dies. The stored file is subject to digests and permissions checks. $cs->set_warnings $cs->set_warnings(name => $name, switch => 'on|off'); Change warning for $name after construction. $cs->warnings_on $on = $cs->warnings_on(name => $name); Returns true if warning $name is on. This is useful primarily for subclassing. EXCEPTIONS All methods die on error. Config::Scoped::Error defines a hierarchy of classes that represent Config::Scoped errors. When a method detects an error, it creates an instance of the corresponding class and throws it. The error classes are all subclasses of Config::Scoped::Error. See Config::Scoped::Error for the complete list. If the exception is not caught, the program terminates, and Config::Scoped prints the config file name and line number where the error was detected to STDERR. CONFIG FILE FORMAT Config::Scoped parses configuration files. If we have a config file like % cat host.cfg host { name = cpan.org port = 22 } % we can parse it into Perl with code like $cs = Config::Scoped->new( file => 'host.cfg' ); $cfg_hash = $cs->parse; The result is always a hash ref. We'll call this the config hash, and its contents for the example file above is: $cfg_hash = { host => { name => 'cpan.org', port => 22, } } Config files and config strings As described, Config::Scoped can obtain a configuration from a $config_file, passed to the constructor, or from a $config_string, passed to the parse method. For simplicity, we'll talk about parsing configuration files, distinguishing configuration strings only when necessary. File layout Config files are free-form text files. Comments begin with #, and extend to the end of the line. Declarations The top-level elements of a config file are called declarations. A declaration consists of a name, followed by a block foo { } bar { } The declaration names become keys in the config hash. The value of each key is another hash ref. The config shown above parses to $cfg_hash = { foo => {}, bar => {}, } You can create additional levels in the config hash simply by listing successive declaration names before the block. This config dog hound { } dog beagle { } cat { } parses to $cfg_hash = { dog => { hound => {}, beagle => {}, }, cat => {} } Declarations may not be nested. Parameters The ultimate purpose of a configuration file is to provide data values for a program. These values are specified by parameters. Parameters have the form name = value and go inside declaration blocks. The name = value parameters in a spec file become key and value pairs inside the declaration hashes in Perl code. For example, this configuration dog { legs = 4 wings = 0 } bird { legs = 2 wings = 2 } parses to $cfg_hash = { dog => { legs => 4, wings => 0, }, bird => { legs => 2, wings => 2, } } Parameter values can be scalars, lists or hashes. Scalar values may be numbers or strings shape = square sides = 4 Lists values are enclosed in square brackets colors = [ red green blue ] primes = [ 2 3 5 7 11 13 ] Hash values are enclosed in curly brackets capitals = { England => London France => Paris } A hash value is also called a hash block. Lists and hashes can be nested to arbitrary depth Europe { currency = euro cities = { England => [ London Birmingham Liverpool ] France => [ Paris Canne Calais ] } } parses to $cfg_hash = { Europe => { currency => 'euro', cities => { England => [ 'London', 'Birmingham', 'Liverpool' ], France => [ 'Paris', 'Canne', 'Calais' ], } } } The Config::Scoped data syntax is similar to the Perl data syntax, and Config::Scoped will parse many Perl data structures. In general, Config::Scoped requires less punctuation that Perl. Note that Config::Scoped allows arrow (=>) or equals (=) between hash keys and values, but not comma (,) capitals = { England => London # OK France = Paris # OK Germany , Berlin # error } _GLOBAL If a config file contains no declarations at all name = cpan.org port = 22 then any parameters will be placed in a _GLOBAL declaration in the config hash $cfg_hash = { _GLOBAL => { name => 'cpan.org', port => 22, } } This allows very simple config files with just parameters and no declarations. Blocks, scoping and inheritance Each declaration block in a config file creates a lexical scope. Parameters inside a declaration are scoped to that block. Parameters are inherited by all following declarations within their scope. If all your animals have four legs, you can save some typing by writing legs = 4 cat {} dog {} which parses to $cfg_hash = { cat => { legs => 4 }, dog => { legs => 4 }, } If some of your animals have two legs, you can create additional scopes with anonymous blocks to control inheritance { legs = 4 cat {} dog {} } { legs = 2 bird {} } parses to $cfg_hash = { cat => { legs => 4 }, dog => { legs => 4 }, bird => { legs => 2 }, } Anonymous blocks may be nested. Each hash block also creates a scope. The hash does not inherit parameters from outside its own scope. Perl code evaluation If you can't express what you need within the Config::Scoped syntax, your escape hatch is eval { ... } This does a Perl eval on the block, and replaces the construct with the results of the eval. start = eval { localtime } foo = eval { warn 'foo,' if $debug; return 'bar' } The block is evaluated in scalar context. However, it may return a list or hash reference, and the underlying list or hash can become a parameter value. For example foo { list = eval { [ 1 .. 3 ] } hash = eval { { a => 1, b => 2, c => 3 } } } parses to $cfg_hash = { foo => { list => [ 1, 2, 3 ], hash => { a => 1, b => 2, c => 3 }, } } The block is evaluated inside the parser's Safe compartment. Variables can be made available to the eval by sharing them with the compartment. To set the $debug variable in the example above, do $compartment = Safe->new('MY_SHARE'); $MY_SHARE::debug = 1; $cs = Config::Scoped->new( file => 'config.txt', safe => $compartment, ); $cfg_hash = $cs->parse; Only global variables can be shared with a compartment; lexical variables cannot. perl_code is a synonym for eval. Tokens and quoting A token is a * declaration name * parameter name * hash key * scalar value * macro name * macro value * include path * warning name Any token may be quoted. Tokens that contain special characters must be quoted. The special characters are \s {} [] <> () ; , ' " = # % Config::Scoped uses the Perl quoting syntax. Tokens may be quoted with either single or double quotes a = 'New York' b = "New Jersey\n" Here-docs are supported a = < { bc => 1 } } DIRECTIVES Config::Scoped has three directives: %macro, %warning, and %include. Macros Config::Scoped supports macros. A macro is defined with %macro name value Macros may be defined * at file scope * within anonymous blocks * within declaration blocks * within hash blocks Macros defined within blocks are lexically scoped to those blocks. Macro substitution occurs * within any double-quoted text * within the entirety of Perl eval blocks * nowhere else Include files Config::Scoped supports include files. To include one config file within another, write %include path/to/file %include directives may appear * at file scope * within anonymous blocks * nowhere else In particular, %include directives may not appear within declaration blocks or hash blocks. Parameters and macros in include files are imported to the current scope. You can control this scope with an anonymous block { %include dog.cfg dog { } # sees imports from dog.cfg } bird { } # does not see imports from dog.cfg Warnings are scoped to the included file and do not leak to the parent file. Pathnames are either * absolute * relative to the dirname of the current configuration file For example, this config # in configuration file /etc/myapp/global.cfg %include shared.cfg includes the file /etc/myapp/shared.cfg. When parsing a configuration string, the path is relative to the current working directory. Include files are not actually included as text. Rather, they are processed by a recursive call to Config::Scoped. Subclass implementers may need to be aware of this. Warnings Config::Scoped can check for 5 problems with config files * duplicate declaration names * duplicate parameter definitions * duplicate macro definitions * insecure config file permissions * invalid config cache digests The API refers to these as "warnings", but they are actually errors, and if they occur, the parse fails and throws an exception. For consistency with the API, we'll use the term "warning" in the POD. The five warnings are identified by five predefined warning names * declaration * parameter * macro * permissions * digests The permissions check requires that the config file * be owned by root or the real UID of the running process AND * have no group or world write permissions These restrictions help prevent an attacker from subverting a program by altering its config files. The store_cache method computes MD5 checksums for the config file and all included files. These checksums are stored with the cached configuration. The retrieve_cache method recomputes the checksums of the files and compares them to the stored values. The digests check requires that the checksums agree. This helps prevent programs from relying on stale configuration caches. All warnings are enabled by default. Warnings can be disabled by passing the warning key to the constructor or with the set_warnings method. Warnings can also be controlled with the %warnings directive, which has the form %warnings [name] off|on A %warnings directive applies to the named warning, or to all warnings, if name is omitted. %warnings directives allow warnings to be turned on and off as necessary throughout the config file. A %warnings directive may appear * at file scope * within anonymous blocks * within declaration blocks * within hash blocks Each %warnings directive is lexically scoped to its enclosing file or block. Example legs = 4 cat {} dog {} bird { legs = 2 } fails with a duplicate parameter warning, but legs = 4 cat {} dog {} bird { %warnings parameter off; legs = 2 } successfully parses to $cfg_hash = { cat => { legs => 4 }, dog => { legs => 4 }, bird => { legs => 2 }, } Best practices As with all things Perl, there's more than one way to write configuration files. Here are some suggestions for writing config files that are concise, readable, and maintainable. Perl data Config::Scoped accepts most Perl data syntax. This allows Perl data to pulled into config files largely unaltered foo { a = 1; b = [ 'red', 'green', 'blue' ]; c = { x => 5, y => 6 }; } However, Config::Scoped doesn't require as much punctuation as Perl, and config files written from scratch will be cleaner without it foo { a = 1 b = [ red green blue ] c = { x => 5 y => 6 } } Anonymous blocks Don't use anonymous blocks unless you need to restrict the scope of something. In particular, there is no need for a top-level anonymous block around the whole config file { # unnecessary foo { } } Inheritance Parameters that are outside of a declaration are inherited by all following declarations in their scope. Don't do this unless you mean it wheels = 4 car { # OK } cat { # I can haz weelz? } Blocks, blocks, we got blocks... Config::Scoped has four different kinds of blocks * anonymous * declaration * eval * hash They all look the same, but they aren't, and they have different rules and restrictions. See "CONFIG FILE FORMAT" for descriptions of each. Macros Macros are evil, and Config::Scoped macros are specially evil, because * they don't respect token boundaries * where multiple substitutions are possible, the substitution order is undefined * substituted text may or may not be rescanned for further substitutions Caveat scriptor. SUBCLASSING Config::Scoped has no formally defined subclass interface. Here are some guidelines for writing subclasses. Implementers who override (or redefine) base class methods may need to read the Config::Scoped sources for more information. Arbitrary $your_key => $value pairs may be passed to the Config::Scoped constructor. They will be stored in the $cs->{local} hashref, and methods may access them with code like $cs->{local}{$your_key} To avoid conflict with existing keys in the local hash, consider distinguishing your keys with a unique prefix. Arbitrary warning names may be defined, set with new and set_warnings, used in %warnings directives, and tested with warnings_on. Methods can call warnings_on to find out whether a warning is currently enabled. All methods throw exceptions (die) on error. The exception object should be a subclass of Config::Scoped::Error. You can use one of the classes defined in Config::Scoped::Error, or you can derive your own. This code Config::Scoped::Error->throw( -file => $cs->_get_file(%args), -line => $cs->_get_line(%args), -text => $message, ); will generate an error message that reports the location in the config file where the error was detected, rather than a location in Perl code. Config::Scoped performs validation checks on the elements of configuration files (declarations, parameters, macros, etc). Here are the interfaces to the validation methods. Subclasses can override these methods to modify or extend the validation checks. $macro_value = $cs->macro_validate>(name => $name, value => $value) Called for each %macro directive. Receives the $name and $value from the directive. The returned $macro_value becomes the actual value of the macro. If the macro is invalid, throws a Config::Scoped::Error::Validate::Macro exception. $param_value = $cs->parameter_validate>(name => $name, value => $value) Called for each parameter definition. Receives the $name and $value from the definition. The returned $param_value becomes the actual value of the parameter. If the parameter is invalid, throws a Config::Scoped::Error::Validate::Parameter exception. $cs->declaration_validate(name => $name, value => $value, tail => $tail) Called for each declaration. $name is an array ref giving the chain of names for the declaration block. $value is a hash ref containing all the parameters in the declaration block. $tail is a hash ref containing all the parameters in any previously defined declaration with the same name(s). For example, the declaration foo bar baz { a=1 b=2 } leads to the call $cs->declaration_validate(name => [ qw(foo bar baz) ], value => { a => '1', b => '2' }, tail => $cs->{local}{config}{foo}{bar}{baz}); The method can test %$tail to discover if there is an existing, non-empty declaration with the same name(s). The method has no return value. However, the method can alter the contents of %$value. Upon return, the parameters in %$value become the actual contents of the declaration block. If the declaration is invalid, throws a Config::Scoped::Error::Validate::Declaration exception. $cs->permissions_validate(file => $file, handle => $handle) Called for the config file, each included file, and each retrieved cache file. One of $file or $handle must be non-null. Throws a Config::Scoped::Error::Validate::Permissions exception if the file is not safe to read. SEE ALSO * Error * Safe * Config::Scoped::Error * Parse::RecDescent * "Quote and Quote-like Operators" in perlop TODO Tests Still more tests needed. BUGS If you find parser bugs, please send the stripped down config file and additional version information to the author. CREDITS POD by Steven W. McDougall AUTHOR Karl Gaissmaier COPYRIGHT AND LICENSE Copyright (c) 2004-2012 by Karl Gaissmaier This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Config-Scoped-0.22/lib000755004006000346 011727425565 15433 5ustar00gaissmaikizinfra000000000000Config-Scoped-0.22/lib/Config000755004006000346 011727425565 16640 5ustar00gaissmaikizinfra000000000000Config-Scoped-0.22/lib/Config/Scoped.pm000444004006000346 11010011727425565 20601 0ustar00gaissmaikizinfra000000000000# Copyright (c) 2004-2012 by Karl Gaissmaier, Ulm University, Germany # # This library is free software; you can redistribute it and/or modify # it under the same terms as Perl itself. # # for documentation see Config::Scoped.pod package Config::Scoped; use strict; use warnings; use Storable qw(dclone lock_nstore lock_retrieve); use Carp; use Safe; use Digest::MD5 qw(md5_base64); use File::Basename qw(fileparse); use File::Spec; use Config::Scoped::Error; use base 'Parse::RecDescent'; our $VERSION = '0.22'; my $grammar; { local $/; $grammar = ; close DATA; } my @state_hashes = qw(config params macros warnings includes); sub new { my $class = shift; Config::Scoped::Error->throw( -text => Carp::shortmess("odd number of arguments,") ) if @_ % 2; my %args = @_; ############################################## # Delayed compilation of grammar in method parse() # my $empty_grammar = ''; $args{compiled} = undef; ############################################## # create the parser object, delayed grammar # my $thisparser = $class->SUPER::new($empty_grammar) or Config::Scoped::Error->throw( -text => "Can't create a '$class' parser," ); ############################################## # store the args in the P::RD object below 'local' # don't use deep copy since we use always one and # only one global config hash # $thisparser->{local} = {%args}; # frequent typos, be polite $thisparser->{local}{warnings} ||= $thisparser->{local}{warning}; $thisparser->{local}{lc} ||= $thisparser->{local}{lowercase}; $thisparser->{local}{safe} ||= $thisparser->{local}{Safe}; $thisparser->{local}{file} ||= $thisparser->{local}{File}; ############################################## # validate and munge the 'file' param # # a cfg_file isn't necessary, the parse method can be feeded # with a plain text string if ( my $cfg_file = $thisparser->{local}{file} ) { Config::Scoped::Error->throw( -text => Carp::shortmess("can't use filehandle as cfg file") ) if ref $cfg_file; # retrieve the dir part, later on needed for relative include files my ( undef, $cfg_dir ) = fileparse($cfg_file) or Config::Scoped::Error->throw( -text => "error in fileparse", -file => $thisparser->_get_file(%args), -line => $thisparser->_get_line(%args), ); $cfg_file = File::Spec->rel2abs($cfg_file) or Config::Scoped::Error->throw( -text => "error in rel2abs", -file => $thisparser->_get_file(%args), -line => $thisparser->_get_line(%args), ); $thisparser->{local}{cfg_file} = $cfg_file; $thisparser->{local}{cfg_dir} = $cfg_dir; } else { # no cfg_file defined, use _STRING and cwd $thisparser->{local}{cfg_file} = '_STRING'; $thisparser->{local}{cfg_dir} = File::Spec->rel2abs( File::Spec->curdir ); } ############################################## # check for warnings # # set the default to all on $thisparser->{local}{warnings} = { all => 'on' } unless $thisparser->{local}{warnings}; # allow the simple form: 'warnings' => 'on/off' if ( ref $thisparser->{local}{warnings} ne 'HASH' ) { $thisparser->{local}{warnings} = { all => 'on' } if $thisparser->{local}{warnings} =~ m/on/i; $thisparser->{local}{warnings} = { all => 'off' } if $thisparser->{local}{warnings} =~ m/off/i; } # store the warnings in a normalized form foreach my $name ( keys %{ $thisparser->{local}{warnings} } ) { my $switch = delete $thisparser->{local}{warnings}{$name}; $thisparser->_set_warnings( name => $name, switch => $switch, ); } ############################################## # preset the state hashes # # use empty state_hashes if not defined foreach my $hash_name (@state_hashes) { $thisparser->{local}{$hash_name} ||= {}; # be defensive Config::Scoped::Error->throw( -text => Carp::shortmess("$hash_name is no hash ref") ) unless ref $thisparser->{local}{$hash_name} eq 'HASH'; } # install/create Safe compartment for perl_code my $compartment = $thisparser->{local}{safe}; if ( $thisparser->{local}{safe} ) { Config::Scoped::Error->throw( -text => Carp::shortmess("can't find method 'reval' on compartment") ) unless UNIVERSAL::can( $thisparser->{local}{safe}, 'reval' ); } else { $thisparser->{local}{safe} = Safe->new or Config::Scoped::Error->throw( -text => "can't create a Safe compartment!" ); } return $thisparser; } sub parse { my $thisparser = shift; Config::Scoped::Error->throw( -text => Carp::shortmess("odd number of arguments,") ) if @_ % 2; unless (defined $thisparser->{local}{compiled} ){ $thisparser->Replace($grammar); $thisparser->{local}{compiled} = 1; } my %args = @_; my $cfg_text = $args{text}; unless ( defined $cfg_text ) { my $cfg_file = $thisparser->{local}{cfg_file} or Config::Scoped::Error->throw( -text => Carp::shortmess("no cfg_file defined"), -file => $thisparser->_get_file(%args), -line => $thisparser->_get_line(%args), ); Config::Scoped::Error->throw( -text => "no text to parse defined" ) if $cfg_file eq '_STRING'; # slurp the cfg file $cfg_text = $thisparser->_get_cfg_text( %args, file => $cfg_file ); Config::Scoped::Error->throw( -file => $thisparser->_get_file(%args), -line => $thisparser->_get_line(%args), -text => "'$cfg_file' is empty" ) unless $cfg_text; # calculate the message digest and remember this cfg text in includes my $digest = md5_base64($cfg_text); Config::Scoped::Error->throw( -file => $thisparser->_get_file(%args), -line => $thisparser->_get_line(%args), -text => "include loop for '$cfg_file' encountered", ) if $thisparser->{local}{includes}{$digest}; $thisparser->{local}{includes}{$digest} = $cfg_file; } # call the P::RD with the startrule of the grammar $thisparser->config($cfg_text); ############################################## # no declarations but parameters in scope? # # copy them to an automatically generated _GLOBAL hash # first use some shortcuts my $params = $thisparser->{local}{params}; my $config = $thisparser->{local}{config}; # all $config keys other than _GLOBAL are real declarations my @declarations = grep !/^_GLOBAL$/, keys %$config; # no declarations but parameters in global scope if ( !@declarations && %$params ) { # the overall parent scope overrides scopes from include files $config->{_GLOBAL} = dclone $params; } else { # perhaps a prior parse for an include file filled this slot delete $config->{_GLOBAL}; } return $thisparser->{local}{config}; } sub warnings_on { my $thisparser = shift; Config::Scoped::Error->throw( -text => Carp::shortmess("odd number of arguments,") ) if @_ % 2; my %args = @_; Config::Scoped::Error->throw( -text => Carp::shortmess("missing parameters") ) unless defined $args{name}; my $name = $args{name}; my $warnings = $thisparser->{local}{warnings}; $name = $thisparser->_trim_warnings($name); return undef if exists $warnings->{$name} && $warnings->{$name} eq 'off'; return 1 if exists $warnings->{$name} && $warnings->{$name} eq 'on'; # use 'all' return undef if exists $warnings->{all} && $warnings->{all} eq 'off'; return 1 if exists $warnings->{all} && $warnings->{all} eq 'on'; # hmm, name and all not defined, defaults to on return 1; } sub set_warnings { my $thisparser = shift; Config::Scoped::Error->throw( -text => Carp::shortmess("odd number of arguments,") ) if @_ % 2; my %args = @_; Config::Scoped::Error->throw( -text => Carp::shortmess("no warnings switch (on/off) defined") ) unless defined $args{switch}; my $warnings = $thisparser->{local}{warnings}; my $name = $args{name} || 'all'; my $switch = $args{switch}; $name = $thisparser->_trim_warnings($name); # trim the switch, convert to lowercase $switch = lc($switch); if ( $name eq 'all' ) { # reset the hash %{$warnings} = (); $warnings->{all} = $args{switch}; } else { # override the key, key is 'macro', 'declaration', 'parameter', ... $warnings->{$name} = $args{switch}; } return 1; } # just a wrapper for the same method without leading _ # this method is called in the grammar file whereas the set_warnings # may be overriden by the application sub _set_warnings { my $thisparser = shift; $thisparser->set_warnings(@_); } # shortcuts allowed, less spelling errors sub _trim_warnings { my ( $thisparser, $name ) = @_; # trim the names return 'declaration' if $name =~ /^decl/i; return 'parameter' if $name =~ /^param/i; return 'macro' if $name =~ /^mac/i; return 'permissions' if $name =~ /^perm/i; return 'digests' if $name =~ /^dig/i; return $name; } sub store_cache { my $thisparser = shift; Config::Scoped::Error->throw( -text => Carp::shortmess("odd number of arguments,") ) if @_ % 2; my %args = @_; my $cache_file = $args{cache}; unless ($cache_file) { my $cfg_file = $thisparser->{local}{cfg_file} or Config::Scoped::Error->throw( -text => Carp::shortmess("no cache_file and no cfg_file defined") ); Config::Scoped::Error->throw( -text => Carp::shortmess("parameter 'cache' needed for parsed strings") ) if $cfg_file eq '_STRING'; $cache_file = $cfg_file . '.dump'; } my $cfg_hash = { includes => $thisparser->{local}{includes}, config => $thisparser->{local}{config}, }; my $result = eval { lock_nstore( $cfg_hash, $cache_file ); }; Config::Scoped::Error->throw( -text => Carp::shortmess($@) ) if $@; Config::Scoped::Error->throw( -text => Carp::shortmess("can't store the cfg hash to '$cache_file'") ) unless $result; } sub retrieve_cache { my $thisparser = shift; Config::Scoped::Error->throw( -text => Carp::shortmess("odd number of arguments,") ) if @_ % 2; my %args = @_; my $cache_file = $args{cache}; $args{parent_file} = $cache_file; # for better error messages unless ($cache_file) { my $cfg_file = $thisparser->{local}{cfg_file} or Config::Scoped::Error->throw( -text => Carp::shortmess("no cache_file and no cfg_file defined") ); Config::Scoped::Error->throw( -text => Carp::shortmess("cache not supported for strings") ) if $cfg_file eq '_STRING'; $cache_file = $cfg_file . '.dump'; } Config::Scoped::Error::IO->throw( -text => Carp::shortmess("Can't read the cfg_cache '$cache_file'") ) unless -r $cache_file; # check the permission and ownership, I know, it's no handle and of # restricted usage Config::Scoped::Error::Validate::Permissions->throw( -text => Carp::shortmess( "permissions_validate returned false for cache_file '$cache_file'") ) unless $thisparser->permissions_validate( %args, file => $cache_file ); my $cfg_cache = eval { lock_retrieve($cache_file); }; Config::Scoped::Error->throw( -text => Carp::shortmess($@) ) if $@; Config::Scoped::Error->throw( -text => Carp::shortmess( "cfg cache is empty", ) ) unless $cfg_cache; # warnings for digests enabled? return $cfg_cache->{config} unless $thisparser->warnings_on( %args, name => 'digests', ); # check the include digests for modification while ( my ( $digest, $file ) = each %{ $cfg_cache->{includes} } ) { my $text = $thisparser->_get_cfg_text( %args, file => $file, ); if ( $digest ne md5_base64($text) ) { Config::Scoped::Error->throw( -text => Carp::shortmess( "'$file' modified, can't use the cache '$cache_file',") ); } } return $cfg_cache->{config}; } # _include # # this method is called as an action in the INCLUDE grammar rule # the current localized $thisparser->{local}... parameters are used and adjusted # and a new P::RD parser with the same grammar is created and started # for the include file. # After that the parse in the parent cfg file is continued. # We don't change the $text and don't resync the linecounter in P::RD, since # this would result in awfully wrong line numbers in error messages and # we would still have no hint in which include file the error happened. # # The current scope, macro and warnings hash is used during include file parsing # so the include file can use (or overwrite) the current parse state. # # The changed state during the include file parse is propagated to the # parent parser state (except warnings). If this import isn't intended # put the include # in a own block: { %include filename; } # sub _include { my $thisparser = shift; my %args = @_; Config::Scoped::Error->throw( -file => $thisparser->_get_file(%args), -line => $thisparser->_get_line(%args), -text => Carp::shortmess("missing parameters"), ) unless defined $args{file}; my $include_file = $args{file}; my $parent_cfg_file = $thisparser->{local}{cfg_file}; my $parent_cfg_dir = $thisparser->{local}{cfg_dir}; # absolute path? else concat with parent cfg dir unless ( File::Spec->file_name_is_absolute($include_file) ) { $include_file = File::Spec->catfile( $parent_cfg_dir, $include_file ) or Config::Scoped::Error->throw( -file => $parent_cfg_file, -line => $thisparser->_get_line(%args), -text => "error in catfile for '$include_file'" ); } # Create a new parser for this include file parsing. # Use the current parser states (perhaps already localized # in a grammar { action }), and change some args for the new # include parser creation. # my $clone_parser = ( ref $thisparser ) ->new( %{ $thisparser->{local} }, file => $include_file ) or Config::Scoped::Error->throw( -file => $parent_cfg_file, -line => $thisparser->_get_line(%args), -text => "Internal error: Can't create a clone parser" ); # parse the include file (recursively) and return to the parent # cfg parse. Loop includes are detected (via md5) and throws an exception. return $clone_parser->parse( parent_file => $parent_cfg_file, # for better error reporting ); } # this method is called as an action in the MACRO rule in order # to store the macro in the macros hash sub _store_macro { my $thisparser = shift; my %args = @_; Config::Scoped::Error->throw( -text => Carp::shortmess("missing parameters") ) unless ( defined $args{name} && defined $args{value} ); # macro validation, may be overwritten by the application my $valid_macro = $thisparser->macro_validate(%args); return $thisparser->{local}{macros}{ $args{name} } = $valid_macro; } sub macro_validate { my $thisparser = shift; my %args = @_; Config::Scoped::Error->throw( -text => Carp::shortmess("missing parameters") ) unless ( defined $args{name} && defined $args{value} ); my $name = $args{name}; my $value = $args{value}; # warnings for macros enabled? if ( $thisparser->warnings_on( name => 'macro', ) ) { Config::Scoped::Error::Validate::Macro->throw( -file => $thisparser->_get_file(%args), -line => $thisparser->_get_line(%args), -text => "macro redefinition for '$name" ) if exists $thisparser->{local}{macros}{$name}; } # return unchanged, subclass methods may do it different return $value; } # macro expansion sub _expand_macro { my $thisparser = shift; my %args = @_; Config::Scoped::Error->throw( -text => Carp::shortmess("missing parameters") ) unless defined $args{value}; my $value = $args{value}; while ( my ( $macro, $defn ) = each %{ $thisparser->{local}{macros} } ) { $value =~ s/\Q$macro\E/$defn/g; } # a P::RD rule can't return undef, then the rule will fail return defined $value ? $value : ''; } # parameter storage, called as action from within the grammar sub _store_parameter { my $thisparser = shift; my %args = @_; Config::Scoped::Error->throw( -text => Carp::shortmess("missing parameters") ) unless ( defined $args{value} && defined $args{name} ); $args{name} = lc( $args{name} ) if $thisparser->{local}{lc}; # parameter validation, may be overwritten by the application my $valid_value = $thisparser->parameter_validate(%args); # store the return value in the params hash return $thisparser->{local}{params}{ $args{name} } = $valid_value; } sub parameter_validate { my $thisparser = shift; my %args = @_; Config::Scoped::Error->throw( -text => Carp::shortmess("missing parameters") ) unless ( defined $args{value} && defined $args{name} ); # warnings for parameters enabled? if ( $thisparser->warnings_on( name => 'parameter', ) ) { Config::Scoped::Error::Validate::Parameter->throw( -file => $thisparser->_get_file(%args), -line => $thisparser->_get_line(%args), -text => "parameter redefinition for '$args{name}'" ) if exists $thisparser->{local}{params}{ $args{name} }; } # return unchanged, subclass methods may do it different return $args{value}; } # declaration storage, called as action from within the grammar sub _store_declaration { my $thisparser = shift; my %args = @_; Config::Scoped::Error->throw( -text => Carp::shortmess("missing parameters") ) unless ( defined $args{name} && defined $args{value} ); { local $_; map { $_ = lc($_) } @{ $args{name} } if $thisparser->{local}{lc}; } # convert declaration: foo bar ... baz { parameters } # to the data structure # $config->{foo}{bar}...{baz} = { parameters }; my $tail = $thisparser->{local}{config}; # walking down the street ... foreach my $name ( @{ $args{name} } ) { $tail->{$name} = {} unless exists $tail->{$name}; $tail = $tail->{$name}; } # now we have baz = {} # application validation my $valid_value = $thisparser->declaration_validate( %args, tail => $tail ); # store the current scope in the last $config->{foo}...{baz} = $params # use deep copy to break dependencies when config parameters # get's changed in the application in different declarations return %$tail = %{ dclone( $args{value} ) }; } sub declaration_validate { my $thisparser = shift; my %args = @_; Config::Scoped::Error->throw( -text => Carp::shortmess("missing parameters") ) unless ( defined $args{name} && defined $args{value} ); # warnings for declarations enabled and 'tail' already set? if ( $thisparser->warnings_on( name => 'declaration', ) ) { Config::Scoped::Error::Validate::Declaration->throw( -file => $thisparser->_get_file(%args), -line => $thisparser->_get_line(%args), -text => "declaration redefinition for '@{$args{name}}'" ) if %{ $args{tail} }; } # return unchanged, subclass methods may do it different return $args{value}; } sub permissions_validate { my $thisparser = shift; my %args = @_; Config::Scoped::Error->throw( -text => Carp::shortmess("missing parameters") ) unless ( defined $args{handle} || defined $args{file} ); my $warnings = $thisparser->{local}{warnings}; # warnings for files enabled? return 1 unless $thisparser->warnings_on( name => 'permissions', warnings => $warnings, ); my $fh = $args{handle} || $args{file}; # mysteriously vaporized Config::Scoped::Error::IO->throw( -file => $thisparser->_get_file(%args), -line => $thisparser->_get_line(%args), -text => "'$args{file}' can't stat cfg file/handle: $!" ) unless stat $fh; my ( $dev, $ino, $mode, $nlink, $uid, $gid ) = stat(_); # owner is not root and not real uid Config::Scoped::Error::Validate::Permissions->throw( -file => $thisparser->_get_file(%args), -line => $thisparser->_get_line(%args), -text => "'$args{file}' is unsafe: owner is not root and not real uid", ) if $uid != 0 && $uid != $<; Config::Scoped::Error::Validate::Permissions->throw( -file => $thisparser->_get_file(%args), -line => $thisparser->_get_line(%args), -text => "'$args{file}' is unsafe: writeable by group or others", ) if $mode & 022; return 1; } # handle quoted strings, expand macro's and interpolate backslash # patterns like \t, \n, etc. Called as action from within the grammar. sub _quotelike { my $thisparser = shift; my %args = @_; Config::Scoped::Error->throw( -text => Carp::shortmess("missing parameter") ) unless defined $args{value}; my $value = $args{value}; # accepts only '', "", < 1, double => 1, '<<' => 1 ); # see Text::Balanced::extract_quotelike() to understand this # and of course Parse::RecDescent directive my $quote_name = $value->[0]; my $quote_delim = substr( $value->[1], 0, 1 ); my $quote_text = $value->[2]; # the quote_name isn't set with plain quotes, set it now unless ($quote_name) { $quote_name = 'double' if $quote_delim eq '"'; $quote_name = 'single' if $quote_delim eq "'"; } # let the rule fail if not an accepted quote name return undef unless $accept{$quote_name}; # backslash substitution in double quoted strings is # done by reval() in the Safe compartment since # it's possible to smuggle a subroutine call # in a double quoted string. # $quote_text = $thisparser->_perl_code( expr => "\"$quote_text\"" ) unless $quote_name eq 'single' || $quote_delim eq "'"; # macro expansion for double quoted constructs $quote_text = $thisparser->_expand_macro( %args, value => $quote_text ) unless $quote_name eq 'single' || $quote_delim eq "'"; # a P::RD rule can't return undef, then the rule would fail return defined $quote_text ? $quote_text : ''; } # slurp in the cfg files sub _get_cfg_text { my $thisparser = shift; my %args = @_; Config::Scoped::Error->throw( -text => Carp::shortmess("no cfg_file defined") ) unless defined $args{file}; my $cfg_file = $args{file}; local *CFG; # open the cfg file Config::Scoped::Error::IO->throw( -file => $thisparser->_get_file(%args), -line => $thisparser->_get_line(%args), -text => "Can't open cfg_file '$cfg_file': $!" ) unless open( CFG, $cfg_file ); # check the permission and ownership Config::Scoped::Error::Validate::Permissions->throw( -file => $thisparser->_get_file(%args), -line => $thisparser->_get_line(%args), -text => "permissions_validate returned false for cfg_file '$cfg_file'" ) unless $thisparser->permissions_validate( %args, handle => \*CFG ); # slurp the cfg_file, close the handle and return the text my $cfg_text = join '', ; Config::Scoped::Error::IO->throw( -file => $thisparser->_get_file(%args), -line => $thisparser->_get_line(%args), -text => "Can't close cfg_file '$cfg_file' : $!" ) unless close CFG; return $cfg_text; } # eval perlcode in Safe compartment, called as action from within the grammar. sub _perl_code { my $thisparser = shift; my %args = @_; Config::Scoped::Error->throw( -text => Carp::shortmess("no expression to eval defined") ) unless defined $args{expr}; my $expr = $args{expr}; # macro expansion before code evaluation $expr = $thisparser->_expand_macro( %args, value => $expr ); my $compartment = $thisparser->{local}{safe}; # eval in Safe compartment my $result = $compartment->reval($expr); # adjust error message and rethrow if ( !defined $result && $@ ) { chomp $@; $@ .= "\n... (re)blessed and propagated via perl_code{}"; Config::Scoped::Error::Parse->throw( -file => $thisparser->_get_file(%args), -line => $thisparser->_get_line(%args), -text => $@, ); } # a P::RD rule can't return undef, then the rule would fail return defined $result ? $result : ''; } # used for well spotted error messages sub _get_file { my $thisparser = shift; my %args = @_; return $args{parent_file} || $args{file} || $thisparser->{local}{cfg_file} || '?'; } # used for well spotted error messages sub _get_line { my $thisparser = shift; my %args = @_; return $args{line} || $thisparser->{local}{line} || 0; } 1; __DATA__ ####################################################################### # Grammar for Config::Scoped ####################################################################### # # Do you to understand this grammar? # Be warned, dragons ahead, recursive brain damage possible! # # First, read the Config::Scoped manual to understand what's going on here! # # Second, read the Parse::RecDescent manual and learn it by heart to # understand what's going on here! # # INHERITANCE! # The real action is done via $thisparser->_method() calls # to methods in the Config::Scoped package in order to keep the actions in # this grammar file simple and maintainable. # # The logic is heavily based on localization via in order to # handle scopes properly. # # Call by value are always deep copies via Storable::dclone. # # Blocks, declarations and hashes start new scopes for parameters, macros # and warnings. # # Include files are handled by a cloned Config::Scoped parser. # Include files import parameters and macros to the current scope # but not the warnings. Warnings are scoped within the include files and don't # leak to the parent file. If you don't wish the leakage of parameters and # macros to the parent file, put the %inlcude pragma inside a block {}. # # Declarations collect the parameters and store them # in the unscoped $config hashref. The declaration name(s) are the # keys in the $config hashref. Declarations are never scoped, # they always add to the global config. Declarations are just (named) # collectors of the parameters. # # The principle is easy, isn't it? # ######################################################################### # # START of GRAMMAR for Config::Scoped # ######################################################################### # # STARTRULE # config : config_item(s) eofile | { # Error handling: # fetch only the first error, this is the most important one my $parse_error = shift @{ $thisparser->{errors} }; # keep P::RD silent, see the P::RD FAQ $thisparser->{errors} = undef; # throw an exception Config::Scoped::Error::Parse->throw( -text => $parse_error->[0], -line => $parse_error->[1], -file => $thisparser->{local}{cfg_file} ); } # hack, could be done without this intermediate rule, but # the error messages are more readable with this hack. # # commit hack: with a we get better error messages config_item : statement | ######################################################################### # STATEMENT'S ######################################################################### # # use $break to shortcut the alternate productions after a rejected commit # in a subrule. # # This is a hack since P::RD is missing a directive. # I do this programmatically with a localized and { ++$break } # statement : statement : parameter | block | declaration | pragma | comment ######################################################################### # BLOCK'S: { statement(s) } ######################################################################### # # Open a new scope, inherit (deep copy) the scoped hashes. # block : {local}{params} = Storable::dclone $thisparser->{local}{params}> block : {local}{macros} = Storable::dclone $thisparser->{local}{macros}> block : {local}{warnings} = Storable::dclone $thisparser->{local}{warnings}> block : '{' { ++$break } statement(s) '}' stop_pattern | ######################################################################### # DECLARATIONS ######################################################################### # # Open a new scope, inherit (deep copy) the scoped hashes. # declaration : {local}{params} = Storable::dclone $thisparser->{local}{params}> declaration : {local}{macros} = Storable::dclone $thisparser->{local}{macros}> declaration : {local}{warnings} = Storable::dclone $thisparser->{local}{warnings}> declaration : key(s) '{' { ++$break } decl_item(s?) '}' stop_pattern { $thisparser->{local}{line} = $thisline; $thisparser->_store_declaration( name => $item{'key(s)'}, value => $thisparser->{local}{params}, ); # rule success, errors in the method don't raise syntax errors 1; } | decl_item : ...!'}' parameter_or_macro_or_comment_or_warning | ######################################################################### # HASH ######################################################################### # # Open a new scope, inherit (deep copy) the localized hashes # for macros and warnings. # Reset the params hash! # hash : {local}{params} = {}> hash : {local}{macros} = Storable::dclone $thisparser->{local}{macros}> hash : {local}{warnings} = Storable::dclone $thisparser->{local}{warnings}> hash : '{' { ++$break } hash_item(s?) '}' { # returns just the filled parameter hash as value $return = $thisparser->{local}{params}; } | hash_item : ...!'}' parameter_or_macro_or_comment_or_warning m/,?/ | ######################################################################### # LIST ######################################################################### # # lists start no scope, they are just a special kind of parameters # list : list : '[' { ++$break } list_item(s?) ']' { # returns just the filled list as value $return = \@list; } | list_item : ...!']' hash_or_list_or_value_or_comment m/,?/ | ######################################################################### # PARAMETER'S ######################################################################### # parameter : key /=>?/ { ++$break } hash_or_list_or_value stop_pattern { $thisparser->{local}{line} = $thisline; # store the parameter in the local scope $thisparser->_store_parameter( name => $item{key}, value => $item{hash_or_list_or_value}, ); # rule success, errors in the method don't raise syntax errors 1; } | ######################################################################### # intermediate compounds ######################################################################### # # use $break to shortcut the alternations after a rejected commit parameter_or_macro_or_comment_or_warning : parameter_or_macro_or_comment_or_warning : parameter | macro | warning | comment # use $break to shortcut the alternations after a rejected commit hash_or_list_or_value_or_comment : hash_or_list_or_value_or_comment : hash_or_list_or_value { # fill the list, but not with comments! push @list, $item{hash_or_list_or_value} } | comment # use $break to shortcut the alternations after a rejected commit hash_or_list_or_value : hash_or_list_or_value : hash | list | value ######################################################################### # PRAGMA's ######################################################################### # pragma : macro | include | warning macro : '%macro' { ++$break } key value stop_pattern { $thisparser->{local}{line} = $thisline; $thisparser->_store_macro( name => $item{key}, value => $item{value}, ); # rule success, errors in the method don't raise syntax errors 1; } | # call recursively a new P::RD parser for this include file # call by value for the current $warnings include : {local}{warnings} = Storable::dclone $thisparser->{local}{warnings}> include : '%include' { ++$break } value stop_pattern { $thisparser->{local}{line} = $thisline; $thisparser->_include( file => $item{value}, ); # rule success, errors in the method don't raise syntax errors 1; } | warning : warning_short | warning_long warning_short : /%warnings?/i on_off { ++$break } stop_pattern { $thisparser->{local}{line} = $thisline; $thisparser->_set_warnings( switch => $item{on_off} ); # rule success, errors in the method don't raise syntax errors 1; } | warning_long : /%warnings?/i ...!on_off key { ++$break } on_off stop_pattern { $thisparser->{local}{line} = $thisline; $thisparser->_set_warnings( name => $item{key}, switch => $item{on_off}, ); # rule success, errors in the method don't raise syntax errors 1; } | on_off : /on|off/i ######################################################################### # KEY and VALUE'S ######################################################################### # key : perl_code | token | perl_quote value : perl_code | token | perl_quote # everything unless separator characters, better than \w in unicode times token : /[^ \s >< }{ )( [\] ; , ' " = # % ]+/x perl_quote : .../"|'|< { $thisparser->{local}{line} = $thisline; $return = $thisparser->_quotelike( value => $item{__DIRECTIVE1__} ); } perl_code : /perl_code|eval/i { $thisparser->{local}{line} = $thisline; $return = $thisparser->_perl_code( expr => $item{__DIRECTIVE1__}, ); } ######################################################################### # helpers ######################################################################### # # The skip reset is necessary, since the default eats the newlines. # stop_pattern is: # a newline, a semicolon, a comma or a look-ahead for '}', ']', '\s' # stop_pattern : m/\s* (\n | ; | , | \z | (?=[ \} \] \s ]) )/x eofile : /\z/ comment : m/#.*\n/ ######################################################################### # # END of GRAMMAR, without headache? # ######################################################################### Config-Scoped-0.22/lib/Config/Scoped.pod000444004006000346 5514211727425565 20745 0ustar00gaissmaikizinfra000000000000=head1 NAME Config::Scoped - feature rich configuration file parser =head1 SYNOPSIS use Config::Scoped; $cs = Config::Scoped->new( file => $config_file, ... ); $cfg_hash = $cs->parse; =head1 ABSTRACT B is a configuration file parser. =head2 Features =over 4 =item * recursive data structures with scalars, lists, and hashes =item * simplified syntax with minimal punctuation =item * parses many Perl data structures without B, B or B =item * Perl quoting syntax: single quotes (B<''>), double quotes(B<"">), and here-docs (B<< <>) =item * Perl code evaluation in B compartments =item * parses ISC named and dhcpd config files =item * include files with recursion checks =item * controlled macro expansion in double quoted tokens =item * lexically scoped parameter assignments and directives =item * duplicate macro, parameter, and declaration checks =item * file permission and ownership safety checks =item * fine control over error checking =item * error messages report config file names and line numbers =item * exception-based error handling =item * based on B =item * configuration caching with MD5 checksums on the original files =item * may be subclassed to build parsers with specialized features =back =head1 REQUIRES =over 4 =item * B =item * B =back =head1 EXPORTS Nothing. =head1 METHODS =over 4 =item B<< Config::Scoped->new >> $cs = Config::Scoped->new( file => $config_file, lc => $lc, safe => $compartment, warnings => $warnings, your_key => $your_value, { ... }, ); Creates and returns a new B object. The following parameters are optional. =over 4 =item B<$config_file> The configuration file to parse. If omitted, then a B<$config_string> must be provided to the B method (see below). =item B<$lc> If true, all declaration and parameter names will be converted to lower case. =item B<$compartment> A B compartment for evaluating Perl code blocks in the configuration file. Defaults to a B compartment with no extra shares and the B<:default> operator tag. =item B<$warnings> may be the literal string B<'on'> or B<'off'> to set all warnings simultan. Or define a hash reference with the following keys to set each warning as specified. $warnings = { declaration => 'off', digests => 'off', macro => 'off', parameter => 'off', permissions => 'off', your_warning => 'off', }; All warnings are on by default. =item B will be stored in the B<$cs> object. This is useful primarily for subclassing. =back =item B<< $cs->parse >> $cfg_hash = $cs->parse; $cfg_hash = $cs->parse(text => $config_string); Parses the configuration and returns a reference to the config hash. The first form parses the B<$config_file> that was provided to the constructor. If B<$config_file> was not provided to the constructor, this form Bs. The second form parses the B<$config_string>. This method must only be called once. =item B<< $cs->store_cache >> $cs->store_cache; $cs->store_cache(cache => $cache_file); Stores the config hash on disk for rapid retrieval. If B<$config_file> was provided to the constructor, then the stored form includes checksums of B<$config_file> and any included files. The first form writes to B<$config_file.dump> The second form writes to B<$cache_file>. If B<$config_file> was not provided to the constructor, the first form Bs. =item B<< $cs->retrieve_cache >> $cfg_hash = $cs->retrieve_cache; $cfg_hash = $cs->retrieve_cache>(cache => $cache_file); Retrieves the B<$config> hash from a file that was created by B. The first form reads B<$config_file.dump> The second form reads B<$cache_file>. If B<$config_file> was not provided to the constructor, the first form Bs. The stored file is subject to B and B checks. =item B<< $cs->set_warnings >> $cs->set_warnings(name => $name, switch => 'on|off'); Change warning for B<$name> after construction. =item B<< $cs->warnings_on >> $on = $cs->warnings_on(name => $name); Returns true if warning B<$name> is on. This is useful primarily for subclassing. =back =head1 EXCEPTIONS All methods B on error. B defines a hierarchy of classes that represent B errors. When a method detects an error, it creates an instance of the corresponding class and throws it. The error classes are all subclasses of B. See L for the complete list. If the exception is not caught, the program terminates, and B prints the config file name and line number where the error was detected to B. =head1 CONFIG FILE FORMAT B parses configuration files. If we have a config file like % cat host.cfg host { name = cpan.org port = 22 } % we can parse it into Perl with code like $cs = Config::Scoped->new( file => 'host.cfg' ); $cfg_hash = $cs->parse; The result is always a hash ref. We'll call this the B, and its contents for the example file above is: $cfg_hash = { host => { name => 'cpan.org', port => 22, } } =head2 Config files and config strings As described, B can obtain a configuration from a B<$config_file>, passed to the constructor, or from a B<$config_string>, passed to the B method. For simplicity, we'll talk about parsing configuration files, distinguishing configuration strings only when necessary. =head2 File layout Config files are free-form text files. Comments begin with B<#>, and extend to the end of the line. =head2 Declarations The top-level elements of a config file are called B. A declaration consists of a name, followed by a block foo { } bar { } The declaration names become keys in the config hash. The value of each key is another hash ref. The config shown above parses to $cfg_hash = { foo => {}, bar => {}, } You can create additional levels in the config hash simply by listing successive declaration names before the block. This config dog hound { } dog beagle { } cat { } parses to $cfg_hash = { dog => { hound => {}, beagle => {}, }, cat => {} } Declarations may not be nested. =head2 Parameters The ultimate purpose of a configuration file is to provide data values for a program. These values are specified by B. Parameters have the form name = value and go inside declaration blocks. The name = value parameters in a spec file become key and value pairs inside the declaration hashes in Perl code. For example, this configuration dog { legs = 4 wings = 0 } bird { legs = 2 wings = 2 } parses to $cfg_hash = { dog => { legs => 4, wings => 0, }, bird => { legs => 2, wings => 2, } } B can be B, B or B. Scalar values may be numbers or strings shape = square sides = 4 Lists values are enclosed in square brackets colors = [ red green blue ] primes = [ 2 3 5 7 11 13 ] Hash values are enclosed in curly brackets capitals = { England => London France => Paris } A hash value is also called a B. Lists and hashes can be nested to arbitrary depth Europe { currency = euro cities = { England => [ London Birmingham Liverpool ] France => [ Paris Canne Calais ] } } parses to $cfg_hash = { Europe => { currency => 'euro', cities => { England => [ 'London', 'Birmingham', 'Liverpool' ], France => [ 'Paris', 'Canne', 'Calais' ], } } } The B data syntax is similar to the Perl data syntax, and B will parse many Perl data structures. In general, B requires less punctuation that Perl. Note that B allows arrow (B<< => >>) or equals (B<=>) between hash keys and values, but not comma (B<,>) capitals = { England => London # OK France = Paris # OK Germany , Berlin # error } =head2 _GLOBAL If a config file contains no declarations at all name = cpan.org port = 22 then any parameters will be placed in a B<_GLOBAL> declaration in the config hash $cfg_hash = { _GLOBAL => { name => 'cpan.org', port => 22, } } This allows very simple config files with just parameters and no declarations. =head2 Blocks, scoping and inheritance Each declaration block in a config file creates a lexical scope. Parameters inside a declaration are scoped to that block. Parameters are inherited by all following declarations within their scope. If all your animals have four legs, you can save some typing by writing legs = 4 cat {} dog {} which parses to $cfg_hash = { cat => { legs => 4 }, dog => { legs => 4 }, } If some of your animals have two legs, you can create additional scopes with anonymous blocks to control inheritance { legs = 4 cat {} dog {} } { legs = 2 bird {} } parses to $cfg_hash = { cat => { legs => 4 }, dog => { legs => 4 }, bird => { legs => 2 }, } Anonymous blocks may be nested. Each hash block also creates a scope. The hash does not inherit parameters from outside its own scope. =head2 Perl code evaluation If you can't express what you need within the B syntax, your escape hatch is eval { ... } This does a Perl B on the block, and replaces the construct with the results of the B. start = eval { localtime } foo = eval { warn 'foo,' if $debug; return 'bar' } The block is evaluated in scalar context. However, it may return a list or hash reference, and the underlying list or hash can become a parameter value. For example foo { list = eval { [ 1 .. 3 ] } hash = eval { { a => 1, b => 2, c => 3 } } } parses to $cfg_hash = { foo => { list => [ 1, 2, 3 ], hash => { a => 1, b => 2, c => 3 }, } } The block is evaluated inside the parser's B compartment. Variables can be made available to the B by sharing them with the compartment. To set the B<$debug> variable in the example above, do $compartment = Safe->new('MY_SHARE'); $MY_SHARE::debug = 1; $cs = Config::Scoped->new( file => 'config.txt', safe => $compartment, ); $cfg_hash = $cs->parse; Only global variables can be shared with a compartment; lexical variables cannot. B is a synonym for B. =head2 Tokens and quoting A B is a =over 4 =item * declaration name =item * parameter name =item * hash key =item * scalar value =item * macro name =item * macro value =item * include path =item * warning name =back Any token may be quoted. Tokens that contain special characters must be quoted. The special characters are \s {} [] <> () ; , ' " = # % B uses the Perl quoting syntax. Tokens may be quoted with either single or double quotes a = 'New York' b = "New Jersey\n" Here-docs are supported a = <, B, etc.) are not. Text in here-docs is regarded as single-quoted if the delimiter is enclosed in single quotes, and double-quoted if the delimiter is enclosed in double quotes or unquoted. Double-quoted tokens are evaluated as Perl strings inside the parser's B compartment. They are subject to the usual Perl backslash and variable interpolation, as well as macro expansion. Variables to be interpolated are passed via the B compartment, as shown above in L. If you need a literal B<$> or B<@> in a double-quoted string, be sure to escape it with a backslash (B<\>) to suppress interpolation. An eval { ... } may appear anywhere that a token is expected. For example foo { eval { 'b' . 'c' } = 1 } parses to $cfg_hash = { foo => { bc => 1 } } =head1 DIRECTIVES B has three directives: B<%macro>, B<%warning>, and B<%include>. =head2 Macros B supports macros. A macro is defined with %macro name value Macros may be defined =over 4 =item * at file scope =item * within anonymous blocks =item * within declaration blocks =item * within hash blocks =back Macros defined within blocks are lexically scoped to those blocks. Macro substitution occurs =over 4 =item * within B double-quoted text =item * within the B of Perl B blocks =item * nowhere else =back =head2 Include files B supports include files. To include one config file within another, write %include path/to/file B<%include> directives may appear =over 4 =item * at file scope =item * within anonymous blocks =item * nowhere else =back In particular, B<%include> directives may not appear within declaration blocks or hash blocks. Parameters and macros in include files are imported to the current scope. You can control this scope with an anonymous block { %include dog.cfg dog { } # sees imports from dog.cfg } bird { } # does not see imports from dog.cfg Warnings are scoped to the included file and do not leak to the parent file. Pathnames are either =over 4 =item * absolute =item * relative to the dirname of the current configuration file =back For example, this config # in configuration file /etc/myapp/global.cfg %include shared.cfg includes the file F. When parsing a configuration string, the path is relative to the current working directory. Include files are not actually included as text. Rather, they are processed by a recursive call to B. Subclass implementers may need to be aware of this. =head2 Warnings B can check for 5 problems with config files =over 4 =item * duplicate declaration names =item * duplicate parameter definitions =item * duplicate macro definitions =item * insecure config file permissions =item * invalid config cache digests =back The API refers to these as "warnings", but they are actually errors, and if they occur, the parse fails and throws an exception. For consistency with the API, we'll use the term "warning" in the POD. The five warnings are identified by five predefined B =over 4 =item * B =item * B =item * B =item * B =item * B =back The B check requires that the config file =over 4 =item * be owned by root or the real UID of the running process AND =item * have no group or world write permissions =back These restrictions help prevent an attacker from subverting a program by altering its config files. The B method computes MD5 checksums for the config file and all included files. These checksums are stored with the cached configuration. The B method recomputes the checksums of the files and compares them to the stored values. The B check requires that the checksums agree. This helps prevent programs from relying on stale configuration caches. All warnings are enabled by default. Warnings can be disabled by passing the B key to the constructor or with the B method. Warnings can also be controlled with the B<%warnings> directive, which has the form B<%warnings> [B] B|B A B<%warnings> directive applies to the Bd warning, or to all warnings, if B is omitted. B<%warnings> directives allow warnings to be turned on and off as necessary throughout the config file. A B<%warnings> directive may appear =over 4 =item * at file scope =item * within anonymous blocks =item * within declaration blocks =item * within hash blocks =back Each B<%warnings> directive is lexically scoped to its enclosing file or block. Example legs = 4 cat {} dog {} bird { legs = 2 } fails with a duplicate parameter warning, but legs = 4 cat {} dog {} bird { %warnings parameter off; legs = 2 } successfully parses to $cfg_hash = { cat => { legs => 4 }, dog => { legs => 4 }, bird => { legs => 2 }, } =head1 Best practices As with all things Perl, there's more than one way to write configuration files. Here are some suggestions for writing config files that are concise, readable, and maintainable. =head2 Perl data B accepts most Perl data syntax. This allows Perl data to pulled into config files largely unaltered foo { a = 1; b = [ 'red', 'green', 'blue' ]; c = { x => 5, y => 6 }; } However, B doesn't require as much punctuation as Perl, and config files written from scratch will be cleaner without it foo { a = 1 b = [ red green blue ] c = { x => 5 y => 6 } } =head2 Anonymous blocks Don't use anonymous blocks unless you need to restrict the scope of something. In particular, there is no need for a top-level anonymous block around the whole config file { # unnecessary foo { } } =head2 Inheritance Parameters that are outside of a declaration are inherited by B following declarations in their scope. Don't do this unless you mean it wheels = 4 car { # OK } cat { # I can haz weelz? } =head2 Blocks, blocks, we got blocks... B has four different kinds of blocks =over 4 =item * anonymous =item * declaration =item * eval =item * hash =back They all look the same, but they aren't, and they have different rules and restrictions. See L for descriptions of each. =head2 Macros Macros are evil, and B macros are specially evil, because =over 4 =item * they don't respect token boundaries =item * where multiple substitutions are possible, the substitution order is undefined =item * substituted text may or may not be rescanned for further substitutions =back Caveat scriptor. =head1 SUBCLASSING B has no formally defined subclass interface. Here are some guidelines for writing subclasses. Implementers who override (or redefine) base class methods may need to read the B sources for more information. Arbitrary $your_key => $value pairs may be passed to the B constructor. They will be stored in the B<< $cs->{local} >> hashref, and methods may access them with code like $cs->{local}{$your_key} To avoid conflict with existing keys in the B hash, consider distinguishing your keys with a unique prefix. Arbitrary warning names may be defined, set with B and B, used in B<%warnings> directives, and tested with B. Methods can call B to find out whether a warning is currently enabled. All methods throw exceptions (B) on error. The exception object should be a subclass of B. You can use one of the classes defined in B, or you can derive your own. This code Config::Scoped::Error->throw( -file => $cs->_get_file(%args), -line => $cs->_get_line(%args), -text => $message, ); will generate an error message that reports the location in the config file where the error was detected, rather than a location in Perl code. B performs validation checks on the elements of configuration files (declarations, parameters, macros, etc). Here are the interfaces to the validation methods. Subclasses can override these methods to modify or extend the validation checks. =over 4 =item B<< $macro_value = $cs->macro_validate>(name => $name, value => $value) >> Called for each B<%macro> directive. Receives the B<$name> and B<$value> from the directive. The returned B<$macro_value> becomes the actual value of the macro. If the macro is invalid, throws a B exception. =item B<< $param_value = $cs->parameter_validate>(name => $name, value => $value) >> Called for each parameter definition. Receives the B<$name> and B<$value> from the definition. The returned B<$param_value> becomes the actual value of the parameter. If the parameter is invalid, throws a B exception. =item B<< $cs->declaration_validate(name => $name, value => $value, tail => $tail) >> Called for each declaration. B<$name> is an array ref giving the chain of names for the declaration block. B<$value> is a hash ref containing all the parameters in the declaration block. B<$tail> is a hash ref containing all the parameters in any previously defined declaration with the same name(s). For example, the declaration foo bar baz { a=1 b=2 } leads to the call $cs->declaration_validate(name => [ qw(foo bar baz) ], value => { a => '1', b => '2' }, tail => $cs->{local}{config}{foo}{bar}{baz}); The method can test %$tail to discover if there is an existing, non-empty declaration with the same name(s). The method has no return value. However, the method can alter the contents of %$value. Upon return, the parameters in %$value become the actual contents of the declaration block. If the declaration is invalid, throws a B exception. =item B<< $cs->permissions_validate(file => $file, handle => $handle) >> Called for the config file, each included file, and each retrieved cache file. One of B<$file> or B<$handle> must be non-null. Throws a B exception if the file is not safe to read. =back =head1 SEE ALSO =over 4 =item * B =item * B =item * B =item * B =item * L =back =head1 TODO =over 4 =item Tests Still more tests needed. =back =head1 BUGS If you find parser bugs, please send the stripped down config file and additional version information to the author. =head1 CREDITS POD by Steven W. McDougall Eswmcd@world.std.comE =head1 AUTHOR Karl Gaissmaier Ekarl.gaissmaier at uni-ulm.deE =head1 COPYRIGHT AND LICENSE Copyright (c) 2004-2012 by Karl Gaissmaier This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut # vim: sw=4 ft=pod Config-Scoped-0.22/lib/Config/Scoped000755004006000346 011727425565 20055 5ustar00gaissmaikizinfra000000000000Config-Scoped-0.22/lib/Config/Scoped/Error.pm000444004006000346 564711727425565 21655 0ustar00gaissmaikizinfra000000000000use strict; use warnings; =head1 NAME Config:Scoped::Error - an exception class hierarchy based on Error.pm for Config::Scoped =head1 SYNOPSIS use Config::Scoped::Error; Config::Scoped::Error::Parse->throw( -text => $parser_error, -file => $config_file, -line => $thisline, ); Config::Scoped::Error::IO->throw( -text => "can't open file: $!", -file => $config_file, -line => $thisline, ); Config::Scoped::Error::Validate::Macro->throw( -text => "macro redefinition: $macro_name", -file => $config_file, -line => $thisline, ); =head1 DESCRIPTION Config::Scoped::Error is a class hierarchy based on Error.pm. The following Exception class hierarchy is defined: Config::Scoped::Error Config::Scoped::Error::Parse Config::Scoped::Error::Validate Config::Scoped::Error::Validate::Macro Config::Scoped::Error::Validate::Parameter Config::Scoped::Error::Validate::Declaration Config::Scoped::Error::Validate::Permissions Config::Scoped::Error::IO =cut package Config::Scoped::Error; use base 'Error'; our $VERSION='0.22'; #Error propagation, see perldoc -f die sub PROPAGATE { no warnings 'uninitialized'; $_[0]->{-propagate} .= "propagated at $_[1] line $_[2]\n"; return $_[0]; } # private accessor sub _propagate { return exists $_[0]->{-propagate} ? $_[0]->{-propagate} : undef; } # Override Error::stringify. # Add the file and line if not ending in a newline and # add the propagated text. sub stringify { no warnings 'uninitialized'; my $file = $_[0]->file; my $line = $_[0]->line; my $propagate = $_[0]->_propagate || ''; my $text = $_[0]->SUPER::stringify; $text .= " at $file line $line.\n" unless ( $text =~ /\n$/s ); $text .= $propagate; return $text; } package Config::Scoped::Error::Parse; use base 'Config::Scoped::Error'; our $VERSION='0.22'; package Config::Scoped::Error::IO; use base 'Config::Scoped::Error'; our $VERSION='0.22'; package Config::Scoped::Error::Validate; use base 'Config::Scoped::Error'; our $VERSION='0.22'; package Config::Scoped::Error::Validate::Macro; use base 'Config::Scoped::Error::Validate'; our $VERSION='0.22'; package Config::Scoped::Error::Validate::Parameter; use base 'Config::Scoped::Error::Validate'; our $VERSION='0.22'; package Config::Scoped::Error::Validate::Declaration; use base 'Config::Scoped::Error::Validate'; our $VERSION='0.22'; package Config::Scoped::Error::Validate::Permissions; use base 'Config::Scoped::Error::Validate'; our $VERSION='0.22'; 1; =head1 SEE ALSO Config::Scoped, Error =head1 AUTHOR Karl Gaissmaier Ekarl.gaissmaier at uni-ulm.deE =head1 COPYRIGHT AND LICENSE Copyright (c) 2004-2008 by Karl Gaissmaier This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut # vim: cindent sm nohls sw=4 sts=4 ruler Config-Scoped-0.22/t000755004006000346 011727425565 15130 5ustar00gaissmaikizinfra000000000000Config-Scoped-0.22/t/13-decl.t000444004006000346 325611727425565 16610 0ustar00gaissmaikizinfra000000000000# vim: cindent ft=perl sm sw=4 use warnings; use strict; use Test::More tests => 4; BEGIN { use_ok('Config::Scoped') } my ( $p, $cfg ); my $text = <<'eot'; { # defaults, lexically scoped community = public; variables = [ ifInOctets, ifOutOctets ]; oids = { ifInOctets = 1.3.6.1.2.1.2.2.1.10; ifOutOctets = 1.3.6.1.2.1.2.2.1.16; }; %warnings parameter off; ### allow parameter redefinition devices rtr001 { ports = [ 1, 2, 8, 9 ]; } devices rtr007 { community = 'really top secret!'; ports = [ 1, 2, 3, 4 ]; } } eot my $expected = { 'devices' => { 'rtr001' => { 'ports' => [ '1', '2', '8', '9' ], 'community' => 'public', 'variables' => [ 'ifInOctets', 'ifOutOctets' ], 'oids' => { 'ifInOctets' => '1.3.6.1.2.1.2.2.1.10', 'ifOutOctets' => '1.3.6.1.2.1.2.2.1.16' } }, 'rtr007' => { 'ports' => [ '1', '2', '3', '4' ], 'community' => 'really top secret!', 'variables' => [ 'ifInOctets', 'ifOutOctets' ], 'oids' => { 'ifInOctets' => '1.3.6.1.2.1.2.2.1.10', 'ifOutOctets' => '1.3.6.1.2.1.2.2.1.16' } } } }; isa_ok( $p = Config::Scoped->new(), 'Config::Scoped' ); is_deeply( $p->parse( text => $text ), $expected, 'decl test' ); $text = <<'eot'; Foo BAR BaZ { LowerCase = 'Values dont convert' }; eot $expected = { 'foo' => { 'bar' => { 'baz' => { 'lowercase' => 'Values dont convert' } } } }; $p = Config::Scoped->new(lc => 1); is_deeply( $p->parse( text => $text ), $expected, 'lowercase conversion' ); Config-Scoped-0.22/t/05-include.t000444004006000346 160411727425565 17320 0ustar00gaissmaikizinfra000000000000# vim: cindent ft=perl use warnings; use strict; use Test::More tests => 5; use File::Spec; BEGIN { use_ok('Config::Scoped') } my $cfg_file = File::Spec->catfile( 't', 'files', 'include.cfg' ); my ( $p, $cfg ); my $text = "%include $cfg_file; foo{}"; isa_ok( $p = Config::Scoped->new( warnings => { perm => 'off' } ), 'Config::Scoped' ); ok( eval { $cfg = $p->parse( text => $text ) }, 'include test' ); my $expected = { 'foo' => { 'scalar' => '1', 'hash' => { 'c' => 'C', 'a' => 'A', 'b' => 'B' }, 'list' => [ 'a', 'b', 'c', 'd' ] } }; is_deeply( $cfg, $expected, 'datastructure after include' ); $text = < {} }; $p = Config::Scoped->new( warnings => { perm => 'off' } ); is_deeply( $p->parse( text => $text ), $expected, 'include in block' ); Config-Scoped-0.22/t/07-block.t000444004006000346 215611727425565 16774 0ustar00gaissmaikizinfra000000000000# vim: cindent ft=perl sm sw=4 use warnings; use strict; use Test::More tests => 5; BEGIN { use_ok('Config::Scoped') } my ( $p, $cfg ); isa_ok( $p = Config::Scoped->new(), 'Config::Scoped' ); my $text = <<'eot'; # global scope b=1 # new scope # b gets redefined within scope { %warnings parameter off foo { b=2 } } # collect global scope parameters bar {} eot my $expected = { 'foo' => { 'b' => '2' }, 'bar' => { 'b' => '1' }, }; is_deeply( $p->parse( text => $text ), $expected, 'scoping tests, parameter' ); $text = <<'eot'; %macro _M1 m1 { %warnings macro off %macro _M1 m2 a = "_M1" } foo { a = "_M1" } eot $expected = { 'foo' => { 'a' => 'm1' } }; $p = Config::Scoped->new(); is_deeply( $p->parse( text => $text ), $expected, 'scoping tests, macro' ); $text = <<'eot'; foo bar baz { global = 1} { %warnings declaration off foo bar baz { scope = 1 } } eot $expected = { 'foo' => { 'bar' => { 'baz' => { 'scope' => '1' } } } }; $p = Config::Scoped->new(); is_deeply( $p->parse( text => $text ), $expected, 'scoping tests, declaration' ); Config-Scoped-0.22/t/11-eval.t000444004006000346 221111727425565 16614 0ustar00gaissmaikizinfra000000000000# vim: cindent ft=perl sm sw=4 use warnings; use strict; use Test::More tests => 5; BEGIN { use_ok('Config::Scoped') } my ( $p, $cfg ); my $text = <<'eot'; foo { sec = eval{ 3600 * 24 }}; bar { min = perl_code{ 60 * 24 }}; eot my $expected = { 'foo' => { 'sec' => 86400 }, 'bar' => { 'min' => 1440 }, }; isa_ok( $p = Config::Scoped->new(), 'Config::Scoped' ); is_deeply( $p->parse( text => $text ), $expected, 'eval test' ); $text = <<'eot'; foo { list = eval{ [1..9] }}; bar { hash = perl_code{ {red => '#FF0000', green => '#00FF00', blue => '#0000FF'}}}; eot $expected = { 'foo' => { 'list' => [ 1, 2, 3, 4, 5, 6, 7, 8, 9 ] }, 'bar' => { 'hash' => { 'red' => '#FF0000', 'green' => '#00FF00', 'blue' => '#0000FF', } }, }; $p = Config::Scoped->new; is_deeply( $p->parse( text => $text ), $expected, 'eval test' ); $text = <<'eot'; %macro IF_LIST 'eth1,eth2,eth3'; if { list = eval { [IF_LIST] }; } eot $expected = { 'if' => { 'list' => [ 'eth1', 'eth2', 'eth3' ] } }; $p = Config::Scoped->new; is_deeply( $p->parse( text => $text ), $expected, 'macro exp. in eval' ); Config-Scoped-0.22/t/17-perldsc.t000444004006000346 140211727425565 17330 0ustar00gaissmaikizinfra000000000000# vim: cindent ft=perl sm sw=4 use warnings; use strict; use Test::More tests => 4; BEGIN { use_ok('Config::Scoped') } my ( $p, $cfg ); my $text = <<'eot'; 'a' => [ '1', '2', '3', { 'foo' => 'bar' }, '4', '5', '6' ] eot my $expected = { '_GLOBAL' => { 'a' => [ '1', '2', '3', { 'foo' => 'bar' }, '4', '5', '6' ] } }; isa_ok( $p = Config::Scoped->new(), 'Config::Scoped' ); is_deeply( $p->parse( text => $text ), $expected, 'hol' ); $text = <<'eot'; 'bar' => { 'a' => '2' }, 'baz' => { 'a' => '1' }, 'foo' => { 'a' => '3' } eot $expected = { '_GLOBAL' => { 'bar' => { 'a' => '2' }, 'baz' => { 'a' => '1' }, 'foo' => { 'a' => '3' } } }; $p = Config::Scoped->new; is_deeply( $p->parse( text => $text ), $expected, 'hoh' ); Config-Scoped-0.22/t/12-param.t000444004006000346 260411727425565 16774 0ustar00gaissmaikizinfra000000000000# vim: cindent ft=perl sm sw=4 use warnings; use strict; use Test::More tests => 8; BEGIN { use_ok('Config::Scoped') } my ( $p, $cfg ); my $text = <<'eot'; { #1 { #2 { #3 a=3 } a=2 } a=1 } foo{} eot my $expected = { foo => {} }; isa_ok( $p = Config::Scoped->new(), 'Config::Scoped' ); is_deeply( $p->parse( text => $text ), $expected, 'lexically scoped' ); $text = <<'eot'; { #1 { #2 { #3 a=3 foo{} } a=2 bar{} } a=1 baz{} } eot $expected = { 'foo' => { 'a' => '3' }, 'bar' => { 'a' => '2' }, 'baz' => { 'a' => '1' }, }; $p = Config::Scoped->new; is_deeply( $p->parse( text => $text ), $expected, 'lexically scoped' ); $text = <<'eot'; a = default; foo { %warnings param off; a = 1 } bar { } eot $expected = { 'foo' => { 'a' => '1' }, 'bar' => { 'a' => 'default' }, }; $p = Config::Scoped->new; is_deeply( $p->parse( text => $text ), $expected, 'parameter redefinition' ); $text = <<'eot'; a = default; foo { a = 1 } bar { } eot $p = Config::Scoped->new; eval { $p->parse( text => $text ) }; isa_ok($@, 'Config::Scoped::Error::Validate::Parameter'); like($@, qr/redefinition/i, "$@"); $text = <<'eot'; LowerCase = 'Values dont convert' eot $expected = { _GLOBAL => { 'lowercase' => 'Values dont convert', }, }; $p = Config::Scoped->new(lc => 1); is_deeply( $p->parse( text => $text ), $expected, 'lowercase conversion' ); Config-Scoped-0.22/t/09-hashes.t000444004006000346 65311727425565 17137 0ustar00gaissmaikizinfra000000000000# vim: cindent ft=perl sm sw=4 use warnings; use strict; use Test::More tests => 3; BEGIN { use_ok('Config::Scoped') } my ( $p, $cfg ); isa_ok( $p = Config::Scoped->new(), 'Config::Scoped' ); my $text = <<'eot'; hash = { a=b; %warnings param off; a= { a=c } } eot my $expected = { '_GLOBAL' => { 'hash' => { 'a' => { 'a' => 'c' } } } }; is_deeply( $p->parse( text => $text ), $expected, 'hash tests' ); Config-Scoped-0.22/t/10-lists.t000444004006000346 167611727425565 17040 0ustar00gaissmaikizinfra000000000000# vim: cindent ft=perl sm sw=4 use warnings; use strict; use Test::More tests => 4; BEGIN { use_ok('Config::Scoped') } my ( $p, $cfg ); my $text = <<'eot'; list = [ #comment 1 2 3, 4 5, # comment 7 8 9 0 ] ############# 6, '7', "8", # # # # # 9 10 #############] ] eot my $expected = { '_GLOBAL' => { 'list' => [ '1', '2', '3', '4', '5', '6', '7', '8', '9', '10' ] } }; isa_ok( $p = Config::Scoped->new(), 'Config::Scoped' ); is_deeply( $p->parse( text => $text ), $expected, 'list test, comments' ); $text = <<'eot'; list = [ #comment [ 1 2 ], {a=b, c = [ d e ]}, foo, bar # comment ] eot $expected = { '_GLOBAL' => { 'list' => [ [ '1', '2' ], { 'c' => [ 'd', 'e' ], 'a' => 'b' }, 'foo', 'bar' ] } }; $p = Config::Scoped->new(); is_deeply( $p->parse( text => $text ), $expected, 'list test, complex' ); Config-Scoped-0.22/t/15-cache.t000444004006000346 67211727425565 16725 0ustar00gaissmaikizinfra000000000000# vim: cindent ft=perl use warnings; use strict; use Test::More tests => 5; use File::Spec; BEGIN { use_ok('Config::Scoped') } my $cache = File::Spec->catfile( 't', 'files', 'cache-test.cfg' ); my ( $p, $cfg ); isa_ok( $p = Config::Scoped->new( file => $cache, warnings => { perm => 'off' } ), 'Config::Scoped' ); ok( $cfg = $p->parse, 'parse' ); ok( $p->store_cache, 'dump' ); is_deeply( $p->retrieve_cache, $cfg, 'retrieve' ); Config-Scoped-0.22/t/06-quote.t000444004006000346 306111727425565 17032 0ustar00gaissmaikizinfra000000000000# vim: cindent ft=perl use warnings; use strict; use Test::More tests => 5; BEGIN { use_ok('Config::Scoped') } my ( $p, $cfg ); isa_ok( $p = Config::Scoped->new(), 'Config::Scoped' ); my $text = <<'eot'; foo { word = without_spaces_and_other_separators single = 'everything you know from "perl" in single quotes!' %macro _MACRO_ macro double = "now with _MACRO_ expansion in double quotes" 'here doc' = < { 'double' => 'now with macro expansion in double quotes', 'single' => 'everything you know from "perl" in single quotes!', 'word' => 'without_spaces_and_other_separators', 'here doc' => ' with macro expansion ' } }; is_deeply( $p->parse( text => $text ), $expected, 'simple quoting tests' ); $text = <<'eot'; foo { single = '\tasdf\n'; double = "\tasdf\n"; here_single = <<'stop'; \tasdf\n stop here_double = < { single => '\tasdf\n', double => "\tasdf\n", here_single => '\tasdf\n ', here_double => "\tasdf\n\n", } }; $p = Config::Scoped->new(); is_deeply( $p->parse( text => $text ), $expected, 'backslash substitution' ); $text = <<'eot'; rock { escape = "\x43\x6f\x6e\x66\x69\x67\x3a\x3a\x53\x63\x6f\x70\x65\x64\x20\x72\x6f\x63\x6b\x73"; } eot $expected = { 'rock' => { 'escape' => 'Config::Scoped rocks' } }; $p = Config::Scoped->new(); is_deeply( $p->parse( text => $text ), $expected, 'more escapes' ); Config-Scoped-0.22/t/92_pod-coverage.t000444004006000346 140411727425565 20336 0ustar00gaissmaikizinfra000000000000#!/usr/bin/perl # Ensure pod coverage in your distribution use strict; BEGIN { $| = 1; $^W = 1; } my @MODULES = ( 'Pod::Coverage 0.18', 'Test::Pod::Coverage 1.08', ); # Don't run tests during end-user installs use Test::More; unless ( $ENV{AUTOMATED_TESTING} or $ENV{RELEASE_TESTING} ) { plan( skip_all => "no RELEASE_TESTING, author tests not required for installation" ); } # Load the testing modules foreach my $MODULE ( @MODULES ) { eval "use $MODULE"; if ( $@ ) { $ENV{RELEASE_TESTING} ? die( "Failed to load required release-testing module $MODULE" ) : plan( skip_all => "$MODULE not available for testing" ); } } my $trustme = [ # Config::Scoped::Error 'PROPAGATE', 'stringify', ]; all_pod_coverage_ok({trustme => $trustme}); 1; Config-Scoped-0.22/t/02-perm.t000444004006000346 75011727425565 16616 0ustar00gaissmaikizinfra000000000000# vim: cindent ft=perl # change 'tests => 1' to 'tests => last_test_to_print'; use warnings; use strict; use Test::More tests => 4; use File::Spec; BEGIN { use_ok('Config::Scoped') } my $unsafe_cfg = File::Spec->catfile( 't', 'files', 'fvalid.cfg' ); chmod 0664, $unsafe_cfg; my ($p, $cfg); isa_ok($p = Config::Scoped->new(file => $unsafe_cfg), 'Config::Scoped'); eval { $cfg = $p->parse; }; isa_ok($@, 'Config::Scoped::Error::Validate::Permissions'); like($@, qr/is unsafe/i, "$@"); Config-Scoped-0.22/t/04-macros.t000444004006000346 343011727425565 17157 0ustar00gaissmaikizinfra000000000000# vim: cindent ft=perl use warnings; use strict; use Test::More tests => 8; use File::Spec; BEGIN { use_ok('Config::Scoped') } my $macros_cfg = File::Spec->catfile( 't', 'files', 'macros.cfg' ); my ($p, $cfg); isa_ok($p = Config::Scoped->new(file => $macros_cfg), 'Config::Scoped'); ok($p->set_warnings(name => 'perm', switch => 'off'), 'permission warnings off'); ok(eval {$cfg = $p->parse}, 'parsing macros'); my $text = <<'eot'; { %macro _M1 m1; # lexically scoped { %macro _M2 m2; foo { _M1 = "_M1"; _M2 = "_M2" } } bar { _M1 = "_M1"; _M2 = "_M2" } } baz { _M1 = "_M1"; _M2 = "_M2" } eot my $expected = { 'foo' => { '_M1' => 'm1', '_M2' => 'm2', }, 'bar' => { '_M1' => 'm1', '_M2' => '_M2', }, 'baz' => { '_M1' => '_M1', '_M2' => '_M2', }, }; $p = Config::Scoped->new; is_deeply( $p->parse( text => $text ), $expected, 'macros lexically scoped' ); $text = <<'eot'; { %macro _M1 m1; # lexically scoped foo { _M1 = "_M1" } } %macro _M1 'no redefinition'; bar { _M1 = "_M1" } eot $expected = { 'foo' => { '_M1' => 'm1' }, 'bar' => { '_M1' => 'no redefinition' }, }; $p = Config::Scoped->new; is_deeply( $p->parse( text => $text ), $expected, 'macros lexically scoped' ); # no metacharacters expansion $text = <<'eot'; %macro _M. 'quote metacharacter .'; bar { _M1 = "_M1" } eot $expected = { 'bar' => { '_M1' => '_M1' }, }; $p = Config::Scoped->new; is_deeply( $p->parse( text => $text ), $expected, 'quoting meta-characters' ); $text = <<'eot'; %macro _M. 'quote metacharacter .'; foo { _M1 = "_M." } eot $expected = { 'foo' => { '_M1' => 'quote metacharacter .' }, }; $p = Config::Scoped->new; is_deeply( $p->parse( text => $text ), $expected, 'quoting meta-characters' ); Config-Scoped-0.22/t/16-warn.t000444004006000346 314611727425565 16651 0ustar00gaissmaikizinfra000000000000# vim: cindent ft=perl sm sw=4 use warnings; use strict; use Test::More tests => 20; BEGIN { use_ok('Config::Scoped') } my ( $p, $cfg ); ok( $p = Config::Scoped->new( warnings => 'off' ), 'constructor with warnings' ); ok( !$p->warnings_on( name => 'all' ), 'warnings_on: all' ); ok( !$p->warnings_on( name => 'digest' ), 'warnings_on: digest' ); ok( !$p->warnings_on( name => 'foo' ), 'warnings_on: foo' ); ok( $p->set_warnings( name => 'foo', switch => 'on' ), 'set_warnings: foo' ); ok( $p->warnings_on( name => 'foo' ), 'warnings_on: foo' ); ok( !$p->warnings_on( name => 'all' ), 'warnings_on: all' ); ok( !$p->warnings_on( name => 'parameter' ), 'warnings_on: parameter' ); ok( $p = Config::Scoped->new( warnings => { param => 'off', foo => 'off', perm => 'on' } ), 'constructor with warnings hash' ); my $warnings = { parameter => 'off', permissions => 'on', foo => 'off' }; is_deeply( $p->{local}{warnings}, $warnings, 'warnings hash' ); ok( $p->warnings_on( name => 'all' ), 'warnings_on: all' ); ok( $p->warnings_on( name => 'perm' ), 'warnings_on: permissions' ); ok( !$p->warnings_on( name => 'foo' ), 'warnings_on: foo' ); ok( $p->set_warnings( name => 'all', switch => 'off' ), 'set_warnings: all' ); ok( ! $p->warnings_on( name => 'perm' ), 'warnings_on: permissions' ); ok( $p->parse( text=> '%warnings permissions on'), 'warnings directive'); ok( $p->warnings_on( name => 'perm' ), 'warnings_on: permissions' ); ok( $p->parse( text=> '%warnings off'), 'warnings directive'); $warnings = { all => 'off'}; is_deeply( $p->{local}{warnings}, $warnings, 'warnings hash' ); Config-Scoped-0.22/t/03-scalars.t000444004006000346 76411727425565 17311 0ustar00gaissmaikizinfra000000000000# vim: cindent ft=perl # change 'tests => 1' to 'tests => last_test_to_print'; use warnings; use strict; use Test::More tests => 3; use File::Spec; BEGIN { use_ok('Config::Scoped') } my $scalar_cfg = File::Spec->catfile( 't', 'files', 'scalar.cfg' ); my ( $p, $cfg ); isa_ok( $p = Config::Scoped->new( file => $scalar_cfg, warnings => { parameter => 'off', permissions => 'off' } ), 'Config::Scoped' ); ok( eval { $cfg = $p->parse }, 'parsing scalars' ); #diag $@ Config-Scoped-0.22/t/91_pod.t000444004006000346 123211727425565 16543 0ustar00gaissmaikizinfra000000000000#!/usr/bin/perl # Test that the syntax of our POD documentation is valid use strict; BEGIN { $| = 1; $^W = 1; } my @MODULES = ( 'Pod::Simple 3.07', 'Test::Pod 1.26', ); # Don't run tests during end-user installs use Test::More; unless ( $ENV{AUTOMATED_TESTING} or $ENV{RELEASE_TESTING} ) { plan( skip_all => "no RELEASE_TESTING, author tests not required for installation" ); } # Load the testing modules foreach my $MODULE ( @MODULES ) { eval "use $MODULE"; if ( $@ ) { $ENV{RELEASE_TESTING} ? die( "Failed to load required release-testing module $MODULE" ) : plan( skip_all => "$MODULE not available for testing" ); } } all_pod_files_ok(); 1; Config-Scoped-0.22/t/08-comments.t000444004006000346 137411727425565 17531 0ustar00gaissmaikizinfra000000000000# vim: cindent ft=perl sm sw=4 use warnings; use strict; use Test::More tests => 3; BEGIN { use_ok('Config::Scoped') } my ( $p, $cfg ); isa_ok( $p = Config::Scoped->new(), 'Config::Scoped' ); my $text = <<'eot'; a=b; #comment after parameter assignment { # comment in block b=c; #again after assignment # on an own line } hash = { # comment within a hash a=b; # after an assignment # on an own line } #macro foo bar; # after a pragma #warnings on; #again after a pragma foo { # in a declaration h = { # also here, eats the leading } } } eot my $expected = { 'foo' => { 'hash' => { 'a' => 'b' }, 'h' => {}, 'a' => 'b' } }; is_deeply( $p->parse( text => $text ), $expected, 'comment tests' ); Config-Scoped-0.22/t/01-basics.t000444004006000346 132111727425565 17131 0ustar00gaissmaikizinfra000000000000# vim: cindent ft=perl use warnings; use strict; use Test::More tests => 10; use File::Spec; BEGIN { use_ok('Config::Scoped') } my $p; ok( $p = Config::Scoped->new(), 'Constructor'); isa_ok( $p, 'Config::Scoped' ); can_ok( $p, qw(parse warnings_on set_warnings)); ok( $p->parse( text => 'a=b;' ), 'basic parse test: string' ); ok( $p = Config::Scoped->new( file => File::Spec->catfile( 't', 'files', 'basic.cfg' ), warnings => 'off', ), 'Constructor' ); ok( $p->parse, 'basic parse test: file' ); ok( $p = EmptySubclassTest->new(), 'Constructor'); isa_ok( $p, 'EmptySubclassTest' ); can_ok( $p, qw(parse warnings_on set_warnings)); package EmptySubclassTest; use base 'Config::Scoped'; Config-Scoped-0.22/t/14-except.t000444004006000346 251511727425565 17167 0ustar00gaissmaikizinfra000000000000# vim: cindent ft=perl use warnings; use strict; use Test::More tests => 17; use File::Spec; BEGIN { use_ok('Config::Scoped') } my ( $p, $cfg ); eval { $p = Config::Scoped->new('odd number');}; isa_ok( $@, 'Config::Scoped::Error' ); like( $@, qr/odd number/i, "$@" ); eval { $p = Config::Scoped->new(file => \*STDIN);}; isa_ok( $@, 'Config::Scoped::Error' ); like( $@, qr/filehandle/i, "$@" ); eval { $p = Config::Scoped->new(config => 'foo')}; isa_ok( $@, 'Config::Scoped::Error' ); like( $@, qr/no hash ref/i, "$@" ); eval { $p = Config::Scoped->new(safe => 'foo')}; isa_ok( $@, 'Config::Scoped::Error' ); like( $@, qr/reval/i, "$@" ); $p = Config::Scoped->new; eval { $cfg = $p->parse('odd number')}; isa_ok( $@, 'Config::Scoped::Error' ); like( $@, qr/odd number/i, "$@" ); $p = Config::Scoped->new; eval { $cfg = $p->parse}; isa_ok( $@, 'Config::Scoped::Error' ); like( $@, qr/no text/i, "$@" ); $p = Config::Scoped->new( file => File::Spec->catfile( 't', 'files', 'null' ), warnings => { perm => 'off' } ); eval { $cfg = $p->parse}; isa_ok( $@, 'Config::Scoped::Error' ); like( $@, qr/is empty/i, "$@" ); $p = Config::Scoped->new( file => File::Spec->catfile( 't', 'files', 'increc1' ), warnings => { perm => 'off' } ); eval { $cfg = $p->parse; }; isa_ok( $@, 'Config::Scoped::Error' ); like( $@, qr/include loop/i, "$@" ); Config-Scoped-0.22/t/files000755004006000346 011727425565 16232 5ustar00gaissmaikizinfra000000000000Config-Scoped-0.22/t/files/increc1000444004006000346 5711727425565 17600 0ustar00gaissmaikizinfra000000000000# recursive inclusion test %include increc2; Config-Scoped-0.22/t/files/basic.cfg000444004006000346 511727425565 20044 0ustar00gaissmaikizinfra000000000000a=b; Config-Scoped-0.22/t/files/increc2000444004006000346 5711727425565 17601 0ustar00gaissmaikizinfra000000000000# recursive inclusion test %include increc3; Config-Scoped-0.22/t/files/macros.cfg000444004006000346 3611727425565 20273 0ustar00gaissmaikizinfra000000000000#macro M1 foo "_M1_bar" = baz Config-Scoped-0.22/t/files/fvalid.cfg000444004006000346 011727425565 20223 0ustar00gaissmaikizinfra000000000000Config-Scoped-0.22/t/files/cache-test.cfg000444004006000346 62111727425565 21047 0ustar00gaissmaikizinfra000000000000# defaults, lexically scoped community = public; variables = [ ifInOctets, ifOutOctets ]; oids = { ifInOctets = 1.3.6.1.2.1.2.2.1.10; ifOutOctets = 1.3.6.1.2.1.2.2.1.16; }; %include include.cfg; %warnings parameter off; ### allow parameter redefinition devices rtr001 { ports = [ 1, 2, 8, 9 ]; } devices rtr007 { community = 'really top secret!'; ports = [ 1, 2, 3, 4 ]; } Config-Scoped-0.22/t/files/null000444004006000346 011727425565 17172 0ustar00gaissmaikizinfra000000000000Config-Scoped-0.22/t/files/increc3000444004006000346 5711727425565 17602 0ustar00gaissmaikizinfra000000000000# recursive inclusion test %include increc1; Config-Scoped-0.22/t/files/include.cfg000444004006000346 10011727425565 20442 0ustar00gaissmaikizinfra000000000000scalar = 1 list = [ a b c d] hash = { a = A, b = B, c = C } Config-Scoped-0.22/t/files/scalar.cfg000444004006000346 202111727425565 20310 0ustar00gaissmaikizinfra000000000000####################### a = 1 a = '1' a = "1" a = eval{1} a = eval{'1'} a = eval{"1"} a = <new( compactDump => 1 ) or die "Can't create a Dumpvalue object,"; my %opts; getopts( 'lwvtdDc', \%opts ) or usage(); my $cfg_file; $cfg_file = shift || usage() unless $opts{t}; local $::RD_TRACE = 40 if $opts{v}; my $parser = Config::Scoped->new( file => $cfg_file, $opts{w} ? (warnings => 'off') : (), $opts{l} ? (lc => 1) : (), ) or die "Can't create a scoped parser,"; my $config; unless ( $opts{c} ) { if ( $opts{t} ) { my $text = join '', <>; $config = $parser->parse( text => $text ); warn $@ if $@; } else { $config = $parser->parse; warn $@ if $@; } $parser->store_cache || die "can't store the config hash," if defined $config && $opts{d}; } else { $config = $parser->retrieve_cache or die "can't read config cache,"; } $dv->dumpValue($config) unless $opts{D}; print Data::Dumper->Dump([$config], ['config']) if $opts{D}; exit 0; sub usage { die <