r46589 - in /trunk/libconfig-json-perl: .gitignore Changes META.yml README debian/changelog debian/control debian/copyright debian/rules lib/Config/JSON.pm t/Config.t

jawnsy-guest at users.alioth.debian.org jawnsy-guest at users.alioth.debian.org
Sat Oct 31 14:27:39 UTC 2009


Author: jawnsy-guest
Date: Sat Oct 31 14:27:32 2009
New Revision: 46589

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=46589
Log:
* New upstream release
* Standards-Version 3.8.3 (no changes)
* Added myself to Uploaders and Copyright
* Use new debhelper rules format
* Refreshed copyright information

Added:
    trunk/libconfig-json-perl/.gitignore
      - copied unchanged from r46586, branches/upstream/libconfig-json-perl/current/.gitignore
Modified:
    trunk/libconfig-json-perl/Changes
    trunk/libconfig-json-perl/META.yml
    trunk/libconfig-json-perl/README
    trunk/libconfig-json-perl/debian/changelog
    trunk/libconfig-json-perl/debian/control
    trunk/libconfig-json-perl/debian/copyright
    trunk/libconfig-json-perl/debian/rules
    trunk/libconfig-json-perl/lib/Config/JSON.pm
    trunk/libconfig-json-perl/t/Config.t

Modified: trunk/libconfig-json-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-json-perl/Changes?rev=46589&op=diff
==============================================================================
--- trunk/libconfig-json-perl/Changes (original)
+++ trunk/libconfig-json-perl/Changes Sat Oct 31 14:27:32 2009
@@ -1,4 +1,10 @@
 Revision history for Config-JSON
+
+1.4.0
+    Fixed resetting permissions of file on write
+    Fixed another bug that could lead to erasing the config file.
+    Add addToArrayAfter and addToArrayBefore methods to more easily insert items into lists.
+    Added support for slashes in keys via escaping.
 
 1.3.1   Mon Dec 8 14:00:00 2008
     fix: #41525 Cleaning up temporary directory 

Modified: trunk/libconfig-json-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-json-perl/META.yml?rev=46589&op=diff
==============================================================================
--- trunk/libconfig-json-perl/META.yml (original)
+++ trunk/libconfig-json-perl/META.yml Sat Oct 31 14:27:32 2009
@@ -1,7 +1,7 @@
 # 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.3.1
+version:      1.4.0
 version_from: lib/Config/JSON.pm
 installdirs:  site
 requires:

Modified: trunk/libconfig-json-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-json-perl/README?rev=46589&op=diff
==============================================================================
--- trunk/libconfig-json-perl/README (original)
+++ trunk/libconfig-json-perl/README Sat Oct 31 14:27:32 2009
@@ -1,4 +1,4 @@
-Config-JSON version 1.3.1
+Config-JSON version 1.4.0
 
 A JSON based config file parser/writer.
 
@@ -28,7 +28,7 @@
 
 COPYRIGHT AND LICENCE
 
-Copyright (C) 2006-2008, Plain Black Corporation
+Copyright (C) 2006-2009, Plain Black Corporation
 
 This library is free software; you can redistribute it and/or modify
 it under the same terms as Perl itself.

Modified: trunk/libconfig-json-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-json-perl/debian/changelog?rev=46589&op=diff
==============================================================================
--- trunk/libconfig-json-perl/debian/changelog (original)
+++ trunk/libconfig-json-perl/debian/changelog Sat Oct 31 14:27:32 2009
@@ -1,4 +1,11 @@
-libconfig-json-perl (1.3.1-2) UNRELEASED; urgency=low
+libconfig-json-perl (1.4.0-1) UNRELEASED; urgency=low
+
+  [ Jonathan Yu ]
+  * New upstream release
+  * Standards-Version 3.8.3 (no changes)
+  * Added myself to Uploaders and Copyright
+  * Use new debhelper rules format
+  * Refreshed copyright information
 
   [ Nathan Handler ]
   * debian/watch: Update to ignore development releases.
@@ -7,7 +14,7 @@
   * debian/control: Changed: (build-)depend on perl instead of perl-
     modules.
 
- -- Nathan Handler <nhandler at ubuntu.com>  Sat, 06 Jun 2009 01:33:20 +0000
+ -- Jonathan Yu <jawnsy at cpan.org>  Sat, 31 Oct 2009 06:51:44 -0400
 
 libconfig-json-perl (1.3.1-1) unstable; urgency=low
 

Modified: trunk/libconfig-json-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-json-perl/debian/control?rev=46589&op=diff
==============================================================================
--- trunk/libconfig-json-perl/debian/control (original)
+++ trunk/libconfig-json-perl/debian/control Sat Oct 31 14:27:32 2009
@@ -2,14 +2,14 @@
 Section: perl
 Priority: optional
 Build-Depends: debhelper (>= 7)
-Build-Depends-Indep: perl (>= 5.8.0),
+Build-Depends-Indep: perl,
  libclass-insideout-perl (>= 1.06), libjson-perl (>= 2.12),
  perl (>= 5.10) | libversion-perl, libtest-deep-perl (>= 0.095)
 Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
 Uploaders: Ernesto Hernández-Novich (USB) <emhn at usb.ve>,
- Jose Luis Rivas <ghostbar38 at gmail.com>,
+ Jose Luis Rivas <ghostbar38 at gmail.com>, Jonathan Yu <jawnsy at cpan.org>,
  Brian Cassidy <brian.cassidy at gmail.com>
-Standards-Version: 3.8.0
+Standards-Version: 3.8.3
 Homepage: http://search.cpan.org/dist/Config-JSON/
 Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libconfig-json-perl/
 Vcs-Browser: http://svn.debian.org/viewsvn/pkg-perl/trunk/libconfig-json-perl/

Modified: trunk/libconfig-json-perl/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-json-perl/debian/copyright?rev=46589&op=diff
==============================================================================
--- trunk/libconfig-json-perl/debian/copyright (original)
+++ trunk/libconfig-json-perl/debian/copyright Sat Oct 31 14:27:32 2009
@@ -1,16 +1,18 @@
 Format-Specification:
     http://wiki.debian.org/Proposals/CopyrightFormat?action=recall&rev=196
-Upstream-Maintainer: JT Smith  <jt-at-plainblack-dot-com>
+Upstream-Maintainer: JT Smith <jt at plainblack.com>
 Upstream-Source: http://search.cpan.org/dist/Config-JSON/
 Upstream-Name: Config-JSON
 
 Files: *
-Copyright: © 2006-2008, Plain Black Corporation http://www.plainblack.com/.
-License: GPL-1+|Artistic
+Copyright: 2006-2008, Plain Black Corporation http://www.plainblack.com/.
+License: GPL-1+ | Artistic
 
 Files: debian/*
-Copyright: © 2008, various members of the Debian Perl Group,
- cf. debian/changelog
+Copyright: 2009, Jonathan Yu <jawnsy at cpan.org>
+ 2008, Brian Cassidy <brian.cassidy at gmail.com>
+ 2008, Jose Luis Rivas <ghostbar38 at gmail.com>
+ 2008, Ernesto Hernández-Novich (USB) <emhn at usb.ve>
 License: Artistic | GPL-1+
 
 License: Artistic

Modified: trunk/libconfig-json-perl/debian/rules
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-json-perl/debian/rules?rev=46589&op=diff
==============================================================================
--- trunk/libconfig-json-perl/debian/rules (original)
+++ trunk/libconfig-json-perl/debian/rules Sat Oct 31 14:27:32 2009
@@ -1,23 +1,4 @@
 #!/usr/bin/make -f
 
-build: build-stamp
-build-stamp:
-	dh build
-	touch $@
-
-clean:
+%:
 	dh $@
-
-install: install-stamp
-install-stamp: build-stamp
-	dh install
-	touch $@
-
-binary-arch:
-
-binary-indep: install
-	dh $@
-
-binary: binary-arch binary-indep
-
-.PHONY: binary binary-arch binary-indep install clean build

Modified: trunk/libconfig-json-perl/lib/Config/JSON.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-json-perl/lib/Config/JSON.pm?rev=46589&op=diff
==============================================================================
--- trunk/libconfig-json-perl/lib/Config/JSON.pm (original)
+++ trunk/libconfig-json-perl/lib/Config/JSON.pm Sat Oct 31 14:27:32 2009
@@ -4,15 +4,12 @@
 use strict;
 use Carp;
 use Class::InsideOut qw(readonly id register private);
-use File::Copy;
-use File::Temp qw/ tempfile /;
-use JSON;
+use File::Spec;
+use JSON 2.0;
 use List::Util;
-use version; our $VERSION = qv('1.3.1');
-
+use version; our $VERSION = qv('1.4.0');
 
 use constant FILE_HEADER    => "# config-file-type: JSON 1\n";
-
 
 readonly    getFilePath     => my %filePath;    # path to config file
 readonly    isInclude       => my %isInclude;   # is an include file
@@ -28,6 +25,38 @@
       	push(@{$array}, $value);
       	$self->set($property, $array);
 	}
+}
+
+#-------------------------------------------------------------------
+sub addToArrayAfter {
+    my ($self, $property, $afterValue, $value) = @_;
+    my $array = $self->get($property);
+    unless (defined List::Util::first { $value eq $_ } @{ $array }) { # check if it already exists
+        my $idx = 0;
+        for (; $idx < $#{ $array }; $idx++) {
+            if ($array->[$idx] eq $afterValue) {
+                last;
+            }
+        }
+        splice @{ $array }, $idx + 1, 0, $value;
+        $self->set($property, $array);
+    }
+}
+
+#-------------------------------------------------------------------
+sub addToArrayBefore {
+    my ($self, $property, $beforeValue, $value) = @_;
+    my $array = $self->get($property);
+    unless (defined List::Util::first { $value eq $_ } @{ $array }) { # check if it already exists
+        my $idx = $#{ $array };
+        for (; $idx > 0; $idx--) {
+            if ($array->[$idx] eq $beforeValue) {
+                last;
+            }
+        }
+        splice @{ $array }, $idx , 0, $value;
+        $self->set($property, $array);
+    }
 }
 
 #-------------------------------------------------------------------
@@ -60,7 +89,7 @@
 	
 	# find the directive
     my $directive   = $config{id $self};
-    my @parts       = split "/", $param;
+    my @parts       = $self->splitKeyParts($param);
     my $lastPart    = pop @parts;
     foreach my $part (@parts) {
         $directive = $directive->{$part};
@@ -101,7 +130,7 @@
 
 		# look in this config
 		my $value = $config{id $self};
-		foreach my $part (split "/", $property) {
+		foreach my $part ($self->splitKeyParts($property)) {
 			$value = eval{$value->{$part}};
             if ($@) {
                 croak "Can't access $property. $@";
@@ -173,7 +202,7 @@
 
 	# see if the directive exists in this config
     my $directive	= $config{id $self};
-    my @parts 		= split "/", $property;
+    my @parts 		= $self->splitKeyParts($property);
 	my $numParts 	= scalar @parts;
 	for (my $i=0; $i < $numParts; $i++) {
 		my $part = $parts[$i];
@@ -218,20 +247,48 @@
 }
 
 #-------------------------------------------------------------------
+sub splitKeyParts {
+    my ($self, $key) = @_;
+    my @parts = split /(?<!\\)\//, $key;
+    map {s{\\\/}{/}} @parts;
+    return @parts;
+}
+
+#-------------------------------------------------------------------
 sub write {
-	my $self = shift;
-	my $realfile = $self->getFilePath;
-
-	# convert data to json
+    my $self = shift;
+    my $realfile = $self->getFilePath;
+
+    # convert data to json
     my $json = JSON->new->pretty->utf8->canonical->encode($config{id $self});
 
-	# create a temporary config file
-	my ($fh, $tempfile) = tempfile(UNLINK=>1);
-    print {$fh} FILE_HEADER."\n".$json;
-    close($fh);
-	
-	# move the temp file over the top of the existing file
-	copy($tempfile, $realfile) or croak "Can't copy temporary file (".$tempfile.") to config file (".$realfile.")";
+    my $to_write = FILE_HEADER . "\n" . $json;
+    my $needed_bytes = length $to_write;
+
+    # open as read/write
+    open my $fh, '+<:raw', $realfile or croak "Unable to open $realfile for write: $!";
+    my $current_bytes = (stat $fh)[7];
+    # shrink file if needed
+    if ($needed_bytes < $current_bytes) {
+        truncate $fh, $needed_bytes;
+    }
+    # make sure we can expand the file to the needed size before we overwrite it
+    elsif ($needed_bytes > $current_bytes) {
+        my $padding = q{ } x ($needed_bytes - $current_bytes);
+        sysseek $fh, 0, 2;
+        if (! syswrite $fh, $padding) {
+            sysseek $fh, 0, 0;
+            truncate $fh, $current_bytes;
+            close $fh;
+            croak "Unable to expand $realfile: $!";
+        }
+        sysseek $fh, 0, 0;
+        seek $fh, 0, 0;
+    }
+    print {$fh} $to_write;
+    close $fh;
+
+    return 1;
 }
 
 
@@ -245,7 +302,7 @@
 
 =head1 VERSION
 
-This document describes Config::JSON version 1.3.1
+This document describes Config::JSON version 1.4.0
 
 
 =head1 SYNOPSIS
@@ -273,22 +330,22 @@
 
  # 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
-        },
-		
-		# including another file
-		"includes" : ["macros.conf"]
- } 
+    "dsn" : "DBI:mysql:test",
+    "user" : "tester",
+    "password" : "xxxxxx",
+
+    # some colors to choose from
+    "colors" : [ "red", "green", "blue" ],
+
+    # some statistics
+    "stats" : {
+            "health" : 32,
+            "vitality" : 11
+    },
+
+    # including another file
+    "includes" : ["macros.conf"]
+ }
 
 
 =head1 DESCRIPTION
@@ -300,7 +357,19 @@
 
 =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.
+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
@@ -333,7 +402,7 @@
 
 If a directive is deleted, it will be deleted from all files, including the includes.
 
-=head1 INTERFACE 
+=head1 INTERFACE
 
 =head2 addToArray ( directive, value )
 
@@ -346,6 +415,42 @@
 =head3 value
 
 The value to add.
+
+=head2 addToArrayBefore ( directive, insertBefore, value )
+
+Inserts a value into an array immediately before another item.  If
+that item can't be found, inserts at the beginning on the array.
+
+=head3 directive
+
+The name of the array.
+
+=head3 insertBefore
+
+The value to search for and base the positioning on.
+
+=head3 value
+
+The value to insert.
+
+
+=head2 addToArrayAfter ( directive, insertAfter, value )
+
+Inserts a value into an array immediately after another item.  If
+that item can't be found, inserts at the end on the array.
+
+=head3 directive
+
+The name of the array.
+
+=head3 insertAfter
+
+The value to search for and base the positioning on.
+
+=head3 value
+
+The value to insert.
+
 
 
 =head2 addToHash ( directive, key, value )
@@ -441,7 +546,6 @@
 Returns an array reference of Config::JSON objects that are files included by this config.
 
 
-
 =head2 new ( pathToFile )
 
 Constructor. Builds an object around a config file.
@@ -466,6 +570,20 @@
 
 
 
+=head2 splitKeyParts ( key )
+
+Returns an array of key parts.
+
+=head3 key
+
+A key string. Could be 'foo' (simple key), 'foo/bar' (a multilevel key referring to the bar key as a child of foo), or 'foo\/bar' (a simple key that contains a slash in the key). Don't forget to double escape in your perl code if you have a slash in your key parts like this:
+
+ $config->get('foo\\/bar');
+
+=cut
+
+
+
 =head2 write ( )
 
 Writes the file to the filesystem. Normally you'd never need to call this as it's called automatically by the other methods when a change occurs.
@@ -509,8 +627,6 @@
 =item Test::More
 
 =item Test::Deep
-
-=item File::Temp
 
 =item version
 
@@ -538,7 +654,7 @@
 
 =head1 LICENCE AND COPYRIGHT
 
-Copyright (c) 2006-2008, Plain Black Corporation L<http://www.plainblack.com/>. All rights reserved.
+Copyright (c) 2006-2009, 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>.

Modified: trunk/libconfig-json-perl/t/Config.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-json-perl/t/Config.t?rev=46589&op=diff
==============================================================================
--- trunk/libconfig-json-perl/t/Config.t (original)
+++ trunk/libconfig-json-perl/t/Config.t Sat Oct 31 14:27:32 2009
@@ -1,4 +1,4 @@
-use Test::More tests => 28;
+use Test::More tests => 35;
 
 use lib '../lib';
 use Test::Deep;
@@ -77,6 +77,9 @@
 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');
+$config->addToHash('hash','cdn\\/','CDNRoot');
+my $hash = $config->get('hash');
+is $hash->{'cdn/'}, 'CDNRoot', 'allow for escaped slashes in keys';
 my $reconfig = Config::JSON->new($filename);
 cmp_bag($config->get('cars/ford'),$reconfig->get('cars/ford'), 'set() multilevel after re-reading config file');
 
@@ -102,6 +105,24 @@
 $config->deleteFromArray("cars/ford", "fairlane");
 ok(!(grep /fairlane/, @{$config->get("cars/ford")}), "deleteFromArray() multilevel");
 
+# addToArrayBefore
+$config->addToArrayBefore("colors","green",'orange');
+is_deeply($config->get('colors'), [qw(red orange green blue)], "addToArrayBefore works");
+$config->addToArrayBefore("colors","green",'orange');
+is_deeply($config->get('colors'), [qw(red orange green blue)], "addToArrayBefore doesn't insert duplicate entries");
+$config->addToArrayBefore('colors', 'purple', 'black');
+is_deeply($config->get('colors'), [qw(black red orange green blue)], "addToArrayBefore with item that doesn't exist adds to beginning of array");
+$config->set('colors', [qw(red green blue)]);
+
+# addToArrayAfter
+$config->addToArrayAfter('colors', 'green', 'orange');
+is_deeply($config->get('colors'), [qw(red green orange blue)], "addToArrayAfter works");
+$config->addToArrayAfter('colors', 'green', 'orange');
+is_deeply($config->get('colors'), [qw(red green orange blue)], "addToArrayAfter doesn't insert duplicate entries");
+$config->addToArrayAfter('colors', 'purple', 'black');
+is_deeply($config->get('colors'), [qw(red green orange blue black)], "addToArrayAfter with item that doesn't exist adds to end of array");
+$config->set('colors', [qw(red green blue)]);
+
 # addToHash
 $config->addToHash("stats","TEST","VALUE");
 is($config->get("stats/TEST"), "VALUE", "addToHash()");




More information about the Pkg-perl-cvs-commits mailing list