revision 1.16

date: 2000/08/03 16:54:58;  author: jens;  state: Exp;  lines: +4 -1
An jedes File eine Sektion
# 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 <<include ... >> 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 (<server holland>)
----------------------------
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.




git-svn-id: http://dev.catalyst.perl.org/repos/Config-General/trunk@5 be1acefe-a474-0410-9a34-9b3221f2030f
This commit is contained in:
Thomas von Dein
2009-10-10 16:07:21 +00:00
parent 0eda635652
commit f1c21f4750
13 changed files with 1579 additions and 0 deletions

663
General.pm Normal file
View File

@@ -0,0 +1,663 @@
#
# 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 Thomas Linden <tom@daemon.de>.
# All Rights Reserved. Std. disclaimer applies.
# Artificial License, same as perl itself. Have fun.
#
# namespace
package Config::General;
use FileHandle;
use strict;
$Config::General::VERSION = "1.17";
sub new {
#
# create new Config object
#
my($this, $configfile ) = @_;
my $class = ref($this) || $this;
my $self = {};
bless($self,$class);
my(%config);
%config = ();
$self->{level} = 1;
$self->{configfile} = $configfile;
# open the file and read the contents in
$self->_open($self->{configfile});
return $self;
}
sub getall {
#
# just return the whole config hash
# parse the contents of the file
#
my($this) = @_;
# avoid twice parsing
if (!$this->{parsed}) {
$this->{parsed} = 1;
$this->{config} = $this->_parse({}, $this->{content});
}
my %allhash = %{$this->{config}};
return %allhash;
}
sub _open {
#
# open the config file
# and store it's contents in @content
#
my($this, $configfile) = @_;
my(@content, $c_comment, $longline, $hier, $hierend, @hierdoc);
my $fh = new FileHandle;
if (-e $configfile) {
open $fh, "<$configfile" or die "Could not open $configfile!($!)\n";
while (<$fh>) {
chomp;
next if (/^\s*$/ || /^\s*#/); # ignore whitespace(s) and lines beginning with #
if (/^([^#]+?)#/) {
$_ = $1; # remove trailing comment
}
if (/^\s*(.+?)(\s*=\s*|\s+)<<(.+?)$/) { # we are @ the beginning of a here-doc
$hier = $1; # $hier is the actual here-doc
$hierend = $3; # the here-doc end string, i.e. "EOF"
}
elsif (defined $hierend && /^(\s*)\Q$hierend\E$/) { # the current here-doc ends here
my $indent = $1; # preserve indentation
$hier .= " " . chr(182); # append a "<22>" to the here-doc-name, so _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;
}
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
}
elsif (/\\$/) { # a multiline option, indicated by a trailing backslash
chop;
$_ =~ s/^\s*//;
$longline .= $_ if(!$c_comment); # store in $longline
}
else { # any "normal" config lines
if ($longline) { # previous stuff was a longline and this is the last line of the longline
$_ =~ s/^\s*//;
$longline .= $_ if(!$c_comment);
push @{$this->{content}}, $longline; # push it onto the content stack
undef $longline;
}
elsif ($hier) { # we are inside a here-doc
push @hierdoc, $_; # push onto here-dco stack
}
else {
if (/^<<include (.+?)>>$/) { # include external config file
$this->_open($1) if(!$c_comment); # call _open with the argument to include assuming it is a filename
}
else { # standard config line, push it onto the content stack
push @{$this->{content}}, $_ if(!$c_comment);
}
}
}
}
close $fh;
}
else {
die "The file \"$configfile\" does not exist!\n";
}
return 1;
}
sub _parse {
#
# parse the contents of the file
#
my($this, $config, $content) = @_;
my(@newcontent, $block, $blockname, $grab, $chunk,$block_level);
foreach (@{$content}) { # loop over content stack
chomp;
$chunk++;
$_ =~ s/^\s*//; # strip spaces @ end and begin
$_ =~ s/\s*$//;
my ($option,$value) = split /\s*=\s*|\s+/, $_, 2; # option/value assignment, = is optional
my $indichar = chr(182); # <20>, inserted by _open, our here-doc indicator
$value =~ s/^$indichar// if($value); # a here-doc begin, remove indicator
$value =~ s/^"// if($value); # remove leading and trailing "
$value =~ s/"$// if($value);
if (!$block) { # not inside a block @ the moment
if (/^<([^\/]+?.*?)>$/) { # look if it is a block
$this->{level} += 1;
$block = $1; # store block name
($grab, $blockname) = split /\s\s*/, $block, 2; # is it a named block? if yes, store the name separately
if ($blockname) {
$block = $grab;
}
undef @newcontent;
next;
}
elsif (/^<\/(.+?)>$/) { # it is an end block, but we don't have a matching block!
die "EndBlock \"<\/$1>\" has no StartBlock statement (level: $this->{level}, chunk $chunk)!\n";
}
else { # insert key/value pair into actual node
if ($this->{NoMultiOptions}) { # configurable via special method ::NoMultiOptions()
if (exists $config->{$option}) {
die "Option $config->{$option} occurs more than once (level: $this->{level}, chunk $chunk)!\n";
}
$config->{$option} = $value;
}
else {
if (exists $config->{$option}) { # value exists more than once, make it an array
if (ref($config->{$option}) ne "ARRAY") { # convert scalar to array
my $savevalue = $config->{$option};
delete $config->{$option};
push @{$config->{$option}}, $savevalue;
}
push @{$config->{$option}}, $value; # it's still an array, just push
}
else {
$config->{$option} = $value; # standard config option, insert key/value pair into node
}
}
}
}
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 the 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 ($blockname) {
$config->{$block}->{$blockname} = # a named block, make it a hashref inside a hash within the current node
$this->_parse($config->{$block}->{$blockname}, \@newcontent);
}
else { # standard block
$config->{$block} = $this->_parse($config->{$block}, \@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!
die "Block \"<$block>\" has no EndBlock statement (level: $this->{level}, chunk $chunk)!\n";
}
return $config;
}
sub NoMultiOptions {
#
# turn NoMultiOptions off
#
my($this) = @_;
$this->{NoMultiOptions} = 1;
}
sub save {
#
# save the config back to disk
#
my($this,$file, %config) = @_;
my $fh = new FileHandle;
open $fh, ">$file" or die "Could not open $file!($!)\n";
$this->_store($fh, 0,%config);
}
sub _store {
#
# internal sub for saving a block
#
my($this, $fh, $level, %config) = @_;
my $indent = " " x $level;
foreach my $entry (sort keys %config) {
if (ref($config{$entry}) eq "ARRAY") {
foreach my $line (@{$config{$entry}}) {
print $fh $indent . $entry . " " . $line . "\n";
}
}
elsif (ref($config{$entry}) eq "HASH") {
print $fh $indent . "<" . $entry . ">\n";
$this->_store($fh, $level + 1, %{$config{$entry}});
print $fh $indent . "</" . $entry . ">\n";
}
else {
# scalar
if ($config{$entry} =~ /\n/) {
# it is a here doc
my @lines = split /\n/, $config{$entry};
print $fh $indent . $entry . " <<EOF\n";
foreach my $line(@lines) {
print $fh $indent . $line . "\n";
}
print $fh $indent . "EOF\n";
}
else {
print $fh $indent . $entry . " " . $config{$entry} . "\n";
}
}
}
}
# keep this one
1;
=head1 NAME
Config::General - Generic Config Module
=head1 SYNOPSIS
use Config::General;
$conf = new Config::General("rcfile");
my %config = $conf->getall;
=head1 DESCRIPTION
This small module opens a config file and parses it's contents for you. The B<new> method
requires one parameter which needs to be a filename. The method B<getall> returns a hash
which contains all options and it's associated values of your config file.
The format of config files supported by B<Config::General> 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.
There are currently no methods available for accessing sub-parts of the generated hash structure, so it
is on you to access the data within the hash. But there exists a module on CPAN which you can use for
this purpose: Data::DRef. Check it out!
=head1 METHODS
=over
=item new("filename")
This method returns a B<Config::General> object (a hash bleesed into "Config::General" namespace.
All further methods must be used from that returned object. see below.
=item NoMultiOptions()
Turns off the feature of allwing multiple options with identical names.
The default behavior is to create an array if an option occurs more than
once. But under certain circumstances you may not be willed to allow that.
In this case use this method before you call B<getall> to turn it off.
Please note, that there is no method provided to turn this feature on.
=item getall()
Actually parses the contents of the config file and returns a hash structure
which represents the config.
=item save("filename", %confighash)
Writes the config hash back to the harddisk. Please note, that any occurence
of comments will be ignored and thus be lost after you called 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:
<user hans>
id 13
</user>
will become the following after saving:
<user>
<hans>
id 13
</hans>
</user>
=back
=head1 CONFIG FILE FORMAT
Lines begining with B<#> and empty lines will be ignored. (see section COMMENTS!)
Spaces at the begining 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 use
apostrophs B<">.
An optionline starts with it's name followed by a value. An equalsign 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<getall> returns a hash of all values.
=head1 BLOCKS
You can define a B<block> of options. A B<block> looks much like a block
in the wellknown apache config format. It starts with E<lt>B<blockname>E<gt> and ends
with E<lt>/B<blockname>E<gt>. An example:
<database>
host = muli
user = moare
dbname = modb
dbpass = D4r_9Iu
</database>
Blocks can also be nested. Here is a more complicated example:
user = hans
server = mc200
db = maxis
passwd = D3rf$
<jonas>
user = tom
db = unknown
host = mila
<tablestructure>
index int(100000)
name char(100)
prename char(100)
city char(100)
status int(10)
allowed moses
allowed ingram
allowed joice
</tablestructure>
</jonas>
The hash which the method B<getall> 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 the module cannot find an end-block statement, then this block will be ignored.
=head1 IDENTICAL OPTIONS
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 occured only once or an array if it occured
more than once. If you expect multiple identical options, then you may need to
check if an option occured more than once:
$allowed = $hash{jonas}->{tablestructure}->{allowed};
if(ref($allowed) eq "ARRAY") {
@ALLOWED = @{$allowed};
else {
@ALLOWED = ($allowed);
}
If you don't want to allow more than one identical options, you may turn it off:
$conf->NoMultiOptions();
And you must call B<NoMultiOptions> before calling B<getall>! If NoMultiOptions is set
then you will get a warning if an option occurs more than once.
=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
<Directory /usr/frisco>
Limit Deny
Options ExecCgi Index
</Directory>
<Directory /usr/frik>
Limit DenyAll
Options None
</Directory>
# 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 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 identicates the end of a here document. An
identifier must follow a "<<".
Example:
message <<EOF
we want to
remove the
homedir of
root.
EOF
Everything between the two "EOF" strings will be in the option I<message>.
There is a special feature which allows you to use indentation with here documents.
You can have any amount of whitespaces 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 <<EOF
we want to
remove the
homedir of
root.
EOF
After parsing, message will become:
we want to
remove the
homedir of
root.
because there were the string " " in front of EOF, which were cutted from every
line inside the here-document.
=head1 INCLUDES
You can include an external file at any posision in you config file using the following statement
in your config 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 recurively 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 errormessage like
"too many files in system!".
Include statements will be ignored within C-Comments and here-documents.
=head1 COMMENTS
A comment starts with the number sign B<#>, there can be any number of spaces and/or
tabstops 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,
the 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!
=head1 COPYRIGHT
Copyright (c) 2000 Thomas Linden
This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=head1 BUGS
none known yet.
=head1 AUTHOR
Thomas Linden <tom@consol.de>
=head1 VERSION
1.17
=cut

4
MANIFEST Normal file
View File

@@ -0,0 +1,4 @@
General.pm
MANIFEST
Makefile.PL
README

7
Makefile.PL Normal file
View File

@@ -0,0 +1,7 @@
use ExtUtils::MakeMaker;
WriteMakefile(
'NAME' => 'Config::General',
'VERSION_FROM' => 'General.pm', # finds $VERSION
);

668
Makefile.old Normal file
View File

@@ -0,0 +1,668 @@
# This Makefile is for the Config::General extension to perl.
#
# It was generated automatically by MakeMaker version
# 5.45 (Revision: 1.222) from the contents of
# Makefile.PL. Don't edit this file, edit Makefile.PL instead.
#
# ANY CHANGES MADE HERE WILL BE LOST!
#
# MakeMaker ARGV: ()
#
# MakeMaker Parameters:
# NAME => q[Config::General]
# VERSION_FROM => q[General.pm]
# --- MakeMaker post_initialize section:
# --- MakeMaker const_config section:
# These definitions are from config.sh (via /usr/lib/perl5/5.6.0/i686-linux/Config.pm)
# They may have been overridden via Makefile.PL or on the command line
AR = ar
CC = cc
CCCDLFLAGS = -fpic
CCDLFLAGS = -rdynamic
DLEXT = so
DLSRC = dl_dlopen.xs
LD = cc
LDDLFLAGS = -shared -L/usr/local/lib
LDFLAGS = -L/usr/local/lib
LIBC = /lib/libc-2.1.3.so
LIB_EXT = .a
OBJ_EXT = .o
OSNAME = linux
OSVERS = 2.2.14-5.0
RANLIB = :
SO = so
EXE_EXT =
FULL_AR = /usr/bin/ar
# --- MakeMaker constants section:
AR_STATIC_ARGS = cr
NAME = Config::General
DISTNAME = Config-General
NAME_SYM = Config_General
VERSION = 1.17
VERSION_SYM = 1_17
XS_VERSION = 1.17
INST_BIN = blib/bin
INST_EXE = blib/script
INST_LIB = blib/lib
INST_ARCHLIB = blib/arch
INST_SCRIPT = blib/script
PREFIX = /usr
INSTALLDIRS = site
INSTALLPRIVLIB = $(PREFIX)/lib/perl5/5.6.0
INSTALLARCHLIB = $(PREFIX)/lib/perl5/5.6.0/i686-linux
INSTALLSITELIB = $(PREFIX)/lib/perl5/site_perl/5.6.0
INSTALLSITEARCH = $(PREFIX)/lib/perl5/site_perl/5.6.0/i686-linux
INSTALLBIN = $(PREFIX)/bin
INSTALLSCRIPT = $(PREFIX)/bin
PERL_LIB = /usr/lib/perl5/5.6.0
PERL_ARCHLIB = /usr/lib/perl5/5.6.0/i686-linux
SITELIBEXP = /usr/lib/perl5/site_perl/5.6.0
SITEARCHEXP = /usr/lib/perl5/site_perl/5.6.0/i686-linux
LIBPERL_A = libperl.a
FIRST_MAKEFILE = Makefile
MAKE_APERL_FILE = Makefile.aperl
PERLMAINCC = $(CC)
PERL_INC = /usr/lib/perl5/5.6.0/i686-linux/CORE
PERL = /usr/bin/perl
FULLPERL = /usr/bin/perl
FULL_AR = /usr/bin/ar
VERSION_MACRO = VERSION
DEFINE_VERSION = -D$(VERSION_MACRO)=\"$(VERSION)\"
XS_VERSION_MACRO = XS_VERSION
XS_DEFINE_VERSION = -D$(XS_VERSION_MACRO)=\"$(XS_VERSION)\"
PERL_MALLOC_DEF = -DPERL_EXTMALLOC_DEF -Dmalloc=Perl_malloc -Dfree=Perl_mfree -Drealloc=Perl_realloc -Dcalloc=Perl_calloc
MAKEMAKER = /usr/lib/perl5/5.6.0/ExtUtils/MakeMaker.pm
MM_VERSION = 5.45
# FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle).
# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle)
# ROOTEXT = Directory part of FULLEXT with leading slash (eg /DBD) !!! Deprecated from MM 5.32 !!!
# PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar)
# DLBASE = Basename part of dynamic library. May be just equal BASEEXT.
FULLEXT = Config/General
BASEEXT = General
PARENT_NAME = Config
DLBASE = $(BASEEXT)
VERSION_FROM = General.pm
OBJECT =
LDFROM = $(OBJECT)
LINKTYPE = dynamic
# Handy lists of source code files:
XS_FILES=
C_FILES =
O_FILES =
H_FILES =
HTMLLIBPODS =
HTMLSCRIPTPODS =
MAN1PODS =
MAN3PODS = General.pm
HTMLEXT = html
INST_MAN1DIR = blib/man1
INSTALLMAN1DIR = /usr/man/man1
MAN1EXT = 1
INST_MAN3DIR = blib/man3
INSTALLMAN3DIR = /usr/man/man3
MAN3EXT = 3
PERM_RW = 644
PERM_RWX = 755
# work around a famous dec-osf make(1) feature(?):
makemakerdflt: all
.SUFFIXES: .xs .c .C .cpp .cxx .cc $(OBJ_EXT)
# Nick wanted to get rid of .PRECIOUS. I don't remember why. I seem to recall, that
# some make implementations will delete the Makefile when we rebuild it. Because
# we call false(1) when we rebuild it. So make(1) is not completely wrong when it
# does so. Our milage may vary.
# .PRECIOUS: Makefile # seems to be not necessary anymore
.PHONY: all config static dynamic test linkext manifest
# Where is the Config information that we are using/depend on
CONFIGDEP = $(PERL_ARCHLIB)/Config.pm $(PERL_INC)/config.h
# Where to put things:
INST_LIBDIR = $(INST_LIB)/Config
INST_ARCHLIBDIR = $(INST_ARCHLIB)/Config
INST_AUTODIR = $(INST_LIB)/auto/$(FULLEXT)
INST_ARCHAUTODIR = $(INST_ARCHLIB)/auto/$(FULLEXT)
INST_STATIC =
INST_DYNAMIC =
INST_BOOT =
EXPORT_LIST =
PERL_ARCHIVE =
TO_INST_PM = General.pm
PM_TO_BLIB = General.pm \
$(INST_LIBDIR)/General.pm
# --- MakeMaker tool_autosplit section:
# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto
AUTOSPLITFILE = $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e 'use AutoSplit;autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1) ;'
# --- MakeMaker tool_xsubpp section:
# --- MakeMaker tools_other section:
SHELL = /bin/sh
CHMOD = chmod
CP = cp
LD = cc
MV = mv
NOOP = $(SHELL) -c true
RM_F = rm -f
RM_RF = rm -rf
TEST_F = test -f
TOUCH = touch
UMASK_NULL = umask 0
DEV_NULL = > /dev/null 2>&1
# The following is a portable way to say mkdir -p
# To see which directories are created, change the if 0 to if 1
MKPATH = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e mkpath
# This helps us to minimize the effect of the .exists files A yet
# better solution would be to have a stable file in the perl
# distribution with a timestamp of zero. But this solution doesn't
# need any changes to the core distribution and works with older perls
EQUALIZE_TIMESTAMP = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e eqtime
# Here we warn users that an old packlist file was found somewhere,
# and that they should call some uninstall routine
WARN_IF_OLD_PACKLIST = $(PERL) -we 'exit unless -f $$ARGV[0];' \
-e 'print "WARNING: I have found an old package in\n";' \
-e 'print "\t$$ARGV[0].\n";' \
-e 'print "Please make sure the two installations are not conflicting\n";'
UNINST=0
VERBINST=1
MOD_INSTALL = $(PERL) -I$(INST_LIB) -I$(PERL_LIB) -MExtUtils::Install \
-e "install({@ARGV},'$(VERBINST)',0,'$(UNINST)');"
DOC_INSTALL = $(PERL) -e '$$\="\n\n";' \
-e 'print "=head2 ", scalar(localtime), ": C<", shift, ">", " L<", shift, ">";' \
-e 'print "=over 4";' \
-e 'while (defined($$key = shift) and defined($$val = shift)){print "=item *";print "C<$$key: $$val>";}' \
-e 'print "=back";'
UNINSTALL = $(PERL) -MExtUtils::Install \
-e 'uninstall($$ARGV[0],1,1); print "\nUninstall is deprecated. Please check the";' \
-e 'print " packlist above carefully.\n There may be errors. Remove the";' \
-e 'print " appropriate files manually.\n Sorry for the inconveniences.\n"'
# --- MakeMaker dist section:
DISTVNAME = $(DISTNAME)-$(VERSION)
TAR = tar
TARFLAGS = cvf
ZIP = zip
ZIPFLAGS = -r
COMPRESS = gzip --best
SUFFIX = .gz
SHAR = shar
PREOP = @$(NOOP)
POSTOP = @$(NOOP)
TO_UNIX = @$(NOOP)
CI = ci -u
RCS_LABEL = rcs -Nv$(VERSION_SYM): -q
DIST_CP = best
DIST_DEFAULT = tardist
# --- MakeMaker macro section:
# --- MakeMaker depend section:
# --- MakeMaker cflags section:
# --- MakeMaker const_loadlibs section:
# --- MakeMaker const_cccmd section:
# --- MakeMaker post_constants section:
# --- MakeMaker pasthru section:
PASTHRU = LIB="$(LIB)"\
LIBPERL_A="$(LIBPERL_A)"\
LINKTYPE="$(LINKTYPE)"\
PREFIX="$(PREFIX)"\
OPTIMIZE="$(OPTIMIZE)"
# --- MakeMaker c_o section:
# --- MakeMaker xs_c section:
# --- MakeMaker xs_o section:
# --- MakeMaker top_targets section:
#all :: config $(INST_PM) subdirs linkext manifypods
all :: pure_all htmlifypods manifypods
@$(NOOP)
pure_all :: config pm_to_blib subdirs linkext
@$(NOOP)
subdirs :: $(MYEXTLIB)
@$(NOOP)
config :: Makefile $(INST_LIBDIR)/.exists
@$(NOOP)
config :: $(INST_ARCHAUTODIR)/.exists
@$(NOOP)
config :: $(INST_AUTODIR)/.exists
@$(NOOP)
$(INST_AUTODIR)/.exists :: /usr/lib/perl5/5.6.0/i686-linux/CORE/perl.h
@$(MKPATH) $(INST_AUTODIR)
@$(EQUALIZE_TIMESTAMP) /usr/lib/perl5/5.6.0/i686-linux/CORE/perl.h $(INST_AUTODIR)/.exists
-@$(CHMOD) $(PERM_RWX) $(INST_AUTODIR)
$(INST_LIBDIR)/.exists :: /usr/lib/perl5/5.6.0/i686-linux/CORE/perl.h
@$(MKPATH) $(INST_LIBDIR)
@$(EQUALIZE_TIMESTAMP) /usr/lib/perl5/5.6.0/i686-linux/CORE/perl.h $(INST_LIBDIR)/.exists
-@$(CHMOD) $(PERM_RWX) $(INST_LIBDIR)
$(INST_ARCHAUTODIR)/.exists :: /usr/lib/perl5/5.6.0/i686-linux/CORE/perl.h
@$(MKPATH) $(INST_ARCHAUTODIR)
@$(EQUALIZE_TIMESTAMP) /usr/lib/perl5/5.6.0/i686-linux/CORE/perl.h $(INST_ARCHAUTODIR)/.exists
-@$(CHMOD) $(PERM_RWX) $(INST_ARCHAUTODIR)
config :: $(INST_MAN3DIR)/.exists
@$(NOOP)
$(INST_MAN3DIR)/.exists :: /usr/lib/perl5/5.6.0/i686-linux/CORE/perl.h
@$(MKPATH) $(INST_MAN3DIR)
@$(EQUALIZE_TIMESTAMP) /usr/lib/perl5/5.6.0/i686-linux/CORE/perl.h $(INST_MAN3DIR)/.exists
-@$(CHMOD) $(PERM_RWX) $(INST_MAN3DIR)
help:
perldoc ExtUtils::MakeMaker
Version_check:
@$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \
-MExtUtils::MakeMaker=Version_check \
-e "Version_check('$(MM_VERSION)')"
# --- MakeMaker linkext section:
linkext :: $(LINKTYPE)
@$(NOOP)
# --- MakeMaker dlsyms section:
# --- MakeMaker dynamic section:
## $(INST_PM) has been moved to the all: target.
## It remains here for awhile to allow for old usage: "make dynamic"
#dynamic :: Makefile $(INST_DYNAMIC) $(INST_BOOT) $(INST_PM)
dynamic :: Makefile $(INST_DYNAMIC) $(INST_BOOT)
@$(NOOP)
# --- MakeMaker dynamic_bs section:
BOOTSTRAP =
# --- MakeMaker dynamic_lib section:
# --- MakeMaker static section:
## $(INST_PM) has been moved to the all: target.
## It remains here for awhile to allow for old usage: "make static"
#static :: Makefile $(INST_STATIC) $(INST_PM)
static :: Makefile $(INST_STATIC)
@$(NOOP)
# --- MakeMaker static_lib section:
# --- MakeMaker htmlifypods section:
htmlifypods : pure_all
@$(NOOP)
# --- MakeMaker manifypods section:
POD2MAN_EXE = /usr/bin/pod2man
POD2MAN = $(PERL) -we '%m=@ARGV;for (keys %m){' \
-e 'next if -e $$m{$$_} && -M $$m{$$_} < -M $$_ && -M $$m{$$_} < -M "Makefile";' \
-e 'print "Manifying $$m{$$_}\n";' \
-e 'system(qq[$$^X ].q["-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" $(POD2MAN_EXE) ].qq[$$_>$$m{$$_}])==0 or warn "Couldn\047t install $$m{$$_}\n";' \
-e 'chmod(oct($(PERM_RW))), $$m{$$_} or warn "chmod $(PERM_RW) $$m{$$_}: $$!\n";}'
manifypods : pure_all General.pm
@$(POD2MAN) \
General.pm \
$(INST_MAN3DIR)/Config::General.$(MAN3EXT)
# --- MakeMaker processPL section:
# --- MakeMaker installbin section:
# --- MakeMaker subdirs section:
# none
# --- MakeMaker clean section:
# Delete temporary files but do not touch installed files. We don't delete
# the Makefile here so a later make realclean still has a makefile to use.
clean ::
-rm -rf ./blib $(MAKE_APERL_FILE) $(INST_ARCHAUTODIR)/extralibs.all perlmain.c mon.out core core.*perl.*.? *perl.core so_locations pm_to_blib *~ */*~ */*/*~ *$(OBJ_EXT) *$(LIB_EXT) perl.exe $(BOOTSTRAP) $(BASEEXT).bso $(BASEEXT).def $(BASEEXT).exp
-mv Makefile Makefile.old $(DEV_NULL)
# --- MakeMaker realclean section:
# Delete temporary files (via clean) and also delete installed files
realclean purge :: clean
rm -rf $(INST_AUTODIR) $(INST_ARCHAUTODIR)
rm -f $(INST_LIBDIR)/General.pm
rm -rf Makefile Makefile.old
# --- MakeMaker dist_basics section:
distclean :: realclean distcheck
distcheck :
$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=fullcheck \
-e fullcheck
skipcheck :
$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=skipcheck \
-e skipcheck
manifest :
$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=mkmanifest \
-e mkmanifest
# --- MakeMaker dist_core section:
dist : $(DIST_DEFAULT)
@$(PERL) -le 'print "Warning: Makefile possibly out of date with $$vf" if ' \
-e '-e ($$vf="$(VERSION_FROM)") and -M $$vf < -M "Makefile";'
tardist : $(DISTVNAME).tar$(SUFFIX)
zipdist : $(DISTVNAME).zip
$(DISTVNAME).tar$(SUFFIX) : distdir
$(PREOP)
$(TO_UNIX)
$(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME)
$(RM_RF) $(DISTVNAME)
$(COMPRESS) $(DISTVNAME).tar
$(POSTOP)
$(DISTVNAME).zip : distdir
$(PREOP)
$(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME)
$(RM_RF) $(DISTVNAME)
$(POSTOP)
uutardist : $(DISTVNAME).tar$(SUFFIX)
uuencode $(DISTVNAME).tar$(SUFFIX) \
$(DISTVNAME).tar$(SUFFIX) > \
$(DISTVNAME).tar$(SUFFIX)_uu
shdist : distdir
$(PREOP)
$(SHAR) $(DISTVNAME) > $(DISTVNAME).shar
$(RM_RF) $(DISTVNAME)
$(POSTOP)
# --- MakeMaker dist_dir section:
distdir :
$(RM_RF) $(DISTVNAME)
$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=manicopy,maniread \
-e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');"
# --- MakeMaker dist_test section:
disttest : distdir
cd $(DISTVNAME) && $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) Makefile.PL
cd $(DISTVNAME) && $(MAKE)
cd $(DISTVNAME) && $(MAKE) test
# --- MakeMaker dist_ci section:
ci :
$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=maniread \
-e "@all = keys %{ maniread() };" \
-e 'print("Executing $(CI) @all\n"); system("$(CI) @all");' \
-e 'print("Executing $(RCS_LABEL) ...\n"); system("$(RCS_LABEL) @all");'
# --- MakeMaker install section:
install :: all pure_install doc_install
install_perl :: all pure_perl_install doc_perl_install
install_site :: all pure_site_install doc_site_install
install_ :: install_site
@echo INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
pure_install :: pure_$(INSTALLDIRS)_install
doc_install :: doc_$(INSTALLDIRS)_install
@echo Appending installation info to $(INSTALLARCHLIB)/perllocal.pod
pure__install : pure_site_install
@echo INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
doc__install : doc_site_install
@echo INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
pure_perl_install ::
@$(MOD_INSTALL) \
read $(PERL_ARCHLIB)/auto/$(FULLEXT)/.packlist \
write $(INSTALLARCHLIB)/auto/$(FULLEXT)/.packlist \
$(INST_LIB) $(INSTALLPRIVLIB) \
$(INST_ARCHLIB) $(INSTALLARCHLIB) \
$(INST_BIN) $(INSTALLBIN) \
$(INST_SCRIPT) $(INSTALLSCRIPT) \
$(INST_HTMLLIBDIR) $(INSTALLHTMLPRIVLIBDIR) \
$(INST_HTMLSCRIPTDIR) $(INSTALLHTMLSCRIPTDIR) \
$(INST_MAN1DIR) $(INSTALLMAN1DIR) \
$(INST_MAN3DIR) $(INSTALLMAN3DIR)
@$(WARN_IF_OLD_PACKLIST) \
$(SITEARCHEXP)/auto/$(FULLEXT)
pure_site_install ::
@$(MOD_INSTALL) \
read $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist \
write $(INSTALLSITEARCH)/auto/$(FULLEXT)/.packlist \
$(INST_LIB) $(INSTALLSITELIB) \
$(INST_ARCHLIB) $(INSTALLSITEARCH) \
$(INST_BIN) $(INSTALLBIN) \
$(INST_SCRIPT) $(INSTALLSCRIPT) \
$(INST_HTMLLIBDIR) $(INSTALLHTMLSITELIBDIR) \
$(INST_HTMLSCRIPTDIR) $(INSTALLHTMLSCRIPTDIR) \
$(INST_MAN1DIR) $(INSTALLMAN1DIR) \
$(INST_MAN3DIR) $(INSTALLMAN3DIR)
@$(WARN_IF_OLD_PACKLIST) \
$(PERL_ARCHLIB)/auto/$(FULLEXT)
doc_perl_install ::
-@$(MKPATH) $(INSTALLARCHLIB)
-@$(DOC_INSTALL) \
"Module" "$(NAME)" \
"installed into" "$(INSTALLPRIVLIB)" \
LINKTYPE "$(LINKTYPE)" \
VERSION "$(VERSION)" \
EXE_FILES "$(EXE_FILES)" \
>> $(INSTALLARCHLIB)/perllocal.pod
doc_site_install ::
-@$(MKPATH) $(INSTALLARCHLIB)
-@$(DOC_INSTALL) \
"Module" "$(NAME)" \
"installed into" "$(INSTALLSITELIB)" \
LINKTYPE "$(LINKTYPE)" \
VERSION "$(VERSION)" \
EXE_FILES "$(EXE_FILES)" \
>> $(INSTALLARCHLIB)/perllocal.pod
uninstall :: uninstall_from_$(INSTALLDIRS)dirs
uninstall_from_perldirs ::
@$(UNINSTALL) $(PERL_ARCHLIB)/auto/$(FULLEXT)/.packlist
uninstall_from_sitedirs ::
@$(UNINSTALL) $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist
# --- MakeMaker force section:
# Phony target to force checking subdirectories.
FORCE:
@$(NOOP)
# --- MakeMaker perldepend section:
# --- MakeMaker makefile section:
# We take a very conservative approach here, but it\'s worth it.
# We move Makefile to Makefile.old here to avoid gnu make looping.
Makefile : Makefile.PL $(CONFIGDEP)
@echo "Makefile out-of-date with respect to $?"
@echo "Cleaning current config before rebuilding Makefile..."
-@$(RM_F) Makefile.old
-@$(MV) Makefile Makefile.old
-$(MAKE) -f Makefile.old clean $(DEV_NULL) || $(NOOP)
$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL
@echo "==> Your Makefile has been rebuilt. <=="
@echo "==> Please rerun the make command. <=="
false
# To change behavior to :: would be nice, but would break Tk b9.02
# so you find such a warning below the dist target.
#Makefile :: $(VERSION_FROM)
# @echo "Warning: Makefile possibly out of date with $(VERSION_FROM)"
# --- MakeMaker staticmake section:
# --- MakeMaker makeaperl section ---
MAP_TARGET = perl
FULLPERL = /usr/bin/perl
$(MAP_TARGET) :: static $(MAKE_APERL_FILE)
$(MAKE) -f $(MAKE_APERL_FILE) $@
$(MAKE_APERL_FILE) : $(FIRST_MAKEFILE)
@echo Writing \"$(MAKE_APERL_FILE)\" for this $(MAP_TARGET)
@$(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \
Makefile.PL DIR= \
MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
MAKEAPERL=1 NORECURS=1 CCCDLFLAGS=
# --- MakeMaker test section:
TEST_VERBOSE=0
TEST_TYPE=test_$(LINKTYPE)
TEST_FILE = test.pl
TEST_FILES = t/*.t
TESTDB_SW = -d
testdb :: testdb_$(LINKTYPE)
test :: $(TEST_TYPE)
test_dynamic :: pure_all
PERL_DL_NONLAZY=1 $(FULLPERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use Test::Harness qw(&runtests $$verbose); $$verbose=$(TEST_VERBOSE); runtests @ARGV;' $(TEST_FILES)
testdb_dynamic :: pure_all
PERL_DL_NONLAZY=1 $(FULLPERL) $(TESTDB_SW) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(TEST_FILE)
test_ : test_dynamic
test_static :: test_dynamic
testdb_static :: testdb_dynamic
# --- MakeMaker ppd section:
# Creates a PPD (Perl Package Description) for a binary distribution.
ppd:
@$(PERL) -e "print qq{<SOFTPKG NAME=\"Config-General\" VERSION=\"1,17,0,0\">\n}. qq{\t<TITLE>Config-General</TITLE>\n}. qq{\t<ABSTRACT></ABSTRACT>\n}. qq{\t<AUTHOR></AUTHOR>\n}. qq{\t<IMPLEMENTATION>\n}. qq{\t\t<OS NAME=\"$(OSNAME)\" />\n}. qq{\t\t<ARCHITECTURE NAME=\"i686-linux\" />\n}. qq{\t\t<CODEBASE HREF=\"\" />\n}. qq{\t</IMPLEMENTATION>\n}. qq{</SOFTPKG>\n}" > Config-General.ppd
# --- MakeMaker pm_to_blib section:
pm_to_blib: $(TO_INST_PM)
@$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" \
"-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MExtUtils::Install \
-e "pm_to_blib({qw{$(PM_TO_BLIB)}},'$(INST_LIB)/auto')"
@$(TOUCH) $@
# --- MakeMaker selfdocument section:
# --- MakeMaker postamble section:
# End.

82
README Normal file
View File

@@ -0,0 +1,82 @@
NAME
Config::General - Generic Config Module
SYNOPSIS
use Config::General;
$conf = new Config::General("rcfile");
my %config = $conf->getall;
DESCRIPTION
This small module opens a config file and parses it's
contents for you. The new method requires one parameter
which needs to be a filename. The method getall returns a
hash which contains all options and it's associated values
of your 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% 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.
There are currently no methods available for accessing
sub-parts of the generated hash structure, so it is on you
to access the data within the hash. But there exists a
module on CPAN which you can use for this purpose:
Data::DRef. Check it out!
INSTALLATION
to install, type:
perl Makefile.PL
make
make test
make install
to read the complete documentation, type:
perldoc Config::General
see some example config files which can
be parsed with Config::Genreal in the subdirectory
t/cfg.*
COPYRIGHT
Copyright (c) 2000 Thomas Linden
This library is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.
BUGS
none known yet.
AUTHOR
Thomas Linden <tom@consol.de>
COPYRIGHT
Copyright (c) 2000 Thomas Linden
This library is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.
BUGS
none known yet.
AUTHOR
Thomas Linden <tom@consol.de>
VERSION
1.17

11
t/cfg.2 Normal file
View File

@@ -0,0 +1,11 @@
# Nested block test
<cops>
<officer randall>
name stein
age 25
</officer>
<officer gordon>
name bird
age 31
</officer>
</cops>

4
t/cfg.3 Normal file
View File

@@ -0,0 +1,4 @@
# Array content test
domain b0fh.org
domain l0pht.com
domain infonexus.com

6
t/cfg.4 Normal file
View File

@@ -0,0 +1,6 @@
# Here-document test
message <<EOF
yes. we are not here. you
can reach us somewhere in
outerspace.
EOF

5
t/cfg.5 Normal file
View File

@@ -0,0 +1,5 @@
# Multiline option test
command = ssh -f -g orphues.0x49.org \
-l azrael -L:34777samir.okir.da.ru:22 \
-L:31773:shane.sol1.rocket.de:22 \
'exec sleep 99999990'

10
t/cfg.6 Normal file
View File

@@ -0,0 +1,10 @@
# Comment test
user = tom # a comment right after a line
/*
* C-style comment (multiline)
*/
passwd = sakkra
<db>
/* oneline C-style comment */
host = blah.blubber
</db>

27
t/cfg.7 Normal file
View File

@@ -0,0 +1,27 @@
<cops>
<officer randall>
name stein
age 25
</officer>
<officer gordon>
name bird
age 31
</officer>
</cops>
domain b0fh.org
domain l0pht.com
domain infonexus.com
message <<EOF
yes. we are not here. you
can reach us somewhere in
outerspace.
EOF
command = ssh -f -g orphues.0x49.org \
-l azrael -L:34777samir.okir.da.ru:22 \
-L:31773:shane.sol1.rocket.de:22 \
'exec sleep 99999990'
user = tom
passwd = sakkra
<db>
host = blah.blubber
</db>

26
t/cfg.out Normal file
View File

@@ -0,0 +1,26 @@
command ssh -f -g orphues.0x49.org -l azrael -L:34777samir.okir.da.ru:22 -L:31773:shane.sol1.rocket.de:22 'exec sleep 99999990'
<cops>
<officer>
<gordon>
age 31
name bird
</gordon>
<randall>
age 25
name stein
</randall>
</officer>
</cops>
<db>
host blah.blubber
</db>
domain b0fh.org
domain l0pht.com
domain infonexus.com
message <<EOF
yes. we are not here. you
can reach us somewhere in
outerspace.
EOF
passwd sakkra
user tom

66
t/run.t Normal file
View File

@@ -0,0 +1,66 @@
#
# testscript for Conf.pm by Thomas Linden
# needs to be invoked using the command "make test" from
# the Conf.pm source directory.
# Under normal circumstances every test should run.
BEGIN { $| = 1; print "1..7\n";}
use lib "blib/lib";
use Config::General;
print "ok\n";
print STDERR "\n1 .. ok # loading Config::General\n";
foreach (2..6) {
&p("t/cfg." . $_, $_);
}
my $conf = new Config::General("t/cfg.7");
my %hash = $conf->getall;
$conf->save("t/cfg.out", %hash);
my $copy = new Config::General("t/cfg.out");
my %copyhash = $copy->getall;
my $a = \%hash;
my $b = \%copyhash;
# now see if the saved hash is still the same as the
# one we got from cfg.7
if (&comp($a,$b)) {
print "ok\n";
print STDERR "7 .. ok # Writing Config Hash to disk and compare with original\n";
}
else {
print "7 not ok\n";
print STDERR "7 .. not ok\n";
}
sub p {
my($cfg, $t) = @_;
open T, "<$cfg";
my @file = <T>;
close T;
@file = map { chomp($_); $_} @file;
my $fst = $file[0];
my $conf = new Config::General($cfg);
my %hash = $conf->getall;
print "ok\n";
print STDERR "$t .. ok $fst\n";
}
sub comp {
my($a, $b) = @_;
foreach my $key (keys %{$a}) {
if(ref($a->{$key}) eq "HASH") {
&comp($a->{$key},$b->{$key});
next;
}
elsif(ref($a->{$key}) eq "ARRAY") {
# ignore arrays for simplicity
next;
}
return 0 if($a->{$key} ne $b->{$key});
}
return 1;
}