r13522 - in /branches/upstream/libconfig-json-perl: ./ current/ current/authors.t/ current/lib/ current/lib/Config/ current/t/
emhn-guest at users.alioth.debian.org
emhn-guest at users.alioth.debian.org
Fri Jan 25 13:53:18 UTC 2008
Author: emhn-guest
Date: Fri Jan 25 13:53:18 2008
New Revision: 13522
URL: http://svn.debian.org/wsvn/?sc=1&rev=13522
Log:
[svn-inject] Installing original source of libconfig-json-perl
Added:
branches/upstream/libconfig-json-perl/
branches/upstream/libconfig-json-perl/current/
branches/upstream/libconfig-json-perl/current/.cvsignore
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/Makefile.PL
branches/upstream/libconfig-json-perl/current/README
branches/upstream/libconfig-json-perl/current/authors.t/
branches/upstream/libconfig-json-perl/current/authors.t/perlcritic.t
branches/upstream/libconfig-json-perl/current/authors.t/pod-coverage.t
branches/upstream/libconfig-json-perl/current/authors.t/pod.t
branches/upstream/libconfig-json-perl/current/lib/
branches/upstream/libconfig-json-perl/current/lib/Config/
branches/upstream/libconfig-json-perl/current/lib/Config/JSON.pm
branches/upstream/libconfig-json-perl/current/t/
branches/upstream/libconfig-json-perl/current/t/00.load.t
branches/upstream/libconfig-json-perl/current/t/Config.t
Added: branches/upstream/libconfig-json-perl/current/.cvsignore
URL: http://svn.debian.org/wsvn/branches/upstream/libconfig-json-perl/current/.cvsignore?rev=13522&op=file
==============================================================================
--- branches/upstream/libconfig-json-perl/current/.cvsignore (added)
+++ branches/upstream/libconfig-json-perl/current/.cvsignore Fri Jan 25 13:53:18 2008
@@ -1,0 +1,10 @@
+blib*
+Makefile
+Makefile.old
+Build
+_build*
+pm_to_blib*
+*.tar.gz
+.lwpcookies
+Config-JSON-*
+cover_db
Added: branches/upstream/libconfig-json-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libconfig-json-perl/current/Changes?rev=13522&op=file
==============================================================================
--- branches/upstream/libconfig-json-perl/current/Changes (added)
+++ branches/upstream/libconfig-json-perl/current/Changes Fri Jan 25 13:53:18 2008
@@ -1,0 +1,29 @@
+Revision history for Config-JSON
+
+1.1.2 Thu Jan 23 23:00:00 2008
+ fix: #27078: predictable filename in /tmp
+ fix: #29122: Dependency declaration on Test::Deep missing
+ fix: #32633: Config::JSON 1.1.1 doesn't work with JSON 2.x (thanks to Ernesto Hernández-Novich for patch)
+
+1.1.1 Fri Aug 17 11:00:00 2007
+ Removed requirements for author related tests. Should make it easier to install for the average user.
+
+1.1.0 Wed Aug 08 20:00:00 2007
+ Added direct access multi-level directive support.
+ Now is an Inside Out object per Perl Best Practices.
+ API CHANGE: getFilename() does what you expect now, and getFilePath() returns the path and filename of the config.
+ Fixed qv/qw version number problem.
+
+1.0.3 Thu Mar 05 09:29:00 2007
+ Sorting out more CPAN issues. No code changes. (Sorry, this is the first module I've released to CPAN, and there seems to be more that happens after upload
+ than I know how to test from the command line.)
+
+1.0.2 Thu Mar 01 11:33:00 2007
+ Sorting out more CPAN issues. No code changes.
+
+1.0.1 Tue Feb 27 20:10:00 2007
+ Sorting out CPAN issues. No code changes.
+
+1.0.0 Mon Feb 26 15:06:38 2007
+ Initial public release. Has been used in production environments for more than a year.
+
Added: branches/upstream/libconfig-json-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libconfig-json-perl/current/MANIFEST?rev=13522&op=file
==============================================================================
--- branches/upstream/libconfig-json-perl/current/MANIFEST (added)
+++ branches/upstream/libconfig-json-perl/current/MANIFEST Fri Jan 25 13:53:18 2008
@@ -1,0 +1,11 @@
+Changes
+MANIFEST
+META.yml
+Makefile.PL
+README
+lib/Config/JSON.pm
+t/00.load.t
+t/Config.t
+authors.t/perlcritic.t
+authors.t/pod-coverage.t
+authors.t/pod.t
Added: branches/upstream/libconfig-json-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libconfig-json-perl/current/META.yml?rev=13522&op=file
==============================================================================
--- branches/upstream/libconfig-json-perl/current/META.yml (added)
+++ branches/upstream/libconfig-json-perl/current/META.yml Fri Jan 25 13:53:18 2008
@@ -1,0 +1,17 @@
+# 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.2
+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
+
Added: branches/upstream/libconfig-json-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libconfig-json-perl/current/Makefile.PL?rev=13522&op=file
==============================================================================
--- branches/upstream/libconfig-json-perl/current/Makefile.PL (added)
+++ branches/upstream/libconfig-json-perl/current/Makefile.PL Fri Jan 25 13:53:18 2008
@@ -1,0 +1,22 @@
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => 'Config::JSON',
+ AUTHOR => 'JT Smith <jt at plainblack.com>',
+ VERSION_FROM => 'lib/Config/JSON.pm',
+ ABSTRACT_FROM => 'lib/Config/JSON.pm',
+ PL_FILES => {},
+ PREREQ_PM => {
+ 'List::Util' => 0,
+ 'JSON' => 2.0,
+ 'Class::InsideOut' => 0,
+ 'Test::More' => 0,
+ 'Test::Deep' => 0,
+ 'File::Temp' => 0,
+ 'version' => 0,
+ },
+ dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
+ clean => { FILES => 'Config-JSON-*' },
+);
Added: branches/upstream/libconfig-json-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libconfig-json-perl/current/README?rev=13522&op=file
==============================================================================
--- branches/upstream/libconfig-json-perl/current/README (added)
+++ branches/upstream/libconfig-json-perl/current/README Fri Jan 25 13:53:18 2008
@@ -1,0 +1,34 @@
+Config-JSON version 1.1.2
+
+A JSON based config file parser/writer.
+
+INSTALLATION
+
+To install this module, run the following commands:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+
+
+DEPENDENCIES
+
+JSON 2.0 or higher
+List::Util
+Class::InsideOut
+version
+
+The following are only used for tests:
+Test::More
+Test::Deep
+File::Temp
+
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2006-2008, JT Smith
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
Added: branches/upstream/libconfig-json-perl/current/authors.t/perlcritic.t
URL: http://svn.debian.org/wsvn/branches/upstream/libconfig-json-perl/current/authors.t/perlcritic.t?rev=13522&op=file
==============================================================================
--- branches/upstream/libconfig-json-perl/current/authors.t/perlcritic.t (added)
+++ branches/upstream/libconfig-json-perl/current/authors.t/perlcritic.t Fri Jan 25 13:53:18 2008
@@ -1,0 +1,9 @@
+#!perl
+
+if (!require Test::Perl::Critic) {
+ Test::More::plan(
+ skip_all => "Test::Perl::Critic required for testing PBP compliance"
+ );
+}
+
+Test::Perl::Critic::all_critic_ok();
Added: branches/upstream/libconfig-json-perl/current/authors.t/pod-coverage.t
URL: http://svn.debian.org/wsvn/branches/upstream/libconfig-json-perl/current/authors.t/pod-coverage.t?rev=13522&op=file
==============================================================================
--- branches/upstream/libconfig-json-perl/current/authors.t/pod-coverage.t (added)
+++ branches/upstream/libconfig-json-perl/current/authors.t/pod-coverage.t Fri Jan 25 13:53:18 2008
@@ -1,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
+all_pod_coverage_ok();
Added: branches/upstream/libconfig-json-perl/current/authors.t/pod.t
URL: http://svn.debian.org/wsvn/branches/upstream/libconfig-json-perl/current/authors.t/pod.t?rev=13522&op=file
==============================================================================
--- branches/upstream/libconfig-json-perl/current/authors.t/pod.t (added)
+++ branches/upstream/libconfig-json-perl/current/authors.t/pod.t Fri Jan 25 13:53:18 2008
@@ -1,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+all_pod_files_ok();
Added: branches/upstream/libconfig-json-perl/current/lib/Config/JSON.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libconfig-json-perl/current/lib/Config/JSON.pm?rev=13522&op=file
==============================================================================
--- branches/upstream/libconfig-json-perl/current/lib/Config/JSON.pm (added)
+++ branches/upstream/libconfig-json-perl/current/lib/Config/JSON.pm Fri Jan 25 13:53:18 2008
@@ -1,0 +1,472 @@
+package Config::JSON;
+
+use warnings;
+use strict;
+use Carp;
+use Class::InsideOut qw(readonly id register private);
+use JSON;
+use List::Util;
+use version; our $VERSION = qv('1.1.2');
+
+
+use constant FILE_HEADER => "# config-file-type: JSON 1\n";
+
+
+readonly getFilePath => my %filePath; # path to config file
+private config => my %config; # in memory config file
+
+#-------------------------------------------------------------------
+sub addToArray {
+ my $self = shift;
+ my $property = shift;
+ 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);
+ }
+}
+
+
+#-------------------------------------------------------------------
+sub addToHash {
+ my $self = shift;
+ my $property = shift;
+ my $key = shift;
+ my $value = shift;
+ $self->set($property."/".$key, $value);
+}
+
+
+#-------------------------------------------------------------------
+sub create {
+ my $class = shift;
+ my $filename = shift;
+ if (open(my $FILE,">",$filename)) {
+ print $FILE FILE_HEADER."\n{ }\n";
+ close($FILE);
+ }
+ else {
+ carp "Can't write to config file ".$filename;
+ }
+ return $class->new($filename);
+}
+
+
+
+#-------------------------------------------------------------------
+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};
+ }
+ delete $directive->{$lastPart};
+ if (open(my $FILE,">",$self->getFilePath)) {
+ print $FILE FILE_HEADER."\n".JSON->new->pretty->encode($config{id $self});
+ close($FILE);
+ }
+ else {
+ carp "Can't write to config file ".$self->getFilePath;
+ }
+}
+
+#-------------------------------------------------------------------
+sub deleteFromArray {
+ my $self = shift;
+ my $property = shift;
+ my $value = shift;
+ my $array = $self->get($property);
+ for (my $i = 0; $i < scalar(@{$array}); $i++) {
+ if ($array->[$i] eq $value) {
+ splice(@{$array}, $i, 1);
+ last;
+ }
+ }
+ $self->set($property, $array);
+}
+
+
+#-------------------------------------------------------------------
+sub deleteFromHash {
+ my $self = shift;
+ my $property = shift;
+ my $key = shift;
+ $self->delete($property."/".$key);
+}
+
+
+#-------------------------------------------------------------------
+sub get {
+ my $self = shift;
+ my $property = shift;
+ my $value = $config{id $self};
+ foreach my $part (split "/", $property) {
+ $value = $value->{$part};
+ }
+ return $value;
+}
+
+
+#-------------------------------------------------------------------
+sub getFilename {
+ my $self = shift;
+ my @path = split "/", $self->getFilePath;
+ return pop @path;
+}
+
+
+#-------------------------------------------------------------------
+sub new {
+ my $class = shift;
+ my $pathToFile = shift;
+ if (open(my $FILE, "<", $pathToFile)) {
+ # slurp
+ my $holdTerminator = $/;
+ undef $/;
+ my $json = <$FILE>;
+ $/ = $holdTerminator;
+ close($FILE);
+ my $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;
+ return $self;
+ }
+ else {
+ croak "Cannot read config file: ".$pathToFile;
+ }
+}
+
+
+#-------------------------------------------------------------------
+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};
+ }
+ $directive->{$lastPart} = $value;
+ if (open(my $FILE, ">" ,$self->getFilePath)) {
+ print {$FILE} FILE_HEADER."\n".JSON->new->pretty->encode($config{id $self});
+ close($FILE);
+ }
+ else {
+ carp "Can't write to config file ".$self->getFilePath;
+ }
+}
+
+1; # Magic true value required at end of module
+__END__
+
+=head1 NAME
+
+Config::JSON - A JSON based config file system.
+
+
+=head1 VERSION
+
+This document describes Config::JSON version 1.1.2
+
+
+=head1 SYNOPSIS
+
+ use Config::JSON;
+
+ my $config = Config::JSON->create($pathToFile);
+ my $config = Config::JSON->new($pathToFile);
+
+ my $element = $config->get($directive);
+
+ $config->set($directive,$value);
+
+ $config->delete($directive);
+ $config->deleteFromHash($name, $key);
+ $config->deleteFromArray($name, $value);
+
+ $config->addToHash($name, $key, $value);
+ $config->addToArray($name, $value);
+
+ my $path = $config->getFilePath;
+ my $filename = $config->getFilename;
+
+=head2 Example Config File
+
+ # config-file-type: JSON 1
+
+ {
+ "dsn" : "DBI:mysql:test",
+ "user" : "tester",
+ "password" : "xxxxxx",
+
+ # some colors to choose from
+ "colors" : [ "red", "green", "blue" ],
+
+ # some statistics
+ "stats" : {
+ "health" : 32,
+ "vitality" : 11
+ }
+ }
+
+
+=head1 DESCRIPTION
+
+This package parses the config files written in JSON. It also does some non-JSON stuff, like allowing for comments in the files.
+
+If you want to see it in action, it is used as the config file system in WebGUI L<http://www.webgui.org/>.
+
+=head2 Why?
+
+Why build yet another config file system? Well there are a number of reasons: We used to use other config file parsers, but we kept running into limitations. We already use JSON in our app, so using JSON to store config files means using less memory because we already have the JSON parser in memory. In addition, with JSON we can have any number of hierarchcal data structures represented in the config file, whereas most config files will give you only one level of hierarchy, if any at all. JSON parses faster than XML and YAML. JSON is easier to read and edit than XML. Many other config file systems allow you to read a config file, but they don't provide any mechanism or utilities to write back to it. JSON is taint safe. JSON is easily parsed by languages other than Perl when we need to do that.
+
+=head2 Multi-level Directives
+
+You may of course access a directive called "foo", but since the config is basically a hash you can traverse
+multiple elements of the hash when specifying a directive name by simply delimiting each level with a slash, like
+"foo/bar". For example you may:
+
+ my $vitality = $config->get("stats/vitality");
+ $config->set("stats/vitality", 15);
+
+You may do this wherever you specify a directive name.
+
+=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.
+
+=head1 INTERFACE
+
+=head2 addToArray ( directive, value )
+
+Adds a value to an array directive in the config file.
+
+=head3 directive
+
+The name of the array.
+
+=head3 value
+
+The value to add.
+
+
+=head2 addToHash ( directive, key, value )
+
+Adds a value to a hash directive in the config file. B<NOTE:> This is really the same as
+$config->set("directive/key", $value);
+
+=head3 directive
+
+The name of the hash.
+
+=head3 key
+
+The key to add.
+
+=head3 value
+
+The value to add.
+
+
+=head2 create ( pathToFile )
+
+Constructor. Creates a new empty config file.
+
+=head3 pathToFile
+
+The path and filename of the file to create.
+
+
+
+=head2 delete ( directive )
+
+Deletes a key from the config file.
+
+=head3 directive
+
+The name of the directive to delete.
+
+
+=head2 deleteFromArray ( directive, value )
+
+Deletes a value from an array directive in the config file.
+
+=head3 directive
+
+The name of the array.
+
+=head3 value
+
+The value to delete.
+
+
+
+=head2 deleteFromHash ( directive, key )
+
+Delete a key from a hash directive in the config file. B<NOTE:> This is really just the same as doing
+$config->delete("directive/key");
+
+=head3 directive
+
+The name of the hash.
+
+=head3 key
+
+The key to delete.
+
+
+
+=head2 get ( directive )
+
+Returns the value of a particular directive from the config file.
+
+=head3 directive
+
+The name of the directive to return.
+
+
+
+=head2 getFilename ( )
+
+Returns the filename for this config.
+
+
+
+=head2 getFilePath ( )
+
+Returns the filename and path for this config.
+
+
+
+=head2 new ( pathToFile )
+
+Constructor. Builds an object around a config file.
+
+=head3 pathToFile
+
+A string representing a path such as "/etc/my-cool-config.conf".
+
+
+
+=head2 set ( directive, value )
+
+Creates a new or updates an existing directive in the config file.
+
+=head3 directive
+
+A directive name.
+
+=head3 value
+
+The value to set the paraemter to. Can be a scalar, hash reference, or array reference.
+
+
+
+
+
+=head1 DIAGNOSTICS
+
+=over
+
+=item C<< Couldn't parse JSON in config file >>
+
+This means that the config file does not appear to be formatted properly as a JSON file. Common mistakes are missing commas or trailing commas on the end of a list.
+
+=item C<< Cannot read config file >>
+
+We couldn't read the config file. This usually means that the path specified in the constructor is incorrect.
+
+=item C<< Can't write to config file >>
+
+We couldn't write to the config file. This usually means that the file system is full, or the that the file is write protected.
+
+=back
+
+
+=head1 CONFIGURATION AND ENVIRONMENT
+
+Config::JSON requires no configuration files or environment variables.
+
+
+=head1 DEPENDENCIES
+
+=over
+
+=item JSON 2.0 or higher
+
+=item List::Util
+
+=item Class::InsideOut
+
+=item Test::More
+
+=item Test::Deep
+
+=item File::Temp
+
+=item version
+
+=back
+
+
+=head1 INCOMPATIBILITIES
+
+None reported.
+
+
+=head1 BUGS AND LIMITATIONS
+
+No bugs have been reported.
+
+Please report any bugs or feature requests to
+C<bug-config-json at rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org>.
+
+
+=head1 AUTHOR
+
+JT Smith C<< <jt-at-plainblack-dot-com> >>
+
+
+=head1 LICENCE AND COPYRIGHT
+
+Copyright (c) 2006-2008, Plain Black Corporation L<http://www.plainblack.com/>. All rights reserved.
+
+This module is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself. See L<perlartistic>.
+
+
+=head1 DISCLAIMER OF WARRANTY
+
+BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
+EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
+ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
+YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
+NECESSARY SERVICING, REPAIR, OR CORRECTION.
+
+IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
+LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
+OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
+THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
+RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
+FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
+SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGES.
Added: branches/upstream/libconfig-json-perl/current/t/00.load.t
URL: http://svn.debian.org/wsvn/branches/upstream/libconfig-json-perl/current/t/00.load.t?rev=13522&op=file
==============================================================================
--- branches/upstream/libconfig-json-perl/current/t/00.load.t (added)
+++ branches/upstream/libconfig-json-perl/current/t/00.load.t Fri Jan 25 13:53:18 2008
@@ -1,0 +1,8 @@
+use Test::More tests => 1;
+use lib '../lib';
+
+use_ok( 'Config::JSON' );
+
+diag( "Testing Config::JSON $Config::JSON::VERSION" );
+
+
Added: branches/upstream/libconfig-json-perl/current/t/Config.t
URL: http://svn.debian.org/wsvn/branches/upstream/libconfig-json-perl/current/t/Config.t?rev=13522&op=file
==============================================================================
--- branches/upstream/libconfig-json-perl/current/t/Config.t (added)
+++ branches/upstream/libconfig-json-perl/current/t/Config.t Fri Jan 25 13:53:18 2008
@@ -1,0 +1,112 @@
+use Test::More tests => 25;
+
+use lib '../lib';
+use Test::Deep;
+use Config::JSON;
+use File::Temp qw/ tempfile /;
+
+my ($fh, $filename) = tempfile();
+close($fh);
+my $config = Config::JSON->create($filename);
+ok (defined $config, "create new config");
+
+# set up test data
+if (open(my $file, ">", $filename)) {
+my $testData = <<END;
+# config-file-type: JSON 1
+
+ {
+ "dsn" : "DBI:mysql:test",
+ "user" : "tester",
+ "password" : "xxxxxx",
+
+ # some colors to choose from
+ "colors" : [ "red", "green", "blue" ],
+
+ # some statistics
+ "stats" : {
+ "health" : 32,
+ "vitality" : 11
+ },
+
+ # multilevel
+ "this" : {
+ "that" : {
+ "scalar" : "foo",
+ "array" : ["foo", "bar"],
+ "hash" : {
+ "foo" : 1,
+ "bar" : 2
+ }
+ }
+ }
+ }
+
+END
+ print {$file} $testData;
+ close($file);
+ ok(1, "set up test data");
+}
+else {
+ ok(0, "set up test data");
+}
+
+$config = Config::JSON->new($filename);
+isa_ok($config, "Config::JSON" );
+
+# getFilePath and getFilename
+is( $config->getFilePath, $filename, "getFilePath()" );
+my $justTheName = $filename;
+$justTheName =~ s{.*/(\w+)$}{$1}xmsg;
+is( $config->getFilename, $justTheName, "getFilename()" );
+
+# get
+ok( $config->get("dsn") ne "", "get()" );
+is( ref $config->get("stats"), "HASH", "get() hash" );
+is( ref $config->get("colors"), "ARRAY", "get() array" );
+is( $config->get("this/that/scalar"), "foo", "get() multilevel");
+is( ref $config->get("this/that/hash"), "HASH", "get() hash multilevel" );
+is( ref $config->get("this/that/array"), "ARRAY", "get() array multilevel" );
+
+# set
+$config->set('privateArray', ['a', 'b', 'c']);
+cmp_bag($config->get('privateArray'), ['a', 'b', 'c'], 'set()');
+$config->set('cars/ford', "mustang");
+is($config->get('cars/ford'), "mustang", 'set() multilevel non-exisistant');
+$config->set('cars/ford', [qw( mustang pinto maverick )]);
+cmp_bag($config->get('cars/ford'),[qw( mustang pinto maverick )], 'set() multilevel');
+
+# delete
+$config->delete("dsn");
+ok(!(defined $config->get("dsn")), "delete()");
+$config->delete("stats/vitality");
+ok(!(defined $config->get("stats/vitality")), "delete() multilevel");
+ok(defined $config->get("stats"), "delete() multilevel - doesn't delete parent");
+
+# addToArray
+$config->addToArray("colors","TEST");
+ok((grep /TEST/, @{$config->get("colors")}), "addToArray()");
+$config->addToArray("cars/ford", "fairlane");
+ok((grep /fairlane/, @{$config->get("cars/ford")}), "addToArray() multilevel");
+
+# deleteFromArray
+$config->deleteFromArray("colors","TEST");
+ok(!(grep /TEST/, @{$config->get("colors")}), "deleteFromArray()");
+$config->deleteFromArray("cars/ford", "fairlane");
+ok(!(grep /fairlane/, @{$config->get("cars/ford")}), "deleteFromArray() multilevel");
+
+# addToHash
+$config->addToHash("stats","TEST","VALUE");
+is($config->get("stats/TEST"), "VALUE", "addToHash()");
+$config->addToHash("this/that/hash", "three", 3);
+is($config->get("this/that/hash/three"), 3, "addToHash() multilevel");
+
+# deleteFromHash
+$config->deleteFromHash("stats","TEST");
+my $hash = $config->get("stats");
+ok(!(exists $hash->{TEST}), "deleteFromHash()");
+$config->deleteFromHash("this/that/hash", "three");
+$hash = $config->get("this/that/hash");
+ok(!(exists $hash->{three}), "deleteFromHash() multilevel");
+
+
More information about the Pkg-perl-cvs-commits
mailing list