line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# |
2
|
|
|
|
|
|
|
# This file is part of Config-Model |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# This software is Copyright (c) 2005-2022 by Dominique Dumont. |
5
|
|
|
|
|
|
|
# |
6
|
|
|
|
|
|
|
# This is free software, licensed under: |
7
|
|
|
|
|
|
|
# |
8
|
|
|
|
|
|
|
# The GNU Lesser General Public License, Version 2.1, February 1999 |
9
|
|
|
|
|
|
|
# |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
#use Scalar::Util qw(weaken) ; |
12
|
|
|
|
|
|
|
use strict; |
13
|
59
|
|
|
59
|
|
368
|
|
|
59
|
|
|
|
|
117
|
|
|
59
|
|
|
|
|
1540
|
|
14
|
|
|
|
|
|
|
use 5.10.1; |
15
|
59
|
|
|
59
|
|
571
|
use Mouse; |
|
59
|
|
|
|
|
177
|
|
16
|
59
|
|
|
59
|
|
281
|
use Mouse::Util::TypeConstraints; |
|
59
|
|
|
|
|
127
|
|
|
59
|
|
|
|
|
431
|
|
17
|
59
|
|
|
59
|
|
24053
|
use MouseX::StrictConstructor; |
|
59
|
|
|
|
|
126
|
|
|
59
|
|
|
|
|
440
|
|
18
|
59
|
|
|
59
|
|
5827
|
with "Config::Model::Role::NodeLoader"; |
|
59
|
|
|
|
|
141
|
|
|
59
|
|
|
|
|
362
|
|
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
use File::Path; |
21
|
59
|
|
|
59
|
|
10307
|
use Path::Tiny; |
|
59
|
|
|
|
|
136
|
|
|
59
|
|
|
|
|
3839
|
|
22
|
59
|
|
|
59
|
|
36430
|
use Log::Log4perl qw(get_logger :levels); |
|
59
|
|
|
|
|
601828
|
|
|
59
|
|
|
|
|
3505
|
|
23
|
59
|
|
|
59
|
|
472
|
|
|
59
|
|
|
|
|
102
|
|
|
59
|
|
|
|
|
414
|
|
24
|
|
|
|
|
|
|
use Config::Model::TypeConstraints; |
25
|
59
|
|
|
59
|
|
29160
|
use Config::Model::Exception; |
|
59
|
|
|
|
|
153
|
|
|
59
|
|
|
|
|
1549
|
|
26
|
59
|
|
|
59
|
|
23562
|
use Config::Model::Node; |
|
59
|
|
|
|
|
192
|
|
|
59
|
|
|
|
|
2977
|
|
27
|
59
|
|
|
59
|
|
33625
|
use Config::Model::Loader; |
|
59
|
|
|
|
|
297
|
|
|
59
|
|
|
|
|
2563
|
|
28
|
59
|
|
|
59
|
|
523
|
use Config::Model::SearchElement; |
|
59
|
|
|
|
|
104
|
|
|
59
|
|
|
|
|
1323
|
|
29
|
59
|
|
|
59
|
|
26815
|
use Config::Model::Iterator; |
|
59
|
|
|
|
|
162
|
|
|
59
|
|
|
|
|
1993
|
|
30
|
59
|
|
|
59
|
|
25034
|
use Config::Model::ObjTreeScanner; |
|
59
|
|
|
|
|
146
|
|
|
59
|
|
|
|
|
1892
|
|
31
|
59
|
|
|
59
|
|
410
|
|
|
59
|
|
|
|
|
106
|
|
|
59
|
|
|
|
|
1003
|
|
32
|
|
|
|
|
|
|
use warnings ; |
33
|
59
|
|
|
59
|
|
276
|
|
|
59
|
|
|
|
|
100
|
|
|
59
|
|
|
|
|
1718
|
|
34
|
|
|
|
|
|
|
use Carp qw/carp croak confess cluck/; |
35
|
59
|
|
|
59
|
|
280
|
|
|
59
|
|
|
|
|
108
|
|
|
59
|
|
|
|
|
182926
|
|
36
|
|
|
|
|
|
|
my $logger = get_logger("Instance"); |
37
|
|
|
|
|
|
|
my $change_logger = get_logger("Anything::Change"); |
38
|
|
|
|
|
|
|
my $user_logger = get_logger("User"); |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
has [qw/root_class_name/] => ( is => 'ro', isa => 'Str', required => 1 ); |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
|
43
|
132
|
|
|
132
|
0
|
818
|
has config_model => ( |
44
|
|
|
|
|
|
|
is => 'ro', |
45
|
|
|
|
|
|
|
isa => 'Config::Model', |
46
|
|
|
|
|
|
|
weak_ref => 1, |
47
|
|
|
|
|
|
|
required => 1 |
48
|
|
|
|
|
|
|
); |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
has check => ( |
51
|
|
|
|
|
|
|
is => 'ro', |
52
|
|
|
|
|
|
|
isa => 'Str', |
53
|
|
|
|
|
|
|
default => 'yes', |
54
|
|
|
|
|
|
|
reader => 'read_check', |
55
|
|
|
|
|
|
|
); |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
# used by cme -create option |
58
|
|
|
|
|
|
|
has auto_create => ( |
59
|
|
|
|
|
|
|
is => 'ro', |
60
|
|
|
|
|
|
|
isa => 'Bool', |
61
|
|
|
|
|
|
|
default => 0, |
62
|
|
|
|
|
|
|
); |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
# a unique (instance wise) placeholder for various tree objects |
65
|
|
|
|
|
|
|
# to store information |
66
|
|
|
|
|
|
|
has _safe => ( |
67
|
|
|
|
|
|
|
is => 'rw', |
68
|
|
|
|
|
|
|
isa => 'HashRef', |
69
|
|
|
|
|
|
|
traits => ['Hash'], |
70
|
|
|
|
|
|
|
default => sub { {} }, |
71
|
|
|
|
|
|
|
handles => { |
72
|
|
|
|
|
|
|
data => 'accessor', |
73
|
|
|
|
|
|
|
}, |
74
|
|
|
|
|
|
|
); |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
has appli_info => ( |
77
|
|
|
|
|
|
|
is => 'rw', |
78
|
|
|
|
|
|
|
isa => 'HashRef', |
79
|
|
|
|
|
|
|
traits => ['Hash'], |
80
|
|
|
|
|
|
|
default => sub { {} }, |
81
|
|
|
|
|
|
|
handles => { |
82
|
|
|
|
|
|
|
get_appli_info => 'get', |
83
|
|
|
|
|
|
|
# currying See Moose::Manual::Delegation |
84
|
|
|
|
|
|
|
get_support_info => [qw/get support_info/], |
85
|
|
|
|
|
|
|
}, |
86
|
|
|
|
|
|
|
); |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
# preset mode: to load values found by HW scan or other automatic scheme |
90
|
|
|
|
|
|
|
# layered mode: to load values found in included files (e.g. a la multistrap) |
91
|
|
|
|
|
|
|
# canonical mode: write config data back using model order instead of user order |
92
|
|
|
|
|
|
|
has [qw/preset layered canonical/] => ( |
93
|
|
|
|
|
|
|
is => 'ro', |
94
|
|
|
|
|
|
|
isa => 'Bool', |
95
|
|
|
|
|
|
|
default => 0, |
96
|
|
|
|
|
|
|
); |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
has changes => ( |
99
|
|
|
|
|
|
|
is => 'ro', |
100
|
|
|
|
|
|
|
isa => 'ArrayRef', |
101
|
|
|
|
|
|
|
traits => ['Array'], |
102
|
|
|
|
|
|
|
default => sub { [] }, |
103
|
|
|
|
|
|
|
handles => { |
104
|
|
|
|
|
|
|
add_change => 'push', |
105
|
|
|
|
|
|
|
c_count => 'count', |
106
|
|
|
|
|
|
|
has_changes => 'count', |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
#needs_save => 'count' , |
109
|
|
|
|
|
|
|
clear_changes => 'clear', |
110
|
|
|
|
|
|
|
} ); |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
my $self = shift; |
113
|
|
|
|
|
|
|
my $arg = shift; |
114
|
|
|
|
|
|
|
if ( defined $arg ) { |
115
|
65
|
|
|
65
|
1
|
12659
|
if ($arg) { |
116
|
65
|
|
|
|
|
123
|
croak "replace needs_save(1) call with add_change"; |
117
|
65
|
50
|
|
|
|
178
|
$self->add_change(); # may not work |
118
|
0
|
0
|
|
|
|
0
|
} |
119
|
0
|
|
|
|
|
0
|
else { |
120
|
0
|
|
|
|
|
0
|
croak "replace needs_save(0) call with clear_changes"; |
121
|
|
|
|
|
|
|
$self->clear_changes; |
122
|
|
|
|
|
|
|
} |
123
|
0
|
|
|
|
|
0
|
} |
124
|
0
|
|
|
|
|
0
|
return $self->c_count; |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
65
|
|
|
|
|
299
|
has errors => ( |
128
|
|
|
|
|
|
|
is => 'ro', |
129
|
|
|
|
|
|
|
isa => 'HashRef', |
130
|
|
|
|
|
|
|
traits => ['Hash'], |
131
|
|
|
|
|
|
|
default => sub { {} }, |
132
|
|
|
|
|
|
|
handles => { |
133
|
|
|
|
|
|
|
_set_error => 'set', |
134
|
|
|
|
|
|
|
cancel_error => 'delete', |
135
|
|
|
|
|
|
|
has_error => 'count', |
136
|
|
|
|
|
|
|
clear_errors => 'clear', |
137
|
|
|
|
|
|
|
error_paths => 'keys' |
138
|
|
|
|
|
|
|
} ); |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
my $self = shift; |
141
|
|
|
|
|
|
|
$self->_set_error( shift, '' ); |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
|
144
|
20
|
|
|
20
|
0
|
36
|
my $self = shift; |
145
|
20
|
|
|
|
|
80
|
my @errs = map { "$_: " . $self->config_root->grab($_)->error_msg } $self->error_paths; |
146
|
|
|
|
|
|
|
return wantarray ? @errs : join( "\n", @errs ); |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
|
149
|
9
|
|
|
9
|
1
|
6196
|
my $self = shift; |
150
|
9
|
|
|
|
|
33
|
|
|
13
|
|
|
|
|
169
|
|
151
|
9
|
50
|
|
|
|
144
|
my $count_leaf_warnings = sub { |
152
|
|
|
|
|
|
|
my ( $scanner, $data_ref, $node, $element_name, $index, $leaf_object ) = @_; |
153
|
|
|
|
|
|
|
$$data_ref += $leaf_object->has_warning; |
154
|
|
|
|
|
|
|
}; |
155
|
3
|
|
|
3
|
1
|
432
|
|
156
|
|
|
|
|
|
|
my $count_list_warnings = sub { |
157
|
|
|
|
|
|
|
my ( $scanner, $data_ref, $node, $element_name, $index, $leaf_object ) = @_; |
158
|
75
|
|
|
75
|
|
135
|
$$data_ref += $node->fetch_element($element_name)->has_warning; |
159
|
75
|
|
|
|
|
168
|
}; |
160
|
3
|
|
|
|
|
14
|
|
161
|
|
|
|
|
|
|
my $scan = Config::Model::ObjTreeScanner->new( |
162
|
|
|
|
|
|
|
leaf_cb => $count_leaf_warnings, |
163
|
9
|
|
|
9
|
|
20
|
list_element_hook => $count_list_warnings, |
164
|
9
|
|
|
|
|
25
|
hash_element_hook => $count_list_warnings, |
165
|
3
|
|
|
|
|
12
|
); |
166
|
|
|
|
|
|
|
|
167
|
3
|
|
|
|
|
23
|
my $result = 0; |
168
|
|
|
|
|
|
|
$scan->scan_node( \$result, $self->config_root ); |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
return $result; |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
|
173
|
3
|
|
|
|
|
6
|
has on_change_cb => ( |
174
|
3
|
|
|
|
|
16
|
is => 'rw', |
175
|
|
|
|
|
|
|
traits => ['Code'], |
176
|
3
|
|
|
|
|
77
|
isa => 'CodeRef', |
177
|
|
|
|
|
|
|
default => sub { sub { } }, |
178
|
|
|
|
|
|
|
); |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
has on_message_cb => ( |
181
|
|
|
|
|
|
|
traits => ['Code'], |
182
|
|
|
|
|
|
|
is => 'rw', |
183
|
|
|
|
|
|
|
isa => 'CodeRef', |
184
|
|
|
|
|
|
|
default => sub { sub { say @_; } }, |
185
|
|
|
|
|
|
|
handles => { |
186
|
|
|
|
|
|
|
show_message => 'execute', |
187
|
|
|
|
|
|
|
}, |
188
|
|
|
|
|
|
|
); |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
# initial_load mode: when data is loaded the first time |
191
|
|
|
|
|
|
|
has initial_load => ( |
192
|
|
|
|
|
|
|
is => 'rw', |
193
|
|
|
|
|
|
|
isa => 'Bool', |
194
|
|
|
|
|
|
|
default => 0, |
195
|
|
|
|
|
|
|
trigger => \&_trace_initial_load, |
196
|
|
|
|
|
|
|
traits => [qw/Bool/], |
197
|
|
|
|
|
|
|
handles => { |
198
|
|
|
|
|
|
|
initial_load_start => 'set', |
199
|
|
|
|
|
|
|
initial_load_stop => 'unset', |
200
|
|
|
|
|
|
|
} ); |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
my ( $self, $n, $o ) = @_; |
203
|
|
|
|
|
|
|
$logger->debug("switched to $n"); |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
# This array holds a set of sub ref that will be invoked when |
207
|
|
|
|
|
|
|
# the user requires to write all configuration tree in their |
208
|
|
|
|
|
|
|
# backend storage. |
209
|
206
|
|
|
206
|
|
9144
|
has _write_back => ( |
210
|
206
|
|
|
|
|
792
|
is => 'ro', |
211
|
|
|
|
|
|
|
isa => 'HashRef', |
212
|
|
|
|
|
|
|
traits => ['Hash'], |
213
|
|
|
|
|
|
|
handles => { |
214
|
|
|
|
|
|
|
count_write_back => 'count', # mostly for tests |
215
|
|
|
|
|
|
|
has_no_write_back => 'is_empty', |
216
|
|
|
|
|
|
|
nodes_to_write_back => 'keys', |
217
|
|
|
|
|
|
|
write_back_node_info => 'get', |
218
|
|
|
|
|
|
|
delete_write_back => 'delete', |
219
|
|
|
|
|
|
|
clear_write_back => 'clear', |
220
|
|
|
|
|
|
|
}, |
221
|
|
|
|
|
|
|
default => sub { {} }, |
222
|
|
|
|
|
|
|
); |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
my ($self, $path, $backend, $wb) = @_; |
225
|
|
|
|
|
|
|
push @{ $self->_write_back->{$path} //= [] }, [$backend, $wb]; |
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
# used for auto_read auto_write feature |
229
|
|
|
|
|
|
|
has [qw/name application backend_arg backup/] => ( |
230
|
|
|
|
|
|
|
is => 'ro', |
231
|
|
|
|
|
|
|
isa => 'Maybe[Str]', |
232
|
93
|
|
|
93
|
1
|
236
|
); |
233
|
93
|
|
100
|
|
|
143
|
|
|
93
|
|
|
|
|
745
|
|
234
|
|
|
|
|
|
|
has 'root_dir' => ( |
235
|
|
|
|
|
|
|
is => 'ro', |
236
|
|
|
|
|
|
|
isa => 'Config::Model::TypeContraints::Path', |
237
|
|
|
|
|
|
|
coerce => 1 |
238
|
|
|
|
|
|
|
); |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
has root_path => ( |
241
|
|
|
|
|
|
|
is => 'ro', |
242
|
|
|
|
|
|
|
isa => 'Path::Tiny', |
243
|
|
|
|
|
|
|
lazy_build => 1, |
244
|
|
|
|
|
|
|
); |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
my $self = shift; |
247
|
|
|
|
|
|
|
my $root_dir = $self->root_dir // ''; |
248
|
|
|
|
|
|
|
return $root_dir ? path($root_dir) : Path::Tiny->cwd; |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
has [qw/config_dir config_file/] => ( |
252
|
|
|
|
|
|
|
is => 'ro', |
253
|
|
|
|
|
|
|
isa => 'Config::Model::TypeContraints::Path', |
254
|
|
|
|
|
|
|
coerce => 1 |
255
|
2
|
|
|
2
|
|
62
|
); |
256
|
2
|
|
100
|
|
|
50
|
|
257
|
2
|
100
|
|
|
|
19
|
has tree => ( |
258
|
|
|
|
|
|
|
is => 'ro', |
259
|
|
|
|
|
|
|
isa => 'Config::Model::Node', |
260
|
|
|
|
|
|
|
builder => '_build_tree', |
261
|
|
|
|
|
|
|
lazy => 1, |
262
|
|
|
|
|
|
|
clearer => '_clear_config', |
263
|
|
|
|
|
|
|
reader => 'config_root', |
264
|
|
|
|
|
|
|
handles => [qw/apply_fixes deep_check grab grab_value/], |
265
|
|
|
|
|
|
|
); |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
my $self = shift; |
268
|
|
|
|
|
|
|
$self->_clear_config; |
269
|
|
|
|
|
|
|
$self->clear_changes; |
270
|
|
|
|
|
|
|
return $self->config_root; |
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
my $self = shift; |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
return $self->load_node ( |
276
|
|
|
|
|
|
|
config_class_name => $self->{root_class_name}, |
277
|
1
|
|
|
1
|
1
|
303
|
instance => $self, |
278
|
1
|
|
|
|
|
5
|
container => $self, |
279
|
1
|
|
|
|
|
4
|
config_file => $self->{config_file}, |
280
|
1
|
|
|
|
|
17
|
); |
281
|
|
|
|
|
|
|
} |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
my $self = shift; |
284
|
132
|
|
|
132
|
|
38404
|
$logger->info("Starting preset mode"); |
285
|
|
|
|
|
|
|
carp "Cannot start preset mode during layered mode" |
286
|
|
|
|
|
|
|
if $self->{layered}; |
287
|
|
|
|
|
|
|
$self->{preset} = 1; |
288
|
|
|
|
|
|
|
} |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
my $self = shift; |
291
|
132
|
|
|
|
|
956
|
$logger->info("Stopping preset mode"); |
292
|
|
|
|
|
|
|
$self->{preset} = 0; |
293
|
|
|
|
|
|
|
} |
294
|
|
|
|
|
|
|
|
295
|
5
|
|
|
5
|
1
|
3446
|
my $self = shift; |
296
|
5
|
|
|
|
|
32
|
|
297
|
|
|
|
|
|
|
my $leaf_cb = sub { |
298
|
5
|
50
|
|
|
|
61
|
my ( $scanner, $data_ref, $node, $element_name, $index, $leaf_object ) = @_; |
299
|
5
|
|
|
|
|
13
|
$$data_ref ||= $leaf_object->clear_preset; |
300
|
|
|
|
|
|
|
}; |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
$self->_stuff_clear($leaf_cb); |
303
|
5
|
|
|
5
|
1
|
29
|
} |
304
|
5
|
|
|
|
|
20
|
|
305
|
5
|
|
|
|
|
42
|
my $self = shift; |
306
|
|
|
|
|
|
|
$logger->info("Starting layered mode"); |
307
|
|
|
|
|
|
|
carp "Cannot start layered mode during preset mode" |
308
|
|
|
|
|
|
|
if $self->{preset}; |
309
|
1
|
|
|
1
|
1
|
2
|
$self->{layered} = 1; |
310
|
|
|
|
|
|
|
} |
311
|
|
|
|
|
|
|
|
312
|
42
|
|
|
42
|
|
63
|
my $self = shift; |
313
|
42
|
|
100
|
|
|
119
|
$logger->info("Stopping layered mode"); |
314
|
1
|
|
|
|
|
5
|
$self->{layered} = 0; |
315
|
|
|
|
|
|
|
} |
316
|
1
|
|
|
|
|
4
|
|
317
|
|
|
|
|
|
|
my $self = shift; |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
my $leaf_cb = sub { |
320
|
15
|
|
|
15
|
1
|
630
|
my ( $scanner, $data_ref, $node, $element_name, $index, $leaf_object ) = @_; |
321
|
15
|
|
|
|
|
86
|
$$data_ref ||= $leaf_object->clear_layered; |
322
|
|
|
|
|
|
|
}; |
323
|
15
|
50
|
|
|
|
189
|
|
324
|
15
|
|
|
|
|
48
|
$self->_stuff_clear($leaf_cb); |
325
|
|
|
|
|
|
|
} |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
my $self = shift; |
328
|
14
|
|
|
14
|
1
|
70
|
return |
329
|
14
|
|
|
|
|
67
|
$self->{layered} ? 'layered' |
330
|
14
|
|
|
|
|
136
|
: $self->{preset} ? 'preset' |
331
|
|
|
|
|
|
|
: 'normal'; |
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
|
334
|
10
|
|
|
10
|
1
|
27
|
my ( $self, $leaf_cb ) = @_; |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
# this sub may remove hash keys that were entered by user if the |
337
|
137
|
|
|
137
|
|
234
|
# corresponding hash value has no data. |
338
|
137
|
|
100
|
|
|
511
|
# it also clear auto_created ids if there's no data in there |
339
|
10
|
|
|
|
|
54
|
my $h_cb = sub { |
340
|
|
|
|
|
|
|
my ( $scanner, $data_ref, $node, $element_name, @keys ) = @_; |
341
|
10
|
|
|
|
|
45
|
my $obj = $node->fetch_element($element_name); |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
# Since remove method uses splice(array) on list elements, the |
344
|
|
|
|
|
|
|
# removal must be done in reverse order to avoid messing up |
345
|
1576
|
|
|
1576
|
1
|
2316
|
# the indexes of the array (i.e. the last indexes becomes |
346
|
|
|
|
|
|
|
# greater than the length of the array). |
347
|
|
|
|
|
|
|
foreach my $k (reverse @keys) { |
348
|
1576
|
100
|
|
|
|
5129
|
my $has_data = 0; |
|
|
100
|
|
|
|
|
|
349
|
|
|
|
|
|
|
$scanner->scan_hash( \$has_data, $node, $element_name, $k ); |
350
|
|
|
|
|
|
|
$obj->remove($k) unless $has_data; |
351
|
|
|
|
|
|
|
$$data_ref ||= $has_data; |
352
|
|
|
|
|
|
|
} |
353
|
11
|
|
|
11
|
|
31
|
}; |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
my $wiper = Config::Model::ObjTreeScanner->new( |
356
|
|
|
|
|
|
|
fallback => 'all', |
357
|
|
|
|
|
|
|
auto_vivify => 0, |
358
|
|
|
|
|
|
|
check => 'skip', |
359
|
48
|
|
|
48
|
|
110
|
leaf_cb => $leaf_cb, |
360
|
48
|
|
|
|
|
110
|
hash_element_cb => $h_cb, |
361
|
|
|
|
|
|
|
list_element_cb => $h_cb, |
362
|
|
|
|
|
|
|
); |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
$wiper->scan_node( undef, $self->config_root ); |
365
|
|
|
|
|
|
|
|
366
|
48
|
|
|
|
|
174
|
} |
367
|
65
|
|
|
|
|
74
|
|
368
|
65
|
|
|
|
|
174
|
my $self = shift ; |
369
|
65
|
100
|
|
|
|
133
|
my %args = @_ eq 1 ? ( step => $_[0] ) : @_; |
370
|
65
|
|
100
|
|
|
334
|
my $force = delete $args{force_save} || delete $args{force}; |
371
|
|
|
|
|
|
|
my $quiet = delete $args{quiet}; |
372
|
11
|
|
|
|
|
48
|
$self->load(%args); |
373
|
|
|
|
|
|
|
$self->say_changes() unless $quiet; |
374
|
11
|
|
|
|
|
129
|
$self->write_back( force => $force ); |
375
|
|
|
|
|
|
|
return $self; |
376
|
|
|
|
|
|
|
} |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
my $self = shift; |
379
|
|
|
|
|
|
|
my $loader = Config::Model::Loader->new( start_node => $self->config_root ); |
380
|
|
|
|
|
|
|
my %args = @_ eq 1 ? ( step => $_[0] ) : @_; |
381
|
|
|
|
|
|
|
$loader->load( %args ); |
382
|
|
|
|
|
|
|
return $self; |
383
|
11
|
|
|
|
|
78
|
} |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
my $self = shift; |
386
|
|
|
|
|
|
|
$self->config_root->search_element(@_); |
387
|
|
|
|
|
|
|
} |
388
|
2
|
|
|
2
|
1
|
52
|
|
389
|
2
|
50
|
|
|
|
18
|
carp __PACKAGE__, "::wizard_helper helped is deprecated. Call iterator instead"; |
390
|
2
|
|
33
|
|
|
13
|
goto &iterator; |
391
|
2
|
|
|
|
|
5
|
} |
392
|
2
|
|
|
|
|
13
|
|
393
|
2
|
50
|
|
|
|
17
|
my $self = shift; |
394
|
2
|
|
|
|
|
10
|
my @args = @_; |
395
|
2
|
|
|
|
|
42
|
|
396
|
|
|
|
|
|
|
my $tree_root = $self->config_root; |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
return Config::Model::Iterator->new( root => $tree_root, @args ); |
399
|
3
|
|
|
3
|
1
|
1383
|
} |
400
|
3
|
|
|
|
|
74
|
|
401
|
3
|
50
|
|
|
|
224
|
carp "read_directory is deprecated"; |
402
|
3
|
|
|
|
|
25
|
return shift->root_dir; |
403
|
3
|
|
|
|
|
104
|
} |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
my $self = shift; |
406
|
|
|
|
|
|
|
carp "write_directory is deprecated"; |
407
|
0
|
|
|
0
|
0
|
0
|
return $self->root_dir; |
408
|
0
|
|
|
|
|
0
|
} |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
my $self = shift; |
411
|
|
|
|
|
|
|
carp "deprecated"; |
412
|
0
|
|
|
0
|
1
|
0
|
return $self->root_dir; |
413
|
0
|
|
|
|
|
0
|
} |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
# FIXME: record changes to implement undo/redo ? |
416
|
|
|
|
|
|
|
my $self = shift; |
417
|
1
|
|
|
1
|
1
|
2
|
my %args = @_; |
418
|
1
|
|
|
|
|
3
|
if ( $change_logger->is_debug ) { |
419
|
|
|
|
|
|
|
$change_logger->debug( "in instance ", $self->name, ' for path ', $args{path} ); |
420
|
1
|
|
|
|
|
5
|
} |
421
|
|
|
|
|
|
|
|
422
|
1
|
|
|
|
|
8
|
foreach my $obsolete (qw/note_only msg/) { |
423
|
|
|
|
|
|
|
if ( my $m = delete $args{$obsolete} ) { |
424
|
|
|
|
|
|
|
carp "notify_change: param $obsolete is obsolete ($m)"; |
425
|
|
|
|
|
|
|
$args{note} //=''; |
426
|
0
|
|
|
0
|
0
|
0
|
$args{note} .= $m; |
427
|
0
|
|
|
|
|
0
|
} |
428
|
|
|
|
|
|
|
} |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
$self->add_change( \%args ); |
431
|
0
|
|
|
0
|
0
|
0
|
$self->on_change_cb->( %args ); |
432
|
0
|
|
|
|
|
0
|
} |
433
|
0
|
|
|
|
|
0
|
|
434
|
|
|
|
|
|
|
my @lines = @_; |
435
|
|
|
|
|
|
|
foreach my $l (@lines) { |
436
|
|
|
|
|
|
|
next unless defined $l; |
437
|
0
|
|
|
0
|
0
|
0
|
$l =~ s/\n/ /g; |
438
|
0
|
|
|
|
|
0
|
substr ($l, 60) = '[...]' if length $l > 60; # limit string length |
439
|
0
|
|
|
|
|
0
|
} |
440
|
|
|
|
|
|
|
return @lines; |
441
|
|
|
|
|
|
|
} |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
my $self = shift; |
444
|
1465
|
|
|
1465
|
1
|
2211
|
my $l = $self->changes; |
445
|
1465
|
|
|
|
|
5714
|
my @all; |
446
|
1465
|
100
|
|
|
|
3839
|
|
447
|
95
|
|
|
|
|
676
|
foreach my $c (@$l) { |
448
|
|
|
|
|
|
|
my $path = $c->{path} ; |
449
|
|
|
|
|
|
|
|
450
|
1465
|
|
|
|
|
8915
|
my $vt = $c->{value_type} || ''; |
451
|
2930
|
50
|
|
|
|
6555
|
my ( $o, $n ) = _truncate( $c->{old}, $c->{new} ); |
452
|
0
|
|
|
|
|
0
|
|
453
|
0
|
|
0
|
|
|
0
|
my $note = $c->{note} ? " # $c->{note}" : ''; |
454
|
0
|
|
|
|
|
0
|
|
455
|
|
|
|
|
|
|
if ( defined $n and not defined $o ) { |
456
|
|
|
|
|
|
|
push @all, "$path has new value: '$n'$note"; |
457
|
|
|
|
|
|
|
} |
458
|
1465
|
|
|
|
|
5418
|
elsif ( not defined $n and defined $o) { |
459
|
1465
|
|
|
|
|
26967
|
push @all, "$path deleted value: '$o'$note"; |
460
|
|
|
|
|
|
|
} |
461
|
|
|
|
|
|
|
elsif ( defined $o and defined $n ) { |
462
|
|
|
|
|
|
|
push @all, "$path: '$o' -> '$n'$note"; |
463
|
37
|
|
|
37
|
|
72
|
} |
464
|
37
|
|
|
|
|
58
|
elsif ( defined $c->{note} ) { |
465
|
74
|
100
|
|
|
|
121
|
push @all, "$path: ".$c->{note}; |
466
|
52
|
|
|
|
|
75
|
} |
467
|
52
|
50
|
|
|
|
90
|
else { |
468
|
|
|
|
|
|
|
# something's unexpected with the call to notify_change |
469
|
37
|
|
|
|
|
87
|
push @all, "changed ".join(' ', each %$c); |
470
|
|
|
|
|
|
|
} |
471
|
|
|
|
|
|
|
} |
472
|
|
|
|
|
|
|
|
473
|
19
|
|
|
19
|
1
|
4804
|
return wantarray ? @all : join( "\n", @all ); |
474
|
19
|
|
|
|
|
82
|
} |
475
|
19
|
|
|
|
|
33
|
|
476
|
|
|
|
|
|
|
my $self = shift; |
477
|
19
|
|
|
|
|
45
|
my @changes = $self->list_changes; |
478
|
37
|
|
|
|
|
59
|
return $self unless @changes; |
479
|
|
|
|
|
|
|
|
480
|
37
|
|
100
|
|
|
84
|
my $msg = "\n" . |
481
|
37
|
|
|
|
|
99
|
join( "\n- ", "Changes applied to " . ($self->application // $self->name) . " configuration:", @changes ) . |
482
|
|
|
|
|
|
|
"\n"; |
483
|
37
|
100
|
|
|
|
101
|
|
484
|
|
|
|
|
|
|
$user_logger->info($msg); |
485
|
37
|
100
|
100
|
|
|
241
|
return $self; |
|
|
100
|
100
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
50
|
|
|
|
|
|
486
|
2
|
|
|
|
|
7
|
} |
487
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
my $self = shift; |
489
|
6
|
|
|
|
|
18
|
my %args = |
490
|
|
|
|
|
|
|
scalar @_ > 1 ? @_ |
491
|
|
|
|
|
|
|
: scalar @_ == 1 ? ( config_dir => $_[0] ) |
492
|
22
|
|
|
|
|
80
|
: (); |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
my $force_write = delete $args{force} || 0; |
495
|
7
|
|
|
|
|
32
|
|
496
|
|
|
|
|
|
|
if (delete $args{root}) { |
497
|
|
|
|
|
|
|
say "write_back: root argument is no longer supported"; |
498
|
|
|
|
|
|
|
} |
499
|
0
|
|
|
|
|
0
|
|
500
|
|
|
|
|
|
|
# make sure that root node is loaded |
501
|
|
|
|
|
|
|
$self->config_root->init; |
502
|
|
|
|
|
|
|
|
503
|
19
|
100
|
|
|
|
138
|
if ($force_write) { |
504
|
|
|
|
|
|
|
# make sure that the whole tree is loaded |
505
|
|
|
|
|
|
|
my $dump = $self->config_root->dump_tree; |
506
|
|
|
|
|
|
|
} |
507
|
2
|
|
|
2
|
1
|
4
|
|
508
|
2
|
|
|
|
|
16
|
foreach my $k ( keys %args ) { |
509
|
2
|
50
|
|
|
|
7
|
if ($k eq 'config_dir') { |
510
|
|
|
|
|
|
|
$args{$k} ||= ''; |
511
|
2
|
|
33
|
|
|
21
|
$args{$k} .= '/' if $args{$k} and $args{$k} !~ m(/$); |
512
|
|
|
|
|
|
|
} |
513
|
|
|
|
|
|
|
elsif ( $k ne 'config_file' ) { |
514
|
|
|
|
|
|
|
croak "write_back: wrong parameters $k"; |
515
|
2
|
|
|
|
|
11
|
} |
516
|
2
|
|
|
|
|
54
|
} |
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
if ($self->has_no_write_back ) { |
519
|
|
|
|
|
|
|
my $info = $self->application ? "the model of application ".$self->application |
520
|
39
|
|
|
39
|
1
|
12024
|
: "model ".$self->root_class_name ; |
521
|
39
|
50
|
|
|
|
203
|
croak "Don't know how to save data of $self->{name} instance. ", |
|
|
100
|
|
|
|
|
|
522
|
|
|
|
|
|
|
"Either $info has no configured ", |
523
|
|
|
|
|
|
|
"read/write backend or no node containing a backend was loaded. ", |
524
|
|
|
|
|
|
|
"Try with -force option or add read/write backend to $info\n"; |
525
|
|
|
|
|
|
|
} |
526
|
39
|
|
100
|
|
|
184
|
|
527
|
|
|
|
|
|
|
foreach my $path ( sort $self->nodes_to_write_back ) { |
528
|
39
|
50
|
|
|
|
128
|
$logger->info("write_back called on node $path"); |
529
|
0
|
|
|
|
|
0
|
|
530
|
|
|
|
|
|
|
if ( $path and $self->{config_file} ) { |
531
|
|
|
|
|
|
|
$logger->warn("write_back: cannot override config_file in non root node ($path)"); |
532
|
|
|
|
|
|
|
delete $self->{config_file} |
533
|
39
|
|
|
|
|
266
|
} |
534
|
|
|
|
|
|
|
|
535
|
39
|
100
|
|
|
|
155
|
$self->_write_back_node(%args, path => $path, force_write => $force_write) ; |
536
|
|
|
|
|
|
|
} |
537
|
20
|
|
|
|
|
105
|
$self->clear_changes; |
538
|
|
|
|
|
|
|
} |
539
|
|
|
|
|
|
|
|
540
|
39
|
|
|
|
|
140
|
my $self = shift; |
541
|
2
|
50
|
|
|
|
9
|
my %args = @_; |
|
|
50
|
|
|
|
|
|
542
|
0
|
|
0
|
|
|
0
|
|
543
|
0
|
0
|
0
|
|
|
0
|
my $path = delete $args{path}; |
544
|
|
|
|
|
|
|
my $force_write = delete $args{force_write}; |
545
|
|
|
|
|
|
|
|
546
|
0
|
|
|
|
|
0
|
my $node = $self->config_root->grab( |
547
|
|
|
|
|
|
|
step => $path, |
548
|
|
|
|
|
|
|
type => 'node', |
549
|
|
|
|
|
|
|
mode => 'loose', |
550
|
39
|
50
|
|
|
|
211
|
autoadd => 0, |
551
|
0
|
0
|
|
|
|
0
|
); |
552
|
|
|
|
|
|
|
|
553
|
0
|
|
|
|
|
0
|
foreach my $wb_info (@{ $self->write_back_node_info($path) }) { |
554
|
|
|
|
|
|
|
my ($backend, $cb) = @$wb_info; |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
my @wb_args = ( |
557
|
|
|
|
|
|
|
%args, |
558
|
|
|
|
|
|
|
config_file => $self->{config_file}, |
559
|
39
|
|
|
|
|
550
|
force => $force_write, |
560
|
52
|
|
|
|
|
667
|
backup => $self->backup, |
561
|
|
|
|
|
|
|
); |
562
|
52
|
50
|
66
|
|
|
486
|
|
563
|
0
|
|
|
|
|
0
|
if (defined $node and ($node->needs_save or $force_write)) { |
564
|
|
|
|
|
|
|
my $dir = $args{config_dir}; |
565
|
0
|
|
|
|
|
0
|
mkpath( $dir, 0, oct(755) ) if $dir and not -d $dir; |
566
|
|
|
|
|
|
|
|
567
|
52
|
|
|
|
|
193
|
# exit when write is successfull |
568
|
|
|
|
|
|
|
my $res = $cb->(@wb_args); |
569
|
39
|
|
|
|
|
423
|
$logger->info( "write_back called with $backend backend, result is ", |
570
|
|
|
|
|
|
|
defined $res ? $res : '<undef>' ); |
571
|
|
|
|
|
|
|
} |
572
|
|
|
|
|
|
|
|
573
|
52
|
|
|
52
|
|
104
|
if (not defined $node) { |
574
|
52
|
|
|
|
|
229
|
$logger->debug("deleting file for deleted node $path"); |
575
|
|
|
|
|
|
|
$cb->(@wb_args, force_delete => 1); |
576
|
52
|
|
|
|
|
132
|
$self->delete_write_back($path); |
577
|
52
|
|
|
|
|
86
|
} |
578
|
|
|
|
|
|
|
} |
579
|
52
|
|
|
|
|
342
|
|
580
|
|
|
|
|
|
|
$logger->trace( "write_back on node '$path' done" ); |
581
|
|
|
|
|
|
|
} |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
goto &write_back; |
584
|
|
|
|
|
|
|
} |
585
|
|
|
|
|
|
|
|
586
|
52
|
|
|
|
|
92
|
my ($self, %args) = @_; |
|
52
|
|
|
|
|
189
|
|
587
|
52
|
|
|
|
|
795
|
|
588
|
|
|
|
|
|
|
my @msgs ; |
589
|
|
|
|
|
|
|
my $hook = sub { |
590
|
|
|
|
|
|
|
my ($scanner, $data_ref,$node,@element_list) = @_; |
591
|
|
|
|
|
|
|
if ($node->can('update')) { |
592
|
52
|
|
|
|
|
270
|
my $loc = $node->location; |
593
|
|
|
|
|
|
|
say "Calling update on node '$loc'" if $loc and not $args{quiet}; |
594
|
|
|
|
|
|
|
push (@msgs, $node->update(%args)) |
595
|
|
|
|
|
|
|
} ; |
596
|
52
|
50
|
66
|
|
|
442
|
}; |
|
|
|
100
|
|
|
|
|
597
|
51
|
|
|
|
|
114
|
|
598
|
51
|
50
|
33
|
|
|
157
|
my $root = $self->config_root ; |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
Config::Model::ObjTreeScanner->new( |
601
|
51
|
|
|
|
|
204
|
node_content_hook => $hook, |
602
|
51
|
50
|
|
|
|
419
|
check => ($args{quiet} ? 'no' : 'yes'), |
603
|
|
|
|
|
|
|
leaf_cb => sub { } |
604
|
|
|
|
|
|
|
)->scan_node( \@msgs, $root ); |
605
|
|
|
|
|
|
|
|
606
|
52
|
100
|
|
|
|
631
|
return @msgs; |
607
|
1
|
|
|
|
|
6
|
} |
608
|
1
|
|
|
|
|
8
|
|
609
|
1
|
|
|
|
|
4
|
my $self = shift; |
610
|
|
|
|
|
|
|
$self->clear_write_back; # avoid reference loops |
611
|
|
|
|
|
|
|
} |
612
|
|
|
|
|
|
|
|
613
|
52
|
|
|
|
|
262
|
__PACKAGE__->meta->make_immutable; |
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
1; |
616
|
|
|
|
|
|
|
|
617
|
2
|
|
|
2
|
1
|
411
|
# ABSTRACT: Instance of configuration tree |
618
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
=pod |
621
|
0
|
|
|
0
|
1
|
0
|
|
622
|
|
|
|
|
|
|
=encoding UTF-8 |
623
|
0
|
|
|
|
|
0
|
|
624
|
|
|
|
|
|
|
=head1 NAME |
625
|
0
|
|
|
0
|
|
0
|
|
626
|
0
|
0
|
|
|
|
0
|
Config::Model::Instance - Instance of configuration tree |
627
|
0
|
|
|
|
|
0
|
|
628
|
0
|
0
|
0
|
|
|
0
|
=head1 VERSION |
629
|
0
|
|
|
|
|
0
|
|
630
|
|
|
|
|
|
|
version 2.151 |
631
|
0
|
|
|
|
|
0
|
|
632
|
|
|
|
|
|
|
=head1 SYNOPSIS |
633
|
0
|
|
|
|
|
0
|
|
634
|
|
|
|
|
|
|
use Config::Model; |
635
|
|
|
|
|
|
|
use File::Path ; |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
# setup a dummy popcon conf file |
638
|
|
|
|
0
|
|
|
my $wr_dir = '/tmp/etc/'; |
639
|
0
|
0
|
|
|
|
0
|
my $conf_file = "$wr_dir/popularity-contest.conf" ; |
640
|
|
|
|
|
|
|
|
641
|
0
|
|
|
|
|
0
|
unless (-d $wr_dir) { |
642
|
|
|
|
|
|
|
mkpath($wr_dir, { mode => 0755 }) |
643
|
|
|
|
|
|
|
|| die "can't mkpath $wr_dir: $!"; |
644
|
|
|
|
|
|
|
} |
645
|
114
|
|
|
114
|
1
|
2662586
|
open(my $conf,"> $conf_file" ) || die "can't open $conf_file: $!"; |
646
|
114
|
|
|
|
|
634
|
$conf->print( qq!MY_HOSTID="aaaaaaaaaaaaaaaaaaaa"\n!, |
647
|
|
|
|
|
|
|
qq!PARTICIPATE="yes"\n!, |
648
|
|
|
|
|
|
|
qq!USEHTTP="yes" # always http\n!, |
649
|
|
|
|
|
|
|
qq!DAY="6"\n!); |
650
|
|
|
|
|
|
|
$conf->close ; |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
my $model = Config::Model->new; |
653
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
# PopCon model is provided. Create a new Config::Model::Instance object |
655
|
|
|
|
|
|
|
my $inst = $model->instance (root_class_name => 'PopCon', |
656
|
|
|
|
|
|
|
root_dir => '/tmp', |
657
|
|
|
|
|
|
|
); |
658
|
|
|
|
|
|
|
my $root = $inst -> config_root ; |
659
|
|
|
|
|
|
|
|
660
|
|
|
|
|
|
|
print $root->describe; |
661
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
=head1 DESCRIPTION |
663
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
This module provides an object that holds a configuration tree. |
665
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
=head1 CONSTRUCTOR |
667
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
An instance object is created by calling L<instance |
669
|
|
|
|
|
|
|
method|Config::Model/"Configuration instance"> on an existing |
670
|
|
|
|
|
|
|
model. This model can be specified by its application name: |
671
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
my $inst = $model->instance ( |
673
|
|
|
|
|
|
|
# run 'cme list' to get list of applications |
674
|
|
|
|
|
|
|
application => 'foo', |
675
|
|
|
|
|
|
|
# optional |
676
|
|
|
|
|
|
|
instance_name => 'test1' |
677
|
|
|
|
|
|
|
); |
678
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
my $inst = $model->instance ( |
680
|
|
|
|
|
|
|
root_class_name => 'SomeRootClass', |
681
|
|
|
|
|
|
|
instance_name => 'test1' |
682
|
|
|
|
|
|
|
); |
683
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
The directory (or directories) holding configuration files is |
685
|
|
|
|
|
|
|
specified within the configuration model. For test purpose you can |
686
|
|
|
|
|
|
|
change the "root" directory with C<root_dir> parameter. |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
Constructor parameters are: |
689
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
=over |
691
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
=item root_dir |
693
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
Pseudo root directory where to read I<and> write configuration |
695
|
|
|
|
|
|
|
files (L<Path::Tiny> object or string). Configuration directory |
696
|
|
|
|
|
|
|
specified in model or with C<config_dir> option is appended to this |
697
|
|
|
|
|
|
|
root directory |
698
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
=item root_path |
700
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
L<Path::Tiny> object created with C<root_dir> value or with current |
702
|
|
|
|
|
|
|
directory if C<root_dir> is empty. |
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
=item config_dir |
705
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
Directory to read or write configuration file. This parameter must be |
707
|
|
|
|
|
|
|
supplied if not provided by the configuration model. (string) |
708
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
=item backend_arg |
710
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
Specify a backend argument that may be retrieved by some |
712
|
|
|
|
|
|
|
backend. Instance is used as a relay and does not use this data. |
713
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
=item check |
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
Specify whether to check value while reading config files. Either: |
717
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
=over |
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
=item yes |
721
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
Check value and throws an error for bad values. |
723
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
=item skip |
725
|
|
|
|
|
|
|
|
726
|
|
|
|
|
|
|
Check value and skip bad value. |
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
=item no |
729
|
|
|
|
|
|
|
|
730
|
|
|
|
|
|
|
Do not check. |
731
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
=back |
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
=item canonical |
735
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
When true: write config data back using model order. By default, write |
737
|
|
|
|
|
|
|
items back using the order found in the configuration file. This |
738
|
|
|
|
|
|
|
feature is experimental and not supported by all backends. |
739
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
=item on_change_cb |
741
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
Call back this function whenever C<notify_change> is called. Called with |
743
|
|
|
|
|
|
|
arguments: C<< name => <root node element name>, index => <index_value> >> |
744
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
=item on_message_cb |
746
|
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
Call back this function when L<show_message> is called. By default, |
748
|
|
|
|
|
|
|
messages are displayed on STDOUT. |
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
=item error_paths |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
Returns a list of tree items that currently have an error. |
753
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
=item error_messages |
755
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
Returns a list of error messages from the tree content. |
757
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
=back |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
Note that the root directory specified within the configuration model |
761
|
|
|
|
|
|
|
is overridden by C<root_dir> parameter. |
762
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
If you need to load configuration data that are not correct, you can |
764
|
|
|
|
|
|
|
use C<< force_load => 1 >>. Then, wrong data are discarded (equivalent to |
765
|
|
|
|
|
|
|
C<< check => 'no' >> ). |
766
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
=head1 METHODS |
768
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
=head2 Manage configuration data |
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
=head2 modify |
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
Calls L</"load"> and then L</save>. |
774
|
|
|
|
|
|
|
|
775
|
|
|
|
|
|
|
Takes the same parameter as C<load> plus: |
776
|
|
|
|
|
|
|
|
777
|
|
|
|
|
|
|
=over |
778
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
=item C<force_write> |
780
|
|
|
|
|
|
|
|
781
|
|
|
|
|
|
|
Force saving configuration file even if no value was modified |
782
|
|
|
|
|
|
|
(default is 0) |
783
|
|
|
|
|
|
|
|
784
|
|
|
|
|
|
|
=item C<quiet> |
785
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
Do no display the changes brought by the modification steps |
787
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
=back |
789
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
=head2 load |
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
Load configuration tree with configuration data. See |
793
|
|
|
|
|
|
|
L<Config::Model::Loader/"load"> for parameters. |
794
|
|
|
|
|
|
|
Returns <$self>. |
795
|
|
|
|
|
|
|
|
796
|
|
|
|
|
|
|
=head2 save |
797
|
|
|
|
|
|
|
|
798
|
|
|
|
|
|
|
Save the content of the configuration tree to |
799
|
|
|
|
|
|
|
configuration files. (See L</write_back> for more details) |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
Use C<< force => 1 >> option to force saving configuration data. |
802
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
=head2 config_root |
804
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
Returns the L<root object|Config::Model::Node> of the configuration tree. |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
=head2 apply_fixes |
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
Scan the tree and apply fixes that are attached to warning specifications. |
810
|
|
|
|
|
|
|
See C<warn_if_match> or C<warn_unless_match> in L<Config::Model::Value/>. |
811
|
|
|
|
|
|
|
|
812
|
|
|
|
|
|
|
=head2 deep_check |
813
|
|
|
|
|
|
|
|
814
|
|
|
|
|
|
|
Scan the tree and deep check on all elements that support this. Currently only hash or |
815
|
|
|
|
|
|
|
list element have this feature. |
816
|
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
=head2 needs_save |
818
|
|
|
|
|
|
|
|
819
|
|
|
|
|
|
|
Returns 1 (or more) if the instance contains data that needs to be |
820
|
|
|
|
|
|
|
saved. I.e some change were done in the tree that needs to be saved. |
821
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
=head2 has_changes |
823
|
|
|
|
|
|
|
|
824
|
|
|
|
|
|
|
Returns true if the instance contains unsasved changes. |
825
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
=head2 list_changes |
827
|
|
|
|
|
|
|
|
828
|
|
|
|
|
|
|
In list context, returns a array ref of strings describing the changes. |
829
|
|
|
|
|
|
|
In scalar context, returns a big string. Useful to print. |
830
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
=head2 say_changes |
832
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
Print all changes on STDOUT and return C<$self>. |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
=head2 clear_changes |
836
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
Clear list of changes. Note that changes pending in the configuration |
838
|
|
|
|
|
|
|
tree is not affected. This clears only the list shown to user. Use |
839
|
|
|
|
|
|
|
only for tests. |
840
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
=head2 has_warning |
842
|
|
|
|
|
|
|
|
843
|
|
|
|
|
|
|
Returns the number of warning found in the elements of this configuration instance. |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
=head2 update |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
Parameters: C<< ( quiet => (0|1), %args ) >> |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
Try to run update command on all nodes of the configuration tree. Node |
850
|
|
|
|
|
|
|
without C<update> method are ignored. C<update> prints a message |
851
|
|
|
|
|
|
|
otherwise (unless C<quiet> is true). |
852
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
=head2 grab |
854
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
Use the steps parameter to retrieve and returns an object from the |
856
|
|
|
|
|
|
|
configuration tree. Forwarded to L<Config::Model::Role::Grab/grab> |
857
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
=head2 grab_value |
859
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
Use the steps parameter to retrieve and returns the value of a leaf |
861
|
|
|
|
|
|
|
object from the configuration tree. Forwarded to |
862
|
|
|
|
|
|
|
L<Config::Model::Role::Grab/grab_value> |
863
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
=head2 searcher |
865
|
|
|
|
|
|
|
|
866
|
|
|
|
|
|
|
Returns an object dedicated to search an element in the configuration |
867
|
|
|
|
|
|
|
model. |
868
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
This method returns a L<Config::Model::Searcher> object. See |
870
|
|
|
|
|
|
|
L<Config::Model::Searcher> for details on how to handle a search. |
871
|
|
|
|
|
|
|
|
872
|
|
|
|
|
|
|
=head2 iterator |
873
|
|
|
|
|
|
|
|
874
|
|
|
|
|
|
|
This method returns a L<Config::Model::Iterator> object. See |
875
|
|
|
|
|
|
|
L<Config::Model::Iterator> for details. |
876
|
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
Arguments are explained in L<Config::Model::Iterator> |
878
|
|
|
|
|
|
|
L<constructor arguments|Config::Model::Iterator/"Creating an iterator">. |
879
|
|
|
|
|
|
|
|
880
|
|
|
|
|
|
|
=head2 application |
881
|
|
|
|
|
|
|
|
882
|
|
|
|
|
|
|
Returns the application name of the instance. (E.g C<popcon>, C<dpkg> ...) |
883
|
|
|
|
|
|
|
|
884
|
|
|
|
|
|
|
=head2 wizard_helper |
885
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
Deprecated. Call L</iterator> instead. |
887
|
|
|
|
|
|
|
|
888
|
|
|
|
|
|
|
=head1 Internal methods |
889
|
|
|
|
|
|
|
|
890
|
|
|
|
|
|
|
=head2 name |
891
|
|
|
|
|
|
|
|
892
|
|
|
|
|
|
|
Returns the instance name. |
893
|
|
|
|
|
|
|
|
894
|
|
|
|
|
|
|
=head2 read_check |
895
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
Returns which kind of check is performed while reading configuration |
897
|
|
|
|
|
|
|
files. (see C<check> parameter in L</CONSTRUCTOR> section) |
898
|
|
|
|
|
|
|
|
899
|
|
|
|
|
|
|
=head2 show_message |
900
|
|
|
|
|
|
|
|
901
|
|
|
|
|
|
|
Parameters: C<( string )> |
902
|
|
|
|
|
|
|
|
903
|
|
|
|
|
|
|
Display the message on STDOUT unless a custom function was passed to |
904
|
|
|
|
|
|
|
C<on_message_cb> parameter. |
905
|
|
|
|
|
|
|
|
906
|
|
|
|
|
|
|
=head2 reset_config |
907
|
|
|
|
|
|
|
|
908
|
|
|
|
|
|
|
Destroy current configuration tree (with data) and returns a new tree with |
909
|
|
|
|
|
|
|
data (and annotations) loaded from disk. |
910
|
|
|
|
|
|
|
|
911
|
|
|
|
|
|
|
=head2 config_model |
912
|
|
|
|
|
|
|
|
913
|
|
|
|
|
|
|
Returns the model (L<Config::Model> object) of the configuration tree. |
914
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
=head2 annotation_saver |
916
|
|
|
|
|
|
|
|
917
|
|
|
|
|
|
|
Returns the object loading and saving annotations. See |
918
|
|
|
|
|
|
|
L<Config::Model::Annotation> for details. |
919
|
|
|
|
|
|
|
|
920
|
|
|
|
|
|
|
=head2 preset_start |
921
|
|
|
|
|
|
|
|
922
|
|
|
|
|
|
|
All values stored in preset mode are shown to the user as default |
923
|
|
|
|
|
|
|
values. This feature is useful to enter configuration data entered by |
924
|
|
|
|
|
|
|
an automatic process (like hardware scan) |
925
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
=head2 preset_stop |
927
|
|
|
|
|
|
|
|
928
|
|
|
|
|
|
|
Stop preset mode |
929
|
|
|
|
|
|
|
|
930
|
|
|
|
|
|
|
=head2 preset |
931
|
|
|
|
|
|
|
|
932
|
|
|
|
|
|
|
Get preset mode |
933
|
|
|
|
|
|
|
|
934
|
|
|
|
|
|
|
=head2 preset_clear |
935
|
|
|
|
|
|
|
|
936
|
|
|
|
|
|
|
Clear all preset values stored. |
937
|
|
|
|
|
|
|
|
938
|
|
|
|
|
|
|
=head2 layered_start |
939
|
|
|
|
|
|
|
|
940
|
|
|
|
|
|
|
All values stored in layered mode are shown to the user as default |
941
|
|
|
|
|
|
|
values. This feature is useful to enter configuration data entered by |
942
|
|
|
|
|
|
|
an automatic process (like hardware scan) |
943
|
|
|
|
|
|
|
|
944
|
|
|
|
|
|
|
=head2 layered_stop |
945
|
|
|
|
|
|
|
|
946
|
|
|
|
|
|
|
Stop layered mode |
947
|
|
|
|
|
|
|
|
948
|
|
|
|
|
|
|
=head2 layered |
949
|
|
|
|
|
|
|
|
950
|
|
|
|
|
|
|
Get layered mode |
951
|
|
|
|
|
|
|
|
952
|
|
|
|
|
|
|
=head2 layered_clear |
953
|
|
|
|
|
|
|
|
954
|
|
|
|
|
|
|
Clear all layered values stored. |
955
|
|
|
|
|
|
|
|
956
|
|
|
|
|
|
|
=head2 get_data_mode |
957
|
|
|
|
|
|
|
|
958
|
|
|
|
|
|
|
Returns 'normal' or 'preset' or 'layered'. Does not take into account |
959
|
|
|
|
|
|
|
initial_load. |
960
|
|
|
|
|
|
|
|
961
|
|
|
|
|
|
|
=head2 initial_load_start |
962
|
|
|
|
|
|
|
|
963
|
|
|
|
|
|
|
Start initial_load mode. This mode tracks the first modifications of |
964
|
|
|
|
|
|
|
the tree done with data read from the configuration file. |
965
|
|
|
|
|
|
|
|
966
|
|
|
|
|
|
|
Instance is built with initial_load as 1. Read backend clears this |
967
|
|
|
|
|
|
|
value once the first read is done. |
968
|
|
|
|
|
|
|
|
969
|
|
|
|
|
|
|
Other modifications, when initial_load is zero, are assumed to be user |
970
|
|
|
|
|
|
|
modifications. |
971
|
|
|
|
|
|
|
|
972
|
|
|
|
|
|
|
=head2 initial_load_stop |
973
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
Stop initial_load mode. Instance is built with initial_load as 1. Read backend |
975
|
|
|
|
|
|
|
clears this value once the first read is done. |
976
|
|
|
|
|
|
|
|
977
|
|
|
|
|
|
|
=head2 initial_load |
978
|
|
|
|
|
|
|
|
979
|
|
|
|
|
|
|
Get initial_load mode |
980
|
|
|
|
|
|
|
|
981
|
|
|
|
|
|
|
=head2 data |
982
|
|
|
|
|
|
|
|
983
|
|
|
|
|
|
|
This method provides a way to store some arbitrary data in the |
984
|
|
|
|
|
|
|
instance object. |
985
|
|
|
|
|
|
|
|
986
|
|
|
|
|
|
|
E.g: |
987
|
|
|
|
|
|
|
|
988
|
|
|
|
|
|
|
$instance->data(foo => 'bar'); |
989
|
|
|
|
|
|
|
|
990
|
|
|
|
|
|
|
Later: |
991
|
|
|
|
|
|
|
|
992
|
|
|
|
|
|
|
my $foo = $instance->data('foo'); # $foo contains 'bar' |
993
|
|
|
|
|
|
|
|
994
|
|
|
|
|
|
|
=head1 Read and write backend features |
995
|
|
|
|
|
|
|
|
996
|
|
|
|
|
|
|
Usually, a program based on config model must first create the |
997
|
|
|
|
|
|
|
configuration model, then load all configuration data. |
998
|
|
|
|
|
|
|
|
999
|
|
|
|
|
|
|
This feature enables you to declare with the model a way to load |
1000
|
|
|
|
|
|
|
configuration data (and to write it back). See |
1001
|
|
|
|
|
|
|
L<Config::Model::BackendMgr> for details. |
1002
|
|
|
|
|
|
|
|
1003
|
|
|
|
|
|
|
=head2 backend_arg |
1004
|
|
|
|
|
|
|
|
1005
|
|
|
|
|
|
|
Get L<cme> command line argument that may be used by the backend to |
1006
|
|
|
|
|
|
|
get the configuration file. These method is typically used in the read |
1007
|
|
|
|
|
|
|
and write method of a backend to know where is the configuration file |
1008
|
|
|
|
|
|
|
to edit. |
1009
|
|
|
|
|
|
|
|
1010
|
|
|
|
|
|
|
=head2 root_dir |
1011
|
|
|
|
|
|
|
|
1012
|
|
|
|
|
|
|
Returns a L<Path::Tiny> object for the root directory where |
1013
|
|
|
|
|
|
|
configuration data is read from or written to. |
1014
|
|
|
|
|
|
|
|
1015
|
|
|
|
|
|
|
=head2 root_path |
1016
|
|
|
|
|
|
|
|
1017
|
|
|
|
|
|
|
Same as C<root_dir> |
1018
|
|
|
|
|
|
|
|
1019
|
|
|
|
|
|
|
=head2 register_write_back |
1020
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
Parameters: C<( node_location )> |
1022
|
|
|
|
|
|
|
|
1023
|
|
|
|
|
|
|
Register a node path that is called back with |
1024
|
|
|
|
|
|
|
C<write_back> method. |
1025
|
|
|
|
|
|
|
|
1026
|
|
|
|
|
|
|
=head2 notify_change |
1027
|
|
|
|
|
|
|
|
1028
|
|
|
|
|
|
|
Notify that some data has changed in the tree. See |
1029
|
|
|
|
|
|
|
L<Config::Model::AnyThing/notify_change> for more details. |
1030
|
|
|
|
|
|
|
|
1031
|
|
|
|
|
|
|
=head2 write_back |
1032
|
|
|
|
|
|
|
|
1033
|
|
|
|
|
|
|
In summary, save the content of the configuration tree to |
1034
|
|
|
|
|
|
|
configuration files. |
1035
|
|
|
|
|
|
|
|
1036
|
|
|
|
|
|
|
In more details, C<write_back> tries to run all subroutines registered |
1037
|
|
|
|
|
|
|
with C<register_write_back> to write the configuration information. |
1038
|
|
|
|
|
|
|
(See L<Config::Model::BackendMgr> for details). |
1039
|
|
|
|
|
|
|
|
1040
|
|
|
|
|
|
|
You can specify here another config directory to write configuration |
1041
|
|
|
|
|
|
|
data back with C<config_dir> parameter. This overrides the model |
1042
|
|
|
|
|
|
|
specifications. |
1043
|
|
|
|
|
|
|
|
1044
|
|
|
|
|
|
|
C<write_back> croaks if no write call-back are known. |
1045
|
|
|
|
|
|
|
|
1046
|
|
|
|
|
|
|
Use C<< force => 1 >> option to force saving configuration data. This |
1047
|
|
|
|
|
|
|
is useful to write back a file even no change are done at semantic |
1048
|
|
|
|
|
|
|
level, i.e. to reformat a file or remove unnecessary data. |
1049
|
|
|
|
|
|
|
|
1050
|
|
|
|
|
|
|
=head1 AUTHOR |
1051
|
|
|
|
|
|
|
|
1052
|
|
|
|
|
|
|
Dominique Dumont, (ddumont at cpan dot org) |
1053
|
|
|
|
|
|
|
|
1054
|
|
|
|
|
|
|
=head1 SEE ALSO |
1055
|
|
|
|
|
|
|
|
1056
|
|
|
|
|
|
|
L<Config::Model>, |
1057
|
|
|
|
|
|
|
L<Config::Model::Node>, |
1058
|
|
|
|
|
|
|
L<Config::Model::Loader>, |
1059
|
|
|
|
|
|
|
L<Config::Model::Searcher>, |
1060
|
|
|
|
|
|
|
L<Config::Model::Value>, |
1061
|
|
|
|
|
|
|
|
1062
|
|
|
|
|
|
|
=head1 AUTHOR |
1063
|
|
|
|
|
|
|
|
1064
|
|
|
|
|
|
|
Dominique Dumont |
1065
|
|
|
|
|
|
|
|
1066
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
1067
|
|
|
|
|
|
|
|
1068
|
|
|
|
|
|
|
This software is Copyright (c) 2005-2022 by Dominique Dumont. |
1069
|
|
|
|
|
|
|
|
1070
|
|
|
|
|
|
|
This is free software, licensed under: |
1071
|
|
|
|
|
|
|
|
1072
|
|
|
|
|
|
|
The GNU Lesser General Public License, Version 2.1, February 1999 |
1073
|
|
|
|
|
|
|
|
1074
|
|
|
|
|
|
|
=cut |