Commit 93366919303c2d38c3ef238a9b1eb7c97849101d - libconfig-model-itself-perl

+1

-0

Build.PL less more

68	68	'Getopt::Long' => '0',
69	69	'Module::Build' => '0.34',
70	70	'Test::Differences' => '0',
	71	'Test::Exception' => '0',
71	72	'Test::File::Contents' => '0',
72	73	'Test::Memory::Cycle' => '0',
73	74	'Test::More' => '0',

+9

-0

Changes less more

	0	2.021 2021-01-13
	1
	2	A new 2.021 release for 2021 :-)
	3
	4	Bug fix:
	5	* fix error message when attaching Config class to unknown Perl class
	6	* update rw_config file documentation in model
	7	* remove files of deleted application when writing back a model
	8
0	9	2.020 2019-12-29
1	10
2	11	Dependencies:

+4

-1

MANIFEST less more

0		# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.012.
	0	# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.017.
1	1	Build.PL
2	2	CONTRIBUTING.md
3	3	Changes

8	8	README-build-from-git.md
9	9	README.md
10	10	contrib/bash_completion.cme_meta
	11	data/application.d/goner
11	12	data/application.d/master
12	13	data/models/MasterModel.pl
13	14	data/models/MasterModel/CheckListExamples.pl

41	42	lib/Config/Model/models/Itself/WarpValue.pod
42	43	lib/Config/Model/models/Itself/WarpableCargoElement.pl
43	44	lib/Config/Model/models/Itself/WarpableElement.pl
	45	t/application.t
44	46	t/author-critic.t
45	47	t/backend_detect.t
46	48	t/cme-meta-edit.t

52	54	t/itself_snippet.t
53	55	t/list_itself_structure.t
54	56	t/load_write_itself.t
	57	t/meta-class.t
55	58	t/pod.t
56	59	t/pod_gen.t
57	60	weaver.ini

+6

-4

META.json less more

3	3	"Dominique Dumont"
4	4	],
5	5	"dynamic_config" : 0,
6		"generated_by" : "Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150010",
	6	"generated_by" : "Dist::Zilla version 6.017, CPAN::Meta::Converter version 2.150010",
7	7	"license" : [
8	8	"lgpl_2_1"
9	9	],

66	66	"File::Copy::Recursive" : "0",
67	67	"Getopt::Long" : "0",
68	68	"Test::Differences" : "0",
	69	"Test::Exception" : "0",
69	70	"Test::File::Contents" : "0",
70	71	"Test::Memory::Cycle" : "0",
71	72	"Test::More" : "0",

88	89	"web" : "http://github.com/dod38fr/config-model-itself"
89	90	}
90	91	},
91		"version" : "2.020",
92		"x_generated_by_perl" : "v5.30.0",
93		"x_serialization_backend" : "Cpanel::JSON::XS version 4.17"
	92	"version" : "2.021",
	93	"x_generated_by_perl" : "v5.32.0",
	94	"x_serialization_backend" : "Cpanel::JSON::XS version 4.25",
	95	"x_spdx_expression" : "LGPL-2.1"
94	96	}
95	97

+5

-3

META.yml less more

10	10	Getopt::Long: '0'
11	11	Module::Build: '0.34'
12	12	Test::Differences: '0'
	13	Test::Exception: '0'
13	14	Test::File::Contents: '0'
14	15	Test::Memory::Cycle: '0'
15	16	Test::More: '0'

19	20	configure_requires:
20	21	Module::Build: '0.34'
21	22	dynamic_config: 0
22		generated_by: 'Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150010'
	23	generated_by: 'Dist::Zilla version 6.017, CPAN::Meta::Converter version 2.150010'
23	24	license: lgpl
24	25	meta-spec:
25	26	url: http://module-build.sourceforge.net/META-spec-v1.4.html

55	56	bugtracker: https://github.com/dod38fr/config-model-itself/issues
56	57	homepage: https://github.com/dod38fr/config-model/wiki
57	58	repository: git://github.com/dod38fr/config-model-itself.git
58		version: '2.020'
59		x_generated_by_perl: v5.30.0
	59	version: '2.021'
	60	x_generated_by_perl: v5.32.0
60	61	x_serialization_backend: 'YAML::Tiny version 1.73'
	62	x_spdx_expression: LGPL-2.1

+2

-0

data/application.d/goner less more

	0	model = MasterModel
	1	allow_config_file_override = 1

+2

-2

lib/App/Cme/Command/meta.pm less more

8	8	#
9	9	# ABSTRACT: Work on the configuration model of an application
10	10
11		package App::Cme::Command::meta 2.020;
	11	package App::Cme::Command::meta 2.021;
12	12
13	13	use strict ;
14	14	use warnings ;

404	404
405	405	=head1 VERSION
406	406
407		version 2.020
	407	version 2.021
408	408
409	409	=head1 SYNOPSIS
410	410

+2

-2

lib/Config/Model/Itself/BackendDetector.pm less more

6	6	#
7	7	# The GNU Lesser General Public License, Version 2.1, February 1999
8	8	#
9		package Config::Model::Itself::BackendDetector 2.020;
	9	package Config::Model::Itself::BackendDetector 2.021;
10	10
11	11	# since this package is mostly targeted for dev environments
12	12	# let the detector detect models under development

101	101
102	102	=head1 VERSION
103	103
104		version 2.020
	104	version 2.021
105	105
106	106	=head1 SYNOPSIS
107	107

+1

-1

lib/Config/Model/Itself/TkEditUI.pm less more

6	6	#
7	7	# The GNU Lesser General Public License, Version 2.1, February 1999
8	8	#
9		package Config::Model::Itself::TkEditUI 2.020;
	9	package Config::Model::Itself::TkEditUI 2.021;
10	10
11	11	use strict;
12	12	use warnings ;

+78

-75

lib/Config/Model/Itself.pm less more

6	6	#
7	7	# The GNU Lesser General Public License, Version 2.1, February 1999
8	8	#
9		package Config::Model::Itself 2.020;
	9	package Config::Model::Itself 2.021;
10	10
11	11	use Mouse ;
12	12	use Config::Model 2.134;

194	194
195	195	my $app_dir = $read_from \|\| $self->model_dir->parent;
196	196	my %apps;
	197	my %map;
197	198	$logger->info("reading app files from ".$app_dir);
198	199	foreach my $dir ( $app_dir->children(qr/\.d$/) ) {
199	200

218	219
219	220	my $appli = $file->basename;
220	221	$apps{$appli} = $data{model} ;
	222	$map{$appli} = $file;
221	223
222	224	$self->meta_root->load_data(
223	225	data => { application => { $appli => \%data } },

225	227	) ;
226	228	}
227	229	}
	230
	231	$self->{app_map} = \%map;
228	232
229	233	return \%apps;
230	234	}

472	476	my $app_obj = $self->meta_root->fetch_element('application');
473	477
474	478	foreach my $app_name ( $app_obj->fetch_all_indexes ) {
	479	$logger->debug("writing $app_name...");
475	480	my $app = $app_obj->fetch_with_id($app_name);
476	481	my $cat_dir_name = $app->fetch_element_value( name =>'category' ).'.d';
477	482	$app_dir->child($cat_dir_name)->mkpath();

488	493	}
489	494	$logger->info("writing file ".$app_file);
490	495	$app_file->spew(@lines);
491		}
492
	496	delete $self->{app_map}{$app_name};
	497	}
	498
	499	# prune removed app files
	500	foreach my $old_file ( values %{$self->{app_map}}) {
	501	$logger->debug("Removing $old_file.");
	502	$old_file->remove;
	503	}
493	504	}
494	505
495	506	sub write_all {

528	539	my %map_to_write = (%$map,%new_map) ;
529	540
530	541	foreach my $file (keys %map_to_write) {
531		$logger->info("checking model file $file");
532
533		my @data ;
534		my @notes ;
535		my $file_needs_write = 0;
536
537		# check if any a class of a file was modified
538		foreach my $class_name (@{$map_to_write{$file}}) {
539		$file_needs_write++ if $self->class_needs_write($class_name);
540		$logger->info("file $file class $class_name needs write ",$file_needs_write);
541		}
542
543		next unless $file_needs_write ;
544
545		foreach my $class_name (@{$map_to_write{$file}}) {
	542	my ($data,$notes) = $self->check_model_to_write($file, \%map_to_write, \%loaded_classes);
	543	next unless @$data ; # don't write empty model
	544	write_model_file ($dir->child($file), $self->{header}{$file}, $notes, $data);
	545	}
	546
	547	$self->meta_instance->clear_changes ;
	548	}
	549
	550	sub check_model_to_write {
	551	my ($self, $file, $map_to_write, $loaded_classes) = @_;
	552	$logger->info("checking model file $file");
	553
	554	my @data ;
	555	my @notes ;
	556	my $file_needs_write = 0;
	557
	558	# check if any a class of a file was modified
	559	foreach my $class_name (@{$map_to_write->{$file}}) {
	560	$file_needs_write++ if $self->class_needs_write($class_name);
	561	$logger->info("file $file class $class_name needs write ",$file_needs_write);
	562	}
	563
	564	if ($file_needs_write) {
	565	foreach my $class_name (@{$map_to_write->{$file}}) {
546	566	$logger->info("writing class $class_name");
547		my $model
548		= $self-> get_perl_data_model(class_name => $class_name) ;
	567	my $model = $self-> get_perl_data_model(class_name => $class_name) ;
549	568	push @data, $model if defined $model and keys %$model;
550	569
551	570	my $node = $self->{meta_root}->grab("class:".$class_name) ;
552	571	push @notes, $node->dump_annotations_as_pod ;
553	572	# remove class name from above list
554		delete $loaded_classes{$class_name} ;
555		}
556
557		next unless @data ; # don't write empty model
558
559		write_model_file ($dir->child($file), $self->{header}{$file}, \@notes, \@data);
560		}
561
562		$self->meta_instance->clear_changes ;
	573	delete $loaded_classes->{$class_name} ;
	574	}
	575	}
	576
	577	return (\@data, \@notes);
563	578	}
564	579
565	580	sub write_model_plugin {

610	625	} ;
611	626	find ($wanted, $plugin_dir ) ;
612	627
	628	foreach my $load_file (@files) {
	629	$self->read_plugin_file($load_file);
	630	}
	631	}
	632
	633	sub read_plugin_file {
	634	my ($self, $load_file) = @_;
	635
	636	$logger->info("trying to read plugin $load_file");
613	637	my $class_element = $self->meta_root->fetch_element('class') ;
614	638
615		foreach my $load_file (@files) {
616		$logger->info("trying to read plugin $load_file");
617
618		$load_file = "./$load_file" if $load_file !~ m!^/! and -e $load_file;
619
620		my $plugin = do $load_file ;
621
622		unless ($plugin) {
623		if ($@) {die "couldn't parse $load_file: $@"; }
624		elsif (not defined $plugin) {die "couldn't do $load_file: $!"}
625		else { die "couldn't run $load_file" ;}
626		}
627
628		# there should be only only class in each plugin file
629		foreach my $model (@$plugin) {
630		my $class_name = delete $model->{name} ;
631		# load with a array ref to avoid warnings about missing order
632		$class_element->fetch_with_id($class_name)->load_data( $model ) ;
633		}
634
635		# load annotations
636		$logger->info("loading annotations from plugin file $load_file");
637		my $fh = IO::File->new($load_file) \|\| die "Can't open $load_file: $!" ;
638		my @lines = $fh->getlines ;
639		$fh->close;
640		$self->meta_root->load_pod_annotation(join('',@lines)) ;
641		}
642		}
643
	639	$load_file = "./$load_file" if $load_file !~ m!^/! and -e $load_file;
	640
	641	my $plugin = do $load_file ;
	642
	643	unless ($plugin) {
	644	if ($@) {die "couldn't parse $load_file: $@"; }
	645	elsif (not defined $plugin) {die "couldn't do $load_file: $!"}
	646	else { die "couldn't run $load_file" ;}
	647	}
	648
	649	# there should be only only class in each plugin file
	650	foreach my $model (@$plugin) {
	651	my $class_name = delete $model->{name} ;
	652	# load with a array ref to avoid warnings about missing order
	653	$class_element->fetch_with_id($class_name)->load_data( $model ) ;
	654	}
	655
	656	# load annotations
	657	$logger->info("loading annotations from plugin file $load_file");
	658	my $fh = IO::File->new($load_file) \|\| die "Can't open $load_file: $!" ;
	659	my @lines = $fh->getlines ;
	660	$fh->close;
	661	$self->meta_root->load_pod_annotation(join('',@lines)) ;
	662	}
644	663
645	664	#
646	665	# New subroutine "write_model_file" extracted - Mon Mar 12 13:38:29 2012.

831	850
832	851	=head1 VERSION
833	852
834		version 2.020
	853	version 2.021
835	854
836	855	=head1 SYNOPSIS
837	856

996	1015
997	1016	=item *
998	1017
999		Search CPAN
1000
1001		The default CPAN search engine, useful to view POD in HTML format.
1002
1003		L<http://search.cpan.org/dist/Config-Model-Itself>
1004
1005		=item *
1006
1007		CPAN Ratings
1008
1009		The CPAN Ratings is a website that allows community ratings and reviews of Perl modules.
1010
1011		L<http://cpanratings.perl.org/d/Config-Model-Itself>
1012
1013		=item *
1014
1015	1018	CPANTS
1016	1019
1017	1020	The CPANTS is a website that analyzes the Kwalitee ( code metrics ) of a distribution.

+5

-4

lib/Config/Model/models/Itself/Class.pl less more

61	61	."This Perl class must inherit L<Config::Model::Node>. Use with care.",
62	62	assert => {
63	63	"1_load_class" => {
64		code => 'not defined $_ or eval{Mouse::Util::load_class($_)}; not $@;',
	64	code => 'return 1 unless defined $_;'
	65	.'return Mouse::Util::load_class($_);',
65	66	msg => 'Error while loading $_ class ',
66	67	},
67	68	"2_class_inherit" => {

175	176	.'not be applicable depending on your application. It may also be '
176	177	.'hardcoded in a custom backend. If not specified, the instance name '
177	178	.'is used as base name for your configuration file. The configuration file name'
178		.'can be specified with &index keyword when a backend is associated to a node '
179		.'contained in a hash. See '
180		.'L<backend specifications\|http://search.cpan.org/dist/Config-Model/lib/Config/Model/BackendMgr.pm#Backend_specification>.'
	179	.'can be specified with &index() or &element function. See '
	180	.'L<backend specifications\|http://search.cpan.org/dist/Config-Model/lib/Config/Model/BackendMgr.pm#Backend_specification> '
	181	.'and L<Config::Model::Role::ComputeFunction>.'
181	182	},
182	183	]
183	184	],

+1

-1

lib/Config/Model/models/Itself/ConfigReadWrite/DefaultLayer.pod less more

22	22
23	23	=head2 file - target configuration file name
24	24
25		specify the configuration file name. This parameter may not be applicable depending on your application. It may also be hardcoded in a custom backend. If not specified, the instance name is used as base name for your configuration file. The configuration file namecan be specified with &index keyword when a backend is associated to a node contained in a hash. See L<backend specifications\|http://search.cpan.org/dist/Config-Model/lib/Config/Model/BackendMgr.pm#Backend_specification>. I< Optional. Type uniline. >
	25	specify the configuration file name. This parameter may not be applicable depending on your application. It may also be hardcoded in a custom backend. If not specified, the instance name is used as base name for your configuration file. The configuration file namecan be specified with &index() or &element function. See L<backend specifications\|http://search.cpan.org/dist/Config-Model/lib/Config/Model/BackendMgr.pm#Backend_specification> and L<Config::Model::Role::ComputeFunction>. I< Optional. Type uniline. >
26	26
27	27	=head1 SEE ALSO
28	28

+1

-1

lib/Config/Model/models/Itself/ConfigReadWrite.pod less more

50	50
51	51	=head2 file - target configuration file name
52	52
53		specify the configuration file name. This parameter may not be applicable depending on your application. It may also be hardcoded in a custom backend. If not specified, the instance name is used as base name for your configuration file. The configuration file namecan be specified with &index keyword when a backend is associated to a node contained in a hash. See L<backend specifications\|http://search.cpan.org/dist/Config-Model/lib/Config/Model/BackendMgr.pm#Backend_specification>. I< Optional. Type uniline. >
	53	specify the configuration file name. This parameter may not be applicable depending on your application. It may also be hardcoded in a custom backend. If not specified, the instance name is used as base name for your configuration file. The configuration file namecan be specified with &index() or &element function. See L<backend specifications\|http://search.cpan.org/dist/Config-Model/lib/Config/Model/BackendMgr.pm#Backend_specification> and L<Config::Model::Role::ComputeFunction>. I< Optional. Type uniline. >
54	54
55	55	=head2 function
56	56

+87

-0

t/application.t less more

	0	# -- cperl --
	1
	2	use ExtUtils::testlib;
	3	use Test::More ;
	4	use Config::Model 2.138;
	5	use Config::Model::Tester::Setup qw/init_test setup_test_dir/;
	6	use Path::Tiny;
	7
	8	use Config::Model::Itself ;
	9	use File::Copy::Recursive qw(fcopy rcopy dircopy);
	10	use Test::Memory::Cycle;
	11
	12	use 5.10.1;
	13	use warnings;
	14	use strict;
	15
	16	my ($meta_model, $trace) = init_test();
	17
	18	# do search for the models created in this test
	19	use lib "wr_root/itself/lib";
	20
	21	my $wr_test = setup_test_dir ;
	22	my $wr_lib = $wr_test->child("lib");
	23	my $wr_model1 = $wr_lib->child("wr_model1");
	24
	25	$wr_model1->mkpath;
	26
	27	# copy test model
	28	dircopy('data',$wr_model1->stringify) \|\| die "cannot copy model data:$!" ;
	29
	30	my $model = Config::Model->new(
	31	model_dir => $wr_model1->child("models")->relative($wr_lib)->stringify
	32	) ;
	33	ok(1,"loaded Master model") ;
	34
	35	# ok now we can load test model in Itself
	36
	37	my $meta_inst = $meta_model -> instance (
	38	root_class_name => 'Itself::Model',
	39	instance_name => 'itself_instance',
	40	root_dir => $wr_model1->stringify,
	41	);
	42	ok($meta_inst,"Read Itself::Model and created instance") ;
	43
	44	my $meta_root = $meta_inst -> config_root ;
	45
	46	my $rw_obj = Config::Model::Itself -> new(
	47	model_object => $meta_root,
	48	cm_lib_dir => $wr_model1->stringify,
	49	) ;
	50
	51	ok($rw_obj,"Created model reader/writer");
	52
	53	$rw_obj->read_all(
	54	root_model => 'MasterModel',
	55	legacy => 'ignore',
	56	) ;
	57
	58	ok(1,"Read all models in data dir") ;
	59
	60	is_deeply(
	61	[ $meta_root->grab('application')->fetch_all_indexes ],
	62	[ qw/goner master/],
	63	"check that 2 application files were read"
	64	);
	65
	66	# remove dummy application
	67	$meta_root->load("application:.rm(goner)");
	68
	69	is_deeply(
	70	[ $meta_root->grab('application')->fetch_all_indexes ],
	71	[ qw/master/],
	72	"check that 1 application is left"
	73	);
	74
	75	$rw_obj -> write_all();
	76	ok(1,"Wrote back model") ;
	77
	78	ok(
	79	! $wr_model1->child('application.d/goner')->exists,
	80	"check that goner application file was removed"
	81	);
	82
	83	note("testing memory cycles. Please wait...");
	84	memory_cycle_ok($meta_model, "Check memory cycle");
	85
	86	done_testing;

+40

-0

t/meta-class.t less more

	0
	1	use ExtUtils::testlib;
	2	use Test::More ;
	3	use Config::Model 2.138;
	4	use Config::Model::Tester::Setup qw/init_test setup_test_dir/;
	5
	6	use Config::Model::Itself ;
	7	use Test::Memory::Cycle;
	8	use Test::Exception;
	9
	10	use warnings;
	11	use strict;
	12
	13	my ($meta_model, $trace) = init_test();
	14
	15	my $wr_root = setup_test_dir;
	16
	17	my $meta_inst = $meta_model-> instance (
	18	root_class_name => 'Itself::Model',
	19	instance_name => 'itself_instance',
	20	root_dir => "data",
	21	);
	22	ok($meta_inst,"Read Itself::Model and created instance") ;
	23
	24	my $meta_root = $meta_inst -> config_root ;
	25
	26	$meta_root->load('class:Test');
	27	ok(1,"Created dummy Test class");
	28
	29	throws_ok {
	30	$meta_root->load('class:Test class="Foo::Bar"');
	31	}
	32	qr!Can't locate Foo/Bar.pm in \@INC!,
	33	"test explicit error message when attaching Config class to unknown Perl class";
	34	print "normal error:\n", $@, "\n" if $trace;
	35
	36	note("testing memory cycles. Please wait...");
	37	memory_cycle_ok($meta_model, "Check memory cycle");
	38
	39	done_testing;