@@ -1,3 +1,19 @@
+2.054 2014-04-01
+
+ Bug fix release:
+ * Loader Dumper: fix quote handling (Closes Debian 743097)
+ * Loader: return 'ok' after dispatching an action (avoid undef warning
+ during tests)
+ * cme: -save options force a save even if no semantic change was done
+ * ListId: sort may trigger notify_change is elements are actually
+ moved around, so 'cme modify stuff list:.sort' will save the file
+ as expected.
+
+2.053 2014-03-25
+
+ Bug fix release:
+ * Loader: fix broken list leaf assignment (like 'list:4=foo')
+
2.052 2014-03-23
This release provides new functionalities to 'cme modify stuff'
@@ -96,6 +96,6 @@
"web" : "http://github.com/dod38fr/config-model"
}
},
- "version" : "2.052"
+ "version" : "2.054"
}
@@ -67,4 +67,4 @@ resources:
bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=Config-Model
homepage: https://github.com/dod38fr/config-model/wiki
repository: git://github.com/dod38fr/config-model.git
-version: '2.052'
+version: '2.054'
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Annotation;
-$Config::Model::Annotation::VERSION = '2.052';
+$Config::Model::Annotation::VERSION = '2.054';
use Mouse ;
use English ;
@@ -186,7 +186,7 @@ Config::Model::Annotation - Read and write configuration annotations
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::AnyId ;
-$Config::Model::AnyId::VERSION = '2.052';
+$Config::Model::AnyId::VERSION = '2.054';
use Mouse ;
use namespace::autoclean;
@@ -987,7 +987,7 @@ Config::Model::AnyId - Base class for hash or list element
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::AnyThing;
-$Config::Model::AnyThing::VERSION = '2.052';
+$Config::Model::AnyThing::VERSION = '2.054';
use Mouse ;
use namespace::autoclean;
@@ -584,7 +584,7 @@ Config::Model::AnyThing - Base class for configuration tree item
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Backend::Any ;
-$Config::Model::Backend::Any::VERSION = '2.052';
+$Config::Model::Backend::Any::VERSION = '2.054';
use Carp;
use strict;
use warnings ;
@@ -165,7 +165,7 @@ Config::Model::Backend::Any - Virtual class for other backends
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Backend::Fstab ;
-$Config::Model::Backend::Fstab::VERSION = '2.052';
+$Config::Model::Backend::Fstab::VERSION = '2.054';
use Mouse ;
use Carp ;
use Log::Log4perl qw(get_logger :levels);
@@ -162,7 +162,7 @@ Config::Model::Backend::Fstab - Read and write config from fstab file
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Backend::IniFile ;
-$Config::Model::Backend::IniFile::VERSION = '2.052';
+$Config::Model::Backend::IniFile::VERSION = '2.054';
use Carp;
use Mouse ;
use 5.10.0;
@@ -312,7 +312,7 @@ Config::Model::Backend::IniFile - Read and write config as a INI file
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Backend::Json ;
-$Config::Model::Backend::Json::VERSION = '2.052';
+$Config::Model::Backend::Json::VERSION = '2.054';
use Carp;
use strict;
use warnings ;
@@ -94,7 +94,7 @@ Config::Model::Backend::Json - Read and write config as a JSON data structure
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Backend::PlainFile;
-$Config::Model::Backend::PlainFile::VERSION = '2.052';
+$Config::Model::Backend::PlainFile::VERSION = '2.054';
use Carp;
use Mouse;
use Config::Model::Exception;
@@ -189,7 +189,7 @@ Config::Model::Backend::PlainFile - Read and write config as plain file
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Backend::ShellVar ;
-$Config::Model::Backend::ShellVar::VERSION = '2.052';
+$Config::Model::Backend::ShellVar::VERSION = '2.054';
use Carp;
use Mouse ;
use Config::Model::Exception ;
@@ -113,7 +113,7 @@ Config::Model::Backend::ShellVar - Read and write config as a C<SHELLVAR> data s
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -9,7 +9,7 @@
#
package Config::Model::Backend::Yaml ;
-$Config::Model::Backend::Yaml::VERSION = '2.052';
+$Config::Model::Backend::Yaml::VERSION = '2.054';
use Carp;
use strict;
use warnings ;
@@ -95,7 +95,7 @@ Config::Model::Backend::Yaml - Read and write config as a YAML data structure
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::BackendMgr ;
-$Config::Model::BackendMgr::VERSION = '2.052';
+$Config::Model::BackendMgr::VERSION = '2.054';
use Mouse ;
use namespace::autoclean;
@@ -747,7 +747,7 @@ Config::Model::BackendMgr - Load configuration node on demand
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::CheckList ;
-$Config::Model::CheckList::VERSION = '2.052';
+$Config::Model::CheckList::VERSION = '2.054';
use Mouse ;
use 5.010 ;
@@ -727,7 +727,7 @@ Config::Model::CheckList - Handle check list element
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -13,7 +13,7 @@ Config::Model::Cookbook::CreateModelFromDoc - Create a configuration model from
=head1 VERSION
-version 2.052
+version 2.054
=head1 Introduction
@@ -9,7 +9,7 @@
#
package Config::Model::Describe;
-$Config::Model::Describe::VERSION = '2.052';
+$Config::Model::Describe::VERSION = '2.054';
use Carp;
use strict;
use warnings ;
@@ -170,7 +170,7 @@ Config::Model::Describe - Provide a description of a node element
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::DumpAsData;
-$Config::Model::DumpAsData::VERSION = '2.052';
+$Config::Model::DumpAsData::VERSION = '2.054';
use Carp;
use strict;
use warnings ;
@@ -251,7 +251,7 @@ Config::Model::DumpAsData - Dump configuration content as a perl data structure
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Dumper;
-$Config::Model::Dumper::VERSION = '2.052';
+$Config::Model::Dumper::VERSION = '2.054';
use Carp;
use strict;
use warnings ;
@@ -22,9 +22,18 @@ sub new {
}
sub quote {
- my @res = @_ ;
+ _quote(qr/(\s|"|\*)/,@_) ;
+}
+
+sub id_quote {
+ _quote(qr/[\s"\*<>.=#]/,@_) ;
+}
+
+
+sub _quote {
+ my ($re,@res) = @_ ;
foreach (@res) {
- if ( defined $_ and ( /(\s|"|\*)/ or $_ eq '') ) {
+ if ( defined $_ and ( /$re/ or $_ eq '') ) {
s/"/\\"/g ; # escape present quotes
$_ = '"' . $_ . '"' ; # add my quotes
}
@@ -86,7 +95,7 @@ sub dump_tree {
# get value or only customized value
my $value = quote($value_obj->fetch (mode => $fetch_mode, check => $check)) ;
- $index = quote($index) ;
+ $index = id_quote($index) ;
my $pad = $compute_pad->($node);
@@ -106,7 +115,7 @@ sub dump_tree {
# get value or only customized value
my $value = $value_obj->fetch (mode => $fetch_mode, check => $check) ;
my $qvalue = quote($value) ;
- $index = quote($index) ;
+ $index = id_quote($index) ;
my $pad = $compute_pad->($node);
my $name = defined $index ? "$element:$index"
@@ -141,7 +150,7 @@ sub dump_tree {
$$data_r .= "\n$pad$element:$idx#".note_quote($note) if $note ;
}
# skip undef values
- my @val = quote( grep (defined $_,
+ my @val = id_quote( grep (defined $_,
$list_obj->fetch_all_values(mode => $fetch_mode,
check => $check))) ;
$$data_r .= "\n$pad$element:=" . join( ',', @val ) if @val;
@@ -183,7 +192,7 @@ sub dump_tree {
my $node_note = note_quote($contained_node->annotation) ;
if ($type eq 'list' or $type eq 'hash') {
- $head .= ':'.quote($key) ;
+ $head .= ':'.id_quote($key) ;
$head .= '#'.$node_note if $node_note ;
my $sub_data = '';
$scanner->scan_node(\$sub_data, $contained_node);
@@ -242,7 +251,7 @@ Config::Model::Dumper - Serialize data of config tree
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Exception;
-$Config::Model::Exception::VERSION = '2.052';
+$Config::Model::Exception::VERSION = '2.054';
use warnings;
use strict;
use Data::Dumper;
@@ -143,7 +143,7 @@ use Exception::Class (
Config::Model::Exception::Internal->Trace(1);
package Config::Model::Exception::Syntax;
-$Config::Model::Exception::Syntax::VERSION = '2.052';
+$Config::Model::Exception::Syntax::VERSION = '2.054';
sub full_message {
my $self = shift;
@@ -158,7 +158,7 @@ sub full_message {
}
package Config::Model::Exception::Any;
-$Config::Model::Exception::Any::VERSION = '2.052';
+$Config::Model::Exception::Any::VERSION = '2.054';
sub full_message {
my $self = shift;
@@ -188,7 +188,7 @@ sub xpath_message {
}
package Config::Model::Exception::LoadData;
-$Config::Model::Exception::LoadData::VERSION = '2.052';
+$Config::Model::Exception::LoadData::VERSION = '2.054';
sub full_message {
@@ -207,7 +207,7 @@ sub full_message {
}
package Config::Model::Exception::Model;
-$Config::Model::Exception::Model::VERSION = '2.052';
+$Config::Model::Exception::Model::VERSION = '2.054';
sub full_message {
@@ -236,7 +236,7 @@ sub full_message {
}
package Config::Model::Exception::Load;
-$Config::Model::Exception::Load::VERSION = '2.052';
+$Config::Model::Exception::Load::VERSION = '2.054';
sub full_message {
@@ -258,7 +258,7 @@ sub full_message {
}
package Config::Model::Exception::RestrictedElement;
-$Config::Model::Exception::RestrictedElement::VERSION = '2.052';
+$Config::Model::Exception::RestrictedElement::VERSION = '2.054';
sub full_message {
@@ -275,7 +275,7 @@ sub full_message {
}
package Config::Model::Exception::UnavailableElement;
-$Config::Model::Exception::UnavailableElement::VERSION = '2.052';
+$Config::Model::Exception::UnavailableElement::VERSION = '2.054';
sub full_message {
@@ -301,7 +301,7 @@ sub full_message {
}
package Config::Model::Exception::ObsoleteElement;
-$Config::Model::Exception::ObsoleteElement::VERSION = '2.052';
+$Config::Model::Exception::ObsoleteElement::VERSION = '2.054';
sub full_message {
@@ -321,7 +321,7 @@ sub full_message {
}
package Config::Model::Exception::UnknownElement;
-$Config::Model::Exception::UnknownElement::VERSION = '2.052';
+$Config::Model::Exception::UnknownElement::VERSION = '2.054';
use Carp;
@@ -392,7 +392,7 @@ sub full_message {
}
package Config::Model::Exception::UnknownId;
-$Config::Model::Exception::UnknownId::VERSION = '2.052';
+$Config::Model::Exception::UnknownId::VERSION = '2.054';
sub full_message {
@@ -422,7 +422,7 @@ sub full_message {
}
package Config::Model::Exception::WrongType;
-$Config::Model::Exception::WrongType::VERSION = '2.052';
+$Config::Model::Exception::WrongType::VERSION = '2.054';
sub full_message {
@@ -448,7 +448,7 @@ sub full_message {
}
package Config::Model::Exception::ConfigFile::Missing ;
-$Config::Model::Exception::ConfigFile::Missing::VERSION = '2.052';
+$Config::Model::Exception::ConfigFile::Missing::VERSION = '2.054';
sub full_message {
@@ -460,7 +460,7 @@ sub full_message {
}
package Config::Model::Exception::Xml;
-$Config::Model::Exception::Xml::VERSION = '2.052';
+$Config::Model::Exception::Xml::VERSION = '2.054';
sub full_message {
@@ -491,7 +491,7 @@ Config::Model::Exception - Exception mechanism for configuration model
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::FuseUI ;
-$Config::Model::FuseUI::VERSION = '2.052';
+$Config::Model::FuseUI::VERSION = '2.054';
# there's no Singleton with Mouse
use Mouse ;
@@ -317,7 +317,7 @@ Config::Model::FuseUI - Fuse virtual file interface for Config::Model
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::HashId ;
-$Config::Model::HashId::VERSION = '2.052';
+$Config::Model::HashId::VERSION = '2.054';
use Mouse ;
use namespace::autoclean;
@@ -492,7 +492,7 @@ Config::Model::HashId - Handle hash element for configuration model
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::IdElementReference;
-$Config::Model::IdElementReference::VERSION = '2.052';
+$Config::Model::IdElementReference::VERSION = '2.054';
use Mouse;
use namespace::autoclean;
@@ -197,7 +197,7 @@ Config::Model::IdElementReference - Refer to id element(s) and extract keys
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Instance;
-$Config::Model::Instance::VERSION = '2.052';
+$Config::Model::Instance::VERSION = '2.054';
#use Scalar::Util qw(weaken) ;
use 5.10.1;
@@ -493,7 +493,7 @@ Config::Model::Instance - Instance of configuration tree
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Iterator ;
-$Config::Model::Iterator::VERSION = '2.052';
+$Config::Model::Iterator::VERSION = '2.054';
use Carp;
use strict;
use warnings ;
@@ -275,7 +275,7 @@ Config::Model::Iterator - Iterates forward or backward a configuration tree
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::ListId ;
-$Config::Model::ListId::VERSION = '2.052';
+$Config::Model::ListId::VERSION = '2.054';
use 5.10.1;
use Mouse ;
use namespace::autoclean;
@@ -369,17 +369,24 @@ sub sort {
my $self = shift;
$self->_assert_leaf_cargo;
- $self->_sort_data(sub{$_[0]->fetch cmp $_[1]->fetch});
- $self->_reindex;
+ ;
+ $self->_sort_data( sub { $_[0]->fetch cmp $_[1]->fetch; });
+
+ my $has_changed = $self->_reindex;
+ $self->notify_change(note => "sorted") if $has_changed ;
}
sub _reindex {
my $self = shift;
my $i = 0;
+ my $has_changed = 0;
foreach my $o ($self->_all_data) {
- $o->index_value($i++) if defined $o;
+ next unless defined $o;
+ $has_changed =1 if $o->index_value != $i;
+ $o->index_value($i++);
}
+ return $has_changed;
}
sub swap {
@@ -503,7 +510,7 @@ Config::Model::ListId - Handle list element for configuration model
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Lister;
-$Config::Model::Lister::VERSION = '2.052';
+$Config::Model::Lister::VERSION = '2.054';
use strict;
use warnings;
@@ -86,7 +86,7 @@ Config::Model::Lister - List available models and applications
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Loader;
-$Config::Model::Loader::VERSION = '2.052';
+$Config::Model::Loader::VERSION = '2.054';
use Carp;
use strict;
use warnings ;
@@ -130,8 +130,10 @@ sub _split_cmd {
(?: \( ([^)]+) \) ) # capture parameters between braces
| (
/[^/]+/ # regexp
- | $quoted_string
- | [^#=\.<>]+ # non action chars
+ | (?:
+ $quoted_string
+ | [^#=\.<>]+ # non action chars
+ )+
)
)?
)?
@@ -155,7 +157,6 @@ sub _split_cmd {
)?
!gx
) ;
- unquote (@command) ;
return wantarray ? @command : \@command ;
}
@@ -283,6 +284,7 @@ sub _load {
$logger->debug("_load: calling $element_type loader on element $element_name") ;
my $ret = $self->$method($node, $check,$experience, \@instructions,$cmdref) ;
+ die "Internal error: method dispatched for $element_type returned an undefined value " unless defined $ret;
if ($ret eq 'error' or $ret eq 'done') {
$logger->debug("_load return: $node_name got $ret");
@@ -301,6 +303,8 @@ sub _load {
sub _load_note {
my ( $self, $target_obj, $note, $instructions, $cmdref) = @_;
+ unquote($note);
+
# apply note on target object
if ( defined $note ) {
if ( defined $target_obj ) {
@@ -489,7 +493,8 @@ sub _load_list {
return 'ok';
}
- if (defined $subaction and $subaction eq '=' and $cargo_type eq 'leaf' ) {
+ # compat mode for list=a,b,c,d commands
+ if (not defined $action and defined $subaction and $subaction eq '=' and $cargo_type eq 'leaf' ) {
$logger->debug("_load_list: set whole list with '=' subaction'" );
# valid for check_list or list
$logger->info("Setting $elt_type element ",$element->name, " with '$value'");
@@ -498,13 +503,16 @@ sub _load_list {
return 'ok';
}
+ unquote($id,$value,$note);
+
if (defined $action) {
my $dispatch
= $dispatch_action{'list_'.$cargo_type}{$action}
|| $dispatch_action{$cargo_type}{$action}
|| $dispatch_action{'fallback'}{$action};
if ($dispatch) {
- return $dispatch->($self,$element,$check, $inst, @f_args) ;
+ $dispatch->($self,$element,$check, $inst, @f_args) ;
+ return 'ok';
}
}
@@ -518,6 +526,7 @@ sub _load_list {
}
if (defined $action and $action eq ':') {
+ unquote($id);
my $obj = $element->fetch_with_id(index => $id, check => $check) ;
$self->_load_note($obj, $note, $inst, $cmdref);
@@ -553,6 +562,8 @@ sub _load_hash {
my ($self,$node,$check,$experience,$inst,$cmdref) = @_ ;
my ($element_name,$action,$f_arg,$id,$subaction,$value,$note) = @$inst ;
+ unquote($id,$value,$note);
+
my $element = $node -> fetch_element(name => $element_name, check => $check ) ;
my $cargo_type = $element->cargo_type ;
@@ -572,7 +583,7 @@ sub _load_hash {
if ($action eq ':~') {
my @keys = $element->fetch_all_indexes;
- my $ret ;
+ my $ret = 'ok';
$logger->debug("_load_hash: looping with regex $id on keys @keys");
$id =~ s!^/!!;
$id =~ s!/$!! ;
@@ -609,7 +620,8 @@ sub _load_hash {
|| $dispatch_action{$cargo_type}{$action}
|| $dispatch_action{'fallback'}{$action};
if ($dispatch) {
- return $dispatch->($self,$element,$check,$inst,$id) ;
+ $dispatch->($self,$element,$check,$inst,$id) ;
+ return 'ok';
}
}
@@ -653,6 +665,8 @@ sub _load_leaf {
my ($self,$node,$check,$experience,$inst,$cmdref) = @_ ;
my ($element_name,$action,$f_arg,$id,$subaction,$value,$note) = @$inst ;
+ unquote($id,$value);
+
my $element = $node -> fetch_element(name => $element_name, check => $check) ;
$self->_load_note($element, $note, $inst, $cmdref);
@@ -729,7 +743,7 @@ Config::Model::Loader - Load serialized data into config tree
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -13,7 +13,7 @@ Config::Model::Manual::ModelCreationAdvanced - Creating a model with advanced fe
=head1 VERSION
-version 2.052
+version 2.054
=head1 Introduction
@@ -13,7 +13,7 @@ Config::Model::Manual::ModelCreationIntroduction - Introduction to model creatio
=head1 VERSION
-version 2.052
+version 2.054
=head1 Introduction
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Node;
-$Config::Model::Node::VERSION = '2.052';
+$Config::Model::Node::VERSION = '2.054';
use Mouse ;
use namespace::autoclean;
@@ -1254,7 +1254,7 @@ Config::Model::Node - Class for configuration tree node
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::ObjTreeScanner ;
-$Config::Model::ObjTreeScanner::VERSION = '2.052';
+$Config::Model::ObjTreeScanner::VERSION = '2.054';
use strict ;
use Config::Model::Exception ;
use Scalar::Util qw/blessed/ ;
@@ -307,7 +307,7 @@ Config::Model::ObjTreeScanner - Scan config tree and perform call-backs for each
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Report;
-$Config::Model::Report::VERSION = '2.052';
+$Config::Model::Report::VERSION = '2.054';
use Carp;
use strict;
use warnings ;
@@ -94,7 +94,7 @@ Config::Model::Report - Reports data from config tree
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::SearchElement;
-$Config::Model::SearchElement::VERSION = '2.052';
+$Config::Model::SearchElement::VERSION = '2.054';
use Log::Log4perl qw(get_logger :levels);
use Carp;
use strict;
@@ -351,7 +351,7 @@ Config::Model::SearchElement - Search an element in a configuration model
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::SimpleUI ;
-$Config::Model::SimpleUI::VERSION = '2.052';
+$Config::Model::SimpleUI::VERSION = '2.054';
use Carp;
use strict ;
use warnings ;
@@ -280,7 +280,7 @@ Config::Model::SimpleUI - Simple interface for Config::Model
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::TermUI ;
-$Config::Model::TermUI::VERSION = '2.052';
+$Config::Model::TermUI::VERSION = '2.054';
use Carp;
use strict ;
use warnings ;
@@ -225,7 +225,7 @@ Config::Model::TermUI - Provides Config::Model UI with Term::ReadLine
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::TreeSearcher ;
-$Config::Model::TreeSearcher::VERSION = '2.052';
+$Config::Model::TreeSearcher::VERSION = '2.054';
use Mouse ;
use Mouse::Util::TypeConstraints;
use namespace::autoclean;
@@ -148,7 +148,7 @@ Config::Model::TreeSearcher - Search tree for match in value, description...
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Value::LayeredInclude;
-$Config::Model::Value::LayeredInclude::VERSION = '2.052';
+$Config::Model::Value::LayeredInclude::VERSION = '2.054';
use 5.010;
use strict;
@@ -109,7 +109,7 @@ Config::Model::Value::LayeredInclude - Include a sub layer configuration
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Value ;
-$Config::Model::Value::VERSION = '2.052';
+$Config::Model::Value::VERSION = '2.054';
use 5.10.1 ;
use Mouse;
@@ -1911,7 +1911,7 @@ Config::Model::Value - Strongly typed configuration value
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::ValueComputer ;
-$Config::Model::ValueComputer::VERSION = '2.052';
+$Config::Model::ValueComputer::VERSION = '2.054';
use Mouse ;
use MouseX::StrictConstructor;
use namespace::autoclean;
@@ -583,7 +583,7 @@ Config::Model::ValueComputer - Provides configuration value computation
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::WarpedNode ;
-$Config::Model::WarpedNode::VERSION = '2.052';
+$Config::Model::WarpedNode::VERSION = '2.054';
use Mouse ;
use Carp qw(cluck croak);
@@ -313,7 +313,7 @@ Config::Model::WarpedNode - Node that change config class properties
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Warper ;
-$Config::Model::Warper::VERSION = '2.052';
+$Config::Model::Warper::VERSION = '2.054';
use Mouse ;
use namespace::autoclean;
@@ -601,7 +601,7 @@ Config::Model::Warper - Warp tree properties
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model;
-$Config::Model::VERSION = '2.052';
+$Config::Model::VERSION = '2.054';
use Mouse ;
use namespace::autoclean;
use Mouse::Util::TypeConstraints;
@@ -1563,7 +1563,7 @@ Config::Model - Create tools to validate, migrate and edit configuration files
=head1 VERSION
-version 2.052
+version 2.054
=head1 SYNOPSIS
@@ -57,7 +57,7 @@ my $dumptype;
my $load;
my @fix_from;
my $fix_filter ;
-my $request_save = 0;
+my $force_save = 0;
my $open_item = '';
my $fuse_dir;
my $fuse_debug = 0;
@@ -109,7 +109,7 @@ my @global_options = (
"backend=s" => \$backend,
"stack-trace|trace!" => \$trace,
"backup:s" => \$backup,
- "save!" => \$request_save,
+ "save!" => \$force_save,
"strict!" => \$strict,
);
@@ -231,6 +231,7 @@ my $inst = $model->instance(
);
my $root = $inst->config_root;
+my $request_save = 0;
if ( $command eq 'dump' ) {
my $dump_string = $root->dump_tree( mode => $dumptype || 'custom' );
@@ -435,7 +436,7 @@ if ($request_save) {
$inst->say_changes;
# if load was forced, must write back to clean up errors (even if they are not changes
# at semantic level, i.e. removed unnecessary stuff)
- $inst->write_back(force => $force_load) ;
+ $inst->write_back(force => $force_load || $force_save) ;
}
my $ouch = $inst->has_warning ;
@@ -413,8 +413,12 @@ $pl->clear ;
# test sort
@set = qw/j h g f/ ;
$pl->store_set(@set);
+$inst->clear_changes ;
$pl->sort;
eq_or_diff( [ $pl->fetch_all_values ], [sort @set] ,"check sort result");
+is($inst->c_count, 1, "check that sort has triggered a change") ;
+$pl->sort;
+is($inst->c_count, 1, "check that redundant sort has not triggered a change") ;
# test unshift
@set = qw/j h g f/ ;
@@ -107,7 +107,7 @@
cargo_type => 'node',
config_class_name => 'SlaveZ' ,
},
- [qw/lista listb/] => { type => 'list',
+ [qw/lista listb listc/] => { type => 'list',
cargo_type => 'leaf',
cargo_args => {value_type => 'string'},
},
@@ -162,6 +162,9 @@
a_string => { type => 'leaf',
value_type => 'string'
},
+ a_string2 => { type => 'leaf',
+ value_type => 'string'
+ },
another_string => { type => 'leaf',
mandatory => 1 ,
value_type => 'string'
@@ -1,8 +1,9 @@
# -*- cperl -*-
use ExtUtils::testlib;
-use Test::More tests => 22;
+use Test::More;
use Test::Memory::Cycle;
+use Test::Differences;
use Config::Model;
use warnings;
@@ -45,23 +46,23 @@ ok( $root->load( step => $step, experience => 'advanced' ),
$inst->preset_stop ;
$step = 'std_id:ab X=Bv - std_id:bc X=Av - std_id:"b d " X=Av '
- .'- a_string="toto \"titi\" tata" another_string="foobar" '
- .'lista:=a,b,c,d olist:0 X=Av - olist:1 X=Bv - listb:=b,"c c2",d '
+ .'- a_string="toto \"titi\" tata" another_string="foobar" a_string2=dod@foo.com '
+ .'lista:=a,b,c,d olist:0 X=Av - olist:1 X=Bv - listb:=b,"c c2",d listc:="dod@foo.com" '
. '! hash_a:X2=x hash_a:Y2=xy hash_b:X3=xy my_check_list=X2,X3' ;
ok( $root->load( step => $step, experience => 'advanced' ),
"set up data in tree");
-is_deeply([ sort $root->fetch_element('std_id')->fetch_all_indexes ],
+eq_or_diff([ sort $root->fetch_element('std_id')->fetch_all_indexes ],
['ab','b d ','bc'], "check std_id keys" ) ;
-is_deeply([ sort $root->fetch_element('lista')->fetch_all_values(mode => 'custom') ],
+eq_or_diff([ sort $root->fetch_element('lista')->fetch_all_values(mode => 'custom') ],
[qw/c d/], "check lista custom values" ) ;
my $cds = $root->dump_tree;
print "cds string:\n$cds" if $trace ;
-my $expect = <<'EOF' ;
+my $orig_expect = <<'EOF' ;
std_id:ab -
std_id:"b d "
X=Av -
@@ -69,6 +70,7 @@ std_id:bc
X=Av -
lista:=c,d
listb:="c c2",d
+listc:="dod@foo.com"
hash_a:X2=x
hash_a:Y2=xy
hash_b:X3=xy
@@ -77,18 +79,19 @@ olist:0
olist:1
X=Bv -
a_string="toto \"titi\" tata"
+a_string2=dod@foo.com
another_string=foobar
my_check_list=X2,X3 -
EOF
$cds =~ s/\s+\n/\n/g;
-is_deeply( [split /\n/,$cds], [split /\n/,$expect],
+eq_or_diff( [split /\n/,$cds], [split /\n/,$orig_expect],
"check dump of only customized values ") ;
$cds = $root->dump_tree( full_dump => 1 );
print "cds string:\n$cds" if $trace ;
-$expect = <<'EOF' ;
+my $expect = <<'EOF' ;
std_id:ab
X=Bv
DX=Dv -
@@ -100,6 +103,7 @@ std_id:bc
DX=Dv -
lista:=a,b,c,d
listb:=b,"c c2",d
+listc:="dod@foo.com"
hash_a:X2=x
hash_a:Y2=xy
hash_b:X3=xy
@@ -112,13 +116,14 @@ olist:1
string_with_def="yada yada"
a_uniline="yada yada"
a_string="toto \"titi\" tata"
+a_string2=dod@foo.com
another_string=foobar
int_v=10
my_check_list=X2,X3 -
EOF
$cds =~ s/\s+\n/\n/g;
-is_deeply( [split /\n/,$cds], [split /\n/,$expect],
+eq_or_diff( [split /\n/,$cds], [split /\n/,$expect],
"check dump of all values ") ;
my $listb = $root->fetch_element('listb');
@@ -138,6 +143,7 @@ std_id:bc
X=Av
DX=Dv -
lista:=a,b,c,d
+listc:="dod@foo.com"
hash_a:X2=x
hash_a:Y2=xy
hash_b:X3=xy
@@ -150,13 +156,14 @@ olist:1
string_with_def="yada yada"
a_uniline="yada yada"
a_string="toto \"titi\" tata"
+a_string2=dod@foo.com
another_string=foobar
int_v=10
my_check_list=X2,X3 -
EOF
$cds =~ s/\s+\n/\n/g;
-is_deeply( [split /\n/,$cds], [split /\n/,$expect],
+eq_or_diff( [split /\n/,$cds], [split /\n/,$expect],
"check dump of all values after listb is cleared") ;
@@ -176,6 +183,7 @@ std_id:bc
X=Av
DX=Dv -
lista:=a,b,c,d
+listc:="dod@foo.com"
hash_a:X2=x
hash_a:Y2=xy
hash_b:X3=xy
@@ -188,6 +196,7 @@ olist:1
string_with_def="yada yada"
a_uniline="yada yada"
a_string=""
+a_string2=dod@foo.com
another_string=foobar
int_v=10
my_check_list=X2,X3 -
@@ -197,7 +206,7 @@ $cds = $root->dump_tree( full_dump => 1 );
print "cds string:\n$cds" if $trace ;
$cds =~ s/\s+\n/\n/g;
-is_deeply( [split /\n/,$cds], [split /\n/,$expect],
+eq_or_diff( [split /\n/,$cds], [split /\n/,$expect],
"check dump of all values after a_string is set to ''") ;
# check preset values
@@ -216,7 +225,7 @@ olist:1 - -
EOF
$cds =~ s/\s+\n/\n/g;
-is_deeply( [split /\n/,$cds], [split /\n/,$expect],
+eq_or_diff( [split /\n/,$cds], [split /\n/,$expect],
"check dump of all preset values") ;
# shake warp stuff
@@ -237,6 +246,17 @@ print "Empty listb dump:\n$cds" if $trace ;
unlike($cds,qr/listb/,"check that listb containing undef values is not shown") ;
+# reload test
+
+my $reload_root = $model->instance (root_class_name => 'Master',
+ instance_name => 'reload_test') -> config_root ;
+
+$reload_root->load($orig_expect);
+my $reloaded_dump = $reload_root -> dump_tree;
+eq_or_diff( [split /\n/,$reloaded_dump], [split /\n/,$orig_expect],
+ "check dump of tree load with dump result") ;
+
+
# annotation tests
my $root2 = $model->instance (root_class_name => 'Master',
@@ -275,4 +295,8 @@ my $cds2 = $root3->dump_tree( full_dump => 1 );
print "Dump second instance with annotations:\n$cds2" if $trace ;
is($cds2,$cds,"check both dumps") ;
-memory_cycle_ok($model);
+
+
+memory_cycle_ok($model,"memory cycles");
+
+done_testing;
\ No newline at end of file
@@ -51,30 +51,33 @@ my @regexp_test
# string elt_name op (param) id op val note
[ 'a' , ['a', 'x' , 'x', 'x' ,'x' , 'x' , 'x' ]],
[ '#C' , ['x', 'x' , 'x', 'x' ,'x' , 'x' , 'C' ]],
- [ '#"m C"' , ['x', 'x' , 'x', 'x' ,'x' , 'x' , 'm C']],
+ [ '#"m C"' , ['x', 'x' , 'x', 'x' ,'x' , 'x' , '"m C"']],
[ 'a=b' , ['a', 'x' , 'x', 'x' ,'=' , 'b' , 'x' ]],
[ 'a-z=b' , ['a-z','x' , 'x', 'x' ,'=' , 'b' , 'x' ]],
[ "a=\x{263A}" , ['a', 'x' , 'x', 'x' ,'=' , "\x{263A}" , 'x' ]], # utf8 smiley
[ 'a.=b' , ['a', 'x' , 'x', 'x' ,'.=','b' , 'x' ]],
[ "a.=\x{263A}" , ['a', 'x' , 'x', 'x' ,'.=', "\x{263A}" , 'x' ]], # utf8 smiley
- [ 'a="b=c"' , ['a', 'x' , 'x', 'x' ,'=' , 'b=c' , 'x' ]],
- [ 'a="b=\"c\""' , ['a', 'x' , 'x', 'x' ,'=' , 'b="c"' , 'x' ]],
+ [ 'a="b=c"' , ['a', 'x' , 'x', 'x' ,'=' , '"b=c"' , 'x' ]],
+ [ 'a="b=\"c\""' , ['a', 'x' , 'x', 'x' ,'=' , '"b=\"c\""' , 'x' ]],
[ 'a=~/a/A/' , ['a', 'x' , 'x', 'x' ,'=~', '/a/A/' , 'x' ]], # subst on value
[ 'a=b#B' , ['a', 'x' , 'x', 'x' ,'=' , 'b' , 'B' ]],
[ 'a#B' , ['a', 'x' , 'x', 'x' ,'x' , 'x' , 'B' ]],
- [ 'a#"b=c"' , ['a', 'x' , 'x', 'x' ,'x' , 'x' , 'b=c']],
+ [ 'a#"b=c"' , ['a', 'x' , 'x', 'x' ,'x' , 'x' , '"b=c"']],
[ 'a:b=c' , ['a', ':' , 'x', 'b' ,'=' , 'c' , 'x' ]], # fetch and assign elt
- [ 'a:"b\""="\"c"' , ['a', ':' , 'x', 'b"' ,'=' ,'"c' , 'x' ]], # fetch and assign elt qith quotes
+ [ 'a:"b\""="\"c"' , ['a', ':' , 'x', '"b\""' ,'=' ,'"\"c"' , 'x' ]], # fetch and assign elt qith quotes
[ 'a:~/b.*/' , ['a', ':~', 'x','/b.*/' ,'x' , 'x' , 'x' ]], # loop on matched value
- [ 'a:~/b.*/.="\"a"' , ['a', ':~', 'x','/b.*/' ,'.=','"a' , 'x' ]], # loop on matched value and append
+ [ 'a:~/b.*/.="\"a"' , ['a', ':~', 'x','/b.*/' ,'.=','"\"a"' , 'x' ]], # loop on matched value and append
[ 'a:~/^\w+$/' , ['a', ':~', 'x','/^\w+$/','x','x' , 'x' ]], # loop on matched value
+ [ 'a:="dod@foo.com"' , ['a', ':=' , 'x','"dod@foo.com"','x','x', 'x' ]], # set list
[ 'a:=b,c,d' , ['a', ':=' , 'x','b,c,d', 'x' , 'x', 'x' ]], # set list
[ 'a=b,c,d' , ['a', 'x' , 'x', 'x', '=', 'b,c,d', 'x' ]], # set list old style
[ 'm:=a,"a b "' , ['m', ':=' , 'x','a,"a b "','x','x' , 'x' ]], # set list with quotes
+ [ 'm:="a b ",c' , ['m', ':=' , 'x','"a b ",c','x','x' , 'x' ]], # set list with quotes
+ [ 'm:="a b","c d"' , ['m', ':=' , 'x','"a b","c d"','x','x' , 'x' ]], # set list with quotes
[ 'm=a,"a b "' , ['m', 'x' , 'x', 'x', '=', 'a,"a b "' ,'x' ]], # set list with quotes, old style
[ 'a:b#C' , ['a', ':' , 'x', 'b' ,'x' , 'x' , 'C' ]], # fetch elt and add comment
- [ 'a:"b\""#"\"c"' , ['a', ':' , 'x', 'b"' ,'x' , 'x' ,'"c' ]], # fetch elt and add comment with quotes
+ [ 'a:"b\""#"\"c"' , ['a', ':' , 'x', '"b\""','x' , 'x' ,'"\"c"' ]], # fetch elt and add comment with quotes
[ 'a:b=c#C' , ['a', ':' , 'x', 'b' ,'=' , 'c' , 'C' ]], # fetch and assign elt and add comment
[ 'a:-' , ['a', ':-', 'x', 'x' ,'x' , 'x' , 'x' ]], # empty list
[ 'a:-b' , ['a', ':-', 'x', 'b' ,'x' , 'x' , 'x' ]], # remove id b
@@ -180,11 +183,11 @@ $step = 'std_id:ab ZZX=Bv - std_id:bc X=Bv';
throws_ok {$root->load( step => $step, experience => 'advanced' );}
"Config::Model::Exception::UnknownElement", "load wrong '$step'";
-$step = 'lista:=a,b,c,d olist:0 X=Av - olist:1 X=Bv - listb:=b,c,d,,f,"",h,0';
+$step = 'lista:=a,b,c,d lista:4=e olist:0 X=Av - olist:1 X=Bv - listb:=b,c,d,,f,"",h,0';
throws_ok { $root->load( step => $step, experience => 'advanced');}
qr/comma/, "load wrong '$step'";
-$step = 'listb:=b,c,d,f,"",h,0';
+$step = 'listb:=b,c,d,f,"",h,0 listc:="dod@foo.com"';
ok ( $root->load( step => $step, experience => 'advanced'),
"load '$step'");
@@ -209,7 +212,7 @@ is($olist->fetch_with_id(0)->fetch_element('X')->fetch, 'Av',
is($olist->fetch_with_id(1)->fetch_element('X')->fetch, 'Bv',
"check list element 1 content") ;
-my @expect = qw/a b c d/;
+my @expect = qw/a b c d e/;
map {
is($lista->fetch_with_id($_)->fetch, $expect[$_],
"check lista element $_ content") ;