Config-Model-Itself-2.006000755001750001750 012766275757 14303 5ustar00domidomi000000000000Changes100644001750001750 3670712766275757 15714 0ustar00domidomi000000000000Config-Model-Itself-2.0062.006 2016-09-14 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 2.005 2016-07-03 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 Other changes: * removed long deprecated 'experience' parameter * added CONTRIBUTING.md file 2.004 2016-04-21 New features: * added auto_delete parameter for read/write backend this requires Config::Model 2.083 Doc updates in model: * updated Class doc * added help for value_type Bug fixes: * detect backend in local dev environment. 2.003 2016-01-27 New features: * 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) 0.203 2008-05-21 * config-model-edit: Fixed bug that prevented testing of the configuration editor when starting from scratch. 0.202 2008-05-18 * lib/Config/Model/models/Itself/CommonElement.pl: Added support for built in default list for check_list elements * 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) * lib/Config/Model/Itself.pm (list_class_element): new method to help model debug * lib/Config/Model/Itself.pm (read_all): Reworked model to fit with new cargo arguments. * tests: suppress legacy warnings 0.201 2008-04-03 * lib/Config/Model/models/Itself/Element.pl: Fixed element and cargo models. * lib/Config/Model/models/Itself/WarpableElement.pl: added description for 'replace' element * lib/Config/Model/models/Itself/WarpableElement.pl: removed enum_integer type * config-model-edit: Clarified where models are read and written. 0.102 2008-03-18 * config-model-edit: Now use Config::Model::TkUI instead of Config::Model::TkUi * lib/Config/Model/Itself.pm (read_all): Skip svn directory when reading model files * 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 * config-model-edit: added possibity to use Tk interface. * lib/Config/Model/models/Itself/WarpableElement.pl: added 'replace' parameter 0.101 2007-10-16 * All: first version t000755001750001750 012766275757 14467 5ustar00domidomi000000000000Config-Model-Itself-2.006pod.t100644001750001750 34412766275757 15557 0ustar00domidomi000000000000Config-Model-Itself-2.006/t# -*- cperl -*- use strict; use Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; my @poddirs = qw( lib config-model-edit ); all_pod_files_ok( all_pod_files( @poddirs ) ); LICENSE100644001750001750 6013212766275757 15413 0ustar00domidomi000000000000Config-Model-Itself-2.006This software is Copyright (c) 2007-2016 by Dominique Dumont. This is free software, licensed under: The GNU Lesser General Public License, Version 2.1, February 1999 The GNU Lesser General Public License (LGPL) Version 2.1, February 1999 (The master copy of this license lives on the GNU website.) Copyright (C) 1991, 1999 Free Software Foundation, Inc. 59 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. [This is the first released version of the Lesser GPL. It also counts as the successor of the GNU Library Public License, version 2, hence the version number 2.1.] Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This license, the Lesser General Public License, applies to some specially designated software packages--typically libraries--of the Free Software Foundation and other authors who decide to use it. You can use it too, but we suggest you first think carefully about whether this license or the ordinary General Public License is the better strategy to use in any particular case, based on the explanations below. When we speak of free software, we are referring to freedom of use, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish); that you receive source code or can get it if you want it; that you can change the software and use pieces of it in new free programs; and that you are informed that you can do these things. To protect your rights, we need to make restrictions that forbid distributors to deny you these rights or to ask you to surrender these rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library or if you modify it. For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link other code with the library, you must provide complete object files to the recipients, so that they can relink them with the library after making changes to the library and recompiling it. And you must show them these terms so they know their rights. We protect your rights with a two-step method: (1) we copyright the library, and (2) we offer you this license, which gives you legal permission to copy, distribute and/or modify the library. To protect each distributor, we want to make it very clear that there is no warranty for the free library. Also, if the library is modified by someone else and passed on, the recipients should know that what they have is not the original version, so that the original author's reputation will not be affected by problems that might be introduced by others. Finally, software patents pose a constant threat to the existence of any free program. We wish to make sure that a company cannot effectively restrict the users of a free program by obtaining a restrictive license from a patent holder. Therefore, we insist that any patent license obtained for a version of the library must be consistent with the full freedom of use specified in this license. Most GNU software, including some libraries, is covered by the ordinary GNU General Public License. This license, the GNU Lesser General Public License, applies to certain designated libraries, and is quite different from the ordinary General Public License. We use this license for certain libraries in order to permit linking those libraries into non-free programs. When a program is linked with a library, whether statically or using a shared library, the combination of the two is legally speaking a combined work, a derivative of the original library. The ordinary General Public License therefore permits such linking only if the entire combination fits its criteria of freedom. The Lesser General Public License permits more lax criteria for linking other code with the library. We call this license the "Lesser" General Public License because it does Less to protect the user's freedom than the ordinary General Public License. It also provides other free software developers Less of an advantage over competing non-free programs. These disadvantages are the reason we use the ordinary General Public License for many libraries. However, the Lesser license provides advantages in certain special circumstances. For example, on rare occasions, there may be a special need to encourage the widest possible use of a certain library, so that it becomes a de-facto standard. To achieve this, non-free programs must be allowed to use the library. A more frequent case is that a free library does the same job as widely used non-free libraries. In this case, there is little to gain by limiting the free library to free software only, so we use the Lesser General Public License. In other cases, permission to use a particular library in non-free programs enables a greater number of people to use a large body of free software. For example, permission to use the GNU C Library in non-free programs enables many more people to use the whole GNU operating system, as well as its variant, the GNU/Linux operating system. Although the Lesser General Public License is Less protective of the users' freedom, it does ensure that the user of a program that is linked with the Library has the freedom and the wherewithal to run that program using a modified version of the Library. The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, whereas the latter must be combined with the library in order to run. TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any software library or other program which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Lesser General Public License (also called "this License"). Each licensee is addressed as "you". A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables. The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".) "Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library. Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does. 1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) The modified work must itself be a software library. b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change. c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License. d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful. (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library. In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices. Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy. This option is useful when you wish to copy part of the code of the Library into a program that is not a library. 4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange. If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code. 5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License. However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables. When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law. If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.) Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself. 6. As an exception to the Sections above, you may also combine or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications. You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things: a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.) b) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (1) uses at run time a copy of the library already present on the user's computer system, rather than copying library functions into the executable, and (2) will operate properly with a modified version of the library, if the user installs one, as long as the modified version is interface-compatible with the version that the work was made with. c) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution. d) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place. e) Verify that the user has already received a copy of these materials or that you have already sent this user a copy. For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the materials to be distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute. 7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things: a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above. b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it. 10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties with this License. 11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 13. The Free Software Foundation may publish revised and/or new versions of the Lesser General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation. 14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Build.PL100644001750001750 623412766275757 15665 0ustar00domidomi000000000000Config-Model-Itself-2.006# # This file is part of Config-Model-Itself # # This software is Copyright (c) 2007-2016 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 ; require 5.010; # 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' ); 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' }, 'requires' => { 'App::Cme' => '1.002', 'App::Cme::Common' => '0', 'Carp' => '0', 'Config::Model' => '2.091', 'Config::Model::TkUI' => '1.210', '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', 'Pod::POM' => '0', 'Tk' => '0', 'YAML::Tiny' => '0', 'perl' => '5.010' }, script_files => [ 'config-model-edit' ], add_to_cleanup => [qw/wr_test/] , ); $build->add_build_element('pl'); # $build->add_build_element('appli'); $build->create_build_script; META.yml100644001750001750 240312766275757 15634 0ustar00domidomi000000000000Config-Model-Itself-2.006--- 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 generated_by: 'Dist::Zilla version 6.007, CPAN::Meta::Converter version 2.150010' license: lgpl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Config-Model-Itself requires: App::Cme: '1.002' App::Cme::Common: '0' Carp: '0' Config::Model: '2.091' Config::Model::TkUI: '1.210' 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' Pod::POM: '0' Tk: '0' YAML::Tiny: '0' perl: '5.010' resources: bugtracker: https://github.com/dod38fr/config-model-itself/issues homepage: https://github.com/dod38fr/config-model/wiki repository: git://github.com/dod38fr/config-model-itself.git version: '2.006' x_serialization_backend: 'YAML::Tiny version 1.69' MANIFEST100644001750001750 356112766275757 15522 0ustar00domidomi000000000000Config-Model-Itself-2.006# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.007. Build.PL CONTRIBUTING.md Changes LICENSE MANIFEST META.json META.yml README.md config-model-edit 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 META.json100644001750001750 441612766275757 16012 0ustar00domidomi000000000000Config-Model-Itself-2.006{ "abstract" : "Model editor for Config::Model", "author" : [ "Dominique Dumont" ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 6.007, CPAN::Meta::Converter version 2.150010", "license" : [ "lgpl_2_1" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Config-Model-Itself", "prereqs" : { "build" : { "requires" : { "App::Cme" : "1.002", "Module::Build" : "0.34" } }, "configure" : { "requires" : { "Module::Build" : "0.34" } }, "runtime" : { "requires" : { "App::Cme" : "1.002", "App::Cme::Common" : "0", "Carp" : "0", "Config::Model" : "2.091", "Config::Model::TkUI" : "1.210", "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", "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::File::Contents" : "0", "Test::Memory::Cycle" : "0", "Test::More" : "0", "Text::Diff" : "0" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "mailto" : "ddumont at cpan.org", "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-itself.git", "web" : "http://github.com/dod38fr/config-model-itself" } }, "version" : "2.006", "x_serialization_backend" : "Cpanel::JSON::XS version 3.0217" } README.md100644001750001750 500012766275757 15636 0ustar00domidomi000000000000Config-Model-Itself-2.006 ## 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 libconfig-model-itself-perl Otherwise: cpanm Config::Model::Itself weaver.ini100644001750001750 22512766275757 16335 0ustar00domidomi000000000000Config-Model-Itself-2.006[@Default] [-Transformer] transformer = List [Support] perldoc = 0 bugs = metadata websites = search,anno,ratings,kwalitee,testers,testmatrix,deps itself.t100644001750001750 1766312766275757 16337 0ustar00domidomi000000000000Config-Model-Itself-2.006/t# -*- 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; pod_gen.t100644001750001750 542212766275757 16432 0ustar00domidomi000000000000Config-Model-Itself-2.006/t# -*- 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) ; cme-meta.t100644001750001750 360712766275757 16512 0ustar00domidomi000000000000Config-Model-Itself-2.006/t# -*- 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; dot_graph.t100644001750001750 277012766275757 16771 0ustar00domidomi000000000000Config-Model-Itself-2.006/t# -*- 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); CONTRIBUTING.md100644001750001750 621312766275757 16617 0ustar00domidomi000000000000Config-Model-Itself-2.006# 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@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@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@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) config-model-edit100644001750001750 2522612766275757 17624 0ustar00domidomi000000000000Config-Model-Itself-2.006#!/usr/bin/env perl # # This file is part of Config-Model-Itself # # This software is Copyright (c) 2007-2016 by Dominique Dumont. # # This is free software, licensed under: # # The GNU Lesser General Public License, Version 2.1, February 1999 # use strict ; use warnings ; use 5.10.1; use Config::Model; use Getopt::Long ; use Pod::Usage ; use Log::Log4perl ; use Config::Model::Itself ; use YAML::Tiny; use Tk ; use Config::Model::TkUI ; use Config::Model::Itself::TkEditUI ; use Path::Tiny ; use lib qw/lib/ ; my $log4perl_syst_conf_file = '/etc/log4config-model.conf' ; my $log4perl_user_conf_file = $ENV{HOME}.'/.log4config-model' ; my $fallback_conf = << 'EOC'; 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 EOC my $log4perl_conf = -e $log4perl_user_conf_file ? $log4perl_user_conf_file : -e $log4perl_syst_conf_file ? $log4perl_syst_conf_file : \$fallback_conf ; Log::Log4perl::init($log4perl_conf); my $dev_cm_lib_dir = path(qw/lib Config Model/); my $root_model ; my $trace = 0 ; sub load_data { my $load_file = shift ; my @data ; if ( $load_file eq '-' ) { @data = ; } else { open(LOAD,$load_file) || die "cannot open load file $load_file:$!"; @data = ; close LOAD; } return wantarray ? @data : join('',@data); } my $man = 0; my $help = 0; my $force_load = 0; my $model_dir_path ; my $do_dot = 0; my $do_dump; my $dumptype; my $do_yaml = 0; my $load_yaml ; my $save = 0; my $load ; # my $model_modified = 0; my $open_item = ''; my $plugin_file = ''; my $read_system; my $result = GetOptions ( "dir=s" => \$model_dir_path, "model=s" => \$root_model, "man!" => \$man, "help!" => \$help, "force-load|force_load!" => \$force_load, "save!" => \$save, "dot-diagram|dot_diagram!" => \$do_dot , "dump:s" => \$do_dump , "dumptype=s" => \$dumptype, "load=s" => \$load, "load-yaml|load_yaml=s" => \$load_yaml, "dump-yaml|dump_yaml!" => \$do_yaml , "open-item|open_item=s" => \$open_item , "plugin-file=s" => \$plugin_file , "system!" => \$read_system, ); pod2usage(2) if not $result ; pod2usage(1) if $help; pod2usage(-verbose => 2) if $man; Config::Model::Exception::Any->Trace(1) if $trace ; say 'This command is deprecated, please use "cme meta edit"'; die "Unspecified root configuration model (option -model)\n" unless defined $root_model ; my $model_dir = $model_dir_path ? path(split m!/!, $model_dir_path) : $dev_cm_lib_dir ; if (! $model_dir->is_dir) { $model_dir->mkpath(0, 0755) || die "can't create $model_dir:$!"; } my $meta_model = Config::Model -> new(); my $meta_inst = $meta_model->instance( root_class_name => 'Itself::Model', instance_name => $root_model . ' model', check => $force_load ? 'no' : 'yes', ); my $meta_root = $meta_inst -> config_root ; my $system_model_dir = $INC{'Config/Model.pm'} ; $system_model_dir =~ s/\.pm//; my $meta_model_dir = ($read_system || $plugin_file) ? $system_model_dir : $model_dir->canonpath ; say "Reading model from $meta_model_dir" if $read_system; # now load model my $rw_obj = Config::Model::Itself -> new( model_object => $meta_root, cm_lib_dir => $meta_model_dir, ) ; # my $root_model_file = $root_model ; # $root_model_file =~ s!::!/!g ; # if (not -e $read_model_dir.'/'.$root_model_file.'.pl') { # $read_model_dir = $INC{'Config/Model.pm'} ; # $read_model_dir =~ s/\.pm//; # $read_model_dir .= '/models' ; # } $meta_inst->initial_load_start ; $meta_inst->layered_start if $plugin_file; $rw_obj->read_all( force_load => $force_load, root_model => $root_model, # legacy => 'ignore', ); if ($plugin_file) { $meta_inst->layered_stop; # load any existing plugin file $rw_obj->read_model_snippet(snippet_dir => $model_dir, model_file => $plugin_file) ; } $meta_inst->initial_load_stop ; if (defined $load) { my $data = load_data($load) ; $data = qq(class:"$root_model" ).$data unless $data =~ /^\s*class:/ ; $meta_root->load($data); } if (defined $load_yaml) { my $yaml = load_data($load_yaml) ; my $pdata = Load($yaml) ; $meta_root->load_data($pdata) ; } if (@ARGV) { my $data = join(' ',@ARGV) ; $data = qq(class:"$root_model" ).$data unless $data =~ /^\s*class:/ ; $meta_root->load($data) ; } if ($do_dot) { print $rw_obj->get_dot_diagram ; exit ; } if (defined $do_dump) { my $dump_string = $meta_root->dump_tree( mode => $dumptype || 'custom' ) ; if ($do_dump) { open(DUMP,">$do_dump") or die "cannot dump in $do_dump:$!"; print DUMP $dump_string ; close DUMP; } else { print $dump_string ; } exit ; } if ($do_yaml) { require YAML::Tiny; import YAML::Tiny qw/Dump/; print Dump($meta_root->dump_as_data(ordered_hash_as_list => 0)) ; exit ; } my $write_sub = $plugin_file ? sub { $rw_obj->write_model_snippet(snippet_dir => $model_dir, model_file => $plugin_file ); } : sub { my $wr_dir = shift || $model_dir ; $rw_obj->write_all( ); } ; if ($save) { &$write_sub ; exit ; } 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, ); if (not $meta_root->fetch_element('class')->fetch_size) { $open_item ||= qq(class:"$root_model" ); } else { $open_item ||= 'class'; } if ($open_item) { my $obj = $meta_root->grab($open_item) ; $cmu->after(10, sub { $cmu->force_element_display($obj) }); } &MainLoop ; # Tk's __END__ =pod =head1 NAME config-model-edit - Deprecated use cme meta edit =head1 SYNOPSIS config-model-edit [options] -model Sshd [ class:Sshd element:Foo ... ] # plugin mode config-model-edit [options] -model Debian::Dpkg -plugin-file dpkg-snippet.pl =head1 DESCRIPTION config-model-edit will provides a Perl/Tk graphical interface to edit configuration models that will be used by Config::Model. Config::Model is a general purpose configuration framework based on configuration models (See L for details). 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 L. The structure and rules documented in L are also expressed in a model in the files provided with L. Hence the possibity to verify, modify configuration data provided by Config::Model can also be applied on configuration models using the same user interface as L. The model editor program is config-model-edit. =head1 USAGE C will read and write model file from C<./lib/Config/Model/models>. When you specify a C<-model> options, only configuration models matching this options will be loaded. I.e. config-model-edit -model Xorg will load models C (file C) and all other C like C (file C). =head1 Options =over =item -model Mandatory option that specifies the configuration model to be edited. =item -plugin-file foo.pl this option can be used to create model plugins. A model plugin is an addendum to an existing model. The resulting file will be saved in a C<.d> directory besides the original file to be taken into account. For instance: $ config-model-edit -model Debian::Dpkg -plugin-file my-plugin.pl # perform additions to Debian::Dpkg and Debian::Dpkg::Control::Source and save $ find lib -name my-plugin.pl lib/Config/Model/models/Debian/Dpkg.d/my-plugin.pl lib/Config/Model/models/Debian/Dpkg/Control/Source.d/my-plugin.pl =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 -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 -dot-diagram Returns a dot file that represent the structure of the configuration model. C are represented by solid lines. Class usage (i.e. C parameter) is represented by dashed lines. The name of the element is attached to the dashed line. =item -dump [ file ] Dump configuration content on STDOUT or in the specified with Config::Model 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 =item -dumptype [ full | preset | custom ] Choose to dump every values (full), only preset values or only customized values (default) =item -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 | - Load configuration data in model from YAML file. This option can be used with C<-save> to directly save a model loaded from the YAML file or from STDIN. =item -dump_yaml Dump a model in YAML format =item -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. =item -dir Directory where to read and write model =item -open-item 'path' In graphical mode, force the UI to open the node specified. 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. 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 =head1 AUTHOR Dominique Dumont, ddumont at cpan dot org =head1 SEE ALSO L, L, L, L, L, L, L =cut cme-meta-edit.t100644001750001750 167712766275757 17442 0ustar00domidomi000000000000Config-Model-Itself-2.006/t# -*- 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; itself-editor.t100644001750001750 1143512766275757 17612 0ustar00domidomi000000000000Config-Model-Itself-2.006/t# -*- 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,@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"); backend_detect.t100644001750001750 315412766275757 17736 0ustar00domidomi000000000000Config-Model-Itself-2.006/t# -*- 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/, "Found Yaml NAME section from pod") ; $help = $backend->get_help('cds_file') ; is($help,"file ...", "cds_file help was kept") ; memory_cycle_ok($model); itself_snippet.t100644001750001750 1014012766275757 20060 0ustar00domidomi000000000000Config-Model-Itself-2.006/t# -*- 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_snippet = "$wr_test/wr_snippet"; 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 snippets, read model in layered mode my $meta_snippet_inst = $meta_model->instance( root_class_name => 'Itself::Model', instance_name => 'itself_snippet', root_dir => $wr_model1, ); ok($meta_snippet_inst,"Read Itself::Model and created instance for model snippet") ; my $meta_snippet_root = $meta_snippet_inst -> config_root ; my $snippet_rw_obj = Config::Model::Itself -> new( model_object => $meta_snippet_root, cm_lib_dir => 'data', ) ; $meta_snippet_inst->layered_start ; $snippet_rw_obj -> read_all( root_model => 'MasterModel', legacy => 'ignore', ) ; ok(1,"Read all models in data dir in layered mode") ; $meta_snippet_inst->layered_stop ; # modify model, X_base_class2 is not a mistake $meta_snippet_root->load(q!class:MasterModel::X_base_class2 element:X#"X note" help:Cv="Mighty help for Cv"!); $meta_snippet_root->load(q!class:MasterModel element:a_string warn_if_match:meh msg="said meh"!); $snippet_rw_obj->write_model_snippet(snippet_dir => $wr_snippet, model_file=> 'snippet.pl') ; my %expected_snippet; $expected_snippet{MasterModel} = << "EOS" ; [ { 'element' => [ 'a_string', { 'warn_if_match' => { 'meh' => { 'msg' => 'said meh' } } } ], 'name' => 'MasterModel' } ] ; EOS $expected_snippet{"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_snippet."/$_.d/snippet.pl", $expected_snippet{$_}, "genereted $_ snippet file"; } keys %expected_snippet ; my $meta_snippet_inst2 = $meta_model->instance( root_class_name => 'Itself::Model', instance_name => 'itself_snippet', root_dir => $wr_model1, ); ok($meta_snippet_inst2,"Read Itself::Model and created instance for model snippet") ; my $meta_snippet_root2 = $meta_snippet_inst2 -> config_root ; my $snippet_rw_obj2 = Config::Model::Itself -> new( cm_lib_dir => 'data', model_object => $meta_snippet_root2, ) ; $meta_snippet_inst2->layered_start ; $snippet_rw_obj2->read_all( root_model => 'MasterModel', legacy => 'ignore', ); ok(1,"Read all models in data dir in layered mode") ; $meta_snippet_inst->layered_stop ; $snippet_rw_obj2->read_model_snippet(snippet_dir => $wr_snippet, model_file=> 'snippet.pl') ; $snippet_rw_obj2->write_model_snippet(snippet_dir => $wr_snippet, model_file=> 'snippet2.pl') ; map { file_contents_eq_or_diff $wr_snippet."/$_.d/snippet2.pl", $expected_snippet{$_}, "regenerated $_ snippet file"; } keys %expected_snippet ; cme-meta-plugin.t100644001750001750 324312766275757 20002 0ustar00domidomi000000000000Config-Model-Itself-2.006/t# -*- 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.pl/, '-test-and-quit' => 's', '-load' => $plug->stringify, '-dir' => $wr_test->stringify, ] ) ; like($result->stdout , qr/Preparing 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('Fstab/CommonOptions.d/my-plugin.pl'); file_contents_like $plug_out, qr/'mandatory' => '1'/, "check content of $plug_out"; } } done_testing; load_write_itself.t100644001750001750 517312766275757 20521 0ustar00domidomi000000000000Config-Model-Itself-2.006/t# -*- 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" } ); } application.d000755001750001750 012766275757 17662 5ustar00domidomi000000000000Config-Model-Itself-2.006/datamaster100644001750001750 6312766275757 21177 0ustar00domidomi000000000000Config-Model-Itself-2.006/data/application.dmodel = MasterModel allow_config_file_override = 1 list_itself_structure.t100644001750001750 245212766275757 21460 0ustar00domidomi000000000000Config-Model-Itself-2.006/t# -*- 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; models000755001750001750 012766275757 16420 5ustar00domidomi000000000000Config-Model-Itself-2.006/dataMasterModel.pl100644001750001750 3212512766275757 21354 0ustar00domidomi000000000000Config-Model-Itself-2.006/data/models# -*- cperl -*- # # This file is part of Config-Model-Itself # # This software is Copyright (c) 2007-2016 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 Model000755001750001750 012766275757 17237 5ustar00domidomi000000000000Config-Model-Itself-2.006/lib/ConfigItself.pm100644001750001750 7034312766275757 21212 0ustar00domidomi000000000000Config-Model-Itself-2.006/lib/Config/Model# # This file is part of Config-Model-Itself # # This software is Copyright (c) 2007-2016 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.006'; use Mouse ; use Config::Model 2.091; 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; 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! ) ; } ; $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('',@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_snippet { my $self = shift ; my %args = @_ ; my $snippet_dir = delete $args{snippet_dir} || croak __PACKAGE__," write_model_snippet: undefined snippet_dir"; my $model_file = delete $args{model_file} || croak __PACKAGE__," write_model_snippet: undefined model_file"; croak "write_model_snippet: 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 $class_dir = $class.'.d'; $class_dir =~ s!::!/!g; write_model_file ("$snippet_dir/$class_dir/$model_file", [], \@notes, [ $data ]); } $self->meta_instance->clear_changes ; } sub read_model_snippet { my $self = shift ; my %args = @_ ; my $snippet_dir = delete $args{snippet_dir} || croak __PACKAGE__," write_model_snippet: undefined snippet_dir"; my $model_file = delete $args{model_file} || croak __PACKAGE__," read_model_snippet: undefined model_file"; croak "read_model_snippet: 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/$model_file! ) ; } ; find ($wanted, $snippet_dir ) ; my $class_element = $self->meta_root->fetch_element('class') ; foreach my $load_file (@files) { $logger->info("trying to read snippet $load_file"); $load_file = "./$load_file" if $load_file !~ m!^/! and -e $load_file; my $snippet = do $load_file ; unless ($snippet) { if ($@) {die "couldn't parse $load_file: $@"; } elsif (not defined $snippet) {die "couldn't do $load_file: $!"} else { die "couldn't run $load_file" ;} } # there should be only only class in each snippet file foreach my $model (@$snippet) { 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 snippet 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('',@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.006 =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. 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 L. The structure and rules documented in L are also expressed in a model in the files provided with C. Hence the possibity to verify, modify configuration data provided by 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 specifies where are the model files (defaults to C<./lib/Config/Model>. C is either a C object or a string. By default, this constructor will create all necessary C objects. If needed, you can pass already created object with options C (L object), C (L object) or C (L object). =head2 Methods =head1 read_all ( [ root_model => ... ], [ force_load => 1 ] ) Load all the model files contained in C and all its subdirectories. C is used to filter the classes read. Use C if you are trying to load a model containing errors. C 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_snippet( snippet_dir => foo, model_file => bar.pl ) Write snippet models in separate C<.d> directory. E.g. a snippet for class C will be written in C file. This file is to be used by L '...', class_data )"> =head2 read_model_snippet( snippet_dir => foo, model_file => bar.pl ) To read model snippets, this methid will search recursively C<$snippet_dir> and load all C files found in 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 relations are represented by solid lines =item * Class usage (i.e. C 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 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, L, L =head1 AUTHOR Dominique Dumont =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2007-2016 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 =item * AnnoCPAN The AnnoCPAN is a website that allows community annotations of Perl module documentation. L =item * CPAN Ratings The CPAN Ratings is a website that allows community ratings and reviews of Perl modules. L =item * CPANTS The CPANTS is a website that analyzes the Kwalitee ( code metrics ) of a distribution. L =item * CPAN Testers The CPAN Testers is a network of smokers who run automated tests on uploaded CPAN distributions. L =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 =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 =back =head2 Bugs / Feature Requests Please report any bugs or feature requests by email to C, or through the web interface at L. 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 git clone git://github.com/dod38fr/config-model-itself.git =cut Command000755001750001750 012766275757 17574 5ustar00domidomi000000000000Config-Model-Itself-2.006/lib/App/Cmemeta.pm100644001750001750 3767412766275757 21261 0ustar00domidomi000000000000Config-Model-Itself-2.006/lib/App/Cme/Command# # This file is part of Config-Model-Itself # # This software is Copyright (c) 2007-2016 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.006'; 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 [ edit | gendot | dump | yaml ] 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 = ; } else { open(LOAD,$load_file) || die "cannot open load file $load_file:$!"; @data = ; close LOAD; } return wantarray ? @data : join('',@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, $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 = $system_cm_lib_dir ; my $plugin_file = shift @$args or die "missing plugin file name after application name."; say "Preparing plugin for model $root_model"; # now load model my $rw_obj = Config::Model::Itself -> new( model_object => $meta_root, cm_lib_dir => $meta_cm_lib_dir, ) ; $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_snippet(snippet_dir => $cm_lib_dir, model_file => $plugin_file) ; $meta_inst->initial_load_stop ; $self->load_optional_data($args, $opt, $root_model, $meta_root) ; my $write_sub = sub { $rw_obj->write_model_snippet( snippet_dir => $cm_lib_dir, model_file => $plugin_file ); } ; 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.006 =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 Debian::Dpkg dpkg-snippet.pl =head1 DESCRIPTION C provides a Perl/Tk graphical interface to create or edit configuration models that will be used by L. This tool enables you to create configuration checker or editor for configuration files of an application. =head1 USAGE C supports several sub commands like C or C. These sub commands are detailed below. =head2 edit C 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 (file C) and all other C like C (file C). Besides C, the following sub commands are available: =head2 check C 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 will be saved in a C<.d> directory besides the original file to be taken into account. For instance: $ cme meta plugin Debian::Dpkg my-plugin.pl # perform additions to Debian::Dpkg and Debian::Dpkg::Control::Source and save $ find lib -name my-plugin.pl lib/Config/Model/models/Debian/Dpkg.d/my-plugin.pl lib/Config/Model/models/Debian/Dpkg/Control/Source.d/my-plugin.pl =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 $ cme meta gen-dot Itself itself.dot $ dot -T png itself.dot > itself.png C are represented by solid lines. Class usage (i.e. C 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) using Config::Model dump string syntax (hence the C file extension). See L 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) 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 | - Load model from cds file (using Config::Model serialisation format, typically done with -dump option). This option can be used with C to directly save a model loaded from the cds file or from STDIN. =item -load-yaml | - Load configuration data in model from YAML file. This option can be used with C 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 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. 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 =head1 Dogfooding The GUI shown by C 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). This explains why the GUI shown by C looks like the GUI shown by C: the same GUI generator is used>. If you're new to L, I'd advise not to peek under C hood lest you'll loose your sanity. =head1 AUTHOR Dominique Dumont, ddumont at cpan dot org =head1 SEE ALSO =over =item * L =item * L, =item * L, =item * L, =item * L, =item * L, =item * L, =item * L, =item * L, =item * L =back =head1 AUTHOR Dominique Dumont =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2007-2016 by Dominique Dumont. This is free software, licensed under: The GNU Lesser General Public License, Version 2.1, February 1999 =cut contrib000755001750001750 012766275757 15664 5ustar00domidomi000000000000Config-Model-Itself-2.006bash_completion.cme_meta100644001750001750 233412766275757 22670 0ustar00domidomi000000000000Config-Model-Itself-2.006/contrib# 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; } MasterModel000755001750001750 012766275757 20634 5ustar00domidomi000000000000Config-Model-Itself-2.006/data/modelsWarpedId.pl100644001750001750 656112766275757 23040 0ustar00domidomi000000000000Config-Model-Itself-2.006/data/models/MasterModel# # This file is part of Config-Model-Itself # # This software is Copyright (c) 2007-2016 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' } ] ] ]; Itself000755001750001750 012766275757 20465 5ustar00domidomi000000000000Config-Model-Itself-2.006/lib/Config/ModelTkEditUI.pm100644001750001750 1032512766275757 22626 0ustar00domidomi000000000000Config-Model-Itself-2.006/lib/Config/Model/Itself# # This file is part of Config-Model-Itself # # This software is Copyright (c) 2007-2016 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.006'; 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; References.pl100644001750001750 606312766275757 23417 0ustar00domidomi000000000000Config-Model-Itself-2.006/data/models/MasterModel# # This file is part of Config-Model-Itself # # This software is Copyright (c) 2007-2016 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', }, ] ] ]; X_base_class.pl100644001750001750 140612766275757 23720 0ustar00domidomi000000000000Config-Model-Itself-2.006/data/models/MasterModel# -*- cperl -*- # # This file is part of Config-Model-Itself # # This software is Copyright (c) 2007-2016 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 WarpedValues.pl100644001750001750 2000512766275757 23750 0ustar00domidomi000000000000Config-Model-Itself-2.006/data/models/MasterModel# # This file is part of Config-Model-Itself # # This software is Copyright (c) 2007-2016 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' } ], ] ]; Itself000755001750001750 012766275757 21750 5ustar00domidomi000000000000Config-Model-Itself-2.006/lib/Config/Model/modelsModel.pl100644001750001750 216112766275757 23505 0ustar00domidomi000000000000Config-Model-Itself-2.006/lib/Config/Model/models/Itself# # This file is part of Config-Model-Itself # # This software is Copyright (c) 2007-2016 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 ' ], ], ]; Class.pl100644001750001750 4604712766275757 23545 0ustar00domidomi000000000000Config-Model-Itself-2.006/lib/Config/Model/models/Itself# # This file is part of Config-Model-Itself # # This software is Copyright (c) 2007-2016 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. 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 will be re-used to generate the documentation of your configuration class. You can use pod markup to format your description. See L for details.", read_config => "Specify the Perl class(es) and function(s) used to read configuration data. The specified function will be 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 will accept as valid. " ."The key of the hash is a regular expression that will 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 will be 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) ! .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 ' .'will be used as base name for your configuration file.', }, ] ], [ 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", } }, 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) 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 will contain all INI classes. ' .'See L', warp => { follow => '- backend', rules => [ IniFile => { level => 'normal', } ], } }, 'section_map' => { type => 'hash', level => 'hidden', index_type => 'string', description => 'Specify element name that will contain 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 => 'comment starts with this character', 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 will' . ' not change the behavior but will help generating more consistent ' . ' user interfaces' } ], ], ]; Class.pod100644001750001750 665512766275757 23675 0ustar00domidomi000000000000Config-Model-Itself-2.006/lib/Config/Model/models/Itself# 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 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 will be re-used to generate the documentation of your configuration class. You can use pod markup to format your description. See L 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. 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 . >> =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 function will be tried in sequence to get configuration data. I<< Optional. Type list of node of class L . >> =head2 write_config Specify the Perl class and function used to write configuration data. I<< Optional. Type list of node of class L . >> =head2 accept Specifies names of the elements this configuration class will accept as valid. The key of the hash is a regular expression that will 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 will be eval'ed with a leading C<^> and a trailing C<$>. I<< Optional. Type hash of node of class L . >> =head1 SEE ALSO =over =item * L =item * L =item * L =item * L =item * L =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 HashIdOfValues.pl100644001750001750 457312766275757 24147 0ustar00domidomi000000000000Config-Model-Itself-2.006/data/models/MasterModel# # This file is part of Config-Model-Itself # # This software is Copyright (c) 2007-2016 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, }, ], ] ]; Element.pl100644001750001750 1035312766275757 24060 0ustar00domidomi000000000000Config-Model-Itself-2.006/lib/Config/Model/models/Itself# # This file is part of Config-Model-Itself # # This software is Copyright (c) 2007-2016 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', } ], ], ]; Element.pod100644001750001750 2277112766275757 24236 0ustar00domidomi000000000000Config-Model-Itself-2.006/lib/Config/Model/models/Itself# 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 =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 will be attemped. When a copy is not possible, undef values will be assigned. 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 will be written in the configuration data. I<< Optional. Type uniline. >> =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 uniline. >> =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$> will allow C or C but not C. To be case insentive, use the C<(?i)> extended pattern. For instance, the regexp C<^(?i)foo|bar$> will also allow the values C and C. I<< Optional. Type uniline. >> =head2 assert Raise an error if the test code snippet does returns false. Note this snippet will also be run on undefined value, which may not be what you want. I<< Optional. Type hash of node of class L . >> =head2 warn_if Warn user if the code snippet returns true. I<< Optional. Type hash of node of class L . >> =head2 warn_unless Warn user if the code snippet returns false. I<< Optional. Type hash of node of class L . >> =head2 warn_if_match Warn user if a I value matches the regular expression. I<< Optional. Type hash of node of class L . >> =head2 warn_unless_match Warn user if I value does not match the regular expression. I<< Optional. Type hash of node of class L . >> =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 will allow 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 will contain 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 . >> =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 =item * L =item * L =item * L =back =cut BackendDetector.pm100644001750001750 1032712766275757 24227 0ustar00domidomi000000000000Config-Model-Itself-2.006/lib/Config/Model/Itself# # This file is part of Config-Model-Itself # # This software is Copyright (c) 2007-2016 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.006'; # 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.006 =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. It is designed to be used in a 'enum' value where the choice (the available backends) are the backend built in L and all the plugin backends. The plugin backends are all the C 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, L, L =head1 AUTHOR Dominique Dumont =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2007-2016 by Dominique Dumont. This is free software, licensed under: The GNU Lesser General Public License, Version 2.1, February 1999 =cut WarpValue.pl100644001750001750 325612766275757 24361 0ustar00domidomi000000000000Config-Model-Itself-2.006/lib/Config/Model/models/Itself# # This file is part of Config-Model-Itself # # This software is Copyright (c) 2007-2016 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 a path the configuration element that will drive the warp , i.e .the elements that control the property change. These a 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', }, ], ], ]; CheckListExamples.pl100644001750001750 501012766275757 24675 0ustar00domidomi000000000000Config-Model-Itself-2.006/data/models/MasterModel# # This file is part of Config-Model-Itself # # This software is Copyright (c) 2007-2016 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' }, ] ] ]; WarpValue.pod100644001750001750 210412766275757 24517 0ustar00domidomi000000000000Config-Model-Itself-2.006/lib/Config/Model/models/Itself# 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 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 a path the configuration element that will drive the warp , i.e .the elements that control the property change. These a 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 =back =cut ConfigRead.pod100644001750001750 1213412766275757 24636 0ustar00domidomi000000000000Config-Model-Itself-2.006/lib/Config/Model/models/Itself# 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 =head1 Elements =head2 syntax Deprecated parameter that specified the file syntax to store permanently configuration data. Replaced by "backend" B 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) 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 will be used as base name for your configuration file. 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) that is overridden by user's file. I<< Optional. Type node of class L . >> =head2 class I<< Optional. Type uniline. >> =head2 store_class_in_hash Specify element hash name that will contain all INI classes. See L I<< Optional. Type uniline. >> =head2 section_map Specify element name that will contain 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 comment starts with this character. 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 I<< Optional. Type boolean. upstream_default: '0'. >> =head1 SEE ALSO =over =item * L =item * L =back =cut Application.pl100644001750001750 440412766275757 24712 0ustar00domidomi000000000000Config-Model-Itself-2.006/lib/Config/Model/models/Itself# # This file is part of Config-Model-Itself # # This software is Copyright (c) 2007-2016 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', }, 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', 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', } }, 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." }, ], } ] ; ConfigWrite.pod100644001750001750 1161612766275757 25061 0ustar00domidomi000000000000Config-Model-Itself-2.006/lib/Config/Model/models/Itself# 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 =head1 Elements =head2 syntax Deprecated parameter that specified the file syntax to store permanently configuration data. Replaced by "backend" B 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) 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 will be used as base name for your configuration file. 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) that is overridden by user's file. I<< Optional. Type node of class L . >> =head2 class I<< Optional. Type uniline. >> =head2 store_class_in_hash Specify element hash name that will contain all INI classes. See L I<< Optional. Type uniline. >> =head2 section_map Specify element name that will contain 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 comment starts with this character. 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 =item * L =back =cut CargoElement.pl100644001750001750 307712766275757 25021 0ustar00domidomi000000000000Config-Model-Itself-2.006/lib/Config/Model/models/Itself# # This file is part of Config-Model-Itself # # This software is Copyright (c) 2007-2016 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. " }, ], ], ]; CommonElement.pl100644001750001750 3300012766275757 25223 0ustar00domidomi000000000000Config-Model-Itself-2.006/lib/Config/Model/models/Itself# # This file is part of Config-Model-Itself # # This software is Copyright (c) 2007-2016 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. "$_" will contain 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. $_ will contain the value to fix. $_ will be stored as the new value once the instructions are done. C<$self> will contain 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. $_ will contain the value to test. C<$self> will contain 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 => 'uniline', description => 'Specify default value. This default value will be written in the configuration data', warp => { follow => { 't' => '?type' }, 'rules' => [ '$t eq "leaf"' => { level => 'normal', } ] } }, 'upstream_default' => { type => 'leaf', level => 'hidden', value_type => 'uniline', 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$> will allow ! . q!C or C but not C. To be case insentive, ! . q!use the C<(?i)> extended pattern. For instance, the regexp ! . q!C<^(?i)foo|bar$> will also allow the values ! . q!C and C.!, @warp_in_uniline_or_string, }, 'assert' => { %assert_payload, description => 'Raise an error if the test code snippet does returns false. Note this snippet will ' . 'also be 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 value matches the regular expression. ', }, 'warn_unless_match' => { %warn_if_match_payload, description => 'Warn user if I 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 ], ], ]; ComputedValue.pl100644001750001750 213012766275757 25216 0ustar00domidomi000000000000Config-Model-Itself-2.006/lib/Config/Model/models/Itself# # This file is part of Config-Model-Itself # # This software is Copyright (c) 2007-2016 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", }, '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." }, ], ], ]; ConfigAccept.pod100644001750001750 2345012766275757 25165 0ustar00domidomi000000000000Config-Model-Itself-2.006/lib/Config/Model/models/Itself# 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 =head1 Elements =head2 name_match B I<< Optional. Type uniline. upstream_default: '.*'. >> =head2 accept_after specify where to insert accepted element. This will not change the behavior but will help 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 will be attemped. When a copy is not possible, undef values will be assigned. 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 will be written in the configuration data. I<< Optional. Type uniline. >> =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 uniline. >> =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$> will allow C or C but not C. To be case insentive, use the C<(?i)> extended pattern. For instance, the regexp C<^(?i)foo|bar$> will also allow the values C and C. I<< Optional. Type uniline. >> =head2 assert Raise an error if the test code snippet does returns false. Note this snippet will also be run on undefined value, which may not be what you want. I<< Optional. Type hash of node of class L . >> =head2 warn_if Warn user if the code snippet returns true. I<< Optional. Type hash of node of class L . >> =head2 warn_unless Warn user if the code snippet returns false. I<< Optional. Type hash of node of class L . >> =head2 warn_if_match Warn user if a I value matches the regular expression. I<< Optional. Type hash of node of class L . >> =head2 warn_unless_match Warn user if I value does not match the regular expression. I<< Optional. Type hash of node of class L . >> =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 will allow 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 will contain 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 . >> =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 =item * L =item * L =item * L =back =cut MigratedValue.pl100644001750001750 424212766275757 25200 0ustar00domidomi000000000000Config-Model-Itself-2.006/lib/Config/Model/models/Itself# # This file is part of Config-Model-Itself # # This software is Copyright (c) 2007-2016 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\' ', }, '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" ', }, '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\' ', }, '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 will force an eval by Perl when computing the formula. The result of the eval will be used as the computed value.' }, 'undef_is' => { type => 'leaf', value_type => 'uniline', description => 'Specify a replacement for undefined variables. This will replace undef' .' values in the formula before migrating values. Use \'\' (2 single quotes) ' . 'if you want to specify an empty string', }, ], ], ]; WarpOnlyElement.pl100644001750001750 216512766275757 25536 0ustar00domidomi000000000000Config-Model-Itself-2.006/lib/Config/Model/models/Itself# # This file is part of Config-Model-Itself # # This software is Copyright (c) 2007-2016 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', ], ], ]; WarpableElement.pl100644001750001750 1577312766275757 25551 0ustar00domidomi000000000000Config-Model-Itself-2.006/lib/Config/Model/models/Itself# # This file is part of Config-Model-Itself # # This software is Copyright (c) 2007-2016 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 will contain the same keys as the hash pointed by the path string', allow_keys_from => 'this hash will allow 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".', ], ], ]; NonWarpableElement.pl100644001750001750 2255712766275757 26222 0ustar00domidomi000000000000Config-Model-Itself-2.006/lib/Config/Model/models/Itself# # This file is part of Config-Model-Itself # # This software is Copyright (c) 2007-2016 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 will be attemped. When a copy is not possible, " . "undef values will be assigned.", }, # 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 ], ], ]; WarpableCargoElement.pl100644001750001750 251412766275757 26472 0ustar00domidomi000000000000Config-Model-Itself-2.006/lib/Config/Model/models/Itself# # This file is part of Config-Model-Itself # # This software is Copyright (c) 2007-2016 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', ], ]; CommonElement000755001750001750 012766275757 24512 5ustar00domidomi000000000000Config-Model-Itself-2.006/lib/Config/Model/models/ItselfAssert.pod100644001750001750 201712766275757 26617 0ustar00domidomi000000000000Config-Model-Itself-2.006/lib/Config/Model/models/Itself/CommonElement# 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 =head1 Elements =head2 code Perl instructions to test the value. $_ will contain the value to test. C<$self> will contain the value object. Use with care. I<< Optional. Type string. >> =head2 msg Warning message to show user. "$_" will contain 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. $_ will contain the value to fix. $_ will be stored as the new value once the instructions are done. C<$self> will contain the value object. Use with care. I<< Optional. Type string. >> =head1 SEE ALSO =over =item * L =back =cut ConfigWR000755001750001750 012766275757 23426 5ustar00domidomi000000000000Config-Model-Itself-2.006/lib/Config/Model/models/ItselfDefaultLayer.pod100644001750001750 212012766275757 26646 0ustar00domidomi000000000000Config-Model-Itself-2.006/lib/Config/Model/models/Itself/ConfigWR# 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 =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) 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 will be used as base name for your configuration file. I<< Optional. Type uniline. >> =head1 SEE ALSO =over =item * L =back =cut WarnIfMatch.pod100644001750001750 156612766275757 27531 0ustar00domidomi000000000000Config-Model-Itself-2.006/lib/Config/Model/models/Itself/CommonElement# 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 =head1 Elements =head2 msg Warning message to show user. "$_" will contain 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. $_ will contain the value to fix. $_ will be stored as the new value once the instructions are done. C<$self> will contain the value object. Use with care. I<< Optional. Type string. >> =head1 SEE ALSO =over =item * L =back =cut