From babc3c272544eec352786c4d9a28210293016637 Mon Sep 17 00:00:00 2001 From: denghao Date: Thu, 15 Sep 2022 04:28:58 +0300 Subject: [PATCH] Import Upstream version 2.65 --- Changelog | 1106 ++++++++++++++ General.pm | 2889 +++++++++++++++++++++++++++++++++++++ General/Extended.pm | 663 +++++++++ General/Interpolated.pm | 370 +++++ MANIFEST | 57 + META.json | 50 + META.yml | 28 + Makefile.PL | 30 + README | 107 ++ example.cfg | 74 + t/Tie/IxHash.pm | 630 ++++++++ t/Tie/README | 7 + t/apache-include-opt.conf | 7 + t/apache-include.conf | 6 + t/cfg.16 | 32 + t/cfg.16a | 3 + t/cfg.17 | 4 + t/cfg.19 | 16 + t/cfg.2 | 14 + t/cfg.20.a | 2 + t/cfg.20.b | 2 + t/cfg.20.c | 2 + t/cfg.3 | 4 + t/cfg.34 | 18 + t/cfg.39 | 13 + t/cfg.4 | 6 + t/cfg.40 | 7 + t/cfg.41 | 6 + t/cfg.42 | 13 + t/cfg.43 | 5 + t/cfg.45 | 14 + t/cfg.46 | 3 + t/cfg.5 | 5 + t/cfg.51 | 5 + t/cfg.55 | 5 + t/cfg.58 | 3 + t/cfg.6 | 13 + t/cfg.7 | 8 + t/cfg.8 | 45 + t/complex.cfg | 28 + t/complex/n1.cfg | 16 + t/complex/n2.cfg | 17 + t/dual-include.conf | 6 + t/included.conf | 1 + t/notincluded.conf.not | 1 + t/run.t | 793 ++++++++++ t/sub1/cfg.sub1 | 3 + t/sub1/cfg.sub1b | 1 + t/sub1/cfg.sub1c | 1 + t/sub1/cfg.sub1d | 1 + t/sub1/cfg.sub1e | 1 + t/sub1/sub2/cfg.sub2 | 5 + t/sub1/sub2/cfg.sub2b | 1 + t/sub1/sub2/sub3/cfg.sub3 | 5 + t/test.rc | 90 ++ t/utf8_bom/bar.cfg | 3 + t/utf8_bom/foo.cfg | 4 + 57 files changed, 7249 insertions(+) create mode 100644 Changelog create mode 100644 General.pm create mode 100644 General/Extended.pm create mode 100644 General/Interpolated.pm create mode 100644 MANIFEST create mode 100644 META.json create mode 100644 META.yml create mode 100644 Makefile.PL create mode 100644 README create mode 100644 example.cfg create mode 100644 t/Tie/IxHash.pm create mode 100644 t/Tie/README create mode 100644 t/apache-include-opt.conf create mode 100644 t/apache-include.conf create mode 100644 t/cfg.16 create mode 100644 t/cfg.16a create mode 100644 t/cfg.17 create mode 100644 t/cfg.19 create mode 100644 t/cfg.2 create mode 100644 t/cfg.20.a create mode 100644 t/cfg.20.b create mode 100644 t/cfg.20.c create mode 100644 t/cfg.3 create mode 100644 t/cfg.34 create mode 100644 t/cfg.39 create mode 100644 t/cfg.4 create mode 100644 t/cfg.40 create mode 100644 t/cfg.41 create mode 100644 t/cfg.42 create mode 100644 t/cfg.43 create mode 100644 t/cfg.45 create mode 100644 t/cfg.46 create mode 100644 t/cfg.5 create mode 100644 t/cfg.51 create mode 100644 t/cfg.55 create mode 100644 t/cfg.58 create mode 100644 t/cfg.6 create mode 100644 t/cfg.7 create mode 100644 t/cfg.8 create mode 100644 t/complex.cfg create mode 100644 t/complex/n1.cfg create mode 100644 t/complex/n2.cfg create mode 100644 t/dual-include.conf create mode 100644 t/included.conf create mode 100644 t/notincluded.conf.not create mode 100644 t/run.t create mode 100644 t/sub1/cfg.sub1 create mode 100644 t/sub1/cfg.sub1b create mode 100644 t/sub1/cfg.sub1c create mode 100644 t/sub1/cfg.sub1d create mode 100644 t/sub1/cfg.sub1e create mode 100644 t/sub1/sub2/cfg.sub2 create mode 100644 t/sub1/sub2/cfg.sub2b create mode 100644 t/sub1/sub2/sub3/cfg.sub3 create mode 100644 t/test.rc create mode 100644 t/utf8_bom/bar.cfg create mode 100644 t/utf8_bom/foo.cfg diff --git a/Changelog b/Changelog new file mode 100644 index 0000000..50b5368 --- /dev/null +++ b/Changelog @@ -0,0 +1,1106 @@ +2.65 - fix rt.cpan.org#132893: clarified license, now licensed + under the Artistic License 2.0. + - fix rt.cpan.org#139261: correctly include directories. + + - fix rt.cpan.org#118746: remove the comma from legal + variable names, added mandatory start characters a-zA-Z0-9, + added a section in the POD to clarify this. + + - fix rt.cpan.org#119160: fix IfDefine code. Thanks for the patch. + +2.64 - fix rt.cpan.org#142095: copy default hash, avoid modification. + + - the Catalyst folks who hosted the source of this module + closed or moved the repository, I have not been informed and + have therefore lost all history of the module. So I moved + to github (https://github.com/TLINDEN/Config-General). + Thanks for nothing, Catalyst. + +2.63 - fix for rt.cpan.org#116340: do only consider a backslash + as meta escape char, but not if it appears on it's own, + as it happens on windows platforms. Thanks to for finding + and tracking it down. + +2.62 - fix rt.cpan.org#115326: Callback on 'pre_open' not called + when glob expands to one include file + + - added patch by Niels van Dijke, which adds apache IFDefine + support. Use -UseApacheIfDefine=>1 to enable, add defines + with -Define and add to your config, see + pod for details. + + - added test case for the code. + + - fixed unindented half of the pod, which was largely no + readable because of this. However, I wonder why this hasn't + reported, seems nobody reads the docs :) + + - fixed tab/space issues here and there + +2.61 - fix rt.cpan.org#113671: ignore utf BOM, if any and turn on + UTF8 support if not yet enabled. + +2.60 - fix rt.cpan.org#107929: added missing test config. + +2.59 - fix rt.cpan.org#107108 by adding support for IncludeOptional. + - clarified documentation on StoreDelimiter. + +2.58 - bumbp version + +2.57 - fix rt.cpan.org#104548, dont allow special chars like newline + or < in keys, which leads to faile when saving. + +2.56 - fix rt.cpan.org#95325 + +2.55 - fix rt.cpan.org#95314 + +2.54 - fixed rt.cpan.org#39814. changed the order of pre-processing + in _read(): 1) remove comments, 2) check for continuation, + 3) remove empty lines. + +2.53 - applied patch rt.cpan.org#68153, which adds a find() method to + Config::General::Extended. + + - fixed rt.cpan.org#79869 (in fact it has been fixed in 2.52 + but I forgot to mention it here). + + - applied spelling fixes rt.cpan.org 87072+87080. + + - fixed rt.cpan.org#89379 + +2.52 - applied pod patch rt.cpan.org#79603 + + - fixed rt.cpan.org#80006, it tolerates now whitespaces + after the block closing > + + - added -Plug parameter, which introduces plugin closures. + idea from rt.cpan.org#79694. + Currently available hooks are: + pre_open, pre_read, post_read, pre_parse_value, post_parse_value + + - applied patch by Ville Skyttä, spelling fixes. + + - fixed rt.cpan.org#85080, more spelling fixes. + + - applied patch rt.cpan.org#85132, which fixes a deprecation + warning in perl 5.18 and above. Fixes #85668 as well. + + - applied patch rt.cpan.org#85538, c-style comments + are ignored inside here-docs. + + - fixed rt.cpan.org#82637, don't use indirect object syntax + in pod and code. + + 2.51 - fixed rt.cpan.org#77667 which resulted in invalid configs + written to file when using save_file() and a named block, + whose 2nd part starts with a /. + + - fixed rt.cpan.org#64169 by applying patch by Dulaunoy Fabrice. + adds -NoEscape switch which turns off escaping of anything. + + - implemented suggestion of rt.cpan.org#67564 by adding 3 new + parameters: -NormalizeOption, -NormalizeBlock and -NormalizeValue, + which take a subroutine reference and change the block, + option or value accordingly. + + - fixed rt.cpan.org#65860+76953 undefined value error. + + + 2.50 + - fixed rt.cpan.org#63487 documentation error. + + - fixed rt.cpan.org#61302, now croak if the config file + parameter is a directory and directory include is not + turned on. + + - fixed rt.cpan.org#60429 META.yml typo + + - added new option -AllowSingleQuoteInterpolation, which + turns on interpolation for variables inside single quotes. + + - added test case for the new option + + + 2.49 + - fixed rt.cpan.org#56532, '#' missed during fix for + 56370 in 2.45. + + - added test case for this too + + + 2.48 + - arg, uploaded the wrong file to pause, so another version + bump up. + + - fixed typos in pod section for -ForceArray. + + + 2.47 + - fixed rt.cpan.org#53759 by adding new option -ForceArray. + when enabled a single config value enclosed in [] will become + an array forcefully. + + - fixed typo in license: it is "artistic", not "artificial". + + + 2.46 + - fixed rt.cpan.org#56370: there was a sort() call in _store() + left, which lead to sorted arrays even if -SaveSorted were + turned off. + + + 2.45 + - fixed rt.cpan.org#50647 escaping bug. Now escaped $ or + backslash characters are handled correctly (across save too) + + - fixed rt.cpan.org#52047, tied hash will remain tied + when savong to a file. + + - fixed rt.cpan.org#54580, preserve single quotes during + variable interpolation corrected. No more using rand() + to mark single quotes but an incrementor instead. + + - fixed rt.cpan.org#42721+54583, empty config values will no + more handed over to interpreting methods (as interpolate + or autotrue and the like) but returned as undef untouched. + + + 2.44 + - fixed rt.cpan.org#49023 by rolling back change in 2.43 + in line 158, regarding GLOB support. + + 2.43 + - fixed rt.cpan.org#40925, $indichar replaced by internal + configuration variable EOFseparator, which contains + a 256 bit SHA checksum of the date I fixed the bug. + This will prevent future conflicts hopefully. In addition + it makes it possible to make it customizable, if necessary, + in a future release. + + - fixed rt.cpan.org#42721, return undef for empty values + + - fixed rt.cpan.org#42331, return undef for empty objects + + - fixed rt.cpan.org#44600, comments after blockname + causes parser failure. + + - fixed rt.cpan.org#42287, whitespace at beginning or end + of a quoted value gets lost after save(). + + - fixed rt.cpan.org#46184, variables that were not previously + defined are deleted when -InterPolateEnv is enabled. + + - fixed bug in config loader for FileHandle objects, it + supports now any compatible object. Hint by Ingo Schmiegel. + + - applied spelling- and speedup patches by Ville Skyttä. + + - applied documentation patch by Jordan Macdonald. + + + 2.42 + - dist tarball for 2.41 missed t/Tie/LxHash.pm. Dammit. + the File to the MANIFEST. + + + 2.41 + - fixed rt.cpan.org#38635. apache-like include now supports + quoted strings. + + - fixed rt.cpan.org#41748. saving config with -tie enabled + now keeps the tie as documented. + + - added unit test for -tie. For this to work, a copy of + Tie::LxHash module is delivered with Config::General + source, but will not installed, in fact, it is only + used for 'make test' (number 50) + + - fixed rt.cpan.org#39159. documentation of functional interface + now reflects that qw$method) is now required. + + - applied patch by AlexK fixing rt.cpan.org#41030: + if files are included by means of a glob pattern having the -IncludeGlob + option activated, paths specified by the -ConfigPath option are being + neglected when trying to spot the files. This patch fixes this + + - applied patch by fbicknel, fixes rt.cpan.org#41570: + An array of scalars (eg: option = [1,2,3]) cannot + be used for interpolation (which element shall we use?!), so + we ignore those types of lists and don't build a __stack for them. + + + + 2.40 + - fixed SplitDelimiter parser regex, it does no more consider + non-whitespaces (\S+?) as the option name but anything + before the delimiter (.+?), this fixes bug rt.cpan.org#36607, + the fix of 2.39 were not sufficient. Thanks to + Jeffrey Ratcliffe for pointing it out. + + - added new parameter -SaveSorted. The default value is 0, + that means configs will be saved unsorted (as always), + however if you want to save it sorted, turn this parameter + to 1. Thanks to Herbert Breunung for the hint. + + - added complexity test, which checks a combination + of various complex features of the parser. + + 2.39 + - fixed rt.cpan.org#35122. This one was one of the most + intriguing bugs I've ever observed in my own code. The + internal temporary __stack hashref were copied from one + subhash to another to enable inheritance of variables. + However, the hashes were copied by reference, so once a + value changed later, that value were overwritten because + the __stack in question were just a reference. I introduced + a simple function _copy() which copies the contents of + the __stack by value, which solved the bug. + Conclusion: beware of perl hash refs! + + - fixed rt.cpan.org#36607, accept whitespaces in heredoc + names if split delimiter is gues (equalsign or whitespace) + + - fixed rt.cpan.org#34080 (typo) + + - fixed rt.cpan.org#35766. Variables inside single quoted + strings will no more interpolated (as the docu states). + Also added test case for this. + + - fixed bug rt.cpan.org#33766. Checking for defined not true + in ::Extended::AUTOLOAD(). + + - added -UTF8 flag, which opens files in utf8 mode + (suggested by KAORU, rt.cpan.org#35583) + I decided not to add a test case for this, since perls + utf8 support is not stable with all versions. + + + 2.38 + - fixed rt.cpan.org#31529 variable inheritance failed + with multiple named blocks. + + - fixed rt.cpan.org#33447, regex to catch variable + names were too strict, now - . + or : are allowed too. + + - fixed rt.cpan.org#33385 and #32978 - using arrayrefs + as param to -String didn't work anymore (sic) + + - fixed rt.cpan.org#33216 - variable stack were not properly + re-constructed for pre-existing variables if + -MergeDuplicateOptions is turned on. + + + 2.37 + - "fixed" rt.cpan.org#30199 - check for invalid and + unsupported structures, especially mixing blocks + and scalars with identical names. + + - added checks to 'make test' to test for the above + checks. + + - revoked patch of rt.cpan.org#27225, it broke running + code. + + - fixed rt.cpan.org#30063 (and #27225!) by reimplementing + the whole interpolation code. The internal stack is + no more a class variable of the module but stored + directly within the generated config hash and cleaned + before returning to the user. + + - added (modified) patch rt.cpan.org#30063 to check + if interpolation works with supplied default config + works. + + + 2.36 + - oh my goodness! For some unknown reason I deleted the + Makefile.PL before packaging. Dammit. So, here it is + again. + + 2.35 + - 'make test' failed under perl 5.5 because some prequisite + modules were not found. So now I added all requirements + to Makefile.PL, even if those modules are part of + recent perls (beginning with 5.6). I could have also + added a 'use 5.6' to the code but this would users + of perl5 exclude. This way they have the possibility + to fix their installation. Hopefully. + + No code changes otherwise. + + + 2.34 + - fixed rt.cpan.org#27271 - removed output file from + manifest. + + - fixed rt.cpan.org#27225 - clear vars off the stack + if entering a new block, so old vars get not re-used. + + - fixed rt.cpan.org#27110 - re-implemented support + for arrayref as -String parameter. + + - fixed rt.cpan.org#24155 - relative include bug fixed. + + - applied patch by GWYN, (see fixed rt.cpan.org#27622) + which allows the same file included multiple times. + there is no loop detection if turned on. new option + introduced: -IncludeAgain => 1 (default turned off). + + - added support for -IncludeAgain to directory include + code too. + + - the directory globbing code used slashes to join + directory and file names. changed this to use catfile() + instead. + + + 2.33 + - fixed rt.cpan.org#26333 - just return $con if env var + is undefined. + + - applied part of a patch supplied by Vincent Rivellino + which turns off explicit empty block support if in + apache compatibility mode, see next. + + - added new option -ApacheCompatible, which makes the + module behave really apache compatible by setting the + required options. + + - a little bit re-organized the code, most of the stuff + in new() is now outsourced into several extra subs to + make maintenance of the code easier. The old new() sub + in fact was a nightmare. + + - fixed a bug reported by Otto Hirr : + the _store() sub used sort() to sort the keys, which conflicts + with sorted hashes (eg. tied using Tie::IxHash). + + - fixed tie bug reported by King, Jason , + loading of the tie module didn't work. + + + 2.32 + - fixed rt.cpan.org#24232 - import ENV vars only if defined + + - fixed rt.cpan.org#20742 - dont' overwrite a var if re-defined + in current scope, interpolation failed for re-defined vars and used + the value of the var defined in outer scope, not the current one. + + - fixed rt.cpan.org#17852 - a 0 as blockname were ignored. applied + patch by SCOP to t/run.t to test for 0 in blocks. + + - applied most hints Perl::Critic had about Config::General: + o the functions ParseConfig SaveConfig SaveConfigString must + now imported implicitly. This might break existing code, but + is easily to fix. + o using IO::File instead of open(). + o General.pm qualifies for "stern" level after all. + + - added much more tests to t/run.t for 'make test'. + + - using Test::More now. + + + + 2.31 + - applied patches by Jason Rhinelander : + o bugfix: multiple levels if include files didn't + work properly. + + o new option -IncludeDirectories, which allows + to include all files of a directory. The directory + must be specified by -ConfigFile as usual. + + o new option -IncludeGlob, which allows to + use globs (wildcards) to include multiple files. + + o -ConfigPath can be speciefied using a single + scalar value instead of an array if there is only + one path. + + o bugfix: quotes from quoted block names were + not removed properly. + + o fixes and updates for tests (make test) for + the above patches. + + Thanks a lot Jason. + + - fixed number of tests in run.t + + - applied suggestion by Eric Kisiel : + ::Extended::keys() returns an empty hash if the + referring object is not hash. + + - fixed bug #14770, "Use of uninitialized value.." during + environment variable interpolation. + + + 2.30 + - applied patch by Branislav Zahradnik + which adds -InterPolateEnv. + This allows to use environment variables too. It + implies -InterPolateVars. + + - added object list capability for the ::Extended::obj() + method. If a certain key points to an array of + hashrefs, then the whole arrayref is returned. + Suggested by Alan Hodgkinson . + + 2.29 + - applied patch by brian@kronos.com via rt.cpan.org + #11211. + + - applied patch by plasmaball@pchome.com.tw via + rt.cpan.org #5846 + + - added new files to MANIFEST file. + + - added example.cfg to show the config format. + + + 2.28 + - fixed bug in save(), now blocks containing whitespaces + will be saved using quotes, in addition the parser observes + the quoting feature, added portion about this to the pod + doc. pointed out by Jeff Murphy . + + - added internal list of files opened so far to avoid + reading in the same file multiple times. + Suggested by Michael Graham. + + - added new method files() which returns the above list. + + - added workaround for foolish perl installation on + debian systems (croak() doesn't work anymore as of + 5.8.4, it's a shame!) + + - applied patch by Michael Graham which fixes IncludeRelative + feature, now an included file is being included relative + to the calling config file, not the first one. + + - added 'make test' targets for files() and include + stuff. (by Michael too) + + + 2.27 + - bugfix in _store, which caused warning when saving + a config containing empty hashes. Reported by + herbert breunung . + + - removed applied patch (added in 2.20), there are no more + calls to binmode(), this destroys portability, because + perls determines itself wether it uses \n or \r\n as newline. + Reported by herbert breunung too. + + - applied patch by Danial Pearce , + scalars containing a backslash as the last character will + be written out as here-doc when storing a config to disk. + + + 2.26 + - fixed invalid regexp in _open() which circumvented + explicit empty block to work when the block statement + included whitespaces. + + - more finetuning in Makefile.PL for cleaning emacs' + ~ files. + + + 2.25 + - fixed bug with not working -IncludeRelative setting when + including a config file. It were only included from the + location relative to the underlying config if it were + non-existent. reported by Dmitry Koteroff . + + - applied patch by Danial Pearce + which adds the -BackslashEscape parameter to enable + general escaping of special characters using the + backslash. + + - fixed bug reported by Harold van Oostrom : + according to the documentation one can call new() with + a hash-ref as its single parameter which would then + used as the config. This didn't work and were fixed. + + - added feature suggested by Eric Andreychek : + now block statements like this are allowed: "" + which is called an explicit empty block. This generates just + an empty hash-ref and saves writing. In fact, internally it + will be converted to: + + + + - fixed Makefile.PL: it cleans now files generated by 'make test' + properly. reported by: Dagfinn Ilmari Mannsåker + + - updated MANIFEST (in fact I did this some years ago the last time!) + also reported by: Dagfinn Ilmari Mannsåker + + + 2.24 + - fixed Bug #3869 (rt.cpan.org) reported by + "Mike Depot" + + - applied patch by Roland Huss , + which fixes a bug with the -Tie option, sub-hashes of + named blocks were not properly created (in fact, not + tied). + + - added documentation to Interpolated.pm that it does not + interpolate variables in keys, see bug #3773 (rt.cpan.org). + + + 2.23 + - still versioning problem, stupid white man ;-) + Extended.pm is now 2.00 which *is* higher than 1.10. + + 2.22 + - incremented all version numbers because of cpan problem. + no further changes. See Bug #3347 (rt.cpan.org). + + 2.21 + - fixed bug in new() used $this instead of $self for empty + hashref creation if no config file given. + + 2.20 + - fixed bug reported by Stefano di Sandro : in + OOP mode (extended access) the obj() method returned the whole + config object if the given key does not exist. Now it returns + a new empty object. + + - added patch by David Dick which + sets $/ if it is unset. + + - added patch by David Dick which + calls the binmode() function in case the modules is being + used under win32 systems. Read perldoc -f binmode for more + informations on this issue. + + - added feature suggested by Chase Phillips : + the new() method has a new parameter -Tie which takes the + name of a Tie class that each new hash should be based off + of. This makes it possible to create a config hash with + ordered contents across nested structures. + + 2.19 + - forgot to import 'catfile' from File::Spec. Bug reported by + various people. + + - applied patch by Peter Tandler + which adds a search-path feature for include files. + + - applied patch by David Dick which + adds an auto launder capability to the module which makes it + possible to use variables read by Config::General in a + tainted perlscript (executed with -T) for open(), backtick calls + or something which the taintmode considers to be dangerous. + + 2.18 + - fixed Bug #2325 (rt.cpan.org). The subs exported by File::Spec + will now imported explicitly. + - fixed warning about double my'ed variable $dummi, changed it + to undef because it was unused anyway. + + 2.17 + - added File::Spec support which makes the modules more portable + (i.e. on win32 systems), + as suggested by Peter Tandler . + + 2.16 + - applied patch by Michael Gray which + fixes a bug in the Interpolate.pm submodule. A second variable, + when immediately following the first, did not get interpolated, + i.e. ${var1}${var2}. + + 2.15 - fixed Bug in SaveConfig***, which didn't work. + - applied patch by Robb Canfield , + which fixes a bug in the variable interpolation + scheme. It did not interpolate blocks nor + blocknames. This patch fixes this. Patch slightly + modified by me(interpolation on block and blocknames). + - enhanced test for variable interpolation to + reflect this. + - added check if a named block occurs after the underlying + block is already an array, which is not possible. + perl cannot add a hashref to an array. i.e.: + + a = 1 + + + b = 1 + + + c = 1 + + As you can see, "" will be an array, and "blubber" + cannot be stored in any way on this array. + The module croaks now if such construct occurs. + + 2.14 - fixed bug reported by Francisco Olarte Sanz + , which caused _parse to + ignore blocks with the name "0": + <0> .. , because it checked just if $block (the name + between < and >) is true, and from the perl point + of view "0" is not. Changed it to check for defined. + Normally I avoid using 'defined' but in this case + it will not be possible that $block contains the + empty string, so defined is ok here. + + 2.13 - fixed bug reported by Steffen Schwigon . + the parser was still active inside a here-doc, which + cause weird results if the here-doc contained + multiple < reported this + mis-behavior. The problem was that the whole hash + was feeded to ::Interpolated.pm, but as we all + know, perl hashes doesn't preserve the order. So, + in our case the module sometimes was unable to + resolve variablenames, because they were stored + in a different location as it occurred in the config. + The change is, that Config::General now calls + ::Interpolate.pm (new sub: _interpolate()) itself + directly on a per-key/value pair basis. The internal + varstack is now stored on $this globally. So, now + a variable will be known when it occurs. period :-) + + + 2.10 - added -StrictVars documentation section to the POD, + which was missing. + + - fixed a formatting error in the POD documentation. + + + 2.09 - added bugfix in '#' comment parsing. If current state + was within a block, then /^ #/ was not ignored as + comment but instead added as variable. Reported by + Lupe Christoph + + - added -StrictObjects parameter support in the following + ::Extended methods: hash() and value(). + + - added better parameter checks in the ::Extended::obj() + method. Its now no more possible to create a new (sub-) + object from an undefined key or a key which does not + point to a hash reference. + + - simplified storing of ConfigFile and ConfigHash in new() + removed my variable $configfile. + + - the original parameter list will now be saved, which is + required for ::Extended to create new objects with the + same config as their parents. + + 2.08 - added option -StrictVars, which causes Interpolate.pm to + ignore undefined variables and replaces such occurrences + with the emppty string. + + - applied patch by Stefan Moser , which fixes + some weird bevavior if -MergeDuplicateOptions was turned + on, the parser croaked regardless -MergeDuplicateBlocks + was set or not. Now the two options behave almost independent + from each other, which allows one to merge duplicate + blocks but duplicate options not. + + - changed behavior of setting -MergeDuplicateOptions which + implied in previous versions -AllowMultiOptions to be + false. Now this will only be done if the user does not + set -AllowMultiOptions by himself. This allows one to + have duplicate blocks which will be turned into an + array but duplicate options to be merged. + + - applied patch by Matthias Pitzl , which + fixes a bug at parsing apache-like include directive + (Include ...). It did not properly trim unnecessary whitespaces + so that the filename to be included became invalid. This + bug espessially occurred if one saved a hash containing + a key/value pair like this: "Include" => "/etc/grs.cfg", + which was then saved as "Include /etc/grs.cfg", the + parser returned " /etc/grs.cfg" which, of course, does + not exists. odd... + + 2.07 - fixed cpan bugid #1351, SaveConfig contained a deprecated + function call which caused the module to croak. + - added feature request, if in extended mode (OOP turned + on with -ExtendedAccess => 1 access to non-existent keys + caused a croak. While this is still the default behavior + it is now possible to turn this off using -StrictObjects => 0. + - added this to the related pod section in ::Extended. + - fixed bug in new() which caused a couple of errors + if the ConfigFile parameter is not set, or is set to + undef. In this case it will now simply create an empty + object. + - fixed related bug in save_file() which will save "" to + a file now if the config is uninitialized (i.e. the case + mentioned below arrived). + + 2.06 - added -SplitPolicy, -SplitDelimiter and -StoreDelimiter + - removed whitespace support in keys in the default parser + SplitPolicy 'guess', which was introduced in 2.02. Now + I (re-)use the old regex I used before. if you need + whitespaces in keys, use 'equalsign' as SplitPolicy. + - the write_scalar() method uses the StoreDelimiter for + separating options from values. + - added -CComments to make it possible to turn c-comment + parsing off. + - added support for FileHandle objects as parameter to the + -ConfigFile parameter. This makes it possible to use locking. + + 2.05 - fixed bug in ::Extended. It exported for some weird + reason I can't remember all of its methods. This included + keys() exists() and delete(), which are perl internals. + If one used keys() on a normal hash, then the ::Extended + own keys() were used instead of perls own one. I removed + the export line. + + 2.04 - added RFE from rt.cpan.org (ID: 1218). the ::Interpolate + module populates now uses of uninitialized variables in + config files itself instead of just letting perl die(). + The other suggestion of the RFE was declined. + + 2.03 - fixed bug in the _parse() routine (better: design flaw). + after the last patch for allowing whitespaces in + option names, it had a problem with here-docs which + contained equal signs. option/value splitting resulted + in weird output. + + - as a side effect of the bug fix below it is now + possible to use equal signs inside quoted values, which + will then be ignored, thus not used for splitting + the line into an option/value assignment. + + - added a new test, which tests for all possible notations + of option/value lines. + + 2.02 - added patch by Jens Heunemann, which allows to use + whitespaces in option names. + + - changed the save() calls in the test script (t/run.t) + to save_file() + + - removed new() from ::Interpolated and ::Extended. + This may break existing code (they will need to + move to the flags of Config::General::new() ), but + this decision must be made. The problem was that + both the old way of directly using the subclasses + and the enw way did not work together. So, now + subclasses are only method holders and used by + Config::General on request. Direct use of subclasses + is prohibited. (you receive a warning if you do). + + + 2.01 - added -ConfigFile (in replace for -file) and + -ConfigHash (in replace for -hash) to get a consistent + parameter naming scheme. The old names are still + supported for backward compatibility, but no more + documented. + + - the parameter -BaseHash has been dropped because + -DefaultConfig already has the capabilities of + defining a custom backing hash. The pod section for + -DefaultConfig has been enhanced to reflect this. + + - README changed something. Removed the 'small' keyword, + because the module isn't really small anymore :-) + At least IMHO. + + 2.00 - fixed a bug in the ::Extended::keys() method, which + caused a beloved "use of uninitialized ..." message. + Reported by Danial Pearce . + + - Removed all deprecated methods (in fact, they are still + there for shouting out a warn that its deprecated. But + the pod sections are removed. These are NoMultiOptions() + and save(). + + - added two new parameters to new(): -InterPolateVars and + -ExtendedAccess, which allows one to use the functionalites + of the supplied submodules without the need to decide + for one of them. This makes it possible to use variable + interpolation and oop access in the same time. Suggested + by Jared Rhine . + + - added new parameter -BaseHash which makes it possible + to supply your own hash which stores the parsed contents + of the config. This can be a tied hash o the like. + Suggested by Jared Rhine too. + + - switched to release 2.00 because the above is a major + change. + + 1.36 - simplified new() parameter parsing, should be now a little + bit better to understand. + + - added new parameter -DefaultConfig, which can hold a hashref + or a string, which will be used to pre-define values + of the resulting hash after parsing a config. + Thanks to Mark Hampton for the + suggestion. + + - added new parameter -MergeDuplicateOptions, which allows + one to overwrite duplicate options, which is required, + if you turn on -DefaultConfig, because otherwise a + array would be created, which is probably not what you + wanted. + + - added patch by Danial Pearce + to Config::General::Extended::keys(), which allows to + retrieve the keys of the object itself (which was not + directly possible before) + + - added patch by Danial Pearce + to Config::General::Extended::value(), which allows to + set a value to a (perlish-) nontrue value. This was a + bug. + + - added patch by Danial Pearce + to Config::General::_parse_value, which fixes a bug in + this method, which in prior versions caused values of + "0" (zero digit) to be wiped out of the config. + + - added tests in t/run.t for the new default config feature. + + + + 1.35 - the here-doc identifier in saved configs will now created + in a way which avoids the existence of this identifier + inside the here-doc, which if it happens results in + weird behavior in the resulting config. + + 1.34 - Danial Pearce reported a bug + in _store(), which caused the module to create scalar + entries even if the entry contained newlines. While + Danial supplied a patch to fix this - thx(TM) - I + did not apply it, because I "outsourced" this kind of + stuff to the subroutine _write_scalar(), see next. + + - added internal methods _write_scalar() and _write_hash() + to simplify _store(), which did the same thing more + than once, which is a good time to create a sub which + does the job. + + - fixed cut'n paste bug in General/Extended.pm reported by + Danial Pearce , which caused + Config::General::Extended::is_scalar() to return true even + when the key you pass in is an array. + + - added new method Config::General::Extended::delete() suggested + by Danial Pearce , which deletes + the given key from the config. + + 1.33 - fixed bug in _parse_value() which caused perl to complain + with "Use of uninitialized value in..." if a value was + empty. + + + 1.32 - *argl* ... I forgot Interpolated.pm, don't know how that + could happen, in 1.29 it was "lost". However - + I added it again now. + - added patch by Peder Stray to + the _store() method, which makes it possible to catch + arrays of hashes to be stored correctly. + - cleaned up the t/run.t testscript to reflect the + changes (in fact I did not touch it since 1.18 or so). + - added test number 16 to test variable interpolation + using ::Interpolated in t/run.t. + - fixed bug with new() parameter -AllowMultiOptions which + generated a croak() if set to something other than "no". + - changed Extended::save() to reflect the API change, + it calls now save_file(). + + 1.31: - i'm such a moron ... I forgot to do a make clean + in 1.30, pf. So this is 1.31, which is clean. + + 1.30: - fixed typo, which made 1.29 unusable (undefined var %config) + - added code to check if unknown parameters to new() + has been supplied. + + 1.29: + - added 2 procedural functions ParseConf and SaveConf + - added new parameters -AutoTrue and -FlagBits + - added save_file() which replaces save(), which was + weird implemented. If the user only supplied a hash + as parameter to save(), then the first key was + used as the filename and the rest was used + as a config hash (which was then of an uneven size). + - save_file() takes now instead of a hash a hash-ref + and a filename. And the hashref is optional, since + the object already contains a complete hash. + - new method save_string() added, which returns the + ready generated string instead of writing it to + disk. The user can then save it himself. + - POD updated. + + 1.28: + - added contributed sub module Config::General::Interpolated + by "Wei-Hon Chen" with + help from "Autrijus Tang" + which makes it possible to use variables inside + config files. + - _read() accepts now c-comments inside c-comments if + they are on a single line. + - _read() is now more tolerant to here-identifiers + (the ends of here-docs), whitespaces right after + such an identifier are allowed (i.e. "EOF "). + - _read() does now behave somewhat different with + C-comments, they will be the first thing being + processed in a config, so the parser really + ignores everything inside C-comments. Previously + it did not do that, for example here-docs has + not been ignored. + + 1.27: - "make test" complained about uninitialized value + in :146, which is now fixed. + + 1.26: - added filehandle capability to -file. + - added -String parameter to new(), which allows + one to supply the whole config as a string. + - added -MergeDuplicateBlocks option, which causes + duplicate blocks to be merged. + + 1.25: - include statements are now case insensitive + - include statements may now also being used with + indentation(leading and following whitespaces are + allowed) + - changed the end here-doc regexp from .+? to \S+? + so " < + and Anton Luht :-) + This allows to include files from the location of + the configfile instead from the working directory. + + 1.24: - AllowMultiOptions printed out the value and not the + option itself, if more than one of this particular + option occurred. + - added -UseApacheInclude feature, contributed by + Thomas Klausner + - fixed bug with multiple options stuff, which did not + work with blocks or named blocks. Pointed out by + Thomas Klausner , who meant it being + feature request, but in fact it was a bug (IMHO). + - Config::General does now contain also it's OO-sister + Config::General::Extended, which is from now on + no more available as an extra module, because it + lived a shadowy existence. + - finally(!) created a Changelog file (this one, yes). + + 1.23: - fixed bug, which removed trailing or leading " even + no matching " was there. + + 1.22: - added a new option to new(): -LowerCaseNames, which + lowercases all option-names (feature request) + + 1.21: - lines with just one "#" became an option array named + "#" with empty entries, very weird, fixed + + 1.20: - added an if(exists... to new() for checking of the + existence of -AllowMultiOptions. + - use now "local $_" because it caused weird results + if a user used $_ with the module. + + 1.19: - you can escape "#" characters using a backslash: "\#" + which will now no more treated as a comment. + - comments inside here-documents will now remain in the + here-doc value. + +history logs 1.17+1.18 are lost in space :-( + +older history logs (stripped from CVS): + +revision 1.16 +date: 2000/08/03 16:54:58; author: jens; state: Exp; lines: +4 -1 +# Local Variables: *** +# perl-master-file: ../../webmin/index.pl *** +# End: *** + +rangehängt, damit ich mit C-c d das debugging von jedem File aus +einschalten kann +(siehe mein .emacs file) +---------------------------- +revision 1.15 +date: 2000/08/01 09:12:52; author: tom; state: Exp; lines: +57 -68 +added comments to _open() and _parse() +---------------------------- +revision 1.14 +date: 2000/07/31 18:07:12; author: tom; state: Exp; lines: +44 -19 +added <> capability +---------------------------- +revision 1.13 +date: 2000/07/16 18:35:33; author: tom; state: Exp; lines: +135 -10 +added here-doc and multi-line feature, updated perlpod +---------------------------- +revision 1.12 +date: 2000/07/14 14:56:09; author: tom; state: Exp; lines: +2 -2 +bug fixed, it did not ignore options inside c-comments with a # comment +@ the end of line +---------------------------- +revision 1.11 +date: 2000/07/14 11:26:04; author: tom; state: Exp; lines: +42 -6 +added C-Style comments and allow also comments after a statement. +---------------------------- +revision 1.10 +date: 2000/07/12 14:04:51; author: tom; state: Exp; lines: +2 -1 +i woas ned +---------------------------- +revision 1.9 +date: 2000/07/12 10:59:53; author: jens; state: Exp; lines: +5 -3 +hehe :) +---------------------------- +revision 1.8 +date: 2000/07/12 10:43:20; author: tom; state: Exp; lines: +5 -2 +fixed bug in getall(), which doubled %config if called more than onse. +---------------------------- +revision 1.7 +date: 2000/07/12 09:09:33; author: tom; state: Exp; lines: +22 -24 +100% Apache Config complete ;-) it supports now "named blocks"! +---------------------------- +revision 1.6 +date: 2000/07/11 23:43:03; author: tom; state: Exp; lines: +72 -19 +added named block support () +---------------------------- +revision 1.5 +date: 2000/07/11 20:49:47; author: tom; state: Exp; lines: +2 -2 +typo in pod corrected +---------------------------- +revision 1.4 +date: 2000/07/11 17:07:04; author: tom; state: Exp; lines: +61 -7 +a config file can now contain an option more than once and will be +returned as array +---------------------------- +revision 1.3 +date: 2000/07/07 11:27:38; author: cvs; state: Exp; lines: +2 -2 +folgende Parameterform geht jetzt auch: +parameter= blabla + +vorher musste man +parameter = blabla +schreiben +---------------------------- +revision 1.2 +date: 2000/07/04 13:21:12; author: tom; state: Exp; lines: +9 -4 +added better failurehandling in case of missing block start/end statements +---------------------------- +revision 1.1 +date: 2000/07/04 12:52:09; author: tom; state: Exp; +implemented module and method getall, works as expected. + diff --git a/General.pm b/General.pm new file mode 100644 index 0000000..875a24d --- /dev/null +++ b/General.pm @@ -0,0 +1,2889 @@ +# +# Config::General.pm - Generic Config Module +# +# Purpose: Provide a convenient way for loading +# config values from a given file and +# return it as hash structure +# +# Copyright (c) 2000-2022 Thomas Linden . +# All Rights Reserved. Std. disclaimer applies. +# Licensed under the Artistic License 2.0. +# +# namespace +package Config::General; + +use strict; +use warnings; +use English '-no_match_vars'; + +use IO::File; +use FileHandle; +use File::Spec::Functions qw(splitpath file_name_is_absolute catfile catpath); +use File::Glob qw/:glob/; + + +# on debian with perl > 5.8.4 croak() doesn't work anymore without this. +# There is some require statement which dies 'cause it can't find Carp::Heavy, +# I really don't understand, what the hell they made, but the debian perl +# installation is definitely bullshit, damn! +use Carp::Heavy; + + +use Carp; +use Exporter; + +$Config::General::VERSION = "2.65"; + +use vars qw(@ISA @EXPORT_OK); +use base qw(Exporter); +@EXPORT_OK = qw(ParseConfig SaveConfig SaveConfigString); + +use constant _UTF8_BOM => "\x{ef}\x{bb}\x{bf}"; + +sub new { + # + # create new Config::General object + # + my($this, @param ) = @_; + my $class = ref($this) || $this; + + # define default options + my $self = { + # sha256 of current date + # hopefully this lowers the probability that + # this matches any configuration key or value out there + # bugfix for rt.40925 + EOFseparator => 'ad7d7b87f5b81d2a0d5cb75294afeb91aa4801b1f8e8532dc1b633c0e1d47037', + SlashIsDirectory => 0, + AllowMultiOptions => 1, + MergeDuplicateOptions => 0, + MergeDuplicateBlocks => 0, + LowerCaseNames => 0, + ApacheCompatible => 0, + UseApacheInclude => 0, + IncludeRelative => 0, + IncludeDirectories => 0, + IncludeGlob => 0, + IncludeAgain => 0, + AutoLaunder => 0, + AutoTrue => 0, + AutoTrueFlags => { + true => '^(on|yes|true|1)$', + false => '^(off|no|false|0)$', + }, + DefaultConfig => {}, + String => '', + level => 1, + InterPolateVars => 0, + InterPolateEnv => 0, + ExtendedAccess => 0, + SplitPolicy => 'guess', # also possible: whitespace, equalsign and custom + SplitDelimiter => 0, # must be set by the user if SplitPolicy is 'custom' + StoreDelimiter => 0, # will be set by me unless user uses 'custom' policy + CComments => 1, # by default turned on + BackslashEscape => 0, # deprecated + StrictObjects => 1, # be strict on non-existent keys in OOP mode + StrictVars => 1, # be strict on undefined variables in Interpolate mode + Tie => q(), # could be set to a perl module for tie'ing new hashes + parsed => 0, # internal state stuff for variable interpolation + files => {}, # which files we have read, if any + UTF8 => 0, + SaveSorted => 0, + ForceArray => 0, # force single value array if value enclosed in [] + AllowSingleQuoteInterpolation => 0, + NoEscape => 0, + NormalizeBlock => 0, + NormalizeOption => 0, + NormalizeValue => 0, + Plug => {}, + UseApacheIfDefine => 0, + Define => {} + }; + + # create the class instance + bless $self, $class; + + if ($#param >= 1) { + # use of the new hash interface! + $self->_prepare(@param); + } + elsif ($#param == 0) { + # use of the old style + $self->{ConfigFile} = $param[0]; + if (ref($self->{ConfigFile}) eq 'HASH') { + $self->{ConfigHash} = delete $self->{ConfigFile}; + } + } + else { + # this happens if $#param == -1,1 thus no param was given to new! + $self->{config} = $self->_hashref(); + $self->{parsed} = 1; + } + + # find split policy to use for option/value separation + $self->_splitpolicy(); + + # bless into variable interpolation module if necessary + $self->_blessvars(); + + # process as usual + if (!$self->{parsed}) { + $self->_process(); + } + + if ($self->{InterPolateVars}) { + $self->{config} = $self->_clean_stack($self->{config}); + } + + # bless into OOP namespace if required + $self->_blessoop(); + + return $self; +} + + + +sub _process { + # + # call _read() and _parse() on the given config + my($self) = @_; + + if ($self->{DefaultConfig} && $self->{InterPolateVars}) { + $self->{DefaultConfig} = $self->_interpolate_hash($self->{DefaultConfig}); # FIXME: _hashref() ? + } + if (exists $self->{StringContent}) { + # consider the supplied string as config file + $self->_read($self->{StringContent}, 'SCALAR'); + $self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content}); + } + elsif (exists $self->{ConfigHash}) { + if (ref($self->{ConfigHash}) eq 'HASH') { + # initialize with given hash + $self->{config} = $self->{ConfigHash}; + $self->{parsed} = 1; + } + else { + croak "Config::General: Parameter -ConfigHash must be a hash reference!\n"; + } + } + elsif (ref($self->{ConfigFile}) eq 'GLOB' || ref($self->{ConfigFile}) eq 'FileHandle') { + # use the file the glob points to + $self->_read($self->{ConfigFile}); + $self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content}); + } + else { + if ($self->{ConfigFile}) { + # open the file and read the contents in + $self->{configfile} = $self->{ConfigFile}; + if ( file_name_is_absolute($self->{ConfigFile}) ) { + # look if this is an absolute path and save the basename if it is absolute + my ($volume, $path, undef) = splitpath($self->{ConfigFile}); + $path =~ s#/$##; # remove eventually existing trailing slash + if (! $self->{ConfigPath}) { + $self->{ConfigPath} = []; + } + unshift @{$self->{ConfigPath}}, catpath($volume, $path, q()); + } + $self->_open($self->{configfile}); + # now, we parse immediately, getall simply returns the whole hash + $self->{config} = $self->_hashref(); + $self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content}); + } + else { + # hm, no valid config file given, so try it as an empty object + $self->{config} = $self->_hashref(); + $self->{parsed} = 1; + } + } +} + + +sub _blessoop { + # + # bless into ::Extended if necessary + my($self) = @_; + if ($self->{ExtendedAccess}) { + # we are blessing here again, to get into the ::Extended namespace + # for inheriting the methods available over there, which we doesn't have. + bless $self, 'Config::General::Extended'; + eval { + require Config::General::Extended; + }; + if ($EVAL_ERROR) { + croak "Config::General: " . $EVAL_ERROR; + } + } +# return $self; +} + +sub _blessvars { + # + # bless into ::Interpolated if necessary + my($self) = @_; + if ($self->{InterPolateVars} || $self->{InterPolateEnv}) { + # InterPolateEnv implies InterPolateVars + $self->{InterPolateVars} = 1; + + # we are blessing here again, to get into the ::InterPolated namespace + # for inheriting the methods available overthere, which we doesn't have here. + bless $self, 'Config::General::Interpolated'; + eval { + require Config::General::Interpolated; + }; + if ($EVAL_ERROR) { + croak "Config::General: " . $EVAL_ERROR; + } + # pre-compile the variable regexp + $self->{regex} = $self->_set_regex(); + } +} + + +sub _splitpolicy { + # + # find out what split policy to use + my($self) = @_; + if ($self->{SplitPolicy} ne 'guess') { + if ($self->{SplitPolicy} eq 'whitespace') { + $self->{SplitDelimiter} = '\s+'; + if (!$self->{StoreDelimiter}) { + $self->{StoreDelimiter} = q( ); + } + } + elsif ($self->{SplitPolicy} eq 'equalsign') { + $self->{SplitDelimiter} = '\s*=\s*'; + if (!$self->{StoreDelimiter}) { + $self->{StoreDelimiter} = ' = '; + } + } + elsif ($self->{SplitPolicy} eq 'custom') { + if (! $self->{SplitDelimiter} ) { + croak "Config::General: SplitPolicy set to 'custom' but no SplitDelimiter set.\n"; + } + } + else { + croak "Config::General: Unsupported SplitPolicy: $self->{SplitPolicy}.\n"; + } + } + else { + if (!$self->{StoreDelimiter}) { + $self->{StoreDelimiter} = q( ); + } + } +} + +sub _prepare { + # + # prepare the class parameters, mangle them, if there + # are options to reset or to override, do it here. + my ($self, %conf) = @_; + + # save the parameter list for ::Extended's new() calls + $self->{Params} = \%conf; + + # be backwards compatible + if (exists $conf{-file}) { + $self->{ConfigFile} = delete $conf{-file}; + } + if (exists $conf{-hash}) { + $self->{ConfigHash} = delete $conf{-hash}; + } + + # store input, file, handle, or array + if (exists $conf{-ConfigFile}) { + $self->{ConfigFile} = delete $conf{-ConfigFile}; + } + if (exists $conf{-ConfigHash}) { + $self->{ConfigHash} = delete $conf{-ConfigHash}; + } + + # store search path for relative configs, if any + if (exists $conf{-ConfigPath}) { + my $configpath = delete $conf{-ConfigPath}; + $self->{ConfigPath} = ref $configpath eq 'ARRAY' ? $configpath : [$configpath]; + } + + # handle options which contains values we need (strings, hashrefs or the like) + if (exists $conf{-String} ) { + if (not ref $conf{-String}) { + if ( $conf{-String}) { + $self->{StringContent} = $conf{-String}; + } + delete $conf{-String}; + } + # re-implement arrayref support, removed after 2.22 as _read were + # re-organized + # fixed bug#33385 + elsif(ref($conf{-String}) eq 'ARRAY') { + $self->{StringContent} = join "\n", @{$conf{-String}}; + } + else { + croak "Config::General: Parameter -String must be a SCALAR or ARRAYREF!\n"; + } + delete $conf{-String}; + } + if (exists $conf{-Tie}) { + if ($conf{-Tie}) { + $self->{Tie} = delete $conf{-Tie}; + $self->{DefaultConfig} = $self->_hashref(); + } + } + + if (exists $conf{-FlagBits}) { + if ($conf{-FlagBits} && ref($conf{-FlagBits}) eq 'HASH') { + $self->{FlagBits} = 1; + $self->{FlagBitsFlags} = $conf{-FlagBits}; + } + delete $conf{-FlagBits}; + } + + if (exists $conf{-DefaultConfig}) { + if ($conf{-DefaultConfig} && ref($conf{-DefaultConfig}) eq 'HASH') { + # copy the hashref so that it is not being modified by subsequent calls, fixes bug#142095 + $self->{DefaultConfig} = $self->_copy($conf{-DefaultConfig}); + } + elsif ($conf{-DefaultConfig} && ref($conf{-DefaultConfig}) eq q()) { + $self->_read($conf{-DefaultConfig}, 'SCALAR'); + $self->{DefaultConfig} = $self->_parse($self->_hashref(), $self->{content}); + $self->{content} = (); + } + delete $conf{-DefaultConfig}; + } + + # handle options which may either be true or false + # allowing "human" logic about what is true and what is not + foreach my $entry (keys %conf) { + my $key = $entry; + $key =~ s/^\-//; + if (! exists $self->{$key}) { + croak "Config::General: Unknown parameter: $entry => \"$conf{$entry}\" (key: <$key>)\n"; + } + if ($conf{$entry} =~ /$self->{AutoTrueFlags}->{true}/io) { + $self->{$key} = 1; + } + elsif ($conf{$entry} =~ /$self->{AutoTrueFlags}->{false}/io) { + $self->{$key} = 0; + } + else { + # keep it untouched + $self->{$key} = $conf{$entry}; + } + } + + if ($self->{MergeDuplicateOptions}) { + # override if not set by user + if (! exists $conf{-AllowMultiOptions}) { + $self->{AllowMultiOptions} = 0; + } + } + + if ($self->{ApacheCompatible}) { + # turn on all apache compatibility options which has + # been incorporated during the years... + $self->{UseApacheInclude} = 1; + $self->{IncludeRelative} = 1; + $self->{IncludeDirectories} = 1; + $self->{IncludeGlob} = 1; + $self->{SlashIsDirectory} = 1; + $self->{SplitPolicy} = 'whitespace'; + $self->{CComments} = 0; + $self->{UseApacheIfDefine} = 1; + } + + if ($self->{UseApacheIfDefine}) { + if (exists $conf{-Define}) { + my $ref = ref($conf{-Define}); + + if ($ref eq '') { + $self->{Define} = {$conf{-Define} => 1}; + } + elsif ($ref eq 'SCALAR') { + $self->{Define} = {${$conf{-Define}} = 1}; + } + elsif ($ref eq 'ARRAY') { + my %h = map { $_ => 1 } @{$conf{-Define}}; + $self->{Define} = \%h; + } + elsif ($ref eq 'HASH') { + $self->{Define} = $conf{-Define}; + } + else { + croak qq{Config::General: Unsupported ref '$ref' for 'Define'}; + } + + delete $conf{-Define}; + } + + } +} + +sub getall { + # + # just return the whole config hash + # + my($this) = @_; + return (exists $this->{config} ? %{$this->{config}} : () ); +} + + +sub files { + # + # return a list of files opened so far + # + my($this) = @_; + return (exists $this->{files} ? keys %{$this->{files}} : () ); +} + + +sub _open { + # + # open the config file, or expand a directory or glob or include + # + my($this, $basefile, $basepath) = @_; + my $cont; + + ($cont, $basefile, $basepath) = $this->_hook('pre_open', $basefile, $basepath); + return if(!$cont); + + my($fh, $configfile); + + if($basepath) { + # if this doesn't work we can still try later the global config path to use + $configfile = catfile($basepath, $basefile); + } + else { + $configfile = $basefile; + } + + my $glob = qr/[*?\[\{\\]/; + if ($^O =~ /win/i) { + # fix for rt.cpan.org#116340: do only consider a backslash + # as meta escape char, but not if it appears on it's own, + # as it happens on windows platforms. + $glob = qr/(\\[*?\[\{\\]|[*?\[\{])/; + } + + if ($this->{IncludeGlob} and $configfile =~ /$glob/) { + # Something like: *.conf (or maybe dir/*.conf) was included; expand it and + # pass each expansion through this method again. + local $_; + my @include = grep { -f $_ } bsd_glob($configfile, GLOB_BRACE | GLOB_QUOTE); + + # applied patch by AlexK fixing rt.cpan.org#41030 + if ( !@include && defined $this->{ConfigPath} ) { + foreach my $dir (@{$this->{ConfigPath}}) { + my ($volume, $path, undef) = splitpath($basefile); + if ( -d catfile( $dir, $path ) ) { + push @include, grep { -f $_ } bsd_glob(catfile($dir, $basefile), GLOB_BRACE | GLOB_QUOTE); + last; + } + } + } + + # Multiple results or no expansion results (which is fine, + # include foo/* shouldn't fail if there isn't anything matching) + # rt.cpan.org#79869: local $this->{IncludeGlob}; + foreach my $file (@include) { + $this->_open($file); + } + return; + } + + if (!-e $configfile) { + my $found; + if (defined $this->{ConfigPath}) { + # try to find the file within ConfigPath + foreach my $dir (@{$this->{ConfigPath}}) { + if( -e catfile($dir, $basefile) ) { + $configfile = catfile($dir, $basefile); + $found = 1; + last; # found it + } + } + } + if (!$found) { + my $path_message = defined $this->{ConfigPath} ? q( within ConfigPath: ) . join(q(.), @{$this->{ConfigPath}}) : q(); + croak qq{Config::General The file "$basefile" does not exist$path_message!}; + } + } + + local ($RS) = $RS; + if (! $RS) { + carp(q(\$RS (INPUT_RECORD_SEPARATOR) is undefined. Guessing you want a line feed character)); + $RS = "\n"; + } + + if (-d $configfile and $this->{IncludeDirectories}) { + # A directory was included; include all the files inside that directory in ASCII order + local *INCLUDEDIR; + opendir INCLUDEDIR, $configfile or croak "Config::General: Could not open directory $configfile!($!)\n"; + #my @files = sort grep { -f catfile($configfile, $_) } catfile($configfile, $_), readdir INCLUDEDIR; + # fixes rt.cpan.org#139261 + my @files = sort grep { -f catfile($configfile, $_) } readdir INCLUDEDIR; + closedir INCLUDEDIR; + local $this->{CurrentConfigFilePath} = $configfile; + for (@files) { + my $file = catfile($configfile, $_); + if (! exists $this->{files}->{$file} or $this->{IncludeAgain} ) { + # support re-read if used urged us to do so, otherwise ignore the file + $fh = $this->_openfile_for_read($file); + $this->{files}->{"$file"} = 1; + $this->_read($fh); + } + else { + warn "File $file already loaded. Use -IncludeAgain to load it again.\n"; + } + } + } + elsif (-d $configfile) { + croak "Config::General: config file argument is a directory, expecting a file!\n"; + } + elsif (-e _) { + if (exists $this->{files}->{$configfile} and not $this->{IncludeAgain}) { + # do not read the same file twice, just return + warn "File $configfile already loaded. Use -IncludeAgain to load it again.\n"; + return; + } + else { + $fh = $this->_openfile_for_read($configfile); + $this->{files}->{$configfile} = 1; + + my ($volume, $path, undef) = splitpath($configfile); + local $this->{CurrentConfigFilePath} = catpath($volume, $path, q()); + + $this->_read($fh); + } + } + return; +} + + +sub _openfile_for_read { + # + # actually open a file, turn on utf8 mode if requested by bom + # + my ($this, $file) = @_; + + my $fh = IO::File->new( $file, 'r') + or croak "Config::General: Could not open $file!($!)\n"; + + # attempt to read an initial utf8 byte-order mark (BOM) + my $n_read = sysread $fh, my $read_BOM, length(_UTF8_BOM); + my $has_BOM = $n_read == length(_UTF8_BOM) && $read_BOM eq _UTF8_BOM; + + # set utf8 perlio layer if BOM was found or if option -UTF8 is turned on + binmode $fh, ":utf8" if $this->{UTF8} || $has_BOM; + + # rewind to beginning of file if we read chars that were not the BOM + sysseek $fh, 0, 0 if $n_read && !$has_BOM; + + return $fh; +} + + + +sub _read { + # + # store the config contents in @content + # and prepare it somewhat for easier parsing later + # (comments, continuing lines, and stuff) + # + my($this, $fh, $flag) = @_; + + + my(@stuff, @content, $c_comment, $longline, $hier, $hierend, @hierdoc); + local $_ = q(); + + if ($flag && $flag eq 'SCALAR') { + if (ref($fh) eq 'ARRAY') { + @stuff = @{$fh}; + } + else { + @stuff = split /\n/, $fh; + } + } + else { + @stuff = <$fh>; + } + + my $cont; + ($cont, $fh, @stuff) = $this->_hook('pre_read', $fh, @stuff); + return if(!$cont); + + if ($this->{UseApacheIfDefine}) { + $this->_process_apache_ifdefine(\@stuff); + } + + foreach (@stuff) { + if ($this->{AutoLaunder}) { + if (m/^(.*)$/) { + $_ = $1; + } + } + + chomp; + + + if ($hier) { + # inside here-doc, only look for $hierend marker + if (/^(\s*)\Q$hierend\E\s*$/) { + my $indent = $1; # preserve indentation + $hier .= ' ' . $this->{EOFseparator}; # bugfix of rt.40925 + # _parse will also preserver indentation + if ($indent) { + foreach (@hierdoc) { + s/^$indent//; # i.e. the end was: " EOF" then we remove " " from every here-doc line + $hier .= $_ . "\n"; # and store it in $hier + } + } + else { + $hier .= join "\n", @hierdoc; # there was no indentation of the end-string, so join it 1:1 + } + push @{$this->{content}}, $hier; # push it onto the content stack + @hierdoc = (); + undef $hier; + undef $hierend; + } + else { + # everything else onto the stack + push @hierdoc, $_; + } + next; + } + + if ($this->{CComments}) { + # look for C-Style comments, if activated + if (/(\s*\/\*.*\*\/\s*)/) { + # single c-comment on one line + s/\s*\/\*.*\*\/\s*//; + } + elsif (/^\s*\/\*/) { + # the beginning of a C-comment ("/*"), from now on ignore everything. + if (/\*\/\s*$/) { + # C-comment end is already there, so just ignore this line! + $c_comment = 0; + } + else { + $c_comment = 1; + } + } + elsif (/\*\//) { + if (!$c_comment) { + warn "invalid syntax: found end of C-comment without previous start!\n"; + } + $c_comment = 0; # the current C-comment ends here, go on + s/^.*\*\///; # if there is still stuff, it will be read + } + next if($c_comment); # ignore EVERYTHING from now on, IF it IS a C-Comment + } + + # Remove comments and empty lines + s/(? .* bugfix rt.cpan.org#44600 + next if /^\s*#/; + + # look for multiline option, indicated by a trailing backslash + if (/(?{ApacheCompatible} && /\s*<([^\/]+?.*?)\/>\s*$/) { + my $block = $1; + if ($block !~ /\"/) { + if ($block !~ /\s[^\s]/) { + # fix of bug 7957, add quotation to pure slash at the + # end of a block so that it will be considered as directory + # unless the block is already quoted or contains whitespaces + # and no quotes. + if ($this->{SlashIsDirectory}) { + push @{$this->{content}}, '<' . $block . '"/">'; + next; + } + } + } + my $orig = $_; + $orig =~ s/\/>$/>/; + $block =~ s/\s\s*.*$//; + push @{$this->{content}}, $orig, ""; + next; + } + + + # look for here-doc identifier + if ($this->{SplitPolicy} eq 'guess') { + if (/^\s*([^=]+?)\s*=\s*<<\s*(.+?)\s*$/) { + # try equal sign (fix bug rt#36607) + $hier = $1; # the actual here-doc variable name + $hierend = $2; # the here-doc identifier, i.e. "EOF" + next; + } + elsif (/^\s*(\S+?)\s+<<\s*(.+?)\s*$/) { + # try whitespace + $hier = $1; # the actual here-doc variable name + $hierend = $2; # the here-doc identifier, i.e. "EOF" + next; + } + } + else { + # no guess, use one of the configured strict split policies + if (/^\s*(.+?)($this->{SplitDelimiter})<<\s*(.+?)\s*$/) { + $hier = $1; # the actual here-doc variable name + $hierend = $3; # the here-doc identifier, i.e. "EOF" + next; + } + } + + + + ### + ### any "normal" config lines from now on + ### + + if ($longline) { + # previous stuff was a longline and this is the last line of the longline + s/^\s*//; + $longline .= $_; + push @{$this->{content}}, $longline; # push it onto the content stack + undef $longline; + next; + } + else { + # ignore empty lines + next if /^\s*$/; + + # look for include statement(s) + my $incl_file; + my $path = ''; + if ( $this->{IncludeRelative} and defined $this->{CurrentConfigFilePath}) { + $path = $this->{CurrentConfigFilePath}; + } + elsif (defined $this->{ConfigPath}) { + # fetch pathname of base config file, assuming the 1st one is the path of it + $path = $this->{ConfigPath}->[0]; + } + + # bugfix rt.cpan.org#38635: support quoted filenames + if ($this->{UseApacheInclude}) { + my $opt = ''; + if (/^\s*(include|includeoptional)\s*(["'])(.*?)(?{IncludeGlob} && $opt =~ /opt/i && $incl_file !~ /[*?\[\{\\]/) { + # fix rt#107108 + # glob enabled && optional include && file is not already a glob: + # turn it into a singular matching glob, like: + # "file" => "[f][i][l][e]" and: + # "dir/file" => "dir/[f][i][l][e]" + # which IS a glob but only matches that particular file. if it + # doesn't exist, it will be ignored by _open(), just what + # we'd like to have when using IncludeOptional. + my ($vol,$dirs,$file) = splitpath( $incl_file ); + $incl_file = catpath($vol, $dirs, join '', map { "[$_]" } split //, $file); + } + } + } + else { + if (/^\s*<>\\s*$/i) { + $incl_file = $2; + } + elsif (/^\s*<>\s*$/i) { + $incl_file = $1; + } + } + + if ($incl_file) { + if ( $this->{IncludeRelative} && $path && !file_name_is_absolute($incl_file) ) { + # include the file from within location of $this->{configfile} + $this->_open( $incl_file, $path ); + } + else { + # include the file from within pwd, or absolute + $this->_open($incl_file); + } + } + else { + # standard entry, (option = value) + push @{$this->{content}}, $_; + } + + } + + } + + ($cont, $this->{content}) = $this->_hook('post_read', $this->{content}); + return 1; +} + + +sub _process_apache_ifdefine { + # + # Loop trough config lines and exclude all those entries + # for which there's no IFDEF but which reside inside an IFDEF. + # + # Called from _read(), if UseApacheIfDefine is enabled, returns + # the modified array. + my($this, $rawlines) = @_; + + my @filtered; + my @includeFlag = (1); + + foreach (@{$rawlines}) { + if (/^\s*<\s*IfDefine\s+([!]*)("[^"]+"|\S+)\s*>/i) { + # new IFDEF block, mark following content to be included if + # the DEF is known, otherwise skip it til end of IFDEF + my ($negate, $define) = ($1 eq '!',$2); + + push(@includeFlag, + $includeFlag[-1] & + ((not $negate) & (exists $this->{Define}{$define})) + ); + } + elsif (/^\s*<\s*\/IfDefine\s*>/i) { + if (scalar(@includeFlag) <= 1) { + croak qq(Config::General: without a !\n); + } + pop(@includeFlag); + } + elsif ($includeFlag[-1] && /^\s*Define\s+("[^"]+"|\S+)/i) { + # inline Define, add it to our list + $this->{Define}{$1} = 1; + } + elsif ($includeFlag[-1]) { + push @filtered, $_; + } + } + + if (scalar(@includeFlag) > 1) { + croak qq(Config::General: Block has no EndBlock statement!\n); + } + + @$rawlines = @filtered; # replace caller array +} + + +sub _parse { + # + # parse the contents of the file + # + my($this, $config, $content) = @_; + my(@newcontent, $block, $blockname, $chunk,$block_level); + local $_; + + foreach (@{$content}) { # loop over content stack + chomp; + $chunk++; + $_ =~ s/^\s+//; # strip spaces @ end and begin + $_ =~ s/\s+$//; + + # + # build option value assignment, split current input + # using whitespace, equal sign or optionally here-doc + # separator EOFseparator + my ($option,$value); + if (/$this->{EOFseparator}/) { + ($option,$value) = split /\s*$this->{EOFseparator}\s*/, $_, 2; # separated by heredoc-finding in _open() + } + else { + if ($this->{SplitPolicy} eq 'guess') { + # again the old regex. use equalsign SplitPolicy to get the + # 2.00 behavior. the new regexes were too odd. + ($option,$value) = split /\s*=\s*|\s+/, $_, 2; + } + else { + # no guess, use one of the configured strict split policies + ($option,$value) = split /$this->{SplitDelimiter}/, $_, 2; + } + } + + if($this->{NormalizeOption}) { + $option = $this->{NormalizeOption}($option); + } + + if ($value && $value =~ /^"/ && $value =~ /"$/) { + $value =~ s/^"//; # remove leading and trailing " + $value =~ s/"$//; + } + if (! defined $block) { # not inside a block @ the moment + if (/^<([^\/]+?.*?)>$/) { # look if it is a block + $block = $1; # store block name + if ($block =~ /^"([^"]+)"$/) { +# quoted block, unquote it and do not split + $block =~ s/"//g; + } + else { + # If it is a named block store the name separately; allow the block and name to each be quoted + if ($block =~ /^(?:"([^"]+)"|(\S+))(?:\s+(?:"([^"]+)"|(.*)))?$/) { + $block = $1 || $2; + $blockname = $3 || $4; + } + } + if($this->{NormalizeBlock}) { + $block = $this->{NormalizeBlock}($block); + if (defined $blockname) { + $blockname = $this->{NormalizeBlock}($blockname); + if($blockname eq "") { + # if, after normalization no blockname is left, remove it + $blockname = undef; + } + } + } + if ($this->{InterPolateVars}) { + # interpolate block(name), add "<" and ">" to the key, because + # it is sure that such keys does not exist otherwise. + $block = $this->_interpolate($config, "<$block>", $block); + if (defined $blockname) { + $blockname = $this->_interpolate($config, "<$blockname>", "$blockname"); + } + } + if ($this->{LowerCaseNames}) { + $block = lc $block; # only for blocks lc(), if configured via new() + } + $this->{level} += 1; + undef @newcontent; + next; + } + elsif (/^<\/(.+?)>$/) { # it is an end block, but we don't have a matching block! + croak "Config::General: EndBlock \"<\/$1>\" has no StartBlock statement (level: $this->{level}, chunk $chunk)!\n"; + } + else { # insert key/value pair into actual node + if ($this->{LowerCaseNames}) { + $option = lc $option; + } + + if (exists $config->{$option}) { + if ($this->{MergeDuplicateOptions}) { + $config->{$option} = $this->_parse_value($config, $option, $value); + + # bugfix rt.cpan.org#33216 + if ($this->{InterPolateVars}) { + # save pair on local stack + $config->{__stack}->{$option} = $config->{$option}; + } + } + else { + if (! $this->{AllowMultiOptions} ) { + # no, duplicates not allowed + croak "Config::General: Option \"$option\" occurs more than once (level: $this->{level}, chunk $chunk)!\n"; + } + else { + # yes, duplicates allowed + if (ref($config->{$option}) ne 'ARRAY') { # convert scalar to array + my $savevalue = $config->{$option}; + delete $config->{$option}; + push @{$config->{$option}}, $savevalue; + } + eval { + # check if arrays are supported by the underlying hash + my $i = scalar @{$config->{$option}}; + }; + if ($EVAL_ERROR) { + $config->{$option} = $this->_parse_value($config, $option, $value); + } + else { + # it's already an array, just push + push @{$config->{$option}}, $this->_parse_value($config, $option, $value); + } + } + } + } + else { + if($this->{ForceArray} && defined $value && $value =~ /^\[\s*(.+?)\s*\]$/) { + # force single value array entry + push @{$config->{$option}}, $this->_parse_value($config, $option, $1); + } + else { + # standard config option, insert key/value pair into node + $config->{$option} = $this->_parse_value($config, $option, $value); + + if ($this->{InterPolateVars}) { + # save pair on local stack + $config->{__stack}->{$option} = $config->{$option}; + } + } + } + } + } + elsif (/^<([^\/]+?.*?)>$/) { # found a start block inside a block, don't forget it + $block_level++; # $block_level indicates wether we are still inside a node + push @newcontent, $_; # push onto new content stack for later recursive call of _parse() + } + elsif (/^<\/(.+?)>$/) { + if ($block_level) { # this endblock is not the one we are searching for, decrement and push + $block_level--; # if it is 0, then the endblock was the one we searched for, see below + push @newcontent, $_; # push onto new content stack + } + else { # calling myself recursively, end of $block reached, $block_level is 0 + if (defined $blockname) { + # a named block, make it a hashref inside a hash within the current node + + if (! exists $config->{$block}) { + # Make sure that the hash is not created implicitly + $config->{$block} = $this->_hashref(); + + if ($this->{InterPolateVars}) { + # inherit current __stack to new block + $config->{$block}->{__stack} = $this->_copy($config->{__stack}); + } + } + + if (ref($config->{$block}) eq '') { + croak "Config::General: Block <$block> already exists as scalar entry!\n"; + } + elsif (ref($config->{$block}) eq 'ARRAY') { + croak "Config::General: Cannot append named block <$block $blockname> to array of scalars!\n" + ."Block <$block> or scalar '$block' occurs more than once.\n" + ."Turn on -MergeDuplicateBlocks or make sure <$block> occurs only once in the config.\n"; + } + elsif (exists $config->{$block}->{$blockname}) { + # the named block already exists, make it an array + if ($this->{MergeDuplicateBlocks}) { + # just merge the new block with the same name as an existing one into + # this one. + $config->{$block}->{$blockname} = $this->_parse($config->{$block}->{$blockname}, \@newcontent); + } + else { + if (! $this->{AllowMultiOptions}) { + croak "Config::General: Named block \"<$block $blockname>\" occurs more than once (level: $this->{level}, chunk $chunk)!\n"; + } + else { # preserve existing data + my $savevalue = $config->{$block}->{$blockname}; + delete $config->{$block}->{$blockname}; + my @ar; + if (ref $savevalue eq 'ARRAY') { + push @ar, @{$savevalue}; # preserve array if any + } + else { + push @ar, $savevalue; + } + push @ar, $this->_parse( $this->_hashref(), \@newcontent); # append it + $config->{$block}->{$blockname} = \@ar; + } + } + } + else { + # the first occurrence of this particular named block + my $tmphash = $this->_hashref(); + + if ($this->{InterPolateVars}) { + # inherit current __stack to new block + $tmphash->{__stack} = $this->_copy($config->{__stack}); + } + + $config->{$block}->{$blockname} = $this->_parse($tmphash, \@newcontent); + } + } + else { + # standard block + if (exists $config->{$block}) { + if (ref($config->{$block}) eq '') { + croak "Config::General: Cannot create hashref from <$block> because there is\n" + ."already a scalar option '$block' with value '$config->{$block}'\n"; + } + + # the block already exists, make it an array + if ($this->{MergeDuplicateBlocks}) { + # just merge the new block with the same name as an existing one into + # this one. + $config->{$block} = $this->_parse($config->{$block}, \@newcontent); + } + else { + if (! $this->{AllowMultiOptions}) { + croak "Config::General: Block \"<$block>\" occurs more than once (level: $this->{level}, chunk $chunk)!\n"; + } + else { + my $savevalue = $config->{$block}; + delete $config->{$block}; + my @ar; + if (ref $savevalue eq "ARRAY") { + push @ar, @{$savevalue}; + } + else { + push @ar, $savevalue; + } + + # fixes rt#31529 + my $tmphash = $this->_hashref(); + if ($this->{InterPolateVars}) { + # inherit current __stack to new block + $tmphash->{__stack} = $this->_copy($config->{__stack}); + } + + push @ar, $this->_parse( $tmphash, \@newcontent); + + $config->{$block} = \@ar; + } + } + } + else { + # the first occurrence of this particular block + my $tmphash = $this->_hashref(); + + if ($this->{InterPolateVars}) { + # inherit current __stack to new block + $tmphash->{__stack} = $this->_copy($config->{__stack}); + } + + $config->{$block} = $this->_parse($tmphash, \@newcontent); + } + } + undef $blockname; + undef $block; + $this->{level} -= 1; + next; + } + } + else { # inside $block, just push onto new content stack + push @newcontent, $_; + } + } + if ($block) { + # $block is still defined, which means, that it had + # no matching endblock! + croak "Config::General: Block \"<$block>\" has no EndBlock statement (level: $this->{level}, chunk $chunk)!\n"; + } + return $config; +} + + +sub _copy { + # + # copy the contents of one hash into another + # to circumvent invalid references + # fixes rt.cpan.org bug #35122 + my($this, $source) = @_; + my %hash = (); + while (my ($key, $value) = each %{$source}) { + $hash{$key} = $value; + } + return \%hash; +} + + +sub _parse_value { + # + # parse the value if value parsing is turned on + # by either -AutoTrue and/or -FlagBits + # otherwise just return the given value unchanged + # + my($this, $config, $option, $value) =@_; + + my $cont; + ($cont, $option, $value) = $this->_hook('pre_parse_value', $option, $value); + return $value if(!$cont); + + # avoid "Use of uninitialized value" + if (! defined $value) { + # patch fix rt#54583 + # Return an input undefined value without trying transformations + return $value; + } + + if($this->{NormalizeValue}) { + $value = $this->{NormalizeValue}($value); + } + + if ($this->{InterPolateVars}) { + $value = $this->_interpolate($config, $option, $value); + } + + # make true/false values to 1 or 0 (-AutoTrue) + if ($this->{AutoTrue}) { + if ($value =~ /$this->{AutoTrueFlags}->{true}/io) { + $value = 1; + } + elsif ($value =~ /$this->{AutoTrueFlags}->{false}/io) { + $value = 0; + } + } + + # assign predefined flags or undef for every flag | flag ... (-FlagBits) + if ($this->{FlagBits}) { + if (exists $this->{FlagBitsFlags}->{$option}) { + my %__flags = map { $_ => 1 } split /\s*\|\s*/, $value; + foreach my $flag (keys %{$this->{FlagBitsFlags}->{$option}}) { + if (exists $__flags{$flag}) { + $__flags{$flag} = $this->{FlagBitsFlags}->{$option}->{$flag}; + } + else { + $__flags{$flag} = undef; + } + } + $value = \%__flags; + } + } + + if (!$this->{NoEscape}) { + # are there any escaped characters left? put them out as is + $value =~ s/\\([\$\\\"#])/$1/g; + } + + ($cont, $option, $value) = $this->_hook('post_parse_value', $option, $value); + + return $value; +} + + + +sub _hook { + my ($this, $hook, @arguments) = @_; + if(exists $this->{Plug}->{$hook}) { + my $sub = $this->{Plug}->{$hook}; + my @hooked = &$sub(@arguments); + return @hooked; + } + return (1, @arguments); +} + + + +sub save { + # + # this is the old version of save() whose API interface + # has been changed. I'm very sorry 'bout this. + # + # I'll try to figure out, if it has been called correctly + # and if yes, feed the call to Save(), otherwise croak. + # + my($this, $one, @two) = @_; + + if ( (@two && $one) && ( (scalar @two) % 2 == 0) ) { + # @two seems to be a hash + my %h = @two; + $this->save_file($one, \%h); + } + else { + croak q(Config::General: The save() method is deprecated. Use the new save_file() method instead!); + } + return; +} + + +sub save_file { + # + # save the config back to disk + # + my($this, $file, $config) = @_; + my $fh; + my $config_string; + + if (!$file) { + croak "Config::General: Filename is required!"; + } + else { + if ($this->{UTF8}) { + $fh = IO::File->new; + open($fh, ">:utf8", $file) + or croak "Config::General: Could not open $file in UTF8 mode!($!)\n"; + } + else { + $fh = IO::File->new( "$file", 'w') + or croak "Config::General: Could not open $file!($!)\n"; + } + if (!$config) { + if (exists $this->{config}) { + $config_string = $this->_store(0, $this->{config}); + } + else { + croak "Config::General: No config hash supplied which could be saved to disk!\n"; + } + } + else { + $config_string = $this->_store(0, $config); + } + + if ($config_string) { + print {$fh} $config_string; + } + else { + # empty config for whatever reason, I don't care + print {$fh} q(); + } + + close $fh; + } + return; +} + + + +sub save_string { + # + # return the saved config as a string + # + my($this, $config) = @_; + + if (!$config || ref($config) ne 'HASH') { + if (exists $this->{config}) { + return $this->_store(0, $this->{config}); + } + else { + croak "Config::General: No config hash supplied which could be saved to disk!\n"; + } + } + else { + return $this->_store(0, $config); + } + return; +} + + + +sub _store { + # + # internal sub for saving a block + # + my($this, $level, $config) = @_; + local $_; + my $indent = q( ) x $level; + + my $config_string = q(); + + foreach my $entry ( $this->{SaveSorted} ? sort keys %$config : keys %$config ) { + # fix rt#104548 + if ($entry =~ /[<>\n\r]/) { + croak "Config::General: current key contains invalid characters: $entry!\n"; + } + + if (ref($config->{$entry}) eq 'ARRAY') { + if( $this->{ForceArray} && scalar @{$config->{$entry}} == 1 && ! ref($config->{$entry}->[0]) ) { + # a single value array forced to stay as array + $config_string .= $this->_write_scalar($level, $entry, '[' . $config->{$entry}->[0] . ']'); + } + else { + foreach my $line ( $this->{SaveSorted} ? sort @{$config->{$entry}} : @{$config->{$entry}} ) { + if (ref($line) eq 'HASH') { + $config_string .= $this->_write_hash($level, $entry, $line); + } + else { + $config_string .= $this->_write_scalar($level, $entry, $line); + } + } + } + } + elsif (ref($config->{$entry}) eq 'HASH') { + $config_string .= $this->_write_hash($level, $entry, $config->{$entry}); + } + else { + $config_string .= $this->_write_scalar($level, $entry, $config->{$entry}); + } + } + + return $config_string; +} + + +sub _write_scalar { + # + # internal sub, which writes a scalar + # it returns it, in fact + # + my($this, $level, $entry, $line) = @_; + + my $indent = q( ) x $level; + + my $config_string; + + # patch fix rt#54583 + if ( ! defined $line ) { + $config_string .= $indent . $entry . "\n"; + } + elsif ($line =~ /\n/ || $line =~ /\\$/) { + # it is a here doc + my $delimiter; + my $tmplimiter = 'EOF'; + while (!$delimiter) { + # create a unique here-doc identifier + if ($line =~ /$tmplimiter/s) { + $tmplimiter .= '%'; + } + else { + $delimiter = $tmplimiter; + } + } + my @lines = split /\n/, $line; + $config_string .= $indent . $entry . $this->{StoreDelimiter} . "<<$delimiter\n"; + foreach (@lines) { + $config_string .= $indent . $_ . "\n"; + } + $config_string .= $indent . "$delimiter\n"; + } + else { + # a simple stupid scalar entry + + if (!$this->{NoEscape}) { + # re-escape contained $ or # or \ chars + $line =~ s/([#\$\\\"])/\\$1/g; + } + + # bugfix rt.cpan.org#42287 + if ($line =~ /^\s/ or $line =~ /\s$/) { + # need to quote it + $line = "\"$line\""; + } + $config_string .= $indent . $entry . $this->{StoreDelimiter} . $line . "\n"; + } + + return $config_string; +} + +sub _write_hash { + # + # internal sub, which writes a hash (block) + # it returns it, in fact + # + my($this, $level, $entry, $line) = @_; + + my $indent = q( ) x $level; + my $config_string; + + if ($entry =~ /\s/) { + # quote the entry if it contains whitespaces + $entry = q(") . $entry . q("); + } + + # check if the next level key points to a hash and is the only one + # in this case put out a named block + # fixes rt.77667 + my $num = scalar keys %{$line}; + if($num == 1) { + my $key = (keys %{$line})[0]; + if(ref($line->{$key}) eq 'HASH') { + $config_string .= $indent . qq(<$entry $key>\n); + $config_string .= $this->_store($level + 1, $line->{$key}); + $config_string .= $indent . qq(\n"; + return $config_string; + } + } + + $config_string .= $indent . q(<) . $entry . ">\n"; + $config_string .= $this->_store($level + 1, $line); + $config_string .= $indent . q(\n"; + + return $config_string +} + + +sub _hashref { + # + # return a probably tied new empty hash ref + # + my($this) = @_; + if ($this->{Tie}) { + eval { + eval qq{require $this->{Tie}}; + }; + if ($EVAL_ERROR) { + croak q(Config::General: Could not create a tied hash of type: ) . $this->{Tie} . q(: ) . $EVAL_ERROR; + } + my %hash; + tie %hash, $this->{Tie}; + return \%hash; + } + else { + return {}; + } +} + + +# +# Procedural interface +# +sub ParseConfig { + # + # @_ may contain everything which is allowed for new() + # + return (new Config::General(@_))->getall(); +} + +sub SaveConfig { + # + # 2 parameters are required, filename and hash ref + # + my ($file, $hash) = @_; + + if (!$file || !$hash) { + croak q{Config::General::SaveConfig(): filename and hash argument required.}; + } + else { + if (ref($hash) ne 'HASH') { + croak q(Config::General::SaveConfig() The second parameter must be a reference to a hash!); + } + else { + (new Config::General(-ConfigHash => $hash))->save_file($file); + } + } + return; +} + +sub SaveConfigString { + # + # same as SaveConfig, but return the config, + # instead of saving it + # + my ($hash) = @_; + + if (!$hash) { + croak q{Config::General::SaveConfigString(): Hash argument required.}; + } + else { + if (ref($hash) ne 'HASH') { + croak q(Config::General::SaveConfigString() The parameter must be a reference to a hash!); + } + else { + return (new Config::General(-ConfigHash => $hash))->save_string(); + } + } + return; +} + + + +# keep this one + 1; +__END__ + + + + +=head1 NAME + +Config::General - Generic Config Module + +=head1 SYNOPSIS + + # + # the OOP way + use Config::General; + $conf = Config::General->new("rcfile"); + my %config = $conf->getall; + + # + # the procedural way + use Config::General qw(ParseConfig SaveConfig SaveConfigString); + my %config = ParseConfig("rcfile"); + +=head1 DESCRIPTION + +This module opens a config file and parses its contents for you. The B method +requires one parameter which needs to be a filename. The method B returns a hash +which contains all options and its associated values of your config file. + +The format of config files supported by B is inspired by the well known Apache config +format, in fact, this module is 100% compatible to Apache configs, but you can also just use simple + name/value pairs in your config files. + +In addition to the capabilities of an Apache config file it supports some enhancements such as here-documents, +C-style comments or multiline options. + + +=head1 SUBROUTINES/METHODS + +=over + +=item new() + +Possible ways to call B: + + $conf = Config::General->new("rcfile"); + + $conf = Config::General->new(\%somehash); + + $conf = Config::General->new( %options ); # see below for description of possible options + + +This method returns a B object (a hash blessed into "Config::General" namespace. +All further methods must be used from that returned object. see below. + +You can use the new style with hash parameters or the old style which is of course +still supported. Possible parameters to B are: + +* a filename of a configfile, which will be opened and parsed by the parser + +or + +* a hash reference, which will be used as the config. + +An alternative way to call B is supplying an option- hash with one or more of +the following keys set: + +=over + +=item B<-ConfigFile> + +A filename or a filehandle, i.e.: + + -ConfigFile => "rcfile" or -ConfigFile => \$FileHandle + + + +=item B<-ConfigHash> + +A hash reference, which will be used as the config, i.e.: + + -ConfigHash => \%somehash + + + +=item B<-String> + +A string which contains a whole config, or an arrayref +containing the whole config line by line. +The parser will parse the contents of the string instead +of a file. i.e: + + -String => $complete_config + +it is also possible to feed an array reference to -String: + + -String => \@config_lines + + + +=item B<-AllowMultiOptions> + +If the value is "no", then multiple identical options are disallowed. +The default is "yes". +i.e.: + + -AllowMultiOptions => "yes" + +see B for details. + +=item B<-LowerCaseNames> + +If set to a true value, then all options found in the config will be converted +to lowercase. This allows you to provide case-in-sensitive configs. The +values of the options will B lowercased. + + + +=item B<-UseApacheInclude> + +If set to a true value, the parser will consider "include ..." as valid include +statement (just like the well known Apache include statement). + +It also supports apache's "IncludeOptional" statement with the same behavior, +that is, if the include file doesn't exist no error will be thrown. + +=item B<-IncludeRelative> + +If set to a true value, included files with a relative path (i.e. "cfg/blah.conf") +will be opened from within the location of the configfile instead from within the +location of the script($0). This works only if the configfile has a absolute pathname +(i.e. "/etc/main.conf"). + +If the variable B<-ConfigPath> has been set and if the file to be included could +not be found in the location relative to the current config file, the module +will search within B<-ConfigPath> for the file. See the description of B<-ConfigPath> +for more details. + + +=item B<-IncludeDirectories> + +If set to a true value, you may specify include a directory, in which case all +files inside the directory will be loaded in ASCII order. Directory includes +will not recurse into subdirectories. This is comparable to including a +directory in Apache-style config files. + + +=item B<-IncludeGlob> + +If set to a true value, you may specify a glob pattern for an include to +include all matching files (e.g. <>). Also note that as +with standard file patterns, * will not match dot-files, so <> +is often more desirable than including a directory with B<-IncludeDirectories>. + +An include option will not cause a parser error if the glob didn't return anything. + +=item B<-IncludeAgain> + +If set to a true value, you will be able to include a sub-configfile +multiple times. With the default, false, you will get a warning about +duplicate includes and only the first include will succeed. + +Reincluding a configfile can be useful if it contains data that you want to +be present in multiple places in the data tree. See the example under +L. + +Note, however, that there is currently no check for include recursion. + + +=item B<-ConfigPath> + +As mentioned above, you can use this variable to specify a search path for relative +config files which have to be included. Config::General will search within this +path for the file if it cannot find the file at the location relative to the +current config file. + +To provide multiple search paths you can specify an array reference for the +path. For example: + + @path = qw(/usr/lib/perl /nfs/apps/lib /home/lib); + .. + -ConfigPath => \@path + + + +=item B<-MergeDuplicateBlocks> + +If set to a true value, then duplicate blocks, that means blocks and named blocks, +will be merged into a single one (see below for more details on this). +The default behavior of Config::General is to create an array if some junk in a +config appears more than once. + + +=item B<-MergeDuplicateOptions> + +If set to a true value, then duplicate options will be merged. That means, if the +same option occurs more than once, the last one will be used in the resulting +config hash. + +Setting this option implies B<-AllowMultiOptions == false> unless you set +B<-AllowMultiOptions> explicit to 'true'. In this case duplicate blocks are +allowed and put into an array but duplicate options will be merged. + + +=item B<-AutoLaunder> + +If set to a true value, then all values in your config file will be laundered +to allow them to be used under a -T taint flag. This could be regarded as circumventing +the purpose of the -T flag, however, if the bad guys can mess with your config file, +you have problems that -T will not be able to stop. AutoLaunder will only handle +a config file being read from -ConfigFile. + + + +=item B<-AutoTrue> + +If set to a true value, then options in your config file, whose values are set to +true or false values, will be normalised to 1 or 0 respectively. + +The following values will be considered as B: + + yes, on, 1, true + +The following values will be considered as B: + + no, off, 0, false + +This effect is case-insensitive, i.e. both "Yes" or "No" will result in 1. + + +=item B<-FlagBits> + +This option takes one required parameter, which must be a hash reference. + +The supplied hash reference needs to define variables for which you +want to preset values. Each variable you have defined in this hash-ref +and which occurs in your config file, will cause this variable being +set to the preset values to which the value in the config file refers to. + +Multiple flags can be used, separated by the pipe character |. + +Well, an example will clarify things: + + my $conf = Config::General->new( + -ConfigFile => "rcfile", + -FlagBits => { + Mode => { + CLEAR => 1, + STRONG => 1, + UNSECURE => "32bit" } + } + ); + +In this example we are defining a variable named I<"Mode"> which +may contain one or more of "CLEAR", "STRONG" and "UNSECURE" as value. + +The appropriate config entry may look like this: + + # rcfile + Mode = CLEAR | UNSECURE + +The parser will create a hash which will be the value of the key "Mode". This +hash will contain B flags which you have pre-defined, but only those +which were set in the config will contain the pre-defined value, the other +ones will be undefined. + +The resulting config structure would look like this after parsing: + + %config = ( + Mode => { + CLEAR => 1, + UNSECURE => "32bit", + STRONG => undef, + } + ); + +This method allows the user (or, the "maintainer" of the configfile for your +application) to set multiple pre-defined values for one option. + +Please beware, that all occurrences of those variables will be handled this +way, there is no way to distinguish between variables in different scopes. +That means, if "Mode" would also occur inside a named block, it would +also parsed this way. + +Values which are not defined in the hash-ref supplied to the parameter B<-FlagBits> +and used in the corresponding variable in the config will be ignored. + +Example: + + # rcfile + Mode = BLAH | CLEAR + +would result in this hash structure: + + %config = ( + Mode => { + CLEAR => 1, + UNSECURE => undef, + STRONG => undef, + } + ); + +"BLAH" will be ignored silently. + + +=item B<-DefaultConfig> + +This can be a hash reference or a simple scalar (string) of a config. This +causes the module to preset the resulting config hash with the given values, +which allows you to set default values for particular config options directly. + +Note that you probably want to use this with B<-MergeDuplicateOptions>, otherwise +a default value already in the configuration file will produce an array of two +values. + +=item B<-Tie> + +B<-Tie> takes the name of a Tie class as argument that each new hash should be +based off of. + +This hash will be used as the 'backing hash' instead of a standard Perl hash, +which allows you to affect the way, variable storing will be done. You could, for +example supply a tied hash, say Tie::DxHash, which preserves ordering of the +keys in the config (which a standard Perl hash won't do). Or, you could supply +a hash tied to a DBM file to save the parsed variables to disk. + +There are many more things to do in tie-land, see L to get some interesting +ideas. + +If you want to use the B<-Tie> feature together with B<-DefaultConfig> make sure +that the hash supplied to B<-DefaultConfig> must be tied to the same Tie class. + +Make sure that the hash which receives the generated hash structure (e.g. which +you are using in the assignment: %hash = $config->getall()) must be tied to +the same Tie class. + +Example: + + use Config::General qw(ParseConfig); + use Tie::IxHash; + tie my %hash, "Tie::IxHash"; + %hash = ParseConfig( + -ConfigFile => shift(), + -Tie => "Tie::IxHash" + ); + + +=item B<-InterPolateVars> + +If set to a true value, variable interpolation will be done on your config +input. See L for more information. + +=item B<-InterPolateEnv> + +If set to a true value, environment variables can be used in +configs. + +This implies B<-InterPolateVars>. + +=item B<-AllowSingleQuoteInterpolation> + +By default variables inside single quotes will not be interpolated. If +you turn on this option, they will be interpolated as well. + +=item B<-ExtendedAccess> + +If set to a true value, you can use object oriented (extended) methods to +access the parsed config. See L for more information. + +=item B<-StrictObjects> + +By default this is turned on, which causes Config::General to croak with an +error if you try to access a non-existent key using the OOP-way (B<-ExtendedAcess> +enabled). If you turn B<-StrictObjects> off (by setting to 0 or "no") it will +just return an empty object/hash/scalar. This is valid for OOP-access 8via AUTOLOAD +and for the methods obj(), hash() and value(). + + +=item B<-StrictVars> + +By default this is turned on, which causes Config::General to croak with an +error if an undefined variable with B turned on occurs +in a config. Set to I (i.e. 0) to avoid such error messages. + +=item B<-SplitPolicy> + +You can influence the way how Config::General decides which part of a line +in a config file is the key and which one is the value. By default it tries +its best to guess. That means you can mix equalsign assignments and whitespace +assignments. + +However, sometime you may wish to make it more strictly for some reason. In +this case you can set B<-SplitPolicy>. The possible values are: 'guess' which +is the default, 'whitespace' which causes the module to split by whitespace, +'equalsign' which causes it to split strictly by equal sign, or 'custom'. In the +latter case you must also set B<-SplitDelimiter> to some regular expression +of your choice. For example: + + -SplitDelimiter => '\s*:\s*' + +will cause the module to split by colon while whitespace which surrounds +the delimiter will be removed. + +Please note that the delimiter used when saving a config (save_file() or save_string()) +will be chosen according to the current B<-SplitPolicy>. If -SplitPolicy is +set to 'guess' or 'whitespace', 3 spaces will be used to delimit saved +options. If 'custom' is set, then you need to set B<-StoreDelimiter>. + +=item B<-SplitDelimiter> + +Set this to any arbitrary regular expression which will be used for option/value +splitting. B<-SplitPolicy> must be set to 'custom' to make this work. + +=item B<-StoreDelimiter> + +You can use this parameter to specify a custom delimiter to use when saving +configs to a file or string. You only need to set it if you want to store +the config back to disk and if you have B<-SplitPolicy> set to 'custom'. + +However, this parameter takes precedence over whatever is set for B<-SplitPolicy>. + +Be very careful with this parameter. + + +=item B<-CComments> + +Config::General is able to notice c-style comments (see section COMMENTS). +But for some reason you might no need this. In this case you can turn +this feature off by setting B<-CComments> to a false value('no', 0, 'off'). + +By default B<-CComments> is turned on. + + +=item B<-BackslashEscape> + +B. + +=item B<-SlashIsDirectory> + +If you turn on this parameter, a single slash as the last character +of a named block will be considered as a directory name. + +By default this flag is turned off, which makes the module somewhat +incompatible to Apache configs, since such a setup will be normally +considered as an explicit empty block, just as XML defines it. + +For example, if you have the following config: + + + Index index.awk + + +you will get such an error message from the parser: + + EndBlock "" has no StartBlock statement (level: 1, chunk 10)! + +This is caused by the fact that the config chunk below will be +internally converted to: + + + Index index.awk + + +Now there is one '' too much. The proper solution is +to use quotation to circumvent this error: + + + Index index.awk + + +However, a raw apache config comes without such quotes. In this +case you may consider to turn on B<-SlashIsDirectory>. + +Please note that this is a new option (incorporated in version 2.30), +it may lead to various unexpected side effects or other failures. +You've been warned. + +=item B<-UseApacheIfDefine> + +Enables support for Apache ... . See -Define. + +=item B<-Define> + +Defines the symbols to be used for conditional configuration files. +Allowed arguments: scalar, scalar ref, array ref or hash ref. + +Examples: + + -Define => 'TEST' + -Define => \$testOrProduction + -Define => [qw(TEST VERBOSE)] + -Define => {TEST => 1, VERBOSE => 1} + +Sample configuration: + + + + Level Debug + include test/*.cfg + + + Level Notice + include production/*.cfg + + + +=item B<-ApacheCompatible> + +Over the past years a lot of options has been incorporated +into Config::General to be able to parse real Apache configs. + +The new B<-ApacheCompatible> option now makes it possible to +tweak all options in a way that Apache configs can be parsed. + +This is called "apache compatibility mode" - if you will ever +have problems with parsing Apache configs without this option +being set, you'll get no help by me. Thanks :) + +The following options will be set: + + UseApacheInclude = 1 + IncludeRelative = 1 + IncludeDirectories = 1 + IncludeGlob = 1 + SlashIsDirectory = 1 + SplitPolicy = 'whitespace' + CComments = 0 + UseApacheIfDefine = 1 + +Take a look into the particular documentation sections what +those options are doing. + +Beside setting some options it also turns off support for +explicit empty blocks. + +=item B<-UTF8> + +If turned on, all files will be opened in utf8 mode. This may +not work properly with older versions of Perl. + +=item B<-SaveSorted> + +If you want to save configs in a sorted manner, turn this +parameter on. It is not enabled by default. + +=item B<-NoEscape> + +If you want to use the data ( scalar or final leaf ) without escaping special character, turn this +parameter on. It is not enabled by default. + +=item B<-NormalizeBlock> + +Takes a subroutine reference as parameter and gets the current +block or blockname passed as parameter and is expected to return +it in some altered way as a scalar string. The sub will be called +before anything else will be done by the module itself (e.g. interpolation). + +Example: + + -NormalizeBlock => sub { my $x = shift; $x =~ s/\s*$//; $x; } + +This removes trailing whitespaces of block names. + +=item B<-NormalizeOption> + +Same as B<-NormalizeBlock> but applied on options only. + +=item B<-NormalizeValue> + +Same as B<-NormalizeBlock> but applied on values only. + +=back + + + + +=item getall() + +Returns a hash structure which represents the whole config. + +=item files() + +Returns a list of all files read in. + +=item save_file() + +Writes the config hash back to the hard disk. This method takes one or two +parameters. The first parameter must be the filename where the config +should be written to. The second parameter is optional, it must be a +reference to a hash structure, if you set it. If you do not supply this second parameter +then the internal config hash, which has already been parsed, will be +used. + +Please note that any occurrence of comments will be ignored by getall() +and thus be lost after you call this method. + +You need also to know that named blocks will be converted to nested blocks +(which is the same from the perl point of view). An example: + + + id 13 + + +will become the following after saving: + + + + id 13 + + + +Example: + + $conf_obj->save_file("newrcfile", \%config); + +or, if the config has already been parsed, or if it didn't change: + + $conf_obj->save_file("newrcfile"); + + +=item save_string() + +This method is equivalent to the previous save_file(), but it does not +store the generated config to a file. Instead it returns it as a string, +which you can save yourself afterwards. + +It takes one optional parameter, which must be a reference to a hash structure. +If you omit this parameter, the internal config hash, which has already been parsed, +will be used. + +Example: + + my $content = $conf_obj->save_string(\%config); + +or: + + my $content = $conf_obj->save_string(); + + +=back + + +=head1 CONFIG FILE FORMAT + +Lines beginning with B<#> and empty lines will be ignored. (see section COMMENTS!) +Spaces at the beginning and the end of a line will also be ignored as well as tabulators. +If you need spaces at the end or the beginning of a value you can surround it with +double quotes. +An option line starts with its name followed by a value. An equal sign is optional. +Some possible examples: + + user max + user = max + user max + +If there are more than one statements with the same name, it will create an array +instead of a scalar. See the example below. + +The method B returns a hash of all values. + + +=head1 BLOCKS + +You can define a B of options. A B looks much like a block +in the wellknown Apache config format. It starts with EBE and ends +with E/BE. + +A block start and end cannot be on the same line. + +An example: + + + host = muli + user = moare + dbname = modb + dbpass = D4r_9Iu + + +Blocks can also be nested. Here is a more complicated example: + + user = hans + server = mc200 + db = maxis + passwd = D3rf$ + + user = tom + db = unknown + host = mila + + index int(100000) + name char(100) + prename char(100) + city char(100) + status int(10) + allowed moses + allowed ingram + allowed joice + + + +The hash which the method B returns look like that: + + print Data::Dumper(\%hash); + $VAR1 = { + 'passwd' => 'D3rf$', + 'jonas' => { + 'tablestructure' => { + 'prename' => 'char(100)', + 'index' => 'int(100000)', + 'city' => 'char(100)', + 'name' => 'char(100)', + 'status' => 'int(10)', + 'allowed' => [ + 'moses', + 'ingram', + 'joice', + ] + }, + 'host' => 'mila', + 'db' => 'unknown', + 'user' => 'tom' + }, + 'db' => 'maxis', + 'server' => 'mc200', + 'user' => 'hans' + }; + +If you have turned on B<-LowerCaseNames> (see new()) then blocks as in the +following example: + + + + Owner root + + + +would produce the following hash structure: + + $VAR1 = { + 'dir' => { + 'attributes' => { + 'owner' => "root", + } + } + }; + +As you can see, the keys inside the config hash are normalized. + +Please note, that the above config block would result in a +valid hash structure, even if B<-LowerCaseNames> is not set! +This is because I does not +use the block names to check if a block ends, instead it uses an internal +state counter, which indicates a block end. + +If the module cannot find an end-block statement, then this block will be ignored. + + + +=head1 NAMED BLOCKS + +If you need multiple blocks of the same name, then you have to name every block. +This works much like Apache config. If the module finds a named block, it will +create a hashref with the left part of the named block as the key containing +one or more hashrefs with the right part of the block as key containing everything +inside the block(which may again be nested!). As examples says more than words: + +# given the following sample + + Limit Deny + Options ExecCgi Index + + + Limit DenyAll + Options None + + +# you will get: + + $VAR1 = { + 'Directory' => { + '/usr/frik' => { + 'Options' => 'None', + 'Limit' => 'DenyAll' + }, + '/usr/frisco' => { + 'Options' => 'ExecCgi Index', + 'Limit' => 'Deny' + } + } + }; + +You cannot have more than one named block with the same name because it will +be stored in a hashref and therefore be overwritten if a block occurs once more. + + +=head1 WHITESPACE IN BLOCKS + +The normal behavior of Config::General is to look for whitespace in +block names to decide if it's a named block or just a simple block. + +Sometimes you may need blocknames which have whitespace in their names. + +With named blocks this is no problem, as the module only looks for the +first whitespace: + + + + +would be parsed to: + + $VAR1 = { + 'person' => { + 'hugo gera' => { + }, + } + }; + +The problem occurs, if you want to have a simple block containing whitespace: + + + + +This would be parsed as a named block, which is not what you wanted. In this +very case you may use quotation marks to indicate that it is not a named block: + + <"hugo gera"> + + +The save() method of the module inserts automatically quotation marks in such +cases. + + +=head1 EXPLICIT EMPTY BLOCKS + +Beside the notation of blocks mentioned above it is possible to use +explicit empty blocks. + +Normally you would write this in your config to define an empty +block: + + + + +To save writing you can also write: + + + +which is the very same as above. This works for normal blocks and +for named blocks. + + + +=head1 IDENTICAL OPTIONS (ARRAYS) + +You may have more than one line of the same option with different values. +Example: + + log log1 + log log2 + log log2 + +You will get a scalar if the option occurred only once or an array if it occurred +more than once. If you expect multiple identical options, then you may need to +check if an option occurred more than once: + + $allowed = $hash{jonas}->{tablestructure}->{allowed}; + if (ref($allowed) eq "ARRAY") { + @ALLOWED = @{$allowed}; + else { + @ALLOWED = ($allowed); + } + } + +The same applies to blocks and named blocks too (they are described in more detail +below). For example, if you have the following config: + + + user max + + + user hannes + + +then you would end up with a data structure like this: + + $VAR1 = { + 'dir' => { + 'blah' => [ + { + 'user' => 'max' + }, + { + 'user' => 'hannes' + } + ] + } + }; + +As you can see, the two identical blocks are stored in a hash which contains +an array(-reference) of hashes. + +Under some rare conditions you might not want this behavior with blocks (and +named blocks too). If you want to get one single hash with the contents of +both identical blocks, then you need to turn the B parameter B<-MergeDuplicateBlocks> +on (see above). The parsed structure of the example above would then look like +this: + + + $VAR1 = { + 'dir' => { + 'blah' => { + 'user' => [ + 'max', + 'hannes' + ] + } + } + }; + +As you can see, there is only one hash "dir->{blah}" containing multiple +"user" entries. As you can also see, turning on B<-MergeDuplicateBlocks> +does not affect scalar options (i.e. "option = value"). In fact you can +tune merging of duplicate blocks and options independent from each other. + +If you don't want to allow more than one identical options, you may turn it off +by setting the flag I in the B method to "no". +If turned off, Config::General will complain about multiple occurring options +with identical names! + +=head2 FORCE SINGLE VALUE ARRAYS + +You may also force a single config line to get parsed into an array by +turning on the option B<-ForceArray> and by surrounding the value of the +config entry by []. Example: + + hostlist = [ foo.bar ] + +Will be a singlevalue array entry if the option is turned on. If you want +it to remain to be an array you have to turn on B<-ForceArray> during save too. + +=head1 LONG LINES + +If you have a config value, which is too long and would take more than one line, +you can break it into multiple lines by using the backslash character at the end +of the line. The Config::General module will concatenate those lines to one single-value. + +Example: + + command = cat /var/log/secure/tripwire | \ + mail C<-s> "report from tripwire" \ + honey@myotherhost.nl + +command will become: +"cat /var/log/secure/tripwire | mail C<-s> 'report from twire' honey@myotherhost.nl" + + +=head1 HERE DOCUMENTS + +You can also define a config value as a so called "here-document". You must tell +the module an identifier which indicates the end of a here document. An +identifier must follow a "<<". + +Example: + + message <. + +There is a special feature which allows you to use indentation with here documents. +You can have any amount of whitespace or tabulators in front of the end +identifier. If the module finds spaces or tabs then it will remove exactly those +amount of spaces from every line inside the here-document. + +Example: + + message <> + +If you turned on B<-UseApacheInclude> (see B), then you can also use the following +statement to include an external file: + + include externalconfig.rc + +This file will be inserted at the position where it was found as if the contents of this file +were directly at this position. + +You can also recursively include files, so an included file may include another one and so on. +Beware that you do not recursively load the same file, you will end with an error message like +"too many open files in system!". + +By default included files with a relative pathname will be opened from within the current +working directory. Under some circumstances it maybe possible to +open included files from the directory, where the configfile resides. You need to turn on +the option B<-IncludeRelative> (see B) if you want that. An example: + + my $conf = Config::General( + -ConfigFile => "/etc/crypt.d/server.cfg" + -IncludeRelative => 1 + ); + +/etc/crypt.d/server.cfg: + + <> + +In this example Config::General will try to include I from I: + + /etc/crypt.d/acl.cfg + +The default behavior (if B<-IncludeRelative> is B set!) will be to open just I, +wherever it is, i.e. if you did a chdir("/usr/local/etc"), then Config::General will include: + + /usr/local/etc/acl.cfg + +Include statements can be case insensitive (added in version 1.25). + +Include statements will be ignored within C-Comments and here-documents. + +By default, a config file will only be included the first time it is +referenced. If you wish to include a file in multiple places, set +B to true. But be warned: this may lead to infinite loops, +so make sure, you're not including the same file from within itself! + +Example: + + # main.cfg + + class=Some::Class + + include printers.cfg + + # ... + + + class=Another::Class + + include printers.cfg + + # ... + + +Now C will be include in both the C and C objects. + +You will have to be careful to not recursively include a file. Behaviour +in this case is undefined. + + + +=head1 COMMENTS + +A comment starts with the number sign B<#>, there can be any number of spaces and/or +tab stops in front of the #. + +A comment can also occur after a config statement. Example: + + username = max # this is the comment + +If you want to comment out a large block you can use C-style comments. A B signals +the begin of a comment block and the B<*/> signals the end of the comment block. +Example: + + user = max # valid option + db = tothemax + /* + user = andors + db = toand + */ + +In this example the second options of user and db will be ignored. Please beware of the fact, +if the Module finds a B string which is the start of a comment block, but no matching +end block, it will ignore the whole rest of the config file! + +B If you require the B<#> character (number sign) to remain in the option value, then +you can use a backslash in front of it, to escape it. Example: + + bgcolor = \#ffffcc + +In this example the value of $config{bgcolor} will be "#ffffcc", Config::General will not treat +the number sign as the begin of a comment because of the leading backslash. + +Inside here-documents escaping of number signs is NOT required! + + +=head1 PARSER PLUGINS + +You can alter the behavior of the parser by supplying closures +which will be called on certain hooks during config file processing +and parsing. + +The general aproach works like this: + + sub ck { + my($file, $base) = @_; + print "_open() tries $file ... "; + if ($file =~ /blah/) { + print "ignored\n"; + return (0); + } else { + print "allowed\n"; + return (1, @_); + } + } + + my %c = ParseConfig( + -IncludeGlob => 1, + -UseApacheInclude => 1, + -ConfigFile => shift, + -Plug => { pre_open => *ck } + ); + +Output: + + _open() tries cfg ... allowed + _open() tries x/*.conf ... allowed + _open() tries x/1.conf ... allowed + _open() tries x/2.conf ... allowed + _open() tries x/blah.conf ... ignored + +As you can see, we wrote a little sub which takes a filename +and a base directory as parameters. We tell Config::General via +the B parameter of B to call this sub everytime +before it attempts to open a file. + +General processing continues as usual if the first value of +the returned array is true. The second value of that array +depends on the kind of hook being called. + +The following hooks are available so far: + +=over + +=item B + +Takes two parameters: filename and basedirectory. + +Has to return an array consisting of 3 values: + + - 1 or 0 (continue processing or not) + - filename + - base directory + +=item B + +Takes two parameters: the filehandle of the file to be read +and an array containing the raw contents of said file. + +This hook will be applied in _read(). File contents are already +available at this stage, comments will be removed, here-docs normalized +and the like. This hook gets the unaltered, original contents. + +Has to return an array of 3 values: + + - 1 or 0 (continue processing or not) + - the filehandle + - an array of strings + +You can use this hook to apply your own normalizations or whatever. + +Be careful when returning the abort value (1st value of returned array 0), +since in this case nothing else would be done on the contents. If it still +contains comments or something, they will be parsed as legal config options. + +=item B + +Takes one parameter: a reference to an array containing the prepared +config lines (after being processed by _read()). + +This hook will be applied in _read() when everything else has been done. + +Has to return an array of 2 values: + + - 1 or 0 (continue processing or not) [Ignored for post hooks] + - a reference to an array containing the config lines + +=item B + +Takes 2 parameters: an option name and its value. + +This hook will be applied in _parse_value() before any processing. + +Has to return an array of 3 values: + + - 1 or 0 (continue processing or not) + - option name + - value of the option + +=item B + +Almost identical to pre_parse_value, but will be applied after _parse_value() +is finished and all usual processing and normalization is done. + +=back + +Not implemented yet: hooks for variable interpolation and block +parsing. + + +=head1 OBJECT ORIENTED INTERFACE + +There is a way to access a parsed config the OO-way. +Use the module B, which is +supplied with the Config::General distribution. + +=head1 VARIABLE INTERPOLATION + +You can use variables inside your config files if you like. To do +that you have to use the module B, +which is supplied with the Config::General distribution. + + +=head1 EXPORTED FUNCTIONS + +Config::General exports some functions too, which makes it somewhat +easier to use it, if you like this. + +How to import the functions: + + use Config::General qw(ParseConfig SaveConfig SaveConfigString); + +=over + +=item B + +This function takes exactly all those parameters, which are +allowed to the B method of the standard interface. + +Example: + + use Config::General qw(ParseConfig); + my %config = ParseConfig(-ConfigFile => "rcfile", -AutoTrue => 1); + + +=item B + +This function requires two arguments, a filename and a reference +to a hash structure. + +Example: + + use Config::General qw(SaveConfig); + .. + SaveConfig("rcfile", \%some_hash); + + +=item B + +This function requires a reference to a config hash as parameter. +It generates a configuration based on this hash as the object-interface +method B does. + +Example: + + use Config::General qw(ParseConfig SaveConfigString); + my %config = ParseConfig(-ConfigFile => "rcfile"); + .. # change %config something + my $content = SaveConfigString(\%config); + + +=back + +=head1 CONFIGURATION AND ENVIRONMENT + +No environment variables will be used. + +=head1 SEE ALSO + +I recommend you to read the following documents, which are supplied with Perl: + + perlreftut Perl references short introduction + perlref Perl references, the rest of the story + perldsc Perl data structures intro + perllol Perl data structures: arrays of arrays + + Config::General::Extended Object oriented interface to parsed configs + Config::General::Interpolated Allows one to use variables inside config files + +=head1 LICENSE AND COPYRIGHT + +Copyright (c) 2000-2022 Thomas Linden + +This library is free software; you can redistribute it and/or +modify it under the same terms of the Artistic License 2.0. + +=head1 BUGS AND LIMITATIONS + +See rt.cpan.org for current bugs, if any. + +=head1 INCOMPATIBILITIES + +None known. + +=head1 DIAGNOSTICS + +To debug Config::General use the Perl debugger, see L. + +=head1 DEPENDENCIES + +Config::General depends on the modules L, +L, L, which all are +shipped with Perl. + +=head1 AUTHOR + +Thomas Linden + +=head1 VERSION + +2.65 + +=cut + diff --git a/General/Extended.pm b/General/Extended.pm new file mode 100644 index 0000000..f4369c9 --- /dev/null +++ b/General/Extended.pm @@ -0,0 +1,663 @@ +# +# Config::General::Extended - special Class based on Config::General +# +# Copyright (c) 2000-2022 Thomas Linden . +# All Rights Reserved. Std. disclaimer applies. +# Licensed under the Artistic License 2.0. +# + +# namespace +package Config::General::Extended; + +# yes we need the hash support of new() in 1.18 or higher! +use Config::General 1.18; + +use FileHandle; +use Carp; +use Exporter (); +use vars qw(@ISA @EXPORT); + +# inherit new() and so on from Config::General +@ISA = qw(Config::General Exporter); + +use strict; + + +$Config::General::Extended::VERSION = "2.07"; + + +sub new { + croak "Deprecated method Config::General::Extended::new() called.\n" + ."Use Config::General::new() instead and set the -ExtendedAccess flag.\n"; +} + + +sub getbypath { + my ($this, $path) = @_; + my $xconfig = $this->{config}; + $path =~ s#^/##; + $path =~ s#/$##; + my @pathlist = split /\//, $path; + my $index; + foreach my $element (@pathlist) { + if($element =~ /^([^\[]*)\[(\d+)\]$/) { + $element = $1; + $index = $2; + } + else { + $index = undef; + } + + if(ref($xconfig) eq "ARRAY") { + return {}; + } + elsif (! exists $xconfig->{$element}) { + return {}; + } + + if(ref($xconfig->{$element}) eq "ARRAY") { + if(! defined($index) ) { + #croak "$element is an array but you didn't specify an index to access it!\n"; + $xconfig = $xconfig->{$element}; + } + else { + if(exists $xconfig->{$element}->[$index]) { + $xconfig = $xconfig->{$element}->[$index]; + } + else { + croak "$element doesn't have an element with index $index!\n"; + } + } + } + else { + $xconfig = $xconfig->{$element}; + } + } + + return $xconfig; +} + +sub obj { + # + # returns a config object from a given key + # or from the current config hash if the $key does not exist + # or an empty object if the content of $key is empty. + # + my($this, $key) = @_; + + # just create the empty object, just in case + my $empty = $this->SUPER::new( -ExtendedAccess => 1, -ConfigHash => {}, %{$this->{Params}} ); + + if (exists $this->{config}->{$key}) { + if (!$this->{config}->{$key}) { + # be cool, create an empty object! + return $empty + } + elsif (ref($this->{config}->{$key}) eq "ARRAY") { + my @objlist; + foreach my $element (@{$this->{config}->{$key}}) { + if (ref($element) eq "HASH") { + push @objlist, + $this->SUPER::new( -ExtendedAccess => 1, + -ConfigHash => $element, + %{$this->{Params}} ); + } + else { + if ($this->{StrictObjects}) { + croak "element in list \"$key\" does not point to a hash reference!\n"; + } + # else: skip this element + } + } + return \@objlist; + } + elsif (ref($this->{config}->{$key}) eq "HASH") { + return $this->SUPER::new( -ExtendedAccess => 1, + -ConfigHash => $this->{config}->{$key}, %{$this->{Params}} ); + } + else { + # nothing supported + if ($this->{StrictObjects}) { + croak "key \"$key\" does not point to a hash reference!\n"; + } + else { + # be cool, create an empty object! + return $empty; + } + } + } + else { + # even return an empty object if $key does not exist + return $empty; + } +} + + +sub value { + # + # returns a value of the config hash from a given key + # this can be a hashref or a scalar + # + my($this, $key, $value) = @_; + if (defined $value) { + $this->{config}->{$key} = $value; + } + else { + if (exists $this->{config}->{$key}) { + return $this->{config}->{$key}; + } + else { + if ($this->{StrictObjects}) { + croak "Key \"$key\" does not exist within current object\n"; + } + else { + return ""; + } + } + } +} + + +sub hash { + # + # returns a value of the config hash from a given key + # as hash + # + my($this, $key) = @_; + if (exists $this->{config}->{$key}) { + return %{$this->{config}->{$key}}; + } + else { + if ($this->{StrictObjects}) { + croak "Key \"$key\" does not exist within current object\n"; + } + else { + return (); + } + } +} + + +sub array { + # + # returns a value of the config hash from a given key + # as array + # + my($this, $key) = @_; + if (exists $this->{config}->{$key}) { + return @{$this->{config}->{$key}}; + } + if ($this->{StrictObjects}) { + croak "Key \"$key\" does not exist within current object\n"; + } + else { + return (); + } +} + + + +sub is_hash { + # + # return true if the given key contains a hashref + # + my($this, $key) = @_; + if (exists $this->{config}->{$key}) { + if (ref($this->{config}->{$key}) eq "HASH") { + return 1; + } + else { + return; + } + } + else { + return; + } +} + + + +sub is_array { + # + # return true if the given key contains an arrayref + # + my($this, $key) = @_; + if (exists $this->{config}->{$key}) { + if (ref($this->{config}->{$key}) eq "ARRAY") { + return 1; + } + else { + return; + } + } + else { + return; + } +} + + +sub is_scalar { + # + # returns true if the given key contains a scalar(or number) + # + my($this, $key) = @_; + if (exists $this->{config}->{$key} && !ref($this->{config}->{$key})) { + return 1; + } + return; +} + + + +sub exists { + # + # returns true if the key exists + # + my($this, $key) = @_; + if (exists $this->{config}->{$key}) { + return 1; + } + else { + return; + } +} + + +sub keys { + # + # returns all keys under in the hash of the specified key, if + # it contains keys (so it must be a hash!) + # + my($this, $key) = @_; + if (!$key) { + if (ref($this->{config}) eq "HASH") { + return map { $_ } keys %{$this->{config}}; + } + else { + return (); + } + } + elsif (exists $this->{config}->{$key} && ref($this->{config}->{$key}) eq "HASH") { + return map { $_ } keys %{$this->{config}->{$key}}; + } + else { + return (); + } +} + + +sub delete { + # + # delete the given key from the config, if any + # and return what is deleted (just as 'delete $hash{key}' does) + # + my($this, $key) = @_; + if (exists $this->{config}->{$key}) { + return delete $this->{config}->{$key}; + } + else { + return undef; + } +} + + + + +sub configfile { + # + # sets or returns the config filename + # + my($this,$file) = @_; + if ($file) { + $this->{configfile} = $file; + } + return $this->{configfile}; +} + +sub find { + my $this = shift; + my $key = shift; + return undef unless $this->exists($key); + if (@_) { + return $this->obj($key)->find(@_); + } + else { + return $this->obj($key); + } +} + +sub AUTOLOAD { + # + # returns the representing value, if it is a scalar. + # + my($this, $value) = @_; + my $key = $Config::General::Extended::AUTOLOAD; # get to know how we were called + $key =~ s/.*:://; # remove package name! + + if (defined $value) { + # just set $key to $value! + $this->{config}->{$key} = $value; + } + elsif (exists $this->{config}->{$key}) { + if ($this->is_hash($key)) { + croak "Key \"$key\" points to a hash and cannot be automatically accessed\n"; + } + elsif ($this->is_array($key)) { + croak "Key \"$key\" points to an array and cannot be automatically accessed\n"; + } + else { + return $this->{config}->{$key}; + } + } + else { + if ($this->{StrictObjects}) { + croak "Key \"$key\" does not exist within current object\n"; + } + else { + # be cool + return undef; # bugfix rt.cpan.org#42331 + } + } +} + +sub DESTROY { + my $this = shift; + $this = (); +} + +# keep this one +1; + + + + + +=head1 NAME + +Config::General::Extended - Extended access to Config files + + +=head1 SYNOPSIS + + use Config::General; + + $conf = Config::General->new( + -ConfigFile => 'configfile', + -ExtendedAccess => 1 + ); + +=head1 DESCRIPTION + +This is an internal module which makes it possible to use object +oriented methods to access parts of your config file. + +Normally you don't call it directly. + +=head1 METHODS + +=over + +=item configfile('filename') + +Set the filename to be used by B to "filename". It returns the current +configured filename if called without arguments. + + +=item obj('key') + +Returns a new object (of Config::General::Extended Class) from the given key. +Short example: +Assume you have the following config: + + + + age 23 + + + age 56 + + + + blah blubber + blah gobble + leer + + +and already read it in using B, then you can get a +new object from the "individual" block this way: + + $individual = $conf->obj("individual"); + +Now if you call B on I<$individual> (just for reference) you would get: + + $VAR1 = ( + martin => { age => 13 } + ); + +Or, here is another use: + + my $individual = $conf->obj("individual"); + foreach my $person ($conf->keys("individual")) { + $man = $individual->obj($person); + print "$person is " . $man->value("age") . " years old\n"; + } + +See the discussion on B and B below. + +If the key from which you want to create a new object is empty, an empty +object will be returned. If you run the following on the above config: + + $obj = $conf->obj("other")->obj("leer"); + +Then $obj will be empty, just like if you have had run this: + + $obj = Config::General::Extended->new( () ); + +Read operations on this empty object will return nothing or even fail. +But you can use an empty object for I a new config using write +operations, i.e.: + + $obj->someoption("value"); + +See the discussion on B below. + +If the key points to a list of hashes, a list of objects will be +returned. Given the following example config: + + + + +you could write code like this to access the list the OOP way: + + my $objlist = $conf->obj("option"); + foreach my $option (@{$objlist}) { + print $option->name; + } + +Please note that the list will be returned as a reference to an array. + +Empty elements or non-hash elements of the list, if any, will be skipped. + +=item hash('key') + +This method returns a hash(if it B one!) from the config which is referenced by +"key". Given the sample config above you would get: + + my %sub_hash = $conf->hash("individual"); + print Dumper(\%sub_hash); + $VAR1 = { + martin => { age => 13 } + }; + +=item array('key') + +This the equivalent of B mentioned above, except that it returns an array. +Again, we use the sample config mentioned above: + + $other = $conf->obj("other"); + my @blahs = $other->array("blah"); + print Dumper(\@blahs); + $VAR1 = [ "blubber", "gobble" ]; + + +=item value('key') + +This method returns the scalar value of a given key. Given the following sample +config: + + name = arthur + age = 23 + +you could do something like that: + + print $conf->value("name") . " is " . $conf->value("age") . " years old\n"; + + + +You can use this method also to set the value of "key" to something if you give over +a hash reference, array reference or a scalar in addition to the key. An example: + + $conf->value("key", \%somehash); + # or + $conf->value("key", \@somearray); + # or + $conf->value("key", $somescalar); + +Please note, that this method does not complain about existing values within "key"! + +=item is_hash('key') is_array('key') is_scalar('key') + +As seen above, you can access parts of your current config using hash, array or scalar +methods. But you are right if you guess, that this might become problematic, if +for example you call B on a key which is in real not a hash but a scalar. Under +normal circumstances perl would refuse this and die. + +To avoid such behavior you can use one of the methods is_hash() is_array() is_scalar() to +check if the value of "key" is really what you expect it to be. + +An example(based on the config example from above): + + if($conf->is_hash("individual") { + $individual = $conf->obj("individual"); + } + else { + die "You need to configure a "individual" block!\n"; + } + + +=item exists('key') + +This method returns just true if the given key exists in the config. + + +=item keys('key') + +Returns an array of the keys under the specified "key". If you use the example +config above you could do that: + + print Dumper($conf->keys("individual"); + $VAR1 = [ "martin", "joseph" ]; + +If no key name was supplied, then the keys of the object itself will be returned. + +You can use this method in B loops as seen in an example above(obj() ). + + +=item delete('key') + +This method removes the given key and all associated data from the internal +hash structure. If 'key' contained data, then this data will be returned, +otherwise undef will be returned. + +=item find(@list) + +Given a list of nodes, ->find will search for a tree that branches in +just this way, returning the Config::General::Extended object it finds +at the bottom if it exists. You can also search partway down the tree +and ->find should return where you left off. + +For example, given the values B and the following +tree ( tags omitted for brevity): + + + + ... + + + ... + + BAR = shoo + +B will find the object at I with the value BAR = shoo and +return it. + + + +=back + + +=head1 AUTOLOAD METHODS + +Another useful feature is implemented in this class using the B feature +of perl. If you know the keynames of a block within your config, you can access to +the values of each individual key using the method notation. See the following example +and you will get it: + +We assume the following config: + + + name = Moser + prename = Peter + birth = 12.10.1972 + + +Now we read it in and process it: + + my $conf = Config::General::Extended->new("configfile"); + my $person = $conf->obj("person"); + print $person->prename . " " . $person->name . " is " . $person->age . " years old\n"; + +This notation supports only scalar values! You need to make sure, that the block + does not contain any subblock or multiple identical options(which will become +an array after parsing)! + +If you access a non-existent key this way, Config::General will croak an error. +You can turn this behavior off by setting B<-StrictObjects> to 0 or "no". In +this case undef will be returned. + +Of course you can use this kind of methods for writing data too: + + $person->name("Neustein"); + +This changes the value of the "name" key to "Neustein". This feature behaves exactly like +B, which means you can assign hash or array references as well and that existing +values under the given key will be overwritten. + + +=head1 COPYRIGHT + +Copyright (c) 2000-2022 Thomas Linden + +This library is free software; you can redistribute it and/or +modify it under the terms of the Artistic License 2.0. + + +=head1 BUGS + +none known yet. + + +=head1 AUTHOR + +Thomas Linden + +=head1 VERSION + +2.07 + +=cut + diff --git a/General/Interpolated.pm b/General/Interpolated.pm new file mode 100644 index 0000000..acc4740 --- /dev/null +++ b/General/Interpolated.pm @@ -0,0 +1,370 @@ +# +# Config::General::Interpolated - special Class based on Config::General +# +# Copyright (c) 2001 by Wei-Hon Chen . +# Copyright (c) 2000-2022 by Thomas Linden . +# All Rights Reserved. Std. disclaimer applies. +# Licensed under the terms of the Artistic License 2.0. +# + +package Config::General::Interpolated; +$Config::General::Interpolated::VERSION = "2.16"; + +use strict; +use Carp; +use Config::General; +use Exporter (); + + +# Import stuff from Config::General +use vars qw(@ISA @EXPORT); +@ISA = qw(Config::General Exporter); + + +sub new { + # + # overwrite new() with our own version + # and call the parent class new() + # + + croak "Deprecated method Config::General::Interpolated::new() called.\n" + ."Use Config::General::new() instead and set the -InterPolateVars flag.\n"; +} + + + +sub _set_regex { + # + # set the regex for finding vars + # + + # the following regex is provided by Autrijus Tang + # , and I made some modifications. + # thanx, autrijus. :) + my $regex = qr{ + (^|\G|[^\\]) # $1: can be the beginning of the line + # or the beginning of next match + # but can't begin with a '\' + \$ # dollar sign + (\{)? # $2: optional opening curly + ([a-zA-Z0-9][a-zA-Z0-9_\-\.:\+]*) # $3: capturing variable name (fix of #33447+118746) + (?(2) # $4: if there's the opening curly... + \} # ... match closing curly + ) + }x; + return $regex; +} + + +sub _interpolate { + # + # interpolate a scalar value and keep the result + # on the varstack. + # + # called directly by Config::General::_parse_value() + # + my ($this, $config, $key, $value) = @_; + my $quote_counter = 100; + + # some dirty trick to circumvent single quoted vars to be interpolated + # we remove all quotes and replace them with unique random literals, + # which will be replaced after interpolation with the original quotes + # fixes bug rt#35766 + my %quotes; + + if(! $this->{AllowSingleQuoteInterpolation} ) { + $value =~ s/(\'[^\']+?\')/ + my $key = "QUOTE" . ($quote_counter++) . "QUOTE"; + $quotes{ $key } = $1; + $key; + /gex; + } + + $value =~ s{$this->{regex}}{ + my $con = $1; + my $var = $3; + my $var_lc = $this->{LowerCaseNames} ? lc($var) : $var; + + if (exists $config->{__stack}->{$var_lc}) { + $con . $config->{__stack}->{$var_lc}; + } + elsif ($this->{InterPolateEnv}) { + # may lead to vulnerabilities, by default flag turned off + if (defined($ENV{$var})) { + $con . $ENV{$var}; + } + else { + $con; + } + } + elsif ($this->{StrictVars}) { + croak "Use of uninitialized variable (\$$var) while loading config entry: $key = $value\n"; + } + else { + # be cool + $con; + } + }egx; + + # re-insert unaltered quotes + # fixes bug rt#35766 + foreach my $quote (keys %quotes) { + $value =~ s/$quote/$quotes{$quote}/; + } + + return $value; +}; + + +sub _interpolate_hash { + # + # interpolate a complete hash and keep the results + # on the varstack. + # + # called directly by Config::General::new() + # + my ($this, $config) = @_; + + # bugfix rt.cpan.org#46184, moved code from _interpolate() to here. + if ($this->{InterPolateEnv}) { + # may lead to vulnerabilities, by default flag turned off + for my $key (keys %ENV){ + $config->{__stack}->{$key}=$ENV{$key}; + } + } + + $config = $this->_var_hash_stacker($config); + + return $config; +} + +sub _var_hash_stacker { + # + # build a varstack of a given hash ref + # + my ($this, $config) = @_; + + foreach my $key (keys %{$config}) { + next if($key eq "__stack"); + if (ref($config->{$key}) eq "ARRAY" ) { + $config->{$key} = $this->_var_array_stacker($config->{$key}, $key); + } + elsif (ref($config->{$key}) eq "HASH") { + my $tmphash = $config->{$key}; + $tmphash->{__stack} = $config->{__stack}; + $config->{$key} = $this->_var_hash_stacker($tmphash); + } + else { + # SCALAR + $config->{__stack}->{$key} = $config->{$key}; + } + } + + return $config; +} + + +sub _var_array_stacker { + # + # same as _var_hash_stacker but for arrayrefs + # + my ($this, $config, $key) = @_; + + my @new; + + foreach my $entry (@{$config}) { + if (ref($entry) eq "HASH") { + $entry = $this->_var_hash_stacker($entry); + } + elsif (ref($entry) eq "ARRAY") { + # ignore this. Arrays of Arrays cannot be created/supported + # with Config::General, because they are not accessible by + # any key (anonymous array-ref) + next; + } + else { + #### $config->{__stack}->{$key} = $config->{$key}; + # removed. a array of scalars (eg: option = [1,2,3]) cannot + # be used for interpolation (which one shall we use?!), so + # we ignore those types of lists. + # found by fbicknel, fixes rt.cpan.org#41570 + } + push @new, $entry; + } + + return \@new; +} + +sub _clean_stack { + # + # recursively empty the variable stack + # + my ($this, $config) = @_; + #return $config; # DEBUG + foreach my $key (keys %{$config}) { + if ($key eq "__stack") { + delete $config->{__stack}; + next; + } + if (ref($config->{$key}) eq "ARRAY" ) { + $config->{$key} = $this->_clean_array_stack($config->{$key}); + } + elsif (ref($config->{$key}) eq "HASH") { + $config->{$key} = $this->_clean_stack($config->{$key}); + } + } + return $config; +} + + +sub _clean_array_stack { + # + # same as _var_hash_stacker but for arrayrefs + # + my ($this, $config) = @_; + + my @new; + + foreach my $entry (@{$config}) { + if (ref($entry) eq "HASH") { + $entry = $this->_clean_stack($entry); + } + elsif (ref($entry) eq "ARRAY") { + # ignore this. Arrays of Arrays cannot be created/supported + # with Config::General, because they are not accessible by + # any key (anonymous array-ref) + next; + } + push @new, $entry; + } + + return \@new; +} + +1; + +__END__ + + +=head1 NAME + +Config::General::Interpolated - Parse variables within Config files + + +=head1 SYNOPSIS + + use Config::General; + $conf = Config::General->new( + -ConfigFile => 'configfile', + -InterPolateVars => 1 + ); + +=head1 DESCRIPTION + +This is an internal module which makes it possible to interpolate +Perl style variables in your config file (i.e. C<$variable> +or C<${variable}>). + +Normally you don't call it directly. + + +=head1 VARIABLES + +Variables can be defined everywhere in the config and can be used +afterwards as the value of an option. Variables cannot be used as +keys or as part of keys. + +If you define a variable inside +a block or a named block then it is only visible within this block or +within blocks which are defined inside this block. Well - let's take a +look to an example: + + # sample config which uses variables + basedir = /opt/ora + user = t_space + sys = unix + + instance = INTERN + owner = $user # "t_space" + logdir = $basedir/log # "/opt/ora/log" + sys = macos + + misc1 = ${sys}_${instance} # macos_INTERN + misc2 = $user # "t_space" + +
+ +This will result in the following structure: + + { + 'basedir' => '/opt/ora', + 'user' => 't_space' + 'sys' => 'unix', + 'table' => { + 'intern' => { + 'sys' => 'macos', + 'logdir' => '/opt/ora/log', + 'instance' => 'INTERN', + 'owner' => 't_space', + 'procs' => { + 'misc1' => 'macos_INTERN', + 'misc2' => 't_space' + } + } + } + +As you can see, the variable B has been defined twice. Inside +the block a variable ${sys} has been used, which then were +interpolated into the value of B defined inside the +block, not the sys variable one level above. If sys were not defined +inside the
block then the "global" variable B would have +been used instead with the value of "unix". + +Variables inside double quotes will be interpolated, but variables +inside single quotes will B interpolated. This is the same +behavior as you know of Perl itself. + +In addition you can surround variable names with curly braces to +avoid misinterpretation by the parser. + +=head1 NAMING CONVENTIONS + +Variable names must: + +=over + +=item * start with a US-ASCII letter(a-z or A-Z) or a digit (0-9). + +=item * contain only US-ASCII letter(a-z or A-Z), digits (0-9), the dash (-) + colon (:), dot (.), underscore (_) and plus (+) characters. + +=back + +For added clarity variable names can be surrounded by curly braces. + +=head1 SEE ALSO + +L + +=head1 AUTHORS + + Thomas Linden + Autrijus Tang + Wei-Hon Chen + +=head1 COPYRIGHT + +Copyright 2001 by Wei-Hon Chen Eplasmaball@pchome.com.twE. +Copyright 2002-2022 by Thomas Linden . + +This program is free software; you can redistribute it and/or +modify it under the terms of the Artistic License 2.0. + +See L + +=head1 VERSION + +2.16 + +=cut + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..299455f --- /dev/null +++ b/MANIFEST @@ -0,0 +1,57 @@ +Changelog +example.cfg +General/Extended.pm +General/Interpolated.pm +General.pm +Makefile.PL +MANIFEST +META.yml +README +t/apache-include.conf +t/apache-include-opt.conf +t/notincluded.conf.not +t/cfg.16 +t/cfg.16a +t/cfg.17 +t/cfg.19 +t/cfg.2 +t/cfg.20.a +t/cfg.20.b +t/cfg.20.c +t/cfg.3 +t/cfg.34 +t/cfg.39 +t/cfg.4 +t/cfg.40 +t/cfg.41 +t/cfg.42 +t/cfg.43 +t/cfg.45 +t/cfg.46 +t/cfg.5 +t/cfg.6 +t/cfg.7 +t/cfg.8 +t/cfg.55 +t/complex/n1.cfg +t/complex/n2.cfg +t/complex.cfg +t/dual-include.conf +t/included.conf +t/run.t +t/sub1/cfg.sub1 +t/sub1/cfg.sub1b +t/sub1/cfg.sub1c +t/sub1/cfg.sub1d +t/sub1/cfg.sub1e +t/sub1/sub2/cfg.sub2 +t/sub1/sub2/cfg.sub2b +t/sub1/sub2/sub3/cfg.sub3 +t/test.rc +t/Tie/IxHash.pm +t/Tie/README +t/cfg.51 +t/utf8_bom/bar.cfg +t/utf8_bom/foo.cfg +t/cfg.58 +META.json Module JSON meta-data (added by MakeMaker) diff --git a/META.json b/META.json new file mode 100644 index 0000000..f11d724 --- /dev/null +++ b/META.json @@ -0,0 +1,50 @@ +{ + "abstract" : "unknown", + "author" : [ + "unknown" + ], + "dynamic_config" : 1, + "generated_by" : "ExtUtils::MakeMaker version 7.44, CPAN::Meta::Converter version 2.150010", + "license" : [ + "artistic_2" + ], + "meta-spec" : { + "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", + "version" : 2 + }, + "name" : "Config-General", + "no_index" : { + "directory" : [ + "t", + "inc" + ] + }, + "prereqs" : { + "build" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + } + }, + "configure" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + } + }, + "runtime" : { + "requires" : { + "File::Glob" : "0", + "File::Spec::Functions" : "0", + "FileHandle" : "0", + "IO::File" : "0" + } + } + }, + "release_status" : "stable", + "resources" : { + "repository" : { + "url" : "https://github.com/TLINDEN/Config-General" + } + }, + "version" : "2.65", + "x_serialization_backend" : "JSON::PP version 4.04" +} diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..4a4e84c --- /dev/null +++ b/META.yml @@ -0,0 +1,28 @@ +--- +abstract: unknown +author: + - unknown +build_requires: + ExtUtils::MakeMaker: '0' +configure_requires: + ExtUtils::MakeMaker: '0' +dynamic_config: 1 +generated_by: 'ExtUtils::MakeMaker version 7.44, CPAN::Meta::Converter version 2.150010' +license: artistic_2 +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: '1.4' +name: Config-General +no_index: + directory: + - t + - inc +requires: + File::Glob: '0' + File::Spec::Functions: '0' + FileHandle: '0' + IO::File: '0' +resources: + repository: https://github.com/TLINDEN/Config-General +version: '2.65' +x_serialization_backend: 'CPAN::Meta::YAML version 0.018' diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..ee6251b --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,30 @@ +# +# Makefile.PL - build file for Config::General +# +# Copyright (c) 2000-2022 Thomas Linden . +# All Rights Reserved. Std. disclaimer applies. +# Licensed under the Artistic License 2.0. +# + +use ExtUtils::MakeMaker; + +WriteMakefile( + 'NAME' => 'Config::General', + 'VERSION_FROM' => 'General.pm', + 'clean' => { + FILES => 't/*.out t/test.cfg *~ */*~' + }, + 'PREREQ_PM' => { + 'IO::File' => 0, + 'FileHandle' => 0, + 'File::Spec::Functions' => 0, + 'File::Glob' => 0 + }, + 'META_MERGE' => { + resources => { + repository => 'https://github.com/TLINDEN/Config-General' + }, + }, + ($ExtUtils::MakeMaker::VERSION ge '6.31'? + ('LICENSE' => 'artistic_2', ) : ()), + ); diff --git a/README b/README new file mode 100644 index 0000000..0931c9c --- /dev/null +++ b/README @@ -0,0 +1,107 @@ +NAME + Config::General - Generic Config Module + +SYNOPSIS + use Config::General; + $conf = new Config::General(-ConfigFile => "myconfig.rc"); + my %config = $conf->getall; + + +DESCRIPTION + This module opens a config file and parses it's contents + for you. After parsing the module returns a hash structure + which contains the representation of the config file. + + The format of config files supported by Config::General is + inspired by the well known apache config format, in fact, + this module is 100% read-compatible to apache configs, but + you can also just use simple name/value pairs in your config + files. + + In addition to the capabilities of a apache config file + it supports some enhancements such as here-documents, C- + style comments or multiline options. It is also possible to + save the config back to disk, which makes the module a + perfect backend for configuration interfaces. + + It is possible to use variables in config files and there + exists also support for object oriented access to the + configuration. + + +INSTALLATION + + to install, type: + perl Makefile.PL + make + make test + make install + + to read the complete documentation, type: + perldoc Config::General + perldoc Config::General::Extended + perldoc Config::General::Interpolated + + see some example config files which can + be parsed with Config::Genreal in the subdirectory + t/cfg.* + + +UPDATE + + If you are updating from version 1.xx, you might be interested, + that some things in the API has changed, which might force you + to change your application code. These changes were necessary + to clean up the module interface. Now it has a consistent + "look and feel" and behaves more naturally. Therefore historic + remains were removed. + + Here is a short list: + + o it is no more possible to use Config::General::Extended + and Config::General::Interpolated directly. Instead use + Config::General and turn on -InterPolateVars and + -ExtendedAccess respectively. + + o the method NoMultiOptions() is deprecated. Set the parameter + -AllowMultiOptions to false when calling new() to create + a new Config::General object. + + o the method save() is deprecated. Use save_file() or + save_string() instead. + + o the parameter -file is deprecated. Use -ConfigFile instead. + + o the parameter -hash is deprecated. Use -ConfigHash instead. + + For a more detailed explanation of changes refer to the Changelog. + + +COPYRIGHT + Config::General + Config::General::Extended + Copyright (c) 2000-2022 by Thomas Linden + + Config::General::Interpolated + Copyright (c) 2001 by Wei-Hon Chen + Copyright (c) 2002-2022 by Thomas Linden . + + This library is free software; you can redistribute it + and/or modify it under the terms of the Artistic 2.0 license. + +HOMEPAGE + + The homepage of Config::General is located at: + + http://www.daemon.de/config-general/ + +BUGS + make test does currently not catch all possible scenarios. + + +AUTHOR + Thomas Linden + + +VERSION + 2.65 diff --git a/example.cfg b/example.cfg new file mode 100644 index 0000000..dd0cea3 --- /dev/null +++ b/example.cfg @@ -0,0 +1,74 @@ +# -*-sh-*- (ignore, this is just for my operation system, emacs, +# to function properly) +# +# This is an example of a config file supported by Config::General. +# It shows almost all features of the format and its flexibility. +# +# To try it, install Config::General as usual and execute the +# following perlscript: +# +# use Config::General; +# use Data::Dumper; +# my %conf = ParseConfig(-ConfigFile => "example.cfg", -InterPolateVars => 1); +# print Dumper(\%C);' +# +# This will parse the config and print out a stringified version +# of the hash it produces, which can be used in your program. +# + + +/* + * c-style comment + */ + +# variable assignment +option1 = blah +option2 blubber +option3 = "something special" # this is a comment + +option4 = parameters can be written on \ + multiple lines + +# duplicate options will be made into an array +huc = 12 +huc = 17 +huc = 133 + +# options can be organized in blocks too + + user = hans + server = mc200 + db = maxis + passwd = D3rf8d + + # nested blocks are no problem + + index int(100000) + name char(100) + prename char(100) + status int(10) + + + +# named blocks can also be used + + # block names containing whitespaces must be quoted + <"kyla cole"> + # blocks maybe empty + + + +# here-docs are fully supported +usage <[0] = {}; # hashkey index + $s->[1] = []; # array of keys + $s->[2] = []; # array of data + $s->[3] = 0; # iter count + + bless $s, $c; + + $s->Push(@_) if @_; + + return $s; +} + +#sub DESTROY {} # costly if there's nothing to do + +sub FETCH { + my($s, $k) = (shift, shift); + return exists( $s->[0]{$k} ) ? $s->[2][ $s->[0]{$k} ] : undef; +} + +sub STORE { + my($s, $k, $v) = (shift, shift, shift); + + if (exists $s->[0]{$k}) { + my($i) = $s->[0]{$k}; + $s->[1][$i] = $k; + $s->[2][$i] = $v; + $s->[0]{$k} = $i; + } + else { + push(@{$s->[1]}, $k); + push(@{$s->[2]}, $v); + $s->[0]{$k} = $#{$s->[1]}; + } +} + +sub DELETE { + my($s, $k) = (shift, shift); + + if (exists $s->[0]{$k}) { + my($i) = $s->[0]{$k}; + for ($i+1..$#{$s->[1]}) { # reset higher elt indexes + $s->[0]{$s->[1][$_]}--; # timeconsuming, is there is better way? + } + delete $s->[0]{$k}; + splice @{$s->[1]}, $i, 1; + return (splice(@{$s->[2]}, $i, 1))[0]; + } + return undef; +} + +sub EXISTS { + exists $_[0]->[0]{ $_[1] }; +} + +sub FIRSTKEY { + $_[0][3] = 0; + &NEXTKEY; +} + +sub NEXTKEY { + return $_[0][1][$_[0][3]++] if ($_[0][3] <= $#{$_[0][1]}); + return undef; +} + + + +# +# +# class functions that provide additional capabilities +# +# + +sub new { TIEHASH(@_) } + +# +# add pairs to end of indexed hash +# note that if a supplied key exists, it will not be reordered +# +sub Push { + my($s) = shift; + while (@_) { + $s->STORE(shift, shift); + } + return scalar(@{$s->[1]}); +} + +sub Push2 { + my($s) = shift; + $s->Splice($#{$s->[1]}+1, 0, @_); + return scalar(@{$s->[1]}); +} + +# +# pop last k-v pair +# +sub Pop { + my($s) = shift; + my($k, $v, $i); + $k = pop(@{$s->[1]}); + $v = pop(@{$s->[2]}); + if (defined $k) { + delete $s->[0]{$k}; + return ($k, $v); + } + return undef; +} + +sub Pop2 { + return $_[0]->Splice(-1); +} + +# +# shift +# +sub Shift { + my($s) = shift; + my($k, $v, $i); + $k = shift(@{$s->[1]}); + $v = shift(@{$s->[2]}); + if (defined $k) { + delete $s->[0]{$k}; + for (keys %{$s->[0]}) { + $s->[0]{$_}--; + } + return ($k, $v); + } + return undef; +} + +sub Shift2 { + return $_[0]->Splice(0, 1); +} + +# +# unshift +# if a supplied key exists, it will not be reordered +# +sub Unshift { + my($s) = shift; + my($k, $v, @k, @v, $len, $i); + + while (@_) { + ($k, $v) = (shift, shift); + if (exists $s->[0]{$k}) { + $i = $s->[0]{$k}; + $s->[1][$i] = $k; + $s->[2][$i] = $v; + $s->[0]{$k} = $i; + } + else { + push(@k, $k); + push(@v, $v); + $len++; + } + } + if (defined $len) { + for (keys %{$s->[0]}) { + $s->[0]{$_} += $len; + } + $i = 0; + for (@k) { + $s->[0]{$_} = $i++; + } + unshift(@{$s->[1]}, @k); + return unshift(@{$s->[2]}, @v); + } + return scalar(@{$s->[1]}); +} + +sub Unshift2 { + my($s) = shift; + $s->Splice(0,0,@_); + return scalar(@{$s->[1]}); +} + +# +# splice +# +# any existing hash key order is preserved. the value is replaced for +# such keys, and the new keys are spliced in the regular fashion. +# +# supports -ve offsets but only +ve lengths +# +# always assumes a 0 start offset +# +sub Splice { + my($s, $start, $len) = (shift, shift, shift); + my($k, $v, @k, @v, @r, $i, $siz); + my($end); # inclusive + + # XXX inline this + ($start, $end, $len) = $s->_lrange($start, $len); + + if (defined $start) { + if ($len > 0) { + my(@k) = splice(@{$s->[1]}, $start, $len); + my(@v) = splice(@{$s->[2]}, $start, $len); + while (@k) { + $k = shift(@k); + delete $s->[0]{$k}; + push(@r, $k, shift(@v)); + } + for ($start..$#{$s->[1]}) { + $s->[0]{$s->[1][$_]} -= $len; + } + } + while (@_) { + ($k, $v) = (shift, shift); + if (exists $s->[0]{$k}) { + # $s->STORE($k, $v); + $i = $s->[0]{$k}; + $s->[1][$i] = $k; + $s->[2][$i] = $v; + $s->[0]{$k} = $i; + } + else { + push(@k, $k); + push(@v, $v); + $siz++; + } + } + if (defined $siz) { + for ($start..$#{$s->[1]}) { + $s->[0]{$s->[1][$_]} += $siz; + } + $i = $start; + for (@k) { + $s->[0]{$_} = $i++; + } + splice(@{$s->[1]}, $start, 0, @k); + splice(@{$s->[2]}, $start, 0, @v); + } + } + return @r; +} + +# +# delete elements specified by key +# other elements higher than the one deleted "slide" down +# +sub Delete { + my($s) = shift; + + for (@_) { + # + # XXX potential optimization: could do $s->DELETE only if $#_ < 4. + # otherwise, should reset all the hash indices in one loop + # + $s->DELETE($_); + } +} + +# +# replace hash element at specified index +# +# if the optional key is not supplied the value at index will simply be +# replaced without affecting the order. +# +# if an element with the supplied key already exists, it will be deleted first. +# +# returns the key of replaced value if it succeeds. +# +sub Replace { + my($s) = shift; + my($i, $v, $k) = (shift, shift, shift); + if (defined $i and $i <= $#{$s->[1]} and $i >= 0) { + if (defined $k) { + delete $s->[0]{ $s->[1][$i] }; + $s->DELETE($k) ; #if exists $s->[0]{$k}; + $s->[1][$i] = $k; + $s->[2][$i] = $v; + $s->[0]{$k} = $i; + return $k; + } + else { + $s->[2][$i] = $v; + return $s->[1][$i]; + } + } + return undef; +} + +# +# Given an $start and $len, returns a legal start and end (where start <= end) +# for the current hash. +# Legal range is defined as 0 to $#s+1 +# $len defaults to number of elts upto end of list +# +# 0 1 2 ... +# | X | X | X ... X | X | X | +# -2 -1 (no -0 alas) +# X's above are the elements +# +sub _lrange { + my($s) = shift; + my($offset, $len) = @_; + my($start, $end); # both inclusive + my($size) = $#{$s->[1]}+1; + + return undef unless defined $offset; + if($offset < 0) { + $start = $offset + $size; + $start = 0 if $start < 0; + } + else { + ($offset > $size) ? ($start = $size) : ($start = $offset); + } + + if (defined $len) { + $len = -$len if $len < 0; + $len = $size - $start if $len > $size - $start; + } + else { + $len = $size - $start; + } + $end = $start + $len - 1; + + return ($start, $end, $len); +} + +# +# Return keys at supplied indices +# Returns all keys if no args. +# +sub Keys { + my($s) = shift; + return ( @_ == 1 + ? $s->[1][$_[0]] + : ( @_ + ? @{$s->[1]}[@_] + : @{$s->[1]} ) ); +} + + +# Returns values at supplied indices +# Returns all values if no args. +# +sub Values { + my($s) = shift; + return ( @_ == 1 + ? $s->[2][$_[0]] + : ( @_ + ? @{$s->[2]}[@_] + : @{$s->[2]} ) ); +} + +# +# get indices of specified hash keys +# +sub Indices { + my($s) = shift; + return ( @_ == 1 ? $s->[0]{$_[0]} : @{$s->[0]}{@_} ); +} + +# +# number of k-v pairs in the ixhash +# note that this does not equal the highest index +# owing to preextended arrays +# +sub Length { + return scalar @{$_[0]->[1]}; +} + +# +# Reorder the hash in the supplied key order +# +# warning: any unsupplied keys will be lost from the hash +# any supplied keys that dont exist in the hash will be ignored +# +sub Reorder { + my($s) = shift; + my(@k, @v, %x, $i); + return unless @_; + + $i = 0; + for (@_) { + if (exists $s->[0]{$_}) { + push(@k, $_); + push(@v, $s->[2][ $s->[0]{$_} ] ); + $x{$_} = $i++; + } + } + $s->[1] = \@k; + $s->[2] = \@v; + $s->[0] = \%x; + return $s; +} + +sub SortByKey { + my($s) = shift; + $s->Reorder(sort $s->Keys); +} + +sub SortByValue { + my($s) = shift; + $s->Reorder(sort { $s->FETCH($a) cmp $s->FETCH($b) } $s->Keys) +} + +1; +__END__ + +=head1 NAME + +Tie::IxHash - ordered associative arrays for Perl + + +=head1 SYNOPSIS + + # simple usage + use Tie::IxHash; + tie HASHVARIABLE, Tie::IxHash [, LIST]; + + # OO interface with more powerful features + use Tie::IxHash; + TIEOBJECT = Tie::IxHash->new( [LIST] ); + TIEOBJECT->Splice( OFFSET [, LENGTH [, LIST]] ); + TIEOBJECT->Push( LIST ); + TIEOBJECT->Pop; + TIEOBJECT->Shift; + TIEOBJECT->Unshift( LIST ); + TIEOBJECT->Keys( [LIST] ); + TIEOBJECT->Values( [LIST] ); + TIEOBJECT->Indices( LIST ); + TIEOBJECT->Delete( [LIST] ); + TIEOBJECT->Replace( OFFSET, VALUE, [KEY] ); + TIEOBJECT->Reorder( LIST ); + TIEOBJECT->SortByKey; + TIEOBJECT->SortByValue; + TIEOBJECT->Length; + + +=head1 DESCRIPTION + +This Perl module implements Perl hashes that preserve the order in which the +hash elements were added. The order is not affected when values +corresponding to existing keys in the IxHash are changed. The elements can +also be set to any arbitrary supplied order. The familiar perl array +operations can also be performed on the IxHash. + + +=head2 Standard C Interface + +The standard C mechanism is available. This interface is +recommended for simple uses, since the usage is exactly the same as +regular Perl hashes after the C is declared. + + +=head2 Object Interface + +This module also provides an extended object-oriented interface that can be +used for more powerful operations with the IxHash. The following methods +are available: + +=over 8 + +=item FETCH, STORE, DELETE, EXISTS + +These standard C methods mandated by Perl can be used directly. +See the C entry in perlfunc(1) for details. + +=item Push, Pop, Shift, Unshift, Splice + +These additional methods resembling Perl functions are available for +operating on key-value pairs in the IxHash. The behavior is the same as the +corresponding perl functions, except when a supplied hash key already exists +in the hash. In that case, the existing value is updated but its order is +not affected. To unconditionally alter the order of a supplied key-value +pair, first C the IxHash element. + +=item Keys + +Returns an array of IxHash element keys corresponding to the list of supplied +indices. Returns an array of all the keys if called without arguments. +Note the return value is mostly only useful when used in a list context +(since perl will convert it to the number of elements in the array when +used in a scalar context, and that may not be very useful). + +If a single argument is given, returns the single key corresponding to +the index. This is usable in either scalar or list context. + +=item Values + +Returns an array of IxHash element values corresponding to the list of supplied +indices. Returns an array of all the values if called without arguments. +Note the return value is mostly only useful when used in a list context +(since perl will convert it to the number of elements in the array when +used in a scalar context, and that may not be very useful). + +If a single argument is given, returns the single value corresponding to +the index. This is usable in either scalar or list context. + +=item Indices + +Returns an array of indices corresponding to the supplied list of keys. +Note the return value is mostly only useful when used in a list context +(since perl will convert it to the number of elements in the array when +used in a scalar context, and that may not be very useful). + +If a single argument is given, returns the single index corresponding to +the key. This is usable in either scalar or list context. + +=item Delete + +Removes elements with the supplied keys from the IxHash. + +=item Replace + +Substitutes the IxHash element at the specified index with the supplied +value-key pair. If a key is not supplied, simply substitutes the value at +index with the supplied value. If an element with the supplied key already +exists, it will be removed from the IxHash first. + +=item Reorder + +This method can be used to manipulate the internal order of the IxHash +elements by supplying a list of keys in the desired order. Note however, +that any IxHash elements whose keys are not in the list will be removed from +the IxHash. + +=item Length + +Returns the number of IxHash elements. + +=item SortByKey + +Reorders the IxHash elements by textual comparison of the keys. + +=item SortByValue + +Reorders the IxHash elements by textual comparison of the values. + +=back + + +=head1 EXAMPLE + + use Tie::IxHash; + + # simple interface + $t = tie(%myhash, Tie::IxHash, 'a' => 1, 'b' => 2); + %myhash = (first => 1, second => 2, third => 3); + $myhash{fourth} = 4; + @keys = keys %myhash; + @values = values %myhash; + print("y") if exists $myhash{third}; + + # OO interface + $t = Tie::IxHash->new(first => 1, second => 2, third => 3); + $t->Push(fourth => 4); # same as $myhash{'fourth'} = 4; + ($k, $v) = $t->Pop; # $k is 'fourth', $v is 4 + $t->Unshift(neg => -1, zeroth => 0); + ($k, $v) = $t->Shift; # $k is 'neg', $v is -1 + @oneandtwo = $t->Splice(1, 2, foo => 100, bar => 101); + + @keys = $t->Keys; + @values = $t->Values; + @indices = $t->Indices('foo', 'zeroth'); + @itemkeys = $t->Keys(@indices); + @itemvals = $t->Values(@indices); + $t->Replace(2, 0.3, 'other'); + $t->Delete('second', 'zeroth'); + $len = $t->Length; # number of key-value pairs + + $t->Reorder(reverse @keys); + $t->SortByKey; + $t->SortByValue; + + +=head1 BUGS + +You cannot specify a negative length to C. Negative indexes are OK, +though. + +Indexing always begins at 0 (despite the current C<$[> setting) for +all the functions. + + +=head1 TODO + +Addition of elements with keys that already exist to the end of the IxHash +must be controlled by a switch. + +Provide C interface when it stabilizes in Perl. + +Rewrite using XSUBs for efficiency. + + +=head1 AUTHOR + +Gurusamy Sarathy gsar@umich.edu + +Copyright (c) 1995 Gurusamy Sarathy. All rights reserved. +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + + +=head1 VERSION + +Version 1.21 20 Nov 1997 + + +=head1 SEE ALSO + +perl(1) + +=cut diff --git a/t/Tie/README b/t/Tie/README new file mode 100644 index 0000000..6567ff7 --- /dev/null +++ b/t/Tie/README @@ -0,0 +1,7 @@ +This module exists here just to satisfy 'make test' +because it tests the -tie functionality. It is NOT +part of Config::General itself, which doesn't depend +on it. + + +Tom diff --git a/t/apache-include-opt.conf b/t/apache-include-opt.conf new file mode 100644 index 0000000..2cc4000 --- /dev/null +++ b/t/apache-include-opt.conf @@ -0,0 +1,7 @@ + + IncludeOptional t/included.conf + + + nink ack + IncludeOptional t/notincluded.conf + diff --git a/t/apache-include.conf b/t/apache-include.conf new file mode 100644 index 0000000..069e5b7 --- /dev/null +++ b/t/apache-include.conf @@ -0,0 +1,6 @@ + + include t/included.conf + + + include "t/included.conf" + diff --git a/t/cfg.16 b/t/cfg.16 new file mode 100644 index 0000000..50ef74d --- /dev/null +++ b/t/cfg.16 @@ -0,0 +1,32 @@ +# variable interpolation test +me=blah +pr=$me/blubber + + base = /usr + uid = 501 + + +base = /opt + + base = /usr # set $base to a new value in this scope + log = ${base}/log/logfile # use braces + + home = $base/home/max # $base should be /usr, not /opt ! + + + +# block(name) test +tag = dir +mono = teri +<$tag> + bl = 1 + +<$tag mono> + bl = 2 + + + bl = 3 + +<$tag $mono> + bl = 3 + diff --git a/t/cfg.16a b/t/cfg.16a new file mode 100644 index 0000000..28e12f2 --- /dev/null +++ b/t/cfg.16a @@ -0,0 +1,3 @@ + + log = ${HOME}/log/logfile # use braces + diff --git a/t/cfg.17 b/t/cfg.17 new file mode 100644 index 0000000..59f3df0 --- /dev/null +++ b/t/cfg.17 @@ -0,0 +1,4 @@ +home = /home/users + +quux = $bar + diff --git a/t/cfg.19 b/t/cfg.19 new file mode 100644 index 0000000..5b0d899 --- /dev/null +++ b/t/cfg.19 @@ -0,0 +1,16 @@ +# +# these options must all in +# msg[\d] keys. +# +msg1 = "Das ist ein Test" +msg2 = "Das = ein Test" +msg3 "Das ist ein Test" +msg4 "Das = ein Test" + +msg6 = < + + name stein + age 25 + color \#000000 + + + name bird + age 31 + color \#ffffff + + diff --git a/t/cfg.20.a b/t/cfg.20.a new file mode 100644 index 0000000..550afc1 --- /dev/null +++ b/t/cfg.20.a @@ -0,0 +1,2 @@ +seen_cfg.20.a = true +<> diff --git a/t/cfg.20.b b/t/cfg.20.b new file mode 100644 index 0000000..53af75b --- /dev/null +++ b/t/cfg.20.b @@ -0,0 +1,2 @@ +seen_cfg.20.b = true +<> diff --git a/t/cfg.20.c b/t/cfg.20.c new file mode 100644 index 0000000..ba9e0fd --- /dev/null +++ b/t/cfg.20.c @@ -0,0 +1,2 @@ +seen_cfg.20.c = true +last = cfg.20.c diff --git a/t/cfg.3 b/t/cfg.3 new file mode 100644 index 0000000..6946a1a --- /dev/null +++ b/t/cfg.3 @@ -0,0 +1,4 @@ +# Array content test +domain b0fh.org +domain l0pht.com +domain infonexus.com \ No newline at end of file diff --git a/t/cfg.34 b/t/cfg.34 new file mode 100644 index 0000000..2975171 --- /dev/null +++ b/t/cfg.34 @@ -0,0 +1,18 @@ + + var1 = yes + var2 = on + var3 = true + var4 = no + var5 = off + var6 = false + + + + var1 = Yes + var2 = On + var3 = TRUE + var4 = nO + var5 = oFf + var6 = False + + diff --git a/t/cfg.39 b/t/cfg.39 new file mode 100644 index 0000000..eff9f54 --- /dev/null +++ b/t/cfg.39 @@ -0,0 +1,13 @@ + + test = foo + + ivar = $test + + + + + test = bar + + ivar = $test + + diff --git a/t/cfg.4 b/t/cfg.4 new file mode 100644 index 0000000..4d3ce00 --- /dev/null +++ b/t/cfg.4 @@ -0,0 +1,6 @@ +# Here-document test + +header = < +
+EOF \ No newline at end of file diff --git a/t/cfg.40 b/t/cfg.40 new file mode 100644 index 0000000..6dabe61 --- /dev/null +++ b/t/cfg.40 @@ -0,0 +1,7 @@ +# should generate an error about invalid structure +# array of scalars => hashref +val = 1 +val = 2 + + x = no + \ No newline at end of file diff --git a/t/cfg.41 b/t/cfg.41 new file mode 100644 index 0000000..1c8eed6 --- /dev/null +++ b/t/cfg.41 @@ -0,0 +1,6 @@ +# should generate an error about invalid structure +# scalar => hashref +val = 1 + + x = no + diff --git a/t/cfg.42 b/t/cfg.42 new file mode 100644 index 0000000..9014667 --- /dev/null +++ b/t/cfg.42 @@ -0,0 +1,13 @@ +# should generate an error about invalid structure +# array of hashrefs => scalar + + + x = no + + +val = 3 + + + x = no + + diff --git a/t/cfg.43 b/t/cfg.43 new file mode 100644 index 0000000..a6c4941 --- /dev/null +++ b/t/cfg.43 @@ -0,0 +1,5 @@ +# should generate an error about invalid structure +val = 1 + + x = 2 + diff --git a/t/cfg.45 b/t/cfg.45 new file mode 100644 index 0000000..5794ffc --- /dev/null +++ b/t/cfg.45 @@ -0,0 +1,14 @@ +param1 = value1 +param2 = value2 + + + param2 = value3 + param4 = $param1 # expect: "value1" + param5 = $param2 # expect: "value3" + + + + param6 = $param1 # expect: "value1" + param7 = $param2 # expect: "value2" + + diff --git a/t/cfg.46 b/t/cfg.46 new file mode 100644 index 0000000..e93750f --- /dev/null +++ b/t/cfg.46 @@ -0,0 +1,3 @@ +foo = bar +blah = blubber +test = $foo 'variable $blah should be kept' and '$foo too' diff --git a/t/cfg.5 b/t/cfg.5 new file mode 100644 index 0000000..b2acc6b --- /dev/null +++ b/t/cfg.5 @@ -0,0 +1,5 @@ +# Multiline option test +command = ssh -f -g orpheus.0x49.org \ + -l azrael -L:34777samir.okir.da.ru:22 \ + -L:31773:shane.sol1.rocket.de:22 \ + 'exec sleep 99999990' diff --git a/t/cfg.51 b/t/cfg.51 new file mode 100644 index 0000000..16462e2 --- /dev/null +++ b/t/cfg.51 @@ -0,0 +1,5 @@ +dollar = \$foo +backslash = contains \\ backslash +prize = 18 $ +hostparam = "\"'wsh.dir'\"" +bgcolor = \#fff diff --git a/t/cfg.55 b/t/cfg.55 new file mode 100644 index 0000000..dab0a52 --- /dev/null +++ b/t/cfg.55 @@ -0,0 +1,5 @@ +a = 1 + +b = nochop\ + +c = should stay alone diff --git a/t/cfg.58 b/t/cfg.58 new file mode 100644 index 0000000..709a180 --- /dev/null +++ b/t/cfg.58 @@ -0,0 +1,3 @@ + + level debug + diff --git a/t/cfg.6 b/t/cfg.6 new file mode 100644 index 0000000..4de8710 --- /dev/null +++ b/t/cfg.6 @@ -0,0 +1,13 @@ +# Comment test +user = tom # a comment right after a line +/* + * C-style comment (multiline) + */ +passwd = sakkra + +/* oneline C-style comment */ +host = blah.blubber + + # +bar = baz + \ No newline at end of file diff --git a/t/cfg.7 b/t/cfg.7 new file mode 100644 index 0000000..ef23a32 --- /dev/null +++ b/t/cfg.7 @@ -0,0 +1,8 @@ +# Case insensitive block test + + + + name stein + age 25 + + diff --git a/t/cfg.8 b/t/cfg.8 new file mode 100644 index 0000000..ca9b600 --- /dev/null +++ b/t/cfg.8 @@ -0,0 +1,45 @@ + + + name stein + age 25 + + + name bird + age 31 + + +domain nix.to +domain b0fh.org +domain foo.bar +message < +host = blah.blubber + + + + user1 hans + + + + user2 max + + +quoted = "this one contains whitespace at the end " + +quotedwithquotes = " holy crap, it contains \"masked quotes\" and 'single quotes' " + + diff --git a/t/complex.cfg b/t/complex.cfg new file mode 100644 index 0000000..c52517e --- /dev/null +++ b/t/complex.cfg @@ -0,0 +1,28 @@ +# complexity test +var1 = zero # comment +var2 = zeppelin /* another comment */ +/* +to be ignored +*/ +line = a\ + long line +var3 = blah +set = $var3 +ignore = \$set +quote = this should be 'kept: $set' and not be '$set!' +host = gw.intx.foo +cmd = mart@${host}:22 +onflag = yes +offflag = No +<> +a [[weird]] heredoc = < + <> + diff --git a/t/complex/n1.cfg b/t/complex/n1.cfg new file mode 100644 index 0000000..70b195d --- /dev/null +++ b/t/complex/n1.cfg @@ -0,0 +1,16 @@ + + + x = 9323 + z = 000 + + g = $z + long = another long \ + line + + /* + please ignore this */ + + + z = rewe + + diff --git a/t/complex/n2.cfg b/t/complex/n2.cfg new file mode 100644 index 0000000..6bd9f9f --- /dev/null +++ b/t/complex/n2.cfg @@ -0,0 +1,17 @@ + + mode = 755 + + + Options = +Indexes + +nando = 11111 + + blak = $nando + nando = 9999 + + + klack = $nando + + + value = 0 + diff --git a/t/dual-include.conf b/t/dual-include.conf new file mode 100644 index 0000000..a608b7a --- /dev/null +++ b/t/dual-include.conf @@ -0,0 +1,6 @@ + + <> + + + <> + diff --git a/t/included.conf b/t/included.conf new file mode 100644 index 0000000..23e6b6c --- /dev/null +++ b/t/included.conf @@ -0,0 +1 @@ +honk=bonk diff --git a/t/notincluded.conf.not b/t/notincluded.conf.not new file mode 100644 index 0000000..40ea569 --- /dev/null +++ b/t/notincluded.conf.not @@ -0,0 +1 @@ +honk=NONONO diff --git a/t/run.t b/t/run.t new file mode 100644 index 0000000..4dbf233 --- /dev/null +++ b/t/run.t @@ -0,0 +1,793 @@ +# -*-perl-*- +# testscript for Config::General Classes by Thomas Linden +# +# needs to be invoked using the command "make test" from +# the Config::General source directory. +# +# Under normal circumstances every test should succeed. + + +use Data::Dumper; +use Test::More tests => 78; +#use Test::More qw(no_plan); + +# ahem, we deliver the test code with a local copy of +# the Tie::IxHash module so we can do tests on sorted +# hashes without dependency to Tie::IxHash. +use lib qw(t); +use Tie::IxHash; +my @WARNINGS_FOUND; +BEGIN { + $SIG{__WARN__} = sub { diag( "WARN: ", join( '', @_ ) ); push @WARNINGS_FOUND, @_ }; +} + +### 1 +BEGIN { use_ok "Config::General"}; +require_ok( 'Config::General' ); + +### 2 - 7 +foreach my $num (2..7) { + my $cfg = "t/cfg.$num"; + open T, "<$cfg"; + my @file = ; + close T; + my $fst = $file[0]; + chomp $fst; + $fst =~ s/\#\s*//g; + eval { + my $conf = new Config::General($cfg); + my %hash = $conf->getall; + }; + ok(!$@, "$fst"); +} + +### 8 +my $conf = new Config::General("t/cfg.8"); +my %hash = $conf->getall; +$conf->save_file("t/cfg.out"); +my $copy = new Config::General("t/cfg.out"); +my %copyhash = $copy->getall; +is_deeply(\%hash, \%copyhash, "Writing Config Hash to disk and compare with original"); + +# 8a +like($copyhash{nocomment}, qr/this should appear/, "C-comments not processed in here-doc"); + +### 9 +$conf = new Config::General( + -ExtendedAccess => 1, + -ConfigFile => "t/test.rc"); +ok($conf, "Creating a new object from config file"); + + +### 10 +my $conf2 = new Config::General( + -ExtendedAccess => 1, + -ConfigFile => "t/test.rc", + -AllowMultiOptions => "yes" +); +ok($conf2, "Creating a new object using the hash parameter way"); + + +### 11 +my $domain = $conf->obj("domain"); +ok($domain, "Creating a new object from a block"); + + +### 12 +my $addr = $domain->obj("bar.de"); +ok($addr, "Creating a new object from a sub block"); + + +### 13 +my @keys = $conf->keys("domain"); +ok($#keys > -1, "Getting values from the object"); + + +### 14 +# test various OO methods +my $a; +if ($conf->is_hash("domain")) { + my $domains = $conf->obj("domain"); + foreach my $domain ($conf->keys("domain")) { + my $domain_obj = $domains->obj($domain); + foreach my $address ($domains->keys($domain)) { + $a = $domain_obj->value($address); + } + } +} +ok($a, "Using keys() and values()"); + +### 15 +# test AUTOLOAD methods +eval { + my $conf3 = new Config::General( + -ExtendedAccess => 1, + -ConfigHash => { name => "Moser", prename => "Hannes"} + ); + my $n = $conf3->name; + my $p = $conf3->prename; + $conf3->name("Meier"); + $conf3->prename("Max"); + $conf3->save_file("t/test.cfg"); +}; +ok (!$@, "Using AUTOLOAD methods"); + + +### 16 +# testing variable interpolation +my $conf16 = new Config::General(-ConfigFile => "t/cfg.16", -InterPolateVars => 1, -StrictVars => 0); +my %h16 = $conf16->getall(); +if($h16{etc}->{log} eq "/usr/log/logfile" and + $h16{etc}->{users}->{home} eq "/usr/home/max" and + exists $h16{dir}->{teri}->{bl}) { + pass("Testing variable interpolation"); +} +else { + fail("Testing variable interpolation"); +} + +### 16.a +# testing variable interpolation with %ENV use +my $env = "/home/theunexistent"; +$ENV{HOME} = $env; +my $conf16a = new Config::General(-ConfigFile => "t/cfg.16a", -InterPolateVars => 1, -InterPolateEnv => 1, -StrictVars => 0); +my %h16a = $conf16a->getall(); +if($h16a{etc}->{log} eq "$env/log/logfile") { + pass("Testing environment variable interpolation"); +} +else { + fail("Testing environment variable interpolation"); +} + + +### 17 +# testing value pre-setting using a hash +my $conf17 = new Config::General( + -file => "t/cfg.17", + -DefaultConfig => { home => "/exports/home", + logs => "/var/backlog", + foo => { + bar => "quux" + } + }, + -InterPolateVars => 1, + -MergeDuplicateOptions => 1, + -MergeDuplicateBlocks => 1 +); +my %h17 = $conf17->getall(); +ok ($h17{home} eq "/home/users" && + $h17{foo}{quux} eq "quux", + "Testing value pre-setting using a hash"); + + +### 18 +# testing value pre-setting using a string +my $conf18 = new Config::General( + -file => "t/cfg.17", # reuse the file + -DefaultConfig => "home = /exports/home\nlogs = /var/backlog", + -MergeDuplicateOptions => 1, + -MergeDuplicateBlocks => 1 +); +my %h18 = $conf18->getall(); +ok ($h18{home} eq "/home/users", "Testing value pre-setting using a string"); + + +### 19 +# testing various otion/value assignment notations +my $conf19 = new Config::General(-file => "t/cfg.19"); +my %h19 = $conf19->getall(); +my $works = 1; +foreach my $key (keys %h19) { + if ($key =~ /\s/) { + $works = 0; + } +} +ok ($works, "Testing various otion/value assignment notations"); + +### 20 +# testing files() method +my $conf20 = Config::General->new( + -file => "t/cfg.20.a", + -MergeDuplicateOptions => 1 +); +my %h20 = $conf20->getall(); +my %files = map { $_ => 1 } $conf20->files(); +my %expected_files = map { $_ => 1 } ( + 't/cfg.20.a', + 't/cfg.20.b', + 't/cfg.20.c', +); +is_deeply (\%files, \%expected_files, "testing files() method"); + + +### 22 +# testing improved IncludeRelative option +# First try without -IncludeRelative +# this should fail +eval { + my $conf21 = Config::General->new( + -file => "t/sub1/sub2/sub3/cfg.sub3", + -MergeDuplicateOptions => 1, + ); +}; +ok ($@, "prevented from loading relative cfgs without -IncludeRelative"); + + +### 23 +# Now try with -IncludeRelative +# this should fail +my $conf22 = Config::General->new( + -file => "t/sub1/sub2/sub3/cfg.sub3", + -MergeDuplicateOptions => 1, + -IncludeRelative => 1, +); +my %h22 = $conf22->getall; +my %expected_h22 = ( + 'sub3_seen' => 'yup', + 'sub2_seen' => 'yup', + 'sub2b_seen' => 'yup', + 'sub1_seen' => 'yup', + 'sub1b_seen' => 'yup', + 'fruit' => 'mango', +); +is_deeply(\%h22, \%expected_h22, "loaded relative to included files"); + + +### 24 +# Testing IncludeDirectories option +my $conf23 = Config::General->new( + -String => "<>", + -IncludeDirectories => 1 +); +my %h23 = $conf23->getall; +my %expected_h23 = ( + fruit => 'mango', + sub1_seen => 'yup', + sub1b_seen => 'yup', + test => 'value', + test2 => 'value2', + test3 => 'value3' +); +is_deeply(\%h23, \%expected_h23, "including a directory with -IncludeDirectories"); + + +### 24 +# Testing IncludeGlob option +my $conf24 = Config::General->new( + -String => "<>", + -IncludeGlob => 1 +); +my %h24 = $conf24->getall; +my %expected_h24 = ( + test => 'value', + test2 => 'value2', + test3 => 'value3' +); +is_deeply(\%h24, \%expected_h24, "including multiple files via glob pattern with -IncludeGlob"); + + +### 25 +# Testing block and block name quoting +my $conf25 = Config::General->new( + -String => < + opt1 val1 + +<"block2 /"> + opt2 val2 + +<"block 3" "/"> + opt3 val3 + + + opt4 val4 + +TEST + -SlashIsDirectory => 1 +); +my %h25 = $conf25->getall; +my %expected_h25 = ( + block => { '/' => { opt1 => 'val1' } }, + 'block2 /' => { opt2 => 'val2' }, + 'block 3' => { '/' => { opt3 => 'val3' } }, + block4 => { '/' => { opt4 => 'val4' } } +); +is_deeply(\%h25, \%expected_h25, "block and block name quoting"); + + +### 26 +# Testing 0-value handling +my $conf26 = Config::General->new( + -String => < + 0 + +TEST +); +my %h26 = $conf26->getall; +my %expected_h26 = ( + foo => { 0 => { 0 => undef } }, +); +is_deeply(\%h26, \%expected_h26, "testing 0-values in block names"); + + + +# +# look if invalid input gets rejected right +# + +### 27 +# testing invalid parameter calls, expected to fail +my @pt = ( + { + p => {-ConfigHash => "StringNotHash"}, + t => "-ConfigHash HASH required" + }, + { + p => {-String => {}}, + t => "-String STRING required" + }, + { + p => {-ConfigFile => {}}, + t => "-ConfigFile STRING required" + }, + { + p => {-ConfigFile => "NoFile"}, + t => "-ConfigFile STRING File must exist and be readable" + } +); +foreach my $C (@pt) { + eval { + my $cfg = new Config::General(%{$C->{p}}); + }; + ok ($@, "check parameter failure handling $C->{t}"); +} + + + +### 32 +# check Flagbits +my $cfg28 = new Config::General( + -String => "Mode = CLEAR | UNSECURE", + -FlagBits => { + Mode => { + CLEAR => 1, + STRONG => 1, + UNSECURE => "32bit" + } + } ); +my %cfg28 = $cfg28->getall(); +is_deeply(\%cfg28, +{ + 'Mode' => { + 'STRONG' => undef, + 'UNSECURE' => '32bit', + 'CLEAR' => 1 +}}, "Checking -Flagbits resolving"); + + + +### 33 +# checking functional interface +eval { + my %conf = Config::General::ParseConfig(-ConfigFile => "t/test.rc"); + Config::General::SaveConfig("t/test.rc.out", \%conf); + my %next = Config::General::ParseConfig(-ConfigFile => "t/test.rc.out"); + my @a = sort keys %conf; + my @b = sort keys %next; + if (@a != @b) { + die "Re-parsed result differs from original"; + } +}; +ok(! $@, "Testing functional interface $@"); + + + +### 34 +# testing -AutoTrue +my $cfg34 = new Config::General(-AutoTrue => 1, -ConfigFile => "t/cfg.34"); +my %cfg34 = $cfg34->getall(); +my %expect34 = ( + 'a' => { + 'var6' => 0, + 'var3' => 1, + 'var1' => 1, + 'var4' => 0, + 'var2' => 1, + 'var5' => 0 + }, + 'b' => { + 'var6' => 0, + 'var3' => 1, + 'var1' => 1, + 'var4' => 0, + 'var2' => 1, + 'var5' => 0 + } + ); +is_deeply(\%cfg34, \%expect34, "Using -AutoTrue"); + + + +### 35 +# testing -SplitPolicy +my %conf35 = Config::General::ParseConfig( + -String => + qq(var1 :: alpha + var2 :: beta + var3 = gamma # use wrong delimiter by purpose), + -SplitPolicy => 'custom', + -SplitDelimiter => '\s*::\s*' +); +my %expect35 = ( + 'var3 = gamma' => undef, + 'var1' => 'alpha', + 'var2' => 'beta' + ); +is_deeply(\%conf35, \%expect35, "Using -SplitPolicy and custom -SplitDelimiter"); + + + +### Include both +my $conf36 = Config::General->new( -ConfigFile => "t/dual-include.conf", + -IncludeAgain => 1 ); +my %C36 = $conf36->getall; +is_deeply( \%C36, { bit => { one => { honk=>'bonk' }, + two => { honk=>'bonk' } + } }, "Included twice" ); + + +### Include once +{ + my @expected_warning; + local $SIG{__WARN__} = sub { push @expected_warning, @_}; + + my $conf37 = Config::General->new( "t/dual-include.conf" ); + my %C37 = $conf37->getall; + is_deeply( \%C37, { bit => { one => { honk=>'bonk' }, + two => {} + } }, "Included once-only" ); + + is( @expected_warning, 1, "1 Expected warning" ); + like( $expected_warning[0], qr/File .* already loaded. Use -IncludeAgain to load it again./ms, "Warns about a file already being loaded" ); +} + + +### apache-style Include +my $conf38 = Config::General->new( -ConfigFile => "t/apache-include.conf", + -IncludeAgain => 1, + -UseApacheInclude => 1 ); +my %C38 = $conf38->getall; +is_deeply( \%C38, { bit => { one => { honk=>'bonk' }, + two => { honk=>'bonk' } + } }, "Apache-style include" ); + + +# verify fix for rt#107108, test support for IncludeOptional +my $conf38n = Config::General->new( -ConfigFile => "t/apache-include-opt.conf", + -IncludeAgain => 1, -IncludeGlob => 1, + -UseApacheInclude => 1 ); +my %C38n = $conf38n->getall; +is_deeply( \%C38n, { bit => { one => { nink=>'ack' }, + two => { honk=>'bonk' } + } }, "Apache-style IncludeOptional" ); + + + + +#### 39 verifies bug rt#27225 +# testing variable scope. +# a variable shall resolve to the value defined in the current +# scope, not a previous outer scope. +my $conf39 = new Config::General(-ConfigFile => "t/cfg.39", -InterPolateVars => 1, -StrictVars => 0); +my %conf39 = $conf39->getall(); +isnt($conf39{outer}->{b1}->{inner}->{ivar}, + $conf39{outer}->{b2}->{inner}->{ivar}, + "Variable scope test"); + +### 40 - 42 verify if structural error checks are working +foreach my $pos (40 .. 43) { + eval { + my $conf = new Config::General(-ConfigFile => "t/cfg.$pos"); + }; + ok($@ =~ /^Config::General/, "$pos: Structural error checks"); +} + +my $conf44; +eval { + $conf44 = new Config::General(-String => [ 'foo bar' ]); +}; +ok(! $@, "-String arrayref"); +is_deeply({ $conf44->getall }, { foo => 'bar' }, "-String arrayref contents"); + + + +# verifies bug rt#35122 +my $conf45 = new Config::General(-ConfigFile => "t/cfg.45", -InterPolateVars => 1, -StrictVars => 0); +my %conf45 = $conf45->getall(); +my $expect45 = { + 'block1' => { + 'param5' => 'value3', + 'param4' => 'value1', + 'param2' => 'value3' + }, + 'block2' => { + 'param7' => 'value2', + 'param6' => 'value1' + }, + 'param2' => 'value2', + 'param1' => 'value1' + }; +is_deeply($expect45, \%conf45, "Variable precedence"); + +# verifies bug rt#35766 +my $conf46 = new Config::General(-ConfigFile => "t/cfg.46", -InterPolateVars => 1, -StrictVars => 0); +my %conf46 = $conf46->getall(); +my $expect46 = { + 'blah' => 'blubber', + 'test' => 'bar \'variable $blah should be kept\' and \'$foo too\'', + 'foo' => 'bar' + }; +is_deeply($expect46, \%conf46, "Variables inside single quotes"); + + + + + +# complexity test +# check the combination of various features +my $conf47 = new Config::General( + -ConfigFile => "t/complex.cfg", + -InterPolateVars => 1, + -DefaultConfig => { this => "that", default => "imported" }, + -MergeDuplicateBlocks => 1, + -MergeDuplicateOptions => 1, + -StrictVars => 1, + -SplitPolicy => 'custom', + -SplitDelimiter => '\s*=\s*', + -IncludeGlob => 1, + -IncludeAgain => 1, + -IncludeRelative => 1, + -AutoTrue => 1, + -FlagBits => { someflags => { LOCK => 1, RW => 2, TAINT => 3 } }, + -StoreDelimiter => ' = ', + -SlashIsDirectory => 1, + -SaveSorted => 1 + ); +my %conf47 = $conf47->getall(); +my $expect47 = { + 'var3' => 'blah', + 'z1' => { + 'blak' => '11111', + 'nando' => '9999' + }, + 'a' => { + 'b' => { + 'm' => { + '9323' => { + 'g' => '000', + 'long' => 'another long line' + } + }, + 'x' => '9323', + 'z' => 'rewe' + } + }, + 'onflag' => 1, + 'var2' => 'zeppelin', + 'ignore' => '$set', # escaped $ should get to plain $, not \\$! + 'quote' => 'this should be \'kept: $set\' and not be \'$set!\'', + 'x5' => { + 'klack' => '11111' + }, + 'set' => 'blah', + 'line' => 'along line', + 'this' => 'that', + 'imported' => 'got that from imported config', + 'someflags' => { + 'RW' => 2, + 'LOCK' => 1, + 'TAINT' => 3 + }, + 'var1' => 'zero', + 'offflag' => 0, + 'cmd' => 'mart@gw.intx.foo:22', + 'default' => 'imported', + 'host' => 'gw.intx.foo', + 'nando' => '11111', + 'auch ätzendes' => 'muss gehen', + 'Directory' => { + '/' => { + 'mode' => '755' + } + }, + 'hansa' => { + 'z1' => { + 'blak' => '11111', + 'nando' => '9999' + }, + 'Directory' => { + '/' => { + 'mode' => '755' + } + }, + 'block' => { + '0' => { + 'value' => 0 + } + }, + 'x5' => { + 'klack' => '11111' + }, + 'Files' => { + '~/*.pl' => { + 'Options' => '+Indexes' + } + }, + 'nando' => '11111' + }, + 'block' => { + '0' => { + 'value' => 0 + } + }, + 'Files' => { + '~/*.pl' => { + 'Options' => '+Indexes' + } + }, + 'a [[weird]] heredoc' => 'has to + work + too!' +}; +#scip +is_deeply($expect47, \%conf47, "complexity test"); + +# check if sorted save works +$conf47->save_file("t/complex.out", \%conf47); +open T, "; +close T; +my $sorted = qq( +imported = got that from imported config +line = along line +nando = 11111 +offflag = 0 +onflag = 1); +if ($got47 =~ /\Q$sorted\E/) { + pass("Testing sorted save"); +} +else { + fail("Testing sorted save"); +} + + + +tie my %hash48, "Tie::IxHash"; +my $ostr48 = +"zeppelin 1 +beach 2 +anathem 3 +mercury 4\n"; +my $cfg48 = new Config::General( + -String => $ostr48, + -Tie => "Tie::IxHash" + ); +%hash48 = $cfg48->getall(); +my $str48 = $cfg48->save_string(\%hash48); +is( $str48, $ostr48, "tied hash test"); + + + +# check for undef and -w +{ +my $ostr49 = "foo\n"; +local $^W = 1; +my $cfg49 = new Config::General( -String => $ostr49 ); +my %hash49 = $cfg49->getall(); +ok( exists $hash49{foo}, "value for undefined key found"); +is( $hash49{foo}, undef, "value returned as expected - undef"); + +# repeat with interpolation turned on +$cfg49 = new Config::General( -String => $ostr49, -InterPolateVars => 1 ); +%hash49 = $cfg49->getall(); +ok( exists $hash49{foo}, "value for undefined key found"); +is( $hash49{foo}, undef, "value returned as expected - undef"); +$^W = 0; +} + + +# verifies bug fix rt#54580 +# Test handling of values containing *many* single-quoted strings +# when -InterPolateVars option is set +my $dupcount50 = 2000; +my $ostr50; +foreach my $counter ( reverse 1 .. $dupcount50 ) { + $ostr50 .= " 'luck${counter}'"; +} +$ostr50 =~ s{\A }{}; +my $cfgsrc50 = 'test_single_many ' . $ostr50; +$cfg50 = new Config::General( -String => $cfgsrc50, -InterPolateVars => 1 ); +%hash50 = $cfg50->getall(); +is($hash50{test_single_many}, $ostr50, "value with single-quote strings is as expected" ); + + +# check for escaped chars +my $cfg51 = new Config::General( -ConfigFile => "t/cfg.51" ); +my %hash51 = $cfg51->getall(); +is($hash51{dollar}, '$foo', "keep escaped dollar character"); +is($hash51{backslash}, 'contains \ backslash', "keep escaped backslash character"); +is($hash51{prize}, '18 $', "keep un-escaped dollar character"); +is($hash51{hostparam}, q("'wsh.dir'"), "keep escaped quote character"); +is($hash51{bgcolor}, '#fff', "keep escaped number sign"); + +# now save it to a file and re-read it in and see if everything remains escaped +$cfg51->save_file("t/cfg.51.out"); +$cfg51 = new Config::General( -ConfigFile => "t/cfg.51.out", -InterPolateVars => 1 ); +my %hash51new = $cfg51->getall(); +is_deeply(\%hash51, \%hash51new, "compare saved config containing escaped chars"); + + +# check if forced single value arrays remain +my $cfg52 = new Config::General( -String => "habeas = [ corpus ]", -ForceArray => 1); +my %hash52 = $cfg52->getall(); +my @array52 = qw(corpus); +is_deeply($hash52{habeas}, \@array52, "check -ForceArray single value arrays"); +$cfg52->save_file("t/cfg.52.out"); +$cfg52 = new Config::General( -ConfigFile => "t/cfg.52.out", -ForceArray => 1); +my %hash52new = $cfg52->getall(); +is_deeply(\%hash52new, \%hash52, "check -ForceArray single value arrays during save()"); + +my $cfg53 = new Config::General(-AllowSingleQuoteInterpolation => 1, -String => "got = 1\nhave = '\$got'", -InterPolateVars => 1 ); +my %hash53 = $cfg53->getall(); +is($hash53{have}, "'1'", "check -AllowSingleQuoteInterpolation"); + + +# Make sure no warnings were seen during the test. +ok( !@WARNINGS_FOUND, "No unexpected warnings seen" ); + +# check if disabling escape chars does work +my $cfg54 = new Config::General(-NoEscape => 1, -String => qq(val = \\\$notavar:\\blah\n)); +my %hash54 = $cfg54->getall(); +is($hash54{val}, qq(\\\$notavar:\\blah), "check -NoEscape"); + +# check for line continuation followed by empty line (rt.cpan.org#39814) +my $cfg55 = new Config::General( -ConfigFile => "t/cfg.55" ); +my %hash55 = $cfg55->getall(); +is($hash55{b}, "nochop", "check continuation followed by empty line"); + +my $cfg56 = Config::General->new(); +eval { + $cfg56->save_file("t/56.out", { "new\nline" => 9, "brack 8 }); +}; +ok($@, "catch special chars in keys"); + + +# UTF8[BOM] tests +my $cfg57 = "t/utf8_bom/foo.cfg"; +my $expected57 = {foo => {"\x{e9}" => "\x{e8}", bar => {"\x{f4}" => "\x{ee}"}}}; + +for my $bool (0, 1) { + my $conf = Config::General->new(-ConfigFile => $cfg57, + -IncludeRelative => 1, + -UTF8 => $bool); + my %hash = $conf->getall; + is_deeply \%hash, $expected57, "-UTF8 => $bool"; +} + +# IFDEF tests +my $cfg58 = "t/cfg.58"; +my $expected58 = { level => "debug" }; +my %defs = ( + scalar => 'TEST', + array => ['TEST'], + hash => {'TEST' => 1} + ); + +foreach my $def (keys %defs) { + my $conf = Config::General->new(-ConfigFile => $cfg58, + -UseApacheIfDefine => 1, + -Define => $defs{$def}); + my %hash = $conf->getall(); + is_deeply \%hash, $expected58, "UseApacheIfDefine, -Define => $def"; +} diff --git a/t/sub1/cfg.sub1 b/t/sub1/cfg.sub1 new file mode 100644 index 0000000..d5ef884 --- /dev/null +++ b/t/sub1/cfg.sub1 @@ -0,0 +1,3 @@ +fruit = mango +sub1_seen = yup + diff --git a/t/sub1/cfg.sub1b b/t/sub1/cfg.sub1b new file mode 100644 index 0000000..94f7565 --- /dev/null +++ b/t/sub1/cfg.sub1b @@ -0,0 +1 @@ +sub1b_seen = yup diff --git a/t/sub1/cfg.sub1c b/t/sub1/cfg.sub1c new file mode 100644 index 0000000..743c4f2 --- /dev/null +++ b/t/sub1/cfg.sub1c @@ -0,0 +1 @@ +test value diff --git a/t/sub1/cfg.sub1d b/t/sub1/cfg.sub1d new file mode 100644 index 0000000..c1344de --- /dev/null +++ b/t/sub1/cfg.sub1d @@ -0,0 +1 @@ +test2 value2 diff --git a/t/sub1/cfg.sub1e b/t/sub1/cfg.sub1e new file mode 100644 index 0000000..ff90bc8 --- /dev/null +++ b/t/sub1/cfg.sub1e @@ -0,0 +1 @@ +test3 value3 diff --git a/t/sub1/sub2/cfg.sub2 b/t/sub1/sub2/cfg.sub2 new file mode 100644 index 0000000..f31638f --- /dev/null +++ b/t/sub1/sub2/cfg.sub2 @@ -0,0 +1,5 @@ +fruit = pear +sub2_seen = yup + +<> +<> diff --git a/t/sub1/sub2/cfg.sub2b b/t/sub1/sub2/cfg.sub2b new file mode 100644 index 0000000..55a7b93 --- /dev/null +++ b/t/sub1/sub2/cfg.sub2b @@ -0,0 +1 @@ +sub2b_seen = yup diff --git a/t/sub1/sub2/sub3/cfg.sub3 b/t/sub1/sub2/sub3/cfg.sub3 new file mode 100644 index 0000000..fa4b573 --- /dev/null +++ b/t/sub1/sub2/sub3/cfg.sub3 @@ -0,0 +1,5 @@ +fruit = apple +sub3_seen = yup + +<> +<> diff --git a/t/test.rc b/t/test.rc new file mode 100644 index 0000000..86a01b2 --- /dev/null +++ b/t/test.rc @@ -0,0 +1,90 @@ +/* + * Beispiel .redirect Datei. + * + * Wenn diese Datei nicht im $HOME des + * jeweiligen Benutzers vorhanden ist, + * oder wenn die vorhandene Datei aus + * irgendeinem Grund ungültig ist(Syntax) + * dann wird per Default alles an @domain + * zum Benutzer weitergeleitet. + * + * Syntax: + * Domain Blöcke beginnen mit und enden + * mit (equivalent zu apache config). + * Als Kommentare sind # sowie C-Style erlaubt(so + * wie dieser hier). + * Näheres zum Block siehe unten. + * + * Im Block kann man Variablen definieren, auf + * die man dann innerhalb der Blöcke zu- + * greifen kann (siehe sample!) + * + * + * Im Block kann man Mailinglisten einrichten + * allerdings rudimentär, d.h. es sind eigentlich nur + * Verteiler, aber immerhin. Die entsprechende Adresse + * muss im dazugehörigen Block definiert sein. + * + * Angegebene Emailadressen werden (zumindest im Moment) + * nicht überprüft, also 1:1 übernommen, also Sorgfalt + * walten lassen. + * + * Fragen/Kommentare/Kritik/Flames/Mecker an: + * Thomas Linden + * + */ + + + +/* + ********************************************************************* + * Hier kann man Variablen definieren und später mittels + * $variablenname verwenden. + ********************************************************************* + */ + + USER scip # via $USER verwendbar + + +host manna +host gorky + +/* + ********************************************************************* + * Für jede Domain muss ein Block vorhanden sein + ********************************************************************* + */ + + foo max@nasa.gov # foo@bar.de nach max@nasa.gov + + coderz %coderz # coderz@bar.de ist ein Verteiler, der + # in definiert ist. + + @ $USER # alles andere an "scip" schicken. + # Wenn nicht angegeben, kommen unbekannte + # Adressen an den Absender zurück, z.B. + # gibtsnet@bar.de würde "Unknown User" ver- + # ursachen! + + + + + +/* + ********************************************************************* + * Definition einer "Mailingliste", gültige Empfänger müssen mit + * dem Parameter "rcpt" definiert werden. Blöcke sind Domain- + * unabhängig, d.h. sie müssen einen eindeutigen Namen haben. + ********************************************************************* + */ + + rcpt solaar.designer@packetstorm.org + rcpt $USER + rcpt machine@star.wars.de + + + + + + + diff --git a/t/utf8_bom/bar.cfg b/t/utf8_bom/bar.cfg new file mode 100644 index 0000000..8e1fb6d --- /dev/null +++ b/t/utf8_bom/bar.cfg @@ -0,0 +1,3 @@ + + ô = î + diff --git a/t/utf8_bom/foo.cfg b/t/utf8_bom/foo.cfg new file mode 100644 index 0000000..dfda03f --- /dev/null +++ b/t/utf8_bom/foo.cfg @@ -0,0 +1,4 @@ + + é = è + <> +