[libconfig-model-perl] 01/01: New upstream version 2.110
dod at debian.org
dod at debian.org
Sun Sep 24 15:40:36 UTC 2017
This is an automated email from the git hooks/post-receive script.
dod pushed a commit to annotated tag upstream/2.110
in repository libconfig-model-perl.
commit 1edc934204c3c4d64353fa0df7d756c08bbb9b37
Author: Dominique Dumont <dod at debian.org>
Date: Fri Sep 22 15:14:20 2017 +0200
New upstream version 2.110
---
Build.PL | 2 +-
Changes | 32 ++
MANIFEST | 6 +
META.json | 2 +-
META.yml | 2 +-
lib/Config/Model.pm | 70 +++--
lib/Config/Model/Annotation.pm | 4 +-
lib/Config/Model/AnyId.pm | 4 +-
lib/Config/Model/AnyThing.pm | 4 +-
lib/Config/Model/Backend/Any.pm | 14 +-
lib/Config/Model/Backend/{Json.pm => CdsFile.pm} | 108 +++----
lib/Config/Model/Backend/Fstab.pm | 4 +-
lib/Config/Model/Backend/IniFile.pm | 72 ++---
lib/Config/Model/Backend/Json.pm | 17 +-
lib/Config/Model/Backend/{Json.pm => PerlFile.pm} | 113 ++++---
lib/Config/Model/Backend/PlainFile.pm | 18 +-
lib/Config/Model/Backend/ShellVar.pm | 18 +-
lib/Config/Model/Backend/Yaml.pm | 17 +-
lib/Config/Model/BackendMgr.pm | 329 ++++-----------------
lib/Config/Model/CheckList.pm | 4 +-
lib/Config/Model/Cookbook/CreateModelFromDoc.pod | 2 +-
lib/Config/Model/Describe.pm | 4 +-
lib/Config/Model/DumpAsData.pm | 4 +-
lib/Config/Model/Dumper.pm | 4 +-
lib/Config/Model/Exception.pm | 44 +--
lib/Config/Model/FuseUI.pm | 4 +-
lib/Config/Model/HashId.pm | 4 +-
lib/Config/Model/IdElementReference.pm | 4 +-
lib/Config/Model/Instance.pm | 6 +-
lib/Config/Model/Iterator.pm | 4 +-
lib/Config/Model/ListId.pm | 4 +-
lib/Config/Model/Lister.pm | 4 +-
lib/Config/Model/Loader.pm | 39 +--
lib/Config/Model/Manual/ModelCreationAdvanced.pod | 2 +-
.../Model/Manual/ModelCreationIntroduction.pod | 237 ++-------------
lib/Config/Model/Node.pm | 37 ++-
lib/Config/Model/ObjTreeScanner.pm | 4 +-
lib/Config/Model/Report.pm | 4 +-
lib/Config/Model/Role/ComputeFunction.pm | 4 +-
lib/Config/Model/Role/Grab.pm | 4 +-
lib/Config/Model/Role/HelpAsText.pm | 4 +-
lib/Config/Model/Role/NodeLoader.pm | 4 +-
lib/Config/Model/Role/WarpMaster.pm | 4 +-
lib/Config/Model/SearchElement.pm | 4 +-
lib/Config/Model/SimpleUI.pm | 4 +-
lib/Config/Model/TermUI.pm | 4 +-
lib/Config/Model/TreeSearcher.pm | 4 +-
lib/Config/Model/Utils/GenClassPod.pm | 4 +-
lib/Config/Model/Value.pm | 12 +-
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 +-
t/annotation.t | 6 +-
t/backend_ini.t | 2 +-
t/backend_ini_with_section_map.t | 2 +-
t/backend_mgr.t | 6 +-
t/backend_multiple.t | 2 +-
t/backend_plainfile.t | 2 +-
t/backend_yaml.t | 2 +-
t/cme-function.t | 2 +-
t/fuse_ui.t | 2 +-
t/include.t | 5 +-
t/load.t | 119 ++++----
t/load_model_snippets.t | 4 +-
t/model_tests.d/backend-cds-examples/basic | 8 +
t/model_tests.d/backend-cds-test-conf.pl | 62 ++++
t/model_tests.d/backend-perl-examples/basic | 17 ++
t/model_tests.d/backend-perl-test-conf.pl | 62 ++++
t/pod_generation.t | 4 +-
70 files changed, 733 insertions(+), 893 deletions(-)
diff --git a/Build.PL b/Build.PL
index 8ffee45..719e912 100644
--- a/Build.PL
+++ b/Build.PL
@@ -128,7 +128,7 @@ my $build = $class->new(
# cleanup required by t/auto_read.t
# PreGrammar.pm is created by t/value_computer.t
- add_to_cleanup => [ qw/PreGrammar.pm wr_root/ ],
+ add_to_cleanup => [ qw/PreGrammar.pm wr_root wr_root_p/ ],
);
$build->add_build_element('pl');
diff --git a/Changes b/Changes
index 6bd577c..ce362f9 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,35 @@
+2.110 2017-09-21
+
+ Unfortunately the deprecations and updates done last release broke
+ Config::Model::Itself. This release fixes these problems:
+ * disable translation of read_config to rw_config
+ * change deprecation messages from warn to say
+ * put back old backend parameters for FsTab, Multistrap
+ and PopCon models
+
+2.109 2017-09-18
+
+ Deprecation and updates as announced in http://wp.me/pFBZb-f5 :
+ * the model parameters read_config and write_config that are used
+ to specify different read and write backends are deprecated
+ in favor of rw_config to specify *one* r/w backend
+ * multiple backends are deprecated.
+ * update doc for these deprecations
+ * Dump string backend (cds_file) is now handled by its own class
+ (Config::Model::Backend::CdsFile)
+ * Perl backend (perl_file) is now handled by its own class
+ (Config::Model::Backend::PerlFile)
+ * Model: die when model parameters allow, allow_from, follow are
+ used. These parameters were deprecated several years ago.
+
+ Other changes:
+ * update backend parameters of FsTab, Multistrap, PopCon models
+ * Value: allow regexp and code test for enum (like warn_if_match)
+
+ Test improvements
+ * can run tests concurrently: prove -j8 runs all tests in 4s
+ (16s without -j8)
+
2.108 2017-08-31
Fix random failure in non-regression tests
diff --git a/MANIFEST b/MANIFEST
index a6e9e0b..5f3af7b 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -19,9 +19,11 @@ lib/Config/Model/Annotation.pm
lib/Config/Model/AnyId.pm
lib/Config/Model/AnyThing.pm
lib/Config/Model/Backend/Any.pm
+lib/Config/Model/Backend/CdsFile.pm
lib/Config/Model/Backend/Fstab.pm
lib/Config/Model/Backend/IniFile.pm
lib/Config/Model/Backend/Json.pm
+lib/Config/Model/Backend/PerlFile.pm
lib/Config/Model/Backend/PlainFile.pm
lib/Config/Model/Backend/ShellVar.pm
lib/Config/Model/Backend/Yaml.pm
@@ -117,12 +119,16 @@ t/lib/test_yaml_model.pl
t/load.t
t/load_model_snippets.t
t/model.t
+t/model_tests.d/backend-cds-examples/basic
+t/model_tests.d/backend-cds-test-conf.pl
t/model_tests.d/backend-ini-examples/complex
t/model_tests.d/backend-ini-test-conf.pl
t/model_tests.d/backend-json-examples/basic
t/model_tests.d/backend-json-test-conf.pl
t/model_tests.d/backend-key-value-examples/bts-control
t/model_tests.d/backend-key-value-test-conf.pl
+t/model_tests.d/backend-perl-examples/basic
+t/model_tests.d/backend-perl-test-conf.pl
t/model_tests.d/backend-plainfile-examples/with-index/debian/bar.install.list
t/model_tests.d/backend-plainfile-examples/with-index/debian/bar.move.list
t/model_tests.d/backend-plainfile-examples/with-index/debian/foo.install.list
diff --git a/META.json b/META.json
index 4b0a98c..bdea783 100644
--- a/META.json
+++ b/META.json
@@ -97,7 +97,7 @@
"web" : "http://github.com/dod38fr/config-model"
}
},
- "version" : "2.108",
+ "version" : "2.110",
"x_serialization_backend" : "JSON::XS version 3.03"
}
diff --git a/META.yml b/META.yml
index fe4015a..7899a36 100644
--- a/META.yml
+++ b/META.yml
@@ -68,5 +68,5 @@ resources:
bugtracker: https://github.com/dod38fr/config-model/issues
homepage: https://github.com/dod38fr/config-model/wiki
repository: git://github.com/dod38fr/config-model.git
-version: '2.108'
+version: '2.110'
x_serialization_backend: 'YAML::Tiny version 1.70'
diff --git a/lib/Config/Model.pm b/lib/Config/Model.pm
index cd02479..a7d70df 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.108';
+$Config::Model::VERSION = '2.110';
use strict ;
use warnings;
use 5.10.1;
@@ -329,8 +329,7 @@ sub instance_names {
# into element description.
my @legal_params_to_move = (
- qw/read_config read_config_dir
- write_config write_config_dir/, # read/write stuff
+ qw/read_config write_config rw_config/, # read/write stuff
# this parameter is filled by class generated by a program. It may
# be used to avoid interactive edition of a generated model
@@ -411,7 +410,7 @@ sub include_backend {
# includes (and normalization). Is already a dclone
my $included_model = $self->get_model($included_class);
- foreach my $rw (qw/read_config write_config config_dir/) {
+ foreach my $rw (qw/rw_config read_config write_config config_dir/) {
if ($target_model->{$rw} and $included_model->{$rw}) {
my $msg = "Included $rw from $included_class cannot clobber "
. "existing data in $class_name";
@@ -479,15 +478,14 @@ sub normalize_class_parameters {
$normalized_model->{include} = delete $normalized_model->{inherit};
}
- # get data read/write information (if any)
- $model->{read_config_dir} = $model->{write_config_dir} = delete $normalized_model->{config_dir}
- if defined $normalized_model->{config_dir};
-
foreach my $info (@legal_params_to_move) {
next unless defined $normalized_model->{$info};
$model->{$info} = delete $normalized_model->{$info};
}
+ # first deal with perl file and cds_file backend
+ $self->translate_legacy_backend_info( $config_class_name, $model );
+
# handle accept parameter
my @accept_list;
my %accept_hash;
@@ -683,6 +681,41 @@ sub translate_legacy_info {
) if $legacy_logger->is_debug;
}
+# TODO: use 'warn' for show_legacy_issue once all models are updated (mid October 2017 ?)
+# TODO: use 'die' mid November 2017
+sub translate_legacy_backend_info {
+ my ( $self, $config_class_name, $model ) = @_;
+
+ my $multi_backend = 0;
+ foreach my $config (qw/read_config write_config/) {
+ my $ref = $model->{$config};
+ if ($ref and ref($ref) eq 'ARRAY') {
+ if (@$ref == 1) {
+ $model->{$config} = $ref->[0];
+ }
+ elsif (@$ref > 1){
+ $self->show_legacy_issue("$config_class_name $config: multiple backends are deprecated", 'note');
+ $multi_backend++;
+ }
+ }
+ }
+
+ if ($model->{read_config}) {
+ $self->show_legacy_issue("$config_class_name: read_config specification is deprecated, please move in rw_config", 'note');
+ # TODO: enable once COnfig::Model::Itself is ready
+ # $model->{rw_config} = delete $model->{read_config} unless $multi_backend;
+ }
+
+ if ($model->{write_config}) {
+ $self->show_legacy_issue("$config_class_name: write_config specification is deprecated, please merge with read_config and move in rw_config", 'note');
+ # TODO: enable once Config::Model::Itself is ready
+ #if (not $multi_backend) {
+ # map {$model->{rw_config}{$_} = $model->{write_config}{$_} } keys %{$model->{write_config}} ;
+ # delete $model->{write_config};
+ #}
+ }
+}
+
sub translate_cargo_info {
my $self = shift;
my $config_class_name = shift;
@@ -717,15 +750,14 @@ sub translate_cargo_info {
) if $legacy_logger->is_debug;
}
-# TODO: set to die In September 2016
sub translate_id_names {
my $self = shift;
my $config_class_name = shift;
my $elt_name = shift;
my $info = shift;
- $self->translate_name( $config_class_name, $elt_name, $info, 'allow', 'allow_keys', 'warn' );
- $self->translate_name( $config_class_name, $elt_name, $info, 'allow_from', 'allow_keys_from', 'warn' );
- $self->translate_name( $config_class_name, $elt_name, $info, 'follow', 'follow_keys_from', 'warn' );
+ $self->translate_name( $config_class_name, $elt_name, $info, 'allow', 'allow_keys', 'die' );
+ $self->translate_name( $config_class_name, $elt_name, $info, 'allow_from', 'allow_keys_from', 'die' );
+ $self->translate_name( $config_class_name, $elt_name, $info, 'follow', 'follow_keys_from', 'die' );
}
sub translate_name {
@@ -1781,7 +1813,7 @@ Config::Model - Create tools to validate, migrate and edit configuration files
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
@@ -1808,9 +1840,9 @@ version 2.108
$model ->create_config_class (
name => "MiniModel",
element => [ [qw/foo bar baz/ ] => { type => 'leaf', value_type => 'uniline' }, ],
- read_config => { backend => 'IniFile', auto_create => 1,
- config_dir => '.', file => 'mini.ini',
- }
+ rw_config => { backend => 'IniFile', auto_create => 1,
+ config_dir => '.', file => 'mini.ini',
+ }
) ;
# create instance (Config::Model::Instance object)
@@ -1832,9 +1864,9 @@ version 2.108
$ mkdir -p lib/Config/Model/models/
$ echo "[ { name => 'MiniModel', \
element => [ [qw/foo bar baz/ ] => { type => 'leaf', value_type => 'uniline' }, ], \
- read_config => { backend => 'IniFile', auto_create => 1, \
- config_dir => '.', file => 'mini.ini', \
- } \
+ rw_config => { backend => 'IniFile', auto_create => 1, \
+ config_dir => '.', file => 'mini.ini', \
+ } \
} \
] ; " > lib/Config/Model/models/MiniModel.pl
# require App::Cme
diff --git a/lib/Config/Model/Annotation.pm b/lib/Config/Model/Annotation.pm
index 89cab3f..b391c62 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.108';
+$Config::Model::Annotation::VERSION = '2.110';
use Mouse;
use English;
@@ -164,7 +164,7 @@ Config::Model::Annotation - Read and write configuration annotations
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
diff --git a/lib/Config/Model/AnyId.pm b/lib/Config/Model/AnyId.pm
index abd47b5..fd26b9c 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.108';
+$Config::Model::AnyId::VERSION = '2.110';
use 5.010;
use Mouse;
@@ -1031,7 +1031,7 @@ Config::Model::AnyId - Base class for hash or list element
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
diff --git a/lib/Config/Model/AnyThing.pm b/lib/Config/Model/AnyThing.pm
index 24225e0..bab5aac 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.108';
+$Config::Model::AnyThing::VERSION = '2.110';
use Mouse;
# FIXME: must cleanup warp mechanism to implement this
@@ -327,7 +327,7 @@ Config::Model::AnyThing - Base class for configuration tree item
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Backend/Any.pm b/lib/Config/Model/Backend/Any.pm
index d3fe93a..ead2cd8 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.108';
+$Config::Model::Backend::Any::VERSION = '2.110';
use Carp;
use strict;
use warnings;
@@ -187,7 +187,7 @@ Config::Model::Backend::Any - Virtual class for other backends
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
@@ -279,23 +279,23 @@ L<Config::Model::Node> specification.
Let's say your new backend is C<Config::Model::Backend::Foo>. This new backend
can be specified with:
- read_config => [ {
+ rw_config => {
backend => 'Foo' , # can also be 'foo'
config_dir => '/etc/cfg_dir'
file => 'foo.conf', # optional
- }]
+ }
(The backend class name is constructed with C<ucfirst($backend_name)>)
-C<read_config> can also have custom parameters that are passed
+C<rw_config> can also have custom parameters that are passed
verbatim to C<Config::Model::Backend::Foo> methods:
- read_config => [ {
+ rw_config => {
backend => 'Foo' , # can also be 'foo'
config_dir => '/etc/cfg_dir'
file => 'foo.conf', # optional
my_param => 'my_value',
- } ]
+ }
C<Config::Model::Backend::Foo> class must inherit (extend)
L<Config::Model::Backend::Any> and is expected to provide the
diff --git a/lib/Config/Model/Backend/Json.pm b/lib/Config/Model/Backend/CdsFile.pm
similarity index 62%
copy from lib/Config/Model/Backend/Json.pm
copy to lib/Config/Model/Backend/CdsFile.pm
index 58f1ba4..1335a69 100644
--- a/lib/Config/Model/Backend/Json.pm
+++ b/lib/Config/Model/Backend/CdsFile.pm
@@ -7,8 +7,9 @@
#
# The GNU Lesser General Public License, Version 2.1, February 1999
#
-package Config::Model::Backend::Json;
-$Config::Model::Backend::Json::VERSION = '2.108';
+package Config::Model::Backend::CdsFile;
+$Config::Model::Backend::CdsFile::VERSION = '2.110';
+use 5.10.1;
use Carp;
use strict;
use warnings;
@@ -17,11 +18,10 @@ use File::Path;
use Log::Log4perl qw(get_logger :levels);
use base qw/Config::Model::Backend::Any/;
-use JSON;
-my $logger = get_logger("Backend::Json");
+my $logger = get_logger("Backend::CdsFile");
-sub suffix { return '.json'; }
+sub suffix { return '.cds'; }
sub read {
my $self = shift;
@@ -36,20 +36,11 @@ sub read {
# io_handle => $io # IO::File object
# check => yes|no|skip
- return 0 unless defined $args{io_handle}; # no file to read
+ my $file_path = $args{file_path};
+ return 0 unless defined $args{io_handle};
+ $logger->info("Read cds data from $file_path");
- # load Json file
- my $json = join( '', $args{io_handle}->getlines );
-
- # convert to perl data
- my $perl_data = decode_json $json ;
- if ( not defined $perl_data ) {
- $logger->warn("No data found in Json file $args{file_path}");
- return 1;
- }
-
- # load perl data in tree
- $self->{node}->load_data( data => $perl_data, check => $args{check} || 'yes' );
+ $self->node->load( step => [ $args{io_handle}->getlines ] );
return 1;
}
@@ -66,20 +57,17 @@ sub write {
# io_handle => $io # IO::File object
# check => yes|no|skip
- croak "Undefined file handle to write"
- unless defined $args{io_handle};
-
- my $perl_data = $self->{node}->dump_as_data( full_dump => $args{full_dump} );
- my $json = to_json( $perl_data, { pretty => 1 } );
-
- $args{io_handle}->print($json);
+ my $file_path = $args{file_path};
+ $logger->info("Write cds data to $file_path");
+ my $dump = $self->node->dump_tree( skip_auto_write => 'cds_file', check => $args{check} );
+ $args{io_handle}->print($dump);
return 1;
}
1;
-# ABSTRACT: Read and write config as a JSON data structure
+# ABSTRACT: Read and write config as a Cds data structure
__END__
@@ -89,11 +77,11 @@ __END__
=head1 NAME
-Config::Model::Backend::Json - Read and write config as a JSON data structure
+Config::Model::Backend::CdsFile - Read and write config as a Cds data structure
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
@@ -118,13 +106,12 @@ version 2.108
},
},
],
- read_config => [
- { backend => 'Json' ,
- config_dir => '/tmp',
- file => 'foo.json',
- auto_create => 1,
- }
- ],
+ rw_config => {
+ backend => 'cds_file' ,
+ config_dir => '/tmp',
+ file => 'foo.pl',
+ auto_create => 1,
+ }
) ;
my $inst = $model->instance(root_class_name => 'MyClass' );
@@ -136,46 +123,65 @@ version 2.108
$root->load( steps => $steps ) ;
$inst->write_back ;
-Now, C</tmp/foo.yml> contains:
+Now, C</tmp/foo.pl> contains:
{
- "bar" : "bla bla",
- "foo" : "yada",
- "baz" : {
- "hr" : "dobar dan",
- "en" : "hello",
- "fr" : "bonjour"
- }
+ bar => 'bla bla',
+ baz => {
+ en => 'hello',
+ fr => 'bonjour',
+ hr => 'dobar dan'
+ },
+ foo => 'yada'
}
=head1 DESCRIPTION
This module is used directly by L<Config::Model> to read or write the
-content of a configuration tree written with Json syntax in
+content of a configuration tree written with Cds syntax in
C<Config::Model> configuration tree.
-Note that undefined values are skipped for list element. I.e. if a
-list element contains C<('a',undef,'b')>, the data structure only
+Note:
+
+=over 4
+
+=item *
+
+Undefined values are skipped for list element. I.e. if a
+list element contains C<('a',undef,'b')>, the data structure
contains C<'a','b'>.
+=item *
+
+Cds file is not created (and may be deleted) when no data is to be
+written.
+
+=back
+
+=head1 backend parameter
+
+=head2 config_dir
+
+Mandoatory parameter to specify where is the Cds configuration file.
+
=head1 CONSTRUCTOR
-=head2 new ( node => $node_obj, name => 'Json' ) ;
+=head2 new
Inherited from L<Config::Model::Backend::Any>. The constructor is
called by L<Config::Model::BackendMgr>.
-=head2 read ( io_handle => ... )
+=head2 read
-Of all parameters passed to this read call-back, only C<io_handle> is
-used. This parameter must be an L<IO::File> object already opened for
+Of all parameters passed to this read call-back, only C<ifile_path> is
+used. This parameter must be L<IO::File> object already opened for
read.
It can also be undef. In which case C<read()> returns 0.
When a file is read, C<read()> returns 1.
-=head2 write ( io_handle => ... )
+=head2 write
Of all parameters passed to this write call-back, only C<io_handle> is
used. This parameter must be L<IO::File> object already opened for
diff --git a/lib/Config/Model/Backend/Fstab.pm b/lib/Config/Model/Backend/Fstab.pm
index 3900cff..76ea465 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.108';
+$Config::Model::Backend::Fstab::VERSION = '2.110';
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.108
+version 2.110
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Backend/IniFile.pm b/lib/Config/Model/Backend/IniFile.pm
index 1bdf327..6a80a39 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.108';
+$Config::Model::Backend::IniFile::VERSION = '2.110';
use Carp;
use Mouse;
use 5.10.0;
@@ -412,7 +412,7 @@ Config::Model::Backend::IniFile - Read and write config as a INI file
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
@@ -444,15 +444,13 @@ version 2.108
},
],
- read_config => [
- {
- backend => 'IniFile',
- config_dir => '/tmp',
- file => 'foo.conf',
- store_class_in_hash => 'ini_class',
- auto_create => 1,
- }
- ],
+ rw_config => {
+ backend => 'IniFile',
+ config_dir => '/tmp',
+ file => 'foo.conf',
+ store_class_in_hash => 'ini_class',
+ auto_create => 1,
+ }
);
my $inst = $model->instance(root_class_name => 'MyClass' );
@@ -646,45 +644,39 @@ The model has this structure:
\- key B (value is node of class_A)
\- element-bar
-In this case, the C<my_class_holder> name is specified in C<read_config> with C<store_class_in_hash>
+In this case, the C<my_class_holder> name is specified in C<rw_config> with C<store_class_in_hash>
parameter:
- read_config => [
- {
- backend => 'IniFile',
- config_dir => '/tmp',
- file => 'foo.ini',
- store_class_in_hash => 'my_class_holder',
- }
- ],
+ rw_config => {
+ backend => 'IniFile',
+ config_dir => '/tmp',
+ file => 'foo.ini',
+ store_class_in_hash => 'my_class_holder',
+ }
Of course they are exceptions. For instance, in C<Multistrap>, the C<[General]>
INI class must be mapped to a specific node object. This can be specified
with the C<section_map> parameter:
- read_config => [
- {
- backend => 'IniFile',
- config_dir => '/tmp',
- file => 'foo.ini',
- store_class_in_hash => 'my_class_holder',
- section_map => {
- General => 'general_node',
- }
- }
- ],
+ rw_config => }
+ backend => 'IniFile',
+ config_dir => '/tmp',
+ file => 'foo.ini',
+ store_class_in_hash => 'my_class_holder',
+ section_map => {
+ General => 'general_node',
+ }
+ }
C<section_map> can also map an INI class to the root node:
- read_config => [
- {
- backend => 'ini_file',
- store_class_in_hash => 'sections',
- section_map => {
- General => '!'
- },
- }
- ],
+ rw_config => {
+ backend => 'ini_file',
+ store_class_in_hash => 'sections',
+ section_map => {
+ General => '!'
+ },
+ }
=head1 Handle key value files
diff --git a/lib/Config/Model/Backend/Json.pm b/lib/Config/Model/Backend/Json.pm
index 58f1ba4..11b38cb 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.108';
+$Config::Model::Backend::Json::VERSION = '2.110';
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.108
+version 2.110
=head1 SYNOPSIS
@@ -118,13 +118,12 @@ version 2.108
},
},
],
- read_config => [
- { backend => 'Json' ,
- config_dir => '/tmp',
- file => 'foo.json',
- auto_create => 1,
- }
- ],
+ rw_config => {
+ backend => 'Json' ,
+ config_dir => '/tmp',
+ file => 'foo.json',
+ auto_create => 1,
+ }
) ;
my $inst = $model->instance(root_class_name => 'MyClass' );
diff --git a/lib/Config/Model/Backend/Json.pm b/lib/Config/Model/Backend/PerlFile.pm
similarity index 62%
copy from lib/Config/Model/Backend/Json.pm
copy to lib/Config/Model/Backend/PerlFile.pm
index 58f1ba4..3690fa1 100644
--- a/lib/Config/Model/Backend/Json.pm
+++ b/lib/Config/Model/Backend/PerlFile.pm
@@ -7,8 +7,9 @@
#
# The GNU Lesser General Public License, Version 2.1, February 1999
#
-package Config::Model::Backend::Json;
-$Config::Model::Backend::Json::VERSION = '2.108';
+package Config::Model::Backend::PerlFile;
+$Config::Model::Backend::PerlFile::VERSION = '2.110';
+use 5.10.1;
use Carp;
use strict;
use warnings;
@@ -17,11 +18,10 @@ use File::Path;
use Log::Log4perl qw(get_logger :levels);
use base qw/Config::Model::Backend::Any/;
-use JSON;
-my $logger = get_logger("Backend::Json");
+my $logger = get_logger("Backend::PerlFile");
-sub suffix { return '.json'; }
+sub suffix { return '.pl'; }
sub read {
my $self = shift;
@@ -36,20 +36,13 @@ sub read {
# io_handle => $io # IO::File object
# check => yes|no|skip
- return 0 unless defined $args{io_handle}; # no file to read
+ my $file_path = $args{file_path};
+ return 0 unless -r $file_path;
+ $file_path = "./$file_path" unless $file_path =~ m!^\.?/!;
+ $logger->info("Read Perl data from $file_path");
- # load Json file
- my $json = join( '', $args{io_handle}->getlines );
-
- # convert to perl data
- my $perl_data = decode_json $json ;
- if ( not defined $perl_data ) {
- $logger->warn("No data found in Json file $args{file_path}");
- return 1;
- }
-
- # load perl data in tree
- $self->{node}->load_data( data => $perl_data, check => $args{check} || 'yes' );
+ my $pdata = do $file_path || die "Cannot open $file_path:$?";
+ $self->node->load_data($pdata);
return 1;
}
@@ -66,20 +59,24 @@ sub write {
# io_handle => $io # IO::File object
# check => yes|no|skip
- croak "Undefined file handle to write"
- unless defined $args{io_handle};
+ my $file_path = $args{file_path};
+ $logger->info("Write perl data to $file_path");
- my $perl_data = $self->{node}->dump_as_data( full_dump => $args{full_dump} );
- my $json = to_json( $perl_data, { pretty => 1 } );
+ my $p_data = $self->node->dump_as_data(
+ skip_auto_write => 'perl_file',
+ check => $args{check}
+ );
+ my $dumper = Data::Dumper->new( [$p_data] );
+ $dumper->Terse(1);
- $args{io_handle}->print($json);
+ $args{io_handle}->print( $dumper->Dump, ";\n" );
return 1;
}
1;
-# ABSTRACT: Read and write config as a JSON data structure
+# ABSTRACT: Read and write config as a Perl data structure
__END__
@@ -89,11 +86,11 @@ __END__
=head1 NAME
-Config::Model::Backend::Json - Read and write config as a JSON data structure
+Config::Model::Backend::PerlFile - Read and write config as a Perl data structure
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
@@ -118,13 +115,12 @@ version 2.108
},
},
],
- read_config => [
- { backend => 'Json' ,
- config_dir => '/tmp',
- file => 'foo.json',
- auto_create => 1,
- }
- ],
+ rw_config => {
+ backend => 'perl_file' ,
+ config_dir => '/tmp',
+ file => 'foo.pl',
+ auto_create => 1,
+ },
) ;
my $inst = $model->instance(root_class_name => 'MyClass' );
@@ -136,46 +132,65 @@ version 2.108
$root->load( steps => $steps ) ;
$inst->write_back ;
-Now, C</tmp/foo.yml> contains:
+Now, C</tmp/foo.pl> contains:
{
- "bar" : "bla bla",
- "foo" : "yada",
- "baz" : {
- "hr" : "dobar dan",
- "en" : "hello",
- "fr" : "bonjour"
- }
+ bar => 'bla bla',
+ baz => {
+ en => 'hello',
+ fr => 'bonjour',
+ hr => 'dobar dan'
+ },
+ foo => 'yada'
}
=head1 DESCRIPTION
This module is used directly by L<Config::Model> to read or write the
-content of a configuration tree written with Json syntax in
+content of a configuration tree written with Perl syntax in
C<Config::Model> configuration tree.
-Note that undefined values are skipped for list element. I.e. if a
-list element contains C<('a',undef,'b')>, the data structure only
+Note:
+
+=over 4
+
+=item *
+
+Undefined values are skipped for list element. I.e. if a
+list element contains C<('a',undef,'b')>, the data structure
contains C<'a','b'>.
+=item *
+
+Perl file is not created (and may be deleted) when no data is to be
+written.
+
+=back
+
+=head1 backend parameter
+
+=head2 config_dir
+
+Mandoatory parameter to specify where is the Perl configuration file.
+
=head1 CONSTRUCTOR
-=head2 new ( node => $node_obj, name => 'Json' ) ;
+=head2 new
Inherited from L<Config::Model::Backend::Any>. The constructor is
called by L<Config::Model::BackendMgr>.
-=head2 read ( io_handle => ... )
+=head2 read
-Of all parameters passed to this read call-back, only C<io_handle> is
-used. This parameter must be an L<IO::File> object already opened for
+Of all parameters passed to this read call-back, only C<ifile_path> is
+used. This parameter must be L<IO::File> object already opened for
read.
It can also be undef. In which case C<read()> returns 0.
When a file is read, C<read()> returns 1.
-=head2 write ( io_handle => ... )
+=head2 write
Of all parameters passed to this write call-back, only C<io_handle> is
used. This parameter must be L<IO::File> object already opened for
diff --git a/lib/Config/Model/Backend/PlainFile.pm b/lib/Config/Model/Backend/PlainFile.pm
index 9c2347d..fbfdd1d 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.108';
+$Config::Model::Backend::PlainFile::VERSION = '2.110';
use 5.10.1;
use Carp;
use Mouse;
@@ -210,7 +210,7 @@ Config::Model::Backend::PlainFile - Read and write config as plain file
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
@@ -223,12 +223,10 @@ version 2.108
element => [
[qw/source new/] => { qw/type leaf value_type uniline/ },
],
- read_config => [
- {
- backend => 'plain_file',
- config_dir => '/tmp',
- },
- ],
+ rw_config => {
+ backend => 'plain_file',
+ config_dir => '/tmp',
+ },
);
my $inst = $model->instance(root_class_name => 'WithPlainFile' );
@@ -285,12 +283,12 @@ For instance, with the following model:
string_a => { type => 'leaf', value_type => 'string'}
string_b => { type => 'leaf', value_type => 'string'}
],
- read_config => [{
+ rw_config => {
backend => 'PlainFile',
config_dir => 'foo',
file => '&element(-).&element',
file_mode => 0644, # optional
- }]
+ }
If the configuration is loaded with C<example string_a=something
string_b=else>, this backend writes "C<something>" in file
diff --git a/lib/Config/Model/Backend/ShellVar.pm b/lib/Config/Model/Backend/ShellVar.pm
index a77007b..f672515 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.108';
+$Config::Model::Backend::ShellVar::VERSION = '2.110';
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.108
+version 2.110
=head1 SYNOPSIS
@@ -127,14 +127,12 @@ version 2.108
[qw/foo bar/] => {qw/type leaf value_type string/}
],
- read_config => [
- {
- backend => 'ShellVar',
- config_dir => '/tmp',
- file => 'foo.conf',
- auto_create => 1,
- }
- ],
+ rw_config => {
+ backend => 'ShellVar',
+ config_dir => '/tmp',
+ file => 'foo.conf',
+ auto_create => 1,
+ }
);
my $inst = $model->instance(root_class_name => 'MyClass' );
diff --git a/lib/Config/Model/Backend/Yaml.pm b/lib/Config/Model/Backend/Yaml.pm
index 4ac03bf..fd5bb6b 100644
--- a/lib/Config/Model/Backend/Yaml.pm
+++ b/lib/Config/Model/Backend/Yaml.pm
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Backend::Yaml;
-$Config::Model::Backend::Yaml::VERSION = '2.108';
+$Config::Model::Backend::Yaml::VERSION = '2.110';
use 5.10.1;
use Carp;
use strict;
@@ -123,7 +123,7 @@ Config::Model::Backend::Yaml - Read and write config as a YAML data structure
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
@@ -148,13 +148,12 @@ version 2.108
},
},
],
- read_config => [
- { backend => 'yaml' ,
- config_dir => '/tmp',
- file => 'foo.yml',
- auto_create => 1,
- }
- ],
+ rw_config => {
+ backend => 'yaml',
+ config_dir => '/tmp',
+ file => 'foo.yml',
+ auto_create => 1,
+ }
) ;
my $inst = $model->instance(root_class_name => 'MyClass' );
diff --git a/lib/Config/Model/BackendMgr.pm b/lib/Config/Model/BackendMgr.pm
index acc85e7..d347ba2 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.108';
+$Config::Model::BackendMgr::VERSION = '2.110';
use Mouse;
use strict;
use warnings;
@@ -218,7 +218,7 @@ sub load_backend_class {
$f =~ s/_(\w)/uc($1)/ge;
$c{$k} = $f;
- foreach my $c ( keys %c ) {
+ foreach my $c ( sort keys %c ) {
if ( $c->can($function) ) {
# no need to load class
@@ -229,7 +229,7 @@ sub load_backend_class {
# look for file to load
my $class_to_load;
- foreach my $c ( keys %c ) {
+ foreach my $c ( sort keys %c ) {
$logger->trace("load_backend_class: looking to load class $c");
foreach my $prefix (@INC) {
my $realfilename = "$prefix/$c{$c}";
@@ -254,19 +254,13 @@ sub read_config_data {
$logger->trace( "called for node ", $self->node->location );
- my $readlist_orig = delete $args{read_config};
+ my $readlist_orig = delete $args{rw_config};
my $check = delete $args{check};
- my $r_dir = delete $args{read_config_dir};
my $config_file_override = delete $args{config_file};
my $auto_create_override = delete $args{auto_create};
croak "unexpected args " . join( ' ', keys %args ) . "\n" if %args;
- # r_dir is obsolete
- if ( defined $r_dir ) {
- die $self->node->config_class_name, " : read_config_dir is obsolete\n";
- }
-
my $readlist = dclone $readlist_orig ;
my $instance = $self->node->instance();
@@ -274,19 +268,25 @@ sub read_config_data {
# root override is passed by the instance
my $root_dir = $instance->read_root_dir || '';
- croak "readlist must be array or hash ref\n"
- unless ref $readlist;
+ my @list;
+ if (ref $readlist eq 'ARRAY') {
+ say "Multiple backends are deprecated (read_config)" if @$readlist > 1;
+ @list = @$readlist ;
+ }
+ elsif (ref $readlist eq 'HASH') {
+ @list = ($readlist);
+ }
+ else {
+ croak "readlist must be a hash ref\n" unless ref $readlist;
+ }
- my @list = ref $readlist eq 'ARRAY' ? @$readlist : ($readlist);
my $pref_backend = $instance->backend || '';
my $read_done = 0;
my $auto_create = 0;
my @tried;
foreach my $read (@list) {
- warn $self->config_class_name, " deprecated 'syntax' parameter in backend\n"
- if defined $read->{syntax};
- my $backend = delete $read->{backend} || delete $read->{syntax} || 'custom';
+ my $backend = delete $read->{backend} || die "undefined read backend\n";
if ( $backend =~ /^(perl|ini|cds)$/ ) {
warn $self->config_class_name,
" deprecated backend $backend. Should be '$ {backend}_file'\n";
@@ -338,7 +338,7 @@ sub read_config_sub_layer {
Config::Model::Exception::Model->throw(
error => "backend error: unexpected default_layer parameters: "
- . join( ' ', keys %$layered_config ),
+ . join( ' ', sort keys %$layered_config ),
object => $self->node,
) if %$layered_config;
@@ -409,29 +409,9 @@ sub try_read_backend {
};
$error = $@;
}
- elsif ( $backend eq 'perl_file' ) {
- my ($file_ok, $fh);
- ( $file_ok, $file_path ) = $self->get_cfg_file_path(@read_args, suffix => '.pl' );
- return ( 0, $file_path ) if not $file_ok or not -r $file_path;
- $fh = $self->open_read_file($backend, $file_path);
- eval { $res = $self->read_perl( @read_args, file_path => $file_path, io_handle => $fh ); };
- $error = $@;
- }
- elsif ( $backend eq 'cds_file' ) {
- my ($file_ok, $fh);
- ( $file_ok, $file_path ) = $self->get_cfg_file_path(@read_args, suffix => '.cds' );
- return ( 0, $file_path ) if not $file_ok or not -r $file_path;
- $fh = $self->open_read_file($backend, $file_path);
- eval {
- $res = $self->read_cds_file(
- @read_args,
- file_path => $file_path,
- io_handle => $fh,
- );
- };
- $error = $@;
- }
else {
+ warn("function parameter for a backend is deprecated. Please implement 'read' method in backend $backend")
+ if $read->{function};
# try to load a specific Backend class
my $f = delete $read->{function} || 'read';
my $c = load_backend_class( $backend, $f );
@@ -493,17 +473,11 @@ sub try_read_backend {
sub auto_write_init {
my ( $self, %args ) = @_;
- my $wrlist_orig = delete $args{write_config};
- my $w_dir = delete $args{write_config_dir};
+ my $wrlist_orig = delete $args{rw_config};
- croak "auto_write_init: unexpected args " . join( ' ', keys %args ) . "\n"
+ croak "auto_write_init: unexpected args " . join( ' ', sort keys %args ) . "\n"
if %args;
- # w_dir is obsolete
- if ( defined $w_dir ) {
- die $self->config_class_name, " : write_config_dir is obsolete\n";
- }
-
my $wrlist = dclone $wrlist_orig ;
my $instance = $self->node->instance();
@@ -511,7 +485,17 @@ sub auto_write_init {
# root override is passed by the instance
my $root_dir = $instance->write_root_dir || '';
- my @array = ref $wrlist eq 'ARRAY' ? @$wrlist : ($wrlist);
+ my @array;
+ if (ref $wrlist eq 'ARRAY') {
+ say "Multiple backends are deprecated (write_config)\n" if @$wrlist > 1;
+ @array = @$wrlist ;
+ }
+ elsif (ref $wrlist eq 'HASH') {
+ @array = ($wrlist);
+ }
+ else {
+ croak "wrlist must be a hash ref\n" unless ref $wrlist;
+ }
# ensure that one auto_create specified applies to all wr backends
my $auto_create = 0;
@@ -522,9 +506,8 @@ sub auto_write_init {
# provide a proper write back function
foreach my $write (@array) {
- warn $self->config_class_name, " deprecated 'syntax' parameter in auto_write\n"
- if defined $write->{syntax};
- my $backend = delete $write->{backend} || delete $write->{syntax} || 'custom';
+ my $backend = delete $write->{backend} || die "undefined write backend\n";;
+
if ( $backend =~ /^(perl|ini|cds)$/ ) {
warn $self->config_class_name,
" deprecated backend $backend. Should be '$ {backend}_file'\n";
@@ -544,6 +527,10 @@ sub auto_write_init {
root => $root_dir, # override from instance
);
+ # used bby C::M::Dumper and C::M::DumpAsData
+ # TODO: is this needed once multi backend are removed
+ $self->{auto_write}{$backend} = 1;
+
my $wb;
if ( $backend eq 'custom' ) {
my $c = my $file = $write->{class};
@@ -575,44 +562,6 @@ sub auto_write_init {
$self->close_file_to_write( $error, $fh, $file_path, $write->{file_mode} );
return defined $res ? $res : $error ? 0 : 1;
};
- $self->{auto_write}{custom} = 1;
- }
- elsif ( $backend eq 'perl_file' ) {
- $wb = sub {
- $logger->debug( "write cb ($backend) called for ", $self->node->name );
- my ( $file_ok, $file_path, $fh ) =
- $self->open_file_to_write( $backend, suffix => '.pl', @wr_args, @_ );
- my $res;
- $res = eval {
- $self->write_perl( @wr_args, io_handle => $fh, file_path => $file_path, @_ );
- };
- my $error = $@;
- $logger->warn("write backend $backend failed: $error") if $error;
- $self->close_file_to_write( $error, $fh, $file_path, $write->{file_mode} );
- return defined $res ? $res : $error ? 0 : 1;
- };
- $self->{auto_write}{perl_file} = 1;
- }
- elsif ( $backend eq 'cds_file' ) {
- $wb = sub {
- $logger->debug( "write cb ($backend) called for ", $self->node->name );
- my ( $file_ok, $file_path, $fh ) =
- $self->open_file_to_write( $backend, suffix => '.cds', @wr_args, @_ );
- my $res;
- $res = eval {
- $self->write_cds_file(
- @wr_args,
- io_handle => $fh,
- file_path => $file_path,
- @_
- );
- };
- my $error = $@;
- $logger->warn("write backend $backend failed: $error") if $error;
- $self->close_file_to_write( $error, $fh, $file_path, $write->{file_mode} );
- return defined $res ? $res : $error ? 0 : 1;
- };
- $self->{auto_write}{cds_file} = 1;
}
else {
my $f = $write->{function} || 'write';
@@ -749,57 +698,6 @@ sub is_auto_write_for_type {
return $self->{auto_write}{$type} || 0;
}
-sub read_cds_file {
- my $self = shift;
- my %args = @_;
-
- my $file_path = $args{file_path};
- $logger->info("Read cds data from $file_path");
-
- $self->node->load( step => [ $args{io_handle}->getlines ] );
- return 1;
-}
-
-# TODO: replace with class based on Config::Model::Backend::Any
-sub write_cds_file {
- my $self = shift;
- my %args = @_;
- my $file_path = $args{file_path};
- $logger->info("Write cds data to $file_path");
-
- my $dump = $self->node->dump_tree( skip_auto_write => 'cds_file', check => $args{check} );
- $args{io_handle}->print($dump);
- return 1;
-}
-
-# TODO: replace with class based on Config::Model::Backend::Any
-sub read_perl {
- my $self = shift;
- my %args = @_;
-
- my $file_path = $args{file_path};
- $file_path = "./$file_path" unless $file_path =~ m!^\.?/!;
- $logger->info("Read Perl data from $file_path");
-
- my $pdata = do $file_path || die "Cannot open $file_path:$!";
- $self->node->load_data($pdata);
- return 1;
-}
-
-sub write_perl {
- my $self = shift;
- my %args = @_;
- my $file_path = $args{file_path};
- $logger->info("Write perl data to $file_path");
-
- my $p_data = $self->node->dump_as_data( skip_auto_write => 'perl_file', check => $args{check} );
- my $dumper = Data::Dumper->new( [$p_data] );
- $dumper->Terse(1);
-
- $args{io_handle}->print( $dumper->Dump, ";\n" );
- return 1;
-}
-
__PACKAGE__->meta->make_immutable;
1;
@@ -818,7 +716,7 @@ Config::Model::BackendMgr - Load configuration node on demand
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
@@ -840,8 +738,8 @@ version 2.108
$model->create_config_class(
name => "MyClass",
- # read_config spec is used by Config::Model::BackendMgr
- read_config => [
+ # rw_config spec is used by Config::Model::BackendMgr
+ rw_config => [
{
backend => 'yaml',
config_dir => '/tmp/',
@@ -919,7 +817,7 @@ L<Config::Model::Loader/"load string syntax">.
=item *
C<perl_file>: Perl data structure (perl) in a file. See L<Config::Model::DumpAsData>
-for details on the data structure.
+for details on the data structure. Now handled by L<Config::Model::Backend::PerlFile>
=item *
@@ -937,12 +835,12 @@ L<Config::Model::Instance>) to store back all configuration information.
The backend specification is provided as an attribute of a
L<Config::Model::Node> specification. These attributes are optional:
-A node without C<read_config> attribute must rely on another node for
-its data to be read and saved.
+A node without C<rw_config> attribute must rely on another node to
+read or save its data.
When needed (usually for the root node), the configuration class is
-declared with a C<read_config> parameter. This parameter is a list
-of possible backend. Usually, only one read backend is needed.
+declared with a C<rw_config> parameter which specifies the read/write
+backend configuration.
=head2 Parameters available for all backends
@@ -1024,19 +922,16 @@ By default, an exception is thrown if no read was
successful. This behavior can be overridden by specifying
C<< auto_create => 1 >> in one of the backend specification. For instance:
- read_config => [ {
+ rw_config => {
backend => 'IniFile',
config_dir => '/tmp',
file => 'foo.conf',
auto_create => 1
- } ],
+ },
Setting C<auto_create> to 1 is necessary to create a configuration
from scratch
-When C<auto_create> is set in write backend, missing directory and
-files are created with current umask. Default is false.
-
=item auto_delete
Delete configuration files that contains no data. (default is to leave an empty file)
@@ -1050,11 +945,11 @@ in their documentation.
For instance:
- read_config => [{
+ rw_config => {
backend => 'yaml',
config_dir => '/tmp/',
file => 'my_class.yml',
- }],
+ },
See L<Config::Model::Backend::Yaml> for more details for this backend.
@@ -1064,129 +959,9 @@ You can also write a dedicated backend. See
L<How to write your own backend|Config::Model::Backend::Any/"How to write your own backend">
for details.
-=head2 Built-in backend
-
-C<cds_file> and C<perl_file> backend must be specified with
-mandatory C<config_dir> parameter. For instance:
-
- read_config => {
- backend => 'cds_file' ,
- config_dir => '/etc/cfg_dir',
- file => 'cfg_file.cds', #optional
- },
-
-When C<file> is not specified, a file name is constructed with
-C<< <instance_name>.<suffix> >> where suffix is C<pl> or C<cds>.
-
=head2 Custom backend
-Custom backend is provided to be backward compatible but should not be used
-for new project.
-L<Writing your own backend|Config::Model::Backend::Any/"How to write your own backend">
-is preferred.
-
-Custom backend must be specified with a class name that features the
-methods used to write and read the configuration files:
-
- read_config => [ {
- backend => 'custom' ,
- class => 'MyRead',
- function => 'read_it", # optional, defaults to 'read'
- config_dir => '/etc/foo', # optional
- file => 'foo.conf', # optional
- } ]
-
-C<custom> backend parameters are:
-
-=over
-
-=item class
-
-Specify the class that contains the read methods
-
-=item function
-
-Function name that is called back to read the file.
-See L</"read callback"> for details. (default is C<read>)
-
-=item file
-
-optional. Configuration file. This parameter may not apply if the
-configuration is stored in several files. By default, the instance name
-is used as configuration file name.
-
-=back
-
-Most of the times, there's no need to create a write specification:
-the read specification is enough for this module to write back the
-configuration file.
-
-The write method must be specified if the writer class is not the same as the
-reader class or if the writer method is not C<write>:
-
- write_config => [ {
- backend => 'custom' ,
- class => 'MyWrite',
- function => 'write_it", # optional, defaults to 'read'
- config_dir => '/etc/foo', # optional
- file => 'foo.conf', # optional
- } ]
-
-Read callback function is called with these parameters:
-
- object => $obj, # Config::Model::Node object
- root => './my_test', # fake root directory, used for tests
- config_dir => /etc/foo', # absolute path
- file => 'foo.conf', # file name
- file_path => './my_test/etc/foo/foo.conf'
- io_handle => $io # IO::File object with binmode :utf8
- check => [yes|no|skip]
-
-The L<IO::File> object is undef if the file cannot be read.
-
-The callback must return 0 on failure and 1 on successful read.
-
-Write callback function is called with these parameters:
-
- object => $obj, # Config::Model::Node object
- root => './my_test', # fake root directory, used for tests
- config_dir => /etc/foo', # absolute path
- file => 'foo.conf', # file name
- file_path => './my_test/etc/foo/foo.conf'
- io_handle => $io # IO::File object opened in write mode
- # with binmode :utf8
- auto_create => 1 # create dir as needed
- check => [yes|no|skip]
-
-The L<IO::File> object is undef if the file cannot be written to.
-
-The callback must return 0 on failure and 1 on successful write.
-
-=head1 Using backend to change configuration file syntax
-
-C<read_config> tries all the specified backends. This feature
-can be used to migrate from one syntax to another.
-
-In this example, backend manager first tries to read an INI file
-and then to read a YAML file:
-
- read_config => [
- { backend => 'IniFile', ... },
- { backend => 'yaml', ... },
- ],
-
-When a read operation is successful, the remaining read methods are
-skipped.
-
-Likewise, the C<write_config> specification accepts several backends.
-By default, the specifications are tried in order, until the first succeeds.
-
-In the example above, the migration from INI to YAML can be achieved
-by specifying only the YAML backend:
-
- write_config => [
- { backend => 'yaml', ... },
- ],
+Custom backend is now deprecated and will soon be removed.
=head1 Test setup
@@ -1204,7 +979,7 @@ configuration file.
If this behavior causes problem (e.g. with augeas backend), the
solution is either to set C<file> to undef or an empty string in the
-C<write_config> specification.
+C<rw_config> specification.
=head1 Methods
diff --git a/lib/Config/Model/CheckList.pm b/lib/Config/Model/CheckList.pm
index 540800b..a525824 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.108';
+$Config::Model::CheckList::VERSION = '2.110';
use Mouse;
use 5.010;
@@ -747,7 +747,7 @@ Config::Model::CheckList - Handle check list element
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Cookbook/CreateModelFromDoc.pod b/lib/Config/Model/Cookbook/CreateModelFromDoc.pod
index 8aa7e97..c903d96 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.108
+version 2.110
=head1 Introduction
diff --git a/lib/Config/Model/Describe.pm b/lib/Config/Model/Describe.pm
index b755f5e..463c6aa 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.108';
+$Config::Model::Describe::VERSION = '2.110';
use Carp;
use strict;
use warnings;
@@ -214,7 +214,7 @@ Config::Model::Describe - Provide a description of a node element
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
diff --git a/lib/Config/Model/DumpAsData.pm b/lib/Config/Model/DumpAsData.pm
index a7730f0..50982ac 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.108';
+$Config::Model::DumpAsData::VERSION = '2.110';
use Carp;
use strict;
use warnings;
@@ -256,7 +256,7 @@ Config::Model::DumpAsData - Dump configuration content as a perl data structure
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Dumper.pm b/lib/Config/Model/Dumper.pm
index ed00802..eac118c 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.108';
+$Config::Model::Dumper::VERSION = '2.110';
use Carp;
use strict;
use warnings;
@@ -259,7 +259,7 @@ Config::Model::Dumper - Serialize data of config tree
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Exception.pm b/lib/Config/Model/Exception.pm
index 62b2b3c..a6e4221 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.108';
+$Config::Model::Exception::VERSION = '2.110';
use warnings;
use strict;
use Data::Dumper;
@@ -100,19 +100,19 @@ sub full_message {
}
package Config::Model::Exception::Any;
-$Config::Model::Exception::Any::VERSION = '2.108';
+$Config::Model::Exception::Any::VERSION = '2.110';
use Mouse;
extends 'Config::Model::Exception';
package Config::Model::Exception::ModelDeclaration;
-$Config::Model::Exception::ModelDeclaration::VERSION = '2.108';
+$Config::Model::Exception::ModelDeclaration::VERSION = '2.110';
use Mouse;
extends 'Config::Model::Exception::Fatal';
sub _desc {'configuration model declaration error' }
package Config::Model::Exception::User ;
-$Config::Model::Exception::User::VERSION = '2.108';
+$Config::Model::Exception::User::VERSION = '2.110';
use Mouse;
extends 'Config::Model::Exception::Any';
sub _desc {'user error' }
@@ -120,7 +120,7 @@ sub _desc {'user error' }
## old classes below
package Config::Model::Exception::Syntax;
-$Config::Model::Exception::Syntax::VERSION = '2.108';
+$Config::Model::Exception::Syntax::VERSION = '2.110';
use Mouse;
extends 'Config::Model::Exception::Any';
@@ -141,7 +141,7 @@ sub full_message {
}
package Config::Model::Exception::LoadData;
-$Config::Model::Exception::LoadData::VERSION = '2.108';
+$Config::Model::Exception::LoadData::VERSION = '2.110';
use Mouse;
extends 'Config::Model::Exception::User';
@@ -165,7 +165,7 @@ sub full_message {
}
package Config::Model::Exception::Model;
-$Config::Model::Exception::Model::VERSION = '2.108';
+$Config::Model::Exception::Model::VERSION = '2.110';
use Mouse;
extends 'Config::Model::Exception::Fatal';
@@ -198,7 +198,7 @@ sub full_message {
}
package Config::Model::Exception::Load;
-$Config::Model::Exception::Load::VERSION = '2.108';
+$Config::Model::Exception::Load::VERSION = '2.110';
use Mouse;
extends 'Config::Model::Exception::User';
@@ -227,7 +227,7 @@ sub full_message {
}
package Config::Model::Exception::UnavailableElement;
-$Config::Model::Exception::UnavailableElement::VERSION = '2.108';
+$Config::Model::Exception::UnavailableElement::VERSION = '2.110';
use Mouse;
extends 'Config::Model::Exception::User';
@@ -258,7 +258,7 @@ sub full_message {
}
package Config::Model::Exception::AncestorClass;
-$Config::Model::Exception::AncestorClass::VERSION = '2.108';
+$Config::Model::Exception::AncestorClass::VERSION = '2.110';
use Mouse;
extends 'Config::Model::Exception::User';
@@ -266,7 +266,7 @@ sub _desc { 'unknown ancestor class'}
package Config::Model::Exception::ObsoleteElement;
-$Config::Model::Exception::ObsoleteElement::VERSION = '2.108';
+$Config::Model::Exception::ObsoleteElement::VERSION = '2.110';
use Mouse;
extends 'Config::Model::Exception::User';
@@ -291,7 +291,7 @@ sub full_message {
}
package Config::Model::Exception::UnknownElement;
-$Config::Model::Exception::UnknownElement::VERSION = '2.108';
+$Config::Model::Exception::UnknownElement::VERSION = '2.110';
use Carp;
use Mouse;
@@ -368,14 +368,14 @@ sub full_message {
}
package Config::Model::Exception::WarpError;
-$Config::Model::Exception::WarpError::VERSION = '2.108';
+$Config::Model::Exception::WarpError::VERSION = '2.110';
use Mouse;
extends 'Config::Model::Exception::User';
sub _desc { 'warp error'}
package Config::Model::Exception::Fatal;
-$Config::Model::Exception::Fatal::VERSION = '2.108';
+$Config::Model::Exception::Fatal::VERSION = '2.110';
use Mouse;
extends 'Config::Model::Exception::Any';
@@ -383,7 +383,7 @@ sub _desc { 'fatal error' }
package Config::Model::Exception::UnknownId;
-$Config::Model::Exception::UnknownId::VERSION = '2.108';
+$Config::Model::Exception::UnknownId::VERSION = '2.110';
use Mouse;
extends 'Config::Model::Exception::User';
@@ -417,7 +417,7 @@ sub full_message {
}
package Config::Model::Exception::WrongValue;
-$Config::Model::Exception::WrongValue::VERSION = '2.108';
+$Config::Model::Exception::WrongValue::VERSION = '2.110';
use Mouse;
extends 'Config::Model::Exception::User';
@@ -425,7 +425,7 @@ sub _desc { 'wrong value'};
package Config::Model::Exception::WrongType;
-$Config::Model::Exception::WrongType::VERSION = '2.108';
+$Config::Model::Exception::WrongType::VERSION = '2.110';
use Mouse;
extends 'Config::Model::Exception::User';
@@ -459,14 +459,14 @@ sub full_message {
}
package Config::Model::Exception::ConfigFile;
-$Config::Model::Exception::ConfigFile::VERSION = '2.108';
+$Config::Model::Exception::ConfigFile::VERSION = '2.110';
use Mouse;
extends 'Config::Model::Exception::User';
sub _desc { 'error in configuration file' }
package Config::Model::Exception::ConfigFile::Missing;
-$Config::Model::Exception::ConfigFile::Missing::VERSION = '2.108';
+$Config::Model::Exception::ConfigFile::Missing::VERSION = '2.110';
use Mouse;
extends 'Config::Model::Exception::ConfigFile';
@@ -483,14 +483,14 @@ sub full_message {
}
package Config::Model::Exception::Formula;
-$Config::Model::Exception::Formula::VERSION = '2.108';
+$Config::Model::Exception::Formula::VERSION = '2.110';
use Mouse;
extends 'Config::Model::Exception::Model';
sub _desc { 'error in computation formula of the configuration model'}
package Config::Model::Exception::Internal;
-$Config::Model::Exception::Internal::VERSION = '2.108';
+$Config::Model::Exception::Internal::VERSION = '2.110';
use Mouse;
extends 'Config::Model::Exception::Fatal';
@@ -512,7 +512,7 @@ Config::Model::Exception - Exception mechanism for configuration model
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
diff --git a/lib/Config/Model/FuseUI.pm b/lib/Config/Model/FuseUI.pm
index ad05407..d9cb5e8 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.108';
+$Config::Model::FuseUI::VERSION = '2.110';
# there's no Singleton with Mouse
use Mouse;
@@ -327,7 +327,7 @@ Config::Model::FuseUI - Fuse virtual file interface for Config::Model
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
diff --git a/lib/Config/Model/HashId.pm b/lib/Config/Model/HashId.pm
index c5d6c23..081f402 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.108';
+$Config::Model::HashId::VERSION = '2.110';
use Mouse;
use 5.10.1;
@@ -538,7 +538,7 @@ Config::Model::HashId - Handle hash element for configuration model
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
diff --git a/lib/Config/Model/IdElementReference.pm b/lib/Config/Model/IdElementReference.pm
index a2cb748..879d745 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.108';
+$Config::Model::IdElementReference::VERSION = '2.110';
use Mouse;
use Carp;
@@ -190,7 +190,7 @@ Config::Model::IdElementReference - Refer to id element(s) and extract keys
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Instance.pm b/lib/Config/Model/Instance.pm
index a2fdf3c..0fa9a77 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.108';
+$Config::Model::Instance::VERSION = '2.110';
#use Scalar::Util qw(weaken) ;
use strict;
@@ -516,7 +516,7 @@ sub write_back {
"Try with -force option or add read/write backend to $info\n";
}
- foreach my $path ( $self->nodes_to_write_back ) {
+ foreach my $path ( sort $self->nodes_to_write_back ) {
$logger->info("write_back called on node $path");
if ( $path and $self->{config_file} ) {
@@ -633,7 +633,7 @@ Config::Model::Instance - Instance of configuration tree
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Iterator.pm b/lib/Config/Model/Iterator.pm
index f5f4f09..a86e7be 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.108';
+$Config::Model::Iterator::VERSION = '2.110';
use Carp;
use strict;
use warnings;
@@ -281,7 +281,7 @@ Config::Model::Iterator - Iterates forward or backward a configuration tree
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
diff --git a/lib/Config/Model/ListId.pm b/lib/Config/Model/ListId.pm
index f47fb11..51251bc 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.108';
+$Config::Model::ListId::VERSION = '2.110';
use 5.10.1;
use Mouse;
@@ -505,7 +505,7 @@ Config::Model::ListId - Handle list element for configuration model
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Lister.pm b/lib/Config/Model/Lister.pm
index cece457..e79492a 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.108';
+$Config::Model::Lister::VERSION = '2.110';
use strict;
use warnings;
use Exporter;
@@ -92,7 +92,7 @@ Config::Model::Lister - List available models and applications
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Loader.pm b/lib/Config/Model/Loader.pm
index 37793f9..47a8501 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.108';
+$Config::Model::Loader::VERSION = '2.110';
use Carp;
use strict;
use warnings;
@@ -128,7 +128,7 @@ sub _split_cmd {
(?:
(:~|:-[=~]?|:=~|:\.\w+|:[=<>@]?|~) # action
(?:
- (?: \( ( $quoted_string | [^)]+ ) \) ) # capture parameters between braces
+ (?: \( ( $quoted_string | [^)]+ ) \) ) # capture parameters between ( )
| (
/[^/]+/ # regexp
| (?:
@@ -137,16 +137,19 @@ sub _split_cmd {
)+
)
)?
- )?
+ )?
(?:
- (=~|.=|[=<>]) # apply regexp or assign or append
- (
- (?:
- $quoted_string
- | [^#\s] # or non whitespace
- )+ # many
- )
- )?
+ (=~|\.=|=\.\w+|[=<>]) # apply regexp or assign or append
+ (?:
+ (?: \( ( $quoted_string | [^)]+ ) \) ) # capture parameters between ( )
+ | (
+ (?:
+ $quoted_string
+ | [^#\s] # or non whitespace
+ )+ # many
+ )
+ )?
+ )?
(?:
\# # optional annotation
(
@@ -224,12 +227,12 @@ sub _load {
}
my @instructions = _split_cmd($cmd);
- my ( $element_name, $action, $function_param, $id, $subaction, $value, $note ) =
+ my ( $element_name, $action, $function_param, $id, $subaction, $value_function_param, $value, $note ) =
@instructions;
if ( $logger->is_debug ) {
my @disp = map { defined $_ ? "'$_'" : '<undef>' } @instructions;
- $logger->debug("_load instructions: @disp (left: $cmd)");
+ $logger->debug("_load instructions: @disp (from: $cmd)");
}
if ( not defined $element_name and not defined $note ) {
@@ -372,7 +375,7 @@ sub unquote {
sub _load_check_list {
my ( $self, $node, $check, $inst, $cmdref ) = @_;
- my ( $element_name, $action, $f_arg, $id, $subaction, $value, $note ) = @$inst;
+ my ( $element_name, $action, $f_arg, $id, $subaction, $f2_arg, $value, $note ) = @$inst;
my $element = $node->fetch_element( name => $element_name, check => $check );
@@ -516,7 +519,7 @@ sub _insort_hash_of_node {
sub _load_list {
my ( $self, $node, $check, $inst, $cmdref ) = @_;
- my ( $element_name, $action, $f_arg, $id, $subaction, $value, $note ) = @$inst;
+ my ( $element_name, $action, $f_arg, $id, $subaction, $f2_arg, $value, $note ) = @$inst;
my $element = $node->fetch_element( name => $element_name, check => $check );
@@ -610,7 +613,7 @@ sub _load_list {
sub _load_hash {
my ( $self, $node, $check, $inst, $cmdref ) = @_;
- my ( $element_name, $action, $f_arg, $id, $subaction, $value, $note ) = @$inst;
+ my ( $element_name, $action, $f_arg, $id, $subaction, $f2_arg, $value, $note ) = @$inst;
unquote( $id, $value, $note );
@@ -728,7 +731,7 @@ sub _load_hash {
sub _load_leaf {
my ( $self, $node, $check, $inst, $cmdref ) = @_;
- my ( $element_name, $action, $f_arg, $id, $subaction, $value, $note ) = @$inst;
+ my ( $element_name, $action, $f_arg, $id, $subaction, $f2_arg, $value, $note ) = @$inst;
unquote( $id, $value );
@@ -830,7 +833,7 @@ Config::Model::Loader - Load serialized data into config tree
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Manual/ModelCreationAdvanced.pod b/lib/Config/Model/Manual/ModelCreationAdvanced.pod
index 7b3e016..c7f63d5 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.108
+version 2.110
=head1 Introduction
diff --git a/lib/Config/Model/Manual/ModelCreationIntroduction.pod b/lib/Config/Model/Manual/ModelCreationIntroduction.pod
index 0e7e810..9fb62f2 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.108
+version 2.110
=head1 Introduction
@@ -727,56 +727,27 @@ notion in L<Creating a model with advanced features|Config::Model::Manual::Model
=head1 Reading configuration files
-Once the model is specified, Config::Model can generate a nice user
+Once the model is specified, L<Config::Model> can generate a nice user
interface, but there's still no way to load or write the configuration
file.
For Config::Model to read the file, the model designer must declare in
-the model how to read the file (the read backend).
+the model how to read and write the file (the read/write backend).
-The read method can use one or more of the following mechanisms:
+The read/write functionality is provided by a class inheriting
+C<Config::Model::Backend::Any> class like
+C<Config::Model::Backend::IniFile>
-=over
-
-=item *
-
-Built-in, e.g Perl file, INI file...
-
-=item *
-
-A plugin, i.e. a Perl C<Config::Model::Backend::*> class like C<Config::Model::Backend::Augeas>
-
-=item *
-
-A custom class where a read call-back must be provided
-
-=back
-
-For more details, see L<Config::Model::BackendMgr>.
-
-The name of the backend parameter must be specified in all cases.
-
-=head2 Using built-in read mechanism
-
-C<Config::Model> comes with 3 read/write built in mechanisms:
+The name of the backend parameter must match the backend class name
+without C<Config::Model::Backend>. As syntactic sugar, lower case
+backend name are transformed into upper case to match the backend
+class name.
-=over
-
-=item perl_file
-
-A perl data structure (like the ones produced by L<Data::Dumper>).
-See L<Config::Model::DumpAsData> for details.
-
-=item ini_file
+E.g.
-Windows INI file (note that only simple tree structure can use this backend)
-
-=item cds_file
-
-Config::Model own serialization format (a bit like YAML).
-See L<Config::Model::Dumper> for details.
-
-=back
+ Yaml -> Config::Model::Backend::Yaml
+ plain_file -> Config::Model::Backend::PlainFile
+ ini_file -> Config::Model::Backend::IniFile
With the backend name, the following parameters must be defined:
@@ -792,36 +763,27 @@ Config file name (optional). defaults to C<< <config_class_name>.[pl|ini|cds] >>
=back
- read_config => [ { backend => 'cds_file' ,
- config_dir => '/etc/cfg_dir',
- file => 'cfg_file.cds', # optional
- } ],
+ rw_config => { backend => 'ini_file' ,
+ config_dir => '/etc/cfg_dir',
+ file => 'cfg_file.ini',
+ },
-See L<Config::Model::BackendMgr.pm/Built-in_backend> for details
+See L<Config::Model::Backend::IniFile> for details
Note that these parameters can also be set with the graphical
-configuration model editor.
+configuration model editor (C<cme meta edit>).
-=head2 Using a plugin read mechanism
-
-A plugin backend class can also be specified with:
-
- read_config => [ { backend => 'foo' ,
- config_dir => '/etc/cfg_dir'
- } ]
-
-In this case, Config::Model tries to load C<Config::Model::Backend::Foo>.
-(The class name is constructed with C<ucfirst($backend_name)>)
-
-C<read_config> can also have custom parameters that are passed
+C<rw_config> can also have custom parameters that are passed
verbatim to C<Config::Model::Backend::Foo> methods:
- read_config => [ { backend => 'foo' ,
- config_dir => '/etc/cfg_dir',
- my_param => 'my_value',
- } ]
+ rw_config => {
+ backend => 'my_backend',
+ config_dir => '/etc/cfg_dir',
+ my_param => 'my_value',
+ }
-This C<Config::Model::Backend::Foo> class is expected to provide the following methods:
+This C<Config::Model::Backend::MyBackend> class is expected to inherit
+L<Config::Model::Backend::Any> and provide the following methods:
=over
@@ -836,149 +798,6 @@ This C<Config::Model::Backend::Foo> class is expected to provide the following m
Their signatures are explained in
L<Config::Model::BackendMgr doc on plugin backends|Config::Model::BackendMgr/Plugin_backend_classes>
-=head2 Using a custom class
-
-In case the plugin mechanism is not possible, a class with an
-arbitrary name can be specified:
-
- read_config => [ { backend => 'custom' ,
- class => 'MyRead',
- config_dir => '/etc/foo', # optional
- file => 'foo.conf', # optional
- } ]
-
-Even the read method can have an arbitrary name by specifying a
-C<function> parameters.
-
-For more details on available parameters on custom backends, see
-L<Config::Model::BackendMgr doc on custom backends|Config::Model::BackendMgr/Custom_backend>
-
-=head2 Using several read mechanisms
-
-Several read mechanism can be specified to enable:
-
-=over
-
-=item *
-
-Migration from one syntax to another
-
-=item *
-
-Usage of different libraries (e.g. L<Augeas|http://augeas.net> or pure Perl backend)
-
-=back
-
-For instance, to try Augeas and fall back on a custom class in case of problem, specify:
-
- read_config => [ {
- save => 'backup',
- file => 'sshd_config',
- backend => 'augeas',
- config_dir => '/etc/ssh'
- },
- {
- function => 'sshd_read',
- backend => 'custom',
- class => 'Config::Model::OpenSsh',
- config_dir => '/etc/ssh'
- } ],
-
-Both specifications are tried in order. If Augeas backend fails
-(e.g. Augeas is not installed), the custom backend is used.
-
-An exception is raised if both methods fails. This behavior is
-correct for C<OpenSsh>, but it can be a problem if you want to use
-Config::Model to create a configuration file from scratch. In this
-case you should also specify the C<auto_create> parameter:
-
- read_config => [ { backend => 'custom' ,
- class => 'ProcessRead' ,
- config_dir => '/etc/foo',
- file => 'foo.conf',
- auto_create => 1,
- } ],
-
-=head1 Writing configuration files
-
-Read and write specifications were designed to be very similar. Most
-of the times, the C<read> and C<write> specification are
-identical. In this case, there's no need to enter them: the data
-specified in the C<read> specification is used to write the
-configuration file.
-
-Here's an example:
-
- write_config => [ { backend => 'custom',
- class => 'NewFormat'
- function => 'my_write',
- }
- ],
-
-Several C<write> specification can be used. They are tried in order,
-until the first succeeds.
-
-For more information, see
-L<write specification doc|Config::Model::BackendMgr.pm/write_specification>
-
-=head1 Syntax migration example
-
-By combining multiple read specification with C<'one>' write
-specification, a configuration file can be migrated from old to new
-syntax. The following example migrates a configuration file from a
-custom syntax to a perl data file:
-
- {
- name => 'Example',
- element => [ ... ] ,
- read_config => [ { backend => 'perl_file',
- config_dir => '/etc/my_cfg/'
- } ,
- { backend => 'custom',
- class => 'Bar'
- },
- ],
- write_config => [ { backend => 'perl_file',
- config_dir => '/etc/my_cfg/'
- }
- ],
- }
-
-How does this work ? Here's the sequence:
-
-=over
-
-=item 1.
-
-Configuration is stored in old file C</etc/my_cfg/bar.conf>
-
-=item 2.
-
-Config::Model tries to read the config with C<perl_file> read backend
-and looks for C</etc/my_cfg/example.pl>. This file is not found so the
-read fails.
-
-=item 3.
-
-Config::Model tries the second backend which succeeds and load
-configuration data in the configuration tree
-
-=item 4.
-
-Config::Model writes data back from configuration tree using
-C<write_config> backend which writes C</etc/my_cfg/example.pl>
-
-=item 5.
-
-At the next invocation, the first C<read> backend will successfully
-read the perl configuration file. The old file is left alone and can
-be removed later by the system admin.
-
-=back
-
-Thanks to this mechanism, this operation is idempotent so it can
-safely be scripted in package scriplets.
-
=head1 SEE ALSO
=over
diff --git a/lib/Config/Model/Node.pm b/lib/Config/Model/Node.pm
index 46ea8ca..2b9f0ee 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.108';
+$Config::Model::Node::VERSION = '2.110';
use Mouse;
with "Config::Model::Role::NodeLoader";
@@ -324,7 +324,8 @@ sub init {
my $model = $self->{model};
return
- unless defined $model->{read_config}
+ unless defined $model->{rw_config}
+ or defined $model->{read_config}
or defined $model->{write_config};
my $initial_load_backup = $self->instance->initial_load;
@@ -336,20 +337,27 @@ sub init {
node => $self,
);
- if ( defined $model->{read_config} ) {
+ if ( $model->{rw_config} or $model->{read_config} ) {
+ # TODO: change to warn
$self->read_config_data( check => $args{check} // $self->check );
+ say "read_config parameter for backend is deprecated. ",
+ "Please use rw_config to specify both read and write parameters.\n" if $model->{read_config};
+ }
+
+ if (defined $model->{write_config}) {
+ # TODO: change to warn
+ say "write_config parameter for backend is deprecated. ",
+ "Please use only rw_config to specify both read and write parameters.\n";
}
# use read_config data if write_config is missing
$model->{write_config} ||= dclone $model->{read_config}
if defined $model->{read_config};
- if ( $model->{write_config} ) {
-
- # setup auto_write, write_config_dir is obsolete
+ if ( $model->{rw_config} || $model->{write_config} ) {
+ # setup auto_write
$self->backend_mgr->auto_write_init(
- write_config => $model->{write_config},
- write_config_dir => $model->{write_config_dir},
+ rw_config => $model->{rw_config} || $model->{write_config},
);
}
@@ -366,12 +374,11 @@ sub read_config_data {
$self->location, ")\n";
}
- # setup auto_read, read_config_dir is obsolete
+ # setup auto_read
# may use an overridden config file
$self->backend_mgr->read_config_data(
- read_config => $model->{read_config},
+ rw_config => $model->{rw_config} || $model->{read_config},
check => $args{check},
- read_config_dir => $model->{read_config_dir},
config_file => $args{config_file} || $self->{config_file},
auto_create => $args{auto_create} || $self->instance->auto_create,
);
@@ -953,7 +960,7 @@ sub load_data {
"Node load_data (",
$self->location,
") will load elt ",
- join( ' ', keys %$perl_data ) );
+ join( ' ', sort keys %$perl_data ) );
# data must be loaded according to the element order defined by
# the model. This will not load not yet accepted parameters
@@ -1208,7 +1215,7 @@ Config::Model::Node - Class for configuration tree node
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
@@ -1365,9 +1372,7 @@ when generating user interfaces.
Optional C<list ref> of element descriptions. These descriptions may be
used when generating user interfaces.
-=item B<read_config>
-
-=item B<write_config>
+=item B<rw_config>
=item B<config_dir>
diff --git a/lib/Config/Model/ObjTreeScanner.pm b/lib/Config/Model/ObjTreeScanner.pm
index 59aeb45..9dff4fd 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.108';
+$Config::Model::ObjTreeScanner::VERSION = '2.110';
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.108
+version 2.110
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Report.pm b/lib/Config/Model/Report.pm
index c8144c0..4377841 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.108';
+$Config::Model::Report::VERSION = '2.110';
use Carp;
use strict;
use warnings;
@@ -90,7 +90,7 @@ Config::Model::Report - Reports data from config tree
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Role/ComputeFunction.pm b/lib/Config/Model/Role/ComputeFunction.pm
index 9437833..5f19cd5 100644
--- a/lib/Config/Model/Role/ComputeFunction.pm
+++ b/lib/Config/Model/Role/ComputeFunction.pm
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Role::ComputeFunction;
-$Config::Model::Role::ComputeFunction::VERSION = '2.108';
+$Config::Model::Role::ComputeFunction::VERSION = '2.110';
# ABSTRACT: compute &index or &element functions
use Mouse::Role;
@@ -88,7 +88,7 @@ Config::Model::Role::ComputeFunction - compute &index or &element functions
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Role/Grab.pm b/lib/Config/Model/Role/Grab.pm
index d1769a9..0c6df7e 100644
--- a/lib/Config/Model/Role/Grab.pm
+++ b/lib/Config/Model/Role/Grab.pm
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Role::Grab;
-$Config::Model::Role::Grab::VERSION = '2.108';
+$Config::Model::Role::Grab::VERSION = '2.110';
# ABSTRACT: Role to grab data from elsewhere in the tree
use Mouse::Role;
@@ -366,7 +366,7 @@ Config::Model::Role::Grab - Role to grab data from elsewhere in the tree
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Role/HelpAsText.pm b/lib/Config/Model/Role/HelpAsText.pm
index ed561f2..f6f5d5e 100644
--- a/lib/Config/Model/Role/HelpAsText.pm
+++ b/lib/Config/Model/Role/HelpAsText.pm
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Role::HelpAsText;
-$Config::Model::Role::HelpAsText::VERSION = '2.108';
+$Config::Model::Role::HelpAsText::VERSION = '2.110';
# ABSTRACT: Transalet element help from pod to text
use Mouse::Role;
@@ -57,7 +57,7 @@ Config::Model::Role::HelpAsText - Transalet element help from pod to text
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Role/NodeLoader.pm b/lib/Config/Model/Role/NodeLoader.pm
index 84b0dbe..d2cd7da 100644
--- a/lib/Config/Model/Role/NodeLoader.pm
+++ b/lib/Config/Model/Role/NodeLoader.pm
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Role::NodeLoader;
-$Config::Model::Role::NodeLoader::VERSION = '2.108';
+$Config::Model::Role::NodeLoader::VERSION = '2.110';
# ABSTRACT: Load Node element in configuration tree
use Mouse::Role;
@@ -44,7 +44,7 @@ Config::Model::Role::NodeLoader - Load Node element in configuration tree
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Role/WarpMaster.pm b/lib/Config/Model/Role/WarpMaster.pm
index a884d09..d2daa35 100644
--- a/lib/Config/Model/Role/WarpMaster.pm
+++ b/lib/Config/Model/Role/WarpMaster.pm
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Role::WarpMaster;
-$Config::Model::Role::WarpMaster::VERSION = '2.108';
+$Config::Model::Role::WarpMaster::VERSION = '2.110';
# ABSTRACT: register and trigger a warped element
use Mouse::Role;
@@ -106,7 +106,7 @@ Config::Model::Role::WarpMaster - register and trigger a warped element
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
diff --git a/lib/Config/Model/SearchElement.pm b/lib/Config/Model/SearchElement.pm
index 22ac50d..b45a1ce 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.108';
+$Config::Model::SearchElement::VERSION = '2.110';
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.108
+version 2.110
=head1 SYNOPSIS
diff --git a/lib/Config/Model/SimpleUI.pm b/lib/Config/Model/SimpleUI.pm
index b252f0f..7b27ab9 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.108';
+$Config::Model::SimpleUI::VERSION = '2.110';
use Carp;
use 5.010;
use strict;
@@ -338,7 +338,7 @@ Config::Model::SimpleUI - Simple interface for Config::Model
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
diff --git a/lib/Config/Model/TermUI.pm b/lib/Config/Model/TermUI.pm
index 45be72e..d093e58 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.108';
+$Config::Model::TermUI::VERSION = '2.110';
use Carp;
use utf8; # so literals and identifiers can be in UTF-8
use v5.12; # or later to get "unicode_strings" feature
@@ -238,7 +238,7 @@ Config::Model::TermUI - Interactive command line interface for cme
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
diff --git a/lib/Config/Model/TreeSearcher.pm b/lib/Config/Model/TreeSearcher.pm
index 7174a59..44fe0b2 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.108';
+$Config::Model::TreeSearcher::VERSION = '2.110';
use Mouse;
use Mouse::Util::TypeConstraints;
@@ -147,7 +147,7 @@ Config::Model::TreeSearcher - Search tree for match in value, description...
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Utils/GenClassPod.pm b/lib/Config/Model/Utils/GenClassPod.pm
index d74afd0..0e9a7a9 100644
--- a/lib/Config/Model/Utils/GenClassPod.pm
+++ b/lib/Config/Model/Utils/GenClassPod.pm
@@ -8,7 +8,7 @@
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Utils::GenClassPod;
-$Config::Model::Utils::GenClassPod::VERSION = '2.108';
+$Config::Model::Utils::GenClassPod::VERSION = '2.110';
# ABSTRACT: generate pod documentation from configuration models
use strict;
@@ -57,7 +57,7 @@ Config::Model::Utils::GenClassPod - generate pod documentation from configuratio
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Value.pm b/lib/Config/Model/Value.pm
index a86719b..34cb3c1 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.108';
+$Config::Model::Value::VERSION = '2.110';
use 5.10.1;
use Mouse;
@@ -409,10 +409,10 @@ sub setup_match_regexp {
return unless defined $str;
my $vt = $self->{value_type};
- if ( $vt ne 'uniline' and $vt ne 'string' ) {
+ if ( $vt ne 'uniline' and $vt ne 'string' and $vt ne 'enum') {
Config::Model::Exception::Model->throw(
object => $self,
- error => "Can't use $what regexp with $vt, " . "expected 'uniline' or 'string'"
+ error => "Can't use $what regexp with $vt, expected 'enum', 'uniline' or 'string'"
);
}
@@ -437,10 +437,10 @@ sub check_validation_regexp {
my $vt = $self->{value_type};
- if ( $vt ne 'uniline' and $vt ne 'string' ) {
+ if ( $vt ne 'uniline' and $vt ne 'string' and $vt ne 'enum') {
Config::Model::Exception::Model->throw(
object => $self,
- error => "Can't use $what regexp with $vt, " . "expected 'uniline' or 'string'"
+ error => "Can't use $what regexp with $vt, expected 'enum', 'uniline' or 'string'"
);
}
@@ -1809,7 +1809,7 @@ Config::Model::Value - Strongly typed configuration value
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Value/LayeredInclude.pm b/lib/Config/Model/Value/LayeredInclude.pm
index 6abbe9a..4ee1845 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.108';
+$Config::Model::Value::LayeredInclude::VERSION = '2.110';
use 5.010;
use strict;
use warnings;
@@ -108,7 +108,7 @@ Config::Model::Value::LayeredInclude - Include a sub layer configuration
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
diff --git a/lib/Config/Model/ValueComputer.pm b/lib/Config/Model/ValueComputer.pm
index 731f3e8..2a32584 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.108';
+$Config::Model::ValueComputer::VERSION = '2.110';
use Mouse;
use MouseX::StrictConstructor;
@@ -549,7 +549,7 @@ Config::Model::ValueComputer - Provides configuration value computation
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
diff --git a/lib/Config/Model/WarpedNode.pm b/lib/Config/Model/WarpedNode.pm
index 82856a1..72897f8 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.108';
+$Config::Model::WarpedNode::VERSION = '2.110';
use Mouse;
use Carp qw(cluck croak);
@@ -313,7 +313,7 @@ Config::Model::WarpedNode - Node that change config class properties
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
diff --git a/lib/Config/Model/Warper.pm b/lib/Config/Model/Warper.pm
index 4b858d0..681fcfb 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.108';
+$Config::Model::Warper::VERSION = '2.110';
use Mouse;
use Log::Log4perl qw(get_logger :levels);
@@ -620,7 +620,7 @@ Config::Model::Warper - Warp tree properties
=head1 VERSION
-version 2.108
+version 2.110
=head1 SYNOPSIS
diff --git a/t/annotation.t b/t/annotation.t
index 5b6135e..5adf3e0 100644
--- a/t/annotation.t
+++ b/t/annotation.t
@@ -21,7 +21,7 @@ my $trace = $arg =~ /t/ ? 1 : 0;
Config::Model::Exception::Any->Trace(1) if $arg =~ /e/;
# pseudo root where config files are written by config-model
-my $wr_root = 'wr_root/';
+my $wr_root = 'wr_root_p/annotation/';
# cleanup before tests
rmtree($wr_root);
@@ -89,10 +89,10 @@ my $annotate_saver = Config::Model::Annotation->new(
ok( $annotate_saver, "created annotation read/write object" );
my $yaml_dir = $annotate_saver->dir;
-is( $yaml_dir, 'wr_root/config-model/', "check saved dir" );
+is( $yaml_dir, $wr_root.'config-model/', "check saved dir" );
my $yaml_file = $annotate_saver->file;
-is( $yaml_file, 'wr_root/config-model/Master-note.pl', "check saved file" );
+is( $yaml_file, $wr_root.'config-model/Master-note.pl', "check saved file" );
my $h_ref = $annotate_saver->get_annotation_hash();
diff --git a/t/backend_ini.t b/t/backend_ini.t
index 7b07c22..48de847 100644
--- a/t/backend_ini.t
+++ b/t/backend_ini.t
@@ -36,7 +36,7 @@ Config::Model::Exception::Any->Trace(1) if $arg =~ /e/;
ok( 1, "compiled" );
# pseudo root where config files are written by config-model
-my $wr_root = 'wr_root/';
+my $wr_root = 'wr_root_p/backend-ini/';
# set_up data
my @with_semicolon_comment = my @with_one_semicolon_comment = my @with_hash_comment = <DATA>;
diff --git a/t/backend_ini_with_section_map.t b/t/backend_ini_with_section_map.t
index c954e3f..f8b6110 100644
--- a/t/backend_ini_with_section_map.t
+++ b/t/backend_ini_with_section_map.t
@@ -37,7 +37,7 @@ Config::Model::Exception::Any->Trace(1) if $arg =~ /e/;
ok( 1, "compiled" );
# pseudo root where config files are written by config-model
-my $wr_root = 'wr_root/';
+my $wr_root = 'wr_root_p/backend-ini-section-map';
my $head = << 'EOH';
## This file was written by cme command.
diff --git a/t/backend_mgr.t b/t/backend_mgr.t
index 644ccee..18c650a 100644
--- a/t/backend_mgr.t
+++ b/t/backend_mgr.t
@@ -37,7 +37,7 @@ my $model = Config::Model->new();
ok( 1, "compiled" );
# pseudo root for config files
-my $wr_root = path('wr_root');
+my $wr_root = path('wr_root_p/backend-mgr');
my $root1 = $wr_root->child('test1');
my $root2 = $wr_root->child('test2');
my $root3 = $wr_root->child('test3');
@@ -47,6 +47,8 @@ my $conf_dir = '/etc/test/';
# cleanup before tests
$wr_root->remove_tree;
+map { $_->mkpath } ($root1, $root2, $root3);
+
# model declaration
$model->create_config_class(
name => 'Level2',
@@ -504,7 +506,7 @@ $ctoto->write_back;
map {
is(
$result{simple_rw}{$_},
- 'wr_root/test3//etc/test/toto.conf',
+ $wr_root.'/test3//etc/test/toto.conf',
"Check Simple_Rw cb file argument ($_)"
)
} qw/rfile wfile/;
diff --git a/t/backend_multiple.t b/t/backend_multiple.t
index 4a5a558..8345113 100644
--- a/t/backend_multiple.t
+++ b/t/backend_multiple.t
@@ -36,7 +36,7 @@ my $model = Config::Model->new( legacy => 'ignore', );
ok( 1, "compiled" );
# pseudo root where config files are written by config-model
-my $wr_root = 'wr_root/';
+my $wr_root = 'wr_root_p/backend-multiple/';
# cleanup before tests
rmtree($wr_root);
diff --git a/t/backend_plainfile.t b/t/backend_plainfile.t
index 11b1ae6..3715166 100644
--- a/t/backend_plainfile.t
+++ b/t/backend_plainfile.t
@@ -50,7 +50,7 @@ $model->create_config_class(
);
# pseudo root where config files are written by config-model
-my $wr_root = 'wr_root/';
+my $wr_root = 'wr_root_p/backend-plain-file/';
# cleanup before tests
rmtree($wr_root);
diff --git a/t/backend_yaml.t b/t/backend_yaml.t
index 33e65b1..5da71e5 100644
--- a/t/backend_yaml.t
+++ b/t/backend_yaml.t
@@ -26,7 +26,7 @@ my $model = Config::Model->new();
ok( 1, "compiled" );
# pseudo root where config files are written by config-model
-my $wr_root = path('wr_root');
+my $wr_root = path('wr_root_p/backend-yaml');
# cleanup before tests
$wr_root->remove_tree;
diff --git a/t/cme-function.t b/t/cme-function.t
index bdce47f..e604a12 100644
--- a/t/cme-function.t
+++ b/t/cme-function.t
@@ -7,7 +7,7 @@ use Test::More;
use Config::Model qw/cme/;
# pseudo root where config files are written by config-model
-my $wr_root = path('wr_root');
+my $wr_root = path('wr_root_p/cme');
# cleanup before tests
$wr_root->remove_tree;
diff --git a/t/fuse_ui.t b/t/fuse_ui.t
index 3f8a1ca..fde820d 100644
--- a/t/fuse_ui.t
+++ b/t/fuse_ui.t
@@ -75,7 +75,7 @@ else {
ok( 1, "Compilation done" );
# pseudo root where config files are written by config-model
-my $wr_root = path('wr_root');
+my $wr_root = path('wr_root_p/fuse');
# cleanup before tests
$wr_root->remove_tree;
diff --git a/t/include.t b/t/include.t
index b8c3da8..d8234fa 100644
--- a/t/include.t
+++ b/t/include.t
@@ -122,10 +122,11 @@ $model->create_config_class(
'read_config' => $read_config
);
-
my $xorg_model = $model->get_model('LikeXorg');
-eq_or_diff($xorg_model->{read_config}, $read_config,"check included read specification");
+# use because of legacy translation from read_config array to rw_config
+note("need to adapt with rw_config");
+eq_or_diff($xorg_model->{read_config}, $read_config->[0],"check included read specification");
memory_cycle_ok($model, "memory cycles");
diff --git a/t/load.t b/t/load.t
index 092cef6..ba901b3 100644
--- a/t/load.t
+++ b/t/load.t
@@ -47,61 +47,70 @@ ok( 1, "compiled" );
# test mega regexp, 'x' means undef
my @regexp_test = (
- # id_operation leaf_operation
- # string elt 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"' ] ],
- [ '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=~/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"' ] ],
-
- # string elt op (param) id op val note
- [ '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:~', [ 'a', ':~', 'x', 'x', 'x', 'x', 'x' ] ], # loop on matched value
- [ 'a:~.=b', [ 'a', ':~', 'x', 'x', '.=', 'b', 'x' ] ], # loop on matched value
- [ 'a:~/b.*/', [ 'a', ':~', 'x', '/b.*/', 'x', 'x', 'x' ] ], # loop on matched value
- [ '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 at foo.com"', [ 'a', ':=', 'x', '"dod at 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#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
- [ 'a:-=b', [ 'a', ':-=', 'x', 'b', 'x', 'x', 'x' ] ], # remove value b from list or hash
- [ 'a:-~/b/', [ 'a', ':-~', 'x', '/b/', 'x', 'x', 'x' ] ], # remove value matching stuff
- [ 'a:=~s/b/c/g', [ 'a', ':=~', 'x', 's/b/c/g', 'x', 'x', 'x' ] ]
- , # subsitute value value matching stuff
- [ 'a:@', [ 'a', ':@', 'x', 'x', 'x', 'x', 'x' ] ], # sort list
- [ 'a:.b', [ 'a', ':.b', 'x', 'x', 'x', 'x', 'x' ] ], # function called on elt
- [ 'a:.b(foo)', [ 'a', ':.b', 'foo', 'x', 'x', 'x', 'x' ] ], # idem with param
- [ 'a:<c', [ 'a', ':<', 'x', 'c', 'x', 'x', 'x' ] ], # push value
- [ 'a:>c', [ 'a', ':>', 'x', 'c', 'x', 'x', 'x' ] ], # unshift value
- [ 'a:b<c', [ 'a', ':', 'x', 'b', '<', 'c', 'x' ] ], # insert at index
- [ 'a:=b<c', [ 'a', ':=', 'x', 'b', '<', 'c', 'x' ] ], # insert at value
- [ 'a:~/b/<c', [ 'a', ':~', 'x', '/b/', '<', 'c', 'x' ] ], # insert at matching value
- [ 'a:.b("foo(a > b)")', [ 'a', ':.b', '"foo(a > b)"', 'x', 'x', 'x', 'x' ] ], # tricky value with ()
+ # id_operation leaf_operation
+ # string elt op (param) id op (param) val note
+ [ 'a', [ 'a', 'x', 'x', 'x', 'x', 'x', 'x', 'x' ] ],
+ [ '#C', [ 'x', 'x', 'x', 'x', 'x', 'x', 'x', 'C' ] ],
+ [ '#"m C"', [ 'x', 'x', 'x', 'x', 'x', 'x', 'x', '"m C"' ] ],
+ [ 'a=b', [ 'a', 'x', 'x', 'x', '=', 'x', 'b', 'x' ] ],
+ [ 'a=.foo(bar)', [ 'a', 'x', 'x', 'x', '=.foo','bar', 'x', 'x' ] ],
+ [ 'a=.foo("b r")', [ 'a', 'x', 'x', 'x', '=.foo','"b r"', 'x', 'x' ] ],
+ [ 'a-z=b', [ 'a-z','x', 'x', 'x', '=', 'x', 'b', 'x' ] ],
+ [ "a=\x{263A}", [ 'a', 'x', 'x', 'x', '=', 'x', "\x{263A}", 'x' ] ],# utf8 smiley
+ [ 'a.=b', [ 'a', 'x', 'x', 'x', '.=', 'x', 'b', 'x' ] ],
+ [ "a.=\x{263A}", [ 'a', 'x', 'x', 'x', '.=', 'x', "\x{263A}", 'x' ] ],# utf8 smiley
+ [ 'a="b=c"', [ 'a', 'x', 'x', 'x', '=', 'x', '"b=c"', 'x' ] ],
+ [ 'a="b=\"c\""', [ 'a', 'x', 'x', 'x', '=', 'x', '"b=\"c\""','x' ] ],
+ [ 'a=~/a/A/', [ 'a', 'x', 'x', 'x', '=~', 'x', '/a/A/', 'x' ] ],# subst on value
+ [ 'a=b#B', [ 'a', 'x', 'x', 'x', '=', 'x', 'b', 'B' ] ],
+ [ 'a#B', [ 'a', 'x', 'x', 'x', 'x', 'x', 'x', 'B' ] ],
+ [ 'a#"b=c"', [ 'a', 'x', 'x', 'x', 'x', 'x', 'x', '"b=c"' ] ],
+
+ # id_operation leaf_operation
+ # string elt op (param) id op (param) val note
+ [ 'a:b=c', [ 'a', ':', 'x', 'b', '=', 'x', 'c', 'x' ] ],# fetch and assign elt
+ [ 'a:"b\""="\"c"', [ 'a', ':', 'x', '"b\""', '=', 'x', '"\"c"', 'x' ] ],
+ # fetch and assign elt with quotes
+ [ 'a:~', [ 'a', ':~', 'x', 'x', 'x', 'x', 'x', 'x' ] ],# loop on matched value
+ [ 'a:~.=b', [ 'a', ':~', 'x', 'x', '.=', 'x', 'b', 'x' ] ],# loop on matched value
+ [ 'a:~/b.*/', [ 'a', ':~', 'x', '/b.*/', 'x', 'x', 'x', 'x' ] ],# loop on matched value
+ [ 'a:~"b.*"', [ 'a', ':~', 'x', '"b.*"', 'x', 'x', 'x', 'x' ] ],# loop on matched value
+ [ 'a:~/b.*/.="\"a"', [ 'a', ':~', 'x', '/b.*/', '.=', 'x', '"\"a"', 'x' ] ],# loop on matched value and append
+ [ 'a:~"b.*".="\"a"', [ 'a', ':~', 'x', '"b.*"', '.=', 'x', '"\"a"', 'x' ] ],# loop on matched value and append
+ [ 'a:~/^\w+$/', [ 'a', ':~', 'x', '/^\w+$/', 'x', 'x', 'x', 'x' ] ],# loop on matched value
+ [ 'a:="dod at foo.com"', [ 'a', ':=', 'x', '"dod at foo.com"','x', 'x', 'x', 'x' ] ],# set list
+ [ 'a:=b,c,d', [ 'a', ':=', 'x', 'b,c,d', 'x', 'x', 'x', 'x' ] ],# set list
+ [ 'a=b,c,d', [ 'a', 'x', 'x', 'x', '=', 'x', 'b,c,d', 'x' ] ],# set list old style
+ [ 'm:=a,"a b "', [ 'm', ':=', 'x', 'a,"a b "', 'x', 'x', 'x', 'x' ] ],# set list with quotes
+ [ 'm:="a b ",c', [ 'm', ':=', 'x', '"a b ",c', 'x', 'x', 'x', 'x' ] ],# set list with quotes
+ [ 'm:="a b","c d"', [ 'm', ':=', 'x', '"a b","c d"', 'x', 'x', 'x', 'x' ] ],# set list with quotes
+ [ 'm=a,"a b "', [ 'm', 'x', 'x', 'x', '=', 'x', 'a,"a b "', 'x' ] ],
+
+ # set list with quotes,old style
+ # id_operation leaf_operation
+ # string elt op (param) id op (param) val note
+ [ 'a:b#C', [ 'a', ':', 'x', 'b', 'x', 'x', 'x', 'C' ] ],# fetch elt and add comment
+ [ 'a:"b\""#"\"c"', [ 'a', ':', 'x', '"b\""', 'x', 'x', 'x', '"\"c"' ] ] ,
+ # fetch elt and add comment with quotes
+ [ 'a:b=c#C', [ 'a', ':', 'x', 'b', '=', 'x', 'c', 'C' ] ],# fetch and assign elt and add comment
+ [ 'a:-', [ 'a', ':-', 'x', 'x', 'x', 'x', 'x', 'x' ] ],# empty list
+ [ 'a:-b', [ 'a', ':-', 'x', 'b', 'x', 'x', 'x', 'x' ] ],# remove id b
+ [ 'a:-=b', [ 'a', ':-=','x', 'b', 'x', 'x', 'x', 'x' ] ],# remove value b from list or hash
+ [ 'a:-~/b/', [ 'a', ':-~','x', '/b/', 'x', 'x', 'x', 'x' ] ],# remove value matching stuff
+ [ 'a:=~s/b/c/g', [ 'a', ':=~','x', 's/b/c/g', 'x', 'x', 'x', 'x' ] ] ,
+
+ # subsitute value value matching stuff
+ # id_operation leaf_operation
+ # string elt op (param) id op (param) val note
+ [ 'a:@', [ 'a', ':@', 'x', 'x', 'x', 'x', 'x', 'x' ] ],# sort list
+ [ 'a:.b', [ 'a', ':.b','x', 'x', 'x', 'x', 'x', 'x' ] ],# function called on elt
+ [ 'a:.b(foo)', [ 'a', ':.b','foo', 'x', 'x', 'x', 'x', 'x' ] ],# idem with param
+ [ 'a:<c', [ 'a', ':<', 'x', 'c', 'x', 'x', 'x', 'x' ] ],# push value
+ [ 'a:>c', [ 'a', ':>', 'x', 'c', 'x', 'x', 'x', 'x' ] ],# unshift value
+ [ 'a:b<c', [ 'a', ':', 'x', 'b', '<', 'x', 'c', 'x' ] ],# insert at index
+ [ 'a:=b<c', [ 'a', ':=', 'x', 'b', '<', 'x', 'c', 'x' ] ],# insert at value
+ [ 'a:~/b/<c', [ 'a', ':~', 'x', '/b/', '<', 'x', 'c', 'x' ] ],# insert at matching value
+ [ 'a:.b("foo(a > b)")',[ 'a', ':.b','"foo(a > b)"','x', 'x', 'x', 'x', 'x' ] ],# tricky value with ()
);
foreach my $subtest (@regexp_test) {
diff --git a/t/load_model_snippets.t b/t/load_model_snippets.t
index 8f2e703..7614e84 100644
--- a/t/load_model_snippets.t
+++ b/t/load_model_snippets.t
@@ -16,7 +16,7 @@ BEGIN { plan tests => 8; }
use strict;
-use lib 'wr_root';
+use lib 'wr_root_p/snippet';
my $arg = shift || '';
my ( $log, $show ) = (0) x 2;
@@ -40,7 +40,7 @@ Config::Model::Exception::Any->Trace(1) if $arg =~ /e/;
ok( 1, "Compilation done" );
# pseudo root where config files are written by config-model
-my $wr_root = path('wr_root');
+my $wr_root = path('wr_root_p/snippet');
# cleanup before tests
$wr_root->remove_tree;
diff --git a/t/model_tests.d/backend-cds-examples/basic b/t/model_tests.d/backend-cds-examples/basic
new file mode 100644
index 0000000..7113b89
--- /dev/null
+++ b/t/model_tests.d/backend-cds-examples/basic
@@ -0,0 +1,8 @@
+record:localhost
+ ipaddr=127.0.0.1
+ alias=localhost -
+record:bilbo
+ ipaddr=192.168.0.1 -
+record:yada
+
+
diff --git a/t/model_tests.d/backend-cds-test-conf.pl b/t/model_tests.d/backend-cds-test-conf.pl
new file mode 100644
index 0000000..c921dd2
--- /dev/null
+++ b/t/model_tests.d/backend-cds-test-conf.pl
@@ -0,0 +1,62 @@
+#
+# This file is part of Config-Model
+#
+# This software is Copyright (c) 2005-2017 by Dominique Dumont.
+#
+# This is free software, licensed under:
+#
+# The GNU Lesser General Public License, Version 2.1, February 1999
+#
+use Config::Model::BackendMgr;
+
+$conf_dir = '/etc';
+$conf_file_name = 'hosts.cds';
+
+$model->create_config_class(
+ name => 'Host',
+
+ element => [
+ [qw/ipaddr alias/] => {
+ type => 'leaf',
+ value_type => 'uniline',
+ },
+ dummy => {qw/type leaf value_type uniline/},
+ ]
+);
+$model->create_config_class(
+ name => 'Hosts',
+
+ read_config => [
+ {
+ backend => 'cds_file',
+ config_dir => '/etc/',
+ file => 'hosts.cds',
+ },
+ ],
+
+ element => [
+ record => {
+ type => 'hash',
+ index_type => 'string',
+ write_empty_value => 1,
+ cargo => {
+ type => 'node',
+ config_class_name => 'Host',
+ },
+ },
+ ]
+);
+
+$model_to_test = "Hosts";
+
+ at tests = (
+ {
+ name => 'basic',
+ check => [
+ 'record:localhost ipaddr' => '127.0.0.1',
+ 'record:bilbo ipaddr' => '192.168.0.1'
+ ]
+ },
+);
+
+1;
diff --git a/t/model_tests.d/backend-perl-examples/basic b/t/model_tests.d/backend-perl-examples/basic
new file mode 100644
index 0000000..c06aca9
--- /dev/null
+++ b/t/model_tests.d/backend-perl-examples/basic
@@ -0,0 +1,17 @@
+
+my $v = {
+ record => {
+ 'localhost' => {
+ ipaddr => '127.0.0.1',
+ alias => 'localhost',
+ },
+ bilbo => {
+ ipaddr => '192.168.0.1',
+ },
+ yada => {}
+ }
+} ;
+
+$v;
+
+
diff --git a/t/model_tests.d/backend-perl-test-conf.pl b/t/model_tests.d/backend-perl-test-conf.pl
new file mode 100644
index 0000000..33f44b5
--- /dev/null
+++ b/t/model_tests.d/backend-perl-test-conf.pl
@@ -0,0 +1,62 @@
+#
+# This file is part of Config-Model
+#
+# This software is Copyright (c) 2005-2017 by Dominique Dumont.
+#
+# This is free software, licensed under:
+#
+# The GNU Lesser General Public License, Version 2.1, February 1999
+#
+use Config::Model::BackendMgr;
+
+$conf_dir = '/etc';
+$conf_file_name = 'hosts.pl';
+
+$model->create_config_class(
+ name => 'Host',
+
+ element => [
+ [qw/ipaddr alias/] => {
+ type => 'leaf',
+ value_type => 'uniline',
+ },
+ dummy => {qw/type leaf value_type uniline/},
+ ]
+);
+$model->create_config_class(
+ name => 'Hosts',
+
+ read_config => [
+ {
+ backend => 'perl_file',
+ config_dir => '/etc/',
+ file => 'hosts.pl',
+ },
+ ],
+
+ element => [
+ record => {
+ type => 'hash',
+ index_type => 'string',
+ write_empty_value => 1,
+ cargo => {
+ type => 'node',
+ config_class_name => 'Host',
+ },
+ },
+ ]
+);
+
+$model_to_test = "Hosts";
+
+ at tests = (
+ {
+ name => 'basic',
+ check => [
+ 'record:localhost ipaddr' => '127.0.0.1',
+ 'record:bilbo ipaddr' => '192.168.0.1'
+ ]
+ },
+);
+
+1;
diff --git a/t/pod_generation.t b/t/pod_generation.t
index d20b36f..334de4f 100644
--- a/t/pod_generation.t
+++ b/t/pod_generation.t
@@ -14,7 +14,7 @@ use strict;
use lib "t/lib";
# pseudo root where config files are written by config-model
-my $wr_root = 'wr_root';
+my $wr_root = 'wr_root_p/pog-gen/';
# cleanup before tests
rmtree($wr_root);
@@ -49,6 +49,6 @@ $model->generate_doc('Master') if $trace;
$model->generate_doc( 'Master', $wr_root );
-map { ok( -r "wr_root/Config/Model/models/$_", "Found doc $_" ); }
+map { ok( -r "$wr_root/Config/Model/models/$_", "Found doc $_" ); }
qw /Master.pod SlaveY.pod SlaveZ.pod SubSlave2.pod SubSlave.pod/;
memory_cycle_ok($model);
--
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