[libconfig-model-perl] 01/05: Imported Upstream version 2.059
dod at debian.org
dod at debian.org
Mon Jun 30 12:17:46 UTC 2014
This is an automated email from the git hooks/post-receive script.
dod pushed a commit to branch master
in repository libconfig-model-perl.
commit cacc9cc15bdb13fac9631d28b26e800db095326e
Author: Dominique Dumont <dod at debian.org>
Date: Mon Jun 30 13:10:40 2014 +0200
Imported Upstream version 2.059
---
Changes | 22 ++
META.json | 2 +-
META.yml | 2 +-
contrib/bash_completion.cme | 2 +-
lib/Config/Model.pm | 4 +-
lib/Config/Model/Annotation.pm | 4 +-
lib/Config/Model/AnyId.pm | 4 +-
lib/Config/Model/AnyThing.pm | 4 +-
lib/Config/Model/Backend/Any.pm | 4 +-
lib/Config/Model/Backend/Fstab.pm | 4 +-
lib/Config/Model/Backend/IniFile.pm | 4 +-
lib/Config/Model/Backend/Json.pm | 4 +-
lib/Config/Model/Backend/PlainFile.pm | 4 +-
lib/Config/Model/Backend/ShellVar.pm | 4 +-
lib/Config/Model/Backend/Yaml.pm | 6 +-
lib/Config/Model/BackendMgr.pm | 4 +-
lib/Config/Model/CheckList.pm | 4 +-
lib/Config/Model/Cookbook/CreateModelFromDoc.pod | 2 +-
lib/Config/Model/Describe.pm | 22 +-
lib/Config/Model/DumpAsData.pm | 4 +-
lib/Config/Model/Dumper.pm | 4 +-
lib/Config/Model/Exception.pm | 28 +--
lib/Config/Model/FuseUI.pm | 4 +-
lib/Config/Model/HashId.pm | 32 ++-
lib/Config/Model/IdElementReference.pm | 4 +-
lib/Config/Model/Instance.pm | 4 +-
lib/Config/Model/Iterator.pm | 4 +-
lib/Config/Model/ListId.pm | 4 +-
lib/Config/Model/Lister.pm | 4 +-
lib/Config/Model/Loader.pm | 10 +-
lib/Config/Model/Manual/ModelCreationAdvanced.pod | 2 +-
.../Model/Manual/ModelCreationIntroduction.pod | 2 +-
lib/Config/Model/Node.pm | 4 +-
lib/Config/Model/ObjTreeScanner.pm | 6 +-
lib/Config/Model/Report.pm | 4 +-
lib/Config/Model/SearchElement.pm | 4 +-
lib/Config/Model/SimpleUI.pm | 34 ++-
lib/Config/Model/TermUI.pm | 62 ++---
lib/Config/Model/TreeSearcher.pm | 4 +-
lib/Config/Model/Value.pm | 257 +++++++++++----------
lib/Config/Model/Value/LayeredInclude.pm | 4 +-
lib/Config/Model/ValueComputer.pm | 4 +-
lib/Config/Model/WarpedNode.pm | 4 +-
lib/Config/Model/Warper.pm | 4 +-
script/cme | 36 ++-
t/describe_node.t | 20 +-
t/load.t | 7 +
t/simple_ui.t | 21 +-
t/term_ui.t | 16 +-
t/value.t | 19 ++
t/value_compute.t | 33 ++-
t/yaml_backend.t | 2 +-
52 files changed, 459 insertions(+), 298 deletions(-)
diff --git a/Changes b/Changes
index 3193f6b..d189196 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,25 @@
+2.059 2014-06-29
+
+ New features:
+
+ * cme:
+ + added shell command as a shortcut to 'cme edit -ui shell'.
+ E.g 'cme shell ssh' to edit ssh_config through a shell like UI
+ + add :@ and :.sort sub command for ordered hash.
+ E.g.: "cme modify dpkg-control ~~ 'binary:~/.*/ Depends:.sort' -save"
+ or "cme modify dpkg-copyright ~~ 'Files:.sort' -save "
+ * Config::Model::Value: added warn_if parameter
+
+ Bug fixes:
+
+ * cme shell mode:
+ * fix or add completion for several commands
+ * added shell style pattern match to ll and ls command (e.g 'ls foo*')
+ * remove version req from use YAML::Any 0.303 (resolve issues with
+ Debian FTBS)
+ * Value: fix crash when default value raises a warning and code fix
+ returns undef.
+
2.058 2014-06-19
Bug fix release
diff --git a/META.json b/META.json
index 23b48d9..e390d55 100644
--- a/META.json
+++ b/META.json
@@ -91,6 +91,6 @@
"web" : "http://github.com/dod38fr/config-model"
}
},
- "version" : "2.058"
+ "version" : "2.059"
}
diff --git a/META.yml b/META.yml
index 0505a41..be22b7c 100644
--- a/META.yml
+++ b/META.yml
@@ -62,4 +62,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.058'
+version: '2.059'
diff --git a/contrib/bash_completion.cme b/contrib/bash_completion.cme
index 95274d3..07e460b 100644
--- a/contrib/bash_completion.cme
+++ b/contrib/bash_completion.cme
@@ -24,7 +24,7 @@ _cme_appli()
_cme_commands()
{
- COMPREPLY=( $( compgen -W 'list check migrate fix modify search edit dump fusefs' -- $cur ) )
+ COMPREPLY=( $( compgen -W 'list check migrate fix modify search edit shell dump fusefs' -- $cur ) )
}
_cme_handle_app_arg()
diff --git a/lib/Config/Model.pm b/lib/Config/Model.pm
index 5c2a818..8737d41 100644
--- a/lib/Config/Model.pm
+++ b/lib/Config/Model.pm
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model;
-$Config::Model::VERSION = '2.058';
+$Config::Model::VERSION = '2.059';
use Mouse;
use Mouse::Util::TypeConstraints;
use MouseX::StrictConstructor;
@@ -1514,7 +1514,7 @@ Config::Model - Create tools to validate, migrate and edit configuration files
=head1 VERSION
-version 2.058
+version 2.059
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Annotation.pm b/lib/Config/Model/Annotation.pm
index 7a2dd64..cc029bd 100644
--- a/lib/Config/Model/Annotation.pm
+++ b/lib/Config/Model/Annotation.pm
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Annotation;
-$Config::Model::Annotation::VERSION = '2.058';
+$Config::Model::Annotation::VERSION = '2.059';
use Mouse;
use English;
@@ -183,7 +183,7 @@ Config::Model::Annotation - Read and write configuration annotations
=head1 VERSION
-version 2.058
+version 2.059
=head1 SYNOPSIS
diff --git a/lib/Config/Model/AnyId.pm b/lib/Config/Model/AnyId.pm
index 782b56e..672b66e 100644
--- a/lib/Config/Model/AnyId.pm
+++ b/lib/Config/Model/AnyId.pm
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::AnyId;
-$Config::Model::AnyId::VERSION = '2.058';
+$Config::Model::AnyId::VERSION = '2.059';
use Mouse;
use Config::Model::Exception;
@@ -919,7 +919,7 @@ Config::Model::AnyId - Base class for hash or list element
=head1 VERSION
-version 2.058
+version 2.059
=head1 SYNOPSIS
diff --git a/lib/Config/Model/AnyThing.pm b/lib/Config/Model/AnyThing.pm
index 8bb299c..24b8469 100644
--- a/lib/Config/Model/AnyThing.pm
+++ b/lib/Config/Model/AnyThing.pm
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::AnyThing;
-$Config::Model::AnyThing::VERSION = '2.058';
+$Config::Model::AnyThing::VERSION = '2.059';
use Mouse;
# FIXME: must cleanup warp mechanism to implement this
@@ -627,7 +627,7 @@ Config::Model::AnyThing - Base class for configuration tree item
=head1 VERSION
-version 2.058
+version 2.059
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Backend/Any.pm b/lib/Config/Model/Backend/Any.pm
index e81aea5..f7bda93 100644
--- a/lib/Config/Model/Backend/Any.pm
+++ b/lib/Config/Model/Backend/Any.pm
@@ -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.058';
+$Config::Model::Backend::Any::VERSION = '2.059';
use Carp;
use strict;
use warnings;
@@ -170,7 +170,7 @@ Config::Model::Backend::Any - Virtual class for other backends
=head1 VERSION
-version 2.058
+version 2.059
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Backend/Fstab.pm b/lib/Config/Model/Backend/Fstab.pm
index 08229d9..75ed691 100644
--- a/lib/Config/Model/Backend/Fstab.pm
+++ b/lib/Config/Model/Backend/Fstab.pm
@@ -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.058';
+$Config::Model::Backend::Fstab::VERSION = '2.059';
use Mouse;
use Carp;
use Log::Log4perl qw(get_logger :levels);
@@ -164,7 +164,7 @@ Config::Model::Backend::Fstab - Read and write config from fstab file
=head1 VERSION
-version 2.058
+version 2.059
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Backend/IniFile.pm b/lib/Config/Model/Backend/IniFile.pm
index d48ee11..2c00dcb 100644
--- a/lib/Config/Model/Backend/IniFile.pm
+++ b/lib/Config/Model/Backend/IniFile.pm
@@ -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.058';
+$Config::Model::Backend::IniFile::VERSION = '2.059';
use Carp;
use Mouse;
use 5.10.0;
@@ -319,7 +319,7 @@ Config::Model::Backend::IniFile - Read and write config as a INI file
=head1 VERSION
-version 2.058
+version 2.059
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Backend/Json.pm b/lib/Config/Model/Backend/Json.pm
index e2a4042..757ee24 100644
--- a/lib/Config/Model/Backend/Json.pm
+++ b/lib/Config/Model/Backend/Json.pm
@@ -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.058';
+$Config::Model::Backend::Json::VERSION = '2.059';
use Carp;
use strict;
use warnings;
@@ -93,7 +93,7 @@ Config::Model::Backend::Json - Read and write config as a JSON data structure
=head1 VERSION
-version 2.058
+version 2.059
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Backend/PlainFile.pm b/lib/Config/Model/Backend/PlainFile.pm
index 2592c5f..c119a3e 100644
--- a/lib/Config/Model/Backend/PlainFile.pm
+++ b/lib/Config/Model/Backend/PlainFile.pm
@@ -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.058';
+$Config::Model::Backend::PlainFile::VERSION = '2.059';
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.058
+version 2.059
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Backend/ShellVar.pm b/lib/Config/Model/Backend/ShellVar.pm
index a233923..544578a 100644
--- a/lib/Config/Model/Backend/ShellVar.pm
+++ b/lib/Config/Model/Backend/ShellVar.pm
@@ -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.058';
+$Config::Model::Backend::ShellVar::VERSION = '2.059';
use Carp;
use Mouse;
use Config::Model::Exception;
@@ -114,7 +114,7 @@ Config::Model::Backend::ShellVar - Read and write config as a C<SHELLVAR> data s
=head1 VERSION
-version 2.058
+version 2.059
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Backend/Yaml.pm b/lib/Config/Model/Backend/Yaml.pm
index d9f4711..cbd1ad5 100644
--- a/lib/Config/Model/Backend/Yaml.pm
+++ b/lib/Config/Model/Backend/Yaml.pm
@@ -9,7 +9,7 @@
#
package Config::Model::Backend::Yaml;
-$Config::Model::Backend::Yaml::VERSION = '2.058';
+$Config::Model::Backend::Yaml::VERSION = '2.059';
use Carp;
use strict;
use warnings;
@@ -18,7 +18,7 @@ use File::Path;
use Log::Log4perl qw(get_logger :levels);
use base qw/Config::Model::Backend::Any/;
-use YAML::Any 0.303;
+use YAML::Any;
my $logger = get_logger("Backend::Yaml");
@@ -94,7 +94,7 @@ Config::Model::Backend::Yaml - Read and write config as a YAML data structure
=head1 VERSION
-version 2.058
+version 2.059
=head1 SYNOPSIS
diff --git a/lib/Config/Model/BackendMgr.pm b/lib/Config/Model/BackendMgr.pm
index e0bdaf9..b09c78c 100644
--- a/lib/Config/Model/BackendMgr.pm
+++ b/lib/Config/Model/BackendMgr.pm
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::BackendMgr;
-$Config::Model::BackendMgr::VERSION = '2.058';
+$Config::Model::BackendMgr::VERSION = '2.059';
use Mouse;
use Carp;
@@ -768,7 +768,7 @@ Config::Model::BackendMgr - Load configuration node on demand
=head1 VERSION
-version 2.058
+version 2.059
=head1 SYNOPSIS
diff --git a/lib/Config/Model/CheckList.pm b/lib/Config/Model/CheckList.pm
index b0f8d48..f7ff13b 100644
--- a/lib/Config/Model/CheckList.pm
+++ b/lib/Config/Model/CheckList.pm
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::CheckList;
-$Config::Model::CheckList::VERSION = '2.058';
+$Config::Model::CheckList::VERSION = '2.059';
use Mouse;
use 5.010;
@@ -701,7 +701,7 @@ Config::Model::CheckList - Handle check list element
=head1 VERSION
-version 2.058
+version 2.059
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Cookbook/CreateModelFromDoc.pod b/lib/Config/Model/Cookbook/CreateModelFromDoc.pod
index b352fe2..f0fee96 100644
--- a/lib/Config/Model/Cookbook/CreateModelFromDoc.pod
+++ b/lib/Config/Model/Cookbook/CreateModelFromDoc.pod
@@ -13,7 +13,7 @@ Config::Model::Cookbook::CreateModelFromDoc - Create a configuration model from
=head1 VERSION
-version 2.058
+version 2.059
=head1 Introduction
diff --git a/lib/Config/Model/Describe.pm b/lib/Config/Model/Describe.pm
index 6de6e59..1118f3b 100644
--- a/lib/Config/Model/Describe.pm
+++ b/lib/Config/Model/Describe.pm
@@ -9,7 +9,7 @@
#
package Config::Model::Describe;
-$Config::Model::Describe::VERSION = '2.058';
+$Config::Model::Describe::VERSION = '2.059';
use Carp;
use strict;
use warnings;
@@ -27,9 +27,18 @@ sub describe {
my %args = @_;
my $desc_node = delete $args{node}
|| croak "describe: missing 'node' parameter";
- my $element = delete $args{element}; # optional
my $check = delete $args{check} || 'yes';
+ my $element = delete $args{element} ; # optional
+ my $pattern = delete $args{pattern} ; # optional
+
+ my $my_content_cb = sub {
+ my ( $scanner, $data_ref, $node, @element ) = @_;
+ # filter elements according to pattern
+ my @scan = $pattern ? grep { $_ =~ $pattern } @element : @element;
+ map { $scanner->scan_element( $data_ref, $node, $_ ) } @scan;
+ };
+
my $std_cb = sub {
my ( $scanner, $data_r, $obj, $element, $index, $value_obj ) = @_;
@@ -118,6 +127,7 @@ sub describe {
hash_element_cb => $hash_element_cb,
leaf_cb => $std_cb,
node_element_cb => $node_element_cb,
+ node_content_cb => $my_content_cb,
);
my @left = keys %args;
@@ -164,7 +174,7 @@ Config::Model::Describe - Provide a description of a node element
=head1 VERSION
-version 2.058
+version 2.059
=head1 SYNOPSIS
@@ -263,6 +273,12 @@ Reference to a L<Config::Model::Node> object. Mandatory
Describe only this element from the node. Optional. All elements are
described if omitted.
+=item pattern
+
+Describe the element matching the regexp ref. Example:
+
+ describe => ( pattern => qr/^foo/ )
+
=back
=head1 AUTHOR
diff --git a/lib/Config/Model/DumpAsData.pm b/lib/Config/Model/DumpAsData.pm
index e4d27f7..e703509 100644
--- a/lib/Config/Model/DumpAsData.pm
+++ b/lib/Config/Model/DumpAsData.pm
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::DumpAsData;
-$Config::Model::DumpAsData::VERSION = '2.058';
+$Config::Model::DumpAsData::VERSION = '2.059';
use Carp;
use strict;
use warnings;
@@ -249,7 +249,7 @@ Config::Model::DumpAsData - Dump configuration content as a perl data structure
=head1 VERSION
-version 2.058
+version 2.059
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Dumper.pm b/lib/Config/Model/Dumper.pm
index 26d2f42..1688dd9 100644
--- a/lib/Config/Model/Dumper.pm
+++ b/lib/Config/Model/Dumper.pm
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Dumper;
-$Config::Model::Dumper::VERSION = '2.058';
+$Config::Model::Dumper::VERSION = '2.059';
use Carp;
use strict;
use warnings;
@@ -256,7 +256,7 @@ Config::Model::Dumper - Serialize data of config tree
=head1 VERSION
-version 2.058
+version 2.059
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Exception.pm b/lib/Config/Model/Exception.pm
index db5ece3..18ece33 100644
--- a/lib/Config/Model/Exception.pm
+++ b/lib/Config/Model/Exception.pm
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Exception;
-$Config::Model::Exception::VERSION = '2.058';
+$Config::Model::Exception::VERSION = '2.059';
use warnings;
use strict;
use Data::Dumper;
@@ -137,7 +137,7 @@ use Exception::Class (
Config::Model::Exception::Internal->Trace(1);
package Config::Model::Exception::Syntax;
-$Config::Model::Exception::Syntax::VERSION = '2.058';
+$Config::Model::Exception::Syntax::VERSION = '2.059';
sub full_message {
my $self = shift;
@@ -151,7 +151,7 @@ sub full_message {
}
package Config::Model::Exception::Any;
-$Config::Model::Exception::Any::VERSION = '2.058';
+$Config::Model::Exception::Any::VERSION = '2.059';
sub full_message {
my $self = shift;
@@ -180,7 +180,7 @@ sub xpath_message {
}
package Config::Model::Exception::LoadData;
-$Config::Model::Exception::LoadData::VERSION = '2.058';
+$Config::Model::Exception::LoadData::VERSION = '2.059';
sub full_message {
my $self = shift;
@@ -198,7 +198,7 @@ sub full_message {
}
package Config::Model::Exception::Model;
-$Config::Model::Exception::Model::VERSION = '2.058';
+$Config::Model::Exception::Model::VERSION = '2.059';
sub full_message {
my $self = shift;
@@ -226,7 +226,7 @@ sub full_message {
}
package Config::Model::Exception::Load;
-$Config::Model::Exception::Load::VERSION = '2.058';
+$Config::Model::Exception::Load::VERSION = '2.059';
sub full_message {
my $self = shift;
@@ -247,7 +247,7 @@ sub full_message {
}
package Config::Model::Exception::UnavailableElement;
-$Config::Model::Exception::UnavailableElement::VERSION = '2.058';
+$Config::Model::Exception::UnavailableElement::VERSION = '2.059';
sub full_message {
my $self = shift;
@@ -271,7 +271,7 @@ sub full_message {
}
package Config::Model::Exception::ObsoleteElement;
-$Config::Model::Exception::ObsoleteElement::VERSION = '2.058';
+$Config::Model::Exception::ObsoleteElement::VERSION = '2.059';
sub full_message {
my $self = shift;
@@ -290,7 +290,7 @@ sub full_message {
}
package Config::Model::Exception::UnknownElement;
-$Config::Model::Exception::UnknownElement::VERSION = '2.058';
+$Config::Model::Exception::UnknownElement::VERSION = '2.059';
use Carp;
@@ -359,7 +359,7 @@ sub full_message {
}
package Config::Model::Exception::UnknownId;
-$Config::Model::Exception::UnknownId::VERSION = '2.058';
+$Config::Model::Exception::UnknownId::VERSION = '2.059';
sub full_message {
my $self = shift;
@@ -387,7 +387,7 @@ sub full_message {
}
package Config::Model::Exception::WrongType;
-$Config::Model::Exception::WrongType::VERSION = '2.058';
+$Config::Model::Exception::WrongType::VERSION = '2.059';
sub full_message {
my $self = shift;
@@ -412,7 +412,7 @@ sub full_message {
}
package Config::Model::Exception::ConfigFile::Missing;
-$Config::Model::Exception::ConfigFile::Missing::VERSION = '2.058';
+$Config::Model::Exception::ConfigFile::Missing::VERSION = '2.059';
sub full_message {
my $self = shift;
@@ -423,7 +423,7 @@ sub full_message {
}
package Config::Model::Exception::Xml;
-$Config::Model::Exception::Xml::VERSION = '2.058';
+$Config::Model::Exception::Xml::VERSION = '2.059';
sub full_message {
my $self = shift;
@@ -453,7 +453,7 @@ Config::Model::Exception - Exception mechanism for configuration model
=head1 VERSION
-version 2.058
+version 2.059
=head1 SYNOPSIS
diff --git a/lib/Config/Model/FuseUI.pm b/lib/Config/Model/FuseUI.pm
index 30313fb..bd17577 100644
--- a/lib/Config/Model/FuseUI.pm
+++ b/lib/Config/Model/FuseUI.pm
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::FuseUI;
-$Config::Model::FuseUI::VERSION = '2.058';
+$Config::Model::FuseUI::VERSION = '2.059';
# there's no Singleton with Mouse
use Mouse;
@@ -326,7 +326,7 @@ Config::Model::FuseUI - Fuse virtual file interface for Config::Model
=head1 VERSION
-version 2.058
+version 2.059
=head1 SYNOPSIS
diff --git a/lib/Config/Model/HashId.pm b/lib/Config/Model/HashId.pm
index 42dc07e..4a71677 100644
--- a/lib/Config/Model/HashId.pm
+++ b/lib/Config/Model/HashId.pm
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::HashId;
-$Config::Model::HashId::VERSION = '2.058';
+$Config::Model::HashId::VERSION = '2.059';
use Mouse;
use Config::Model::Exception;
@@ -21,7 +21,15 @@ my $logger = get_logger("Tree::Element::Id::Hash");
extends qw/Config::Model::AnyId/;
has data => ( is => 'rw', isa => 'HashRef', default => sub { {}; } );
-has list => ( is => 'rw', isa => 'ArrayRef', default => sub { []; } );
+has list => (
+ is => 'rw',
+ isa => 'ArrayRef[Str]',
+ traits => ['Array'],
+ default => sub { []; },
+ handles => {
+ _sort => 'sort_in_place',
+ }
+);
has [qw/default_keys auto_create_keys/] =>
( is => 'rw', isa => 'ArrayRef', default => sub { []; } );
@@ -196,6 +204,20 @@ sub _clear {
$self->{data} = {};
}
+sub sort {
+ my $self = shift;
+ if ($self->ordered) {
+ $self->_sort;
+ }
+ else {
+ Config::Model::Exception::User->throw(
+ object => $self,
+ message => "cannot call sort on non ordered hash"
+ );
+ }
+}
+
+
# hash only method
sub firstkey {
my $self = shift;
@@ -484,7 +506,7 @@ Config::Model::HashId - Handle hash element for configuration model
=head1 VERSION
-version 2.058
+version 2.059
=head1 SYNOPSIS
@@ -517,6 +539,10 @@ Returns C<hash>.
Returns the number of elements of the hash.
+=head2 sort
+
+Sort an ordered hash. Throws an error if called on a non ordered hash.
+
=head2 firstkey
Returns the first key of the hash. Behaves like C<each> core perl
diff --git a/lib/Config/Model/IdElementReference.pm b/lib/Config/Model/IdElementReference.pm
index c6cb217..7e51f8a 100644
--- a/lib/Config/Model/IdElementReference.pm
+++ b/lib/Config/Model/IdElementReference.pm
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::IdElementReference;
-$Config::Model::IdElementReference::VERSION = '2.058';
+$Config::Model::IdElementReference::VERSION = '2.059';
use Mouse;
use Carp;
@@ -192,7 +192,7 @@ Config::Model::IdElementReference - Refer to id element(s) and extract keys
=head1 VERSION
-version 2.058
+version 2.059
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Instance.pm b/lib/Config/Model/Instance.pm
index 91492a4..8a08b40 100644
--- a/lib/Config/Model/Instance.pm
+++ b/lib/Config/Model/Instance.pm
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Instance;
-$Config::Model::Instance::VERSION = '2.058';
+$Config::Model::Instance::VERSION = '2.059';
#use Scalar::Util qw(weaken) ;
use 5.10.1;
@@ -477,7 +477,7 @@ Config::Model::Instance - Instance of configuration tree
=head1 VERSION
-version 2.058
+version 2.059
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Iterator.pm b/lib/Config/Model/Iterator.pm
index 5bfedcc..1c5e35f 100644
--- a/lib/Config/Model/Iterator.pm
+++ b/lib/Config/Model/Iterator.pm
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Iterator;
-$Config::Model::Iterator::VERSION = '2.058';
+$Config::Model::Iterator::VERSION = '2.059';
use Carp;
use strict;
use warnings;
@@ -275,7 +275,7 @@ Config::Model::Iterator - Iterates forward or backward a configuration tree
=head1 VERSION
-version 2.058
+version 2.059
=head1 SYNOPSIS
diff --git a/lib/Config/Model/ListId.pm b/lib/Config/Model/ListId.pm
index e513fc7..4811cfb 100644
--- a/lib/Config/Model/ListId.pm
+++ b/lib/Config/Model/ListId.pm
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::ListId;
-$Config::Model::ListId::VERSION = '2.058';
+$Config::Model::ListId::VERSION = '2.059';
use 5.10.1;
use Mouse;
@@ -497,7 +497,7 @@ Config::Model::ListId - Handle list element for configuration model
=head1 VERSION
-version 2.058
+version 2.059
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Lister.pm b/lib/Config/Model/Lister.pm
index c34724c..531ea7d 100644
--- a/lib/Config/Model/Lister.pm
+++ b/lib/Config/Model/Lister.pm
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Lister;
-$Config::Model::Lister::VERSION = '2.058';
+$Config::Model::Lister::VERSION = '2.059';
use strict;
use warnings;
use Exporter;
@@ -83,7 +83,7 @@ Config::Model::Lister - List available models and applications
=head1 VERSION
-version 2.058
+version 2.059
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Loader.pm b/lib/Config/Model/Loader.pm
index 3c2cf1b..7e7db1a 100644
--- a/lib/Config/Model/Loader.pm
+++ b/lib/Config/Model/Loader.pm
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Loader;
-$Config::Model::Loader::VERSION = '2.058';
+$Config::Model::Loader::VERSION = '2.059';
use Carp;
use strict;
use warnings;
@@ -379,6 +379,10 @@ my %dispatch_action = (
':.insort' => sub { $_[1]->insort( @_[ 4 .. $#_ ] ); },
':.insert_before' => \&_insert_before,
},
+ 'hash_*' => {
+ ':.sort' => sub { $_[1]->sort; },
+ ':@' => sub { $_[1]->sort; },
+ },
leaf => {
':-=' => \&_remove_by_value,
':-~' => \&_remove_matched_value,
@@ -493,6 +497,7 @@ sub _load_list {
if ( defined $action ) {
my $dispatch =
$dispatch_action{ 'list_' . $cargo_type }{$action}
+ || $dispatch_action{ 'list_*'}{$action}
|| $dispatch_action{$cargo_type}{$action}
|| $dispatch_action{'fallback'}{$action};
if ($dispatch) {
@@ -600,6 +605,7 @@ sub _load_hash {
if ( defined $action ) {
my $dispatch =
$dispatch_action{ 'hash_' . $cargo_type }{$action}
+ || $dispatch_action{ 'hash_*'}{$action}
|| $dispatch_action{$cargo_type}{$action}
|| $dispatch_action{'fallback'}{$action};
if ($dispatch) {
@@ -725,7 +731,7 @@ Config::Model::Loader - Load serialized data into config tree
=head1 VERSION
-version 2.058
+version 2.059
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Manual/ModelCreationAdvanced.pod b/lib/Config/Model/Manual/ModelCreationAdvanced.pod
index 283dd3e..5fb4790 100644
--- a/lib/Config/Model/Manual/ModelCreationAdvanced.pod
+++ b/lib/Config/Model/Manual/ModelCreationAdvanced.pod
@@ -13,7 +13,7 @@ Config::Model::Manual::ModelCreationAdvanced - Creating a model with advanced fe
=head1 VERSION
-version 2.058
+version 2.059
=head1 Introduction
diff --git a/lib/Config/Model/Manual/ModelCreationIntroduction.pod b/lib/Config/Model/Manual/ModelCreationIntroduction.pod
index d2b488e..cda423e 100644
--- a/lib/Config/Model/Manual/ModelCreationIntroduction.pod
+++ b/lib/Config/Model/Manual/ModelCreationIntroduction.pod
@@ -13,7 +13,7 @@ Config::Model::Manual::ModelCreationIntroduction - Introduction to model creatio
=head1 VERSION
-version 2.058
+version 2.059
=head1 Introduction
diff --git a/lib/Config/Model/Node.pm b/lib/Config/Model/Node.pm
index 0d370d5..ce64d99 100644
--- a/lib/Config/Model/Node.pm
+++ b/lib/Config/Model/Node.pm
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Node;
-$Config::Model::Node::VERSION = '2.058';
+$Config::Model::Node::VERSION = '2.059';
use Mouse;
use Carp;
@@ -1124,7 +1124,7 @@ Config::Model::Node - Class for configuration tree node
=head1 VERSION
-version 2.058
+version 2.059
=head1 SYNOPSIS
diff --git a/lib/Config/Model/ObjTreeScanner.pm b/lib/Config/Model/ObjTreeScanner.pm
index bda0b05..d2588f2 100644
--- a/lib/Config/Model/ObjTreeScanner.pm
+++ b/lib/Config/Model/ObjTreeScanner.pm
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::ObjTreeScanner;
-$Config::Model::ObjTreeScanner::VERSION = '2.058';
+$Config::Model::ObjTreeScanner::VERSION = '2.059';
use strict;
use Config::Model::Exception;
use Scalar::Util qw/blessed/;
@@ -285,7 +285,7 @@ Config::Model::ObjTreeScanner - Scan config tree and perform call-backs for each
=head1 VERSION
-version 2.058
+version 2.059
=head1 SYNOPSIS
@@ -576,7 +576,7 @@ C<@element_list> contains all the element names of the node.
Example:
- sub my_content_cb = {
+ sub my_content_cb {
my ($scanner, $data_ref,$node, at element) = @_ ;
# custom code using $data_ref
diff --git a/lib/Config/Model/Report.pm b/lib/Config/Model/Report.pm
index 134f5e6..750a1e1 100644
--- a/lib/Config/Model/Report.pm
+++ b/lib/Config/Model/Report.pm
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Report;
-$Config::Model::Report::VERSION = '2.058';
+$Config::Model::Report::VERSION = '2.059';
use Carp;
use strict;
use warnings;
@@ -90,7 +90,7 @@ Config::Model::Report - Reports data from config tree
=head1 VERSION
-version 2.058
+version 2.059
=head1 SYNOPSIS
diff --git a/lib/Config/Model/SearchElement.pm b/lib/Config/Model/SearchElement.pm
index d179336..a78b623 100644
--- a/lib/Config/Model/SearchElement.pm
+++ b/lib/Config/Model/SearchElement.pm
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::SearchElement;
-$Config::Model::SearchElement::VERSION = '2.058';
+$Config::Model::SearchElement::VERSION = '2.059';
use Log::Log4perl qw(get_logger :levels);
use Carp;
use strict;
@@ -333,7 +333,7 @@ Config::Model::SearchElement - Search an element in a configuration model
=head1 VERSION
-version 2.058
+version 2.059
=head1 SYNOPSIS
diff --git a/lib/Config/Model/SimpleUI.pm b/lib/Config/Model/SimpleUI.pm
index 49b41b8..4cb1ee1 100644
--- a/lib/Config/Model/SimpleUI.pm
+++ b/lib/Config/Model/SimpleUI.pm
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::SimpleUI;
-$Config::Model::SimpleUI::VERSION = '2.058';
+$Config::Model::SimpleUI::VERSION = '2.059';
use Carp;
use strict;
use warnings;
@@ -66,9 +66,14 @@ my $ll_sub = sub {
my $elt = shift;
my $obj = $self->{current_node};
-
- my $i = $self->{current_node}->instance;
- my $res = $obj->describe( element => $elt, check => 'no' );
+ my $res ;
+ if ($elt =~ /\*/) {
+ $elt =~ s/\*/.*/g;
+ $res = $obj->describe( pattern => qr/^$elt$/, check => 'no' );
+ }
+ else {
+ $res = $obj->describe( element => $elt, check => 'no' );
+ }
return $res;
};
@@ -122,15 +127,18 @@ my %run_dispatch = (
},
ls => sub {
my $self = shift;
+ my $pattern = shift || '*';
+ $pattern =~ s/\*/.*/g;
+
my $i = $self->{current_node}->instance;
- my @res = $self->{current_node}->get_element_name;
- return join( ' ', @res );
+ my @res = grep {/^$pattern$/} $self->{current_node}->get_element_name;
+ return join( ' ', @res );
},
dump => sub {
my $self = shift;
my $i = $self->{current_node}->instance;
my @res = $self->{current_node}->dump_tree( full_dump => 1 );
- return join( ' ', @res );
+ return join( ' ', @res );
},
delete => sub {
my $self = shift;
@@ -214,7 +222,7 @@ sub run_loop {
sub prompt {
my $self = shift;
my $ret = $self->{prompt} . ':';
- my $loc = $self->{current_node}->location;
+ my $loc = $self->{current_node}->composite_name_short;
$ret .= " $loc " if $loc;
return $ret . '$ ';
}
@@ -274,7 +282,7 @@ Config::Model::SimpleUI - Simple interface for Config::Model
=head1 VERSION
-version 2.058
+version 2.059
=head1 SYNOPSIS
@@ -407,9 +415,13 @@ Delete a list or hash element
Display a value
-=item ls
+=item ls | ls foo*
+
+Show elements of current node. Can be used with a shell pattern.
+
+=item ll | ll foo*
-Show elements of current node
+Describe elements of current node. Can be used with a shell pattern.
=item help
diff --git a/lib/Config/Model/TermUI.pm b/lib/Config/Model/TermUI.pm
index 5f479a0..66e9a17 100644
--- a/lib/Config/Model/TermUI.pm
+++ b/lib/Config/Model/TermUI.pm
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::TermUI;
-$Config::Model::TermUI::VERSION = '2.058';
+$Config::Model::TermUI::VERSION = '2.059';
use Carp;
use strict;
use warnings;
@@ -21,20 +21,16 @@ my $completion_sub = sub {
my ( $self, $text, $line, $start ) = @_;
my @choice = $self->{current_node}->get_element_name;
-
- return () if scalar grep { $text eq $_ } @choice;
-
- return @choice;
+ my @ret = grep( /^$text/, @choice );
+ return @ret;
};
my $leaf_completion_sub = sub {
my ( $self, $text, $line, $start ) = @_;
my @choice = $self->{current_node}->get_element_name( cargo_type => 'leaf' );
-
- return () if scalar grep { $text eq $_ } @choice;
-
- return @choice;
+ my @ret = grep( /^$text/, @choice );
+ return @ret;
};
# BUG: When doing autocompletion on a hash element with an index
@@ -50,22 +46,22 @@ my $cd_completion_sub = sub {
#print "text '$text' line '$line' start $start\n";
#print " cd comp param is ",join('+', at _),"\n";
- # convert usual cd_ism ( '..' '/foo') to grab syntax ( '-' '! foo')
- #$text =~ s(^/) (! );
- #$text =~ s(\.\.)(-)g;
- #$text =~ s(/) ( )g;
-
# we know that text begins with 'cd '
my $cmd = $line;
$cmd =~ s/cd\s+//;
+ # convert usual cd_ism ( '..' '/foo') to grab syntax ( '-' '! foo')
+ #$text =~ s(^/) (! );
+ $cmd =~ s(^\.\.$)(-)g;
+ #$text =~ s(/) ( )g;
+
my $new_item;
while ( not defined $new_item ) {
# grab in tolerant mode
#print "Grabbing $cmd\n";
eval {
- $new_item = $self->{current_node}->grab( step => $cmd, mode => 'strict', autoadd => 0 );
+ $new_item = $self->{current_node}->grab( step => $cmd, type => 'node', mode => 'strict', autoadd => 0 );
};
chop $cmd;
}
@@ -75,28 +71,19 @@ my $cd_completion_sub = sub {
my @choice = length($line) > 3 ? () : ( '!', '-' );
my $new_type = $new_item->get_type;
- if ( $new_type eq 'node' ) {
- my @cargo = $new_item->get_element_name( cargo_type => 'node' );
- foreach my $elt_name (@cargo) {
- if ( $new_item->element_type($elt_name) =~ /hash|list/ ) {
- push @choice, "$elt_name:";
- }
- else {
- push @choice, "$elt_name ";
+ my @cargo = $new_item->get_element_name( cargo_type => 'node' );
+ foreach my $elt_name (@cargo) {
+ if ( $new_item->element_type($elt_name) =~ /hash|list/ ) {
+ push @choice, "$elt_name:";
+ foreach my $idx ( $new_item->fetch_element($elt_name)->fetch_all_indexes ) {
+ # my ($idx) = ($raw_idx =~ /([^\n]{1,40})/ );
+ # $idx .= '...' unless $raw_idx eq $idx ;
+ push @choice, "$elt_name:" . ($idx =~ /[^\w._-]/ ? qq("$idx") : $idx ). ' ';
}
}
- }
- elsif ( $new_type eq 'hash' or $new_type eq 'list' ) {
- my @idx = $new_item->fetch_all_indexes;
- if (@idx) {
- my $quote = $line =~ /"$/ ? '' : '"';
- my @tmp = map { /\s/ ? qq($quote$_" ) : qq($_ ); } @idx;
-
- #print "tmp @tmp\n";
- push @choice, @tmp;
+ else {
+ push @choice, "$elt_name ";
}
-
- # skip leaf items
}
# filter possible choices according to input
@@ -104,10 +91,6 @@ my $cd_completion_sub = sub {
#print "->choice +",join('+', at ret),"+ text:'$text'<-\n";
- # my $name = $new_node -> element_name || '';
- #print "DEBUG: cd cmd: new_node is ",$new_node->location,", name $name, ",
- # "choice @choice\n" ;#if $::debug;
-
return @ret;
};
@@ -115,6 +98,7 @@ my %completion_dispatch = (
cd => $cd_completion_sub,
desc => $completion_sub,
ll => $completion_sub,
+ ls => $completion_sub,
set => $leaf_completion_sub,
delete => $leaf_completion_sub,
reset => $leaf_completion_sub,
@@ -226,7 +210,7 @@ Config::Model::TermUI - Provides Config::Model UI with Term::ReadLine
=head1 VERSION
-version 2.058
+version 2.059
=head1 SYNOPSIS
diff --git a/lib/Config/Model/TreeSearcher.pm b/lib/Config/Model/TreeSearcher.pm
index 5d3006a..f67a6fb 100644
--- a/lib/Config/Model/TreeSearcher.pm
+++ b/lib/Config/Model/TreeSearcher.pm
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::TreeSearcher;
-$Config::Model::TreeSearcher::VERSION = '2.058';
+$Config::Model::TreeSearcher::VERSION = '2.059';
use Mouse;
use Mouse::Util::TypeConstraints;
@@ -147,7 +147,7 @@ Config::Model::TreeSearcher - Search tree for match in value, description...
=head1 VERSION
-version 2.058
+version 2.059
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Value.pm b/lib/Config/Model/Value.pm
index 2061ceb..62732fe 100644
--- a/lib/Config/Model/Value.pm
+++ b/lib/Config/Model/Value.pm
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Value;
-$Config::Model::Value::VERSION = '2.058';
+$Config::Model::Value::VERSION = '2.059';
use 5.10.1;
use Mouse;
@@ -60,7 +60,7 @@ has value_type => ( is => 'rw', isa => 'ValueType' );
my @common_int_params = qw/min max mandatory /;
has \@common_int_params => ( is => 'ro', isa => 'Maybe[Int]' );
-my @common_hash_params = qw/replace assert warn_if_match warn_unless_match warn_unless help/;
+my @common_hash_params = qw/replace assert warn_if_match warn_unless_match warn_if warn_unless help/;
has \@common_hash_params => ( is => 'ro', isa => 'Maybe[HashRef]' );
my @common_list_params = qw/choice/;
@@ -510,7 +510,7 @@ sub set_properties {
}
map { $self->{$_} = delete $args{$_} if defined $args{$_} }
- qw/min max mandatory replace warn replace_follow assert warn_unless
+ qw/min max mandatory replace warn replace_follow assert warn_if warn_unless
write_as/;
$self->set_help( \%args );
@@ -904,10 +904,11 @@ sub check_value {
$self->{assert} )
if $self->{assert};
$self->run_code_set_on_value( \$value, $apply_fix, \@warn,
- "warn_unless code check returned false",
- $self->{warn_unless} )
+ "warn_unless code check returned false", $self->{warn_unless} )
if $self->{warn_unless};
-
+ $self->run_code_set_on_value( \$value, $apply_fix, \@warn,
+ "warn_if code check returned true", $self->{warn_if}, 1 )
+ if $self->{warn_if};
}
# unconditional warn
@@ -964,7 +965,7 @@ sub run_code_on_value {
}
sub run_code_set_on_value {
- my ( $self, $value_r, $apply_fix, $array, $msg, $w_info ) = @_;
+ my ( $self, $value_r, $apply_fix, $array, $msg, $w_info, $invert ) = @_;
foreach my $label ( keys %$w_info ) {
my $code = $w_info->{$label}{code};
@@ -974,6 +975,7 @@ sub run_code_set_on_value {
my $sub = sub {
local $_ = shift;
+ no warnings "uninitialized";
my $ret = eval($code);
if ($@) {
Config::Model::Exception::Model->throw(
@@ -981,7 +983,7 @@ sub run_code_set_on_value {
message => "Eval of code failed : $@"
);
}
- return $ret;
+ return $invert ^ $ret;
};
$self->run_code_on_value( $value_r, $apply_fix, $array, $label, $sub, $msg, $fix );
@@ -1017,7 +1019,7 @@ sub apply_fixes {
my ( $old, $new );
my $i = 0;
do {
- $old = $self->{nb_of_fixes};
+ $old = $self->{nb_of_fixes} // 0;
$self->check_value( value => $self->_fetch_no_check, fix => 1 );
$new = $self->{nb_of_fixes};
@@ -1026,7 +1028,7 @@ sub apply_fixes {
if ( $i++ > 20 ) {
Config::Model::Exception::Model->throw(
object => $self,
- error => "Too many fix loops: check with fix code or regexp"
+ error => "Too many fix loops: check code used to fix value or the check"
);
}
} while ( $self->{nb_of_fixes} and $old > $new );
@@ -1048,7 +1050,7 @@ sub apply_fix {
if ($@) {
Config::Model::Exception::Model->throw(
object => $self,
- message => "Eval of fix $fix failed : $@"
+ message => "Eval of fix $fix failed : $@"
);
}
@@ -1066,13 +1068,14 @@ sub _store_fix {
"fix change: '" . ( $old // '<undef>' ) . "' -> '" . ( $new // '<undef>' ) . "'" );
}
- $self->notify_change(
+ my %args = (
old => $old // $self->_fetch_std,
new => $new // $self->_fetch_std,
note => 'applied fix'
- );
-
- # $self->store(value => $_, check => 'no'); # will update $self->{fixes}
+ ) ;
+ no warnings "uninitialized";
+ # in case $old is the default value and $new is undef
+ $self->notify_change( %args ) if $args{old} ne $args{new};
}
# read checks should be blocking
@@ -1771,7 +1774,7 @@ Config::Model::Value - Strongly typed configuration value
=head1 VERSION
-version 2.058
+version 2.059
=head1 SYNOPSIS
@@ -2009,17 +2012,36 @@ C<uniline> values.
String. Issue a warning to user with the specified string any time a value is set or read.
-=item warn_unless
+=item warn_if
A bit like C<warn_if_match>. The hash key is not a regexp but a label to
help users. The hash ref contains some Perl code that is evaluated to
-perform the test. A warning will be issued if the code returns false.
+perform the test. A warning will be issued if the code returns true.
C<$_> will contains the value to check. C<$self> will contain the C<Config::Model::Value> object.
-The example below will warn if a directory is missing:
+The example below will warn if value contaims a number:
+
+ warn_if => {
+ warn_test => {
+ code => 'defined $_ && /\d/;',
+ msg => 'should not have numbers',
+ fix => 's/\d//g;'
+ }
+ },
+
+=item warn_unless
+
+Like C<warn_if>, but issue a warning when the C<code> returns false.
-warn_unless => { 'dir' => { code => '-d' , msg => 'missing dir', fix => "system(mkdir $_);" }}
+The example below will warn unless the value points to an existing directory:
+
+ warn_unless => {
+ 'dir' => {
+ code => '-d',
+ msg => 'missing dir',
+ fix => "system(mkdir $_);" }
+ }
=item assert
@@ -2517,81 +2539,73 @@ Set a value from a directory like path.
=head2 Number with min and max values
bounded_number => {
-type => 'leaf',
-value_type => 'number',
-min => 1,
-max => 4,
-}
-,
+ type => 'leaf',
+ value_type => 'number',
+ min => 1,
+ max => 4,
+ },
=head2 Mandatory value
-mandatory_string => {
-type => 'leaf',
-value_type => 'string',
-mandatory => 1,
-}
-,
+ mandatory_string => {
+ type => 'leaf',
+ value_type => 'string',
+ mandatory => 1,
+ },
-mandatory_boolean => {
-type => 'leaf',
-value_type => 'boolean',
-}
-,
+ mandatory_boolean => {
+ type => 'leaf',
+ value_type => 'boolean',
+ },
=head2 Enum with help associated with each value
Note that the help specification is optional.
enum_with_help => {
-type => 'leaf',
-value_type => 'enum',
-choice => [qw/a b c/],
-help => { a => 'a help' }
-}
-,
+ type => 'leaf',
+ value_type => 'enum',
+ choice => [qw/a b c/],
+ help => { a => 'a help' }
+ },
=head2 Migrate old obsolete enum value
Legacy values C<a1>, C<c1> and C<foo/.*> are replaced with C<a>, C<c> and C<foo/>.
-with_replace => {
-type => 'leaf',
-value_type => 'enum',
-choice => [qw/a b c/],
-replace => {
-a1 => 'a',
-c1 => 'c',
-'foo/.*' => 'foo',
-}
-,
-}
-,
+ with_replace => {
+ type => 'leaf',
+ value_type => 'enum',
+ choice => [qw/a b c/],
+ replace => {
+ a1 => 'a',
+ c1 => 'c',
+ 'foo/.*' => 'foo',
+ },
+ },
=head2 Enforce value to match a regexp
An exception will be triggered if the value does not match the C<match>
regular expression.
-match => {
-type => 'leaf',
-value_type => 'string',
-match => '^foo\d{2}$',
-}
-,
+ match => {
+ type => 'leaf',
+ value_type => 'string',
+ match => '^foo\d{2}$',
+ },
=head2 Enforce value to match a L<Parse::RecDescent> grammar
-match_with_parse_recdescent => {
-type => 'leaf',
-value_type => 'string',
-grammar => q{
-token (oper token)(s?)
-oper: 'and' | 'or'
-token: 'Apache' | 'CC-BY' | 'Perl'
-},
-}
-,
+ match_with_parse_recdescent => {
+ type => 'leaf',
+ value_type => 'string',
+ grammar => q{
+ token (oper token)(s?)
+ oper: 'and' | 'or'
+ token: 'Apache' | 'CC-BY' | 'Perl'
+ },
+ },
=head2 Issue a warning if a value matches a regexp
@@ -2599,44 +2613,39 @@ Issue a warning if the string contains upper case letters. Propose a fix that
translate all capital letters to lower case.
warn_if_capital => {
-type => 'leaf',
-value_type => 'string',
-warn_if_match => { '/A-Z/' => { fix => '$_ = lc;' } },
-}
-,
+ type => 'leaf',
+ value_type => 'string',
+ warn_if_match => { '/A-Z/' => { fix => '$_ = lc;' } },
+ },
A specific warning can be specified:
warn_if_capital => {
-type => 'leaf',
-value_type => 'string',
-warn_if_match => {
-'/A-Z/' => {
-fix => '$_ = lc;' ,
-mesg =>'NO UPPER CASE PLEASE'
-}
-}
-,
-}
-,
+ type => 'leaf',
+ value_type => 'string',
+ warn_if_match => {
+ '/A-Z/' => {
+ fix => '$_ = lc;',
+ mesg => 'NO UPPER CASE PLEASE'
+ }
+ },
+ },
=head2 Issue a warning if a value does NOT match a regexp
warn_unless => {
-type => 'leaf',
-value_type => 'string',
-warn_unless_match => { foo => { msg => '', fix => '$_ = "foo".$_;' } },
-}
-,
+ type => 'leaf',
+ value_type => 'string',
+ warn_unless_match => { foo => { msg => '', fix => '$_ = "foo".$_;' } },
+ },
=head2 Always issue a warning
-always_warn => {
-type => 'leaf',
-value_type => 'string',
-warn => 'Always warn whenever used',
-}
-,
+ always_warn => {
+ type => 'leaf',
+ value_type => 'string',
+ warn => 'Always warn whenever used',
+ },
=head2 Computed values
@@ -2670,32 +2679,32 @@ parameter)
Here an example where a URL parameter is changed to a set of 2
parameters (host and path):
-'old_url' => { type => 'leaf',
-value_type => 'uniline',
-status => 'deprecated',
-}
-,
-'host'
-=> { type => 'leaf',
-value_type => 'uniline',
-# the formula must end with '$1' so the result of the capture is used
-# as the host value
-migrate_from => { formula => '$old =~ m!http://([\w\.]+)!; $1 ;' ,
-variables => { old => '- old_url' } ,
-use_eval => 1 ,
-}
-,
-}
-,
-'path' => { type => 'leaf',
-value_type => 'uniline',
-migrate_from => { formula => '$old =~ m!http://[\w\.]+(/.*)!; $1 ;',
-variables => { old => '- old_url' } ,
-use_eval => 1 ,
-}
-,
-}
-,
+ 'old_url' => {
+ type => 'leaf',
+ value_type => 'uniline',
+ status => 'deprecated',
+ },
+ 'host' => {
+ type => 'leaf',
+ value_type => 'uniline',
+
+ # the formula must end with '$1' so the result of the capture is used
+ # as the host value
+ migrate_from => {
+ formula => '$old =~ m!http://([\w\.]+)!; $1 ;',
+ variables => { old => '- old_url' },
+ use_eval => 1,
+ },
+ },
+ 'path' => {
+ type => 'leaf',
+ value_type => 'uniline',
+ migrate_from => {
+ formula => '$old =~ m!http://[\w\.]+(/.*)!; $1 ;',
+ variables => { old => '- old_url' },
+ use_eval => 1,
+ },
+ },
=head1 EXCEPTION HANDLING
diff --git a/lib/Config/Model/Value/LayeredInclude.pm b/lib/Config/Model/Value/LayeredInclude.pm
index 8a54ea0..c76ee89 100644
--- a/lib/Config/Model/Value/LayeredInclude.pm
+++ b/lib/Config/Model/Value/LayeredInclude.pm
@@ -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.058';
+$Config::Model::Value::LayeredInclude::VERSION = '2.059';
use 5.010;
use strict;
use warnings;
@@ -108,7 +108,7 @@ Config::Model::Value::LayeredInclude - Include a sub layer configuration
=head1 VERSION
-version 2.058
+version 2.059
=head1 SYNOPSIS
diff --git a/lib/Config/Model/ValueComputer.pm b/lib/Config/Model/ValueComputer.pm
index cbfcd4e..c3c5ee8 100644
--- a/lib/Config/Model/ValueComputer.pm
+++ b/lib/Config/Model/ValueComputer.pm
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::ValueComputer;
-$Config::Model::ValueComputer::VERSION = '2.058';
+$Config::Model::ValueComputer::VERSION = '2.059';
use Mouse;
use MouseX::StrictConstructor;
@@ -576,7 +576,7 @@ Config::Model::ValueComputer - Provides configuration value computation
=head1 VERSION
-version 2.058
+version 2.059
=head1 SYNOPSIS
diff --git a/lib/Config/Model/WarpedNode.pm b/lib/Config/Model/WarpedNode.pm
index 8dbbd9b..8057b16 100644
--- a/lib/Config/Model/WarpedNode.pm
+++ b/lib/Config/Model/WarpedNode.pm
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::WarpedNode;
-$Config::Model::WarpedNode::VERSION = '2.058';
+$Config::Model::WarpedNode::VERSION = '2.059';
use Mouse;
use Carp qw(cluck croak);
@@ -308,7 +308,7 @@ Config::Model::WarpedNode - Node that change config class properties
=head1 VERSION
-version 2.058
+version 2.059
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Warper.pm b/lib/Config/Model/Warper.pm
index 1976623..f87d361 100644
--- a/lib/Config/Model/Warper.pm
+++ b/lib/Config/Model/Warper.pm
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Warper;
-$Config::Model::Warper::VERSION = '2.058';
+$Config::Model::Warper::VERSION = '2.059';
use Mouse;
use Log::Log4perl qw(get_logger :levels);
@@ -607,7 +607,7 @@ Config::Model::Warper - Warp tree properties
=head1 VERSION
-version 2.058
+version 2.059
=head1 SYNOPSIS
diff --git a/script/cme b/script/cme
index 24af240..f759dba 100644
--- a/script/cme
+++ b/script/cme
@@ -21,6 +21,20 @@ use Pod::Usage;
use Path::Tiny;
use POSIX qw/setsid/;
+sub run_shell_ui ($$) {
+ my ($root, $root_model) = @_;
+
+ require Config::Model::TermUI;
+ my $shell_ui = Config::Model::TermUI->new(
+ root => $root,
+ title => $root_model . ' configuration',
+ prompt => ' >',
+ );
+
+ # engage in user interaction
+ $shell_ui->run_loop;
+}
+
my $ui_type;
my $model_dir;
@@ -66,6 +80,9 @@ my %command_option = (
"ui|if=s" => \$ui_type,
"open_item|open-item=s" => \$open_item,
],
+ shell => [
+ "open_item|open-item=s" => \$open_item,
+ ],
dump => [
"dumptype:s" => \$dumptype,
],
@@ -299,6 +316,9 @@ elsif ( $command =~ /^fuse/ ) {
exit; # don't save data in parent process
}
}
+elsif ( $command eq 'shell' ) {
+ run_shell_ui($root, $root_model) ;
+}
elsif ( $command eq 'edit' ) {
eval { require Config::Model::TkUI; };
my $has_tk = $@ ? 0 : 1;
@@ -335,16 +355,7 @@ elsif ( $command eq 'edit' ) {
$shell_ui->run_loop;
}
elsif ( $ui_type eq 'shell' ) {
-
- require Config::Model::TermUI;
- my $shell_ui = Config::Model::TermUI->new(
- root => $root,
- title => $root_model . ' configuration',
- prompt => ' >',
- );
-
- # engage in user interaction
- $shell_ui->run_loop;
+ run_shell_ui($root, $root_model) ;
}
elsif ( $ui_type eq 'curses' ) {
die "cannot run curses interface: ", "Config::Model::CursesUI is not installed\n"
@@ -542,6 +553,11 @@ for details.
=back
+=head2 shell
+
+Edit the configuration with a shell like interface. See L<Config::Model::TermUI>
+for details. This is a shortcut for C<edit -ui shell>.
+
=head2 check
Checks the content of the configuration file of an application. Prints warnings
diff --git a/t/describe_node.t b/t/describe_node.t
index f9227af..c57a5f1 100644
--- a/t/describe_node.t
+++ b/t/describe_node.t
@@ -1,10 +1,5 @@
-# -*- cperl -*-
-# $Author$
-# $Date$
-# $Revision$
-
use ExtUtils::testlib;
-use Test::More tests => 8;
+use Test::More tests => 9;
use Test::Memory::Cycle;
use Config::Model;
@@ -95,4 +90,17 @@ $description = $root->describe( element => 'std_id' );
$description =~ s/\s*\n/\n/g;
print "description string:\n$description" if $trace;
is( $description, $expect, "check root description of std_id" );
+
+$expect = <<'EOF' ;
+name value type comment
+hash_a:titi titi_value string
+hash_a:toto toto_value string
+hash_b [empty hash] value hash
+EOF
+
+$description = $root->describe( pattern => qr/^hash_/ );
+$description =~ s/\s*\n/\n/g;
+print "description string:\n$description" if $trace;
+is( $description, $expect, "check root description of std_id" );
+
memory_cycle_ok($model);
diff --git a/t/load.t b/t/load.t
index 6c7b155..b17b22e 100644
--- a/t/load.t
+++ b/t/load.t
@@ -354,6 +354,13 @@ $root->load(
'lista=' . join( ',', @set1 ) . ' lista:.sort lista:.insort(' . join( ',', @set2 ) . ')' );
eq_or_diff( [ $lista->fetch_all_values ], [ sort( @set1, @set2 ) ], "check insort result" );
+# test sort on ordered hash
+my $oh = $root->fetch_element('ordered_hash');
+$root->load('ordered_hash:b=bv ordered_hash:a=av');
+eq_or_diff( [$oh->fetch_all_indexes()],[qw/b a/], "check unsorted keys") ;
+$root->load('ordered_hash:.sort') ;
+eq_or_diff( [$oh->fetch_all_indexes()],[qw/a b/], "check sorted keys") ;
+
# test combination of annotation plus load and some utf8
$step = 'std_id#std_id_note ! std_id:ab#std_id_ab_note X=Bv X#X_note
- std_id:bc X=Av X#X2_note '
diff --git a/t/simple_ui.t b/t/simple_ui.t
index 6bdd82d..84bf1ee 100644
--- a/t/simple_ui.t
+++ b/t/simple_ui.t
@@ -1,10 +1,5 @@
-# -*- cperl -*-
-# $Author$
-# $Date$
-# $Revision$
-
use ExtUtils::testlib;
-use Test::More tests => 23;
+use Test::More tests => 27;
use Test::Memory::Cycle;
use Config::Model;
@@ -77,7 +72,15 @@ my @test = (
[ 'vf std_id:ab', "Unexpected command 'vf'", $expected_prompt ],
[
'ls',
- 'std_id lista listb hash_a hash_b ordered_hash olist tree_macro warp slave_y string_with_def a_uniline a_string int_v my_check_list my_reference',
+ 'std_id lista listb hash_a hash_b ordered_hash olist tree_macro warp slave_y string_with_def a_uniline a_string int_v my_check_list my_reference',
+ $expected_prompt
+ ],
+ [ 'ls hash*', 'hash_a hash_b', $expected_prompt],
+ [
+ 'll hash*',
+ "name value type comment \n"
+ ."hash_a [empty hash] value hash \n"
+ ."hash_b [empty hash] value hash \n",
$expected_prompt
],
[ 'set a_string="some value with space"', "", $expected_prompt ],
@@ -91,7 +94,9 @@ my @test = (
foreach my $a_test (@test) {
my ( $cmd, $expect, $expect_prompt ) = @$a_test;
- is( $ui->run($cmd), $expect, "exec $cmd, expect $expect" );
+ my $res = $ui->run($cmd);
+ $res =~ s/ +/ /g;
+ is($res , $expect, "exec $cmd" );
is( $ui->prompt, $expect_prompt, "test prompt is $expect_prompt" );
}
diff --git a/t/term_ui.t b/t/term_ui.t
index d8c4d72..dbc797e 100644
--- a/t/term_ui.t
+++ b/t/term_ui.t
@@ -1,3 +1,4 @@
+# -*- cperl -*-
use ExtUtils::testlib;
use Test::More;
use Test::Differences;
@@ -14,7 +15,7 @@ BEGIN {
or eval { require Term::ReadLine::Perl; 1; } );
if ($ok) {
- plan tests => 11;
+ plan tests => 12;
}
else {
plan skip_all => "Cannot load Term::ReadLine";
@@ -76,19 +77,20 @@ my $term_ui = Config::Model::TermUI->new(
prompt => $prompt,
);
+my @std_id_list = ('std_id:','std_id:ab ','std_id:"abc def" ' ,'std_id:"abc hij" ', 'std_id:bc ') ;
my @test = ( # text line start ## expected completions
[
[ '', '', 0 ],
[qw/cd changes delete desc description display dump help ll ls reset save set/]
],
- [ [ '', 'cd ', 3 ], [ '!', '-', 'std_id:', 'olist:', 'warp ', 'slave_y ' ] ],
- [ [ 's', 'cd s', 3 ], [ 'std_id:', 'slave_y ' ] ],
+ [ [ '', 'cd ', 3 ], [ '!', '-', @std_id_list , 'olist:', 'warp ', 'slave_y ' ] ],
+ [ [ 's', 'cd s', 3 ], [ @std_id_list, 'slave_y ' ] ],
[ [ 'sl', 'cd sl', 3 ], ['slave_y '] ],
- [ [ '', 'cd std_id:', 10 ], [ 'ab ', '"abc def" ', '"abc hij" ', 'bc ' ] ],
- [ [ '', 'cd std_id:"', 11 ], [ 'ab ', 'abc def" ', 'abc hij" ', 'bc ' ] ],
+ [ [ 'std_id:', 'cd std_id:', 10 ], \@std_id_list ],
+ [ [ 'std_id:"', 'cd std_id:"', 11 ], ['std_id:"abc def" ' ,'std_id:"abc hij" ' ] ],
- # [ [ '"abc', 'cd std_id:"abc',14 ], [ ' def" ', ' hij" ' ] ],
- [ [ 'a', 'cd std_id:a', 3 ], ['ab '] ],
+ [ [ 'std_id:"abc', 'cd std_id:"abc',14 ], ['std_id:"abc def" ' ,'std_id:"abc hij" ' ] ],
+ [ [ 'std_id:a', 'cd std_id:a', 3 ], ['std_id:ab '] ],
);
foreach my $a_test (@test) {
diff --git a/t/value.t b/t/value.t
index ff6329a..278bf5b 100644
--- a/t/value.t
+++ b/t/value.t
@@ -209,6 +209,17 @@ $model->create_config_class(
}
},
},
+ warn_if_number => {
+ type => 'leaf',
+ value_type => 'string',
+ warn_if => {
+ warn_test => {
+ code => 'defined $_ && /\d/;',
+ msg => 'should not have numbers',
+ fix => 's/\d//g;'
+ }
+ },
+ },
warn_unless => {
type => 'leaf',
value_type => 'string',
@@ -615,6 +626,14 @@ is( $wip->has_fixes, 1, "test has_fixes after fetch with mode = standard" );
$wip->apply_fixes;
is( $wip->fetch, 'FOOBAR', "test if fixes were applied" );
+### test warn_if_number parameter
+my $win = $root->fetch_element('warn_if_number');
+warning_like { $win->store('bar51'); } qr//, "test warn_if condition";
+
+is( $win->has_fixes, 1, "test has_fixes" );
+$win->apply_fixes;
+is( $win->fetch, 'bar', "test if fixes were applied" );
+
### test warn_unless parameter
my $wup = $root->fetch_element('warn_unless_match');
warning_like { $wup->store('bar'); } qr/should match/, "test warn_unless_match condition";
diff --git a/t/value_compute.t b/t/value_compute.t
index 7e12705..d70548a 100644
--- a/t/value_compute.t
+++ b/t/value_compute.t
@@ -195,6 +195,31 @@ $model->create_config_class(
fix => '$_ = undef;'
}
}
+ },
+ # emulate imon problem where /dev/lcd0 is the default value and may not be found
+ compute_with_override_and_powerless_fix => {
+ type => 'leaf',
+ class => 'Config::Model::Value',
+ value_type => 'uniline',
+ compute => {
+ formula => q"my $l = '/dev/lcd-imon'; -e $l ? $l : '/dev/lcd0';",
+ use_eval => 1,
+ allow_override => 1,
+ },
+ warn_if => {
+ not_lcd_imon => {
+ code => q!my $l = '/dev/lcd-imon';defined $_ and -e $l and $_ ne $l ;!,
+ msg => "not lcd-foo.txt",
+ fix => '$_ = undef;'
+ },
+ },
+ warn_unless => {
+ good_value => {
+ code => 'defined $_ ? -e : 1;',
+ msg => "not good value",
+ fix => '$_ = undef;'
+ }
+ }
},
compute_with_upstream => {
type => 'leaf',
@@ -359,7 +384,8 @@ eq_or_diff(
[ $root->get_element_name() ],
[
qw/av bv compute_int sav sbv one_var one_wrong_var
- meet_test compute_with_override compute_with_override_and_fix compute_with_upstream compute_no_var bar
+ meet_test compute_with_override compute_with_override_and_fix compute_with_override_and_powerless_fix
+ compute_with_upstream compute_no_var bar
foo2 url host with_tmp_var Upstream-Contact Maintainer Source Source2 Licenses
index_function_target test_index_function OtherMaintainer Vcs-Browser/
],
@@ -581,7 +607,10 @@ warning_like {$cwoaf->store('oops') ; }[ qr/not default value/],
$cwoaf->apply_fixes;
is($cwoaf->fetch, 'def value', "test compute_with_override_and_fix value after fix");
-
+my $cwoapf = $root->fetch_element('compute_with_override_and_powerless_fix');
+warning_like { $cwoapf->apply_fixes;} [ qr/not good value/],
+ "check warning when applying powerless fix";
+is($cwoapf->fetch, '/dev/lcd0', "test default value after powerless fix");
memory_cycle_ok( $model, "test memory cycles" );
diff --git a/t/yaml_backend.t b/t/yaml_backend.t
index d2f1cd4..b265785 100644
--- a/t/yaml_backend.t
+++ b/t/yaml_backend.t
@@ -8,7 +8,7 @@ use File::Path;
use File::Copy;
use Path::Tiny;
use Data::Dumper;
-use YAML::Any 0.303;
+use YAML::Any;
use warnings;
no warnings qw(once);
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libconfig-model-perl.git
More information about the Pkg-perl-cvs-commits
mailing list