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 <[email protected]> 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:="[email protected]"', [ 'a', ':=', 'x', '"[email protected]"', '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:="[email protected]"', [ 'a', ':=', 'x', '"[email protected]"','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"; + +@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"; + +@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 _______________________________________________ Pkg-perl-cvs-commits mailing list [email protected] http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits
