[libconfig-model-tester-perl] 01/01: New upstream version 2.007
dod at debian.org
dod at debian.org
Mon Mar 6 09:35:46 UTC 2017
This is an automated email from the git hooks/post-receive script.
dod pushed a commit to annotated tag upstream/2.007
in repository libconfig-model-tester-perl.
commit 903e9e0ef7f46e255b0c6cd5f0bbbc01f2f85921
Author: Dominique Dumont <dod at debian.org>
Date: Mon Mar 6 10:26:00 2017 +0100
New upstream version 2.007
---
Build.PL | 136 ++-
CONTRIBUTING.md | 80 ++
Changes | 591 +++++++--
LICENSE | 2 +-
MANIFEST | 53 +-
MANIFEST.SKIP | 12 -
META.json | 45 +-
META.yml | 45 +-
README-build-from-git.md | 56 +
README.md | 77 ++
README.pod | 9 -
contrib/bash_completion.cme_meta | 44 +
data/application.d/master | 2 +
data/models/MasterModel.pl | 398 +++++++
data/models/MasterModel/CheckListExamples.pl | 82 ++
data/models/MasterModel/HashIdOfValues.pl | 79 ++
data/models/MasterModel/References.pl | 105 ++
data/models/MasterModel/WarpedId.pl | 103 ++
data/models/MasterModel/WarpedValues.pl | 237 ++++
data/models/MasterModel/X_base_class.pl | 35 +
lib/App/Cme/Command/meta.pm | 651 ++++++++++
lib/Config/Model/Itself.pm | 991 ++++++++++++++++
lib/Config/Model/Itself/BackendDetector.pm | 168 +++
lib/Config/Model/Itself/TkEditUI.pm | 144 +++
lib/Config/Model/Tester.pm | 1248 --------------------
lib/Config/Model/models/Itself/Application.pl | 71 ++
lib/Config/Model/models/Itself/CargoElement.pl | 56 +
lib/Config/Model/models/Itself/Class.pl | 502 ++++++++
lib/Config/Model/models/Itself/Class.pod | 128 ++
lib/Config/Model/models/Itself/CommonElement.pl | 389 ++++++
.../Model/models/Itself/CommonElement/Assert.pod | 38 +
.../models/Itself/CommonElement/WarnIfMatch.pod | 34 +
lib/Config/Model/models/Itself/ComputedValue.pl | 43 +
lib/Config/Model/models/Itself/ConfigAccept.pod | 278 +++++
lib/Config/Model/models/Itself/ConfigRead.pod | 154 +++
.../Model/models/Itself/ConfigWR/DefaultLayer.pod | 38 +
lib/Config/Model/models/Itself/ConfigWrite.pod | 148 +++
lib/Config/Model/models/Itself/Element.pl | 126 ++
lib/Config/Model/models/Itself/Element.pod | 270 +++++
lib/Config/Model/models/Itself/MigratedValue.pl | 68 ++
lib/Config/Model/models/Itself/Model.pl | 41 +
.../Model/models/Itself/NonWarpableElement.pl | 242 ++++
lib/Config/Model/models/Itself/WarpOnlyElement.pl | 51 +
lib/Config/Model/models/Itself/WarpValue.pl | 50 +
lib/Config/Model/models/Itself/WarpValue.pod | 36 +
.../Model/models/Itself/WarpableCargoElement.pl | 41 +
lib/Config/Model/models/Itself/WarpableElement.pl | 168 +++
t/backend_detect.t | 65 +
t/cme-meta-edit.t | 41 +
t/cme-meta-plugin.t | 64 +
t/cme-meta.t | 66 ++
t/dot_graph.t | 66 ++
t/itself-editor.t | 181 +++
t/itself.t | 260 ++++
t/itself_snippet.t | 181 +++
t/list_itself_structure.t | 58 +
t/load_write_itself.t | 102 ++
t/model_tests.t | 13 -
t/pod.t | 9 +-
t/pod_gen.t | 113 ++
60 files changed, 8133 insertions(+), 1451 deletions(-)
diff --git a/Build.PL b/Build.PL
index debf475..7eaafae 100644
--- a/Build.PL
+++ b/Build.PL
@@ -1,62 +1,108 @@
#
-# This file is part of Config-Model-Tester
+# This file is part of Config-Model-Itself
#
-# This software is Copyright (c) 2013-2017 by Dominique Dumont.
+# This software is Copyright (c) 2007-2017 by Dominique Dumont.
#
# This is free software, licensed under:
#
# The GNU Lesser General Public License, Version 2.1, February 1999
#
+# Copyright (c) 2009-2013 Dominique Dumont.
+#
+# This file is part of Config-Model-Itself.
+#
+# Config-Model is free software; you can redistribute it and/or
+# modify it under the terms of the GNU Lesser Public License as
+# published by the Free Software Foundation; either version 2.1 of
+# the License, or (at your option) any later version.
+#
+# Config-Model is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# Lesser Public License for more details.
+#
+# You should have received a copy of the GNU Lesser Public License
+# along with Config-Model; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+# 02110-1301 USA
+
+use Module::Build;
+
+use warnings FATAL => qw(all) ;
+use strict ;
-# This file was automatically generated by Dist::Zilla::Plugin::ModuleBuild v6.008.
-use strict;
-use warnings;
+require 5.010;
-use Module::Build 0.34;
+# my %appli_files = map { ( $_, $_ ) } glob("lib/Config/Model/*.d/*");
+# check that pod docs are up-to-date this is redundant with work done by
+# dzil. But this enable to re-build the docs downstream.
+# Use $^X in there as requested in
+# https://rt.cpan.org/Public/Bug/Display.html?id=74891
+my $class = Module::Build->subclass(
+ class => "Module::Build::Custom",
+ code => <<'SUBCLASS' );
-my %module_build_args = (
- "build_requires" => {
- "Module::Build" => "0.34"
+sub ACTION_build {
+ my $self = shift;
+ # below requires Config::Model 2.028
+ system ($^X, '-MConfig::Model::Utils::GenClassPod', '-e','gen_class_pod();') == 0
+ or die "gen-class-pod failed: $?";
+ $self->SUPER::ACTION_build;
+}
+SUBCLASS
+
+my $build = $class->new
+ (
+ module_name => 'Config::Model::Itself',
+ license => 'lgpl',
+ dist_author => "Dominique Dumont (ddumont at cpan dot org)",
+ dist_abstract => "Graphical editor of configuration models",
+ # model_files => \%model_files ,
+
+ 'build_requires' => {
+ 'App::Cmd::Tester' => '0',
+ 'App::Cme' => '1.002',
+ 'File::Copy' => '0',
+ 'File::Copy::Recursive' => '0',
+ 'Module::Build' => '0.34',
+ 'Test::Differences' => '0',
+ 'Test::File::Contents' => '0',
+ 'Test::Memory::Cycle' => '0',
+ 'Test::More' => '0',
+ 'Text::Diff' => '0'
},
- "configure_requires" => {
- "Module::Build" => "0.34"
+ 'configure_requires' => {
+ 'Module::Build' => '0.34'
},
- "dist_abstract" => "Test framework for Config::Model",
- "dist_author" => [
- "Dominique Dumont"
- ],
- "dist_name" => "Config-Model-Tester",
- "dist_version" => "2.059",
- "license" => "lgpl",
- "module_name" => "Config::Model::Tester",
- "recursive_test_files" => 1,
- "requires" => {
- "File::Copy::Recursive" => 0,
- "Log::Log4perl" => "1.11",
- "Path::Tiny" => 0,
- "Test::Differences" => 0,
- "Test::Exception" => 0,
- "Test::File::Contents" => 0,
- "Test::Memory::Cycle" => 0,
- "Test::More" => 0,
- "Test::Warn" => 0,
- "perl" => "5.010"
- }
-);
-
-
-my %fallback_build_requires = (
- "Module::Build" => "0.34"
-);
-
-
-unless ( eval { Module::Build->VERSION(0.4004) } ) {
- delete $module_build_args{test_requires};
- $module_build_args{build_requires} = \%fallback_build_requires;
-}
+ 'requires' => {
+ 'App::Cme' => '1.002',
+ 'App::Cme::Common' => '0',
+ 'Carp' => '0',
+ 'Config::Model' => '2.098',
+ 'Config::Model::TkUI' => '0',
+ 'Config::Model::Value' => '0',
+ 'Data::Compare' => '0',
+ 'Data::Dumper' => '0',
+ 'File::Basename' => '0',
+ 'File::Find' => '0',
+ 'File::Path' => '0',
+ 'IO::File' => '0',
+ 'Log::Log4perl' => '1.11',
+ 'Mouse' => '0',
+ 'Mouse::Util::TypeConstraints' => '0',
+ 'Path::Tiny' => '0.062',
+ 'Pod::POM' => '0',
+ 'Tk' => '0',
+ 'YAML::Tiny' => '0',
+ 'perl' => '5.010'
+ },
+
+ add_to_cleanup => [qw/wr_test/] ,
+ );
-my $build = Module::Build->new(%module_build_args);
+$build->add_build_element('pl');
+# $build->add_build_element('appli');
$build->create_build_script;
diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md
new file mode 100644
index 0000000..158ee19
--- /dev/null
+++ b/CONTRIBUTING.md
@@ -0,0 +1,80 @@
+# How to contribute #
+
+## Ask questions ##
+
+Yes, asking a question is a form of contribution that helps the author
+to improve documentation.
+
+Feel free to ask questions by sending a mail to
+[config-model-user mailing list](mailto:config-model-users at lists.sourceforge.net)
+
+## Log a bug ##
+
+Please report issue on https://github.com/dod38fr/config-model-itself/issues
+
+## To modify Itself model
+
+All Itself model files are located in [lib/Config/Model/models/Itself](https://github.com/dod38fr/config-model-itself/tree/master/lib/Config/Model/models/Itself).
+
+To understand the relations between the classes, please install [grapvhviz](http://graphviz.org/) and run the following commands:
+
+* `cme meta gen-dot`
+* `dot -Tps model.dot > model.ps`
+
+and visualize the ps file with your favorite postscript viewer (may be `okular` or `gs`):
+
+* each box contains a configuration class with its attributes
+* arrows represent 'include' relations
+* dotted arrows represent usage relations (i.e. the class is used in a node (a Config::Model::Node object) or in a warped node (a Config::Model::WarpedNode object)
+
+You can also view the models files using `cme meta edit`. But please do not save the meta configuration with this tool: this will lead to a huge diff.
+
+Note that the author is reluctant to use `cme meta edit` to edit Itself model files for fear of sawing the branch he's sitting on.
+
+## Edit source code from github ##
+
+If you have a github account, you can clone a repo and prepare a pull-request.
+
+You can:
+
+* run `git clone https://github.com/dod38fr/config-model-itself/`
+* edit files
+* run `prove -l t` to run non-regression tests
+
+There's no need to worry about `dzil`, `Dist::Zilla` or `dist.ini`
+files. These are useful to prepare a new release, but not to fix bugs.
+
+## Edit source code from Debian source package ##
+
+You can also prepare a patch using Debian source package:
+
+For instance:
+
+* download and unpack `apt-get source libconfig-model-itself-perl`
+* jump in `cd libconfig-model-itself-perl-2.004`
+* useful to create a patch later: `git init`
+* commit all files: `git add -A ; git commit -m"committed all"`
+* edit files
+* run `prove -l t` to run non-regression tests
+* run `git diff` and send the output on [config-model-user mailing list](mailto:config-model-users at lists.sourceforge.net)
+
+
+## Edit source code from Debian source package or CPAN tarball ##
+
+Non Debian users can also prepare a patch using CPAN tarball:
+
+* Download tar file from http://search.cpan.org
+* unpack tar file with something like `tar axvf Config-Model-Itself-2.004.tar.gz`
+* jump in `cd Config-Model-Itself-2.004`
+* useful to create a patch later: `git init`
+* commit all files: `git add -A ; git commit -m"committed all"`
+* edit files
+* run `prove -l t` to run non-regression tests
+* run `git diff` and send the output on [config-model-user mailing list](mailto:config-model-users at lists.sourceforge.net)
+
+## Provide feedback ##
+
+Feedback is important. Please take a moment to rate, comment or add
+stars to this project:
+
+* [config-model-itself github](https://github.com/dod38fr/config-model-itself) or [config-model-itself cpan ratings](http://cpanratings.perl.org/rate/?distribution=Config::Model::Itself)
diff --git a/Changes b/Changes
index 19ef503..d252cd7 100644
--- a/Changes
+++ b/Changes
@@ -1,133 +1,548 @@
-2.059 2017-02-12
+2.007 2017-03-05
- Improvements:
- * allow to reuse test data. Use data_from parameter to re-use test
- data from another test case
- * mention that file list is sorted when comparing files written by
- first and second test instance
- * add load2 parameter to load configuration data in
- the second test instance.
+ New features:
+ * add file_mode parameter to backend model
+ * Allow plugin injection in other class
+ (depends on Config::Model 2.098)
+ * add synopsis and link_to_doc parameter to the
+ model class that represent application
- Bug fix
- * recreate model object for each application test (i.e. a new model
- object is created for each *-test-conf.pl file)
+ Build:
+ * update © years
+ * requires Path::Tiny >= 0.062
- Other:
- * dist.ini: update © year
+ Bug fixes:
+ * cme meta: don't read plugin when loading model..
+ * remove obsolete config-model-edit command
-2.058 2016-12-05
+ Doc updates:
+ * show all commands in meta's description
+ * update compute value doc in model
+ * mention &index in backend file parameter
+ * update INI comment_delimiter doc
- Minor bug fix:
- * prevent undef warning seen in smoke and travis tests
+2.006 2016-09-14
-2.057 2016-09-03
+ Bug fix following removal of '.' from @INC
+ * fix load of model snippet when '.' is not in @INC
+ (Closes Debian #837682)
+ * requires Config::Model 2.091
- Bug fix for Perl 5.24 and Debian perl 5.22.2-4:
- * load test file even if @INC does not contain '.'
+2.005 2016-07-03
-2.056 2016-09-01
+ Made change to fix tests brought by the changes done
+ in Config::Model::WarpedNode parameters:
+ * depends on Config::Model 2.087
+ * fix deprecated warped_node params in Itself model
+ * fix model for new WarpedNode
- Improvements:
- * added an option to check config tree content
- before calling apply_fix
- * Changed syntax of dump check parameters (old syntax is
- still accepted)
+ Other changes:
+ * removed long deprecated 'experience' parameter
+ * added CONTRIBUTING.md file
-2.055 2016-05-26
+2.004 2016-04-21
- Minor bug fixes:
- * removed debug print
- * avoid undef warning
+ New features:
+ * added auto_delete parameter for read/write backend
+ this requires Config::Model 2.083
-2.054 2016-04-17
+ Doc updates in model:
+ * updated Class doc
+ * added help for value_type
- Improvements:
- * improved Tester documentation
- * inform user when a global var is missing in test setup
- * fix file check when setup param is used
- * handle dir specification containing ~/
+ Bug fixes:
+ * detect backend in local dev environment.
-2.053 2016-03-28
+2.003 2016-01-27
New features:
- * pass application when creating instance
- * use config_dir specified in app info file
+ * added config_dir parameter to application
+ * Replace ini_file backend with IniFile
+ * Added split/join checklist param to ini backend
+ (requires Config::Model 2.076)
+
+ Improved usability:
+ * simplified creation of Itself object.
+ * Build.PL: avoid dependency on cme to generate doc
+
+ Bug fixes:
+ * Config classes created with 'cme meta edit' are now saved
+ * meta: warn if save failed in test_and_quit mode
+ * Avoid a crash creating a config class
+ * fix test failure under debian ci
+ (helps with Debian #809294 and fix github #1)
+
+2.002 2015-12-02
+
+ Test enhancements:
+ * Skip cme-meta tests involing Tk when a display is not available.
+
+2.001 2015-11-29
+
+ Major feature enhancement:
+
+ This modules provides a new sub command for cme: the "meta" sub
+ command. By default "cme meta edit" opens a graphical editor and
+ loads the model found in current directory. "cme meta" also provides
+ sub commands to check a model or to create a dot diagram showing a
+ model structure. "cme meta" comes with bash completion. See
+ App::Cme::Command::meta for more details.
+
+ Other changes:
+
+ + new App::Cmd dependency
+ * requires Config::Model 2.075
+ * config-model-edit is now deprecated in favor of "cme meta edit"
+ * updated README in changed it to README.md
+ * "cme edit" now support app files (e.g. files in lib/Config/Model/*.d )
+
+1.245 2015-07-19
+
+ Bug fixes in config-model-edit:
+ * fix saving of model done before launching test from menu
+ * fix creation of model directory done when starting a model from scratch
+
+ Doc fix:
+ * small synopsis fix in doc of Config::Model::Itself
+
+1.244 2015-05-23
+
+ A minor new feature:
+ * Class model: added include_backend parameter (for Xorg...)
+
+1.243 2015-01-11
+
+ A small change for this release:
+
+ * Version 1.242 added the possibility to override the Perl class
+ implementing a configuration node by adding a class parameter in a
+ place that is confusing. This release fix this bug: this optional
+ override class is now declared at the top of a configuration class.
+ * Depends on Config::Model 2.064
+
+1.242 2014-11-29
+
+ New feature:
+ * Allow 'class' parameter for node, hash and list. This parameter
+ can be used to override the Perl class used to implement node,
+ hash or list element. Use with care.
+
+ Bug fix:
+ * replaced dep declaration YAML::any with YAML::Tiny
+
+1.241 2014-10-22
+
+ * config-model-edit:
+ + added system option to read a model from system files
+ * fix yaml and load_yaml options
+ * fix dump and dumptype options
+ * fixed dot diagram generator (i.e. -dot-diagram option)
+ * dependency change: use YAML::Tiny instead of YAML::Any
+ * leaf value model:
+ + added file and dir and warn_if properties
+
+1.240 2014-05-22
+
+ Main change is the deprecation of the experience attribute.
+ config-model-edit can be used to clean up experience parameter
+ from existing model.
+
+ Dependency changes:
+ * removed usage of AnyEvent (requires C::M 2.055)
+ * removed use namespace::autoclean
+ * config-model-edit: use Path::Tiny instead of Path::Class
+
+ Other changes:
+ * min and max parameters accept number.
+ * removed obsolete permission attribute from test models
+ (which broke test with C::M >= 2.056)
+ * preserve header comments when reading/writing model files
+ * config-model-edit begins with "#!/usr/bin/env perl"
+
+2013-08-27 - 1.239
+
+ * Itself writer: ensure that hash data in models snippets
+ have a predictable order (fix tests for perl 5.18)
+
+2013-08-25 - 1.238
+
+ * Added default_layer backend parameter with DefaultLayer
+ class. This enable user to create a model with a global system
+ configuration file à la /etc/ssh/ssh_config. This requires
+ Config::Model 2.039
+
+1.237 2013-04-19
+
+ * Replaced Any::Moose with Mouse
+ * backend detector: do not list twice the same backend
+ * Removed augeas from model and tests. Augeas meta-model
+ is now delivered with Config::Model::Backend::Augeas
+
+1.236 2013-03-23
+
+ * Itself: use named parameters with load_data to avoid warnings
+ * Depends on Config::Model >= 2.030
+ * delegate Tk init to AnyEvent to avoid blocking at program exit
+ + Depends on AnyEvent
+
+1.235 2012-11-27
+
+ * Fix quit bug in model test widget
+ * integrate model pod generation at build time
+ * Added memory cycle tests where possible
+ * Bump dependency on Config::Model 2.028 to generate
+ properly the documentation for Itself model (which
+ may be should be called C::M::MyOwnDogFood... )
+
+1.234 2012-06-19
+
+ * Fix test that relied on Dpkg model (which used to be provided
+ by Config::Model)
+
+1.232 2012-06-19
+
+ * model Itself::Class: added accept_after
+ (requires Config::Model 2.020)
+ * config-model-edit: make sure that loading models are not
+ recorded as changed data
+
+1.231 2012-05-22
+
+ * added migrate_values_from (requires Config::Model 2.015)
+ * migrate_keys_from cannot be warped (too complicated to mix
+ warp and migration)
+
+1.230 2012-05-04
+
+ * Itself reader/writer: added force_write attribute
+
+1.229 2012-04-14
+
+ + new runtime dependency: Data::Compare, Path::Class
+ + new test dependency: File::Copy::Recursive
+ * Depends on Config::Model 2.009
+
+ * config-model-edit:
+ + new option -plugin-file option. This option can be used to create model
+ plugins: small modification of an existing model that can be distributed
+ in a separate file or package.
+ * removed capacity to read models from systems files if the model
+ is not found locally. This behavior does not work well with model
+ plugins. This command can no longer read from one dir and write to
+ another for the same reason.
+ - removed obsolete option (-verbose -debug). These are now replaced
+ by the Log::Log4Perl framework
+ * replaced '_' by '-' in options names. Old options are still accepted
+ but are not documented
+ * Itself model: added use_as_upstream_default parameter
+ * Itself backend: do not write empty model file
+
+1.228 2011-11-29
+
+ * Requires Config::Model >= 1.263
+ * Meta model changes:
+ * Itself/CommonElement: enable convert for hash indexes.
+ * Itself/Class, added in ini backend a lot of paramaters to
+ cope with various conventions:
+ + force_lc_* parameters.
+ + write_boolean_as parameter
+ + join_list_value parameter
+ + store_class_in_hash section_map split_list_value
+ * Itself/CommonElement: max_index can be used in lists
+ * Itself/NonWarpableElement:
+ + added write_as parameter (for booleans)
+
+1.227 2011-09-15
+
+ * MigratedValue.pl: replaced value can be a string, not only a
+ uniline
+ * CommonElement.pl: added assert and warn_unless parameters
+ (requires Config::Model 1.258)
+
+1.226 2011-09-02
+
+ * WarpableElement.pl: added duplicates parameter
+ * Depends on Config::Model 1.252
+
+
+1.225 2011-06-07
+
+ * Itself.pm: munge pod text embedded in description
+ to avoid spurious pod formatting in model files
+ * WarpableElement.pl: allow default_with_init for list (like hash)
+ * MigratedValue.pl: updated undef_is doc: use '' to have an empty string
+ * CommonElement.pl: warn parameter is a string and not a uniline
+ - Class.pl: name_match parameter is deprecated.
+
+1.224 2011-04-04
+
+ * Class.pl: added full_dump parameter for YAML and Perl backend
+
+1.223 2011-04-01
+
+ * dump and load annotations in pod doc in config class file
+ * Class.pl: added copyright, author, license elements
+ * Search backend in all @INC directories (useful for dev)
+ * Reduced indentation of generated Perl files.
+ * NonWarpableElement: added replace_follow parameter
+ * Build depend on Test::Differences
+ * Requires Config::Model 1.236
+
+1.222 2011-01-20
+
+ * added migrate_keys_from, undef_is parameters
+ * Above require Config::Model 1.230
+
+1.221 2011-01-09
+
+ * Remove unwanted test package file (oops)
+
+1.220 2011-01-09
+
+ * config-model-edit: use same log4perl config files as config-edit
+ * CommonElement: added warn* parameters
+ (require Config::Model 1.228)
+ * Fix class deletion issue
+ * Adapted model and test to new style of accept specification
+
+1.219 2010-10-15
+
+ * removed obsolete push/pop_no_value_check calls
+ * requires Config::Model 1.212
+
+1.218 2010-09-16
+
+ * Fixed missing dependencies in Build.PL (Building from hg
+ requires Dist::Zilla and Dist-Zilla-Plugins-CJM >= 3.01)
+
+1.217 2010-09-14
+
+ * Added allow_keys_matching parameter in ItselfWarpableElement.pl
+ (requires Config::Model 1.207)
+ * config-model-edit :doc fix
+ * Itself.pm: display hash or list cargo type in dot diagram"
+ * BackendDetector.pm: Fixed to handle backend names with embedded
+ :: (e.g. Debian::Dep5)
+
+1.216 2010-08-13
+
+ * Added accept parameter in Itself/Class.pl
+ (requires Config::Model 1.206)
+ * Build.PL: added dependency on Tk to avoid CPAN smoke test
+ failure
+
+1.215 2010-04-06
+
+ * t/itself.t: Fix skip part to avoid failures when X is not
+ available.
+
+1.214 2010-03-31
+
+ * config-model-edit (): ensure that model modified by loading data
+ or YAML is saved later on by the GUI.
+
+1.213 2010-03-25
+
+ * lib/Config/Model/Itself/BackendDetector.pm (): New class derived
+ from Config::Model::Value so config-model-edit can detect
+ available read/write plugin backend and propose relevant choice
+ for 'backend' model specification.
+
+ * Build.PL: Added dedendency on Pod::POM, depends on Config::Model
+ 1.001
+
+
+ * lib/Config/Model/models/Itself/CommonElement.pl: add match
+ parameter from Config::Model 1.001
+
+
+ * config-model-edit (): can use -force_load when loading data or
+ yaml data.
+ * Build.PL: depends on YAML::Any
+
+1.212 2010-02-26
+
+ * Build.PL: depends on Config::Model 0.643
+
+
+ * config-model-edit: added load_yaml option to load model from a
+ YAML file.
+
+
+ * config-model-edit: added dump_yaml option to dump models as YAML
+ file.
+
+
+ * config-model-edit: added -dump -dump_type -load options. Non
+ options args are now interpreted as model modifications
+
+
+ * lib/Config/Model/models/Itself/CommonElement.pl: warp out min and max
+
+1.211 2009-06-24
+
+ * Build.PL: depend on Config::Model 0.637 and C::M::TkUI 1.210
+
+
+ * lib/Config/Model/models/Itself/*.pl: Changed built_in parameter
+ to upstream_default and built_in_list to upstream_default_list
+
+
+ * config-model-edit: added -save option.
+
+ * lib/Config/Model/models/Itself/Class.pl: Changed config_file
+ parameter to file (Req by Config::Model 0.636)
+
+1.210 2009-04-20
+
+ * config-model-edit: Fixed Log::Log4perl default configuration
+
+
+ * lib/Config/Model/models/Itself/Class.pl: Added auto_create and
+ file parameter to read/write spec (Req by Config::Model
+ 0.635). Parameter allow_empty is deprecated and will be replaced
+ by auto_create when you run config-edit-model
+
+
+ * config-model-edit: new -dot_diagram option to get a dot file to
+ reprensent the structure of the configuration model
+
+ * lib/Config/Model/Iself.pm (get_dot_diagram): New method to draw a
+ diagram of the configuration class with "include" and
+ usage (e.g. with "config_class_name" parameter).
+
+ * lib/Config/Model/models/Itself/Element.pl: index_type is now
+ mandatory for hash types
+
+
+ * lib/Config/Model/models/Itself/Element.pl: Added summary model
+ parameter (Config::Model 0.635)
+
+
+ * lib/Config/Model/models/Itself/CommonElement.pl: 'choice' is
+ also available for 'reference' values
+
+1.209 2009-03-10
+
+ * t/*.t: Backported mkpath calls to File::Path delivered by perl
+ 5.8.8
+
+
+ * lib/Config/Model/models/Itself/WarpableElement.pl: changed
+ auto_create in auto_create_keys and auto_create_ids (required by
+ Config::Model 0.634)
+
+1.208 2009-01-09
+
+ * lib/Config/Model/models/Itself/Class.pl: Added allow_empty
+ parameter. Minor corrections related to Augeas integration.
+
+1.207 2008-10-14
+
+ * lib/Config/Model/models/Itself/CommonElement.pl: Added ordered
+ parameter to checklist. Ordered checklist feature is required by
+ Ssh model for Ciphers list (see Config::Model::OpenSsh).
+
+ * Build.PL: Extract version from Config/Model/Itself.pm (hence the
+ bump to v 1.207) so that the pm file versions matches the .tgz
+ distribution version.
+
+0.206 2008-09-23
+
+ * lib/Config/Model/models/Itself/Class.pl: Added seq_with_lens
+ parameter for Augeas backend.
+
+
+ * lib/Config/Model/models/Itself/Class.pl: Bug fix on Augeas
+ parameters
+
+0.205 2008-07-25
+
+ * lib/Config/Model/models/Itself/Class.pl: Fixed specification of
+ Augeas parameters
+
+0.204 2008-07-25
+
+ * lib/Config/Model/models/Itself/*.pl:
+ All the changes described below will be handled by the
+ upgrade facility of Config::Model. I.e. to upgrade your
+ configuration model, load your model in config-model-edit,
+ save it, and you're done.
+ Changes:
+ - Changed auto read and auto write meta-model (needed by
+ Config::Model 0.624).
+ - autoread autowrite 'syntax' parameter is replaced by 'backend'.
+ - Added auto-read/write 'augeas' backend.
+ - Added migrate_from in Class so that your own model will be able
+ to smoothly upgrade configuration data (See upgrade doc in
+ Config::Model::Value)
+ - Added use_eval for more complex string computation when the power
+ of Perl is needed (See Config::Model::ComputedValue documentation)
- Improvements:
- * Report error with model specification
- * Improved doc
-2.052 2015-10-17
+0.203 2008-05-21
- * New features:
- * subtest filter parameter is now a regexp.
- I.e you can filter tests like this:
- prove t/model_test.t :: x stuff '^foo$'
- * you can run update test with no_warnings and quiet param
- * global no_warnings param also apply to load and dump
- * Misc:
- * bug tracker is now on github
+ * config-model-edit: Fixed bug that prevented testing of the
+ configuration editor when starting from scratch.
-2.051 2015-05-20
+0.202 2008-05-18
- * New features:
- + Added has_key and has_not_key parameters to check hash
- element content
+ * lib/Config/Model/models/Itself/CommonElement.pl: Added support for
+ built in default list for check_list elements
-2.050 2015-03-29
- * Bug fix:
- * fix check_data function
+ * config-model-edit: Will now always launch Tk interface which has
+ a menu to test the configuration editor from the model under edition.
+ (some tests still to be written)
-2.049 2015-03-28
- * New features:
- * check argument also accept a regexp ( i.e. a qr// )
- + added option to run 'update' test
- * Allow to start test without config file (from scratch)
+ * lib/Config/Model/Itself.pm (list_class_element): new method to
+ help model debug
- * changed dependency:
- * replaced Path::Class with Path::Tiny
- * Internal changes:
- * refactored most of the logic in separate functions
+ * lib/Config/Model/Itself.pm (read_all): Reworked model to fit with
+ new cargo arguments.
+ * tests: suppress legacy warnings
+
+0.201 2008-04-03
-2.048 2014-06-04
+ * lib/Config/Model/models/Itself/Element.pl: Fixed element and
+ cargo models.
- * C::M::Tester: added load_check2 parameter
-2.047 2013-10-06
+ * lib/Config/Model/models/Itself/WarpableElement.pl: added
+ description for 'replace' element
- * Updated Pod documents and added link to examples
- * Updated dependency list
-2.046 2013-09-20
+ * lib/Config/Model/models/Itself/WarpableElement.pl: removed
+ enum_integer type
- * depends on Path::Class >= 0.29
+ * config-model-edit: Clarified where models are read and
+ written.
-2.045 2013-09-15
+0.102 2008-03-18
- * Fix broken tests on Windows (mixup between / and \ )
+ * config-model-edit: Now use Config::Model::TkUI instead of
+ Config::Model::TkUi
-2.044 2013-09-07
- * accept array ref for file_contents* tests
- * fix spurious creation of '0' dir
+ * lib/Config/Model/Itself.pm (read_all): Skip svn directory when
+ reading model files
-2.043 2013-08-23
- * fix file_content* tests (bad path computation)
+ * lib/Config/Model/Itself.pm (write_all): can now write
+ configuration class created with the editor. Each class created
+ will be saved in its own file. I.e. configuration class Foo::Bar
+ will be saved in Foo/Bar.pl
-2.042 2013-08-14
- * fix file created/removed comparison
- * added require perl5.10
+ * config-model-edit: added possibity to use Tk interface.
-2.041 2013-08-12
+ * lib/Config/Model/models/Itself/WarpableElement.pl: added
+ 'replace' parameter
- * rewrote using Path::Class. Added setup parameter
+0.101 2007-10-16
-2.041_01 2013-08-11
+ * All: first version
+
- * Initial release. This module was moved from Config-Model
- distribution.
\ No newline at end of file
diff --git a/LICENSE b/LICENSE
index 80bf045..ce67306 100644
--- a/LICENSE
+++ b/LICENSE
@@ -1,4 +1,4 @@
-This software is Copyright (c) 2013-2017 by Dominique Dumont.
+This software is Copyright (c) 2007-2017 by Dominique Dumont.
This is free software, licensed under:
diff --git a/MANIFEST b/MANIFEST
index 810242b..5fdc328 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,13 +1,58 @@
# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.008.
Build.PL
+CONTRIBUTING.md
Changes
LICENSE
MANIFEST
-MANIFEST.SKIP
META.json
META.yml
-README.pod
-lib/Config/Model/Tester.pm
-t/model_tests.t
+README-build-from-git.md
+README.md
+contrib/bash_completion.cme_meta
+data/application.d/master
+data/models/MasterModel.pl
+data/models/MasterModel/CheckListExamples.pl
+data/models/MasterModel/HashIdOfValues.pl
+data/models/MasterModel/References.pl
+data/models/MasterModel/WarpedId.pl
+data/models/MasterModel/WarpedValues.pl
+data/models/MasterModel/X_base_class.pl
+lib/App/Cme/Command/meta.pm
+lib/Config/Model/Itself.pm
+lib/Config/Model/Itself/BackendDetector.pm
+lib/Config/Model/Itself/TkEditUI.pm
+lib/Config/Model/models/Itself/Application.pl
+lib/Config/Model/models/Itself/CargoElement.pl
+lib/Config/Model/models/Itself/Class.pl
+lib/Config/Model/models/Itself/Class.pod
+lib/Config/Model/models/Itself/CommonElement.pl
+lib/Config/Model/models/Itself/CommonElement/Assert.pod
+lib/Config/Model/models/Itself/CommonElement/WarnIfMatch.pod
+lib/Config/Model/models/Itself/ComputedValue.pl
+lib/Config/Model/models/Itself/ConfigAccept.pod
+lib/Config/Model/models/Itself/ConfigRead.pod
+lib/Config/Model/models/Itself/ConfigWR/DefaultLayer.pod
+lib/Config/Model/models/Itself/ConfigWrite.pod
+lib/Config/Model/models/Itself/Element.pl
+lib/Config/Model/models/Itself/Element.pod
+lib/Config/Model/models/Itself/MigratedValue.pl
+lib/Config/Model/models/Itself/Model.pl
+lib/Config/Model/models/Itself/NonWarpableElement.pl
+lib/Config/Model/models/Itself/WarpOnlyElement.pl
+lib/Config/Model/models/Itself/WarpValue.pl
+lib/Config/Model/models/Itself/WarpValue.pod
+lib/Config/Model/models/Itself/WarpableCargoElement.pl
+lib/Config/Model/models/Itself/WarpableElement.pl
+t/backend_detect.t
+t/cme-meta-edit.t
+t/cme-meta-plugin.t
+t/cme-meta.t
+t/dot_graph.t
+t/itself-editor.t
+t/itself.t
+t/itself_snippet.t
+t/list_itself_structure.t
+t/load_write_itself.t
t/pod.t
+t/pod_gen.t
weaver.ini
diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP
deleted file mode 100644
index 2ca5914..0000000
--- a/MANIFEST.SKIP
+++ /dev/null
@@ -1,12 +0,0 @@
-^debian/
-~$
-\.ptkdb$
-\.old$
-dist.ini
-_build
-\.orig$
-^MYMETA
-blib
-wr_root
-\.rej$
-README.build-from-git
diff --git a/META.json b/META.json
index d8c798e..fa399f3 100644
--- a/META.json
+++ b/META.json
@@ -1,5 +1,5 @@
{
- "abstract" : "Test framework for Config::Model",
+ "abstract" : "Model editor for Config::Model",
"author" : [
"Dominique Dumont"
],
@@ -12,10 +12,11 @@
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : "2"
},
- "name" : "Config-Model-Tester",
+ "name" : "Config-Model-Itself",
"prereqs" : {
"build" : {
"requires" : {
+ "App::Cme" : "1.002",
"Module::Build" : "0.34"
}
},
@@ -26,16 +27,38 @@
},
"runtime" : {
"requires" : {
- "File::Copy::Recursive" : "0",
+ "App::Cme" : "1.002",
+ "App::Cme::Common" : "0",
+ "Carp" : "0",
+ "Config::Model" : "2.098",
+ "Config::Model::TkUI" : "0",
+ "Config::Model::Value" : "0",
+ "Data::Compare" : "0",
+ "Data::Dumper" : "0",
+ "File::Basename" : "0",
+ "File::Find" : "0",
+ "File::Path" : "0",
+ "IO::File" : "0",
"Log::Log4perl" : "1.11",
- "Path::Tiny" : "0",
+ "Mouse" : "0",
+ "Mouse::Util::TypeConstraints" : "0",
+ "Path::Tiny" : "0.062",
+ "Pod::POM" : "0",
+ "Tk" : "0",
+ "YAML::Tiny" : "0",
+ "perl" : "5.010"
+ }
+ },
+ "test" : {
+ "requires" : {
+ "App::Cmd::Tester" : "0",
+ "File::Copy" : "0",
+ "File::Copy::Recursive" : "0",
"Test::Differences" : "0",
- "Test::Exception" : "0",
"Test::File::Contents" : "0",
"Test::Memory::Cycle" : "0",
"Test::More" : "0",
- "Test::Warn" : "0",
- "perl" : "5.010"
+ "Text::Diff" : "0"
}
}
},
@@ -43,16 +66,16 @@
"resources" : {
"bugtracker" : {
"mailto" : "ddumont at cpan.org",
- "web" : "https://github.com/dod38fr/config-model-tester/issues"
+ "web" : "https://github.com/dod38fr/config-model-itself/issues"
},
"homepage" : "https://github.com/dod38fr/config-model/wiki",
"repository" : {
"type" : "git",
- "url" : "git://github.com/dod38fr/config-model-tester.git",
- "web" : "http://github.com/dod38fr/config-model-tester.git"
+ "url" : "git://github.com/dod38fr/config-model-itself.git",
+ "web" : "http://github.com/dod38fr/config-model-itself"
}
},
- "version" : "2.059",
+ "version" : "2.007",
"x_serialization_backend" : "JSON::XS version 3.03"
}
diff --git a/META.yml b/META.yml
index 1b53332..6b81f54 100644
--- a/META.yml
+++ b/META.yml
@@ -1,9 +1,18 @@
---
-abstract: 'Test framework for Config::Model'
+abstract: 'Model editor for Config::Model'
author:
- 'Dominique Dumont'
build_requires:
+ App::Cmd::Tester: '0'
+ App::Cme: '1.002'
+ File::Copy: '0'
+ File::Copy::Recursive: '0'
Module::Build: '0.34'
+ Test::Differences: '0'
+ Test::File::Contents: '0'
+ Test::Memory::Cycle: '0'
+ Test::More: '0'
+ Text::Diff: '0'
configure_requires:
Module::Build: '0.34'
dynamic_config: 0
@@ -12,21 +21,31 @@ license: lgpl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: '1.4'
-name: Config-Model-Tester
+name: Config-Model-Itself
requires:
- File::Copy::Recursive: '0'
+ App::Cme: '1.002'
+ App::Cme::Common: '0'
+ Carp: '0'
+ Config::Model: '2.098'
+ Config::Model::TkUI: '0'
+ Config::Model::Value: '0'
+ Data::Compare: '0'
+ Data::Dumper: '0'
+ File::Basename: '0'
+ File::Find: '0'
+ File::Path: '0'
+ IO::File: '0'
Log::Log4perl: '1.11'
- Path::Tiny: '0'
- Test::Differences: '0'
- Test::Exception: '0'
- Test::File::Contents: '0'
- Test::Memory::Cycle: '0'
- Test::More: '0'
- Test::Warn: '0'
+ Mouse: '0'
+ Mouse::Util::TypeConstraints: '0'
+ Path::Tiny: '0.062'
+ Pod::POM: '0'
+ Tk: '0'
+ YAML::Tiny: '0'
perl: '5.010'
resources:
- bugtracker: https://github.com/dod38fr/config-model-tester/issues
+ bugtracker: https://github.com/dod38fr/config-model-itself/issues
homepage: https://github.com/dod38fr/config-model/wiki
- repository: git://github.com/dod38fr/config-model-tester.git
-version: '2.059'
+ repository: git://github.com/dod38fr/config-model-itself.git
+version: '2.007'
x_serialization_backend: 'YAML::Tiny version 1.70'
diff --git a/README-build-from-git.md b/README-build-from-git.md
new file mode 100644
index 0000000..7491425
--- /dev/null
+++ b/README-build-from-git.md
@@ -0,0 +1,56 @@
+# How to build Config::Model::Itself from git repository
+
+`Config::Model::Itself` is build with [Dist::Zilla](http://dzil.org/). This
+page details how to install the tools and dependencies required to
+build this module.
+
+## Install tools and dependencies
+
+### Debian, Ubuntu and derivatives
+
+Run
+
+ $ sudo apt install libdist-zilla-perl libdist-zilla-app-command-authordebs-perl
+ $ dzil authordebs --install
+ $ sudo apt build-dep libconfig-model-itself-perl
+
+The [libdist-zilla-app-command-authordebs-perl package](https://tracker.debian.org/pkg/libdist-zilla-app-command-authordebs-perl) is quite recent (uploaded on Dec 2016 in Debian/unstable)
+and may not be available yet on your favorite distribution.
+
+### Other systems
+
+Run
+
+ $ cpamn Dist::Zilla
+ $ dzil authordeps -missing | cpanm --notest
+ $ dzil listdeps --missing | cpanm --notest
+
+NB: The author would welcome pull requests that explains how to
+install these tools and dependencies using native package of other
+distributions.
+
+## Build Config::Model::Itself
+
+Run
+
+ dzil build
+
+or
+
+ dzil test
+
+`dzil` may complain about missing `EmailNotify` or `Twitter`
+plugin. You may ignore this or edit [dist.ini](dist.ini) to comment
+out the last 2 sections. These are useful only to the author when
+releasing a new version.
+
+
+`dzil` may also return an error like `Cannot determine local time
+zone`. In this case, you should specify explicitely your timezone in
+a `TZ` environement variable. E.g run `dzil` this way:
+
+ TZ="Europe/Paris" dzil test
+
+The list of possible timezones is provided by
+[DateTime::TimeZone::Catalog](https://metacpan.org/pod/DateTime::TimeZone::Catalog)
+documentation.
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..46687e9
--- /dev/null
+++ b/README.md
@@ -0,0 +1,77 @@
+
+[](https://travis-ci.org/dod38fr/config-model-itself)
+
+## What is Config::Model::Itself ##
+
+Config::Model::Itself provides a graphical editor to edit configuration model
+for Config::Model.
+
+This modules also provides a model for Config::Model (hence the Itself
+name, you can also think of it as a meta-model). The editor will use
+this meta-model to construct the graphical interface so you can edit
+the configuration model for *your* application. [ This module is the
+"eat your own dog food" principle applied to Config::Model ;-) ]
+
+Let's step back a little to explain. Any configuration data is, in
+essence, structured data. This data could be stored in an XML file. A
+configuration model is a way to describe the structure and relation of
+all items of a configuration data set.
+
+This configuration model is also expressed as structured data. This
+structure data is structured and follow a set of rules which are
+described for humans in Config::Model.
+
+The structure and rules documented in Config::Model are also expressed
+in a model in the files provided with Config::Model::Itself.
+
+Hence the possibity to verify, modify configuration data provided by
+Config::Model can also be applied on configuration models. Using the
+same user interface.
+
+## How to run the editor ##
+
+The model editor is launched by `cme meta edit`
+
+Since the model editor and the configuration data editor are based on
+the same graphical module, you will use similar UIs to edit
+configuration data (for instance [OpenSsh](http://search.cpan.org/dist/Config-Model-OpenSsh/)
+configuration data from sshd_config) and OpenSsh model (if you need to add new parameters in
+OpenSsh model)
+
+Once this module is installed, you can run `cme meta edit` in an empty
+directory to create you own model.
+
+You can also start from an existing model. Clone from github a model
+(like [config-model-openssh](https://github.com/dod38fr/config-model-openssh)),
+jump in the cloned directory and run `cme meta edit`
+
+You can also peek in an installed model. For instance, if you have installed
+Config::Model::OpenSsh, you can run
+
+
+ cme meta edit sshd -system
+
+Note that "save" menu will save the model in current directory.
+
+For more details, see:
+
+* [cme](http://search.cpan.org/dist/App-Cme/bin/cme)
+* [App::Cme::Command::meta](http://search.cpan.org/dist/Config-Model-Itself/lib/App/Command/Cme/meta.pod)
+* [model creation](http://search.cpan.org/dist/Config-Model/lib/Config/Model/Manual/ModelCreationIntroduction.pod)
+
+## Installation
+
+On debian/ubuntu:
+
+ apt-get install cme libconfig-model-itself-perl libconfig-model-tkui-perl
+
+Otherwise:
+
+ cpanm Config::Model::Itself
+ cpanm App::Cme
+ cpanm Config::Model::TkUI
+
+## Build from git
+
+See [build from git instructions](README-build-from-git.md)
+
diff --git a/README.pod b/README.pod
deleted file mode 100644
index 0d3cdaa..0000000
--- a/README.pod
+++ /dev/null
@@ -1,9 +0,0 @@
-=head1 Tester class to test configuration models for Config::Model
-
-Config::Model::Tester provides a way to test configuration models with
-tests files. This class was designed to tests several models and
-several tests cases per model.
-
-For details, see L<Config::Model::Tester>
-
-
diff --git a/contrib/bash_completion.cme_meta b/contrib/bash_completion.cme_meta
new file mode 100644
index 0000000..50d7a9f
--- /dev/null
+++ b/contrib/bash_completion.cme_meta
@@ -0,0 +1,44 @@
+# cme(1) completion -*- shell-script -*-
+#
+#
+# This file is part of Config::Model::Itself
+#
+# This software is Copyright (c) 2015 by Dominique Dumont
+#
+# This is free software, licensed under:
+#
+# The GNU Lesser General Public License, Version 2.1, February 1999
+#
+
+
+_cme_cmd_meta()
+{
+ local cur
+
+ COMPREPLY=()
+ _get_comp_words_by_ref -n : cur prev
+
+ global_options='-dev -force-load -create -backend -trace -quiet -file'
+
+ if [[ $COMP_CWORD -eq 2 ]] ; then
+ COMPREPLY=( $( compgen -W 'edit check save plugin dump dump-yaml gen-dot' -- $cur ) )
+ elif [[ $COMP_CWORD -eq 3 ]] ; then
+ MODELS=$(/usr/bin/perl -MConfig::Model::Lister -e'print Config::Model::Lister::applications(1);')
+ COMPREPLY=( $( compgen -W "$MODELS" -- $cur ) )
+ elif [[ $COMP_CWORD -eq 4 ]] ; then
+ OPTIONS='-dir -dumptype -open-item -plugin-file -load-yaml -load -system'
+ COMPREPLY=( $( compgen -W "$OPTIONS" -- $cur ) )
+ else
+ case $prev in
+ -dir|-open-item|-plugin-file|-load-yaml|-load)
+ _filedir -d
+ ;;
+ -dumptype)
+ COMPREPLY=( $( compgen -W 'full preset custom' -- $cur ) )
+ ;;
+ *)
+ esac
+ fi
+ true;
+}
+
diff --git a/data/application.d/master b/data/application.d/master
new file mode 100644
index 0000000..8054772
--- /dev/null
+++ b/data/application.d/master
@@ -0,0 +1,2 @@
+model = MasterModel
+allow_config_file_override = 1
diff --git a/data/models/MasterModel.pl b/data/models/MasterModel.pl
new file mode 100644
index 0000000..617acf0
--- /dev/null
+++ b/data/models/MasterModel.pl
@@ -0,0 +1,398 @@
+# -*- cperl -*-
+#
+# This file is part of Config-Model-Itself
+#
+# This software is Copyright (c) 2007-2017 by Dominique Dumont.
+#
+# This is free software, licensed under:
+#
+# The GNU Lesser General Public License, Version 2.1, February 1999
+#
+
+# this file is used by test script
+
+[
+ [
+ name => 'MasterModel::SubSlave2',
+ element => [
+ [qw/aa2 ab2 ac2 ad2 Z/] =>
+ { type => 'leaf', value_type => 'string' }
+ ]
+ ],
+
+ [
+ name => 'MasterModel::SubSlave',
+ element => [
+ [qw/aa ab ac ad/] => { type => 'leaf', value_type => 'string' },
+ sub_slave => {
+ type => 'node',
+ config_class_name => 'MasterModel::SubSlave2',
+ }
+ ]
+ ],
+
+ [
+ name => 'MasterModel::SlaveZ',
+ element => [
+ [qw/Z/] => {
+ type => 'leaf',
+ value_type => 'enum',
+ choice => [qw/Av Bv Cv/]
+ },
+ [qw/DX/] => {
+ type => 'leaf',
+ value_type => 'enum',
+ default => 'Dv',
+ choice => [qw/Av Bv Cv Dv/]
+ },
+ ],
+ include => 'MasterModel::X_base_class',
+ ],
+
+ [
+ name => 'MasterModel::SlaveY',
+ element => [
+ std_id => {
+ type => 'hash',
+ index_type => 'string',
+ cargo_type => 'node',
+ config_class_name => 'MasterModel::SlaveZ',
+ },
+ sub_slave => {
+ type => 'node',
+ config_class_name => 'MasterModel::SubSlave',
+ },
+ warp2 => {
+ type => 'warped_node',
+ config_class_name => 'MasterModel::SubSlave',
+ morph => 1,
+ warp => {
+ follow => '! tree_macro',
+ rules => [
+ mXY => { config_class_name => 'MasterModel::SubSlave2' },
+ XZ => { config_class_name => 'MasterModel::SubSlave2' }
+ ]
+ }
+ },
+ Y => {
+ type => 'leaf',
+ value_type => 'enum',
+ choice => [qw/Av Bv Cv/]
+ },
+ ],
+ include => 'MasterModel::X_base_class',
+ ],
+
+ [
+ name => 'MasterModel::TolerantNode',
+ accept => [
+ 'list.*' => {
+ type => 'list',
+ cargo => {
+ type => 'leaf',
+ value_type => 'string',
+ },
+ },
+ 'str.*' => {
+ type => 'leaf',
+ value_type => 'uniline'
+ },
+
+ #TODO: Some advanced structures, hashes, etc.
+ ],
+ element => [
+ id => {
+ type => 'leaf',
+ value_type => 'uniline',
+ },
+
+ ]
+ ],
+
+ [
+ name => 'MasterModel',
+ class_description => "Master description",
+ level => [ [qw/hash_a tree_macro int_v/] => 'important' ],
+
+ read_config => {
+ backend => 'cds_file',
+ config_dir => 'conf_data',
+ auto_create => 1,
+ },
+ write_config => [
+ {
+ backend => 'cds_file',
+ config_dir => 'conf_data',
+ file => 'mymaster.cds'
+ },
+ { backend => 'perl_file', config_dir => 'conf_data' }
+ ],
+
+ element => [
+ std_id => {
+ type => 'hash',
+ index_type => 'string',
+ cargo_type => 'node',
+ config_class_name => 'MasterModel::SlaveZ',
+ },
+ [qw/lista listb/] => {
+ type => 'list',
+ cargo_type => 'leaf',
+ cargo_args => { value_type => 'string' },
+ },
+ [qw/ac_list/] => {
+ type => 'list',
+ cargo_type => 'leaf',
+ auto_create_ids => 3,
+ cargo_args => { value_type => 'string' },
+ },
+ "list_XLeds" => {
+ type => 'list',
+ cargo_type => 'leaf',
+ cargo_args => {
+ value_type => 'integer',
+ min => 1,
+ max => 3
+ },
+ },
+ [qw/hash_a hash_b/] => {
+ type => 'hash',
+ index_type => 'string',
+ cargo_type => 'leaf',
+ cargo_args => { value_type => 'string' },
+ },
+ olist => {
+ type => 'list',
+ cargo_type => 'node',
+ config_class_name => 'MasterModel::SlaveZ',
+ },
+ tree_macro => {
+ type => 'leaf',
+ value_type => 'enum',
+ choice => [qw/XY XZ mXY/],
+ summary => 'macro parameter for tree',
+ help => {
+ XY => 'XY help',
+ XZ => 'XZ help',
+ mXY => 'mXY help',
+ }
+ },
+ warp_el => {
+ type => 'warped_node',
+ config_class_name => 'MasterModel::SlaveY',
+ morph => 1,
+ warp => {
+ follow => '! tree_macro',
+ rules => [
+ #XY => { config_class_name => 'MasterModel::SlaveY'},
+ mXY => { config_class_name => 'MasterModel::SlaveY' },
+ XZ => { config_class_name => 'MasterModel::SlaveZ' }
+ ]
+ }
+ },
+
+ 'tolerant_node' => {
+ type => 'node',
+ config_class_name => 'MasterModel::TolerantNode',
+ },
+
+ 'slave_y' => {
+ type => 'node',
+ config_class_name => 'MasterModel::SlaveY',
+ },
+
+ string_with_def => {
+ type => 'leaf',
+ value_type => 'string',
+ default => 'yada yada'
+ },
+ a_string => {
+ type => 'leaf',
+ mandatory => 1,
+ value_type => 'string'
+ },
+ int_v => {
+ type => 'leaf',
+ value_type => 'integer',
+ default => '10',
+ min => 5,
+ max => 15
+ },
+ my_check_list => {
+ type => 'check_list',
+ refer_to => '- hash_a + ! hash_b',
+ },
+ 'ordered_checklist' => {
+ type => 'check_list',
+ choice => [ 'A' .. 'Z' ],
+ ordered => 1,
+ help => { A => 'A help', E => 'E help' },
+ },
+
+ my_reference => {
+ type => 'leaf',
+ value_type => 'reference',
+ refer_to => '- hash_a + ! hash_b',
+ },
+ lot_of_checklist => {
+ type => 'node',
+ config_class_name => 'MasterModel::CheckListExamples',
+ },
+ warped_values => {
+ type => 'node',
+ config_class_name => 'MasterModel::WarpedValues',
+ },
+ warped_id => {
+ type => 'node',
+ config_class_name => 'MasterModel::WarpedId',
+ },
+ hash_id_of_values => {
+ type => 'node',
+ config_class_name => 'MasterModel::HashIdOfValues',
+ },
+ 'deprecated_p' => {
+ type => 'leaf',
+ value_type => 'enum',
+ choice => [qw/cds perl ini custom/],
+ status => 'deprecated',
+ description =>
+ 'deprecated_p is replaced by new_from_deprecated',
+ },
+
+ 'new_from_deprecated' => {
+ type => 'leaf',
+ value_type => 'enum',
+ choice => [qw/cds_file perl_file ini_file custom/],
+ migrate_from => {
+ formula => '$replace{$old}',
+ variables => { old => '- deprecated_p' },
+ replace => {
+ perl => 'perl_file',
+ ini => 'ini_file',
+ cds => 'cds_file',
+ },
+ },
+ },
+ 'old_url' => {
+ type => 'leaf',
+ value_type => 'uniline',
+ status => 'deprecated',
+ },
+ 'host' => {
+ type => 'leaf',
+ value_type => 'uniline',
+ migrate_from => {
+ formula => '$old =~ m!http://([\w\.]+)!; $1 ;',
+ variables => { old => '- old_url' },
+ use_eval => 1,
+ },
+ },
+ 'reference_stuff' => {
+ type => 'node',
+ config_class_name => 'MasterModel::References',
+ },
+ match => {
+ type => 'leaf',
+ value_type => 'string',
+ match => '^foo\d{2}$',
+ },
+ prd_match => {
+ type => 'leaf',
+ value_type => 'string',
+ grammar => q!token (oper token)(s?)
+ oper: 'and' | 'or'
+ token: 'Apache' | 'CC-BY' | 'Perl'
+ !,
+ },
+ warn_if => {
+ type => 'leaf',
+ value_type => 'string',
+ warn_if_match => { 'foo' => { fix => '$_ = uc;' } },
+ },
+ warn_unless => {
+ type => 'leaf',
+ value_type => 'string',
+ warn_unless_match =>
+ { foo => { msg => '', fix => '$_ = "foo".$_;' } },
+ },
+ list_with_migrate_values_from => {
+ type => 'list',
+ cargo => {
+ type => 'leaf',
+ value_type => 'string'
+ },
+ migrate_values_from => '- lista',
+ },
+ hash_with_migrate_keys_from => {
+ type => 'hash',
+ index_type => 'string',
+ cargo => {
+ type => 'leaf',
+ value_type => 'string'
+ },
+ migrate_keys_from => '- hash_a',
+ },
+ assert_leaf => {
+ type => 'leaf',
+ value_type => 'string',
+ assert => {
+ assert_test => {
+ code => 'defined $_ and /\w/',
+ msg => 'must not be empty',
+ fix => '$_ = "foobar";'
+ }
+ },
+ },
+ leaf_with_warn_unless => {
+ type => 'leaf',
+ value_type => 'string',
+ warn_unless => {
+ warn_test => {
+ code => 'defined $_ and /\w/',
+ msg => 'should not be empty',
+ fix => '$_ = "foobar";'
+ }
+ },
+ },
+ 'Source' => {
+ 'value_type' => 'string',
+ 'migrate_from' => {
+ 'use_eval' => '1',
+ 'formula' => '$old || $older ;',
+ undef_is => "''",
+ 'variables' => {
+ 'older' => '- Original-Source-Location',
+ 'old' => '- Upstream-Source'
+ }
+ },
+ 'type' => 'leaf',
+ },
+ [qw/Upstream-Source Original-Source-Location/] => {
+ 'value_type' => 'string',
+ 'status' => 'deprecated',
+ 'type' => 'leaf'
+ },
+
+ (
+ map {
+ (
+ "list_with_"
+ . $_
+ . "_duplicates" => {
+ type => 'list',
+ duplicates => $_,
+ cargo => { type => 'leaf', value_type => 'string' }
+ },
+ );
+ } qw/warn allow forbid suppress/
+ ),
+
+ ],
+ description => [ tree_macro => 'controls behavior of other elements' ],
+ author => "dod\@foo.com",
+ copyright => "2011 dod",
+ license => "LGPL",
+ ],
+];
+
+# do not put 1; at the end or Model-> load will not work
diff --git a/data/models/MasterModel/CheckListExamples.pl b/data/models/MasterModel/CheckListExamples.pl
new file mode 100644
index 0000000..16e75cf
--- /dev/null
+++ b/data/models/MasterModel/CheckListExamples.pl
@@ -0,0 +1,82 @@
+#
+# This file is part of Config-Model-Itself
+#
+# This software is Copyright (c) 2007-2017 by Dominique Dumont.
+#
+# This is free software, licensed under:
+#
+# The GNU Lesser General Public License, Version 2.1, February 1999
+#
+[
+ [
+ name => "MasterModel::CheckListExamples",
+ element => [
+ [qw/my_hash my_hash2 my_hash3/] => {
+ type => 'hash',
+ index_type => 'string',
+ cargo_type => 'leaf',
+ cargo_args => { value_type => 'string' },
+ },
+
+ choice_list => {
+ type => 'check_list',
+ choice => [ 'A' .. 'Z' ],
+ help => { A => 'A help', E => 'E help' },
+ },
+
+ choice_list_with_default => {
+ type => 'check_list',
+ choice => [ 'A' .. 'Z' ],
+ default_list => [ 'A', 'D' ],
+ help => { A => 'A help', E => 'E help' },
+ },
+
+ choice_list_with_upstream_default_list => {
+ type => 'check_list',
+ choice => [ 'A' .. 'Z' ],
+ upstream_default_list => [ 'A', 'D' ],
+ help => { A => 'A help', E => 'E help' },
+ },
+
+ macro => {
+ type => 'leaf',
+ value_type => 'enum',
+ choice => [qw/AD AH/],
+ },
+
+ 'warped_choice_list' => {
+ type => 'check_list',
+ warp => {
+ follow => '- macro',
+ rules => {
+ AD => {
+ choice => [ 'A' .. 'D' ],
+ default_list => [ 'A', 'B' ]
+ },
+ AH => { choice => [ 'A' .. 'H' ] },
+ }
+ }
+ },
+
+ refer_to_list => {
+ type => 'check_list',
+ refer_to => '- my_hash'
+ },
+
+ refer_to_2_list => {
+ type => 'check_list',
+ refer_to => '- my_hash + - my_hash2 + - my_hash3'
+ },
+
+ refer_to_check_list_and_choice => {
+ type => 'check_list',
+ refer_to =>
+ [ '- refer_to_2_list + - $var', var => '- indirection ', ],
+ choice => [qw/A1 A2 A3/],
+ },
+
+ indirection => { type => 'leaf', value_type => 'string' },
+
+ ]
+ ]
+];
diff --git a/data/models/MasterModel/HashIdOfValues.pl b/data/models/MasterModel/HashIdOfValues.pl
new file mode 100644
index 0000000..d01213b
--- /dev/null
+++ b/data/models/MasterModel/HashIdOfValues.pl
@@ -0,0 +1,79 @@
+#
+# This file is part of Config-Model-Itself
+#
+# This software is Copyright (c) 2007-2017 by Dominique Dumont.
+#
+# This is free software, licensed under:
+#
+# The GNU Lesser General Public License, Version 2.1, February 1999
+#
+my @element = (
+ # Value constructor args are passed in their specific array ref
+ cargo_type => 'leaf',
+ cargo_args => { value_type => 'string' },
+);
+
+[
+ [
+ name => "MasterModel::HashIdOfValues",
+ element => [
+ plain_hash => {
+ type => 'hash',
+
+ # hash_class constructor args are all keys of this hash
+ # except type and class
+ index_type => 'integer',
+
+ @element
+ },
+ hash_with_auto_created_id => {
+ type => 'hash',
+ index_type => 'string',
+ auto_create => 'yada',
+ @element
+ },
+ hash_with_several_auto_created_id => {
+ type => 'hash',
+ index_type => 'string',
+ auto_create => [qw/x y z/],
+ @element
+ },
+ [qw/hash_with_default_id hash_with_default_id_2/] => {
+ type => 'hash',
+ index_type => 'string',
+ default => 'yada',
+ @element
+ },
+ hash_with_several_default_keys => {
+ type => 'hash',
+ index_type => 'string',
+ default => [qw/x y z/],
+ @element
+ },
+ hash_follower => {
+ type => 'hash',
+ index_type => 'string',
+ @element,
+ follow_keys_from => '- hash_with_several_auto_created_id',
+ },
+ hash_with_allow => {
+ type => 'hash',
+ index_type => 'string',
+ @element,
+ allow_keys => [qw/foo bar baz/],
+ },
+ hash_with_allow_from => {
+ type => 'hash',
+ index_type => 'string',
+ @element,
+ allow_keys_from => '- hash_with_several_auto_created_id',
+ },
+ ordered_hash => {
+ type => 'hash',
+ index_type => 'string',
+ @element,
+ ordered => 1,
+ },
+ ],
+ ]
+];
diff --git a/data/models/MasterModel/References.pl b/data/models/MasterModel/References.pl
new file mode 100644
index 0000000..3694084
--- /dev/null
+++ b/data/models/MasterModel/References.pl
@@ -0,0 +1,105 @@
+#
+# This file is part of Config-Model-Itself
+#
+# This software is Copyright (c) 2007-2017 by Dominique Dumont.
+#
+# This is free software, licensed under:
+#
+# The GNU Lesser General Public License, Version 2.1, February 1999
+#
+[
+ [
+ name => 'MasterModel::References::Host',
+ 'element' => [
+ if => {
+ type => 'hash',
+ index_type => 'string',
+ cargo_type => 'node',
+ config_class_name => 'MasterModel::References::If',
+ },
+ trap => {
+ type => 'leaf',
+ value_type => 'string'
+ }
+ ]
+ ],
+ [
+ name => 'MasterModel::References::If',
+ element => [
+ ip => {
+ type => 'leaf',
+ value_type => 'string'
+ }
+ ]
+ ],
+ [
+ name => 'MasterModel::References::Lan',
+ element => [
+ node => {
+ type => 'hash',
+ index_type => 'string',
+ cargo_type => 'node',
+ config_class_name => 'MasterModel::References::Node',
+ },
+ ]
+ ],
+ [
+ name => 'MasterModel::References::Node',
+ element => [
+ host => {
+ type => 'leaf',
+ value_type => 'reference',
+ refer_to => '- host'
+ },
+ if => {
+ type => 'leaf',
+ value_type => 'reference',
+ refer_to => [ ' - host:$h if ', h => '- host' ]
+ },
+ ip => {
+ type => 'leaf',
+ value_type => 'string',
+ compute => [
+ '$ip',
+ ip => '- host:$h if:$card ip',
+ h => '- host',
+ card => '- if'
+ ]
+ }
+ ]
+ ],
+ [
+ name => 'MasterModel::References',
+ element => [
+ host => {
+ type => 'hash',
+ index_type => 'string',
+ cargo_type => 'node',
+ config_class_name => 'MasterModel::References::Host'
+ },
+ lan => {
+ type => 'hash',
+ index_type => 'string',
+ cargo_type => 'node',
+ config_class_name => 'MasterModel::References::Lan'
+ },
+ host_and_choice => {
+ type => 'leaf',
+ value_type => 'reference',
+ refer_to => ['- host '],
+ choice => [qw/foo bar/]
+ },
+ dumb_list => {
+ type => 'list',
+ cargo_type => 'leaf',
+ cargo_args => { value_type => 'string' }
+ },
+ refer_to_list_enum => {
+ type => 'leaf',
+ value_type => 'reference',
+ refer_to => '- dumb_list',
+ },
+
+ ]
+ ]
+];
diff --git a/data/models/MasterModel/WarpedId.pl b/data/models/MasterModel/WarpedId.pl
new file mode 100644
index 0000000..e30af09
--- /dev/null
+++ b/data/models/MasterModel/WarpedId.pl
@@ -0,0 +1,103 @@
+#
+# This file is part of Config-Model-Itself
+#
+# This software is Copyright (c) 2007-2017 by Dominique Dumont.
+#
+# This is free software, licensed under:
+#
+# The GNU Lesser General Public License, Version 2.1, February 1999
+#
+[
+ [
+ name => 'MasterModel::WarpedIdSlave',
+ element => [
+ [qw/X Y Z/] => {
+ type => 'leaf',
+ value_type => 'enum',
+ choice => [qw/Av Bv Cv/],
+ }
+ ]
+ ],
+
+ [
+ name => 'MasterModel::WarpedId',
+ 'element' => [
+ macro => {
+ type => 'leaf',
+ value_type => 'enum',
+ choice => [qw/A B C/],
+ },
+ version => {
+ type => 'leaf',
+ value_type => 'integer',
+ default => 1
+ },
+ warped_hash => {
+ type => 'hash',
+ index_type => 'integer',
+ max_nb => 3,
+ warp => {
+ follow => '- macro',
+ rules => {
+ A => { max_nb => 1 },
+ B => { max_nb => 2 }
+ }
+ },
+ cargo_type => 'node',
+ config_class_name => 'MasterModel::WarpedIdSlave'
+ },
+ 'multi_warp' => {
+ type => 'hash',
+ index_type => 'integer',
+ min_index => 0,
+ max_index => 3,
+ default => [ 0 .. 3 ],
+ warp => {
+ follow => [ '- version', '- macro' ],
+ 'rules' => [
+ [ '2', 'C' ] => { max => 7, default => [ 0 .. 7 ] },
+ [ '2', 'A' ] => { max => 7, default => [ 0 .. 7 ] }
+ ]
+ },
+ cargo_type => 'node',
+ config_class_name => 'MasterModel::WarpedIdSlave'
+ },
+
+ 'hash_with_warped_value' => {
+ type => 'hash',
+ index_type => 'string',
+ cargo_type => 'leaf',
+ level => 'hidden',
+ warp => {
+ follow => '- macro',
+ 'rules' => { 'A' => { level => 'normal', }, }
+ },
+ cargo_args => {
+ value_type => 'string',
+ warp => {
+ follow => '- macro',
+ 'rules' => { 'A' => { default => 'dumb string' }, }
+ }
+ }
+ },
+ 'multi_auto_create' => {
+ type => 'hash',
+ index_type => 'integer',
+ min_index => 0,
+ max_index => 3,
+ auto_create => [ 0 .. 3 ],
+ 'warp' => {
+ follow => [ '- version', '- macro' ],
+ 'rules' => [
+ [ '2', 'C' ] =>
+ { max => 7, auto_create_keys => [ 0 .. 7 ] },
+ [ '2', 'A' ] =>
+ { max => 7, auto_create_keys => [ 0 .. 7 ] }
+ ],
+ },
+ cargo_type => 'node',
+ config_class_name => 'MasterModel::WarpedIdSlave'
+ }
+ ]
+ ]
+];
diff --git a/data/models/MasterModel/WarpedValues.pl b/data/models/MasterModel/WarpedValues.pl
new file mode 100644
index 0000000..71865c9
--- /dev/null
+++ b/data/models/MasterModel/WarpedValues.pl
@@ -0,0 +1,237 @@
+#
+# This file is part of Config-Model-Itself
+#
+# This software is Copyright (c) 2007-2017 by Dominique Dumont.
+#
+# This is free software, licensed under:
+#
+# The GNU Lesser General Public License, Version 2.1, February 1999
+#
+[
+ [
+ name => "MasterModel::RSlave",
+ element => [
+ recursive_slave => {
+ type => 'hash',
+ index_type => 'string',
+ cargo_type => 'node',
+ config_class_name => 'MasterModel::RSlave',
+ },
+ big_compute => {
+ type => 'hash',
+ index_type => 'string',
+ cargo_type => 'leaf',
+ cargo_args => {
+ value_type => 'string',
+ compute => [
+ 'macro is $m, my idx: &index, '
+ . 'my element &element, '
+ . 'upper element &element($up), '
+ . 'up idx &index($up)',
+ 'm' => '! macro',
+ up => '-'
+ ]
+ },
+ },
+ big_replace => {
+ type => 'leaf',
+ value_type => 'string',
+ compute => [
+ 'trad idx $replace{&index($up)}',
+ up => '-',
+ replace => {
+ l1 => 'level1',
+ l2 => 'level2'
+ }
+ ]
+ },
+ macro_replace => {
+ type => 'hash',
+ index_type => 'string',
+ cargo_type => 'leaf',
+ cargo_args => {
+ value_type => 'string',
+ compute => [
+ 'trad macro is $macro{$m}',
+ 'm' => '! macro',
+ macro => {
+ A => 'macroA',
+ B => 'macroB',
+ C => 'macroC'
+ }
+ ]
+ },
+ }
+ ],
+ ],
+
+ [
+ name => "MasterModel::Slave",
+ element => [
+ [qw/X Y Z/] => {
+ type => 'leaf',
+ value_type => 'enum',
+ choice => [qw/Av Bv Cv/],
+ warp => {
+ follow => '- - macro',
+ rules => {
+ A => { default => 'Av' },
+ B => { default => 'Bv' }
+ }
+ }
+ },
+ 'recursive_slave' => {
+ type => 'hash',
+ index_type => 'string',
+ cargo_type => 'node',
+ config_class_name => 'MasterModel::RSlave',
+ },
+ W => {
+ type => 'leaf',
+ value_type => 'enum',
+ level => 'hidden',
+ warp => {
+ follow => '- - macro',
+ 'rules' => {
+ A => {
+ default => 'Av',
+ level => 'normal',
+ choice => [qw/Av Bv Cv/],
+ },
+ B => {
+ default => 'Bv',
+ level => 'normal',
+ choice => [qw/Av Bv Cv/]
+ }
+ }
+ },
+ },
+ Comp => {
+ type => 'leaf',
+ value_type => 'string',
+ compute => [ 'macro is $m', 'm' => '- - macro' ],
+ },
+ ],
+ ],
+ [
+ name => "MasterModel::WarpedValues",
+ element => [
+ get_element => {
+ type => 'leaf',
+ value_type => 'enum',
+ choice => [qw/m_value_element compute_element/]
+ },
+ where_is_element => {
+ type => 'leaf',
+ value_type => 'enum',
+ choice => [qw/get_element/]
+ },
+ macro => {
+ type => 'leaf',
+ value_type => 'enum',
+ choice => [qw/A B C D/]
+ },
+ macro2 => {
+ type => 'leaf',
+ value_type => 'enum',
+ level => 'hidden',
+ warp => {
+ follow => '- macro',
+ 'rules' => [
+ "B" => {
+ choice => [qw/A B C D/],
+ level => 'normal'
+ },
+ ]
+ }
+ },
+ 'm_value' => {
+ type => 'leaf',
+ value_type => 'enum',
+ 'warp' => {
+ follow => { m => '- macro' },
+ 'rules' => [
+ '$m eq "A" or $m eq "D"' => {
+ choice => [qw/Av Bv/],
+ help => { Av => 'Av help' },
+ },
+ '$m eq "B"' => {
+ choice => [qw/Bv Cv/],
+ help => { Bv => 'Bv help' },
+ },
+ '$m eq "C"' => {
+ choice => [qw/Cv/],
+ help => { Cv => 'Cv help' },
+ }
+ ]
+ }
+ },
+ 'm_value_old' => {
+ type => 'leaf',
+ value_type => 'enum',
+ 'warp' => {
+ follow => '- macro',
+ 'rules' => [
+ [qw/A D/] => {
+ choice => [qw/Av Bv/],
+ help => { Av => 'Av help' },
+ },
+ B => {
+ choice => [qw/Bv Cv/],
+ help => { Bv => 'Bv help' },
+ },
+ C => {
+ choice => [qw/Cv/],
+ help => { Cv => 'Cv help' },
+ }
+ ]
+ }
+ },
+ 'compute' => {
+ type => 'leaf',
+ value_type => 'string',
+ compute =>
+ [ 'macro is $m, my element is &element', 'm' => '- macro' ]
+ },
+
+ 'var_path' => {
+ type => 'leaf',
+ value_type => 'string',
+ mandatory => 1, # will croak if value cannot be computed
+ compute => [
+ 'get_element is $element_table{$s}, indirect value is \'$v\'',
+ 's' => '- $where',
+ where => '- where_is_element',
+ v => '- $element_table{$s}',
+ element_table => {
+ qw/m_value_element m_value
+ compute_element compute/
+ }
+ ]
+ },
+
+ 'class' => {
+ type => 'hash',
+ index_type => 'string',
+ cargo_type => 'leaf',
+ cargo_args => { value_type => 'string' },
+ },
+ 'warped_out_ref' => {
+ type => 'leaf',
+ value_type => 'reference',
+ refer_to => '- class',
+ level => 'hidden',
+ warp => {
+ follow => { m => '- macro', m2 => '- macro2' },
+ rules =>
+ [ '$m eq "A" or $m2 eq "A"' => { level => 'normal', }, ]
+ }
+ },
+
+ [qw/bar foo foo2/] => {
+ type => 'node',
+ config_class_name => 'MasterModel::Slave'
+ }
+ ],
+ ]
+];
diff --git a/data/models/MasterModel/X_base_class.pl b/data/models/MasterModel/X_base_class.pl
new file mode 100644
index 0000000..e9e8224
--- /dev/null
+++ b/data/models/MasterModel/X_base_class.pl
@@ -0,0 +1,35 @@
+# -*- cperl -*-
+#
+# This file is part of Config-Model-Itself
+#
+# This software is Copyright (c) 2007-2017 by Dominique Dumont.
+#
+# This is free software, licensed under:
+#
+# The GNU Lesser General Public License, Version 2.1, February 1999
+#
+
+# this file is used by test script
+
+[
+
+ [
+ name => 'MasterModel::X_base_class2',
+ element => [
+ X => {
+ type => 'leaf',
+ value_type => 'enum',
+ choice => [qw/Av Bv Cv/]
+ },
+ ],
+ class_description => 'rather dummy class to check include',
+ ],
+
+ [
+ name => 'MasterModel::X_base_class',
+ include => 'MasterModel::X_base_class2',
+ ],
+
+];
+
+# do not put 1; at the end or Model-> load will not work
diff --git a/lib/App/Cme/Command/meta.pm b/lib/App/Cme/Command/meta.pm
new file mode 100644
index 0000000..c2950b6
--- /dev/null
+++ b/lib/App/Cme/Command/meta.pm
@@ -0,0 +1,651 @@
+#
+# This file is part of Config-Model-Itself
+#
+# This software is Copyright (c) 2007-2017 by Dominique Dumont.
+#
+# This is free software, licensed under:
+#
+# The GNU Lesser General Public License, Version 2.1, February 1999
+#
+# ABSTRACT: Edit the configuration of an application
+
+package App::Cme::Command::meta ;
+$App::Cme::Command::meta::VERSION = '2.007';
+use strict ;
+use warnings ;
+use 5.10.1;
+
+use App::Cme -command ;
+
+use base qw/App::Cme::Common/;
+
+use Config::Model 2.075;
+
+use Config::Model::Itself ;
+use YAML::Tiny;
+
+use Tk ;
+use Config::Model::TkUI ;
+use Config::Model::Itself::TkEditUI ;
+use Path::Tiny ;
+
+my %meta_cmd = (
+ check => \&check,
+ dump => \&dump_cds,
+ 'dump-yaml' => \&dump_yaml,
+ 'gen-dot' => \&gen_dot,
+ edit => \&edit,
+ save => \&save,
+ plugin => \&plugin,
+);
+
+sub validate_args {
+ my ($self, $opt, $args) = @_;
+
+ my $mc = $opt->{'_meta_command'} = shift @$args || die "please specify meta sub command\n";
+
+ if (not $meta_cmd{$mc}) {
+ die "Unexpected meta sub command: '$mc'. Expected ".join(' ', sort keys %meta_cmd)."\n";
+ }
+
+ my ( $categories, $appli_info, $appli_map ) = Config::Model::Lister::available_models;
+ my $application = shift @$args;
+
+ if ($mc eq 'plugin') {
+ unless ($application) {
+ die "Missing application name after 'plugin' command";
+ }
+ $opt->{_root_model} = $appli_map->{$application}
+ || die "Unknown application $application";
+ }
+ elsif ($application) {
+ $opt->{_root_model} = $appli_map->{$application} || $application;
+ }
+
+ Config::Model::Exception::Any->Trace(1) if $opt->{trace};
+
+ $opt->{_application} = $application ;
+
+}
+
+sub opt_spec {
+ my ( $class, $app ) = @_;
+
+ return (
+ [
+ "dir=s" => "directory where to read and write a model",
+ {default => 'lib/Config/Model'}
+ ],
+ [
+ "dumptype=s" => "dump every values (full), only preset values "
+ . "or only customized values (default)",
+ {callbacks => { 'expected values' => sub { $_[0] =~ m/^full|preset|custom$/ ; }}}
+ ],
+ [ "open-item=s" => "force the UI to open the specified node"],
+ [ "plugin-file=s" => "create a model plugin in this file" ],
+ [ "load-yaml=s" => "load model from YAML file" ],
+ [ "load=s" => "load model from cds file (Config::Model serialisation file)"],
+ [ "system!" => "read model from system files" ],
+ [ "test-and-quit=s" => "Used for tests" ],
+ $class->cme_global_options()
+ );
+}
+
+sub usage_desc {
+ my ($self) = @_;
+ my $desc = $self->SUPER::usage_desc; # "%c COMMAND %o"
+ return "$desc [ ".join(' | ', sort keys %meta_cmd)." ] your_model_class ";
+}
+
+sub description {
+ my ($self) = @_;
+ return $self->get_documentation;
+}
+
+sub read_data {
+ my $load_file = shift ;
+
+ my @data ;
+ if ( $load_file eq '-' ) {
+ @data = <STDIN> ;
+ }
+ else {
+ open(LOAD,$load_file) || die "cannot open load file $load_file:$!";
+ @data = <LOAD> ;
+ close LOAD;
+ }
+
+ return wantarray ? @data : join('', at data);
+}
+
+sub load_optional_data {
+ my ($self, $args, $opt, $root_model, $meta_root) = @_;
+
+ if (defined $opt->{load}) {
+ my $data = read_data($opt->{load}) ;
+ $data = qq(class:"$root_model" ).$data unless $data =~ /^\s*class:/ ;
+ $meta_root->load($data);
+ }
+
+ if (defined $opt->{'load-yaml'}) {
+ my $yaml = read_data($opt->{'load-yaml'}) ;
+ my $pdata = Load($yaml) ;
+ $meta_root->load_data($pdata) ;
+ }
+}
+
+sub load_meta_model {
+ my ($self, $opt, $args) = @_;
+
+ my $root_model = $opt->{_root_model};
+ my $cm_lib_dir = path(split m!/!, $opt->{dir}) ; # replace with cm_lib_dir ???
+
+ if (! $cm_lib_dir->is_dir) {
+ $cm_lib_dir->mkpath(0, 0755) || die "can't create $cm_lib_dir:$!";
+ }
+
+ my $meta_model = $self->{meta_model} = Config::Model -> new();
+
+ my $meta_inst = $meta_model->instance(
+ root_class_name => 'Itself::Model',
+ instance_name => 'meta',
+ check => $opt->{'force-load'} ? 'no' : 'yes',
+ );
+
+ my $meta_root = $meta_inst -> config_root ;
+
+ my $system_cm_lib_dir = $INC{'Config/Model.pm'} ;
+ $system_cm_lib_dir =~ s/\.pm//;
+
+ return ($meta_inst, $meta_root, $cm_lib_dir, path($system_cm_lib_dir));
+}
+
+sub load_meta_root {
+ my ($self, $opt, $args) = @_;
+
+ my ($meta_inst, $meta_root, $cm_lib_dir, $system_cm_lib_dir) = $self->load_meta_model($opt,$args);
+
+ my $root_model = $opt->{_root_model};
+
+ say "Reading model from $system_cm_lib_dir" if $opt->system();
+
+ # now load model
+ my $rw_obj = Config::Model::Itself -> new(
+ model_object => $meta_root,
+ cm_lib_dir => $cm_lib_dir->canonpath
+ );
+
+ $meta_inst->initial_load_start ;
+
+ my @read_args = (
+ force_load => $opt->{'force-load'},
+ root_model => $root_model,
+ # legacy => 'ignore',
+ );
+ if ($opt->system()) {
+ push @read_args,
+ application => $opt->{_application},
+ read_from => $system_cm_lib_dir ;
+ }
+ $rw_obj->read_all(@read_args);
+
+ $meta_inst->initial_load_stop ;
+
+ $self->load_optional_data($args, $opt, $root_model, $meta_root) ;
+
+ my $write_sub = sub {
+ my $wr_dir = shift || $cm_lib_dir ;
+ $rw_obj->write_all( );
+ } ;
+ return ($rw_obj, $cm_lib_dir, $meta_root, $write_sub);
+}
+
+sub load_meta_plugin {
+ my ($self, $opt, $args) = @_;
+
+ my ($meta_inst, $meta_root, $cm_lib_dir, $system_cm_lib_dir) = $self->load_meta_model($opt, $args);
+
+ my $root_model = $opt->{_root_model};
+ my $meta_cm_lib_dir = $opt->dev ? $cm_lib_dir : $system_cm_lib_dir ;
+ my $plugin_name = shift @$args or die "missing plugin file name after application name.";
+
+ if ($plugin_name =~ s/\.pl$//) {
+ warn "removed '.pl' deprecated suffix from plugin name\n";
+ }
+
+ say "Preparing plugin $plugin_name for model $root_model found in $meta_cm_lib_dir";
+ say "Use -dev option to create a plugin for a local model (i.e. in $cm_lib_dir)"
+ unless $opt->dev;
+
+ # now load model
+ my $rw_obj = Config::Model::Itself -> new(
+ model_object => $meta_root,
+ cm_lib_dir => $meta_cm_lib_dir->canonpath,
+ ) ;
+
+ $meta_inst->initial_load_start ;
+ $meta_inst->layered_start;
+
+ $rw_obj->read_all(
+ force_load => $opt->{'force-load'},
+ root_model => $root_model,
+ # legacy => 'ignore',
+ );
+
+ $meta_inst->layered_stop;
+
+ # load any existing plugin file
+ $rw_obj->read_model_plugin(
+ plugin_dir => $cm_lib_dir.'/models/',
+ plugin_name => $plugin_name
+ ) ;
+
+ $meta_inst->initial_load_stop ;
+
+ $self->load_optional_data($args, $opt, $root_model, $meta_root) ;
+ my $root_model_dir = $root_model ;
+ $root_model_dir =~ s!::!/!g;
+ my $write_sub = sub {
+ $rw_obj->write_model_plugin(
+ plugin_dir => "$cm_lib_dir/models/$root_model_dir.d",
+ plugin_name => $plugin_name
+ );
+ } ;
+
+ return ($rw_obj, $cm_lib_dir, $meta_root, $write_sub);
+}
+
+sub execute {
+ my ($self, $opt, $args) = @_;
+
+ # how to specify root-model when starting from scratch ?
+ # ask question and fill application file ?
+
+ my $cmd_sub = $meta_cmd{$opt->{_meta_command}};
+
+ $self->$cmd_sub($opt, $args);
+}
+
+sub save {
+ my ($self, $opt, $args) = @_;
+ my ($rw_obj, $cm_lib_dir, $meta_root, $write_sub) = $self->load_meta_root($opt, $args) ;
+
+ say "Saving ",$rw_obj->root_model. ' model'. ($opt->dir ? ' in '.$opt->dir : '');
+ &$write_sub;
+}
+
+sub gen_dot {
+ my ($self, $opt, $args) = @_;
+ my ($rw_obj, $cm_lib_dir, $meta_root, $write_sub) = $self->load_meta_root($opt, $args) ;
+
+ my $out = shift @$args || "model.dot";
+ say "Creating dot file $out";
+ path($out) -> spew( $rw_obj->get_dot_diagram );
+}
+
+sub check {
+ my ($self, $opt, $args) = @_;
+
+ say "loading model" unless $opt->{quiet};
+ my ($rw_obj, $cm_lib_dir, $meta_root, $write_sub) = $self->load_meta_root($opt, $args) ;
+
+ Config::Model::ObjTreeScanner->new( leaf_cb => sub { } )->scan_node( undef, $meta_root );
+
+ say "checking data" unless $opt->{quiet};
+ $meta_root->dump_tree( mode => 'full' );
+ say "check done" unless $opt->{quiet};
+
+ my $ouch = $meta_root->instance->has_warning;
+
+ if ( $opt->{strict} and $ouch ) {
+ die "Found $ouch warnings in strict mode\n";
+ }
+
+}
+
+sub dump_cds {
+ my ($self, $opt, $args) = @_;
+ my ($rw_obj, $cm_lib_dir, $meta_root, $write_sub) = $self->load_meta_root($opt, $args) ;
+
+ my $dump_file = shift @$args || 'model.cds';
+ say "Dumping ".$rw_obj->root_model." in $dump_file";
+
+ my $dump_string = $meta_root->dump_tree( mode => $opt->{dumptype} || 'custom' ) ;
+
+ path($dump_file)->spew($dump_string);
+}
+
+sub dump_yaml{
+ my ($self, $opt, $args) = @_;
+ my ($rw_obj, $cm_lib_dir, $meta_root, $write_sub) = $self->load_meta_root($opt, $args) ;
+
+ require YAML::Tiny;
+ import YAML::Tiny qw/Dump/;
+ my $dump_file = shift @$args || 'model.yml';
+ say "Dumping ".$rw_obj->root_model." in $dump_file";
+
+ my $dump_string = Dump($meta_root->dump_as_data(ordered_hash_as_list => 0)) ;
+
+ path($dump_file)->spew($dump_string);
+
+}
+
+sub plugin {
+ my ($self, $opt, $args) = @_;
+ my @info = $self->load_meta_plugin($opt, $args) ;
+ $self->_edit($opt, $args, @info);
+}
+
+sub edit {
+ my ($self, $opt, $args) = @_;
+ my @info = $self->load_meta_root($opt, $args) ;
+ $self->_edit($opt, $args, @info);
+}
+
+sub _edit {
+ my ($self, $opt, $args, $rw_obj, $cm_lib_dir, $meta_root, $write_sub) = @_;
+
+ my $root_model = $rw_obj->root_model;
+ my $mw = MainWindow-> new;
+
+ $mw->withdraw ;
+ # Thanks to Jerome Quelin for the tip
+ $mw->optionAdd('*BorderWidth' => 1);
+
+ my $cmu = $mw->ConfigModelEditUI(
+ -root => $meta_root,
+ -store_sub => $write_sub,
+ -model_name => $root_model,
+ -cm_lib_dir => $cm_lib_dir
+ );
+
+ my $open_item = $opt->{'open-item'};
+ if ($root_model and not $meta_root->fetch_element('class')->fetch_size) {
+ $open_item ||= qq(class:"$root_model" );
+ }
+ else {
+ $open_item ||= 'class';
+ }
+
+ my $obj = $meta_root->grab($open_item) ;
+ $cmu->after(10, sub { $cmu->force_element_display($obj) });
+
+ if (my $taq = $opt->test_and_quit ) {
+ my $bail_out = sub {
+ warn "save failed: $_[0]\n" if @_;
+ $cmu -> quit;
+ } ;
+
+ $cmu->after( 2000 , sub {
+ if ($taq =~ /s/) {
+ say "Test mode: save and quit";
+ $cmu->save( $bail_out );
+ }
+ else {
+ say "Test mode: quit only";
+ &$bail_out
+ }
+ });
+ }
+ &MainLoop ; # Tk's
+ say "Exited GUI";
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+App::Cme::Command::meta - Edit the configuration of an application
+
+=head1 VERSION
+
+version 2.007
+
+=head1 SYNOPSIS
+
+ # edit meta model
+ cme meta [ options ] edit [ model_class ]
+
+ # check meta model
+ cme meta [ options ] check [ model_class ]
+
+ # model plugin mode
+ cme meta [options] plugin application plugin_name
+
+=head1 DESCRIPTION
+
+C<cme meta edit> provides a Perl/Tk graphical interface to create or
+edit configuration models that will be used by L<Config::Model>.
+
+This tool enables you to create configuration checker or editor for
+configuration files of an application.
+
+=head1 USAGE
+
+C<cme meta> supports several sub commands like C<edit> or C<plugin>. These
+sub commands are detailed below.
+
+=head2 edit
+
+C<cme meta edit> is the most useful sub command. It will read and
+write model file from C<./lib/Config/Model/models> directory.
+
+Only configuration models matching the optional 4th parameter will be loaded. I.e.
+
+ cme meta edit Xorg
+
+will load models C<Xorg> (file C<Xorg.pl>) and all other C<Xorg::*> like
+C<Xorg::Screen> (file C<Xorg/Screen.pl>).
+
+Besides C<edit>, the following sub commands are available:
+
+=head2 check
+
+C<cme meta check> reads the model files from
+C<./lib/Config/Model/models> directory and checks their validity.
+
+=head2 plugin
+
+This sub command is used to create model plugins. A model plugin is an
+addendum to an existing model. The resulting file is saved in a
+C<.d> directory besides the original file to be taken into account.
+
+For instance:
+
+ $ cme meta plugin dpkg my-plugin
+ # perform additions to Dpkg and Dpkg::Control and save
+ $ find lib/Config/Model/models/Dpkg.d -type f
+ lib/Config/Model/models/Debian/Dpkg.d/my-plugin/Dpkg.pl
+ lib/Config/Model/models/Debian/Dpkg.d/my-plugin/Dpkg/Control.pl
+
+Use C<-dev> option if you need to add plugins to a model located in
+current directory.
+
+=head2 gen-dot [ file.dot ]
+
+Create a dot file that represent the structure of the configuration
+model. By default, the generated dot file is C<model.dot>
+
+ $ cme meta gen-dot Itself itself.dot
+ $ dot -T png itself.dot > itself.png
+
+C<include> are represented by solid lines. Class usage
+(i.e. C<config_class_name> parameter) is represented by dashed
+lines. The name of the element is attached to the dashed line.
+
+=head2 dump [ file.cds ]
+
+Dump configuration content in the specified file (or C<model.cds>) using
+Config::Model dump string syntax (hence the C<cds> file extension).
+See L<Config::Model::Loader> for details on the syntax)
+
+By default, dump only custom values, i.e. different from application
+built-in values or model default values. See -dumptype option for
+other types of dump
+
+ $ cme meta dump Itself
+
+=head2 dump-yaml [ file.yml ]
+
+Dump configuration content in the specified file (or C<model.yml>) in
+YAML format.
+
+=head2 save
+
+Force a save of the model even if no edition was done. This option is
+useful to migrate a model when Config::Model model feature changes.
+
+=head1 Options
+
+=over
+
+=item -system
+
+Read model from system files, i.e. from installed files, not from
+C<./lib> directory.
+
+=item -trace
+
+Provides a full stack trace when exiting on error.
+
+=item -load <cds_file_to_load> | -
+
+Load model from cds file (using Config::Model serialisation format,
+typically done with -dump option). This option can be used with
+C<save> to directly save a model loaded from the cds file or from
+STDIN.
+
+=item -load-yaml <yaml_file_to_load> | -
+
+Load configuration data in model from YAML file. This
+option can be used with C<save> to directly save a model loaded from
+a YAML file or from STDIN.
+
+=item -force-load
+
+Load file even if error are found in data. Bad data are loaded, but should be cleaned up
+before saving the model. See menu C<< File -> check >> in the GUI.
+
+=item -dumptype [ full | preset | custom ]
+
+Choose to dump every values (full), only preset values or only
+customized values (default) (only for C<dump> sub command)
+
+=item -open-item 'path'
+
+In graphical mode, force the UI to open the specified node. E.g.
+
+ -open_item 'class:Fstab::FsLine element:fs_mntopts rules'
+
+=back
+
+=head1 LOGGING
+
+All Config::Model logging was moved from klunky debug and
+verbose prints to L<Log::Log4perl>. Logging can be configured in the
+following files:
+
+=over
+
+=item *
+
+ ~/.log4config-model
+
+=item *
+
+ /etc/log4config-model.conf
+
+=back
+
+Without these files, the following Log4perl config is used:
+
+ log4perl.logger=WARN, Screen
+ log4perl.appender.Screen = Log::Log4perl::Appender::Screen
+ log4perl.appender.Screen.stderr = 0
+ log4perl.appender.Screen.layout = Log::Log4perl::Layout::PatternLayout
+ log4perl.appender.Screen.layout.ConversionPattern = %d %m %n
+
+Log4Perl categories are shown in L<cme/LOGGING>
+
+=head1 Dogfooding
+
+The GUI shown by C<cme meta edit> is created from a configuration
+model that describes the structure and parameters of a configuration
+model. (which explains the "Itself" name. This module could also be
+named C<Config::Model::DogFooding>).
+
+This explains why the GUI shown by C<cme meta edit> looks like the GUI
+shown by C<cme edit>: the same GUI generator is used.
+
+If you're new to L<Config::Model>, I'd advise not to peek under
+C<Config::Model::Itself> hood lest you loose your sanity.
+
+=head1 AUTHOR
+
+Dominique Dumont, ddumont at cpan dot org
+
+=head1 SEE ALSO
+
+=over
+
+=item *
+
+L<Config::Model::Manual::ModelCreationIntroduction>
+
+=item *
+
+L<cme>,
+
+=item *
+
+L<Config::Model>,
+
+=item *
+
+L<Config::Model::Itself>,
+
+=item *
+
+L<Config::Model::Node>,
+
+=item *
+
+L<Config::Model::Instance>,
+
+=item *
+
+L<Config::Model::HashId>,
+
+=item *
+
+L<Config::Model::ListId>,
+
+=item *
+
+L<Config::Model::WarpedNode>,
+
+=item *
+
+L<Config::Model::Value>
+
+=back
+
+=head1 AUTHOR
+
+Dominique Dumont
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is Copyright (c) 2007-2017 by Dominique Dumont.
+
+This is free software, licensed under:
+
+ The GNU Lesser General Public License, Version 2.1, February 1999
+
+=cut
diff --git a/lib/Config/Model/Itself.pm b/lib/Config/Model/Itself.pm
new file mode 100644
index 0000000..32fc40e
--- /dev/null
+++ b/lib/Config/Model/Itself.pm
@@ -0,0 +1,991 @@
+#
+# This file is part of Config-Model-Itself
+#
+# This software is Copyright (c) 2007-2017 by Dominique Dumont.
+#
+# This is free software, licensed under:
+#
+# The GNU Lesser General Public License, Version 2.1, February 1999
+#
+package Config::Model::Itself ;
+$Config::Model::Itself::VERSION = '2.007';
+use Mouse ;
+use Config::Model 2.098;
+use 5.010;
+
+use IO::File ;
+use Log::Log4perl 1.11;
+use Carp ;
+use Data::Dumper ;
+use File::Find ;
+use File::Path ;
+use File::Basename ;
+use Data::Compare ;
+use Path::Tiny 0.062;
+use Mouse::Util::TypeConstraints;
+
+my $logger = Log::Log4perl::get_logger("Backend::Itself");
+
+subtype 'ModelPathTiny' => as 'Object' => where { $_->isa('Path::Tiny') };
+
+coerce 'ModelPathTiny' => from 'Str' => via {path($_)} ;
+
+# find all .pl file in model_dir and load them...
+
+around BUILDARGS => sub {
+ my $orig = shift;
+ my $class = shift;
+ my %args = @_;
+
+ my $legacy = delete $args{model_object};
+ if ($legacy) {
+ $args{config_model} = $legacy->instance->config_model;
+ $args{meta_instance} = $legacy->instance;
+ $args{meta_root} = $legacy;
+ }
+ return $class->$orig( %args );
+};
+
+has 'config_model' => (
+ is => 'ro',
+ isa => 'Config::Model',
+ lazy_build => 1,
+) ;
+
+
+sub _build_config_model {
+ my $self = shift;
+ # don't trigger builders below
+ if ($self->{meta_root}) {
+ return $self->meta_root->instance->config_model;
+ }
+ elsif ($self->{meta_instance}) {
+ return $self->meta_instance->config_model;
+ }
+ else {
+ return Config::Model -> new ( ) ;
+ }
+}
+
+has check => (is =>'ro', isa => 'Bool', default => 1) ;
+
+has 'meta_instance' => (
+ is =>'ro',
+ isa =>'Config::Model::Instance',
+ lazy_build => 1,
+) ;
+
+sub _build_meta_instance {
+ my $self = shift;
+
+ # don't trigger builders below
+ if ($self->{meta_root}) {
+ return $self->meta_root->instance;
+ }
+ else {
+ # load Config::Model model
+ return $self->config_model->instance (
+ root_class_name => 'Itself::Model' ,
+ instance_name => 'meta_model' ,
+ check => $self->check,
+ );
+ }
+
+}
+
+has meta_root => (
+ is =>'ro',
+ isa =>'Config::Model::Node',
+ lazy_build => 1,
+) ;
+
+sub _build_meta_root {
+ my $self = shift;
+
+ return $self->meta_instance -> config_root ;
+}
+
+has cm_lib_dir => (
+ is =>'ro',
+ isa => 'ModelPathTiny',
+ lazy_build => 1,
+ coerce => 1
+) ;
+
+sub _build_cm_lib_dir {
+ my $self = shift;
+ my $p = path('lib/Config/Model');
+ if (! $p->is_dir) {
+ $p->mkpath(0, 0755) || die "can't create $p:$!";
+ }
+ return $p;
+}
+
+has force_write => (is =>'ro', isa => 'Bool', default => 0) ;
+has root_model => (is =>'ro', isa => 'str');
+
+has modified_classes => (
+ is =>'rw',
+ isa =>'HashRef[Bool]',
+ traits => ['Hash'],
+ default => sub { {} } ,
+ handles => {
+ clear_classes => 'clear',
+ set_class => 'set',
+ class_was_changed => 'get' ,
+ class_known => 'exists',
+ }
+) ;
+
+has model_dir => (
+ is => 'ro',
+ isa => 'ModelPathTiny',
+ lazy_build => 1,
+);
+
+sub _build_model_dir {
+ my $self = shift;
+ my $md = $self->cm_lib_dir->child('models');
+ $md->mkpath;
+ return $md;
+}
+
+sub BUILD {
+ my $self = shift;
+
+ my $cb = sub {
+ my %args = @_ ;
+ my $p = $args{path} || '' ;
+ return unless $p =~ /^class/ ;
+ return unless $args{index}; # may be empty when class order is changed
+ return if $self->class_was_changed($args{index}) ;
+ $logger->info("class $args{index} was modified");
+
+ $self->add_modified_class($args{index}) ;
+ } ;
+ $self->meta_instance -> on_change_cb($cb) ;
+
+}
+
+sub add_tracked_class {
+ my $self = shift;
+ $self->set_class(shift,0) ;
+}
+
+sub add_modified_class {
+ my $self = shift;
+ $self->set_class(shift,1) ;
+}
+
+sub class_needs_write {
+ my $self = shift;
+ my $name = shift;
+ return ($self->force_write or not $self->class_known($name) or $self->class_was_changed($name)) ;
+}
+
+sub read_app_files {
+ my $self = shift;
+ my $force_load = shift || 0;
+ my $read_from = shift ;
+ my $application = shift ;
+
+ my $app_dir = $read_from || $self->model_dir->parent;
+ my %apps;
+ $logger->info("reading app files from ".$app_dir);
+ foreach my $dir ( $app_dir->children(qr/\.d$/) ) {
+
+ $logger->info("reading app dir ".$dir);
+ foreach my $file ( $dir->children() ) {
+ next if $file =~ m!/README!;
+ next if $file =~ /(~|\.bak|\.orig)$/;
+ next if $application and $file->basename ne $application;
+
+ # bad categories are filtered by the model
+ my %data = ( category => $dir->basename('.d') );
+ $logger->info("reading app file ".$file);
+
+ foreach ($file->lines({ chomp => 1})) {
+ s/^\s+//;
+ s/\s+$//;
+ s/#.*//;
+ my ( $k, $v ) = split /\s*=\s*/;
+ next unless $v;
+ $data{$k} = $v;
+ }
+
+ my $appli = $file->basename;
+ $apps{$appli} = $data{model} ;
+
+ $self->meta_root->load_data(
+ data => { application => { $appli => \%data } },
+ check => $force_load ? 'no' : 'yes'
+ ) ;
+ }
+ }
+
+ return \%apps;
+}
+
+sub read_all {
+ my $self = shift ;
+ my %args = @_ ;
+
+ my $force_load = delete $args{force_load} || 0 ;
+ my $read_from ;
+ my $model_dir ;
+ if ($args{read_from}) {
+ $read_from = path (delete $args{read_from});
+ die "Cannot read from unknown dir ".$read_from unless $read_from->is_dir;
+ $model_dir = $read_from->child('models');
+ die "Cannot read from unknown dir ".$model_dir unless $model_dir->is_dir;
+ }
+
+ my $apps = $self-> read_app_files($force_load, $read_from, delete $args{application});
+
+ my $root_model_arg = delete $args{root_model} || '';
+ my $model = $apps->{$root_model_arg} || $root_model_arg ;
+ my $legacy = delete $args{legacy} ;
+
+ croak "read_all: unexpected parameters ",join(' ', keys %args) if %args ;
+
+ my $dir = $self->model_dir;
+ $dir->mkpath ;
+
+ my $root_model_file = $model ;
+ $root_model_file =~ s!::!/!g ;
+ my $read_dir = $model_dir || $dir;
+ $logger->info("searching model files in ".$read_dir);
+
+ my @files ;
+ my $wanted = sub {
+ push @files, $_ if ( $_->is_file and /\.pl$/
+ and m!$read_dir/$root_model_file\b!
+ and not m!\.d/!
+ ) ;
+ } ;
+ $read_dir->visit($wanted, { recurse => 1} ) ;
+
+ my $i = $self->meta_instance ;
+
+ my %read_models ;
+ my %pod_data ;
+ my %class_file_map ;
+
+ my @all_models;
+ for my $file (@files) {
+ $logger->info("loading config file $file");
+
+ # now apply some translation to read model
+ # - translate legacy warp parameters
+ # - expand elements name
+ my $tmp_model = Config::Model -> new( skip_include => 1, legacy => $legacy ) ;
+ # @models order is important to write configuration class back in the same
+ # order as the declaration
+ my @models = $tmp_model -> load ( 'Tmp' , $file ) ;
+ push @all_models, @models;
+
+ my $rel_file = $file ;
+ $rel_file =~ s/^$read_dir\/?//;
+ die "wrong reg_exp" if $file eq $rel_file ;
+ $class_file_map{$rel_file} = \@models ;
+
+ # - move experience, description and level status into parameter info.
+ foreach my $model_name (@models) {
+ # no need to dclone model as Config::Model object is temporary
+ my $raw_model = $tmp_model -> get_raw_model( $model_name ) ;
+ my $new_model = $tmp_model -> get_model( $model_name ) ;
+
+ # track read class to identify later classes added by user
+ $self->add_tracked_class($model_name);
+
+ # some modifications may be done to cope with older model styles. If a modif
+ # was done, mark the class as changed so it will be saved later
+ $self->add_modified_class($model_name) unless Compare($raw_model, $new_model) ;
+
+ foreach my $item (qw/description summary level experience status/) {
+ foreach my $elt_name (keys %{$new_model->{element}}) {
+ my $moved_data = delete $new_model->{$item}{$elt_name} ;
+ next unless defined $moved_data ;
+ $new_model->{element}{$elt_name}{$item} = $moved_data ;
+ }
+ delete $new_model->{$item} ;
+ }
+
+ # Since accept specs and elements are stored in a ordered hash,
+ # load_data expects a array ref instead of a hash ref.
+ # Build this array ref taking the order into
+ # account
+ foreach my $what (qw/element accept/) {
+ my $list = delete $new_model -> {$what.'_list'} ;
+ my $h = delete $new_model -> {$what} ;
+ $new_model -> {$what} = [] ;
+ map {
+ push @{$new_model->{$what}}, $_, $h->{$_}
+ } @$list ;
+ }
+
+ # remove hash key with undefined values
+ map { delete $new_model->{$_} unless defined $new_model->{$_}
+ and $new_model->{$_} ne ''
+ } keys %$new_model ;
+ $read_models{$model_name} = $new_model ;
+ }
+
+ }
+
+ $self->{root_model} = $model || (sort @all_models)[0];
+
+ # Create all classes listed in %read_models to avoid problems with
+ # include statement while calling load_data
+ my $root_obj = $self->meta_root ;
+ my $class_element = $root_obj->fetch_element('class') ;
+ map { $class_element->fetch_with_id($_) } sort keys %read_models ;
+
+ #require Tk::ObjScanner; Tk::ObjScanner::scan_object(\%read_models) ;
+
+ $logger->info("loading all extracted data in Config::Model::Itself");
+ # load with a array ref to avoid warnings about missing order
+ $root_obj->load_data(
+ data => {class => [ %read_models ] },
+ check => $force_load ? 'no' : 'yes'
+ ) ;
+
+ # load annotations and comment header
+ for my $file (@files) {
+ $logger->info("loading annotations from file $file");
+ my $fh = IO::File->new($file) || die "Can't open $file: $!" ;
+ my @lines = $fh->getlines ;
+ $fh->close;
+ $root_obj->load_pod_annotation(join('', at lines)) ;
+
+ my @headers ;
+ foreach my $l (@lines) {
+ if ($l =~ /^\s*#/ or $l =~ /^\s*$/){
+ push @headers, $l
+ }
+ else {
+ last;
+ }
+ }
+ my $rel_file = $file ;
+ $rel_file =~ s/^$dir\/?//;
+ $self->{header}{$rel_file} = \@headers;
+ }
+
+ return $self->{map} = \%class_file_map ;
+}
+
+# internal
+sub get_perl_data_model{
+ my $self = shift ;
+ my %args = @_ ;
+ my $root_obj = $self->{meta_root};
+ my $class_name = $args{class_name}
+ || croak __PACKAGE__," read: undefined class name";
+
+ my $class_element = $root_obj->fetch_element('class') ;
+
+ # skip if class was deleted during edition
+ return unless $class_element->defined($class_name) ;
+
+ my $class_elt = $class_element -> fetch_with_id($class_name) ;
+
+ my $model = $class_elt->dump_as_data ;
+
+ # now apply some translation to read model
+ # - Do NOT translate legacy warp parameters
+ # - Do not compact elements name
+
+ # don't forget to add name
+ $model->{name} = $class_name if keys %$model;
+
+ return $model ;
+}
+
+sub write_app_files {
+ my $self = shift;
+
+ my $app_dir = $self->cm_lib_dir;
+ my $app_obj = $self->meta_root->fetch_element('application');
+
+ foreach my $app_name ( $app_obj->fetch_all_indexes ) {
+ my $app = $app_obj->fetch_with_id($app_name);
+ my $cat_dir_name = $app->fetch_element_value( name =>'category' ).'.d';
+ $app_dir->child($cat_dir_name)->mkpath();
+ my $app_file = $app_dir->child($cat_dir_name)->child($app->index_value) ;
+
+ my @lines ;
+ foreach my $name ( $app->children ) {
+ next if $name eq 'category'; # saved as directory above
+
+ my $v = $app->fetch_element_value($name); # need to spit out 0 ?
+ next unless defined $v;
+ push @lines, "$name = $v\n";
+
+ }
+ $logger->info("writing file ".$app_file);
+ $app_file->spew(@lines);
+ }
+
+}
+
+sub write_all {
+ my $self = shift ;
+ my %args = @_ ;
+ my $root_obj = $self->meta_root ;
+ my $dir = $self->model_dir ;
+
+ croak "write_all: unexpected parameters ",join(' ', keys %args) if %args ;
+
+ $self->write_app_files;
+
+ my $map = $self->{map} ;
+
+ $dir->mkpath;
+
+ # get list of all classes loaded by the editor
+ my %loaded_classes
+ = map { ($_ => 1); }
+ $root_obj->fetch_element('class')->fetch_all_indexes ;
+
+ # remove classes that are listed in map
+ foreach my $file (keys %$map) {
+ foreach my $class_name (@{$map->{$file}}) {
+ delete $loaded_classes{$class_name} ;
+ }
+ }
+
+ # add remaining classes in map
+ my %new_map = map {
+ my $f = $_;
+ $f =~ s!::!/!g;
+ ("$f.pl" => [ $_ ]) ;
+ } keys %loaded_classes ;
+
+ my %map_to_write = (%$map,%new_map) ;
+
+ foreach my $file (keys %map_to_write) {
+ $logger->info("checking model file $file");
+
+ my @data ;
+ my @notes ;
+ my $file_needs_write = 0;
+
+ # check if any a class of a file was modified
+ foreach my $class_name (@{$map_to_write{$file}}) {
+ $file_needs_write++ if $self->class_needs_write($class_name);
+ $logger->info("file $file class $class_name needs write ",$file_needs_write);
+ }
+
+ next unless $file_needs_write ;
+
+ foreach my $class_name (@{$map_to_write{$file}}) {
+ $logger->info("writing class $class_name");
+ my $model
+ = $self-> get_perl_data_model(class_name => $class_name) ;
+ push @data, $model if defined $model and keys %$model;
+
+ my $node = $self->{meta_root}->grab("class:".$class_name) ;
+ push @notes, $node->dump_annotations_as_pod ;
+ # remove class name from above list
+ delete $loaded_classes{$class_name} ;
+ }
+
+ next unless @data ; # don't write empty model
+
+ write_model_file ($dir->child($file), $self->{header}{$file}, \@notes, \@data);
+ }
+
+ $self->meta_instance->clear_changes ;
+}
+
+sub write_model_plugin {
+ my $self = shift ;
+ my %args = @_ ;
+ my $plugin_dir = delete $args{plugin_dir}
+ || croak __PACKAGE__," write_model_plugin: undefined plugin_dir";
+ my $plugin_name = delete $args{plugin_name}
+ || croak __PACKAGE__," write_model_plugin: undefined plugin_name";
+ croak "write_model_plugin: unexpected parameters ",join(' ', keys %args) if %args ;
+
+ my $model = $self->meta_root->dump_as_data ;
+ # print (Dumper( $model)) ;
+
+ my @raw_data = @{$model->{class} || []} ;
+ while (@raw_data) {
+ my ( $class , $data ) = splice @raw_data,0,2 ;
+ $data ->{name} = $class ;
+
+ # does not distinguish between notes from underlying model or snipper notes ...
+ my @notes = $self->meta_root->grab("class:$class")->dump_annotations_as_pod ;
+ my $plugin_file = $class.'.pl';
+ $plugin_file =~ s!::!/!g;
+ write_model_file ("$plugin_dir/$plugin_name/$plugin_file", [], \@notes, [ $data ]);
+ }
+
+ $self->meta_instance->clear_changes ;
+}
+
+sub read_model_plugin {
+ my $self = shift ;
+ my %args = @_ ;
+ my $plugin_dir = delete $args{plugin_dir}
+ || croak __PACKAGE__," write_model_plugin: undefined plugin_dir";
+ my $plugin_name = delete $args{plugin_name}
+ || croak __PACKAGE__," read_model_plugin: undefined plugin_name";
+
+ croak "read_model_plugin: unexpected parameters ",join(' ', keys %args) if %args ;
+
+ my @files ;
+ my $wanted = sub {
+ my $n = $File::Find::name ;
+ push @files, $n if (-f $_ and not /~$/
+ and $n !~ /CVS/
+ and $n !~ m!.(svn|orig|pod)$!
+ and $n =~ m!\.d/$plugin_name!
+ ) ;
+ } ;
+ find ($wanted, $plugin_dir ) ;
+
+ my $class_element = $self->meta_root->fetch_element('class') ;
+
+ foreach my $load_file (@files) {
+ $logger->info("trying to read plugin $load_file");
+
+ $load_file = "./$load_file" if $load_file !~ m!^/! and -e $load_file;
+
+ my $plugin = do $load_file ;
+
+ unless ($plugin) {
+ if ($@) {die "couldn't parse $load_file: $@"; }
+ elsif (not defined $plugin) {die "couldn't do $load_file: $!"}
+ else { die "couldn't run $load_file" ;}
+ }
+
+ # there should be only only class in each plugin file
+ foreach my $model (@$plugin) {
+ my $class_name = delete $model->{name} ;
+ # load with a array ref to avoid warnings about missing order
+ $class_element->fetch_with_id($class_name)->load_data( $model ) ;
+ }
+
+ # load annotations
+ $logger->info("loading annotations from plugin file $load_file");
+ my $fh = IO::File->new($load_file) || die "Can't open $load_file: $!" ;
+ my @lines = $fh->getlines ;
+ $fh->close;
+ $self->meta_root->load_pod_annotation(join('', at lines)) ;
+ }
+}
+
+
+#
+# New subroutine "write_model_file" extracted - Mon Mar 12 13:38:29 2012.
+#
+sub write_model_file {
+ my $wr_file = shift;
+ my $comments = shift ;
+ my $notes = shift;
+ my $data = shift;
+
+ my $wr_dir = dirname($wr_file);
+ unless ( -d $wr_dir ) {
+ mkpath( $wr_dir, 0, 0755 ) || die "Can't mkpath $wr_dir:$!";
+ }
+
+ my $wr = IO::File->new( $wr_file, '>' )
+ || croak "Cannot open file $wr_file:$!" ;
+ $logger->info("in $wr_file");
+
+ my $dumper = Data::Dumper->new( [ \@$data ] );
+ $dumper->Indent(1); # avoid too deep indentation
+ $dumper->Terse(1); # allow unnamed variables in dump
+ $dumper->Sortkeys(1); # sort keys in hash
+
+ my $dump = $dumper->Dump;
+
+ # munge pod text embedded in values to avoid spurious pod formatting
+ $dump =~ s/\n=/\n'.'=/g;
+
+ $wr->print(@$comments) ;
+ $wr->print( $dump, ";\n\n" );
+
+ $wr->print( join( "\n", @$notes ) );
+
+ $wr->close;
+
+}
+
+
+
+sub list_class_element {
+ my $self = shift ;
+ my $pad = shift || '' ;
+
+ my $res = '';
+ my $meta_class = $self->{meta_root}->fetch_element('class') ;
+ foreach my $class_name ($meta_class->fetch_all_indexes ) {
+ $res .= $self->list_one_class_element($class_name) ;
+ }
+ return $res ;
+}
+
+sub list_one_class_element {
+ my $self = shift ;
+ my $class_name = shift || return '' ;
+ my $pad = shift || '' ;
+
+ my $res = $pad."Class: $class_name\n";
+ my $meta_class = $self->{meta_root}->fetch_element('class')
+ -> fetch_with_id($class_name) ;
+
+ my @elts = $meta_class->fetch_element('element')->fetch_all_indexes ;
+
+ my @include = $meta_class->fetch_element('include')->fetch_all_values ;
+ my $inc_after = $meta_class->grab_value('include_after') ;
+
+ if (@include and not defined $inc_after) {
+ map { $res .= $self->list_one_class_element($_,$pad.' ') ;} @include ;
+ }
+
+ return $res unless @elts ;
+
+ foreach my $elt_name ( @elts) {
+ my $type = $meta_class->grab_value("element:$elt_name type") ;
+
+ $res .= $pad." - $elt_name ($type)\n";
+ if (@include and defined $inc_after and $inc_after eq $elt_name) {
+ map { $res .=$self->list_one_class_element($_,$pad.' ') ;} @include ;
+ }
+ }
+ return $res ;
+}
+
+
+sub get_dot_diagram {
+ my $self = shift ;
+ my $dot = "digraph model {\n" ;
+
+ my $meta_class = $self->{meta_root}->fetch_element('class') ;
+ foreach my $class_name ($meta_class->fetch_all_indexes ) {
+ my $d_class = $class_name ;
+ $d_class =~ s/::/__/g;
+
+ my $elt_list = '';
+ my $use = '';
+
+ my $class_obj = $self->{meta_root}->grab(qq!class:"$class_name"!);
+ my @elts = $class_obj ->grab(qq!element!) ->fetch_all_indexes ;
+ foreach my $elt_name ( @elts ) {
+ my $of = '';
+ my $elt_obj = $class_obj->grab(qq!element:"$elt_name"!) ;
+ my $type = $elt_obj->grab_value("type") ;
+ if ($type =~ /^list|hash$/) {
+ my $cargo = $elt_obj->grab("cargo");
+ my $ct = $cargo->grab_value("type") ;
+ $of = " of $ct" ;
+ $use .= $self->scan_used_class($d_class,$elt_name,$cargo);
+ }
+ else {
+ $use .= $self->scan_used_class($d_class,$elt_name,$elt_obj);
+ }
+ $elt_list .= "- $elt_name ($type$of)\\n";
+ }
+
+ $dot .= $d_class
+ . qq! [shape=box label="$class_name\\n$elt_list"];\n!
+ . $use . "\n";
+
+ $dot .= $self->scan_includes($class_name, $class_obj) ;
+ }
+
+ $dot .="}\n";
+
+ return $dot ;
+}
+
+sub scan_includes {
+ my ($self,$class_name, $class_obj) = @_ ;
+ my $d_class = $class_name ;
+ $d_class =~ s/::/__/g;
+
+ my @includes = $class_obj->grab('include')->fetch_all_values ;
+ my $dot = '';
+ foreach my $c (@includes) {
+ say "$class_name includes $c";
+ my $t = $c;
+ $t =~ s/::/__/g;
+ $dot.= qq!$d_class -> $t ;\n!;
+ }
+ return $dot;
+}
+
+sub scan_used_class {
+ my ($self,$d_class,$elt_name, $elt_obj) = @_ ;
+
+ # define leaf call back
+ my $disp_leaf = sub {
+ my ($scanner, $data_ref, $node,$element_name,$index, $leaf_object) = @_ ;
+ return unless $element_name eq 'config_class_name';
+ my $v = $leaf_object->fetch;
+ return unless $v;
+ $v =~ s/::/__/g;
+ $$data_ref .= qq!$d_class -> $v !
+ . qq![ style=dashed, label="$elt_name" ];\n!;
+ } ;
+
+ # simple scanner, (print all values)
+ my $scan = Config::Model::ObjTreeScanner-> new (
+ leaf_cb => $disp_leaf, # only mandatory parameter
+ ) ;
+
+ my $result = '' ;
+ $scan->scan_node(\$result, $elt_obj) ;
+ return $result ;
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
+
+# ABSTRACT: Model editor for Config::Model
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Config::Model::Itself - Model editor for Config::Model
+
+=head1 VERSION
+
+version 2.007
+
+=head1 SYNOPSIS
+
+ # Itself constructor returns an object to read or write the data
+ # structure containing the model to be edited
+ my $meta_model = Config::Model::Itself -> new( ) ;
+
+ # now load the model to be edited
+ $meta_model -> read_all( ) ;
+
+ # For Curses UI prepare a call-back to write model
+ my $wr_back = sub { $meta_model->write_all(); }
+
+ # create Curses user interface
+ my $dialog = Config::Model::CursesUI-> new (
+ store => $wr_back,
+ ) ;
+
+ # start Curses dialog to edit the mode
+ $dialog->start( $meta_model->config_root ) ;
+
+ # that's it. When user quits curses interface, Curses will call
+ # $wr_back sub ref to write the modified model.
+
+=head1 DESCRIPTION
+
+Config::Itself module and its model files provide a model of Config:Model
+(hence the Itself name).
+
+Let's step back a little to explain. Any configuration data is, in
+essence, structured data. A
+configuration model is a way to describe the structure and relation of
+all items of a configuration data set.
+
+This configuration model is also expressed as structured data. This
+structure data follows a set of rules which are
+described for humans in L<Config::Model>.
+
+The structure and rules documented in L<Config::Model> are also
+expressed in a model in the files provided with
+C<Config::Model::Itself>.
+
+Hence the possibity to verify, modify configuration data provided by
+L<Config::Model> can also be applied on configuration models. Using the
+same user interface.
+
+From a Perl point of view, Config::Model::Itself provides a class
+dedicated to read and write a set of model files.
+
+=head1 Constructor
+
+=head2 new ( [ cm_lib_dir => ... ] )
+
+Creates a new read/write handler. If no model_object is passed, the required
+objects are created. C<cm_lib_dir> specifies where are the model files (defaults to
+C<./lib/Config/Model>.
+
+C<cm_lib_dir> is either a C<Path::Tiny> object or a string.
+
+By default, this constructor will create all necessary
+C<Config::Model*> objects. If needed, you can pass already created
+object with options C<config_model> (L<Config::Model> object),
+C<meta_instance> (L<Config::Model::Instance> object) or C<meta_root>
+(L<Config::Model::Node> object).
+
+=head2 Methods
+
+=head1 read_all ( [ root_model => ... ], [ force_load => 1 ] )
+
+Load all the model files contained in C<model_dir> and all its
+subdirectories. C<root_model> is used to filter the classes read.
+
+Use C<force_load> if you are trying to load a model containing errors.
+
+C<read_all> returns a hash ref containing ( class_name => file_name , ...)
+
+=head2 write_all
+
+Will write back configuration model in the specified directory. The
+structure of the read directory is respected.
+
+=head2 write_model_plugin( plugin_dir => foo, plugin_name => bar )
+
+Write plugin models in the passed C<plugin_dir> directory. The written file is path is
+made of plugin name and class names. E.g. a plugin named C<bar> for class
+C<Foo::Bar> is written in C<bar/Foo/Bar.pl> file. This file is to be used
+by L<augment_config_class|Config::Model/"augment_config_class (name => '...', class_data )">
+
+=head2 read_model_plugin( plugin_dir => foo, plugin_name => bar.pl )
+
+This method searched recursively C<$plugin_dir/$plugin_name> and load
+all C<*.pl> files found there.
+
+=head2 list_class_element
+
+Returns a string listing all the class and elements. Useful for
+debugging your configuration model.
+
+=head2 get_dot_diagram
+
+Returns a graphviz dot file that represents the structure of the
+configuration model:
+
+=over
+
+=item *
+
+C<include> relations are represented by solid lines
+
+=item *
+
+Class usage (i.e. C<config_class_name> parameter) is represented by
+dashed lines. The name of the element is attached to the dashed line.
+
+=back
+
+=head1 BUGS
+
+Test menu entries are created from the content of C<application> model
+parameter. Unfortunately, there's no way to build the menu
+dynamically. So user cme must be restarted to change the menu if the
+application list is changed.
+
+=head1 SEE ALSO
+
+L<Config::Model>, L<Config::Model::Node>, L<Path::Tiny>
+
+=head1 AUTHOR
+
+Dominique Dumont
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is Copyright (c) 2007-2017 by Dominique Dumont.
+
+This is free software, licensed under:
+
+ The GNU Lesser General Public License, Version 2.1, February 1999
+
+=for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
+
+=head1 SUPPORT
+
+=head2 Websites
+
+The following websites have more information about this module, and may be of help to you. As always,
+in addition to those websites please use your favorite search engine to discover more resources.
+
+=over 4
+
+=item *
+
+Search CPAN
+
+The default CPAN search engine, useful to view POD in HTML format.
+
+L<http://search.cpan.org/dist/Config-Model-Itself>
+
+=item *
+
+AnnoCPAN
+
+The AnnoCPAN is a website that allows community annotations of Perl module documentation.
+
+L<http://annocpan.org/dist/Config-Model-Itself>
+
+=item *
+
+CPAN Ratings
+
+The CPAN Ratings is a website that allows community ratings and reviews of Perl modules.
+
+L<http://cpanratings.perl.org/d/Config-Model-Itself>
+
+=item *
+
+CPANTS
+
+The CPANTS is a website that analyzes the Kwalitee ( code metrics ) of a distribution.
+
+L<http://cpants.cpanauthors.org/dist/Config-Model-Itself>
+
+=item *
+
+CPAN Testers
+
+The CPAN Testers is a network of smokers who run automated tests on uploaded CPAN distributions.
+
+L<http://www.cpantesters.org/distro/C/Config-Model-Itself>
+
+=item *
+
+CPAN Testers Matrix
+
+The CPAN Testers Matrix is a website that provides a visual overview of the test results for a distribution on various Perls/platforms.
+
+L<http://matrix.cpantesters.org/?dist=Config-Model-Itself>
+
+=item *
+
+CPAN Testers Dependencies
+
+The CPAN Testers Dependencies is a website that shows a chart of the test results of all dependencies for a distribution.
+
+L<http://deps.cpantesters.org/?module=Config::Model::Itself>
+
+=back
+
+=head2 Bugs / Feature Requests
+
+Please report any bugs or feature requests by email to C<ddumont at cpan.org>, or through
+the web interface at L<https://github.com/dod38fr/config-model-itself/issues>. You will be automatically notified of any
+progress on the request by the system.
+
+=head2 Source Code
+
+The code is open to the world, and available for you to hack on. Please feel free to browse it and play
+with it, or whatever. If you want to contribute patches, please send me a diff or prod me to pull
+from your repository :)
+
+L<http://github.com/dod38fr/config-model-itself>
+
+ git clone git://github.com/dod38fr/config-model-itself.git
+
+=cut
diff --git a/lib/Config/Model/Itself/BackendDetector.pm b/lib/Config/Model/Itself/BackendDetector.pm
new file mode 100644
index 0000000..57db72a
--- /dev/null
+++ b/lib/Config/Model/Itself/BackendDetector.pm
@@ -0,0 +1,168 @@
+#
+# This file is part of Config-Model-Itself
+#
+# This software is Copyright (c) 2007-2017 by Dominique Dumont.
+#
+# This is free software, licensed under:
+#
+# The GNU Lesser General Public License, Version 2.1, February 1999
+#
+package Config::Model::Itself::BackendDetector ;
+$Config::Model::Itself::BackendDetector::VERSION = '2.007';
+# since this package is mostly targeted for dev environments
+# let the detector detect models under development
+use lib 'lib';
+
+use Pod::POM ;
+use File::Find ;
+
+use base qw/Config::Model::Value/ ;
+
+use strict ;
+use warnings ;
+
+sub setup_enum_choice {
+ my $self = shift ;
+
+ # using a hash to make sure that a backend is not listed twice. This may
+ # happen in development environment where a backend in found in /usr/lib
+ # and in ./lib (or ./blib)
+ my %choices = map { ($_ => 1);} ref $_[0] ? @{$_[0]} : @_ ;
+
+ # find available backends in all @INC directories
+ my $wanted = sub {
+ my $n = $File::Find::name ;
+ if (-f $_ and $n =~ s/\.pm$// and $n !~ /Any$/) {
+ $n =~ s!.*Backend/!! ;
+ $n =~ s!/!::!g ;
+ $choices{$n} = 1 ;
+ }
+ } ;
+
+ foreach my $inc (@INC) {
+ my $path = "$inc/Config/Model/Backend" ;
+ find ($wanted, $path ) if -d $path;
+ }
+
+ $self->SUPER::setup_enum_choice(sort keys %choices) ;
+}
+
+sub set_help {
+ my ($self,$args) = @_ ;
+
+ my $help = delete $args->{help} || {} ;
+
+ my $path = $INC{"Config/Model.pm"} ;
+ $path =~ s!\.pm!/Backend! ;
+
+ my $parser = Pod::POM->new();
+
+ my $wanted = sub {
+ my $n = $File::Find::name ;
+
+ return unless (-f $n and $n !~ /Any\.pm$/) ;
+ my $file = $n ;
+ $n =~ s/\.pm$//;
+ $n =~ s!/!::!g ;
+ my $perl_name = $n ;
+ $n =~ s!.*Backend::!! ;
+ $perl_name =~ s!.*Config!Config! ;
+
+ my $pom = $parser->parse_file($file)|| die $parser->error();
+
+ foreach my $head1 ($pom->head1()) {
+ if ($head1->title() eq 'NAME') {
+ my $c = $head1->content();
+ $c =~ s/.*?-\s*//;
+ $c =~ s/\n//g;
+ $help->{$n} = $c . " provided by L<$perl_name>";
+ last;
+ }
+ }
+ };
+
+ find ($wanted, $path ) ;
+
+ $self->{help} = $help;
+}
+
+1;
+
+# ABSTRACT: Detect available read/write backends usable by config models
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Config::Model::Itself::BackendDetector - Detect available read/write backends usable by config models
+
+=head1 VERSION
+
+version 2.007
+
+=head1 SYNOPSIS
+
+ # this class should be referenced in a configuration model and
+ # created only by Config::Model::Node
+
+ my $model = Config::Model->new() ;
+
+ $model ->create_config_class
+ (
+ name => "Test",
+ 'element'
+ => [
+ 'backend' => { type => 'leaf',
+ class => 'Config::Model::Itself::BackendDetector' ,
+ value_type => 'enum',
+ # specify backends built in Config::Model
+ choice => [qw/cds_file perl_file ini_file custom/],
+
+ help => {
+ cds_file => "file ...",
+ ini_file => "Ini file ...",
+ perl_file => "file perl",
+ custom => "Custom format",
+ }
+ }
+ ],
+ );
+
+ my $root = $model->instance(root_class_name => 'Test') -> config_root ;
+
+ my $backend = $root->fetch_element('backend') ;
+
+ my @choices = $backend->get_choice ;
+
+=head1 DESCRIPTION
+
+This class is derived from L<Config::Model::Value>. It is designed to
+be used in a 'enum' value where the choice (the available backends)
+are the backend built in L<Config::Model> and all the plugin backends. The
+plugin backends are all the C<Config::Model::Backend::*> classes.
+
+This module will detect available plugin backend and query their pod
+documentation to provide a contextual help for config-model graphical
+editor.
+
+=head1 SEE ALSO
+
+L<Config::Model>, L<Config::Model::Node>, L<Config::Model::Value>
+
+=head1 AUTHOR
+
+Dominique Dumont
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is Copyright (c) 2007-2017 by Dominique Dumont.
+
+This is free software, licensed under:
+
+ The GNU Lesser General Public License, Version 2.1, February 1999
+
+=cut
diff --git a/lib/Config/Model/Itself/TkEditUI.pm b/lib/Config/Model/Itself/TkEditUI.pm
new file mode 100644
index 0000000..69b4d01
--- /dev/null
+++ b/lib/Config/Model/Itself/TkEditUI.pm
@@ -0,0 +1,144 @@
+#
+# This file is part of Config-Model-Itself
+#
+# This software is Copyright (c) 2007-2017 by Dominique Dumont.
+#
+# This is free software, licensed under:
+#
+# The GNU Lesser General Public License, Version 2.1, February 1999
+#
+# Copyright (c) 2008,2010 Dominique Dumont.
+#
+# This file is part of Config-Model-Itself.
+#
+# Config-Model is free software; you can redistribute it and/or
+# modify it under the terms of the GNU Lesser Public License as
+# published by the Free Software Foundation; either version 2.1 of
+# the License, or (at your option) any later version.
+#
+# Config-Model is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# Lesser Public License for more details.
+#
+# You should have received a copy of the GNU Lesser Public License
+# along with Config-Model; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+
+package Config::Model::Itself::TkEditUI ;
+$Config::Model::Itself::TkEditUI::VERSION = '2.007';
+use strict;
+use warnings ;
+use Carp ;
+use 5.10.0;
+
+use base qw/Config::Model::TkUI/;
+
+Construct Tk::Widget 'ConfigModelEditUI';
+
+sub ClassInit {
+ my ($class, $mw) = @_;
+ # ClassInit is often used to define bindings and/or other
+ # resources shared by all instances, e.g., images.
+
+
+ # cw->Advertise(name=>$widget);
+}
+
+sub Populate {
+ my ($cw, $args) = @_;
+
+ my $cm_lib_dir = (delete $args->{-cm_lib_dir})."/models" ;
+ my $model_name = delete $args->{-model_name} || '';
+ my $root_dir = delete $args->{-root_dir} ; # used to test the edited model
+
+ $args->{'-title'} ||= "cme meta edit $model_name" ;
+
+ $cw->SUPER::Populate($args) ;
+
+ my $model_menu = $cw->{my_menu}->cascade(
+ -label => 'Model',
+ -menuitems => $cw->build_menu() ,
+ ) ;
+
+ $cw->{cm_lib_dir} = $cm_lib_dir ;
+ $cw->{model_name} = $model_name ;
+ $cw->{root_dir} = $root_dir ;
+
+ $cw->show_message("Add a name in Class to create your model") unless $model_name;
+}
+
+sub build_menu {
+ my $cw = shift ;
+
+ # search for config_dir override
+ my $root = $cw->{root};
+ my $items = [];
+ my %app;
+
+ my $found_app = 0;
+ foreach my $app ($root->fetch_element('application')->fetch_all_indexes) {
+ push @$items, [ command => "test $app", '-command' => sub{ $cw->test_model($app) }];
+ $app{$app} = $root->grab_value("application:$app config_dir");
+ }
+
+ push @$items, [ qw/command test -command/, sub{ $cw->test_model }] unless @$items ;
+
+ return $items;
+}
+
+sub test_model {
+ my $cw = shift ;
+ my $app = shift;
+
+ if ( $cw->{root}->instance->needs_save ) {
+ my $answer = $cw->Dialog(
+ -title => "save model before test",
+ -text => "Save model ?",
+ -buttons => [ qw/yes no cancel/, 'show changes' ],
+ -default_button => 'yes',
+ )->Show;
+
+ if ( $answer eq 'yes' ) {
+ $cw->save( sub {$cw->_launch_test($app);});
+ }
+ elsif ( $answer eq 'no' ) {
+ $cw->_launch_test($app);
+ }
+ elsif ( $answer =~ /show/ ) {
+ $cw->show_changes( sub { $cw->test_model } );
+ }
+ }
+ else {
+ $cw->_launch_test($app);
+ }
+}
+sub _launch_test {
+ my $cw = shift ;
+ my $app = shift;
+
+ my $testw = $cw -> {test_widget} ;
+ $testw->destroy if defined $testw and Tk::Exists($testw);
+
+ # need to read test model from where it was written...
+ my $model = Config::Model -> new(model_dir => $cw->{cm_lib_dir}) ;
+
+ # keep a reference on this object, otherwise it will vanish at the end of this block.
+ $cw->{test_model} = $model ;
+
+ my %args = ( root_dir => $cw->{root_dir} );
+
+ $args{root_class_name} = $app ? $cw->{root}->grab_value("application:$app model") : $cw->{model_name};
+ $args{instance_name} = $app ? "test $app" : $cw->{model_name};
+
+ if ($app) {
+ $args{application} = $app;
+ $args{config_dir} = $cw->{root}->grab_value("application:$app config_dir");
+ }
+
+ my $root = $model->instance ( %args )-> config_root ;
+
+ $cw -> {test_widget} = $cw->ConfigModelUI (-root => $root, -quit => 'soft') ;
+}
+
+1;
diff --git a/lib/Config/Model/Tester.pm b/lib/Config/Model/Tester.pm
deleted file mode 100644
index c356e35..0000000
--- a/lib/Config/Model/Tester.pm
+++ /dev/null
@@ -1,1248 +0,0 @@
-#
-# This file is part of Config-Model-Tester
-#
-# This software is Copyright (c) 2013-2017 by Dominique Dumont.
-#
-# This is free software, licensed under:
-#
-# The GNU Lesser General Public License, Version 2.1, February 1999
-#
-package Config::Model::Tester;
-# ABSTRACT: Test framework for Config::Model
-$Config::Model::Tester::VERSION = '2.059';
-use warnings;
-use strict;
-use locale;
-use utf8;
-use 5.10.1;
-
-use Test::More;
-use Log::Log4perl 1.11 qw(:easy :levels);
-use Path::Tiny;
-use File::Copy::Recursive qw(fcopy rcopy dircopy);
-
-use Test::Warn;
-use Test::Exception;
-use Test::File::Contents ;
-use Test::Differences;
-use Test::Memory::Cycle ;
-
-# use eval so this module does not have a "hard" dependency on Config::Model
-# This way, Config::Model can build-depend on Config::Model::Tester without
-# creating a build dependency loop.
-eval {
- require Config::Model;
- require Config::Model::Lister;
- require Config::Model::Value;
- require Config::Model::BackendMgr;
-} ;
-
-use vars qw/$model $conf_file_name $conf_dir $model_to_test $home_for_test @tests $skip @ISA @EXPORT/;
-
-require Exporter;
- at ISA = qw(Exporter);
- at EXPORT = qw(run_tests);
-
-$File::Copy::Recursive::DirPerms = 0755;
-
-sub setup_test {
- my ( $app_to_test, $t_name, $wr_root, $trace, $t_data ) = @_;
-
- # cleanup before tests
- $wr_root->remove_tree();
- $wr_root->mkpath( { mode => 0755 } );
-
- $conf_dir =~ s!~/!$home_for_test/! if $conf_dir and $home_for_test;
-
- my $wr_dir = $wr_root->child('test-' . $t_name);
- my $wr_dir2 = $wr_root->child('test-' . $t_name.'-w');
- my $conf_file ;
- $conf_file = $wr_dir->child($conf_dir,$conf_file_name)
- if $conf_dir and $conf_file_name;
-
- my $ex_dir = path('t')->child('model_tests.d', "$app_to_test-examples");
- my $ex_data = $ex_dir->child($t_data->{data_from} // $t_name);
-
- my @file_list;
-
- if (my $setup = $t_data->{setup}) {
- foreach my $file (keys %$setup) {
- my $map = $setup->{$file} ;
- my $destination_str
- = ref ($map) eq 'HASH' ? $map->{$^O} // $map->{default}
- : $map;
- if (not defined $destination_str) {
- die "$app_to_test $t_name setup error: cannot find destination for test file $file" ;
- }
- $destination_str =~ s!~/!$home_for_test/! if $home_for_test;
- my $destination = $wr_dir->child($destination_str) ;
- $destination->parent->mkpath( { mode => 0755 }) ;
- my $data_file = $ex_data->child($file);
- die "cannot find $data_file" unless $data_file->exists;
- my $data = $data_file->slurp() ;
- $destination->spew( $data );
- @file_list = list_test_files ($wr_dir);
- }
- }
- elsif ( $ex_data->is_dir ) {
- # copy whole dir
- my $destination_dir = $conf_dir ? $wr_dir->child($conf_dir) : $wr_dir ;
- $destination_dir->mkpath( { mode => 0755 });
- say "dircopy ". $ex_data->stringify . '->'. $destination_dir->stringify
- if $trace ;
- dircopy( $ex_data->stringify, $destination_dir->stringify )
- || die "dircopy $ex_data -> $destination_dir failed:$!";
- @file_list = list_test_files ($destination_dir);
- }
- elsif ( $ex_data->exists ) {
- # either one if true if $conf_file is undef
- die "test data is missing \$conf_dir" unless defined $conf_dir;
- die "test data is missing \$conf_file" unless defined $conf_file;
-
- # just copy file
- say "file copy ". $ex_data->stringify . '->'. $conf_file->stringify
- if $trace ;
- fcopy( $ex_data->stringify, $conf_file->stringify )
- || die "copy $ex_data -> $conf_file failed:$!";
- }
- else {
- note ('starting test without original config data, i.e. from scratch');
- }
- ok( 1, "Copied $app_to_test example $t_name" );
-
- return ( $wr_dir, $wr_dir2, $conf_file, $ex_data, @file_list );
-}
-
-#
-# New subroutine "list_test_files" extracted - Thu Nov 17 17:27:20 2011.
-#
-sub list_test_files {
- my $debian_dir = shift;
- my @file_list ;
-
- my $iter = $debian_dir->iterator({ recurse => 1 });
- my $debian_str = $debian_dir->stringify;
-
- while ( my $child = $iter->() ) {
- next if $child->is_dir ;
-
- push @file_list, '/' . $child->relative($debian_str)->stringify;
- #push @file_list, '/'.join('/', at l) ; # build a unix-like path even on windows
- };
-
- return sort @file_list;
-}
-
-sub write_config_file {
- my ($conf_dir,$wr_dir,$t) = @_;
-
- if ($t->{config_file}) {
- my $file = $conf_dir ? "$conf_dir/" : '';
- $file .= $t->{config_file} ;
- $wr_dir->child($file)->parent->mkpath({mode => 0755} ) ;
- }
-}
-
-sub check_load_warnings {
- my ($root,$t) = @_ ;
-
- if ( ($t->{no_warnings} or exists $t->{load_warnings}) and not defined $t->{load_warnings}) {
- local $Config::Model::Value::nowarning = 1;
- $root->init;
- ok( 1,"Read configuration and created instance with init() method without warning check" );
- }
- else {
- warnings_like { $root->init; } $t->{load_warnings},
- "Read configuration and created instance with init() method with warning check ";
- }
-}
-
-sub run_update {
- my ($inst, $dir, $t) = @_;
- my %args = %{$t->{update}};
-
- my $ret = delete $args{returns};
-
- local $Config::Model::Value::nowarning = $args{no_warnings} || $t->{no_warnings} || 0;
-
- note("updating config with ". join(' ',%args));
- my $res = $inst->update( from_dir => $dir, %args ) ;
- if (defined $ret) {
- is($res,$ret,"updated configuration, got expected return value");
- }
- else {
- ok(1,"updated configuration");
- }
-}
-
-sub load_instructions {
- my ($root,$steps,$trace) = @_ ;
-
- print "Loading $steps\n" if $trace ;
- $root->load( $steps );
- ok( 1, "load called" );
-}
-
-sub apply_fix {
- my $inst = shift;
- local $Config::Model::Value::nowarning = 1;
- $inst->apply_fixes;
- ok( 1, "apply_fixes called" );
-}
-
-sub dump_tree {
- my ($app_to_test, $root, $mode, $no_warnings, $t, $trace) = @_;
-
- print "dumping tree ...\n" if $trace;
- my $dump = '';
- my $risky = sub {
- $dump = $root->dump_tree( mode => $mode );
- };
-
- if ( defined $t->{dump_errors} ) {
- my $nb = 0;
- my @tf = @{ $t->{dump_errors} };
- while (@tf) {
- my $qr = shift @tf;
- throws_ok { &$risky } $qr, "Failed dump $nb of $app_to_test config tree";
- my $fix = shift @tf;
- $root->load($fix);
- ok( 1, "Fixed error nb " . $nb++ );
- }
- }
-
- if ( ($no_warnings or (exists $t->{dump_warnings}) and not defined $t->{dump_warnings}) ) {
- local $Config::Model::Value::nowarning = 1;
- &$risky;
- ok( 1, "Ran dump_tree (no warning check)" );
- }
- else {
- warnings_like { &$risky; } $t->{dump_warnings}, "Ran dump_tree";
- }
- ok( $dump, "Dumped $app_to_test config tree in $mode mode" );
-
- print $dump if $trace;
- return $dump;
-}
-
-sub check_data {
- my ($label, $root, $c, $nw) = @_;
-
- local $Config::Model::Value::nowarning = $nw || 0;
- my @checks = ref $c eq 'ARRAY' ? @$c
- : map { ( $_ => $c->{$_})} sort keys %$c ;
-
- while (@checks) {
- my $path = shift @checks;
- my $v = shift @checks;
- my $check_v = ref $v eq 'HASH' ? delete $v->{value} : $v;
- my @check_args = ref $v eq 'HASH' ? %$v : ();
- my $check_str = @check_args ? " (@check_args)" : '';
- my $obj = $root->grab( step => $path, type => ['leaf','check_list'], @check_args );
- my $got = $obj->fetch(@check_args);
- if (ref $check_v eq 'Regexp') {
- like( $got, $check_v, "$label check '$path' value with regexp$check_str" );
- }
- else {
- is( $got, $check_v, "$label check '$path' value$check_str" );
- }
- }
-}
-
-sub check_annotation {
- my ($root, $t) = @_;
-
- my $annot_check = $t->{verify_annotation};
- foreach my $path (keys %$annot_check) {
- my $note = $annot_check->{$path};
- is( $root->grab($path)->annotation, $note, "check $path annotation" );
- }
-}
-
-sub has_key {
- my ($root, $c, $nw) = @_;
-
- _test_key($root, $c, $nw, 0);
-}
-
-sub has_not_key {
- my ($root, $c, $nw) = @_;
-
- _test_key($root, $c, $nw, 1);
-}
-
-sub _test_key {
- my ($root, $c, $nw, $invert) = @_;
-
- my @checks = ref $c eq 'ARRAY' ? @$c
- : map { ( $_ => $c->{$_})} sort keys %$c ;
-
- while (@checks) {
- my $path = shift @checks;
- my $spec = shift @checks;
- my @key_checks = ref $spec eq 'ARRAY' ? @$spec: ($spec);
-
- my $obj = $root->grab( step => $path, type => 'hash' );
- my @keys = $obj->fetch_all_indexes;
- my $res = 0;
- foreach my $check (@key_checks) {
- my @match ;
- foreach my $k (@keys) {
- if (ref $check eq 'Regexp') {
- push @match, $k if $k =~ $check;
- }
- else {
- push @match, $k if $k eq $check;
- }
- }
- if ($invert) {
- is(scalar @match,0, "check $check matched no key" );
- }
- else {
- ok(scalar @match, "check $check matched with keys @match" );
- }
- }
- }
-}
-
-sub write_data_back {
- my ($app_to_test, $inst, $t) = @_;
- local $Config::Model::Value::nowarning = $t->{no_warnings} || 0;
- $inst->write_back( force => 1 );
- ok( 1, "$app_to_test write back done" );
-}
-
-sub check_file_content {
- my ($wr_dir, $t) = @_;
-
- if (my $fc = $t->{file_contents} || $t->{file_content}) {
- foreach my $f (keys %$fc) {
- my $t = $fc->{$f} ;
- my @tests = ref $t eq 'ARRAY' ? @$t : ($t) ;
- foreach my $subtest (@tests) {
- file_contents_eq_or_diff $wr_dir->child($f)->stringify, $subtest,
- "check that $f contains $subtest";
- }
- }
- }
-
- if (my $fc = $t->{file_contents_like}) {
- foreach my $f (keys %$fc) {
- my $t = $fc->{$f} ;
- my @tests = ref $t eq 'ARRAY' ? @$t : ($t) ;
- foreach my $subtest (@tests) {
- file_contents_like $wr_dir->child($f)->stringify, $subtest,
- "check that $f matches regexp $subtest";
- }
- }
- }
-
- if (my $fc = $t->{file_contents_unlike}) {
- foreach my $f (keys %$fc) {
- my $t = $fc->{$f} ;
- my @tests = ref $t eq 'ARRAY' ? @$t : ($t) ;
- foreach my $subtest (@tests) {
- file_contents_unlike $wr_dir->child($f)->stringify, $subtest,
- "check that $f does not match regexp $subtest";
- }
- }
- }
-}
-
-sub check_added_or_removed_files {
- my ( $conf_dir, $wr_dir, $t, @file_list) = @_;
-
- # copy whole dir
- my $destination_dir
- = $t->{setup} ? $wr_dir
- : $conf_dir ? $wr_dir->child($conf_dir)
- : $wr_dir ;
- my @new_file_list = list_test_files($destination_dir) ;
- $t->{file_check_sub}->( \@file_list ) if defined $t->{file_check_sub};
- eq_or_diff( \@new_file_list, [ sort @file_list ], "check added or removed files" );
-}
-
-sub create_second_instance {
- my ($app_to_test, $t_name, $wr_dir, $wr_dir2,$t, $config_dir_override) = @_;
-
- # create another instance to read the conf file that was just written
- dircopy( $wr_dir->stringify, $wr_dir2->stringify )
- or die "can't copy from $wr_dir to $wr_dir2: $!";
-
- my $i2_test = $model->instance(
- root_class_name => $model_to_test,
- root_dir => $wr_dir2->stringify,
- config_file => $t->{config_file} ,
- instance_name => "$app_to_test-$t_name-w",
- application => $app_to_test,
- check => $t->{load_check2} || 'yes',
- config_dir => $config_dir_override,
- );
-
- ok( $i2_test, "Created instance $app_to_test-test-$t_name-w" );
-
- local $Config::Model::Value::nowarning = $t->{no_warnings} || 0;
- my $i2_root = $i2_test->config_root;
- $i2_root->init;
-
- return $i2_root;
-}
-
-sub run_model_test {
- my ($app_to_test, $app_to_test_conf, $do, $model, $trace, $wr_root) = @_ ;
-
- $skip = 0;
- undef $conf_file_name ;
- undef $conf_dir ;
- undef $home_for_test ;
-
- note("Beginning $app_to_test test ($app_to_test_conf)");
-
- unless ( my $return = do "./$app_to_test_conf" ) {
- warn "couldn't parse $app_to_test_conf: $@" if $@;
- warn "couldn't do $app_to_test_conf: $!" unless defined $return;
- warn "couldn't run $app_to_test_conf" unless $return;
- }
-
- if ($skip) {
- note("Skipped $app_to_test test ($app_to_test_conf)");
- return;
- }
-
- my ($trash, $appli_info, $applications) = Config::Model::Lister::available_models(1);
-
- # even undef, this resets the global variable there
- Config::Model::BackendMgr::_set_test_home($home_for_test) ;
-
- if (not defined $model_to_test) {
- $model_to_test = $applications->{$app_to_test};
- if (not defined $model_to_test) {
- my @k = sort values %$applications;
- my @files = map { $_->{_file} // 'unknown' } values %$appli_info ;
- die "Cannot find model name for $app_to_test in files >@files<. Know dev models are >@k<. ".
- "Check your test name (the file ending with -test-conf.pl) or set the \$model_to_test global variable\n";
- }
- }
-
- my $config_dir_override = $appli_info->{$app_to_test}{config_dir}; # may be undef
-
- my $note ="$app_to_test uses $model_to_test model";
- $note .= " on file $conf_file_name" if defined $conf_file_name;
- note($note);
-
- my $idx = 0;
- foreach my $t (@tests) {
- translate_test_data($t);
- my $t_name = $t->{name} || "t$idx";
- if ( defined $do and $t_name !~ /$do/) {
- $idx++;
- next;
- }
- note("Beginning subtest $app_to_test $t_name");
-
- my ($wr_dir, $wr_dir2, $conf_file, $ex_data, @file_list)
- = setup_test ($app_to_test, $t_name, $wr_root,$trace, $t);
-
- write_config_file($conf_dir,$wr_dir,$t);
-
- my $inst_name = "$app_to_test-" . $t_name;
-
- die "Duplicated test name $t_name for app $app_to_test\n"
- if $model->has_instance ($inst_name);
-
- my $inst = $model->instance(
- root_class_name => $model_to_test,
- root_dir => $wr_dir->stringify,
- instance_name => $inst_name,
- application => $app_to_test,
- config_file => $t->{config_file} ,
- check => $t->{load_check} || 'yes',
- config_dir => $config_dir_override,
- );
-
- my $root = $inst->config_root;
-
- check_load_warnings ($root,$t);
-
- run_update($inst,$wr_dir,$t) if $t->{update};
-
- load_instructions ($root,$t->{load},$trace) if $t->{load} ;
-
- dump_tree ('before fix '.$app_to_test , $root, 'full', $t->{no_warnings}, $t->{check_before_fix}, $trace)
- if $t->{check_before_fix};
-
- apply_fix($inst) if $t->{apply_fix};
-
- dump_tree ($app_to_test, $root, 'full', $t->{no_warnings}, $t->{full_dump}, $trace) ;
-
- my $dump = dump_tree ($app_to_test, $root, 'custom', $t->{no_warnings}, {}, $trace) ;
-
- check_data("first", $root, $t->{check}, $t->{no_warnings}) if $t->{check};
-
- has_key ( $root, $t->{has_key}, $t->{no_warnings}) if $t->{has_key} ;
- has_not_key ( $root, $t->{has_not_key}, $t->{no_warnings}) if $t->{has_not_key} ;
-
- check_annotation($root,$t) if $t->{verify_annotation};
-
- write_data_back ($app_to_test, $inst, $t) ;
-
- check_file_content($wr_dir,$t) ;
-
- check_added_or_removed_files ($conf_dir, $wr_dir, $t, @file_list) if $ex_data->is_dir;
-
- my $i2_root = create_second_instance ($app_to_test, $t_name, $wr_dir, $wr_dir2,$t, $config_dir_override);
-
- load_instructions ($i2_root,$t->{load2},$trace) if $t->{load2} ;
-
- my $p2_dump = dump_tree("second $app_to_test", $i2_root, 'custom', $t->{no_warnings},{}) ;
-
- unified_diff;
- eq_or_diff(
- [ split /\n/,$p2_dump ],
- [ split /\n/,$dump ],
- "compare original $app_to_test custom data with 2nd instance custom data",
- );
-
- ok( -s "$wr_dir2/$conf_dir/$conf_file_name" ,
- "check that original $app_to_test file was not clobbered" )
- if defined $conf_file_name ;
-
- check_data("second", $i2_root, $t->{wr_check}, $t->{no_warnings}) if $t->{wr_check} ;
-
- note("End of subtest $app_to_test $t_name");
-
- $idx++;
- }
- note("End of $app_to_test test");
-
-}
-
-sub translate_test_data {
- my $t = shift;
- map {$t->{full_dump}{$_} = delete $t->{$_} if $t->{$_}; } qw/dump_warnings dump_errors/;
-}
-
-sub create_model_object {
- my $new_model ;
- eval { $new_model = Config::Model->new(); } ;
- if ($@) {
- # necessary to run smoke test (no Config::Model to avoid dependency loop)
- plan skip_all => 'Config::Model is not loaded' ;
- return;
- }
- return $new_model;
-}
-
-sub run_tests {
- my ( $arg, $test_only_app, $do ) = @_;
-
- my $log = 0;
-
- my $trace = ($arg =~ /t/) ? 1 : 0;
- $log = 1 if $arg =~ /l/;
-
- my $log4perl_user_conf_file = ($ENV{HOME} || '') . '/.log4config-model';
-
- if ( $log and -e $log4perl_user_conf_file ) {
- Log::Log4perl::init($log4perl_user_conf_file);
- }
- else {
- Log::Log4perl->easy_init( $log ? $WARN : $ERROR );
- }
-
- 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 = path('wr_root');
-
- my @group_of_tests = grep { /-test-conf.pl$/ } glob("t/model_tests.d/*");
-
- foreach my $app_to_test_conf (@group_of_tests) {
- my ($app_to_test) = ( $app_to_test_conf =~ m!\.d/([\w\-]+)-test-conf! );
- next if ( $test_only_app and $test_only_app ne $app_to_test ) ;
- $model = create_model_object();
- return unless $model;
- run_model_test($app_to_test, $app_to_test_conf, $do, $model, $trace, $wr_root) ;
- }
-
- memory_cycle_ok($model,"test memory cycle") ;
-
- done_testing;
-
-}
-1;
-
-__END__
-
-=pod
-
-=encoding UTF-8
-
-=head1 NAME
-
-Config::Model::Tester - Test framework for Config::Model
-
-=head1 VERSION
-
-version 2.059
-
-=head1 SYNOPSIS
-
- # in t/model_test.t
- use warnings;
- use strict;
-
- use Config::Model::Tester ;
- use ExtUtils::testlib;
-
- my $arg = shift || ''; # typically e t l
- my $test_only_app = shift || ''; # only run one set of test
- my $do = shift ; # select subtests to run with a regexp
-
- run_tests($arg, $test_only_app, $do) ;
-
-=head1 DESCRIPTION
-
-This class provides a way to test configuration models with tests files.
-This class was designed to tests several models and several tests
-cases per model.
-
-A specific layout for test files must be followed.
-
-=head2 Simple test file layout
-
-Each test case is represented by a configuration file (not
-a directory) in the C<*-examples> directory. This configuration file
-will be used by the model to test and is copied as
-C<$confdir/$conf_file_name> using the global variables explained
-below.
-
-In the example below, we have 1 app model to test: C<lcdproc> and 2 tests
-cases. The app name matches the file specified in
-C<lib/Config/Model/*.d> directory. In this case, the app name matches
-C<lib/Config/Model/system.d/lcdproc>
-
- t
- |-- model_test.t
- \-- model_tests.d # do not change directory name
- |-- lcdproc-test-conf.pl # test specification for lcdproc app
- \-- lcdproc-examples
- |-- t0 # subtest t0
- \-- LCDD-0.5.5 # subtest for older LCDproc
-
-Test specification is written in C<lcdproc-test-conf.pl> file (i.e. this
-modules looks for files named like C<< <app-name>-test-conf.pl> >>).
-
-Subtests are specified in files in directory C<lcdproc-examples> (
-i.e. this modules looks for subtests in directory
-C<< <model-name>-examples.pl> >>. C<lcdproc-test-conf.pl> contains
-instructions so that each file will be used as a C</etc/LCDd.conf>
-file during each test case.
-
-C<lcdproc-test-conf.pl> can contain specifications for more test
-cases. Each test case will require a new file in C<lcdproc-examples>
-directory.
-
-See L</Examples> for a link to the actual LCDproc model tests
-
-=head2 Test file layout for multi-file configuration
-
-When a configuration is spread over several files, each test case is
-provided in a sub-directory. This sub-directory is copied in
-C<$conf_dir> (a global variable as explained below)
-
-In the example below, the test specification is written in
-C<dpkg-test-conf.pl>. Dpkg layout requires several files per test case.
-C<dpkg-test-conf.pl> will contain instructions so that each directory
-under C<dpkg-examples> will be used.
-
- t/model_tests.d
- \-- dpkg-test-conf.pl # test specification
- \-- dpkg-examples
- \-- libversion # example subdir, used as subtest name
- \-- debian # directory for one test case
- |-- changelog
- |-- compat
- |-- control
- |-- copyright
- |-- rules
- |-- source
- | \-- format
- \-- watch
-
-See L</Examples> for a link to the (many) Dpkg model tests
-
-=head2 More complex file layout
-
-Each test case is a sub-directory on the C<*-examples> directory and
-contains several files. The destination of the test files may depend
-on the system (e.g. the OS). For instance, system wide C<ssh_config>
-is stored in C</etc/ssh> on Linux, and directly in C</etc> on MacOS.
-
-These files are copied in a test directory using a C<setup> parameter:
-
- setup => {
- test_file_in_example_dir => 'destination'
- }
-
-Let's consider this example of 2 tests cases for ssh:
-
- t/model_tests.d/
- |-- ssh-test-conf.pl
- |-- ssh-examples
- \-- basic
- |-- system_ssh_config
- \-- user_ssh_config
-
-Unfortunately, C<user_ssh_config> is a user file, so you specify where
-the home directory for the tests with another global variable:
-
- $home_for_test = '/home/joe' ;
-
-For Linux only, the C<setup> parameter is:
-
- setup => {
- 'system_ssh_config' => '/etc/ssh/ssh_config',
- 'user_ssh_config' => "~/.ssh/config"
- }
-
-On the other hand, system wide config file is different on MacOS and
-the test file must be copied in the correct location. When the value
-of the C<setup> hash is another hash, the key of this other hash is
-used as to specify the target location for other OS (as returned by
-Perl C<$^O> variable:
-
- setup => {
- 'system_ssh_config' => {
- 'darwin' => '/etc/ssh_config',
- 'default' => '/etc/ssh/ssh_config',
- },
- 'user_ssh_config' => "~/.ssh/config"
- }
-
-See the actual L<Ssh and Sshd model tests|https://github.com/dod38fr/config-model-openssh/tree/master/t/model_tests.d>
-
-=head2 Basic test specification
-
-Each model test is specified in C<< <model>-test-conf.pl >>. This file
-contains a set of global variables. (yes, global variables are often bad ideas
-in programs, but they are handy for tests):
-
- # config file name (used to copy test case into test wr_root directory)
- $conf_file_name = "fstab" ;
- # config dir where to copy the file (optional)
- #$conf_dir = "etc" ;
- # home directory for this test
- $home_for_test = '/home/joe' ;
-
-Here, C<t0> file will be copied in C<wr_root/test-t0/etc/fstab>.
-
- # config model name to test
- $model_to_test = "Fstab" ;
-
- # list of tests. This modules looks for @tests global variable
- @tests = (
- {
- # test name
- name => 't0',
- # add optional specification here for t0 test
- },
- {
- name => 't1',
- # add optional specification here for t1 test
- },
- );
-
- 1; # to keep Perl happy
-
-You can suppress warnings by specifying C<< no_warnings => 1 >>. On
-the other hand, you may also want to check for warnings specified to
-your model. In this case, you should avoid specifying C<no_warnings>
-here and specify warning tests or warning filters as mentioned below.
-
-See actual L<fstab test|https://github.com/dod38fr/config-model/blob/master/t/model_tests.d/fstab-test-conf.pl>.
-
-=head2 Internal tests or backend tests
-
-Some tests will require the creation of a configuration class dedicated
-for test (typically to test corner cases on a backend).
-
-This test class can be created directly in the test specification
-by calling L<create_config_class|Config::Model/create_config_class> on
-C<$model> variable. See for instance the
-L<layer test|https://github.com/dod38fr/config-model/blob/master/t/model_tests.d/layer-test-conf.pl>
-or the
-L<test for shellvar backend|https://github.com/dod38fr/config-model/blob/master/t/model_tests.d/backend-shellvar-test-conf.pl>.
-
-=head2 Test specification with arbitrary file names
-
-In some models like C<Multistrap>, the config file is chosen by the
-user. In this case, the file name must be specified for each tests
-case:
-
- $model_to_test = "Multistrap";
-
- @tests = (
- {
- name => 'arm',
- config_file => '/home/foo/my_arm.conf',
- check => {},
- },
- );
-
-See the actual L<multistrap test|https://github.com/dod38fr/config-model/blob/master/t/model_tests.d/multistrap-test-conf.pl>.
-
-=head2 Re-use test data
-
-When the input data for test is quite complex (several files), it may
-be interested to re-use these data for other tests case. Knowing that
-test name must must unique, you can re-use test data with C<data_from>
-parameter. For instance:
-
- @tests = (
- {
- name => 'some-test',
- # ...
- },
- {
- name => 'some-other-test',
- data_from => 'some-test', # re-use data from test above
- # ...
- },
-
-See
-L<plainfile backend test|https://github.com/dod38fr/config-model/blob/master/t/model_tests.d/backend-plainfile-test-conf.pl>
-for a real life example.
-
-=head2 Test scenario
-
-Each subtest follow a sequence explained below. Each step of this
-sequence may be altered by adding specification in
-C<< <model-to-test>-test-conf.pl >>:
-
-=over
-
-=item *
-
-Setup test in C<< wr_root/<subtest name>/ >>. If your configuration file layout depend
-on the target system, you will have to specify the path using C<setup> parameter.
-See L</"Test file layout depending on system">.
-
-=item *
-
-Create configuration instance, load config data and check its validity. Use
-C<< load_check => 'no' >> if your file is not valid.
-
-=item *
-
-Check for config data warning. You should pass the list of expected warnings.
-E.g.
-
- load_warnings => [ qr/Missing/, (qr/deprecated/) x 3 , ],
-
-Use an empty array_ref to mask load warnings.
-
-=item *
-
-Optionally run L<update|App::Cme::Command::update> command:
-
- update => { in => 'some-test-data.txt', returns => 'foo' , no_warnings => [ 0 | 1 ] }
-
-C<returns> is the expected return value (optional). All other
-arguments are passed to C<update> method. Note that C<< quiet => 1 >>
-may be useful for less verbose test.
-
-=item *
-
-Optionally load configuration data. You should design this config data to
-suppress any error or warning mentioned above. E.g:
-
- load => 'binary:seaview Synopsis="multiplatform interface for sequence alignment"',
-
-See L<Config::Model::Loader> for the syntax of the string accepted by C<load> parameter.
-
-=item *
-
-Optionally, run a check before running apply_fix (if any). This step is useful to check
-warning messages:
-
- check_before_fix => {
- dump_errors => [ ... ] # optional, see below
- dump_warnings => [ ... ] # optional, see below
- }
-
-Use C<dump_errors> if you expect issues:
-
- check_before_fix => {
- dump_errors => [
- # the issues and a way to fix the issue using Config::Model::Node::load
- qr/mandatory/ => 'Files:"*" Copyright:0="(c) foobar"',
- qr/mandatory/ => ' License:FOO text="foo bar" ! Files:"*" License short_name="FOO" '
- ],
- }
-
-Likewise, specify any expected warnings (note the list must contain
-only ref to regular expressions):
-
- check_before_fix => {
- dump_warnings => [ (qr/deprecated/) x 3 ],
- }
-
-You can tolerate any dump warning this way:
-
- check_before_fix => {
- dump_warnings => undef ,
- }
-
-Both C<dump_warnings> and C<dump_errors> can be specified in C<check_before_fix> hash.
-
-=item *
-
-Optionally, call L<apply_fixes|Config::Model::Instance/apply_fixes>:
-
- apply_fix => 1,
-
-=item *
-
-Call L<dump_tree|Config::Model::Node/dump_tree ( ... )> to check the validity of the
-data after optional C<apply_fix>. This step is not optional.
-
-As with C<check_before_fix>, both C<dump_errors> or C<dump_warnings> can be used.
-
-=item *
-
-Run specific content check to verify that configuration data was retrieved
-correctly:
-
- check => {
- 'fs:/proc fs_spec', "proc" ,
- 'fs:/proc fs_file', "/proc" ,
- 'fs:/home fs_file', "/home",
- },
-
-The keys of the hash points to the value to be checked using the
-syntax described in L<Config::Model::AnyThing:/"grab(...)">.
-
-You can run check using different check modes (See L<Config::Model::Value/"fetch( ... )">)
-by passing a hash ref instead of a scalar :
-
- check => {
- 'sections:debian packages:0' , { mode => 'layered', value => 'dpkg-dev' },
- 'sections:base packages:0', { mode => 'layered', value => "gcc-4.2-base' },
- },
-
-The whole hash content (except "value") is passed to L<grab|Config::Model::AnyThing/"grab(...)">
-and L<fetch|Config::Model::Value/"fetch( ... )">
-
-A regexp can also be used to check value:
-
- check => {
- "License text" => qr/gnu/i,
- "License text" => { mode => 'custom', value => qr/gnu/i },
- }
-
-=item *
-
-Verify if a hash contains one or more keys (or keys matching a regexp):
-
- has_key => [
- 'sections' => 'debian', # sections must point to a hash element
- 'control' => [qw/source binary/],
- 'copyright Files' => qr/.c$/,
- 'copyright Files' => [qr/\.h$/], qr/\.c$/],
- ],
-
-=item *
-
-Verify that a hash has B<not> a key (or a key matching a regexp):
-
- has_not_key => [
- 'copyright Files' => qr/.virus$/ # silly, isn't ?
- ],
-
-=item *
-
-Verify annotation extracted from the configuration file comments:
-
- verify_annotation => {
- 'source Build-Depends' => "do NOT add libgtk2-perl to build-deps (see bug #554704)",
- 'source Maintainer' => "what a fine\nteam this one is",
- },
-
-=item *
-
-Write back the config data in C<< wr_root/<subtest name>/ >>.
-Note that write back is forced, so the tested configuration files are
-written back even if the configuration values were not changed during the test.
-
-You can skip warning when writing back with the global :
-
- no_warnings => 1,
-
-=item *
-
-Check the content of the written files(s) with L<Test::File::Contents>. Tests can be grouped
-in an array ref:
-
- file_contents => {
- "/home/foo/my_arm.conf" => "really big string" ,
- "/home/bar/my_arm.conf" => [ "really big string" , "another"], ,
- }
-
- file_contents_like => {
- "/home/foo/my_arm.conf" => [ qr/should be there/, qr/as well/ ] ,
- }
-
- file_contents_unlike => {
- "/home/foo/my_arm.conf" => qr/should NOT be there/ ,
- }
-
-=item *
-
-Check added or removed configuration files. If you expect changes,
-specify a subref to alter the file list:
-
- file_check_sub => sub {
- my $list_ref = shift ;
- # file added during tests
- push @$list_ref, "/debian/source/format" ;
- },
-
-Note that actual and expected file lists are sorted before check,
-adding a file can be done with C<push>.
-
-=item *
-
-Copy all config data from C<< wr_root/<subtest name>/ >>
-to C<< wr_root/<subtest name>-w/ >>. This steps is necessary
-to check that configuration written back has the same content as
-the original configuration.
-
-=item *
-
-Create a second configuration instance to read the conf file that was just copied
-(configuration data is checked.)
-
-=item *
-
-You can skip the load check if the written file still contain errors (e.g.
-some errors were ignored and cannot be fixed) with C<< load_check2 => 'no' >>
-
-=item *
-
-Optionally load configuration data in the second instance. You should
-design this config data to suppress any error or warning that occur in
-the step below. E.g:
-
- load2 => 'binary:seaview',
-
-See L<Config::Model::Loader> for the syntax of the string accepted by C<load2> parameter.
-
-=item *
-
-Compare data read from original data.
-
-=item *
-
-Run specific content check on the B<written> config file to verify that
-configuration data was written and retrieved correctly:
-
- wr_check => {
- 'fs:/proc fs_spec' => "proc" ,
- 'fs:/proc fs_file' => "/proc",
- 'fs:/home fs_file' => "/home",
- },
-
-Like the C<check> item explained above, you can run C<wr_check> using
-different check modes.
-
-=back
-
-=head2 Running the test
-
-Run all tests with one of these commands:
-
- prove -l t/model_test.t :: [ t|l|e [ <model_name> [ <regexp> ]]]
- perl -Ilib t/model_test.t [ t|l|e [ <model_name> [ <regexp> ]]]
-
-By default, all tests are run on all models.
-
-You can pass arguments to C<t/model_test.t>:
-
-=over
-
-=item *
-
-a bunch of letters. 't' to get test traces. 'e' to get stack trace in case of
-errors, 'l' to have logs. All other letters are ignored. E.g.
-
- # run with log and error traces
- prove -lv t/model_test.t :: el
-
-=item *
-
-The model name to tests. E.g.:
-
- # run only fstab tests
- prove -lv t/model_test.t :: x fstab
-
-=item *
-
-A regexp to filter subtest E.g.:
-
- # run only fstab tests foobar subtest
- prove -lv t/model_test.t :: x fstab foobar
-
- # run only fstab tests foo subtest
- prove -lv t/model_test.t :: x fstab '^foo$'
-
-=back
-
-=head1 Examples
-
-=over
-
-=item *
-
-L<LCDproc|http://lcdproc.org> has a single configuration file:
-C</etc/LCDd.conf>. Here's LCDproc test
-L<layout|https://github.com/dod38fr/config-model-lcdproc/tree/master/t/model_tests.d>
-and the L<test specification|https://github.com/dod38fr/config-model-lcdproc/blob/master/t/model_tests.d/lcdd-test-conf.pl>
-
-=item *
-
-Dpkg packages are constructed from several files. These files are handled like
-configuration files by L<Config::Model::Dpkg>. The
-L<test layout|http://anonscm.debian.org/gitweb/?p=pkg-perl/packages/libconfig-model-dpkg-perl.git;a=tree;f=t/model_tests.d;hb=HEAD>
-features test with multiple file in
-L<dpkg-examples|http://anonscm.debian.org/gitweb/?p=pkg-perl/packages/libconfig-model-dpkg-perl.git;a=tree;f=t/model_tests.d/dpkg-examples;hb=HEAD>.
-The test is specified in L<dpkg-test-conf.pl|http://anonscm.debian.org/gitweb/?p=pkg-perl/packages/libconfig-model-dpkg-perl.git;a=blob_plain;f=t/model_tests.d/dpkg-test-conf.pl;hb=HEAD>
-
-=item *
-
-L<multistrap-test-conf.pl|https://github.com/dod38fr/config-model/blob/master/t/model_tests.d/multistrap-test-conf.pl>
-and L<multistrap-examples|https://github.com/dod38fr/config-model/tree/master/t/model_tests.d/multistrap-examples>
-specify a test where the configuration file name is not imposed by the
-application. The file name must then be set in the test specification.
-
-=item *
-
-L<backend-shellvar-test-conf.pl|https://github.com/dod38fr/config-model/blob/master/t/model_tests.d/backend-shellvar-test-conf.pl>
-is a more complex example showing how to test a backend. The test is done creating a dummy model within the test specification.
-
-=back
-
-=head1 SEE ALSO
-
-=over 4
-
-=item *
-
-L<Config::Model>
-
-=item *
-
-L<Test::More>
-
-=back
-
-=head1 AUTHOR
-
-Dominique Dumont
-
-=head1 COPYRIGHT AND LICENSE
-
-This software is Copyright (c) 2013-2017 by Dominique Dumont.
-
-This is free software, licensed under:
-
- The GNU Lesser General Public License, Version 2.1, February 1999
-
-=for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
-
-=head1 SUPPORT
-
-=head2 Websites
-
-The following websites have more information about this module, and may be of help to you. As always,
-in addition to those websites please use your favorite search engine to discover more resources.
-
-=over 4
-
-=item *
-
-Search CPAN
-
-The default CPAN search engine, useful to view POD in HTML format.
-
-L<http://search.cpan.org/dist/Config-Model-Tester>
-
-=item *
-
-AnnoCPAN
-
-The AnnoCPAN is a website that allows community annotations of Perl module documentation.
-
-L<http://annocpan.org/dist/Config-Model-Tester>
-
-=item *
-
-CPAN Ratings
-
-The CPAN Ratings is a website that allows community ratings and reviews of Perl modules.
-
-L<http://cpanratings.perl.org/d/Config-Model-Tester>
-
-=item *
-
-CPANTS
-
-The CPANTS is a website that analyzes the Kwalitee ( code metrics ) of a distribution.
-
-L<http://cpants.cpanauthors.org/dist/Config-Model-Tester>
-
-=item *
-
-CPAN Testers
-
-The CPAN Testers is a network of smokers who run automated tests on uploaded CPAN distributions.
-
-L<http://www.cpantesters.org/distro/C/Config-Model-Tester>
-
-=item *
-
-CPAN Testers Matrix
-
-The CPAN Testers Matrix is a website that provides a visual overview of the test results for a distribution on various Perls/platforms.
-
-L<http://matrix.cpantesters.org/?dist=Config-Model-Tester>
-
-=item *
-
-CPAN Testers Dependencies
-
-The CPAN Testers Dependencies is a website that shows a chart of the test results of all dependencies for a distribution.
-
-L<http://deps.cpantesters.org/?module=Config::Model::Tester>
-
-=back
-
-=head2 Bugs / Feature Requests
-
-Please report any bugs or feature requests by email to C<ddumont at cpan.org>, or through
-the web interface at L<https://github.com/dod38fr/config-model-tester/issues>. You will be automatically notified of any
-progress on the request by the system.
-
-=head2 Source Code
-
-The code is open to the world, and available for you to hack on. Please feel free to browse it and play
-with it, or whatever. If you want to contribute patches, please send me a diff or prod me to pull
-from your repository :)
-
-L<http://github.com/dod38fr/config-model-tester.git>
-
- git clone git://github.com/dod38fr/config-model-tester.git
-
-=cut
diff --git a/lib/Config/Model/models/Itself/Application.pl b/lib/Config/Model/models/Itself/Application.pl
new file mode 100644
index 0000000..1a10ae8
--- /dev/null
+++ b/lib/Config/Model/models/Itself/Application.pl
@@ -0,0 +1,71 @@
+#
+# This file is part of Config-Model-Itself
+#
+# This software is Copyright (c) 2007-2017 by Dominique Dumont.
+#
+# This is free software, licensed under:
+#
+# The GNU Lesser General Public License, Version 2.1, February 1999
+#
+
+[
+ {
+ name => 'Itself::Application',
+ # read/written by Config::Model::Itself (read_all)
+
+ element => [
+ model => {
+ refer_to => '! class',
+ type => 'leaf',
+ value_type => 'reference',
+ description => 'Top class required to configure this application',
+ },
+ synopsis => {
+ type => 'leaf',
+ value_type => 'uniline',
+ description => "one line description of the application."
+ },
+ link_to_doc => {
+ type => 'leaf',
+ value_type => 'uniline',
+ description => "Documentation URL."
+ },
+ category => {
+ choice => [
+ 'system',
+ 'user',
+ 'application'
+ ],
+ type => 'leaf',
+ value_type => 'enum',
+ description => 'Can be "system", "user" or "application"',
+ help => {
+ system => 'Configuration file is owned by root and usually located in C</etc>',
+ user => 'Configuration files is owned by user and usually located in C<~/.*>',
+ application => 'Configuration file is located anywhere and is usually explicitly '
+ .'specified to application. E.g. C<multistrap -f CONFIG_FILE>',
+ }
+ },
+ allow_config_file_override => {
+ type => 'leaf',
+ upstream_default => '0',
+ value_type => 'boolean',
+ description => 'Set if user can override the configuration file loaded by default by cme',
+ },
+ require_config_file => {
+ type => 'leaf',
+ upstream_default => '0',
+ value_type => 'boolean',
+ description => "set when there's no default path for the configuration file."
+ . "user will have to specify a configuration file with C<--file> option."
+ },
+ config_dir => {
+ type => 'leaf',
+ value_type => 'uniline',
+ description => "set configuration directory where config file is read from "
+ . "or written to. This value does not override a directory specified in the model."
+ },
+ ],
+ }
+] ;
+
diff --git a/lib/Config/Model/models/Itself/CargoElement.pl b/lib/Config/Model/models/Itself/CargoElement.pl
new file mode 100644
index 0000000..54a6d1a
--- /dev/null
+++ b/lib/Config/Model/models/Itself/CargoElement.pl
@@ -0,0 +1,56 @@
+#
+# This file is part of Config-Model-Itself
+#
+# This software is Copyright (c) 2007-2017 by Dominique Dumont.
+#
+# This is free software, licensed under:
+#
+# The GNU Lesser General Public License, Version 2.1, February 1999
+#
+
+[
+ [
+ name => "Itself::CargoElement",
+
+ include =>
+ [ 'Itself::NonWarpableElement', 'Itself::WarpableCargoElement' ],
+ include_after => 'type',
+
+ 'element' => [
+
+ # structural information
+ 'type' => {
+ type => 'leaf',
+ value_type => 'enum',
+ choice => [qw/node warped_node leaf check_list/],
+ mandatory => 1,
+ description => 'specify the type of the cargo.',
+ },
+
+ # node element (may be within a hash or list)
+
+ 'warp' => {
+ type => 'warped_node', # ?
+ level => 'hidden',
+
+ warp => {
+ follow => { elt_type => '- type' },
+ rules => [
+ '$elt_type ne "node"' => {
+ level => 'normal',
+ config_class_name => 'Itself::WarpValue',
+ }
+ ],
+ },
+ description =>
+ "change the properties (i.e. default value or its value_type) "
+ . "dynamically according to the value of another Value object locate "
+ . "elsewhere in the configuration tree. "
+
+ },
+
+ ],
+
+ ],
+
+];
diff --git a/lib/Config/Model/models/Itself/Class.pl b/lib/Config/Model/models/Itself/Class.pl
new file mode 100644
index 0000000..6cc1e77
--- /dev/null
+++ b/lib/Config/Model/models/Itself/Class.pl
@@ -0,0 +1,502 @@
+#
+# This file is part of Config-Model-Itself
+#
+# This software is Copyright (c) 2007-2017 by Dominique Dumont.
+#
+# This is free software, licensed under:
+#
+# The GNU Lesser General Public License, Version 2.1, February 1999
+#
+# Copyright (c) 2007-2015 Dominique Dumont.
+#
+# This file is part of Config-Model-Itself.
+#
+# Config-Model-Itself is free software; you can redistribute it
+# and/or modify it under the terms of the GNU Lesser Public License
+# as published by the Free Software Foundation; either version 2.1
+# of the License, or (at your option) any later version.
+#
+# Config-Model-Itself is distributed in the hope that it will be
+# useful, but WITHOUT ANY WARRANTY; without even the implied
+# warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+# See the GNU Lesser Public License for more details.
+#
+# You should have received a copy of the GNU Lesser Public License
+# along with Config-Model-Itself; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+
+[
+ [
+ name => "Itself::Class",
+ author => 'Dominique Dumont',
+ copyright => '2007-2011 Dominique Dumont.',
+ license => 'LGPL-2',
+
+ class_description =>
+ "Configuration class. This class represents a node of a configuration tree.",
+
+ 'element' => [
+
+ [qw/class_description license/] => {
+ type => 'leaf',
+ value_type => 'string',
+ },
+
+ [qw/author copyright/] => {
+ type => 'list',
+ cargo => {
+ type => 'leaf',
+ value_type => 'uniline',
+ }
+ },
+
+ 'class' => {
+ type => 'leaf',
+ value_type => 'uniline',
+ summary => "Override implementation of configuration node",
+ description =>
+ "Perl class name used to override the default implementation of a configuration node. "
+ ."This Perl class must inherit L<Config::Model::Node>. Use with care.",
+ assert => {
+ "1_load_class" => {
+ code => 'not defined $_ or eval{Mouse::Util::load_class($_)}; not $@;',
+ msg => 'Error while loading $_ class ',
+ },
+ "2_class_inherit" => {
+ code => 'not defined $_ or $_->isa("Config::Model::Node")',
+ msg => 'class $_ must inherit Config::Model::Node',
+ }
+ },
+
+ },
+
+ 'element' => {
+ type => 'hash',
+ level => 'important',
+ ordered => 1,
+ index_type => 'string',
+ cargo => {
+ type => 'node',
+ config_class_name => 'Itself::Element',
+ },
+ },
+
+ [qw/include include_backend/] => {
+ type => 'list',
+ cargo => {
+ type => 'leaf',
+ value_type => 'reference',
+ refer_to => '! class',
+ }
+ },
+
+ 'include_after' => {
+ type => 'leaf',
+ value_type => 'reference',
+ refer_to => '- element',
+ },
+
+ generated_by => {
+ type => 'leaf',
+ value_type => 'uniline',
+ },
+ 'read_config' => {
+ type => 'list',
+ cargo => {
+ type => 'node',
+ config_class_name => 'Itself::ConfigRead',
+ },
+ },
+
+ 'write_config' => {
+ type => 'list',
+ cargo => {
+ type => 'node',
+ config_class_name => 'Itself::ConfigWrite',
+ },
+ },
+ 'accept' => {
+ type => 'hash',
+ index_type => 'string',
+ ordered => 1,
+ cargo => {
+ type => 'node',
+ config_class_name => 'Itself::ConfigAccept',
+ },
+ },
+ ],
+ 'description' => [
+ element => "Specify the elements names of this configuration class.",
+ include => "Include the element description of another class into this class.",
+ include_after => "insert the included elements after a specific element. "
+ . "By default, included elements are placed before all other elements.",
+ include_backend => "Include the read/write specification of another class into this class.",
+ class_description => "Explain the purpose of this configuration class. This description is re-used to generate the documentation of your configuration class. You can use pod markup to format your description. See L<perlpod> for details.",
+ read_config => "Specify the Perl class(es) and function(s) used to read configuration data. The specified functions are tried in sequence to get configuration data. ",
+ write_config => "Specify the Perl class and function used to write configuration data.",
+ generated_by => "When set, this class was generated by some program. You should not edit "
+ ."this class as your modifications may be clobbered later on when the class is regenerated.",
+ accept => "Specifies names of the elements this configuration class accepts as valid. "
+ ."The key of the hash is a regular expression that are be tested against
+ candidate parameters. When the parameter matches the regular expression,
+ a new parameter is created in the model using the description provided
+ in the value of this hash key. Note that the regexp must match the whole name
+ of the potential parameter. I.e. the specified regexp is eval\'ed
+ with a leading C<^> and a trailing C<\$>."
+ ],
+ ],
+
+ [
+ name => 'Itself::ConfigWR::DefaultLayer',
+
+ 'element' => [
+ 'config_dir' => {
+ type => 'leaf',
+ value_type => 'uniline',
+ level => 'normal',
+ },
+
+ os_config_dir => {
+ type => 'hash',
+ index_type => 'string',
+ cargo => {
+ type => 'leaf',
+ value_type => 'uniline',
+ },
+ summary => 'configuration file directory for specific OS',
+ description => 'Specify and alternate location of a configuration directory depending '
+ .q!on the OS (as returned by C<$^O> or C<$Config{'osname'}>, see L<perlport/PLATFORMS>) !
+ .q!Common values for C<$^O> are 'linux', 'MSWin32', 'darwin'!
+ },
+ 'file' => {
+ type => 'leaf',
+ value_type => 'uniline',
+ level => 'normal',
+ summary => 'target configuration file name',
+ description => 'specify the configuration file name. This parameter may '
+ .'not be applicable depending on your application. It may also be '
+ .'hardcoded in a custom backend. If not specified, the instance name '
+ .'is used as base name for your configuration file. The configuration file name'
+ .'can be specified with &index keyword when a backend is associated to a node '
+ .'contained in a hash. See '
+ .'L<backend specifications|http://search.cpan.org/dist/Config-Model/lib/Config/Model/BackendMgr.pm#Backend_specification>.'
+ },
+ ]
+ ],
+
+ [
+ name => "Itself::ConfigWR",
+ include => "Itself::ConfigWR::DefaultLayer",
+ include_after => 'backend',
+
+ 'element' => [
+
+ 'syntax' => {
+ type => 'leaf',
+ value_type => 'enum',
+ choice => [qw/cds perl ini custom/],
+ status => 'deprecated',
+ description => 'Deprecated parameter that specified the file syntax to store permanently configuration data. Replaced by "backend"',
+ },
+
+ 'backend' => {
+ type => 'leaf',
+ class => 'Config::Model::Itself::BackendDetector',
+ value_type => 'enum',
+ choice => [qw/cds_file perl_file custom/],
+ replace => {
+ perl => 'perl_file',
+ ini => 'IniFile',
+ ini_file => 'IniFile',
+ cds => 'cds_file',
+ },
+ migrate_from => {
+ formula => '$old',
+ variables => { old => '- syntax' },
+ },
+ description => 'specifies the backend to store permanently configuration data.',
+ help => {
+ cds_file => "file with config data string. This is Config::Model own serialisation format, designed to be compact and readable. Configuration filename is made with instance name",
+ IniFile =>
+"Ini file format. Beware that the structure of your model must match the limitations of the INI file format, i.e only a 2 levels hierarchy. Configuration filename is made with instance name",
+ perl_file =>
+"file with a perl data structure. Configuration filename is made with instance name",
+ custom =>
+"Custom format. You must specify your own class and method to perform the read or write function. See Config::Model::AutoRead doc for more details",
+ }
+ },
+
+ file_mode => {
+ type => 'leaf',
+ value_type => 'uniline',
+ level => 'normal',
+ summary => 'configuration file mode',
+ description => 'specify the configuration file mode. C<file_mode> parameter can be used to set the '
+ . 'mode of the written file. C<file_mode> value can be in any form suppported by L<Path::Tiny/chmod>.'
+ },
+
+ default_layer => {
+ type => 'node',
+ config_class_name => 'Itself::ConfigWR::DefaultLayer',
+ summary => q!How to find default values in a global config file!,
+ description => q!Specifies where to find a global configuration file that !
+ .q!specifies default values. For instance, this is used by OpenSSH to !
+ .q!specify a global configuration file (C</etc/ssh/ssh_config>) that is !
+ .q!overridden by user's file!,
+ },
+
+ 'class' => {
+ type => 'leaf',
+ value_type => 'uniline',
+ level => 'hidden',
+ warp => {
+ follow => '- backend',
+ rules => [
+ custom => {
+ level => 'normal',
+ mandatory => 1,
+ }
+ ],
+ }
+ },
+
+ 'store_class_in_hash' => {
+ type => 'leaf',
+ value_type => 'uniline',
+ level => 'hidden',
+ description => 'Specify element hash name that contains all INI classes. '
+ .'See L<Config::Model::Backend::IniFile/"Arbitrary class name">',
+ warp => {
+ follow => '- backend',
+ rules => [ IniFile => { level => 'normal', } ],
+ }
+ },
+
+ 'section_map' => {
+ type => 'hash',
+ level => 'hidden',
+ index_type => 'string',
+ description => 'Specify element name that contains one INI class. E.g. to store '
+ .'INI class [foo] in element Foo, specify { foo => "Foo" } ',
+ warp => {
+ follow => '- backend',
+ rules => [ IniFile => { level => 'normal', } ],
+ },
+ cargo => {
+ type => 'leaf',
+ value_type => 'uniline',
+ },
+ },
+
+ ['split_list_value','split_check_list_value'] => {
+ type => 'leaf',
+ value_type => 'uniline',
+ level => 'hidden',
+ description => 'Regexp to split the value read from ini file. Usually "\s+" or "[,\s]"',
+ warp => {
+ follow => '- backend',
+ rules => [ IniFile => { level => 'normal', } ],
+ }
+ },
+
+ ['join_list_value', 'join_check_list_value'] => {
+ type => 'leaf',
+ value_type => 'uniline',
+ level => 'hidden',
+ warp => {
+ follow => '- backend',
+ rules => [ IniFile => { level => 'normal', } ],
+ }
+ },
+
+ 'write_boolean_as' => {
+ type => 'list',
+ description => 'Specify how to write a boolean value in config file. Suggested values are '
+ . '"no","yes". ',
+ max_index => 1,
+ cargo => {
+ type => 'leaf',
+ value_type => 'uniline',
+ },
+ },
+
+ force_lc_section => {
+ type => 'leaf',
+ value_type => 'boolean',
+ level => 'hidden',
+ upstream_default => 0,
+ description => "force section to be lowercase",
+ warp => {
+ follow => '- backend',
+ rules => [ IniFile => { level => 'normal', } ],
+ }
+ },
+ force_lc_key => {
+ type => 'leaf',
+ value_type => 'boolean',
+ level => 'hidden',
+ upstream_default => 0,
+ description => "force key names to be lowercase",
+ warp => {
+ follow => '- backend',
+ rules => [ IniFile => { level => 'normal', } ],
+ }
+ },
+ force_lc_value => {
+ type => 'leaf',
+ value_type => 'boolean',
+ level => 'hidden',
+ upstream_default => 0,
+ description => "force values to be lowercase",
+ warp => {
+ follow => '- backend',
+ rules => [ IniFile => { level => 'normal', } ],
+ }
+ },
+
+ 'full_dump' => {
+ type => 'leaf',
+ value_type => 'boolean',
+ level => 'hidden',
+ description => 'Also dump default values in the data structure. Useful if the dumped configuration data will be used by the application. (default is yes)',
+ upstream_default => '1',
+ warp => {
+ follow => { backend => '- backend' },
+ rules => [ '$backend =~ /yaml|perl/i' => { level => 'normal', } ],
+ }
+ },
+
+ 'comment_delimiter' => {
+ type => 'leaf',
+ value_type => 'uniline',
+ level => 'hidden',
+ description => 'list of characters that start a comment. When more that one character'
+ .' is used. the first one is used to write back comment. For instance,'
+ .' value "#;" indicate that a comments can start with "#" or ";" and that all comments'
+ .' are written back with "#".',
+ upstream_default => '#',
+ warp => {
+ follow => '- backend',
+ rules => [ IniFile => { level => 'normal', } ],
+ }
+ },
+
+ 'auto_delete' => {
+ type => 'leaf',
+ value_type => 'boolean',
+ level => 'normal',
+ upstream_default => 0,
+ summary => 'Delete empty configuration file',
+ description => 'Delete configuration files when no information is left in there.'
+ . ' This may happen when data is removed by user. This is mostly useful when the '
+ . ' configuration of an application is made of several files.',
+ },
+
+ ],
+ description => [
+ join_list_value => 'string to join list values before writing the entry in ini file. Usually " " or ", "',
+ join_check_list_value => 'string to join checked items names before writing the entry in the ini file. Usually " " or ", "',
+ ],
+
+ ],
+
+ [
+ name => 'Itself::ConfigRead',
+ include => "Itself::ConfigWR",
+
+ 'element' => [
+ 'function' => {
+ type => 'leaf',
+ value_type => 'uniline',
+ level => 'hidden',
+ warp => {
+ follow => '- backend',
+ rules => [
+ custom => {
+ level => 'normal',
+ upstream_default => 'read',
+ }
+ ],
+ }
+ },
+
+ 'auto_create' => {
+ type => 'leaf',
+ value_type => 'boolean',
+ level => 'normal',
+ upstream_default => 0,
+ summary => 'Creates configuration files as needed',
+ migrate_from => {
+ formula => '$old',
+ variables => { old => '- allow_empty' },
+ },
+ },
+
+ 'allow_empty' => {
+ type => 'leaf',
+ value_type => 'boolean',
+ level => 'normal',
+ status => 'deprecated',
+ upstream_default => 0,
+ summary => 'deprecated in favor of auto_create',
+ },
+
+ ],
+ ],
+
+ [
+ name => 'Itself::ConfigWrite',
+ include => "Itself::ConfigWR",
+
+ 'element' => [
+ 'function' => {
+ type => 'leaf',
+ value_type => 'uniline',
+ level => 'hidden',
+ warp => {
+ follow => '- backend',
+ rules => [
+ custom => {
+ level => 'normal',
+ upstream_default => 'write',
+ }
+ ],
+ }
+ },
+
+ # move to ConfigRW when removing legacy allow_empty
+ 'auto_create' => {
+ type => 'leaf',
+ value_type => 'boolean',
+ level => 'normal',
+ upstream_default => 0,
+ summary => 'Creates configuration files as needed',
+ },
+
+ ],
+ ],
+ [
+ name => 'Itself::ConfigAccept',
+
+ include => "Itself::Element",
+ include_after => 'accept_after',
+ 'element' => [
+ 'name_match' => {
+ type => 'leaf',
+ value_type => 'uniline',
+ upstream_default => '.*',
+ status => 'deprecated',
+ },
+ 'accept_after' => {
+ type => 'leaf',
+ value_type => 'reference' ,
+ refer_to => '- - element' ,
+ description => 'specify where to insert accepted element. This does'
+ . ' not change the behavior and helps generating more consistent '
+ . ' user interfaces'
+ }
+
+ ],
+ ],
+
+];
diff --git a/lib/Config/Model/models/Itself/Class.pod b/lib/Config/Model/models/Itself/Class.pod
new file mode 100644
index 0000000..bc25ad9
--- /dev/null
+++ b/lib/Config/Model/models/Itself/Class.pod
@@ -0,0 +1,128 @@
+# PODNAME: Config::Model::models::Itself::Class
+# ABSTRACT: Configuration class Itself::Class
+=encoding utf8
+
+=head1 NAME
+
+Config::Model::models::Itself::Class - Configuration class Itself::Class
+
+=head1 DESCRIPTION
+
+Configuration classes used by L<Config::Model>
+
+Configuration class. This class represents a node of a configuration tree.
+
+=head1 Elements
+
+=head2 class_description
+
+Explain the purpose of this configuration class. This description is re-used to generate the documentation of your configuration class. You can use pod markup to format your description. See L<perlpod> for details. I<< Optional. Type string. >>
+
+=head2 license
+
+I<< Optional. Type string. >>
+
+=head2 author
+
+I<< Optional. Type list of uniline. >>
+
+=head2 copyright
+
+I<< Optional. Type list of uniline. >>
+
+=head2 class - Override implementation of configuration node
+
+Perl class name used to override the default implementation of a configuration node. This Perl class must inherit L<Config::Model::Node>. Use with care. I<< Optional. Type uniline. >>
+
+=head2 element
+
+Specify the elements names of this configuration class. I<< Optional. Type hash of node of class L<Itself::Element|Config::Model::models::Itself::Element> . >>
+
+=head2 include
+
+Include the element description of another class into this class. I<< Optional. Type list of reference. >>
+
+=head2 include_backend
+
+Include the read/write specification of another class into this class. I<< Optional. Type list of reference. >>
+
+=head2 include_after
+
+insert the included elements after a specific element. By default, included elements are placed before all other elements. I<< Optional. Type reference. >>
+
+=head2 generated_by
+
+When set, this class was generated by some program. You should not edit this class as your modifications may be clobbered later on when the class is regenerated. I<< Optional. Type uniline. >>
+
+=head2 read_config
+
+Specify the Perl class(es) and function(s) used to read configuration data. The specified functions are tried in sequence to get configuration data. I<< Optional. Type list of node of class L<Itself::ConfigRead|Config::Model::models::Itself::ConfigRead> . >>
+
+=head2 write_config
+
+Specify the Perl class and function used to write configuration data. I<< Optional. Type list of node of class L<Itself::ConfigWrite|Config::Model::models::Itself::ConfigWrite> . >>
+
+=head2 accept
+
+Specifies names of the elements this configuration class accepts as valid. The key of the hash is a regular expression that are be tested against
+ candidate parameters. When the parameter matches the regular expression,
+ a new parameter is created in the model using the description provided
+ in the value of this hash key. Note that the regexp must match the whole name
+ of the potential parameter. I.e. the specified regexp is eval'ed
+ with a leading C<^> and a trailing C<$>. I<< Optional. Type hash of node of class L<Itself::ConfigAccept|Config::Model::models::Itself::ConfigAccept> . >>
+
+=head1 SEE ALSO
+
+=over
+
+=item *
+
+L<cme>
+
+=item *
+
+L<Config::Model::models::Itself::ConfigAccept>
+
+=item *
+
+L<Config::Model::models::Itself::ConfigRead>
+
+=item *
+
+L<Config::Model::models::Itself::ConfigWrite>
+
+=item *
+
+L<Config::Model::models::Itself::Element>
+
+=back
+
+=head1 AUTHOR
+
+=over
+
+=item Dominique Dumont
+
+
+=back
+
+=head1 COPYRIGHT
+
+=over
+
+=item 2007-2011 Dominique Dumont.
+
+
+=back
+
+=head1 LICENSE
+
+=over
+
+=item LGPL-2
+
+
+=back
+
+=cut
+
diff --git a/lib/Config/Model/models/Itself/CommonElement.pl b/lib/Config/Model/models/Itself/CommonElement.pl
new file mode 100644
index 0000000..faf4fa7
--- /dev/null
+++ b/lib/Config/Model/models/Itself/CommonElement.pl
@@ -0,0 +1,389 @@
+#
+# This file is part of Config-Model-Itself
+#
+# This software is Copyright (c) 2007-2017 by Dominique Dumont.
+#
+# This is free software, licensed under:
+#
+# The GNU Lesser General Public License, Version 2.1, February 1999
+#
+# Copyright (c) 2007-2011 Dominique Dumont.
+#
+# This file is part of Config-Model-Itself.
+#
+# Config-Model-Itself is free software; you can redistribute it
+# and/or modify it under the terms of the GNU Lesser Public License
+# as published by the Free Software Foundation; either version 2.1
+# of the License, or (at your option) any later version.
+#
+# Config-Model-Itself is distributed in the hope that it will be
+# useful, but WITHOUT ANY WARRANTY; without even the implied
+# warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+# See the GNU Lesser Public License for more details.
+#
+# You should have received a copy of the GNU Lesser Public License
+# along with Config-Model-Itself; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+
+my @warp_in_uniline_or_string = (
+ warp => {
+ follow => {
+ 'type' => '?type',
+ 'vtype' => '?value_type',
+ },
+ 'rules' => [
+ ' $type eq "leaf"
+ and ( $vtype eq "uniline"
+ or $vtype eq "string"
+ )
+ '
+ => { level => 'normal', }
+ ]
+ },
+
+);
+
+my %warn_if_match_payload = (
+ type => 'hash',
+ index_type => 'string',
+ level => 'hidden',
+ cargo => {
+ type => 'node',
+ config_class_name => 'Itself::CommonElement::WarnIfMatch',
+ },
+ @warp_in_uniline_or_string,
+);
+
+my %assert_payload = (
+ type => 'hash',
+ index_type => 'string',
+ level => 'hidden',
+ cargo => {
+ type => 'node',
+ config_class_name => 'Itself::CommonElement::Assert',
+ },
+ @warp_in_uniline_or_string,
+);
+
+[
+ [
+ name => 'Itself::CommonElement::WarnIfMatch',
+ element => [
+ msg => {
+ type => 'leaf',
+ value_type => 'string',
+ description =>
+'Warning message to show user. "$_" contains the bad value. Example "value $_ is bad". Leave blank or undef to use generated message',
+ },
+ fix => {
+ type => 'leaf',
+ value_type => 'string',
+ description =>
+'Perl instructions to fix the value. These instructions may be triggered by user. $_ contains the value to fix. $_ is stored as the new value once the instructions are done. C<$self> contains the value object. Use with care.',
+ },
+ ],
+ ],
+ [
+ name => 'Itself::CommonElement::Assert',
+ include => 'Itself::CommonElement::WarnIfMatch',
+ include_after => 'code',
+ element => [
+ code => {
+ type => 'leaf',
+ value_type => 'string',
+ description =>
+'Perl instructions to test the value. $_ contains the value to test. C<$self> contains the value object. Use with care.',
+ },
+ ],
+ ],
+ [
+ name => 'Itself::CommonElement',
+
+ # warp often depend on this one, so list it first
+ 'element' => [
+
+ 'mandatory' => {
+ type => 'leaf',
+ value_type => 'boolean',
+ level => 'hidden',
+ warp => {
+ follow => '?type',
+ 'rules' => {
+ 'leaf' => {
+ upstream_default => 0,
+ level => 'normal',
+ }
+ }
+ }
+ },
+
+ # node element (may be within a hash or list)
+
+ 'config_class_name' => {
+ type => 'leaf',
+ level => 'hidden',
+ value_type => 'reference',
+ refer_to => '! class',
+ warp => {
+ follow => { t => '?type' },
+ rules => [
+ '$t eq "warped_node" ' => {
+
+ # should be able to warp refer_to ??
+ level => 'normal',
+ },
+ '$t eq "node"' => {
+
+ # should be able to warp refer_to ??
+ level => 'normal',
+ mandatory => 1,
+ },
+ ]
+ }
+ },
+
+ # warped_node: warp parameter for warped_node. They must be
+ # warped out when type is not a warped_node
+
+ # end warp elements for warped_node
+
+ # leaf element
+
+ 'choice' => {
+ type => 'list',
+ level => 'hidden',
+ description => 'Specify the possible values',
+ warp => {
+ follow => {
+ t => '?type',
+ vt => '?value_type',
+ },
+ 'rules' => [
+ ' ($t eq "leaf" and ( $vt eq "enum"
+ or $vt eq "reference")
+ )
+ or $t eq "check_list"' => { level => 'normal', },
+ ]
+ },
+ cargo => { type => 'leaf', value_type => 'uniline' },
+ },
+
+ 'min' => {
+ type => 'leaf',
+ value_type => 'number',
+ level => 'hidden',
+ description => 'minimum value',
+ warp => {
+ follow => {
+ 'type' => '?type',
+ 'vtype' => '?value_type',
+ },
+ 'rules' => [
+ ' $type eq "leaf"
+ and ( $vtype eq "integer"
+ or $vtype eq "number"
+ )
+ '
+ => { level => 'normal', }
+ ]
+ }
+ },
+
+ 'max' => {
+ type => 'leaf',
+ value_type => 'number',
+ level => 'hidden',
+ description => 'maximum value',
+ warp => {
+ follow => {
+ 'type' => '?type',
+ 'vtype' => '?value_type',
+ },
+ 'rules' => [
+ ' $type eq "leaf"
+ and ( $vtype eq "integer"
+ or $vtype eq "number"
+ )
+ '
+ => { level => 'normal', }
+ ]
+ }
+ },
+
+ 'min_index' => {
+ type => 'leaf',
+ value_type => 'integer',
+ level => 'hidden',
+ description => 'minimum number of keys',
+ warp => {
+ follow => { 'type' => '?type', },
+ 'rules' => [
+ '$type eq "hash"' =>
+ { level => 'normal', },
+ ]
+ }
+ },
+
+ 'max_index' => {
+ type => 'leaf',
+ value_type => 'integer',
+ level => 'hidden',
+ description => 'maximum number of keys',
+ warp => {
+ follow => { 'type' => '?type', },
+ 'rules' => [
+ '$type eq "hash" or $type eq "list"' =>
+ { level => 'normal', },
+ ]
+ }
+ },
+
+ 'default' => {
+ type => 'leaf',
+ level => 'hidden',
+ value_type => 'string',
+ description => 'Specify default value. This default value is written '
+ .'in the configuration data',
+ warp => {
+ follow => { 't' => '?type' },
+ 'rules' => [ '$t eq "leaf"' => { level => 'normal', } ]
+ }
+ },
+
+ 'upstream_default' => {
+ type => 'leaf',
+ level => 'hidden',
+ value_type => 'string',
+ description =>
+'Another way to specify a default value. But this default value is considered as "built_in" the application and is not written in the configuration data (unless modified)',
+ warp => {
+ follow => { 't' => '?type' },
+ 'rules' => [ '$t eq "leaf"' => { level => 'normal', } ]
+ }
+ },
+
+ 'convert' => {
+ type => 'leaf',
+ value_type => 'enum',
+ level => 'hidden',
+ description => 'Convert value or index to uppercase (uc) or lowercase (lc).',
+ warp => {
+ follow => { 't' => '?type' },
+ 'rules' => [
+ '$t eq "leaf" or $t eq "hash"' => {
+ choice => [qw/uc lc/],
+ level => 'normal',
+ }
+ ]
+ }
+ },
+
+ 'match' => {
+ type => 'leaf',
+ value_type => 'uniline',
+ level => 'hidden',
+ description =>
+ 'Perl regular expression to assert the validity of the value. To check the '
+ . q!whole value, use C<^> and C<$>. For instance C<^foo|bar$> allows !
+ . q!C<foo> or C<bar> but not C<foobar>. To be case insentive, !
+ . q!use the C<(?i)> extended pattern. For instance, the regexp !
+ . q!C<^(?i)foo|bar$> also allows the values !
+ . q!C<Foo> and C<Bar>.!,
+ @warp_in_uniline_or_string,
+ },
+
+ 'assert' => {
+ %assert_payload,
+ description =>
+ 'Raise an error if the test code snippet does returns false. Note this snippet is '
+ . 'also run on undefined value, which may not be what you want.',
+ },
+
+ 'warn_if' => {
+ %assert_payload,
+ description => 'Warn user if the code snippet returns true',
+ },
+
+ 'warn_unless' => {
+ %assert_payload,
+ description =>
+ 'Warn user if the code snippet returns false',
+ },
+
+ 'warn_if_match' => {
+ %warn_if_match_payload,
+ description =>
+ 'Warn user if a I<defined> value matches the regular expression. ',
+ },
+
+ 'warn_unless_match' => {
+ %warn_if_match_payload,
+ description =>
+ 'Warn user if I<defined> value does not match the regular expression',
+ },
+
+ 'warn' => {
+ type => 'leaf',
+ value_type => 'string',
+ level => 'hidden',
+ description =>
+'Unconditionally issue a warning with this string when this parameter is used. This should be used mostly with "accept"',
+ warp => {
+ follow => { t => '?type' },
+ 'rules' => [ '$t eq "leaf"' => { level => 'normal', }, ]
+ },
+ },
+
+ 'grammar' => {
+ type => 'leaf',
+ value_type => 'string',
+ level => 'hidden',
+ description =>
+"Feed this grammar to Parse::RecDescent to perform validation",
+ @warp_in_uniline_or_string,
+ },
+
+ 'default_list' => {
+ type => 'check_list',
+ level => 'hidden',
+ refer_to => '- choice',
+ description => 'Specify items checked by default',
+ warp => {
+ follow => { t => '?type', o => '?ordered' },
+ 'rules' => [
+ '$t eq "check_list" and not $o ' =>
+ { level => 'normal', },
+ '$t eq "check_list" and $o ' => {
+ level => 'normal',
+ ordered => 1,
+ },
+ ]
+ },
+ },
+
+ 'upstream_default_list' => {
+ type => 'check_list',
+ level => 'hidden',
+ refer_to => '- choice',
+ description =>
+ 'Specify items checked by default in the application',
+ warp => {
+ follow => { t => '?type', o => '?ordered' },
+ 'rules' => [
+ '$t eq "check_list" and not $o ' =>
+ { level => 'normal', },
+ '$t eq "check_list" and $o ' => {
+ level => 'normal',
+ ordered => 1,
+ },
+ ]
+ },
+ },
+
+ # hash element
+
+ # list element
+
+ ],
+ ],
+ ];
diff --git a/lib/Config/Model/models/Itself/CommonElement/Assert.pod b/lib/Config/Model/models/Itself/CommonElement/Assert.pod
new file mode 100644
index 0000000..bc79e47
--- /dev/null
+++ b/lib/Config/Model/models/Itself/CommonElement/Assert.pod
@@ -0,0 +1,38 @@
+# PODNAME: Config::Model::models::Itself::CommonElement::Assert
+# ABSTRACT: Configuration class Itself::CommonElement::Assert
+=encoding utf8
+
+=head1 NAME
+
+Config::Model::models::Itself::CommonElement::Assert - Configuration class Itself::CommonElement::Assert
+
+=head1 DESCRIPTION
+
+Configuration classes used by L<Config::Model>
+
+=head1 Elements
+
+=head2 code
+
+Perl instructions to test the value. $_ contains the value to test. C<$self> contains the value object. Use with care. I<< Optional. Type string. >>
+
+=head2 msg
+
+Warning message to show user. "$_" contains the bad value. Example "value $_ is bad". Leave blank or undef to use generated message. I<< Optional. Type string. >>
+
+=head2 fix
+
+Perl instructions to fix the value. These instructions may be triggered by user. $_ contains the value to fix. $_ is stored as the new value once the instructions are done. C<$self> contains the value object. Use with care. I<< Optional. Type string. >>
+
+=head1 SEE ALSO
+
+=over
+
+=item *
+
+L<cme>
+
+=back
+
+=cut
+
diff --git a/lib/Config/Model/models/Itself/CommonElement/WarnIfMatch.pod b/lib/Config/Model/models/Itself/CommonElement/WarnIfMatch.pod
new file mode 100644
index 0000000..5d3e8c2
--- /dev/null
+++ b/lib/Config/Model/models/Itself/CommonElement/WarnIfMatch.pod
@@ -0,0 +1,34 @@
+# PODNAME: Config::Model::models::Itself::CommonElement::WarnIfMatch
+# ABSTRACT: Configuration class Itself::CommonElement::WarnIfMatch
+=encoding utf8
+
+=head1 NAME
+
+Config::Model::models::Itself::CommonElement::WarnIfMatch - Configuration class Itself::CommonElement::WarnIfMatch
+
+=head1 DESCRIPTION
+
+Configuration classes used by L<Config::Model>
+
+=head1 Elements
+
+=head2 msg
+
+Warning message to show user. "$_" contains the bad value. Example "value $_ is bad". Leave blank or undef to use generated message. I<< Optional. Type string. >>
+
+=head2 fix
+
+Perl instructions to fix the value. These instructions may be triggered by user. $_ contains the value to fix. $_ is stored as the new value once the instructions are done. C<$self> contains the value object. Use with care. I<< Optional. Type string. >>
+
+=head1 SEE ALSO
+
+=over
+
+=item *
+
+L<cme>
+
+=back
+
+=cut
+
diff --git a/lib/Config/Model/models/Itself/ComputedValue.pl b/lib/Config/Model/models/Itself/ComputedValue.pl
new file mode 100644
index 0000000..b3eeae3
--- /dev/null
+++ b/lib/Config/Model/models/Itself/ComputedValue.pl
@@ -0,0 +1,43 @@
+#
+# This file is part of Config-Model-Itself
+#
+# This software is Copyright (c) 2007-2017 by Dominique Dumont.
+#
+# This is free software, licensed under:
+#
+# The GNU Lesser General Public License, Version 2.1, February 1999
+#
+[
+ [
+ name => "Itself::ComputedValue",
+ include => "Itself::MigratedValue" ,
+
+ element => [
+ allow_override => {
+ type => 'leaf',
+ value_type => 'boolean',
+ compute => {
+ formula => '$upstream_knowns',
+ variables => {
+ upstream_knowns => '- use_as_upstream_default',
+ },
+ use_as_upstream_default => 1,
+ },
+ level => 'normal',
+ description => "Allow user to override computed value"
+ .'For more details, see L<doc|Config::Model::ValueComputer.pm/"compute override"> ',,
+ },
+
+ use_as_upstream_default => {
+ type => 'leaf',
+ value_type => 'boolean',
+ upstream_default => 0,
+ level => 'normal',
+ description => "Indicate that the computed value is known by the "
+ ."application and does not need to be written in the configuration file. Implies allow_override."
+ },
+ ],
+
+ ],
+
+];
diff --git a/lib/Config/Model/models/Itself/ConfigAccept.pod b/lib/Config/Model/models/Itself/ConfigAccept.pod
new file mode 100644
index 0000000..5881df2
--- /dev/null
+++ b/lib/Config/Model/models/Itself/ConfigAccept.pod
@@ -0,0 +1,278 @@
+# PODNAME: Config::Model::models::Itself::ConfigAccept
+# ABSTRACT: Configuration class Itself::ConfigAccept
+=encoding utf8
+
+=head1 NAME
+
+Config::Model::models::Itself::ConfigAccept - Configuration class Itself::ConfigAccept
+
+=head1 DESCRIPTION
+
+Configuration classes used by L<Config::Model>
+
+=head1 Elements
+
+=head2 name_match
+
+B<Deprecated> I<< Optional. Type uniline. upstream_default: '.*'. >>
+
+=head2 accept_after
+
+specify where to insert accepted element. This does not change the behavior and helps generating more consistent user interfaces. I<< Optional. Type reference. >>
+
+=head2 type
+
+specify the type of the configuration element.Leaf is used for plain value. I<< Mandatory. Type enum. choice: 'node', 'warped_node', 'hash', 'list', 'leaf', 'check_list'. >>
+
+=head2 value_type
+
+I<< Optional. Type enum. choice: 'boolean', 'enum', 'integer', 'reference', 'number', 'uniline', 'string', 'file', 'dir'. >>
+
+Here are some explanations on the possible values:
+
+=over
+
+=item 'integer'
+
+positive or negative integer
+
+=item 'uniline'
+
+string with no embedded newline
+
+=back
+
+
+
+=head2 class - Override implementation of element
+
+Perl class name used to override the implementation of the configuration element. This override Perl class must inherit a Config::Model class that matches the element type, i.e. Config::Model::Value, Config::Model::HashId or Config::Model::ListId. Use with care. I<< Optional. Type uniline. >>
+
+=head2 morph
+
+When set, a recurse copy of the value from the old object to the new object is attemped. Old values are dropped when a copy is not possible (usually because of mismatching types) I<< Optional. Type boolean. >>
+
+=head2 refer_to
+
+points to an array or hash element in the configuration tree using the path syntax. The available choice of this reference value (or check list)is made from the available keys of the pointed hash element or the values of the pointed array element. I<< Optional. Type uniline. >>
+
+=head2 computed_refer_to
+
+points to an array or hash element in the configuration tree using a path computed with value from several other elements in the configuration tree. The available choice of this reference value (or check list) is made from the available keys of the pointed hash element or the values of the pointed array element. I<< Optional. Type warped_node. >>
+
+=head2 replace_follow
+
+Path specifying a hash of value element in the configuration tree. The hash if used in a way similar to the replace parameter. In this case, the replacement is not coded in the model but specified by the configuration. I<< Optional. Type uniline. >>
+
+=head2 compute
+
+compute the default value according to a formula and value from other elements in the configuration tree. I<< Optional. Type warped_node. >>
+
+=head2 migrate_from
+
+Specify an upgrade path from an old value and compute the value to store in the new element. I<< Optional. Type warped_node. >>
+
+=head2 write_as
+
+Specify how to write a boolean value. Example 'no' 'yes'. I<< Optional. Type list of uniline. >>
+
+=head2 migrate_values_from
+
+Specifies that the values of the hash or list are copied from another hash or list in the configuration tree once configuration data are loaded. I<< Optional. Type uniline. >>
+
+=head2 migrate_keys_from
+
+Specifies that the keys of the hash are copied from another hash in the configuration tree only when the hash is created. I<< Optional. Type uniline. >>
+
+=head2 mandatory
+
+I<< Optional. Type boolean. >>
+
+=head2 config_class_name
+
+I<< Optional. Type reference. >>
+
+=head2 choice
+
+Specify the possible values. I<< Optional. Type list of uniline. >>
+
+=head2 min
+
+minimum value. I<< Optional. Type number. >>
+
+=head2 max
+
+maximum value. I<< Optional. Type number. >>
+
+=head2 min_index
+
+minimum number of keys. I<< Optional. Type integer. >>
+
+=head2 max_index
+
+maximum number of keys. I<< Optional. Type integer. >>
+
+=head2 default
+
+Specify default value. This default value is written in the configuration data. I<< Optional. Type string. >>
+
+=head2 upstream_default
+
+Another way to specify a default value. But this default value is considered as "built_in" the application and is not written in the configuration data (unless modified) I<< Optional. Type string. >>
+
+=head2 convert
+
+Convert value or index to uppercase (uc) or lowercase (lc). I<< Optional. Type enum. >>
+
+=head2 match
+
+Perl regular expression to assert the validity of the value. To check the whole value, use C<^> and C<$>. For instance C<^foo|bar$> allows C<foo> or C<bar> but not C<foobar>. To be case insentive, use the C<(?i)> extended pattern. For instance, the regexp C<^(?i)foo|bar$> also allows the values C<Foo> and C<Bar>. I<< Optional. Type uniline. >>
+
+=head2 assert
+
+Raise an error if the test code snippet does returns false. Note this snippet is also run on undefined value, which may not be what you want. I<< Optional. Type hash of node of class L<Itself::CommonElement::Assert|Config::Model::models::Itself::CommonElement::Assert> . >>
+
+=head2 warn_if
+
+Warn user if the code snippet returns true. I<< Optional. Type hash of node of class L<Itself::CommonElement::Assert|Config::Model::models::Itself::CommonElement::Assert> . >>
+
+=head2 warn_unless
+
+Warn user if the code snippet returns false. I<< Optional. Type hash of node of class L<Itself::CommonElement::Assert|Config::Model::models::Itself::CommonElement::Assert> . >>
+
+=head2 warn_if_match
+
+Warn user if a I<defined> value matches the regular expression. I<< Optional. Type hash of node of class L<Itself::CommonElement::WarnIfMatch|Config::Model::models::Itself::CommonElement::WarnIfMatch> . >>
+
+=head2 warn_unless_match
+
+Warn user if I<defined> value does not match the regular expression. I<< Optional. Type hash of node of class L<Itself::CommonElement::WarnIfMatch|Config::Model::models::Itself::CommonElement::WarnIfMatch> . >>
+
+=head2 warn
+
+Unconditionally issue a warning with this string when this parameter is used. This should be used mostly with "accept" I<< Optional. Type string. >>
+
+=head2 grammar
+
+Feed this grammar to Parse::RecDescent to perform validation. I<< Optional. Type string. >>
+
+=head2 default_list
+
+Specify items checked by default. I<< Optional. Type check_list. >>
+
+=head2 upstream_default_list
+
+Specify items checked by default in the application. I<< Optional. Type check_list. >>
+
+=head2 allow_keys_from
+
+this hash allows keys from the keys of the hash pointed by the path string. I<< Optional. Type uniline. >>
+
+=head2 allow_keys_matching
+
+Keys must match the specified regular expression. I<< Optional. Type uniline. >>
+
+=head2 follow_keys_from
+
+this hash contains the same keys as the hash pointed by the path string. I<< Optional. Type uniline. >>
+
+=head2 warn_if_key_match
+
+Warn user if a key is created matching this regular expression. I<< Optional. Type uniline. >>
+
+=head2 warn_unless_key_match
+
+Warn user if a key is created not matching this regular expression. I<< Optional. Type uniline. >>
+
+=head2 ordered
+
+keep track of the order of the elements of this hash. I<< Optional. Type boolean. >>
+
+=head2 default_keys
+
+default keys hashes. I<< Optional. Type list of string. >>
+
+=head2 auto_create_keys
+
+always create a set of keys specified in this list. I<< Optional. Type list of string. >>
+
+=head2 allow_keys
+
+specify a set of allowed keys. I<< Optional. Type list of string. >>
+
+=head2 auto_create_ids
+
+always create the number of id specified in this integer. I<< Optional. Type string. >>
+
+=head2 default_with_init
+
+specify a set of keys to create and initialization on some elements . E.g. ' foo => "X=Av Y=Bv", bar => "Y=Av Z=Cz"' I<< Optional. Type hash of string. >>
+
+=head2 max_nb
+
+I<< Optional. Type integer. >>
+
+=head2 replace
+
+Used for enum to substitute one value with another. This parameter must be used to enable user to upgrade a configuration with obsolete values. The old value is the key of the hash, the new one is the value of the hash. I<< Optional. Type hash of string. >>
+
+=head2 duplicates
+
+Specify the policy regarding duplicated values stored in the list or as hash values (valid only when cargo type is "leaf"). The policy can be "allow" (default), "suppress", "warn" (which offers the possibility to apply a fix), "forbid". I<< Optional. Type enum. choice: 'allow', 'suppress', 'warn', 'forbid'. upstream_default: 'allow'. >>
+
+=head2 help
+
+Specify help string specific to possible values. E.g for "light" value, you could write " red => 'stop', green => 'walk' I<< Optional. Type hash of string. >>
+
+=head2 status
+
+I<< Optional. Type enum. choice: 'obsolete', 'deprecated', 'standard'. upstream_default: 'standard'. >>
+
+=head2 level
+
+Used to highlight important parameter or to hide others. Hidden parameter are mostly used to hide features that are unavailable at start time. They can be made available later using warp mechanism. I<< Optional. Type enum. choice: 'important', 'normal', 'hidden'. upstream_default: 'normal'. >>
+
+=head2 summary
+
+enter short information regarding this element. I<< Optional. Type uniline. >>
+
+=head2 description
+
+enter detailed help information regarding this element. I<< Optional. Type string. >>
+
+=head2 warp
+
+change the properties (i.e. default value or its value_type) dynamically according to the value of another Value object located elsewhere in the configuration tree. I<< Optional. Type warped_node of class L<Itself::WarpValue|Config::Model::models::Itself::WarpValue> . >>
+
+=head2 index_type
+
+Specify the type of allowed index for the hash. "String" means no restriction. I<< Optional. Type enum. >>
+
+=head2 cargo
+
+Specify the properties of the configuration element configuration in this hash or list. I<< Optional. Type warped_node. >>
+
+=head1 SEE ALSO
+
+=over
+
+=item *
+
+L<cme>
+
+=item *
+
+L<Config::Model::models::Itself::CommonElement::Assert>
+
+=item *
+
+L<Config::Model::models::Itself::CommonElement::WarnIfMatch>
+
+=item *
+
+L<Config::Model::models::Itself::WarpValue>
+
+=back
+
+=cut
+
diff --git a/lib/Config/Model/models/Itself/ConfigRead.pod b/lib/Config/Model/models/Itself/ConfigRead.pod
new file mode 100644
index 0000000..371c2c2
--- /dev/null
+++ b/lib/Config/Model/models/Itself/ConfigRead.pod
@@ -0,0 +1,154 @@
+# PODNAME: Config::Model::models::Itself::ConfigRead
+# ABSTRACT: Configuration class Itself::ConfigRead
+=encoding utf8
+
+=head1 NAME
+
+Config::Model::models::Itself::ConfigRead - Configuration class Itself::ConfigRead
+
+=head1 DESCRIPTION
+
+Configuration classes used by L<Config::Model>
+
+=head1 Elements
+
+=head2 syntax
+
+Deprecated parameter that specified the file syntax to store permanently configuration data. Replaced by "backend" B<Deprecated> I<< Optional. Type enum. choice: 'cds', 'perl', 'ini', 'custom'. >>
+
+=head2 backend
+
+specifies the backend to store permanently configuration data. I<< Optional. Type enum. choice: 'cds_file', 'perl_file', 'custom'. >>
+
+Here are some explanations on the possible values:
+
+=over
+
+=item 'IniFile'
+
+Ini file format. Beware that the structure of your model must match the limitations of the INI file format, i.e only a 2 levels hierarchy. Configuration filename is made with instance name
+
+=item 'cds_file'
+
+file with config data string. This is Config::Model own serialisation format, designed to be compact and readable. Configuration filename is made with instance name
+
+=item 'custom'
+
+Custom format. You must specify your own class and method to perform the read or write function. See Config::Model::AutoRead doc for more details
+
+=item 'perl_file'
+
+file with a perl data structure. Configuration filename is made with instance name
+
+=back
+
+
+
+Note: backend is migrated with 'C<$old>' and with $old => "C<- syntax>"
+
+=head2 config_dir
+
+I<< Optional. Type uniline. >>
+
+=head2 os_config_dir - configuration file directory for specific OS
+
+Specify and alternate location of a configuration directory depending on the OS (as returned by C<$^O> or C<$Config{'osname'}>, see L<perlport/PLATFORMS>) Common values for C<$^O> are 'linux', 'MSWin32', 'darwin' I<< Optional. Type hash of uniline. >>
+
+=head2 file - target configuration file name
+
+specify the configuration file name. This parameter may not be applicable depending on your application. It may also be hardcoded in a custom backend. If not specified, the instance name is used as base name for your configuration file. The configuration file namecan be specified with &index keyword when a backend is associated to a node contained in a hash. See L<backend specifications|http://search.cpan.org/dist/Config-Model/lib/Config/Model/BackendMgr.pm#Backend_specification>. I<< Op [...]
+
+=head2 file_mode - configuration file mode
+
+specify the configuration file mode. C<file_mode> parameter can be used to set the mode of the written file. C<file_mode> value can be in any form suppported by L<Path::Tiny/chmod>. I<< Optional. Type uniline. >>
+
+=head2 default_layer - How to find default values in a global config file
+
+Specifies where to find a global configuration file that specifies default values. For instance, this is used by OpenSSH to specify a global configuration file (C</etc/ssh/ssh_config>) that is overridden by user's file. I<< Optional. Type node of class L<Itself::ConfigWR::DefaultLayer|Config::Model::models::Itself::ConfigWR::DefaultLayer> . >>
+
+=head2 class
+
+I<< Optional. Type uniline. >>
+
+=head2 store_class_in_hash
+
+Specify element hash name that contains all INI classes. See L<Config::Model::Backend::IniFile/"Arbitrary class name"> I<< Optional. Type uniline. >>
+
+=head2 section_map
+
+Specify element name that contains one INI class. E.g. to store INI class [foo] in element Foo, specify { foo => "Foo" } I<< Optional. Type hash of uniline. >>
+
+=head2 split_list_value
+
+Regexp to split the value read from ini file. Usually "\s+" or "[,\s]" I<< Optional. Type uniline. >>
+
+=head2 split_check_list_value
+
+Regexp to split the value read from ini file. Usually "\s+" or "[,\s]" I<< Optional. Type uniline. >>
+
+=head2 join_list_value
+
+string to join list values before writing the entry in ini file. Usually " " or ", " I<< Optional. Type uniline. >>
+
+=head2 join_check_list_value
+
+string to join checked items names before writing the entry in the ini file. Usually " " or ", " I<< Optional. Type uniline. >>
+
+=head2 write_boolean_as
+
+Specify how to write a boolean value in config file. Suggested values are "no","yes". I<< Optional. Type list of uniline. >>
+
+=head2 force_lc_section
+
+force section to be lowercase. I<< Optional. Type boolean. upstream_default: '0'. >>
+
+=head2 force_lc_key
+
+force key names to be lowercase. I<< Optional. Type boolean. upstream_default: '0'. >>
+
+=head2 force_lc_value
+
+force values to be lowercase. I<< Optional. Type boolean. upstream_default: '0'. >>
+
+=head2 full_dump
+
+Also dump default values in the data structure. Useful if the dumped configuration data will be used by the application. (default is yes) I<< Optional. Type boolean. upstream_default: '1'. >>
+
+=head2 comment_delimiter
+
+list of characters that start a comment. When more that one character is used. the first one is used to write back comment. For instance, value "#;" indicate that a comments can start with "#" or ";" and that all comments are written back with "#". I<< Optional. Type uniline. upstream_default: '#'. >>
+
+=head2 auto_delete - Delete empty configuration file
+
+Delete configuration files when no information is left in there. This may happen when data is removed by user. This is mostly useful when the configuration of an application is made of several files. I<< Optional. Type boolean. upstream_default: '0'. >>
+
+=head2 function
+
+I<< Optional. Type uniline. >>
+
+=head2 auto_create - Creates configuration files as needed
+
+I<< Optional. Type boolean. upstream_default: '0'. >>
+
+Note: auto_create is migrated with 'C<$old>' and with $old => "C<- allow_empty>"
+
+=head2 allow_empty - deprecated in favor of auto_create
+
+B<Deprecated> I<< Optional. Type boolean. upstream_default: '0'. >>
+
+=head1 SEE ALSO
+
+=over
+
+=item *
+
+L<cme>
+
+=item *
+
+L<Config::Model::models::Itself::ConfigWR::DefaultLayer>
+
+=back
+
+=cut
+
diff --git a/lib/Config/Model/models/Itself/ConfigWR/DefaultLayer.pod b/lib/Config/Model/models/Itself/ConfigWR/DefaultLayer.pod
new file mode 100644
index 0000000..0ab8410
--- /dev/null
+++ b/lib/Config/Model/models/Itself/ConfigWR/DefaultLayer.pod
@@ -0,0 +1,38 @@
+# PODNAME: Config::Model::models::Itself::ConfigWR::DefaultLayer
+# ABSTRACT: Configuration class Itself::ConfigWR::DefaultLayer
+=encoding utf8
+
+=head1 NAME
+
+Config::Model::models::Itself::ConfigWR::DefaultLayer - Configuration class Itself::ConfigWR::DefaultLayer
+
+=head1 DESCRIPTION
+
+Configuration classes used by L<Config::Model>
+
+=head1 Elements
+
+=head2 config_dir
+
+I<< Optional. Type uniline. >>
+
+=head2 os_config_dir - configuration file directory for specific OS
+
+Specify and alternate location of a configuration directory depending on the OS (as returned by C<$^O> or C<$Config{'osname'}>, see L<perlport/PLATFORMS>) Common values for C<$^O> are 'linux', 'MSWin32', 'darwin' I<< Optional. Type hash of uniline. >>
+
+=head2 file - target configuration file name
+
+specify the configuration file name. This parameter may not be applicable depending on your application. It may also be hardcoded in a custom backend. If not specified, the instance name is used as base name for your configuration file. The configuration file namecan be specified with &index keyword when a backend is associated to a node contained in a hash. See L<backend specifications|http://search.cpan.org/dist/Config-Model/lib/Config/Model/BackendMgr.pm#Backend_specification>. I<< Op [...]
+
+=head1 SEE ALSO
+
+=over
+
+=item *
+
+L<cme>
+
+=back
+
+=cut
+
diff --git a/lib/Config/Model/models/Itself/ConfigWrite.pod b/lib/Config/Model/models/Itself/ConfigWrite.pod
new file mode 100644
index 0000000..2c760d5
--- /dev/null
+++ b/lib/Config/Model/models/Itself/ConfigWrite.pod
@@ -0,0 +1,148 @@
+# PODNAME: Config::Model::models::Itself::ConfigWrite
+# ABSTRACT: Configuration class Itself::ConfigWrite
+=encoding utf8
+
+=head1 NAME
+
+Config::Model::models::Itself::ConfigWrite - Configuration class Itself::ConfigWrite
+
+=head1 DESCRIPTION
+
+Configuration classes used by L<Config::Model>
+
+=head1 Elements
+
+=head2 syntax
+
+Deprecated parameter that specified the file syntax to store permanently configuration data. Replaced by "backend" B<Deprecated> I<< Optional. Type enum. choice: 'cds', 'perl', 'ini', 'custom'. >>
+
+=head2 backend
+
+specifies the backend to store permanently configuration data. I<< Optional. Type enum. choice: 'cds_file', 'perl_file', 'custom'. >>
+
+Here are some explanations on the possible values:
+
+=over
+
+=item 'IniFile'
+
+Ini file format. Beware that the structure of your model must match the limitations of the INI file format, i.e only a 2 levels hierarchy. Configuration filename is made with instance name
+
+=item 'cds_file'
+
+file with config data string. This is Config::Model own serialisation format, designed to be compact and readable. Configuration filename is made with instance name
+
+=item 'custom'
+
+Custom format. You must specify your own class and method to perform the read or write function. See Config::Model::AutoRead doc for more details
+
+=item 'perl_file'
+
+file with a perl data structure. Configuration filename is made with instance name
+
+=back
+
+
+
+Note: backend is migrated with 'C<$old>' and with $old => "C<- syntax>"
+
+=head2 config_dir
+
+I<< Optional. Type uniline. >>
+
+=head2 os_config_dir - configuration file directory for specific OS
+
+Specify and alternate location of a configuration directory depending on the OS (as returned by C<$^O> or C<$Config{'osname'}>, see L<perlport/PLATFORMS>) Common values for C<$^O> are 'linux', 'MSWin32', 'darwin' I<< Optional. Type hash of uniline. >>
+
+=head2 file - target configuration file name
+
+specify the configuration file name. This parameter may not be applicable depending on your application. It may also be hardcoded in a custom backend. If not specified, the instance name is used as base name for your configuration file. The configuration file namecan be specified with &index keyword when a backend is associated to a node contained in a hash. See L<backend specifications|http://search.cpan.org/dist/Config-Model/lib/Config/Model/BackendMgr.pm#Backend_specification>. I<< Op [...]
+
+=head2 file_mode - configuration file mode
+
+specify the configuration file mode. C<file_mode> parameter can be used to set the mode of the written file. C<file_mode> value can be in any form suppported by L<Path::Tiny/chmod>. I<< Optional. Type uniline. >>
+
+=head2 default_layer - How to find default values in a global config file
+
+Specifies where to find a global configuration file that specifies default values. For instance, this is used by OpenSSH to specify a global configuration file (C</etc/ssh/ssh_config>) that is overridden by user's file. I<< Optional. Type node of class L<Itself::ConfigWR::DefaultLayer|Config::Model::models::Itself::ConfigWR::DefaultLayer> . >>
+
+=head2 class
+
+I<< Optional. Type uniline. >>
+
+=head2 store_class_in_hash
+
+Specify element hash name that contains all INI classes. See L<Config::Model::Backend::IniFile/"Arbitrary class name"> I<< Optional. Type uniline. >>
+
+=head2 section_map
+
+Specify element name that contains one INI class. E.g. to store INI class [foo] in element Foo, specify { foo => "Foo" } I<< Optional. Type hash of uniline. >>
+
+=head2 split_list_value
+
+Regexp to split the value read from ini file. Usually "\s+" or "[,\s]" I<< Optional. Type uniline. >>
+
+=head2 split_check_list_value
+
+Regexp to split the value read from ini file. Usually "\s+" or "[,\s]" I<< Optional. Type uniline. >>
+
+=head2 join_list_value
+
+string to join list values before writing the entry in ini file. Usually " " or ", " I<< Optional. Type uniline. >>
+
+=head2 join_check_list_value
+
+string to join checked items names before writing the entry in the ini file. Usually " " or ", " I<< Optional. Type uniline. >>
+
+=head2 write_boolean_as
+
+Specify how to write a boolean value in config file. Suggested values are "no","yes". I<< Optional. Type list of uniline. >>
+
+=head2 force_lc_section
+
+force section to be lowercase. I<< Optional. Type boolean. upstream_default: '0'. >>
+
+=head2 force_lc_key
+
+force key names to be lowercase. I<< Optional. Type boolean. upstream_default: '0'. >>
+
+=head2 force_lc_value
+
+force values to be lowercase. I<< Optional. Type boolean. upstream_default: '0'. >>
+
+=head2 full_dump
+
+Also dump default values in the data structure. Useful if the dumped configuration data will be used by the application. (default is yes) I<< Optional. Type boolean. upstream_default: '1'. >>
+
+=head2 comment_delimiter
+
+list of characters that start a comment. When more that one character is used. the first one is used to write back comment. For instance, value "#;" indicate that a comments can start with "#" or ";" and that all comments are written back with "#". I<< Optional. Type uniline. upstream_default: '#'. >>
+
+=head2 auto_delete - Delete empty configuration file
+
+Delete configuration files when no information is left in there. This may happen when data is removed by user. This is mostly useful when the configuration of an application is made of several files. I<< Optional. Type boolean. upstream_default: '0'. >>
+
+=head2 function
+
+I<< Optional. Type uniline. >>
+
+=head2 auto_create - Creates configuration files as needed
+
+I<< Optional. Type boolean. upstream_default: '0'. >>
+
+=head1 SEE ALSO
+
+=over
+
+=item *
+
+L<cme>
+
+=item *
+
+L<Config::Model::models::Itself::ConfigWR::DefaultLayer>
+
+=back
+
+=cut
+
diff --git a/lib/Config/Model/models/Itself/Element.pl b/lib/Config/Model/models/Itself/Element.pl
new file mode 100644
index 0000000..8120511
--- /dev/null
+++ b/lib/Config/Model/models/Itself/Element.pl
@@ -0,0 +1,126 @@
+#
+# This file is part of Config-Model-Itself
+#
+# This software is Copyright (c) 2007-2017 by Dominique Dumont.
+#
+# This is free software, licensed under:
+#
+# The GNU Lesser General Public License, Version 2.1, February 1999
+#
+# Copyright (c) 2007-2008 Dominique Dumont.
+#
+# This file is part of Config-Model-Itself.
+#
+# Config-Model-Itself is free software; you can redistribute it
+# and/or modify it under the terms of the GNU Lesser Public License
+# as published by the Free Software Foundation; either version 2.1
+# of the License, or (at your option) any later version.
+#
+# Config-Model-Itself is distributed in the hope that it will be
+# useful, but WITHOUT ANY WARRANTY; without even the implied
+# warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+# See the GNU Lesser Public License for more details.
+#
+# You should have received a copy of the GNU Lesser Public License
+# along with Config-Model-Itself; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+
+[
+ [
+ name => "Itself::Element",
+
+ include => ['Itself::NonWarpableElement' ,'Itself::WarpableElement'],
+ include_after => 'type' ,
+
+ 'element'
+ => [
+
+ # structural information
+ 'type' => { type => 'leaf',
+ value_type => 'enum',
+ choice => [qw/node warped_node hash list leaf check_list/],
+ mandatory => 1 ,
+ description => 'specify the type of the configuration element.'
+ . 'Leaf is used for plain value.',
+ },
+
+ # all elements
+ 'status'
+ => {
+ type => 'leaf',
+ value_type => 'enum',
+ choice => [qw/obsolete deprecated standard/],
+ upstream_default => 'standard' ,
+ },
+
+ 'level'
+ => {
+ type => 'leaf',
+ value_type => 'enum',
+ choice => [qw/important normal hidden/] ,
+ upstream_default => 'normal',
+ description => 'Used to highlight important parameter or to hide others. Hidden parameter are mostly used to hide features that are unavailable at start time. They can be made available later using warp mechanism',
+ },
+
+ 'summary'
+ => {
+ type => 'leaf',
+ value_type => 'uniline',
+ description => 'enter short information regarding this element',
+ },
+
+ 'description'
+ => {
+ type => 'leaf',
+ value_type => 'string',
+ description => 'enter detailed help information regarding this element',
+ },
+
+ # all but node or warped_node
+ 'warp' => {
+ type => 'warped_node',
+ level => 'hidden',
+ config_class_name => 'Itself::WarpValue',
+ warp => {
+ follow => { elt_type => '- type' },
+ rules => [
+ '$elt_type ne "node"' => { level => 'normal' }
+ ]
+ },
+ description => "change the properties (i.e. default value or its value_type) dynamically according to the value of another Value object located elsewhere in the configuration tree. "
+ },
+
+ # hash or list
+ 'index_type'
+ => { type => 'leaf',
+ value_type => 'enum',
+ level => 'hidden' ,
+ warp => { follow => '?type',
+ 'rules'
+ => { 'hash' => {
+ level => 'important',
+ mandatory => 1,
+ choice => [qw/string integer/] ,
+ }
+ }
+ },
+ description => 'Specify the type of allowed index for the hash. "String" means no restriction.',
+ },
+
+ 'cargo' => {
+ type => 'warped_node',
+ level => 'hidden',
+ warp => {
+ follow => { 't' => '- type' },
+ 'rules' => [
+ '$t eq "list" or $t eq "hash"' => {
+ level => 'normal',
+ config_class_name => 'Itself::CargoElement',
+ },
+ ],
+ },
+ description => 'Specify the properties of the configuration element configuration in this hash or list',
+ }
+ ],
+ ],
+];
diff --git a/lib/Config/Model/models/Itself/Element.pod b/lib/Config/Model/models/Itself/Element.pod
new file mode 100644
index 0000000..42adc3c
--- /dev/null
+++ b/lib/Config/Model/models/Itself/Element.pod
@@ -0,0 +1,270 @@
+# PODNAME: Config::Model::models::Itself::Element
+# ABSTRACT: Configuration class Itself::Element
+=encoding utf8
+
+=head1 NAME
+
+Config::Model::models::Itself::Element - Configuration class Itself::Element
+
+=head1 DESCRIPTION
+
+Configuration classes used by L<Config::Model>
+
+=head1 Elements
+
+=head2 type
+
+specify the type of the configuration element.Leaf is used for plain value. I<< Mandatory. Type enum. choice: 'node', 'warped_node', 'hash', 'list', 'leaf', 'check_list'. >>
+
+=head2 value_type
+
+I<< Optional. Type enum. choice: 'boolean', 'enum', 'integer', 'reference', 'number', 'uniline', 'string', 'file', 'dir'. >>
+
+Here are some explanations on the possible values:
+
+=over
+
+=item 'integer'
+
+positive or negative integer
+
+=item 'uniline'
+
+string with no embedded newline
+
+=back
+
+
+
+=head2 class - Override implementation of element
+
+Perl class name used to override the implementation of the configuration element. This override Perl class must inherit a Config::Model class that matches the element type, i.e. Config::Model::Value, Config::Model::HashId or Config::Model::ListId. Use with care. I<< Optional. Type uniline. >>
+
+=head2 morph
+
+When set, a recurse copy of the value from the old object to the new object is attemped. Old values are dropped when a copy is not possible (usually because of mismatching types) I<< Optional. Type boolean. >>
+
+=head2 refer_to
+
+points to an array or hash element in the configuration tree using the path syntax. The available choice of this reference value (or check list)is made from the available keys of the pointed hash element or the values of the pointed array element. I<< Optional. Type uniline. >>
+
+=head2 computed_refer_to
+
+points to an array or hash element in the configuration tree using a path computed with value from several other elements in the configuration tree. The available choice of this reference value (or check list) is made from the available keys of the pointed hash element or the values of the pointed array element. I<< Optional. Type warped_node. >>
+
+=head2 replace_follow
+
+Path specifying a hash of value element in the configuration tree. The hash if used in a way similar to the replace parameter. In this case, the replacement is not coded in the model but specified by the configuration. I<< Optional. Type uniline. >>
+
+=head2 compute
+
+compute the default value according to a formula and value from other elements in the configuration tree. I<< Optional. Type warped_node. >>
+
+=head2 migrate_from
+
+Specify an upgrade path from an old value and compute the value to store in the new element. I<< Optional. Type warped_node. >>
+
+=head2 write_as
+
+Specify how to write a boolean value. Example 'no' 'yes'. I<< Optional. Type list of uniline. >>
+
+=head2 migrate_values_from
+
+Specifies that the values of the hash or list are copied from another hash or list in the configuration tree once configuration data are loaded. I<< Optional. Type uniline. >>
+
+=head2 migrate_keys_from
+
+Specifies that the keys of the hash are copied from another hash in the configuration tree only when the hash is created. I<< Optional. Type uniline. >>
+
+=head2 mandatory
+
+I<< Optional. Type boolean. >>
+
+=head2 config_class_name
+
+I<< Optional. Type reference. >>
+
+=head2 choice
+
+Specify the possible values. I<< Optional. Type list of uniline. >>
+
+=head2 min
+
+minimum value. I<< Optional. Type number. >>
+
+=head2 max
+
+maximum value. I<< Optional. Type number. >>
+
+=head2 min_index
+
+minimum number of keys. I<< Optional. Type integer. >>
+
+=head2 max_index
+
+maximum number of keys. I<< Optional. Type integer. >>
+
+=head2 default
+
+Specify default value. This default value is written in the configuration data. I<< Optional. Type string. >>
+
+=head2 upstream_default
+
+Another way to specify a default value. But this default value is considered as "built_in" the application and is not written in the configuration data (unless modified) I<< Optional. Type string. >>
+
+=head2 convert
+
+Convert value or index to uppercase (uc) or lowercase (lc). I<< Optional. Type enum. >>
+
+=head2 match
+
+Perl regular expression to assert the validity of the value. To check the whole value, use C<^> and C<$>. For instance C<^foo|bar$> allows C<foo> or C<bar> but not C<foobar>. To be case insentive, use the C<(?i)> extended pattern. For instance, the regexp C<^(?i)foo|bar$> also allows the values C<Foo> and C<Bar>. I<< Optional. Type uniline. >>
+
+=head2 assert
+
+Raise an error if the test code snippet does returns false. Note this snippet is also run on undefined value, which may not be what you want. I<< Optional. Type hash of node of class L<Itself::CommonElement::Assert|Config::Model::models::Itself::CommonElement::Assert> . >>
+
+=head2 warn_if
+
+Warn user if the code snippet returns true. I<< Optional. Type hash of node of class L<Itself::CommonElement::Assert|Config::Model::models::Itself::CommonElement::Assert> . >>
+
+=head2 warn_unless
+
+Warn user if the code snippet returns false. I<< Optional. Type hash of node of class L<Itself::CommonElement::Assert|Config::Model::models::Itself::CommonElement::Assert> . >>
+
+=head2 warn_if_match
+
+Warn user if a I<defined> value matches the regular expression. I<< Optional. Type hash of node of class L<Itself::CommonElement::WarnIfMatch|Config::Model::models::Itself::CommonElement::WarnIfMatch> . >>
+
+=head2 warn_unless_match
+
+Warn user if I<defined> value does not match the regular expression. I<< Optional. Type hash of node of class L<Itself::CommonElement::WarnIfMatch|Config::Model::models::Itself::CommonElement::WarnIfMatch> . >>
+
+=head2 warn
+
+Unconditionally issue a warning with this string when this parameter is used. This should be used mostly with "accept" I<< Optional. Type string. >>
+
+=head2 grammar
+
+Feed this grammar to Parse::RecDescent to perform validation. I<< Optional. Type string. >>
+
+=head2 default_list
+
+Specify items checked by default. I<< Optional. Type check_list. >>
+
+=head2 upstream_default_list
+
+Specify items checked by default in the application. I<< Optional. Type check_list. >>
+
+=head2 allow_keys_from
+
+this hash allows keys from the keys of the hash pointed by the path string. I<< Optional. Type uniline. >>
+
+=head2 allow_keys_matching
+
+Keys must match the specified regular expression. I<< Optional. Type uniline. >>
+
+=head2 follow_keys_from
+
+this hash contains the same keys as the hash pointed by the path string. I<< Optional. Type uniline. >>
+
+=head2 warn_if_key_match
+
+Warn user if a key is created matching this regular expression. I<< Optional. Type uniline. >>
+
+=head2 warn_unless_key_match
+
+Warn user if a key is created not matching this regular expression. I<< Optional. Type uniline. >>
+
+=head2 ordered
+
+keep track of the order of the elements of this hash. I<< Optional. Type boolean. >>
+
+=head2 default_keys
+
+default keys hashes. I<< Optional. Type list of string. >>
+
+=head2 auto_create_keys
+
+always create a set of keys specified in this list. I<< Optional. Type list of string. >>
+
+=head2 allow_keys
+
+specify a set of allowed keys. I<< Optional. Type list of string. >>
+
+=head2 auto_create_ids
+
+always create the number of id specified in this integer. I<< Optional. Type string. >>
+
+=head2 default_with_init
+
+specify a set of keys to create and initialization on some elements . E.g. ' foo => "X=Av Y=Bv", bar => "Y=Av Z=Cz"' I<< Optional. Type hash of string. >>
+
+=head2 max_nb
+
+I<< Optional. Type integer. >>
+
+=head2 replace
+
+Used for enum to substitute one value with another. This parameter must be used to enable user to upgrade a configuration with obsolete values. The old value is the key of the hash, the new one is the value of the hash. I<< Optional. Type hash of string. >>
+
+=head2 duplicates
+
+Specify the policy regarding duplicated values stored in the list or as hash values (valid only when cargo type is "leaf"). The policy can be "allow" (default), "suppress", "warn" (which offers the possibility to apply a fix), "forbid". I<< Optional. Type enum. choice: 'allow', 'suppress', 'warn', 'forbid'. upstream_default: 'allow'. >>
+
+=head2 help
+
+Specify help string specific to possible values. E.g for "light" value, you could write " red => 'stop', green => 'walk' I<< Optional. Type hash of string. >>
+
+=head2 status
+
+I<< Optional. Type enum. choice: 'obsolete', 'deprecated', 'standard'. upstream_default: 'standard'. >>
+
+=head2 level
+
+Used to highlight important parameter or to hide others. Hidden parameter are mostly used to hide features that are unavailable at start time. They can be made available later using warp mechanism. I<< Optional. Type enum. choice: 'important', 'normal', 'hidden'. upstream_default: 'normal'. >>
+
+=head2 summary
+
+enter short information regarding this element. I<< Optional. Type uniline. >>
+
+=head2 description
+
+enter detailed help information regarding this element. I<< Optional. Type string. >>
+
+=head2 warp
+
+change the properties (i.e. default value or its value_type) dynamically according to the value of another Value object located elsewhere in the configuration tree. I<< Optional. Type warped_node of class L<Itself::WarpValue|Config::Model::models::Itself::WarpValue> . >>
+
+=head2 index_type
+
+Specify the type of allowed index for the hash. "String" means no restriction. I<< Optional. Type enum. >>
+
+=head2 cargo
+
+Specify the properties of the configuration element configuration in this hash or list. I<< Optional. Type warped_node. >>
+
+=head1 SEE ALSO
+
+=over
+
+=item *
+
+L<cme>
+
+=item *
+
+L<Config::Model::models::Itself::CommonElement::Assert>
+
+=item *
+
+L<Config::Model::models::Itself::CommonElement::WarnIfMatch>
+
+=item *
+
+L<Config::Model::models::Itself::WarpValue>
+
+=back
+
+=cut
+
diff --git a/lib/Config/Model/models/Itself/MigratedValue.pl b/lib/Config/Model/models/Itself/MigratedValue.pl
new file mode 100644
index 0000000..869604b
--- /dev/null
+++ b/lib/Config/Model/models/Itself/MigratedValue.pl
@@ -0,0 +1,68 @@
+#
+# This file is part of Config-Model-Itself
+#
+# This software is Copyright (c) 2007-2017 by Dominique Dumont.
+#
+# This is free software, licensed under:
+#
+# The GNU Lesser General Public License, Version 2.1, February 1999
+#
+
+[
+ [
+ name => "Itself::MigratedValue",
+
+ element => [
+ variables => {
+ type => 'hash',
+ index_type => 'string' ,
+ cargo => { type => 'leaf', value_type => 'uniline' } ,
+ description => 'Specify where to find the variables using path notation. For the formula '
+ .'"$a + $b", you need to specify "a => \'- a_path\', b => \'! b_path\'. '
+ .'Functions like C<&index()> are allowed. '
+ .'For more details, see L<doc|Config::Model::ValueComputer.pm/"Compute variables"> ',
+ },
+
+ formula => {
+ type => 'leaf',
+ value_type => 'string',
+ # making formula mandatory makes mandatory setting the
+ # compute parameter for a leaf. That's not a
+ # desired behavior.
+ # mandatory => 1 ,
+ description => 'Specify how the computation is done. This string can a Perl expression for '
+ .'integer value or a template for string values. Variables have the same notation '
+ .'than in Perl. Example "$a + $b". '
+ .'Functions like C<&index()> are allowed. '
+ .'For more details, see L<doc|Config::Model::ValueComputer.pm/"Compute formula"> ',
+ },
+ replace => {
+ type => 'hash',
+ index_type => 'string' ,
+ cargo => { type => 'leaf', value_type => 'string' } ,
+ description => 'Sometime, using the value of a tree leaf is not enough and you need to '
+ .'substitute a replacement for any value you can get. This replacement can be done '
+ .'using a hash like notation within the formula using the %replace hash. Example '
+ .'$replace{$who} , where "who => \'- who_elt\'. '
+ .'For more details, see L<doc|Config::Model::ValueComputer.pm/"Compute replace">',
+ },
+
+ use_eval => {
+ type => 'leaf',
+ value_type => 'boolean',
+ upstream_default => 0,
+ description => 'Set to 1 if you need to perform more complex operations than substition, '
+ .'like extraction with regular expressions. This forces an eval by Perl when '
+ .'computing the formula. The result of the eval is used as the computed value.'
+ },
+ undef_is => {
+ type => 'leaf',
+ value_type => 'uniline',
+ description => 'Specify a replacement for undefined variables. This replaces C<undef>'
+ .' values in the formula before migrating values. Use \'\' (2 single quotes) '
+ . 'if you want to specify an empty string. '
+ .'For more details, see L<doc|Config::Model::ValueComputer.pm/"Undefined variables">',
+ },
+ ],
+ ],
+];
diff --git a/lib/Config/Model/models/Itself/Model.pl b/lib/Config/Model/models/Itself/Model.pl
new file mode 100644
index 0000000..aa7faec
--- /dev/null
+++ b/lib/Config/Model/models/Itself/Model.pl
@@ -0,0 +1,41 @@
+#
+# This file is part of Config-Model-Itself
+#
+# This software is Copyright (c) 2007-2017 by Dominique Dumont.
+#
+# This is free software, licensed under:
+#
+# The GNU Lesser General Public License, Version 2.1, February 1999
+#
+
+[
+ [
+ name => "Itself::Model",
+
+ element => [
+ class => {
+ type => 'hash',
+ index_type => 'string' ,
+ ordered => 1,
+ cargo => {
+ type => 'node',
+ config_class_name => 'Itself::Class' ,
+ },
+ },
+ application => {
+ type => 'hash',
+ index_type => 'string',
+ level => 'important',
+ cargo => {
+ type => 'node',
+ config_class_name => 'Itself::Application',
+ },
+ },
+ ],
+
+ description => [
+ class => 'A configuration model is made of several configuration classes.',
+ application => 'defines the application name provided by user to cme. E.g. cme edit <application>'
+ ],
+ ],
+];
diff --git a/lib/Config/Model/models/Itself/NonWarpableElement.pl b/lib/Config/Model/models/Itself/NonWarpableElement.pl
new file mode 100644
index 0000000..7db856b
--- /dev/null
+++ b/lib/Config/Model/models/Itself/NonWarpableElement.pl
@@ -0,0 +1,242 @@
+#
+# This file is part of Config-Model-Itself
+#
+# This software is Copyright (c) 2007-2017 by Dominique Dumont.
+#
+# This is free software, licensed under:
+#
+# The GNU Lesser General Public License, Version 2.1, February 1999
+#
+# Copyright (c) 2007-2011 Dominique Dumont.
+#
+# This file is part of Config-Model-Itself.
+#
+# Config-Model-Itself is free software; you can redistribute it
+# and/or modify it under the terms of the GNU Lesser Public License
+# as published by the Free Software Foundation; either version 2.1
+# of the License, or (at your option) any later version.
+#
+# Config-Model-Itself is distributed in the hope that it will be
+# useful, but WITHOUT ANY WARRANTY; without even the implied
+# warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+# See the GNU Lesser Public License for more details.
+#
+# You should have received a copy of the GNU Lesser Public License
+# along with Config-Model-Itself; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+
+[
+ [
+ name => 'Itself::NonWarpableElement',
+
+ # warp often depend on this one, so list it first
+ 'element' => [
+ 'value_type' => {
+ type => 'leaf',
+ level => 'hidden',
+ value_type => 'enum',
+ choice => [
+ qw/boolean enum integer reference
+ number uniline string file dir/
+ ],
+ 'warp' => {
+ follow => { 't' => '- type' },
+ 'rules' => [
+ '$t eq "leaf"' => {
+ level => 'normal',
+ mandatory => 1,
+ }
+ ]
+ },
+ help => {
+ integer => 'positive or negative integer',
+ uniline => 'string with no embedded newline',
+ }
+ },
+
+ 'class' => {
+ type => 'leaf',
+ level => 'hidden',
+ value_type => 'uniline',
+ summary => "Override implementation of element",
+ description =>
+ "Perl class name used to override the implementation of the configuration element. "
+ ."This override Perl class must inherit a Config::Model class that matches the element type, "
+ ."i.e. Config::Model::Value, Config::Model::HashId or Config::Model::ListId. "
+ ."Use with care.",
+ 'warp' => {
+ follow => { 't' => '- type' },
+ 'rules' => [ '$t and $t !~ /node/' => { level => 'normal', } ]
+ }
+ },
+
+ 'morph' => {
+ type => 'leaf',
+ level => 'hidden',
+ value_type => 'boolean',
+ 'warp' => {
+ follow => '- type',
+ 'rules' => {
+ 'warped_node' => {
+ level => 'normal',
+ upstream_default => 0,
+ },
+ }
+ },
+ description =>
+ "When set, a recurse copy of the value from the old object "
+ . "to the new object is attemped. Old values are dropped when "
+ ." a copy is not possible (usually because of mismatching types) "
+ },
+
+ # end warp elements for warped_node
+
+ # leaf element
+
+ 'refer_to' => {
+ type => 'leaf',
+ level => 'hidden',
+ value_type => 'uniline',
+ warp => {
+ follow => {
+ t => '- type',
+ vt => '- value_type',
+ },
+ 'rules' => [
+ '$t eq "check_list" or $vt eq "reference"' =>
+ { level => 'important', },
+ ]
+ },
+ description =>
+ "points to an array or hash element in the configuration "
+ . "tree using the path syntax. The available choice of this "
+ . "reference value (or check list)is made from the available "
+ . "keys of the pointed hash element or the values of the pointed array element.",
+ },
+
+ 'computed_refer_to' => {
+ type => 'warped_node',
+ level => 'hidden',
+ warp => {
+ follow => {
+ t => '- type',
+ vt => '- value_type',
+ },
+ 'rules' => [
+ '$t eq "check_list" or $vt eq "reference"' => {
+ level => 'normal',
+ config_class_name => 'Itself::ComputedValue',
+ },
+ ],
+ },
+ description =>
+ "points to an array or hash element in the configuration "
+ . "tree using a path computed with value from several other "
+ . "elements in the configuration tree. The available choice "
+ . "of this reference value (or check list) is made from the "
+ . "available keys of the pointed hash element or the values "
+ . "of the pointed array element.",
+ },
+
+ 'replace_follow' => {
+ type => 'leaf',
+ level => 'hidden',
+ value_type => 'uniline',
+ warp => {
+ follow => { t => '- type' },
+ 'rules' => [ '$t eq "leaf"' => { level => 'important', }, ]
+ },
+ description =>
+ "Path specifying a hash of value element in the configuration "
+ . "tree. The hash if used in a way similar to the replace "
+ . "parameter. In this case, the replacement is not coded "
+ . "in the model but specified by the configuration.",
+ },
+
+ 'compute' => {
+ type => 'warped_node',
+ level => 'hidden',
+
+ warp => {
+ follow => { t => '- type', },
+ 'rules' => [
+ '$t eq "leaf"' => {
+ level => 'normal',
+ config_class_name => 'Itself::ComputedValue',
+ },
+ ],
+ },
+ description =>
+ "compute the default value according to a formula and value "
+ . "from other elements in the configuration tree.",
+ },
+
+ 'migrate_from' => {
+ type => 'warped_node',
+ level => 'hidden',
+
+ warp => {
+ follow => { t => '- type', },
+ 'rules' => [
+ '$t eq "leaf"' => {
+ level => 'normal',
+ config_class_name => 'Itself::MigratedValue',
+ },
+ ],
+ },
+ description =>
+ "Specify an upgrade path from an old value and compute "
+ . "the value to store in the new element.",
+ },
+
+ 'write_as' => {
+ type => 'list',
+ level => 'hidden',
+ max_index => 1,
+
+ warp => {
+ follow => { t => '- type', vt => '- value_type'},
+ rules => [
+ '$t eq "leaf" and $vt eq "boolean"' => { level => 'normal', },
+ ]
+ },
+ cargo => {
+ type => 'leaf',
+ value_type => 'uniline',
+ },
+ description =>
+ "Specify how to write a boolean value. Example 'no' 'yes'.",
+ },
+
+ # hash or list element
+ migrate_values_from => {
+ type => 'leaf',
+ level => 'hidden',
+ value_type => 'uniline',
+ warp => {
+ follow => { 't' => '?type' },
+ 'rules' => [ '$t eq "hash" or $t eq "list"' => { level => 'normal', } ]
+ } ,
+ description => 'Specifies that the values of the hash or list are copied '
+ . 'from another hash or list in the configuration tree once configuration '
+ . 'data are loaded.',
+ },
+
+ # hash element
+ migrate_keys_from => {
+ type => 'leaf',
+ level => 'hidden',
+ value_type => 'uniline',
+ warp => {
+ follow => { 't' => '?type' },
+ 'rules' => [ '$t eq "hash"' => { level => 'normal', } ]
+ },
+ description => 'Specifies that the keys of the hash are copied from another hash '
+ . 'in the configuration tree only when the hash is created.',
+ },
+
+ # list element
+
+ ],
+ ],
+];
diff --git a/lib/Config/Model/models/Itself/WarpOnlyElement.pl b/lib/Config/Model/models/Itself/WarpOnlyElement.pl
new file mode 100644
index 0000000..33f23ae
--- /dev/null
+++ b/lib/Config/Model/models/Itself/WarpOnlyElement.pl
@@ -0,0 +1,51 @@
+#
+# This file is part of Config-Model-Itself
+#
+# This software is Copyright (c) 2007-2017 by Dominique Dumont.
+#
+# This is free software, licensed under:
+#
+# The GNU Lesser General Public License, Version 2.1, February 1999
+#
+
+[
+ [
+ name => "Itself::WarpOnlyElement",
+
+ include => 'Itself::WarpableElement' ,
+
+ 'element'
+ => [
+
+ 'level'
+ => {
+ type => 'leaf',
+ value_type => 'enum',
+ choice => [qw/important normal hidden/] ,
+ },
+
+ 'index_type'
+ => { type => 'leaf',
+ value_type => 'enum',
+ level => 'hidden' ,
+ warp => { follow => '?type',
+ 'rules'
+ => { 'hash' => {
+ level => 'important',
+ #mandatory => 1,
+ choice => [qw/string integer/] ,
+ }
+ }
+ },
+ description => 'Specify the type of allowed index for the hash. "String" means no restriction.',
+ },
+
+ ],
+
+ 'description'
+ => [
+ level => 'Used to highlight important parameter or to hide others. Hidden parameter are mostly used to hide features that are unavailable at start time. They can be made available later using warp mechanism',
+ ],
+ ],
+
+];
diff --git a/lib/Config/Model/models/Itself/WarpValue.pl b/lib/Config/Model/models/Itself/WarpValue.pl
new file mode 100644
index 0000000..2e424fc
--- /dev/null
+++ b/lib/Config/Model/models/Itself/WarpValue.pl
@@ -0,0 +1,50 @@
+#
+# This file is part of Config-Model-Itself
+#
+# This software is Copyright (c) 2007-2017 by Dominique Dumont.
+#
+# This is free software, licensed under:
+#
+# The GNU Lesser General Public License, Version 2.1, February 1999
+#
+
+[
+ [
+ name => "Itself::WarpValue",
+
+ class_description => 'Warp functionality enable a Value object to change its properties (i.e. default value or its type) dynamically according to the value of another Value object locate elsewhere in the configuration tree.',
+
+ 'element'
+ => [
+ 'follow'
+ => {
+ type => 'hash',
+ index_type =>'string',
+ cargo => { type => 'leaf', value_type => 'uniline' } ,
+ description => 'Specify with the pathof the configuration element that drives '
+ .'the warp, i.e .the elements that control the property change. '
+ .'These are specified using a variable name (used in the "rules" formula)'
+ .'and a path to fetch the actual value. Example $country => " ! country"',
+ },
+ 'rules' => {
+ type => 'hash',
+ ordered => 1,
+ index_type => 'string',
+ cargo => {
+ type => 'warped_node',
+ warp => {
+ rules => [
+ '&get_type =~ /hash|list/' => {
+ config_class_name => 'Itself::WarpableCargoElement'
+ },
+ '&get_type !~ /hash|list/' => {
+ config_class_name => 'Itself::WarpOnlyElement' ,
+ }
+ ]
+ }
+ },
+ description => 'Each key of the hash is a test (as formula using the variables defined in "follow" element) that are tried in sequences to apply its associated effects',
+ },
+ ],
+ ],
+];
diff --git a/lib/Config/Model/models/Itself/WarpValue.pod b/lib/Config/Model/models/Itself/WarpValue.pod
new file mode 100644
index 0000000..67ecd8b
--- /dev/null
+++ b/lib/Config/Model/models/Itself/WarpValue.pod
@@ -0,0 +1,36 @@
+# PODNAME: Config::Model::models::Itself::WarpValue
+# ABSTRACT: Configuration class Itself::WarpValue
+=encoding utf8
+
+=head1 NAME
+
+Config::Model::models::Itself::WarpValue - Configuration class Itself::WarpValue
+
+=head1 DESCRIPTION
+
+Configuration classes used by L<Config::Model>
+
+Warp functionality enable a Value object to change its properties (i.e. default value or its type) dynamically according to the value of another Value object locate elsewhere in the configuration tree.
+
+=head1 Elements
+
+=head2 follow
+
+Specify with the pathof the configuration element that drives the warp, i.e .the elements that control the property change. These are specified using a variable name (used in the "rules" formula)and a path to fetch the actual value. Example $country => " ! country" I<< Optional. Type hash of uniline. >>
+
+=head2 rules
+
+Each key of the hash is a test (as formula using the variables defined in "follow" element) that are tried in sequences to apply its associated effects. I<< Optional. Type hash of warped_node. >>
+
+=head1 SEE ALSO
+
+=over
+
+=item *
+
+L<cme>
+
+=back
+
+=cut
+
diff --git a/lib/Config/Model/models/Itself/WarpableCargoElement.pl b/lib/Config/Model/models/Itself/WarpableCargoElement.pl
new file mode 100644
index 0000000..6f57d66
--- /dev/null
+++ b/lib/Config/Model/models/Itself/WarpableCargoElement.pl
@@ -0,0 +1,41 @@
+#
+# This file is part of Config-Model-Itself
+#
+# This software is Copyright (c) 2007-2017 by Dominique Dumont.
+#
+# This is free software, licensed under:
+#
+# The GNU Lesser General Public License, Version 2.1, February 1999
+#
+# $Author: ddumont $
+# $Date: 2008-03-24 15:05:19 +0100 (Mon, 24 Mar 2008) $
+# $Revision: 559 $
+
+# Copyright (c) 2007-2008 Dominique Dumont.
+#
+# This file is part of Config-Model-Itself.
+#
+# Config-Model-Itself is free software; you can redistribute it
+# and/or modify it under the terms of the GNU Lesser Public License
+# as published by the Free Software Foundation; either version 2.1
+# of the License, or (at your option) any later version.
+#
+# Config-Model-Itself is distributed in the hope that it will be
+# useful, but WITHOUT ANY WARRANTY; without even the implied
+# warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+# See the GNU Lesser Public License for more details.
+#
+# You should have received a copy of the GNU Lesser Public License
+# along with Config-Model-Itself; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+
+[
+ [
+ name => "Itself::WarpableCargoElement",
+
+ include => 'Itself::CommonElement' ,
+
+ class_description => 'attributes that can be warped within cargo of a hash or list element',
+ ],
+
+];
diff --git a/lib/Config/Model/models/Itself/WarpableElement.pl b/lib/Config/Model/models/Itself/WarpableElement.pl
new file mode 100644
index 0000000..ae7c312
--- /dev/null
+++ b/lib/Config/Model/models/Itself/WarpableElement.pl
@@ -0,0 +1,168 @@
+#
+# This file is part of Config-Model-Itself
+#
+# This software is Copyright (c) 2007-2017 by Dominique Dumont.
+#
+# This is free software, licensed under:
+#
+# The GNU Lesser General Public License, Version 2.1, February 1999
+#
+# Copyright (c) 2007-2011 Dominique Dumont.
+#
+# This file is part of Config-Model-Itself.
+#
+# Config-Model-Itself is free software; you can redistribute it
+# and/or modify it under the terms of the GNU Lesser Public License
+# as published by the Free Software Foundation; either version 2.1
+# of the License, or (at your option) any later version.
+#
+# Config-Model-Itself is distributed in the hope that it will be
+# useful, but WITHOUT ANY WARRANTY; without even the implied
+# warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+# See the GNU Lesser Public License for more details.
+#
+# You should have received a copy of the GNU Lesser Public License
+# along with Config-Model-Itself; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+
+[
+ [
+ name => "Itself::WarpableElement",
+
+ include => 'Itself::CommonElement',
+
+ 'element' => [
+
+ [
+ qw/allow_keys_from allow_keys_matching follow_keys_from
+ warn_if_key_match warn_unless_key_match/
+ ] => {
+ type => 'leaf',
+ level => 'hidden',
+ value_type => 'uniline',
+ warp => {
+ follow => { 't' => '?type' },
+ 'rules' => [ '$t eq "hash"' => { level => 'normal', } ]
+ }
+ },
+
+ [qw/ordered/] => {
+ type => 'leaf',
+ level => 'hidden',
+ value_type => 'boolean',
+ warp => {
+ follow => { 't' => '?type' },
+ 'rules' => [
+ '$t eq "hash" or $t eq "check_list"' =>
+ { level => 'normal', }
+ ]
+ }
+ },
+
+ [qw/default_keys auto_create_keys allow_keys/] => {
+ type => 'list',
+ level => 'hidden',
+ cargo => { type => 'leaf', value_type => 'string' },
+ warp => {
+ follow => { 't' => '?type' },
+ 'rules' => [ '$t eq "hash"' => { level => 'normal', } ]
+ }
+ },
+
+ [qw/auto_create_ids/] => {
+ type => 'leaf',
+ level => 'hidden',
+ value_type => 'string',
+ warp => {
+ follow => { 't' => '?type' },
+ 'rules' => [ '$t eq "list"' => { level => 'normal', } ]
+ }
+ },
+
+ [qw/default_with_init/] => {
+ type => 'hash',
+ level => 'hidden',
+ index_type => 'string',
+ cargo => { type => 'leaf', value_type => 'string' },
+ warp => {
+ follow => { 't' => '?type' },
+ 'rules' => [ '$t eq "hash" or $t eq "list"' => { level => 'normal', } ]
+ }
+ },
+
+ 'max_nb' => {
+ type => 'leaf',
+ level => 'hidden',
+ value_type => 'integer',
+ warp => {
+ follow => { 'type' => '?type', },
+ 'rules' => [ '$type eq "hash"' => { level => 'normal', } ]
+ }
+ },
+
+ 'replace' => {
+ type => 'hash',
+ index_type => 'string',
+ level => 'hidden',
+ warp => {
+ follow => { 't' => '?type' },
+ 'rules' => [
+ '$t eq "leaf" or $t eq "check_list"' =>
+ { level => 'normal', }
+ ]
+ },
+
+ # TBD this could be a reference if we restrict replace to
+ # enum value...
+ cargo => { type => 'leaf', value_type => 'string' },
+ },
+
+ [ qw/duplicates/ ] => {
+ type => 'leaf',
+ level => 'hidden',
+ value_type => 'enum',
+ choice => [qw/allow suppress warn forbid/],
+ upstream_default => 'allow',
+ warp => {
+ follow => { 't' => '?type' },
+ 'rules' => [ '$t eq "hash" or $t eq "list"' => { level => 'normal', } ]
+ }
+ },
+
+ help => {
+ type => 'hash',
+ index_type => 'string',
+ level => 'hidden',
+ warp => {
+ follow => { 't' => '?type' },
+ 'rules' => [
+ '$t eq "leaf" or $t eq "check_list"' =>
+ { level => 'normal', }
+ ]
+ },
+
+ # TBD this could be a reference if we restrict replace to
+ # enum value...
+ cargo => { type => 'leaf', value_type => 'string' },
+ },
+ ],
+
+ 'description' => [
+ follow_keys_from => 'this hash contains the same keys as the hash pointed by the path string',
+ allow_keys_from => 'this hash allows keys from the keys of the hash pointed by the path string',
+ ordered => 'keep track of the order of the elements of this hash',
+ default_keys => 'default keys hashes.',
+ auto_create_keys => 'always create a set of keys specified in this list',
+ auto_create_ids => 'always create the number of id specified in this integer',
+ allow_keys => 'specify a set of allowed keys',
+ allow_keys_matching => 'Keys must match the specified regular expression.',
+ default_with_init => 'specify a set of keys to create and initialization on some elements . E.g. \' foo => "X=Av Y=Bv", bar => "Y=Av Z=Cz"\' ',
+ help => 'Specify help string specific to possible values. E.g for "light" value, you could write " red => \'stop\', green => \'walk\' ',
+ replace => 'Used for enum to substitute one value with another. This parameter must be used to enable user to upgrade a configuration with obsolete values. The old value is the key of the hash, the new one is the value of the hash',
+ warn_if_key_match => 'Warn user if a key is created matching this regular expression',
+ warn_unless_key_match => 'Warn user if a key is created not matching this regular expression',
+ duplicates => 'Specify the policy regarding duplicated values stored in the list or as hash values (valid only when cargo type is "leaf"). The policy can be "allow" (default), "suppress", "warn" (which offers the possibility to apply a fix), "forbid".',
+ ],
+ ],
+
+];
diff --git a/t/backend_detect.t b/t/backend_detect.t
new file mode 100644
index 0000000..5dc4a30
--- /dev/null
+++ b/t/backend_detect.t
@@ -0,0 +1,65 @@
+# -*- cperl -*-
+
+use ExtUtils::testlib;
+use Test::More tests => 5 ;
+use Config::Model;
+use Log::Log4perl qw(:easy) ;
+use Data::Dumper ;
+use Test::Memory::Cycle;
+
+use warnings;
+no warnings qw(once);
+
+use strict;
+
+my $arg = shift || '' ;
+my $trace = $arg =~ /t/ ? 1 : 0 ;
+$::verbose = 1 if $arg =~ /v/;
+$::debug = 1 if $arg =~ /d/;
+Config::Model::Exception::Any->Trace(1) if $arg =~ /e/;
+
+Log::Log4perl->easy_init($arg =~ /l/ ? $DEBUG: $ERROR);
+
+my $model = Config::Model->new() ;
+
+$model ->create_config_class
+ (
+ name => "Master",
+ 'element'
+ => [
+ 'backend' => { type => 'leaf',
+ class => 'Config::Model::Itself::BackendDetector' ,
+ value_type => 'enum',
+ choice => [qw/cds_file perl_file ini_file custom/],
+
+ help => {
+ cds_file => "file ...",
+ ini_file => "Ini file ...",
+ perl_file => "file perl",
+ custom => "Custom format",
+ }
+ }
+ ],
+ );
+
+ok(1,"test class created") ;
+
+my $root = $model->instance(root_class_name => 'Master') -> config_root ;
+
+my $backend = $root->fetch_element('backend') ;
+
+my @choices = $backend->get_choice ;
+
+ok( (scalar grep { $_ eq 'Yaml'} @choices), "Yaml plugin backend was found") ;
+
+# test break when using directly Config::Model repo because get_help
+# retrieves info from NAME section which is added at build time by
+# Pod::Weaver
+my $help = $backend->get_help('Yaml') ;
+like($help,qr/provided by L<Config::Model::Backend::Yaml>/,
+ "Found Yaml NAME section from pod") ;
+
+$help = $backend->get_help('cds_file') ;
+is($help,"file ...", "cds_file help was kept") ;
+
+memory_cycle_ok($model);
diff --git a/t/cme-meta-edit.t b/t/cme-meta-edit.t
new file mode 100644
index 0000000..e80e81c
--- /dev/null
+++ b/t/cme-meta-edit.t
@@ -0,0 +1,41 @@
+# -*- cperl -*-
+
+use warnings;
+use strict;
+use 5.10.1;
+
+use Test::More ;
+use Config::Model;
+use Path::Tiny;
+use Test::File::Contents;
+
+use App::Cmd::Tester;
+use App::Cme ;
+use Tk;
+
+my $arg = shift || '';
+my ( $log, $show ) = (0) x 2;
+
+my $trace = $arg =~ /t/ ? 1 : 0;
+
+Config::Model::Exception::Any->Trace(1) if $arg =~ /e/;
+
+# edit and plugin need to be in separate test files. Otherwise the 2
+# Tk widgets created one after the other interacts badly and the save
+# callback of -save-and-quit option is not called after the first test.
+
+SKIP: {
+ my $mw = eval { MainWindow-> new ; };
+
+ # cannot create Tk window
+ skip "Cannot create Tk window",1 if $@;
+ $mw->destroy ;
+
+ {
+ my $result = test_app( 'App::Cme' => [ qw/meta edit fstab -system -test-and-quit q/ ]) ;
+ like($result->stdout , qr/Reading model from/, "edit and quit");
+ like($result->stdout , qr/Test mode: quit/, "edit is in test mode");
+ }
+}
+
+done_testing;
diff --git a/t/cme-meta-plugin.t b/t/cme-meta-plugin.t
new file mode 100644
index 0000000..10f6686
--- /dev/null
+++ b/t/cme-meta-plugin.t
@@ -0,0 +1,64 @@
+# -*- cperl -*-
+
+use warnings;
+use strict;
+use 5.10.1;
+
+use Test::More ;
+use Config::Model;
+use Path::Tiny;
+use Test::File::Contents;
+
+use File::Copy::Recursive qw(fcopy rcopy dircopy);
+
+use App::Cmd::Tester;
+use App::Cme ;
+use Tk;
+
+my $arg = shift || '';
+my ( $log, $show ) = (0) x 2;
+
+my $trace = $arg =~ /t/ ? 1 : 0;
+
+Config::Model::Exception::Any->Trace(1) if $arg =~ /e/;
+
+# edit and plugin need to be in separate test files. Otherwise the 2
+# Tk widgets created one after the other interacts badly and the save
+# callback of -save-and-quit option is not called after the first test.
+
+SKIP: {
+ my $mw = eval { MainWindow-> new ; };
+
+ # cannot create Tk window
+ skip "Cannot create Tk window",1 if $@;
+ $mw->destroy ;
+
+ my $wr_test = path('wr_test/plugin-ui') ;
+
+ $wr_test->remove_tree if $wr_test->is_dir;
+
+ $wr_test->mkpath;
+
+ {
+ # test plugin
+ my $plug_data = q!class:"Fstab::CommonOptions" element:async mandatory=1 !;
+ my $plug = $wr_test->child('plug.cds');
+ $plug->spew($plug_data);
+
+ my $result = test_app(
+ 'App::Cme' => [
+ qw/meta plugin fstab my-plugin/,
+ '-test-and-quit' => 's',
+ '-load' => $plug->stringify,
+ '-dir' => $wr_test->stringify,
+ ]
+ ) ;
+
+ like($result->stdout , qr/Preparing plugin my-plugin for model Fstab/, "edit plugin and quit");
+ like($result->stdout , qr/Test mode: save and quit/, "edit plugin is in test mode");
+ my $plug_out = $wr_test->child('models/Fstab.d/my-plugin/Fstab/CommonOptions.pl');
+ file_contents_like $plug_out, qr/'mandatory' => '1'/, "check content of $plug_out";
+ }
+}
+
+done_testing;
diff --git a/t/cme-meta.t b/t/cme-meta.t
new file mode 100644
index 0000000..4386dbb
--- /dev/null
+++ b/t/cme-meta.t
@@ -0,0 +1,66 @@
+# -*- cperl -*-
+
+use warnings;
+use strict;
+use 5.10.1;
+
+use Test::More ;
+use Config::Model;
+use Path::Tiny;
+use Test::File::Contents;
+
+use App::Cmd::Tester;
+use App::Cme ;
+
+my $arg = shift || '';
+my ( $log, $show ) = (0) x 2;
+
+my $trace = $arg =~ /t/ ? 1 : 0;
+
+Config::Model::Exception::Any->Trace(1) if $arg =~ /e/;
+
+my $wr_test = path('wr_test/meta') ;
+
+$wr_test->remove_tree if $wr_test->is_dir;
+
+$wr_test->mkpath;
+
+SKIP: {
+ skip "dev list does not yet work" ,1 ;
+ my $result = test_app( 'App::Cme' => [ qw/list/]) ;
+ like($result->stdout , qr/meta/, "meta sub command is found in dev env");
+}
+
+{
+ my $result = test_app( 'App::Cme' => [ qw/help meta/]) ;
+ like($result->stdout , qr/create configuration checker or editor/, "check help");
+}
+{
+ my $result = test_app( 'App::Cme' => [ qw/meta check fstab -system/]) ;
+ like($result->stdout , qr/checking data/, "meta check fstab");
+}
+
+# TODO: group tests with Test::Class or Test::Group ?
+
+{
+ my $cds_out = $wr_test->child('fstab.cds');
+ my $result = test_app( 'App::Cme' => [ qw/meta dump fstab -system/, $cds_out->stringify ]) ;
+ like($result->stdout , qr/Dumping Fstab/, "dump fstab model in $cds_out");
+ file_contents_like $cds_out, qr/^class:Fstab/, "check content of $cds_out";
+}
+
+{
+ my $yaml_out = $wr_test->child('fstab.yml');
+ my $result = test_app( 'App::Cme' => [ qw/meta dump-yaml fstab -system/, $yaml_out->stringify ]) ;
+ like($result->stdout , qr/Dumping Fstab/, "dump fstab model in $yaml_out");
+ file_contents_like $yaml_out, qr/class:\n\s+Fstab:\n/, "check content of $yaml_out";
+}
+{
+ my $dot_out = $wr_test->child('fstab.dot');
+ my $result = test_app( 'App::Cme' => [ qw/meta gen-dot fstab -system/, $dot_out->stringify ]) ;
+ like($result->stdout , qr/Creating dot file/, "dot diagram of Fstab in $dot_out");
+ file_contents_like $dot_out, qr/Fstab -> Fstab__FsLine/, "check content of $dot_out";
+}
+
+
+done_testing;
diff --git a/t/dot_graph.t b/t/dot_graph.t
new file mode 100644
index 0000000..17302e9
--- /dev/null
+++ b/t/dot_graph.t
@@ -0,0 +1,66 @@
+# -*- cperl -*-
+use ExtUtils::testlib;
+use Test::More tests => 5;
+use Config::Model;
+use Test::Memory::Cycle;
+use Log::Log4perl qw(:easy) ;
+use Config::Model::Itself ;
+
+use warnings;
+no warnings qw(once);
+
+use strict;
+
+use vars qw/$model/;
+
+$model = Config::Model -> new(legacy => 'ignore',) ;
+
+my $arg = shift || '' ;
+my $trace = $arg =~ /t/ ? 1 : 0 ;
+$::verbose = 1 if $arg =~ /v/;
+$::debug = 1 if $arg =~ /d/;
+Config::Model::Exception::Any->Trace(1) if $arg =~ /e/;
+
+use Log::Log4perl qw(:easy) ;
+Log::Log4perl->easy_init($arg =~ /l/ ? $TRACE: $WARN);
+
+ok(1,"compiled");
+
+mkdir('wr_test') unless -d 'wr_test' ;
+
+my $meta_model = Config::Model -> new ( ) ;# model_dir => '.' );
+
+my $meta_inst = $meta_model
+ -> instance (root_class_name => 'Itself::Model',
+ instance_name => 'itself_instance',
+ root_dir => "data",
+ );
+ok($meta_inst,"Read Itself::Model and created instance") ;
+
+my $meta_root = $meta_inst -> config_root ;
+
+my $model_dir = 'lib/Config/Model' ;
+my $rw_obj = Config::Model::Itself -> new(
+ model_object => $meta_root,
+ cm_lib_dir => $model_dir,
+) ;
+
+my $map = $rw_obj -> read_all(
+ root_model => 'Itself',
+ force_load => 1,
+) ;
+
+ok(1,"Read all models from $model_dir") ;
+
+my $dot_file = "wr_test/config-test.dot";
+
+my $res = $rw_obj->get_dot_diagram ;
+ok($res,"got dot data, written in $dot_file") ;
+
+print $res if $trace ;
+
+open(TMP,">$dot_file") || die "Cannot open $dot_file:$!";
+print TMP $res;
+close TMP ;
+
+memory_cycle_ok($model);
diff --git a/t/itself-editor.t b/t/itself-editor.t
new file mode 100644
index 0000000..8c2a077
--- /dev/null
+++ b/t/itself-editor.t
@@ -0,0 +1,181 @@
+# -*- cperl -*-
+
+use ExtUtils::testlib;
+use Test::More ;
+use Config::Model;
+use Log::Log4perl qw(:easy) ;
+use Data::Dumper ;
+use Config::Model::Itself ;
+
+use Tk ;
+use File::Path ;
+use File::Copy ;
+use Config::Model::Itself::TkEditUI;
+use File::Copy::Recursive qw(fcopy rcopy dircopy);
+use Test::Memory::Cycle;
+
+use warnings;
+no warnings qw(once);
+
+use strict;
+$File::Copy::Recursive::DirPerms = 0755;
+
+
+my ($log,$show) = (0) x 2 ;
+my $arg = $ARGV[0] || '' ;
+my $trace = $arg =~ /t/ ? 1 : 0 ;
+$log = 1 if $arg =~ /l/;
+$show = 1 if $arg =~ /[si]/;
+
+print "You can play with the widget if you run the test with 's' argument\n";
+
+my $wr_test = 'wr_test' ;
+my $wr_conf1 = "$wr_test/wr_conf1";
+my $wr_model1 = "$wr_test/wr_model1";
+
+sub wr_cds {
+ my ($file,$cds) = @_ ;
+ open(CDS,"> $file") || die "can't open $file:$!" ;
+ print CDS $cds ;
+ close CDS ;
+}
+
+plan tests => 15 ; # avoid double print of plan when exec is run
+
+my $log4perl_user_conf_file = $ENV{HOME}.'/.log4config-model' ;
+
+if ($log and -e $log4perl_user_conf_file ) {
+ Log::Log4perl::init($log4perl_user_conf_file);
+}
+else {
+ Log::Log4perl->easy_init($ERROR);
+}
+
+my $meta_model = Config::Model -> new ( ) ;
+
+Config::Model::Exception::Any->Trace(1) if $arg =~ /e/;
+
+{
+ no warnings "redefine" ;
+ sub Tk::Error {
+ my ($widget,$error, at locations) = @_;
+ die $error ;
+ }
+}
+
+ok(1,"compiled");
+
+rmtree($wr_test) if -d $wr_test ;
+
+mkpath([$wr_conf1, $wr_model1, "$wr_conf1/etc/ssh/"], 0, 0755) ;
+dircopy('data',$wr_model1) || die "cannot copy model data:$!" ;
+
+my $model = Config::Model->new(legacy => 'ignore',model_dir => "$wr_model1/models" ) ;
+ok(1,"loaded Master model") ;
+
+# check that Master Model can be loaded by Config::Model
+my $inst1 = $model->instance (root_class_name => 'MasterModel',
+ instance_name => 'test_orig',
+ root_dir => $wr_conf1,
+ );
+ok($inst1,"created master_model instance") ;
+
+my $root1 = $inst1->config_root ;
+my @elt1 = $root1->get_element_name ;
+
+$root1->load("a_string=toto lot_of_checklist macro=AD - "
+ ."! warped_values macro=C where_is_element=get_element "
+ ." get_element=m_value_element m_value=Cv") ;
+ok($inst1,"loaded some data in master_model instance") ;
+
+my $meta_inst = $meta_model->instance(
+ root_class_name => 'Itself::Model',
+ instance_name => 'itself_instance',
+);
+ok( $meta_inst, "Read Itself::Model and created instance" );
+
+$meta_inst->initial_load_start ;
+
+my $meta_root = $meta_inst -> config_root ;
+
+my $rw_obj = Config::Model::Itself -> new(
+ model_object => $meta_root,
+ cm_lib_dir => $wr_model1,
+) ;
+
+
+
+my $map = $rw_obj->read_all(
+ root_model => 'MasterModel',
+ legacy => 'ignore',
+);
+$meta_inst->initial_load_stop ;
+
+ok(1,"Read all models in data dir") ;
+
+
+SKIP: {
+
+ my $mw = eval { MainWindow-> new ; };
+
+ # cannot create Tk window
+ skip "Cannot create Tk window",8 if $@;
+
+ $mw->withdraw ;
+
+ my $write_sub = sub {
+ $rw_obj->write_all();
+ } ;
+
+ my $cmu = $mw->ConfigModelEditUI (-root => $meta_root,
+ -root_dir => $wr_conf1,
+ -cm_lib_dir => $wr_model1 ,
+ -store_sub => $write_sub,
+ -model_name => 'MasterModel',
+ ) ;
+ my $delay = 500 ;
+
+ my $tktree= $cmu->Subwidget('tree') ;
+ my $mgr = $cmu->Subwidget('multi_mgr') ;
+
+ my @test = (
+ view => sub { $cmu->create_element_widget('view','itself_instance.class');},
+ open_class => sub { $tktree->open('itself_instance.class');1;},
+ open_instance => sub{$tktree->open('itself_instance.class.MasterModel');1;},
+ # save step is mandatory to avoid interaction
+ save => sub { $cmu -> save ; 1;},
+ 'open test window' => sub { $cmu -> test_model ; },
+ 'reopen test window' => sub { $cmu -> test_model ; },
+ exit => sub { $cmu->quit ; 1;}
+ );
+
+ unless ($show) {
+ my $step = 0;
+
+ # build a FILO queue of test subs
+ my $oldsub ;
+ while (@test) {
+ # iterate through test list in reverse order
+ my $t = pop @test ;
+ my $k = pop @test ;
+ my $next_sub = $oldsub ;
+ my $s = sub {
+ my $res = &$t;
+ ok($res,"Tk UI step ".$step++." $k done");
+ $mw->after($delay, $next_sub) if defined $next_sub;
+ };
+ $oldsub = $s ;
+ }
+
+ $mw->after($delay, $oldsub) ; # will launch first test
+ }
+
+ ok(1,"window launched") ;
+
+ MainLoop ; # Tk's
+
+}
+
+memory_cycle_ok($model,"memory cycles");
+
+
diff --git a/t/itself.t b/t/itself.t
new file mode 100644
index 0000000..45eb70a
--- /dev/null
+++ b/t/itself.t
@@ -0,0 +1,260 @@
+# -*- cperl -*-
+
+use ExtUtils::testlib;
+use Test::More ;
+use Config::Model;
+use Log::Log4perl qw(:easy) ;
+use Data::Dumper ;
+use File::Path ;
+use File::Copy ;
+use File::Find ;
+use Config::Model::Itself ;
+use File::Copy::Recursive qw(fcopy rcopy dircopy);
+use Test::Memory::Cycle;
+
+use warnings;
+no warnings qw(once);
+
+use strict;
+
+my $arg = shift || '';
+my ( $log, $show ) = (0) x 2;
+
+my $trace = $arg =~ /t/ ? 1 : 0;
+$log = 1 if $arg =~ /l/;
+$show = 1 if $arg =~ /s/;
+
+my $home = $ENV{HOME} || "";
+my $log4perl_user_conf_file = "$home/.log4config-model";
+
+if ( $log and -e $log4perl_user_conf_file ) {
+ Log::Log4perl::init($log4perl_user_conf_file);
+}
+else {
+ Log::Log4perl->easy_init( $log ? $WARN : $ERROR );
+}
+
+Config::Model::Exception::Any->Trace(1) if $arg =~ /e/;
+
+my $wr_test = 'wr_test' ;
+my $wr_conf1 = "$wr_test/wr_conf1";
+my $wr_model1 = "$wr_test/wr_model1";
+my $wr_model2 = "$wr_test/wr_model2";
+
+sub wr_cds {
+ my ($file,$cds) = @_ ;
+ open(CDS,"> $file") || die "can't open $file:$!" ;
+ print CDS $cds ;
+ close CDS ;
+}
+
+my $meta_model = Config::Model -> new ( ) ;# model_dir => '.' );
+
+Config::Model::Exception::Any->Trace(1) if $arg =~ /e/;
+
+ok(1,"compiled");
+
+rmtree($wr_test) if -d $wr_test ;
+
+# "modern" API of File::Path does not work with perl 5.8.8
+mkpath( [$wr_conf1, $wr_model1, $wr_model2, "$wr_conf1/etc/ssh/"] , 0, 0755) ;
+dircopy('data',$wr_model1) || die "cannot copy model data:$!" ;
+
+# copy test model
+my $wanted = sub {
+ return if /svn|data$|~$/ ;
+ s!data/!! ;
+ -d $File::Find::name && mkpath( ["$wr_model1/$_"], 0, 0755) ;
+ -f $File::Find::name && copy($File::Find::name,"$wr_model1/$_") ;
+};
+find ({ wanted =>$wanted, no_chdir=>1} ,'data') ;
+
+
+my $model = Config::Model->new(legacy => 'ignore',model_dir => 'data/models' ) ;
+ok(1,"loaded Master model") ;
+
+# check that Master Model can be loaded by Config::Model
+my $inst1 = $model->instance (root_class_name => 'MasterModel',
+ instance_name => 'test_orig',
+ root_dir => $wr_conf1,
+ );
+ok($inst1,"created master_model instance") ;
+
+my $root1 = $inst1->config_root ;
+my @elt1 = $root1->get_element_name ;
+
+$root1->load("a_string=toto lot_of_checklist macro=AD - "
+ ."! warped_values macro=C where_is_element=get_element "
+ ." get_element=m_value_element m_value=Cv "
+ ."! assert_leaf=foo leaf_with_warn_unless=bar") ;
+ok($inst1,"loaded some data in master_model instance") ;
+
+my $dump1 = $root1->dump_tree(mode => 'full') ;
+ok($dump1,"dumped master instance") ;
+
+# ok now we can load test model in Itself
+
+my $meta_inst = $meta_model
+ -> instance (root_class_name => 'Itself::Model',
+ instance_name => 'itself_instance',
+ root_dir => $wr_model1,
+ );
+ok($meta_inst,"Read Itself::Model and created instance") ;
+
+
+
+my $meta_root = $meta_inst -> config_root ;
+
+my $rw_obj = Config::Model::Itself -> new(
+ model_object => $meta_root,
+ cm_lib_dir => $wr_model1,
+) ;
+
+my $map = $rw_obj -> read_all(
+ root_model => 'MasterModel',
+ legacy => 'ignore',
+ ) ;
+
+ok(1,"Read all models in data dir") ;
+
+print $meta_model->list_class_element if $trace ;
+
+my $expected_map
+ = {
+ 'MasterModel/HashIdOfValues.pl' => [
+ 'MasterModel::HashIdOfValues'
+ ],
+ 'MasterModel/CheckListExamples.pl' => [
+ 'MasterModel::CheckListExamples'
+ ],
+ 'MasterModel.pl' => [
+ 'MasterModel::SubSlave2',
+ 'MasterModel::SubSlave',
+ 'MasterModel::SlaveZ',
+ 'MasterModel::SlaveY',
+ 'MasterModel::TolerantNode',
+ 'MasterModel'
+ ],
+ 'MasterModel/WarpedId.pl' => [
+ 'MasterModel::WarpedIdSlave',
+ 'MasterModel::WarpedId'
+ ],
+ 'MasterModel/X_base_class.pl' => [
+ 'MasterModel::X_base_class2',
+ 'MasterModel::X_base_class',
+ ],
+ 'MasterModel/WarpedValues.pl' => [
+ 'MasterModel::RSlave',
+ 'MasterModel::Slave',
+ 'MasterModel::WarpedValues'
+ ],
+ 'MasterModel/References.pl' => [
+ 'MasterModel::References::Host',
+ 'MasterModel::References::If',
+ 'MasterModel::References::Lan',
+ 'MasterModel::References::Node',
+ 'MasterModel::References'
+ ],
+ };
+
+is_deeply($expected_map, $map, "Check file class map") ;
+print Dumper $map if $trace ;
+
+# add a new class
+$meta_root->load("class:Master::Created element:created1 type=leaf value_type=number - element:created2 type=leaf value_type=uniline") ;
+ok(1,"added new class Master::Created") ;
+
+if (0) {
+ require Tk;
+ require Config::Model::TkUI ;
+ Tk->import ;
+
+ my $mw = MainWindow-> new ;
+ $mw->withdraw ;
+
+ my $cmu = $mw->ConfigModelUI (-root => $meta_root) ;
+ &MainLoop ; # Tk's
+}
+
+my $cds = $meta_root->dump_tree (full_dump => 1) ;
+my @cds_orig = split /\n/,$cds ;
+
+print $cds if $trace ;
+ok($cds,"dumped full tree in cds format") ;
+
+#like($cds,qr/dumb/,"check for a peculiar warp effet") ;
+
+wr_cds("$wr_conf1/orig.cds",$cds);
+
+#create a 2nd empty model
+my $meta_inst2 = $meta_model->instance (root_class_name => 'Itself::Model',
+ instance_name => 'itself_instance', );
+
+my $meta_root2 = $meta_inst2 -> config_root ;
+$meta_root2 -> load ($cds) ;
+ok(1,"Created and loaded 2nd instance") ;
+
+my $cds2 = $meta_root2 ->dump_tree (full_dump => 1) ;
+wr_cds("$wr_conf1/inst2.cds",$cds2);
+
+is_deeply([split /\n/,$cds2],\@cds_orig,"Compared the 2 full dumps") ;
+
+my $pdata2 = $meta_root2 -> dump_as_data ;
+print Dumper $pdata2 if $trace ;
+
+my $rw_obj2 = Config::Model::Itself -> new(
+ model_object => $meta_root2,
+ cm_lib_dir => $wr_model2,
+ force_write => 1,
+) ;
+
+$rw_obj2 -> write_all();
+
+# create 3rd instance
+
+my $meta_inst3 = $meta_model->instance (root_class_name => 'Itself::Model',
+ instance_name => 'itself_instance', );
+
+my $meta_root3 = $meta_inst3 -> config_root ;
+$meta_root3 -> load_data ($pdata2) ;
+ok(1,"Created and loaded 3nd instance with perl data") ;
+
+my $cds3 = $meta_root3 ->dump_tree (full_dump => 1) ;
+wr_cds("$wr_conf1/inst3.cds",$cds3);
+
+is_deeply([split /\n/,$cds3],\@cds_orig,"Compared the 3rd full dump with first one") ;
+
+# check dump of one class
+my $dump = $rw_obj -> get_perl_data_model ( class_name => 'MasterModel' ) ;
+
+print Dumper $dump if $trace ;
+ok($dump,"Checked dump of one class");
+
+$rw_obj->write_all( ) ;
+
+my $model4 = Config::Model->new(legacy => 'ignore',model_dir => "$wr_model1/models") ;
+#$model4 -> load ('X_base_class', 'wr_test/MasterModel/X_base_class.pl') ;
+#ok(1,"loaded X_base_class") ;
+#$model4 -> load ('MasterModel' , 'wr_test/MasterModel.pl') ;
+#ok(1,"loaded MasterModel") ;
+#$model4 -> load ('MasterModel::Created' , 'wr_test/Master/Created.pl') ;
+#ok(1,"loaded MasterModel::Created") ;
+
+my $inst4 = $model4->instance (root_class_name => 'MasterModel',
+ instance_name => 'test_instance',
+ 'root_dir' => $wr_conf1,
+
+ );
+ok($inst4,"Read MasterModel and created instance") ;
+
+my $root4 = $inst4->config_root ;
+ok($root4,"Created MasterModel root") ;
+
+my @elt4 = $root4->get_element_name() ;
+is(scalar @elt4,scalar @elt1,"Check number of elements of root4") ;
+
+# require Tk::ObjScanner; Tk::ObjScanner::scan_object($meta_model) ;
+
+memory_cycle_ok($model);
+
+done_testing;
diff --git a/t/itself_snippet.t b/t/itself_snippet.t
new file mode 100644
index 0000000..1b1e112
--- /dev/null
+++ b/t/itself_snippet.t
@@ -0,0 +1,181 @@
+# -*- cperl -*-
+
+use ExtUtils::testlib;
+use Test::More tests => 9 ;
+use Config::Model;
+use Log::Log4perl qw(:easy) ;
+use Data::Dumper ;
+use File::Path ;
+use File::Copy ;
+use File::Find ;
+use Config::Model::Itself ;
+use Test::File::Contents ;
+
+use warnings;
+no warnings qw(once);
+
+use strict;
+
+my $arg = $ARGV[0] || '' ;
+my ($log,$show) = (0) x 2 ;
+
+my $trace = $arg =~ /t/ ? 1 : 0 ;
+$log = 1 if $arg =~ /l/;
+$show = 1 if $arg =~ /s/;
+
+my $home = $ENV{HOME} || "";
+my $log4perl_user_conf_file = "$home/.log4config-model";
+
+if ($log and -e $log4perl_user_conf_file ) {
+ Log::Log4perl::init($log4perl_user_conf_file);
+}
+else {
+ Log::Log4perl->easy_init($log ? $WARN: $ERROR);
+}
+
+Config::Model::Exception::Any->Trace(1) if $arg =~ /e/;
+
+my $wr_test = 'wr_test' ;
+my $wr_model1 = "$wr_test/wr_model1";
+my $wr_plugin = "$wr_test/wr_plugin.d";
+my $plugin_name = 'my_plugin';
+
+my $meta_model = Config::Model -> new ( ) ;# model_dir => '.' );
+
+ok(1,"compiled");
+
+rmtree($wr_test) if -d $wr_test ;
+
+# "modern" API of File::Path does not work with perl 5.8.8
+mkpath( [$wr_model1] , 0, 0755) ;
+
+# copy test model
+my $wanted = sub {
+ return if /svn|data$|~$/ ;
+ s!data/!! ;
+ -d $File::Find::name && mkpath( ["$wr_model1/$_"], 0, 0755) ;
+ -f $File::Find::name && copy($File::Find::name,"$wr_model1/$_") ;
+};
+find ({ wanted =>$wanted, no_chdir=>1} ,'data') ;
+
+
+
+
+# test model plugins, read model in layered mode
+my $meta_plugin_inst = $meta_model->instance(
+ root_class_name => 'Itself::Model',
+ instance_name => 'itself_plugin',
+ root_dir => $wr_model1,
+);
+ok($meta_plugin_inst,"Read Itself::Model and created instance for model plugin") ;
+
+my $meta_plugin_root = $meta_plugin_inst -> config_root ;
+
+my $plugin_rw_obj = Config::Model::Itself -> new(
+ model_object => $meta_plugin_root,
+ cm_lib_dir => 'data',
+) ;
+
+$meta_plugin_inst->layered_start ;
+
+$plugin_rw_obj -> read_all(
+ root_model => 'MasterModel',
+ legacy => 'ignore',
+) ;
+
+ok(1,"Read all models in data dir in layered mode") ;
+
+$meta_plugin_inst->layered_stop ;
+
+# modify model, X_base_class2 is not a mistake
+$meta_plugin_root->load(q!class:MasterModel::X_base_class2 element:X#"X note" help:Cv="Mighty help for Cv"!);
+$meta_plugin_root->load(q!class:MasterModel element:a_string warn_if_match:meh msg="said meh"!);
+
+$plugin_rw_obj->write_model_plugin(plugin_dir => $wr_plugin, plugin_name => $plugin_name) ;
+
+my %expected_plugin;
+$expected_plugin{MasterModel} = << "EOS" ;
+[
+ {
+ 'element' => [
+ 'a_string',
+ {
+ 'warn_if_match' => {
+ 'meh' => {
+ 'msg' => 'said meh'
+ }
+ }
+ }
+ ],
+ 'name' => 'MasterModel'
+ }
+]
+;
+
+EOS
+
+$expected_plugin{"MasterModel/X_base_class2"} = << "EOS" ;
+[
+ {
+ 'element' => [
+ 'X',
+ {
+ 'help' => {
+ 'Cv' => 'Mighty help for Cv'
+ }
+ }
+ ],
+ 'name' => 'MasterModel::X_base_class2'
+ }
+]
+;
+
+=head1 Annotations
+
+=over
+
+=item class:"MasterModel::X_base_class2" element:X
+
+X note
+
+=back
+
+EOS
+
+map {
+ file_contents_eq_or_diff $wr_plugin."/$plugin_name/$_.pl", $expected_plugin{$_}, "generated $_ plugin file";
+} keys %expected_plugin ;
+
+my $meta_plugin_inst2 = $meta_model->instance(
+ root_class_name => 'Itself::Model',
+ instance_name => 'itself_plugin',
+ root_dir => $wr_model1,
+);
+ok($meta_plugin_inst2,"Read Itself::Model and created instance for model plugin") ;
+
+my $meta_plugin_root2 = $meta_plugin_inst2 -> config_root ;
+
+my $plugin_rw_obj2 = Config::Model::Itself -> new(
+ cm_lib_dir => 'data',
+ model_object => $meta_plugin_root2,
+) ;
+
+$meta_plugin_inst2->layered_start ;
+
+$plugin_rw_obj2->read_all(
+ root_model => 'MasterModel',
+ legacy => 'ignore',
+);
+
+ok(1,"Read all models in data dir in layered mode") ;
+
+$meta_plugin_inst->layered_stop ;
+
+$plugin_rw_obj2->read_model_plugin(plugin_dir => $wr_plugin, plugin_name => $plugin_name) ;
+
+my $plugin_name2 = 'other_plugin';
+$plugin_rw_obj2->write_model_plugin(plugin_dir => $wr_plugin, plugin_name => $plugin_name2) ;
+
+map {
+ file_contents_eq_or_diff $wr_plugin."/$plugin_name2/$_.pl", $expected_plugin{$_}, "regenerated $_ plugin file";
+} keys %expected_plugin ;
diff --git a/t/list_itself_structure.t b/t/list_itself_structure.t
new file mode 100644
index 0000000..1a94628
--- /dev/null
+++ b/t/list_itself_structure.t
@@ -0,0 +1,58 @@
+# -*- cperl -*-
+use ExtUtils::testlib;
+use Test::More tests => 4;
+use Config::Model;
+use Log::Log4perl qw(:easy) ;
+use Data::Dumper ;
+use Config::Model::Itself ;
+
+use warnings;
+no warnings qw(once);
+use Test::Memory::Cycle;
+
+use strict;
+
+my $arg = shift || '' ;
+my $trace = $arg =~ /t/ ? 1 : 0 ;
+$::verbose = 1 if $arg =~ /v/;
+$::debug = 1 if $arg =~ /d/;
+my $log = 1 if $arg =~ /l/;
+
+Log::Log4perl->easy_init($log ? $DEBUG: $WARN);
+
+my $meta_model = Config::Model -> new ( ) ;# model_dir => '.' );
+
+Config::Model::Exception::Any->Trace(1) if $arg =~ /e/;
+
+ok(1,"compiled");
+
+mkdir('wr_test') unless -d 'wr_test' ;
+
+my $meta_inst = $meta_model
+ -> instance (root_class_name => 'Itself::Model',
+ instance_name => 'itself_instance',
+ root_dir => "data",
+ );
+ok($meta_inst,"Read Itself::Model and created instance") ;
+
+my $meta_root = $meta_inst -> config_root ;
+
+my $model_dir = 'lib/Config/Model';
+my $rw_obj = Config::Model::Itself->new(
+ cm_lib_dir => $model_dir,
+ model_object => $meta_root
+);
+
+my $map = $rw_obj->read_all(
+ root_model => 'Itself',
+ force_load => 1,
+);
+
+ok(1,"Read all models from $model_dir") ;
+
+my $list = $rw_obj->list_class_element;
+ok($list,"got structure") ;
+
+print $list if $trace ;
+
+use Test::Memory::Cycle;
diff --git a/t/load_write_itself.t b/t/load_write_itself.t
new file mode 100644
index 0000000..1471e5a
--- /dev/null
+++ b/t/load_write_itself.t
@@ -0,0 +1,102 @@
+# -*- cperl -*-
+use ExtUtils::testlib;
+use Test::More tests => 8;
+use Config::Model;
+use Log::Log4perl qw(:easy) ;
+use Data::Dumper ;
+use Config::Model::Itself ;
+use File::Path ;
+use File::Find ;
+use File::Copy ;
+
+use Text::Diff;
+use warnings;
+no warnings qw(once);
+
+use strict;
+
+my $arg = shift || '' ;
+my $trace = $arg =~ /t/ ? 1 : 0 ;
+$::verbose = 1 if $arg =~ /v/;
+$::debug = 1 if $arg =~ /d/;
+my $log = 1 if $arg =~ /l/;
+
+Log::Log4perl->easy_init($log ? $DEBUG: $WARN);
+
+my $meta_model = Config::Model -> new ( ) ;# model_dir => '.' );
+
+Config::Model::Exception::Any->Trace(1) if $arg =~ /e/;
+
+ok(1,"compiled");
+
+my $wr_test = "wr_test" ;
+rmtree($wr_test) if -d $wr_test ;
+mkdir($wr_test) ;
+
+my $inst = $meta_model->instance (root_class_name => 'Itself::Model',
+ instance_name => 'itself_instance',
+ root_dir => $wr_test,
+ );
+ok($inst,"Read Itself::Model and created instance") ;
+
+my $root = $inst -> config_root ;
+
+# copy itself model
+my $model_dir = 'lib/Config/Model';
+my $wanted = sub {
+ -d $File::Find::name && mkpath( ["$wr_test/$_"], 0, 0755) ;
+ -f $File::Find::name && copy($File::Find::name,"$wr_test/$_") ;
+};
+# start copy *below* models.
+# See https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=809294
+find ({ wanted => $wanted, no_chdir => 1} , $model_dir.'/models' ) ;
+
+my $rw_obj = Config::Model::Itself->new(
+ cm_lib_dir => "$wr_test/$model_dir",
+ model_object => $root
+);
+
+my $map = $rw_obj->read_all( root_model => 'Itself' );
+
+ok(1,"Read all models from $model_dir") ;
+
+my $cds = $root->dump_tree (full_dump => 1) ;
+
+print $cds if $trace ;
+ok($cds,"dumped full tree in cds format") ;
+
+#create a 2nd empty model
+my $inst2 = $meta_model->instance (root_class_name => 'Itself::Model',
+ instance_name => 'itself_instance', );
+
+my $root2 = $inst -> config_root ;
+$root2 -> load ($cds) ;
+ok(1,"Created and loaded 2nd instance") ;
+
+my $cds2 = $root2 ->dump_tree (full_dump => 1) ;
+
+is(my_diff(\$cds,\$cds2),'',"Compared the 2 full dumps") ;
+
+my $pdata2 = $root2 -> dump_as_data ;
+print Dumper $pdata2 if $trace ;
+
+# create 3rd instance
+
+my $inst3 = $meta_model->instance (root_class_name => 'Itself::Model',
+ instance_name => 'itself_instance', );
+
+my $root3 = $inst -> config_root ;
+$root3 -> load_data ($pdata2) ;
+ok(1,"Created and loaded 3nd instance with perl data") ;
+
+my $cds3 = $root3 ->dump_tree (full_dump => 1) ;
+
+is( my_diff(\$cds, \$cds3),'',"Compared the 3rd full dump with first one") ;
+
+$rw_obj->write_all( ) ;
+
+# require Tk::ObjScanner; Tk::ObjScanner::scan_object($meta_model) ;
+
+sub my_diff {
+ return diff( @_ , { STYLE => "Unified" } );
+}
diff --git a/t/model_tests.t b/t/model_tests.t
deleted file mode 100644
index 3aa3b31..0000000
--- a/t/model_tests.t
+++ /dev/null
@@ -1,13 +0,0 @@
-# -*- cperl -*-
-use warnings;
-
-use strict;
-
-use Config::Model::Tester ;
-use ExtUtils::testlib;
-
-my $arg = shift || '';
-my $test_only_model = shift || '';
-my $do = shift ;
-
-run_tests($arg, $test_only_model, $do) ;
diff --git a/t/pod.t b/t/pod.t
index ceb6fbf..7e67468 100644
--- a/t/pod.t
+++ b/t/pod.t
@@ -1,12 +1,7 @@
-BEGIN {
- unless ($ENV{AUTHOR_TESTING}) {
- require Test::More;
- Test::More::plan(skip_all => 'these tests are for testing by the author');
- }
-}
+# -*- cperl -*-
use strict;
use Test::More;
eval "use Test::Pod 1.00";
plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
-all_pod_files_ok( );
+all_pod_files_ok( );
diff --git a/t/pod_gen.t b/t/pod_gen.t
new file mode 100644
index 0000000..79693fd
--- /dev/null
+++ b/t/pod_gen.t
@@ -0,0 +1,113 @@
+# -*- cperl -*-
+
+use ExtUtils::testlib;
+use Test::More ;
+use Test::Differences ;
+use Config::Model;
+use Log::Log4perl qw(:easy) ;
+use Data::Dumper ;
+use File::Path ;
+use File::Copy ;
+use File::Find ;
+use Config::Model::Itself ;
+
+use warnings;
+no warnings qw(once);
+
+use strict;
+
+my $log = 0;
+my $arg = $ARGV[0] || '' ;
+
+my $trace = ($arg =~ /t/) ? 1 : 0 ;
+$log = 1 if $arg =~ /l/;
+Config::Model::Exception::Any->Trace(1) if $arg =~ /e/;
+
+my $log4perl_user_conf_file = $ENV{HOME}.'/.log4config-model' ;
+
+if ($log and -e $log4perl_user_conf_file ) {
+ Log::Log4perl::init($log4perl_user_conf_file);
+}
+else {
+ Log::Log4perl->easy_init($log ? $WARN: $ERROR);
+}
+
+my $wr_test = 'wr_test' ;
+my $wr_conf1 = "$wr_test/wr_conf1";
+my $wr_model1 = "$wr_test/wr_model1";
+
+
+plan tests => 6 ;
+
+my $meta_model = Config::Model -> new ( ) ;# model_dir => '.' );
+
+Config::Model::Exception::Any->Trace(1) if $arg =~ /e/;
+
+ok(1,"compiled");
+
+rmtree($wr_test) if -d $wr_test ;
+
+
+my $meta_inst = $meta_model->instance(
+ root_class_name => 'Itself::Model',
+ instance_name => 'itself_instance',
+ root_dir => $wr_model1,
+);
+ok( $meta_inst, "Read Itself::Model and created instance" );
+$meta_inst->initial_load_stop ;
+
+my $meta_root = $meta_inst -> config_root ;
+
+my $rw_obj = Config::Model::Itself -> new(
+ model_object => $meta_root,
+ cm_lib_dir => $wr_model1,
+ force_write => 1, # can put 0 when Config::MOdel 1.214 is used
+) ;
+
+# add a new class
+my @list = (1..3);
+foreach my $i (@list) {
+ $meta_root->load(
+ qq/class:Master::Created$i#"my great class $i"
+ class_description="Master class created nb $i\nfor tests purpose."
+ author="dod\@foo.com" copyright="2011 dod" license="LGPL"
+ element:created1 type=leaf#"not autumn" value_type=number description="element 1" -
+ element:created2 type=leaf value_type=uniline description="another element"/) ;
+}
+ok(1,"added new class Master::Created") ;
+
+if (0) {
+ require Tk;
+ require Config::Model::TkUI ;
+ Tk->import ;
+
+ my $mw = MainWindow-> new ;
+ $mw->withdraw ;
+
+ my $cmu = $mw->ConfigModelUI (-root => $meta_root) ;
+ &MainLoop ; # Tk's
+}
+
+$rw_obj->write_all( ) ;
+ok(1,"wrote back all stuff") ;
+
+my $meta_inst2 = $meta_model -> instance (
+ root_class_name => 'Itself::Model',
+ instance_name => 'itself_instance2',
+ root_dir => $wr_model1,
+) ;
+my $meta_root2 = $meta_inst2->config_root ;
+$meta_inst2->initial_load_stop ;
+
+ok($meta_root2,"Read Itself::Model and created instance2") ;
+my $rw_obj2 = Config::Model::Itself -> new(
+ cm_lib_dir => $wr_model1 ,
+ model_object => $meta_root2
+) ;
+$rw_obj2->read_all( root_model => 'Master' ) ;
+
+eq_or_diff($meta_root2->dump_tree, $meta_root->dump_tree,"compare 2 dumps");
+
+
+# require Tk::ObjScanner; Tk::ObjScanner::scan_object($meta_model) ;
+
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libconfig-model-tester-perl.git
More information about the Pkg-perl-cvs-commits
mailing list