r26191 - in /branches/upstream/libconfig-json-perl/current: .cvsignore Changes MANIFEST META.yml README lib/Config/JSON.pm t/00.load.t t/Config.t t/Duplicate.t t/Include.t t/Wildcard.t
emhn-guest at users.alioth.debian.org
emhn-guest at users.alioth.debian.org
Wed Oct 22 12:57:24 UTC 2008
Author: emhn-guest
Date: Wed Oct 22 12:57:17 2008
New Revision: 26191
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=26191
Log:
[svn-upgrade] Integrating new upstream version, libconfig-json-perl (1.2.1)
Added:
branches/upstream/libconfig-json-perl/current/t/Duplicate.t
branches/upstream/libconfig-json-perl/current/t/Include.t
branches/upstream/libconfig-json-perl/current/t/Wildcard.t
Removed:
branches/upstream/libconfig-json-perl/current/.cvsignore
Modified:
branches/upstream/libconfig-json-perl/current/Changes
branches/upstream/libconfig-json-perl/current/MANIFEST
branches/upstream/libconfig-json-perl/current/META.yml
branches/upstream/libconfig-json-perl/current/README
branches/upstream/libconfig-json-perl/current/lib/Config/JSON.pm
branches/upstream/libconfig-json-perl/current/t/00.load.t
branches/upstream/libconfig-json-perl/current/t/Config.t
Modified: branches/upstream/libconfig-json-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-json-perl/current/Changes?rev=26191&op=diff
==============================================================================
--- branches/upstream/libconfig-json-perl/current/Changes (original)
+++ branches/upstream/libconfig-json-perl/current/Changes Wed Oct 22 12:57:17 2008
@@ -1,4 +1,10 @@
Revision history for Config-JSON
+
+1.2.1 Sat Oct 18 16:58:19 EDT 2008
+ Fixed version number.
+
+1.2.0 Fri Oct 17 10:14:02 EDT 2008
+ Patch from Christopher Nehren to enable configuration file includes as in Apache.
1.1.4 Fri Jan 23 16:20:00 2008
Patch from Doug Bell that uses better slurping action, and fixes a problem with killing config files on set() errors.
Modified: branches/upstream/libconfig-json-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-json-perl/current/MANIFEST?rev=26191&op=diff
==============================================================================
--- branches/upstream/libconfig-json-perl/current/MANIFEST (original)
+++ branches/upstream/libconfig-json-perl/current/MANIFEST Wed Oct 22 12:57:17 2008
@@ -6,6 +6,9 @@
lib/Config/JSON.pm
t/00.load.t
t/Config.t
+t/Duplicate.t
+t/Include.t
+t/Wildcard.t
authors.t/perlcritic.t
authors.t/pod-coverage.t
authors.t/pod.t
Modified: branches/upstream/libconfig-json-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-json-perl/current/META.yml?rev=26191&op=diff
==============================================================================
--- branches/upstream/libconfig-json-perl/current/META.yml (original)
+++ branches/upstream/libconfig-json-perl/current/META.yml Wed Oct 22 12:57:17 2008
@@ -1,17 +1,20 @@
-# http://module-build.sourceforge.net/META-spec.html
-#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
-name: Config::JSON
-version: 1.1.4
-version_from: lib/Config/JSON.pm
-installdirs: site
-requires:
- List::Util: 0
- Class::InsideOut: 0
- JSON: 2.0
- Test::More: 0
- Test::Deep: 0
- File::Temp: 0
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.17
-
+--- #YAML:1.0
+name: Config-JSON
+version: 1.2.1
+abstract: A JSON based config file system.
+license: ~
+author:
+ - JT Smith <jt at plainblack.com>
+generated_by: ExtUtils::MakeMaker version 6.42
+distribution_type: module
+requires:
+ Class::InsideOut: 0
+ File::Temp: 0
+ JSON: 2
+ List::Util: 0
+ Test::Deep: 0
+ Test::More: 0
+ version: 0
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.3.html
+ version: 1.3
Modified: branches/upstream/libconfig-json-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-json-perl/current/README?rev=26191&op=diff
==============================================================================
--- branches/upstream/libconfig-json-perl/current/README (original)
+++ branches/upstream/libconfig-json-perl/current/README Wed Oct 22 12:57:17 2008
@@ -1,4 +1,4 @@
-Config-JSON version 1.1.4
+Config-JSON version 1.2.1
A JSON based config file parser/writer.
Modified: branches/upstream/libconfig-json-perl/current/lib/Config/JSON.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-json-perl/current/lib/Config/JSON.pm?rev=26191&op=diff
==============================================================================
--- branches/upstream/libconfig-json-perl/current/lib/Config/JSON.pm (original)
+++ branches/upstream/libconfig-json-perl/current/lib/Config/JSON.pm Wed Oct 22 12:57:17 2008
@@ -6,7 +6,7 @@
use Class::InsideOut qw(readonly id register private);
use JSON;
use List::Util;
-use version; our $VERSION = qv('1.1.4');
+use version; our $VERSION = qv('1.2.1');
use constant FILE_HEADER => "# config-file-type: JSON 1\n";
@@ -14,6 +14,8 @@
readonly getFilePath => my %filePath; # path to config file
private config => my %config; # in memory config file
+readonly keyMapping => my %keyMapping; # key <-> file mapping for includes
+private duplicates => my %duplicates; # keep track of duplicates for deleting
#-------------------------------------------------------------------
sub addToArray {
@@ -22,10 +24,10 @@
my $value = shift;
my $array = $self->get($property);
unless (defined List::Util::first { $value eq $_ } @{$array}) { # check if it already exists
- # add it
- push(@{$array}, $value);
- $self->set($property, $array);
- }
+ # add it
+ push(@{$array}, $value);
+ $self->set($property, $array);
+ }
}
@@ -41,8 +43,8 @@
#-------------------------------------------------------------------
sub create {
- my $class = shift;
- my $filename = shift;
+ my $class = shift;
+ my $filename = shift;
if (open(my $FILE,">",$filename)) {
print $FILE FILE_HEADER."\n{ }\n";
close($FILE);
@@ -50,7 +52,7 @@
else {
carp "Can't write to config file ".$filename;
}
- return $class->new($filename);
+ return $class->new($filename);
}
@@ -59,22 +61,58 @@
sub delete {
my $self = shift;
my $param = shift;
- my $directive = $config{id $self};
my @parts = split "/", $param;
my $lastPart = pop @parts;
- foreach my $part (@parts) {
- $directive = $directive->{$part};
+
+ $self->_deleteDuplicates(@parts, $lastPart);
+ my $configFileToWrite = $self->_getIncludeFileToWrite($parts[0], $lastPart);
+ my $configHashRef = $self->_getConfigFileHashRef($configFileToWrite);
+ my $directive = $configHashRef;
+
+ my $inMemoryConfig = $config{ id $self };
+
+ if(@parts) {
+ foreach my $part ( @parts ) {
+ $directive = $directive->{$part};
+ }
}
delete $directive->{$lastPart};
-
- # If JSON dies, don't kill our existing file.
- my $json = JSON->new->pretty->encode($config{id $self});
- if (open(my $FILE,">",$self->getFilePath)) {
- print $FILE FILE_HEADER."\n".$json;
- close($FILE);
- }
+ delete $inMemoryConfig->{$lastPart};
+
+ $self->_writeUpdatedConfigFile($configFileToWrite, $configHashRef);
+ $config{ id $self } = { %{ $inMemoryConfig }, %{ $configHashRef } };
+}
+
+#-------------------------------------------------------------------
+sub _deleteDuplicates {
+ my $self = shift;
+ my @parts = @_;
+ my $lastPart = pop @parts;
+
+ my $keyToDelete;
+ if ( my $duplicates = $duplicates{id $self} ) {
+ # can't just use $duplicates->{$lastPart} because that may not be where
+ # the duplicates start
+ $keyToDelete = List::Util::first { $duplicates->{$_} } (@parts, $lastPart);
+ foreach my $configFileToWrite ( @{ $duplicates->{$keyToDelete} } ) {
+ my $configHashRef = $self->_getConfigFileHashRef($configFileToWrite);
+ my $directive = $configHashRef;
+ if( @parts ) {
+ foreach my $part ( @parts ) {
+ $directive = $directive->{$part};
+ }
+ }
+ delete $directive->{$lastPart};
+ $self->_writeUpdatedConfigFile($configFileToWrite, $configHashRef);
+ }
+ delete $duplicates->{$lastPart};
+ my $mapping = $keyMapping{id $self};
+ delete $mapping->{$keyToDelete};
+ $keyMapping{id $self} = $mapping;
+ $duplicates{id $self} = $duplicates;
+ }
else {
- carp "Can't write to config file ".$self->getFilePath;
+ return;
}
}
@@ -84,7 +122,7 @@
my $property = shift;
my $value = shift;
my $array = $self->get($property);
- for (my $i = 0; $i < scalar(@{$array}); $i++) {
+ foreach (my $i = 0; $i < scalar(@{$array}); $i++) {
if ($array->[$i] eq $value) {
splice(@{$array}, $i, 1);
last;
@@ -114,6 +152,18 @@
return $value;
}
+#-------------------------------------------------------------------
+sub _getConfigFileHashRef {
+ my $self = shift;
+ my $configFileToWrite = shift;
+ open my $fh, '<', $configFileToWrite or carp "Cannot open config file for updating: " . $configFileToWrite;
+ my $json = do {
+ local $/;
+ <$fh>;
+ };
+ close $fh;
+ return JSON->new->relaxed(1)->decode($json);
+}
#-------------------------------------------------------------------
sub getFilename {
@@ -122,6 +172,31 @@
return pop @path;
}
+#-------------------------------------------------------------------
+sub _getIncludeFileToWrite {
+ my $self = shift;
+ my $firstPart = shift;
+ my $lastPart = shift;
+ my $configFileToWrite;
+ # if we've got included files, search for the file where this key is defined
+ if( my $mapping = $keyMapping{ id $self } ) {
+
+ # for top-level sets, $parts[0] will be undefined. use $lastPart if that's the case.
+ my $keyToWrite = defined $firstPart ? $firstPart : $lastPart;
+
+ # the key already exists in a file; write it there
+ if( my $configFileWithKey = $mapping->{ $keyToWrite } ) {
+ $configFileToWrite = $configFileWithKey;
+ }
+ }
+
+ # if we haven't found the file to write to (the key is new), write to the
+ # main file.
+ if(!defined $configFileToWrite) {
+ $configFileToWrite = $self->getFilePath;
+ }
+ return $configFileToWrite;
+}
#-------------------------------------------------------------------
sub new {
@@ -132,11 +207,22 @@
local $/ = undef;
my $json = <$FILE>;
close($FILE);
- my $conf = JSON->new->relaxed(1)->decode($json);
+ my $conf;
+ eval {
+ $conf = JSON->new->relaxed(1)->decode($json);
+ };
croak "Couldn't parse JSON in config file '$pathToFile'\n" unless ref $conf;
my $self = register($class);
$filePath{id $self} = $pathToFile;
$config{id $self} = $conf;
+ if( $conf->{includes} ) {
+ my $keysInMainConfig;
+ foreach my $key ( keys %{ $conf } ) {
+ $keysInMainConfig->{$key} = $pathToFile;
+ }
+ $keyMapping{id $self} = $keysInMainConfig;
+ $self->_processIncludeFiles;
+ }
return $self;
}
else {
@@ -144,24 +230,101 @@
}
}
+#-------------------------------------------------------------------
+# combine multiple include files into a single data structure. carps for
+# duplicate keys, croaks on being unable to load an include for whatever reason
+sub _processIncludeFiles {
+ my $self = shift;
+ my $includes = $self->get('includes');
+
+ # handle wildcards
+ my @includes = map { glob $_ } @{ $includes };
+
+ my $duplicates = {};
+ foreach my $include ( @includes ) {
+ if( open my $FILE, '<', $include ) {
+ local $/ = undef;
+ my $json = <$FILE>;
+ close $FILE;
+ my $includeConf;
+ eval {
+ $includeConf = JSON->new->relaxed(1)->decode($json)
+ };
+ croak "Couldn't parse JSON in include file '$include'\n" unless ref $includeConf;
+ my $keyMapping = $keyMapping{id $self};
+ foreach my $key ( keys %{ $includeConf } ) {
+ # let the user know if there are duplicates
+ if( exists $keyMapping->{$key} ) {
+ unless( exists $duplicates->{$key} ) {
+ $duplicates->{$key} = [];
+ }
+ carp "Key $key already exists in configuration, defined in " . $keyMapping->{$key};
+ push @{ $duplicates->{$key} }, $include;
+ }
+ # ... but don't fail outright
+ $keyMapping->{$key} = $include;
+ }
+ my $oldConf = $config{id $self};
+ my $newConf = { %{ $oldConf }, %{ $includeConf } };
+ $config{id $self} = $newConf;
+ }
+ else {
+ croak "Cannot read include file: " . $include;
+ }
+ }
+ $duplicates{id $self} = $duplicates;
+}
#-------------------------------------------------------------------
sub set {
my $self = shift;
my $property = shift;
my $value = shift;
- my $directive = $config{id $self};
+
my @parts = split "/", $property;
my $lastPart = pop @parts;
- foreach my $part (@parts) {
- unless (exists $directive->{$part}) {
- $directive->{$part} = {};
- }
- $directive = $directive->{$part};
- }
+
+ my $configFileToWrite = $self->_getIncludeFileToWrite($parts[0], $lastPart);
+
+ # read the file to write and then do the writing. must use raw json because
+ # we can't read in the main file with config::json: it would process the
+ # includes and we'd write a single monolithic file; not what we want!
+
+ my $configHashRef = $self->_getConfigFileHashRef($configFileToWrite);
+ my $directive = $configHashRef;
+
+ # now, what we need to do is walk through the data structure, and get to
+ # the point that we're changing. if it's a top level set, @parts will be
+ # empty, so just use $lastPart.
+ # need to set the value in the in-memory config since we didn't use the API to do the write
+ my $inMemoryConfig = $config{ id $self };
+ if(@parts) {
+ foreach my $part ( @parts ) {
+ unless ( exists $inMemoryConfig->{$part} ) {
+ $directive->{$part} = $inMemoryConfig->{$part} = {};
+ }
+ $directive = $directive->{$part};
+ }
+ }
+
+ # finally, assign the value, and write it to disk
$directive->{$lastPart} = $value;
- if (open(my $FILE, ">" ,$self->getFilePath)) {
- print {$FILE} FILE_HEADER."\n".JSON->new->pretty->encode($config{id $self});
+
+ $self->_writeUpdatedConfigFile($configFileToWrite, $configHashRef);
+
+ # update the in-memory configuration since we wrote raw JSON
+ $config{ id $self } = { %{ $inMemoryConfig }, %{ $configHashRef } };
+}
+
+#-------------------------------------------------------------------
+sub _writeUpdatedConfigFile {
+ my $self = shift;
+ my $configFileToWrite = shift;
+ my $configHashRef = shift;
+
+ my $json = JSON->new->pretty->encode($configHashRef);
+ if (open(my $FILE, ">", $configFileToWrite)) {
+ print $FILE FILE_HEADER."\n".$json;
close($FILE);
}
else {
@@ -169,6 +332,11 @@
}
}
+sub dump {
+ my $self = shift;
+ return $config{id $self};
+}
+
1; # Magic true value required at end of module
__END__
@@ -179,7 +347,7 @@
=head1 VERSION
-This document describes Config::JSON version 1.1.4
+This document describes Config::JSON version 1.2.1
=head1 SYNOPSIS
@@ -219,7 +387,13 @@
"stats" : {
"health" : 32,
"vitality" : 11
- }
+ },
+
+ # include some other files. wildcards are expanded with glob
+ "includes": [
+ "firstInclude.conf",
+ "*.include.conf",
+ ]
}
@@ -244,6 +418,10 @@
You may do this wherever you specify a directive name.
+=head2 Including files
+
+You may specify a list of files to include using the C<includes> directive. All files will be checked for shell globs and expanded appropriately. Config::JSON will emit a warning for each duplicate key found.
+
=head2 Comments
You can put comments in the config file as long as # is the first non-space character on the line. However, if you use this API to write to the config file, your comments will be eliminated.
@@ -436,9 +614,11 @@
L<http://rt.cpan.org>.
-=head1 AUTHOR
+=head1 AUTHORS
JT Smith C<< <jt-at-plainblack-dot-com> >>
+
+Chris Nehren C<< <chris-at-plainblack-dot-com> >>
=head1 LICENCE AND COPYRIGHT
Modified: branches/upstream/libconfig-json-perl/current/t/00.load.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-json-perl/current/t/00.load.t?rev=26191&op=diff
==============================================================================
--- branches/upstream/libconfig-json-perl/current/t/00.load.t (original)
+++ branches/upstream/libconfig-json-perl/current/t/00.load.t Wed Oct 22 12:57:17 2008
@@ -1,5 +1,5 @@
use Test::More tests => 1;
-use lib '../lib';
+use blib;
use_ok( 'Config::JSON' );
Modified: branches/upstream/libconfig-json-perl/current/t/Config.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-json-perl/current/t/Config.t?rev=26191&op=diff
==============================================================================
--- branches/upstream/libconfig-json-perl/current/t/Config.t (original)
+++ branches/upstream/libconfig-json-perl/current/t/Config.t Wed Oct 22 12:57:17 2008
@@ -1,4 +1,4 @@
-use Test::More tests => 25;
+use Test::More tests => 26;
use blib;
use Test::Deep;
@@ -82,6 +82,8 @@
$config->delete("stats/vitality");
ok(!(defined $config->get("stats/vitality")), "delete() multilevel");
ok(defined $config->get("stats"), "delete() multilevel - doesn't delete parent");
+$config->delete('this/that/hash');
+ok(defined $config->get('this/that/scalar'), "delete() multilevel - doesn't delete siblings");
# addToArray
$config->addToArray("colors","TEST");
Added: branches/upstream/libconfig-json-perl/current/t/Duplicate.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-json-perl/current/t/Duplicate.t?rev=26191&op=file
==============================================================================
--- branches/upstream/libconfig-json-perl/current/t/Duplicate.t (added)
+++ branches/upstream/libconfig-json-perl/current/t/Duplicate.t Wed Oct 22 12:57:17 2008
@@ -1,0 +1,178 @@
+use strict;
+use warnings;
+use Test::More tests => 22;
+
+#use blib;
+use lib '../lib';
+use Test::Deep;
+use Config::JSON;
+use File::Temp qw/ tempfile /;
+use JSON;
+
+my ($mainHandle, $mainConfigFile) = tempfile();
+my ($firstIncludeHandle, $firstIncludeFile) = tempfile();
+my ($secondIncludeHandle, $secondIncludeFile) = tempfile();
+close($mainHandle);
+close($firstIncludeHandle);
+close($secondIncludeHandle);
+
+# set up main config file with include section
+if (open(my $file, ">", $mainConfigFile)) {
+ my $testData = <<END;
+
+{
+ "dsn" : "DBI:mysql:test",
+ "user" : "tester",
+ "password" : "xxxxxx",
+
+ "colors" : [ "red", "green", "blue" ],
+
+ "stats" : {
+ "health" : 32,
+ "vitality" : 11
+ },
+
+ "this" : {
+ "that" : {
+ "scalar" : "foo",
+ "array" : ["foo", "bar"],
+ "hash" : {
+ "foo" : 1,
+ "bar" : 2
+ }
+ }
+ },
+
+ "includes" : [ "$firstIncludeFile", "$secondIncludeFile"]
+}
+
+END
+ print $file $testData;
+ close($file);
+ ok(1, "set up test data");
+}
+else {
+ ok(0, "set up test data");
+}
+
+# set up the first include file
+if( open my $file, '>', $firstIncludeFile ) {
+ my $testData = <<END;
+# config-file-type: JSON 1
+{
+ "dsn" : "DBI:mysql:test",
+ "user" : "tester",
+ "password" : "xxxxxx",
+
+ "colors" : [ "red", "green", "blue" ],
+
+ "stats" : {
+ "health" : 32,
+ "vitality" : 11
+ },
+
+ "this" : {
+ "that" : {
+ "scalar" : "foo",
+ "array" : ["foo", "bar"],
+ "hash" : {
+ "foo" : 1,
+ "bar" : 2
+ }
+ }
+ }
+}
+END
+ print $file $testData;
+ close $file;
+ ok(1, "set up first include test data");
+}
+else {
+ ok(0, "set up first include file");
+}
+
+if( open my $file, '>', $secondIncludeFile ) {
+ my $testData = <<END;
+# config-file-type: JSON 1
+{
+ "dsn" : "DBI:mysql:test",
+ "user" : "tester",
+ "password" : "xxxxxx",
+
+ "colors" : [ "red", "green", "blue" ],
+
+ "stats" : {
+ "health" : 32,
+ "vitality" : 11
+ },
+
+ "this" : {
+ "that" : {
+ "scalar" : "foo",
+ "array" : ["foo", "bar"],
+ "hash" : {
+ "foo" : 1,
+ "bar" : 2
+ }
+ }
+ }
+}
+END
+ print $file $testData;
+ close $file;
+ ok(1, "set up second include test data");
+}
+else {
+ ok(0, "set up second include file");
+}
+
+# delete
+my $mainConfig = Config::JSON->new($mainConfigFile);
+$mainConfig->delete("dsn");
+ok(!(defined getKey($mainConfigFile, "dsn")), "delete() writes changes for scalar in main file");
+ok(!(defined getKey($firstIncludeFile, "dsn")), "delete() writes changes for scalar in first include file");
+ok(!(defined getKey($secondIncludeFile, "dsn")), "delete() writes changes for scalar in second include file");
+ok(!(defined $mainConfig->get("dsn")), "delete() works for scalar in main file");
+$mainConfig->delete("stats/vitality");
+ok(!(defined getKey($mainConfigFile, "stats/vitality")), "delete() multilevel works for main file");
+ok(!(defined getKey($firstIncludeFile, "stats/vitality")), "delete() multilevel works for first include file");
+ok(!(defined getKey($secondIncludeFile, "stats/vitality")), "delete() multilevel works for second include file");
+ok(!(defined $mainConfig->get("stats/vitality")), "delete() multilevel works for main file");
+ok(defined getKey($mainConfigFile, "stats"), "delete() multilevel - doesn't delete parent in main file");
+ok(defined getKey($firstIncludeFile, "stats"), "delete() multilevel - doesn't delete parent in first include file");
+ok(defined getKey($secondIncludeFile, "stats"), "delete() multilevel - doesn't delete parent in second include file");
+ok(defined $mainConfig->get("stats"), "delete() multilevel - doesn't delete parent in main file");
+$mainConfig->delete('this/that/hash');
+ok(!(defined getKey($firstIncludeFile, "this/that/hash")), "delete() works for multilevel in first include file");
+ok(!(defined getKey($secondIncludeFile, "this/that/hash")), "delete() works for multilevel in second include file");
+ok(!(defined getKey($mainConfigFile, "this/that/hash")), "delete() works for multilevel in main file");
+ok(!(defined $mainConfig->get("this/that/hash")), "delete() works for multilevel in main file");
+ok(defined getKey($firstIncludeFile, 'this/that'), "delete() on multilevel doesn't delete parent in first include file");
+ok(defined getKey($secondIncludeFile, 'this/that'), "delete() on multilevel doesn't delete parent in second include file");
+ok(defined getKey($mainConfigFile, 'this/that'), "delete() on multilevel doesn't delete parent in main file");
+
+
+#----------------------------------------------------
+# get a value from a config file that has includes. Can't use Config::JSON
+# because the main file includes the other files, which means the value we're
+# looking for will be found regardless. that's what we're testing, so we have
+# to use raw JSON.
+sub getKey {
+ my $configFile = shift;
+ my $key = shift;
+ my @parts = split '/', $key;
+ my $lastPart = pop @parts;
+ open my $fh, '<', $configFile or die "open($configFile): $!";
+ my $raw = do {
+ local $/;
+ <$fh>;
+ };
+ close $fh;
+ my $data = JSON->new->relaxed(1)->decode($raw);
+ my $directive = $data;
+ for my $part (@parts) {
+ $directive = $directive->{$part};
+ }
+ return $directive->{$lastPart};
+}
+
Added: branches/upstream/libconfig-json-perl/current/t/Include.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-json-perl/current/t/Include.t?rev=26191&op=file
==============================================================================
--- branches/upstream/libconfig-json-perl/current/t/Include.t (added)
+++ branches/upstream/libconfig-json-perl/current/t/Include.t Wed Oct 22 12:57:17 2008
@@ -1,0 +1,221 @@
+use strict;
+use warnings;
+use Test::More tests => 55;
+
+use blib;
+use Test::Deep;
+use Config::JSON;
+use File::Temp qw/ tempfile /;
+use JSON;
+
+my ($mainHandle, $mainConfigFile) = tempfile();
+my ($firstIncludeHandle, $firstIncludeFile) = tempfile();
+my ($secondIncludeHandle, $secondIncludeFile) = tempfile();
+close($mainHandle);
+close($firstIncludeHandle);
+close($secondIncludeHandle);
+my $mainConfig = Config::JSON->create($mainConfigFile);
+my $firstConfig = Config::JSON->create($firstIncludeFile);
+my $secondConfig = Config::JSON->create($secondIncludeFile);
+
+# set up main config file with include section
+if (open(my $file, ">", $mainConfigFile)) {
+ my $testData = <<END;
+
+{
+ "dsn" : "DBI:mysql:test",
+ "user" : "tester",
+ "password" : "xxxxxx",
+
+ "colors" : [ "red", "green", "blue" ],
+
+ "stats" : {
+ "health" : 32,
+ "vitality" : 11
+ },
+
+ "this" : {
+ "that" : {
+ "scalar" : "foo",
+ "array" : ["foo", "bar"],
+ "hash" : {
+ "foo" : 1,
+ "bar" : 2
+ }
+ }
+ },
+
+ "includes" : [ "$firstIncludeFile", "$secondIncludeFile"]
+}
+
+END
+ print $file $testData;
+ close($file);
+ ok(1, "set up test data");
+}
+else {
+ ok(0, "set up test data");
+}
+
+# set up the first include file
+if( open my $file, '>', $firstIncludeFile ) {
+ my $testData = <<END;
+# config-file-type: JSON 1
+{
+ "firstFileName" : "$firstIncludeFile",
+ "metasyntacticVariables" : ["foo", "bar", "baz"],
+ "myFavoriteColors" : {
+ "mostFavorite" : "black",
+ "leastFavorite" : "white"
+ },
+ "cars" : {
+ "ford" : [
+ "maverick",
+ "mustang",
+ "pinto"
+ ]
+ }
+}
+END
+ print $file $testData;
+ close $file;
+ ok(1, "set up first include test data");
+}
+else {
+ ok(0, "set up first include file");
+}
+
+if( open my $file, '>', $secondIncludeFile ) {
+ my $testData = <<END;
+# config-file-type: JSON 1
+{
+ "secondFileName" : "$secondIncludeFile",
+ "programmingLanguages" : ["perl", "python", "intercal"],
+ "OSVendors" : {
+ "OS X" : "Apple",
+ "Windows" : "Microsoft"
+ }
+}
+END
+ print $file $testData;
+ close $file;
+ ok(1, "set up second include test data");
+}
+else {
+ ok(0, "set up second include file");
+}
+$mainConfig = Config::JSON->new($mainConfigFile);
+isa_ok($mainConfig, "Config::JSON" );
+
+# getFilePath and getFilename
+is( $mainConfig->getFilePath, $mainConfigFile, "getFilePath()" );
+my $justTheName = $mainConfigFile;
+$justTheName =~ s{.*/(\w+)$}{$1}xmsg;
+is( $mainConfig->getFilename, $justTheName, "getFileName()" );
+
+# getFilePaths and getFilenames
+#cmp_deeply( $mainConfig->getFilePaths, ($mainConfigFile, $firstIncludeFile, $secondIncludeFile), "getFilePaths()" );
+#my @justTheNames = map { s{.*/(\w+)$}{$1}xmsg, $_ } ($mainConfigFile, $firstIncludeFile, $secondIncludeFile);
+#cmp_deeply( $mainConfig->getFileNames, @justTheNames, "getFileNames()" );
+
+# get
+# first, make sure stuff in the main file works
+is( $mainConfig->get('dsn'), 'DBI:mysql:test', 'get() scalar' );
+cmp_deeply( $mainConfig->get('colors'), ['red', 'green', 'blue'], 'get() arrayref' );
+cmp_deeply( $mainConfig->get('stats'), {health => 32, vitality => 11}, 'get() hashref' );
+
+# now make sure stuff in the included files work
+is( $mainConfig->get('firstFileName'), $firstIncludeFile, 'get() first include scalar' );
+is( $mainConfig->get('secondFileName'), $secondIncludeFile, 'get() second include scalar' );
+cmp_deeply( $mainConfig->get('metasyntacticVariables'), ['foo', 'bar', 'baz'], 'get() first include arrayref' );
+cmp_deeply( $mainConfig->get('programmingLanguages'), ['perl', 'python', 'intercal'], 'get() second include arrayref' );
+cmp_deeply( $mainConfig->get('myFavoriteColors'), {mostFavorite => 'black', leastFavorite => 'white'}, 'get() first include hashref' );
+cmp_deeply( $mainConfig->get('OSVendors'), {'OS X' => 'Apple', 'Windows' => 'Microsoft'}, 'get() first include hashref' );
+
+# set
+# testing set is different for includes because we have to make sure that the
+# key goes to the right file. thus we need to check the files after writing to
+# ensure that the correct key was written to the correct file.
+$mainConfig->set('dsn', 'DBI:mysql:test2');
+is( getKey($mainConfigFile, 'dsn'), 'DBI:mysql:test2', 'set() works for existing scalar in main file');
+is( getKey($firstIncludeFile, 'dsn'), undef, 'set() does not write to the wrong file for an existing scalar');
+is( getKey($secondIncludeFile, 'dsn'), undef, 'set() does not write to the wrong file for an existing scalar');
+
+$mainConfig->set('foobar', 'the foobar value');
+is( getKey($mainConfigFile, 'foobar'), 'the foobar value', 'set() works for new value in main file');
+is( getKey($firstIncludeFile, 'foobar'), undef, 'set() does not write to the wrong file for a new scalar');
+is( getKey($secondIncludeFile, 'foobar'), undef, 'set() does not write to the wrong file for a new scalar');
+
+$mainConfig->set('colors', ['blue', 'green', 'red']);
+cmp_deeply( getKey($mainConfigFile, 'colors'), ['blue', 'green', 'red'], 'set() works for existing array in main file' );
+is( getKey($firstIncludeFile, 'colors'), undef, 'set() does not write to the wrong file for an existing array');
+is( getKey($secondIncludeFile, 'colors'), undef, 'set() does not write to the wrong file for an existing array');
+
+$mainConfig->set('numbers', ['one', 'two', 'three']);
+cmp_deeply( getKey($mainConfigFile, 'numbers'), ['one', 'two', 'three'], 'set() works for existing array in main file' );
+is( getKey($firstIncludeFile, 'numbers'), undef, 'set() does not write to the wrong file for a new array');
+is( getKey($secondIncludeFile, 'numbers'), undef, 'set() does not write to the wrong file for a new array');
+
+$mainConfig->set('stats', { height => 65, weight => 'none of your business' });
+cmp_deeply( getKey($mainConfigFile, 'stats'), { height => 65, weight => 'none of your business'}, 'set() works for existing hash in main file' );
+is( getKey($firstIncludeFile, 'stats'), undef, 'set() does not write to the wrong file for an existing hash');
+is( getKey($secondIncludeFile, 'stats'), undef, 'set() does not write to the wrong file for an existing hash');
+
+$mainConfig->set('developerNames', { 'JT' => 'Smith', 'Chris' => 'Nehren' } );
+cmp_deeply( getKey($mainConfigFile, 'developerNames'), { 'JT' => 'Smith', 'Chris' => 'Nehren' }, 'set() works for a new hash in main file' );
+is( getKey($firstIncludeFile, 'developerNames'), undef, 'set() does not write to the wrong file for a new hash');
+is( getKey($secondIncludeFile, 'developerNames'), undef, 'set() does not write to the wrong file for a new hash');
+
+$mainConfig->set('firstFileName', "$firstIncludeFile first");
+is( getKey($firstIncludeFile, 'firstFileName'), "$firstIncludeFile first", 'set() writes a scalar to the correct include file');
+is( getKey($mainConfigFile, 'firstFileName'), undef, 'set() does not write to the wrong file for a scalar in an include file');
+is( getKey($secondIncludeFile, 'firstFileName'), undef, 'set() does not write to the wrong file for a scalar in an include file');
+
+$mainConfig->set('metasyntacticVariables', ['baz', 'bar', 'foo']);
+cmp_deeply( getKey($firstIncludeFile, 'metasyntacticVariables'), ['baz', 'bar', 'foo'], 'set() works for an existing array in an include file' );
+is( getKey($mainConfigFile, 'metasyntacticVariables'), undef, 'set() does not write to the wrong file for an existing array in an include file');
+is( getKey($secondIncludeFile, 'metasyntacticVariables'), undef, 'set() does not write to the wrong file for an existing array in an include file');
+
+$mainConfig->set('myFavoriteColors', { 'black' => 'mostFavorite', 'white' => 'leastFavorite' } );
+cmp_deeply( getKey($firstIncludeFile, 'myFavoriteColors'), { 'black' => 'mostFavorite', 'white' => 'leastFavorite' }, 'set() works for an existing hash in an include file' );
+is( getKey($mainConfigFile, 'myFavoriteColors'), undef, 'set() does not write to the wrong file for an existing hash in an include file');
+is( getKey($secondIncludeFile, 'myFavoriteColors'), undef, 'set() does not write to the wrong file for an existing hash in an include file');
+
+# delete
+$mainConfig->delete("dsn");
+ok(!(defined getKey($mainConfigFile, "dsn")), "delete() writes changes for scalar in main file");
+ok(!(defined $mainConfig->get("dsn")), "delete() works for scalar in main file");
+$mainConfig->delete("stats/vitality");
+ok(!(defined getKey($mainConfigFile, "stats/vitality")), "delete() multilevel works for main file");
+ok(!(defined $mainConfig->get("stats/vitality")), "delete() multilevel works for main file");
+ok(defined getKey($mainConfigFile, "stats"), "delete() multilevel - doesn't delete parent in main file");
+ok(defined $mainConfig->get("stats"), "delete() multilevel - doesn't delete parent in main file");
+$mainConfig->delete('firstFileName');
+ok(!(defined getKey($firstIncludeFile, "firstFileName")), "delete() works for scalar in first include file");
+ok(!(defined $mainConfig->get("dsn")), "delete() works for scalar in main file");
+$mainConfig->delete('metasyntacticVariables');
+ok(!(defined getKey($firstIncludeFile, "metasyntacticVariables")), "delete() works for multilevel in first include file");
+ok(!(defined $mainConfig->get("metasyntacticVariables")), "delete() works for multilevel in main file");
+$mainConfig->delete('cars/ford');
+ok(!(defined getKey($firstIncludeFile, "cars/ford")), "delete() works for multilevel in first include file");
+ok(!(defined $mainConfig->get("cars/ford")), "delete() works for multilevel in main file");
+ok(defined getKey($firstIncludeFile, 'cars'), "delete() on multilevel doesn't delete parent in include file");
+
+
+#----------------------------------------------------
+# get a value from a config file that has includes. Can't use Config::JSON
+# because the main file includes the other files, which means the value we're
+# looking for will be found regardless. that's what we're testing, so we have
+# to use raw JSON.
+sub getKey {
+ my $configFile = shift;
+ my $key = shift;
+ open my $fh, '<', $configFile or die "open($configFile): $!";
+ my $raw = do {
+ local $/;
+ <$fh>;
+ };
+ close $fh;
+ my $data = JSON->new->relaxed(1)->decode($raw);
+ return $data->{$key};
+}
Added: branches/upstream/libconfig-json-perl/current/t/Wildcard.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-json-perl/current/t/Wildcard.t?rev=26191&op=file
==============================================================================
--- branches/upstream/libconfig-json-perl/current/t/Wildcard.t (added)
+++ branches/upstream/libconfig-json-perl/current/t/Wildcard.t Wed Oct 22 12:57:17 2008
@@ -1,0 +1,122 @@
+use strict;
+use warnings;
+use Test::More tests => 12;
+
+use blib;
+use Test::Deep;
+use Config::JSON;
+use File::Temp qw/ tempfile /;
+use JSON;
+
+my ($mainHandle, $mainConfigFile) = tempfile();
+my ($firstIncludeHandle, $firstIncludeFile) = tempfile('XXXXX', SUFFIX => '.include.conf', UNLINK => 1);
+my ($secondIncludeHandle, $secondIncludeFile) = tempfile('XXXXX', SUFFIX => '.include.conf', UNLINK => 1);
+close($mainHandle);
+close($firstIncludeHandle);
+close($secondIncludeHandle);
+my $mainConfig = Config::JSON->create($mainConfigFile);
+my $firstConfig = Config::JSON->create($firstIncludeFile);
+my $secondConfig = Config::JSON->create($secondIncludeFile);
+
+# set up main config file with include section
+if (open(my $file, ">", $mainConfigFile)) {
+ my $testData = <<END;
+
+{
+ "dsn" : "DBI:mysql:test",
+ "user" : "tester",
+ "password" : "xxxxxx",
+
+ "colors" : [ "red", "green", "blue" ],
+
+ "stats" : {
+ "health" : 32,
+ "vitality" : 11
+ },
+
+ "this" : {
+ "that" : {
+ "scalar" : "foo",
+ "array" : ["foo", "bar"],
+ "hash" : {
+ "foo" : 1,
+ "bar" : 2
+ }
+ }
+ },
+
+ "includes" : [ "*.include.conf"]
+}
+
+END
+ print $file $testData;
+ close($file);
+ ok(1, "set up test data");
+}
+else {
+ ok(0, "set up test data");
+}
+
+# set up the first include file
+if( open my $file, '>', $firstIncludeFile ) {
+ my $testData = <<END;
+# config-file-type: JSON 1
+{
+ "firstFileName" : "$firstIncludeFile",
+ "metasyntacticVariables" : ["foo", "bar", "baz"],
+ "myFavoriteColors" : {
+ "mostFavorite" : "black",
+ "leastFavorite" : "white"
+ },
+ "cars" : {
+ "ford" : [
+ "maverick",
+ "mustang",
+ "pinto"
+ ]
+ }
+}
+END
+ print $file $testData;
+ close $file;
+ ok(1, "set up first include test data");
+}
+else {
+ ok(0, "set up first include file");
+}
+
+if( open my $file, '>', $secondIncludeFile ) {
+ my $testData = <<END;
+# config-file-type: JSON 1
+{
+ "secondFileName" : "$secondIncludeFile",
+ "programmingLanguages" : ["perl", "python", "intercal"],
+ "OSVendors" : {
+ "OS X" : "Apple",
+ "Windows" : "Microsoft"
+ }
+}
+END
+ print $file $testData;
+ close $file;
+ ok(1, "set up second include test data");
+}
+else {
+ ok(0, "set up second include file");
+}
+$mainConfig = Config::JSON->new($mainConfigFile);
+
+# get
+# first, make sure stuff in the main file works
+is( $mainConfig->get('dsn'), 'DBI:mysql:test', 'get() scalar' );
+cmp_deeply( $mainConfig->get('colors'), ['red', 'green', 'blue'], 'get() arrayref' );
+cmp_deeply( $mainConfig->get('stats'), {health => 32, vitality => 11}, 'get() hashref' );
+
+# now make sure stuff in the included files work
+is( $mainConfig->get('firstFileName'), $firstIncludeFile, 'get() first include scalar' );
+is( $mainConfig->get('secondFileName'), $secondIncludeFile, 'get() second include scalar' );
+cmp_deeply( $mainConfig->get('metasyntacticVariables'), ['foo', 'bar', 'baz'], 'get() first include arrayref' );
+cmp_deeply( $mainConfig->get('programmingLanguages'), ['perl', 'python', 'intercal'], 'get() second include arrayref' );
+cmp_deeply( $mainConfig->get('myFavoriteColors'), {mostFavorite => 'black', leastFavorite => 'white'}, 'get() first include hashref' );
+cmp_deeply( $mainConfig->get('OSVendors'), {'OS X' => 'Apple', 'Windows' => 'Microsoft'}, 'get() first include hashref' );
+
More information about the Pkg-perl-cvs-commits
mailing list