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 Mouse; |
12
|
59
|
|
|
59
|
|
359
|
with "Config::Model::Role::NodeLoader"; |
|
59
|
|
|
|
|
99
|
|
|
59
|
|
|
|
|
355
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
use Carp; |
15
|
59
|
|
|
59
|
|
19592
|
use 5.020; |
|
59
|
|
|
|
|
121
|
|
|
59
|
|
|
|
|
3040
|
|
16
|
59
|
|
|
59
|
|
1004
|
|
|
59
|
|
|
|
|
182
|
|
17
|
|
|
|
|
|
|
use Config::Model::TypeConstraints; |
18
|
59
|
|
|
59
|
|
325
|
use Config::Model::Instance; |
|
59
|
|
|
|
|
126
|
|
|
59
|
|
|
|
|
1470
|
|
19
|
59
|
|
|
59
|
|
328
|
use Config::Model::Exception; |
|
59
|
|
|
|
|
104
|
|
|
59
|
|
|
|
|
1596
|
|
20
|
59
|
|
|
59
|
|
320
|
use Config::Model::Loader; |
|
59
|
|
|
|
|
120
|
|
|
59
|
|
|
|
|
1348
|
|
21
|
59
|
|
|
59
|
|
28366
|
use Config::Model::Dumper; |
|
59
|
|
|
|
|
190
|
|
|
59
|
|
|
|
|
1968
|
|
22
|
59
|
|
|
59
|
|
26039
|
use Config::Model::DumpAsData; |
|
59
|
|
|
|
|
213
|
|
|
59
|
|
|
|
|
2313
|
|
23
|
59
|
|
|
59
|
|
26176
|
use Config::Model::Report; |
|
59
|
|
|
|
|
183
|
|
|
59
|
|
|
|
|
1867
|
|
24
|
59
|
|
|
59
|
|
21719
|
use Config::Model::TreeSearcher; |
|
59
|
|
|
|
|
176
|
|
|
59
|
|
|
|
|
1774
|
|
25
|
59
|
|
|
59
|
|
22459
|
use Config::Model::Describe; |
|
59
|
|
|
|
|
175
|
|
|
59
|
|
|
|
|
1861
|
|
26
|
59
|
|
|
59
|
|
24828
|
use Config::Model::BackendMgr; |
|
59
|
|
|
|
|
201
|
|
|
59
|
|
|
|
|
2129
|
|
27
|
59
|
|
|
59
|
|
25037
|
use Log::Log4perl qw(get_logger :levels); |
|
59
|
|
|
|
|
174
|
|
|
59
|
|
|
|
|
2081
|
|
28
|
59
|
|
|
59
|
|
378
|
use Storable qw/dclone/; |
|
59
|
|
|
|
|
113
|
|
|
59
|
|
|
|
|
267
|
|
29
|
59
|
|
|
59
|
|
6148
|
use List::MoreUtils qw(insert_after_string); |
|
59
|
|
|
|
|
111
|
|
|
59
|
|
|
|
|
2381
|
|
30
|
59
|
|
|
59
|
|
331
|
|
|
59
|
|
|
|
|
111
|
|
|
59
|
|
|
|
|
408
|
|
31
|
|
|
|
|
|
|
extends qw/Config::Model::AnyThing/; |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
with "Config::Model::Role::Grab"; |
34
|
|
|
|
|
|
|
with "Config::Model::Role::HelpAsText"; |
35
|
|
|
|
|
|
|
with "Config::Model::Role::ComputeFunction"; |
36
|
|
|
|
|
|
|
with "Config::Model::Role::Constants"; |
37
|
|
|
|
|
|
|
with "Config::Model::Role::Utils"; |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
use feature qw/signatures postderef/; |
40
|
59
|
|
|
59
|
|
36693
|
no warnings qw/experimental::signatures experimental::postderef/; |
|
59
|
|
|
|
|
125
|
|
|
59
|
|
|
|
|
5384
|
|
41
|
59
|
|
|
59
|
|
359
|
|
|
59
|
|
|
|
|
145
|
|
|
59
|
|
|
|
|
443160
|
|
42
|
|
|
|
|
|
|
my %legal_properties = ( |
43
|
|
|
|
|
|
|
status => {qw/obsolete 1 deprecated 1 standard 1/}, |
44
|
|
|
|
|
|
|
level => {qw/important 1 normal 1 hidden 1/}, |
45
|
|
|
|
|
|
|
); |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
my $logger = get_logger("Tree::Node"); |
48
|
|
|
|
|
|
|
my $fix_logger = get_logger("Anything::Fix"); |
49
|
|
|
|
|
|
|
my $change_logger = get_logger("ChangeTracker"); |
50
|
|
|
|
|
|
|
my $deep_check_logger = get_logger('DeepCheck'); |
51
|
|
|
|
|
|
|
my $user_logger = get_logger('User'); |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
# Here are the legal element types |
54
|
|
|
|
|
|
|
my %create_sub_for = ( |
55
|
|
|
|
|
|
|
node => \&create_node, |
56
|
|
|
|
|
|
|
leaf => \&create_leaf, |
57
|
|
|
|
|
|
|
hash => \&create_id, |
58
|
|
|
|
|
|
|
list => \&create_id, |
59
|
|
|
|
|
|
|
check_list => \&create_id, |
60
|
|
|
|
|
|
|
warped_node => \&create_warped_node, |
61
|
|
|
|
|
|
|
); |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
# Node internal documentation |
64
|
|
|
|
|
|
|
# |
65
|
|
|
|
|
|
|
# Since the class holds a significant number of element, here's its |
66
|
|
|
|
|
|
|
# main structure. |
67
|
|
|
|
|
|
|
# |
68
|
|
|
|
|
|
|
# $self |
69
|
|
|
|
|
|
|
# = ( |
70
|
|
|
|
|
|
|
# config_model : Weak reference to Config::Model object |
71
|
|
|
|
|
|
|
# config_class_name |
72
|
|
|
|
|
|
|
# model : model of the config class |
73
|
|
|
|
|
|
|
# instance : Weak reference to Config::Model::Instance object |
74
|
|
|
|
|
|
|
# element_name : Name of the element containing this node |
75
|
|
|
|
|
|
|
# (undef for root node). |
76
|
|
|
|
|
|
|
# parent : weak reference of parent node (undef for root node) |
77
|
|
|
|
|
|
|
# element : actual storage of configuration elements |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
# ) ; |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
has initialized => ( is => 'rw', isa => 'Bool', default => 0 ); |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
has config_class_name => ( is => 'ro', isa => 'Str', required => 1 ); |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
has gist => ( |
86
|
|
|
|
|
|
|
is => 'rw', |
87
|
|
|
|
|
|
|
isa => 'Str', |
88
|
|
|
|
|
|
|
default => '', |
89
|
|
|
|
|
|
|
); |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
my $self = shift; |
92
|
|
|
|
|
|
|
my $gist = $self->gist // ''; |
93
|
4
|
|
|
4
|
1
|
7
|
$gist =~ s!{([\w -]+)}!$self->grab($1)->fetch // ''!ge; |
94
|
4
|
|
50
|
|
|
17
|
return $gist; |
95
|
4
|
|
50
|
|
|
32
|
} |
|
8
|
|
|
|
|
26
|
|
96
|
4
|
|
|
|
|
22
|
|
97
|
|
|
|
|
|
|
has config_file => ( is => 'ro', isa => 'Config::Model::TypeContraints::Path', required => 0 ); |
98
|
|
|
|
|
|
|
has element_name => ( is => 'ro', isa => 'Maybe[Str]', required => 0 ); |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
has instance => ( |
101
|
|
|
|
|
|
|
is => 'ro', |
102
|
|
|
|
|
|
|
isa => 'Config::Model::Instance', |
103
|
|
|
|
|
|
|
weak_ref => 1, |
104
|
|
|
|
|
|
|
required => 1, |
105
|
|
|
|
|
|
|
handles => [qw/read_check/], |
106
|
|
|
|
|
|
|
); |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
has config_model => ( |
109
|
|
|
|
|
|
|
is => 'ro', |
110
|
|
|
|
|
|
|
isa => 'Config::Model', |
111
|
|
|
|
|
|
|
weak_ref => 1, |
112
|
|
|
|
|
|
|
lazy => 1, |
113
|
|
|
|
|
|
|
builder => '_config_model' |
114
|
|
|
|
|
|
|
); |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
my $self = shift; |
117
|
|
|
|
|
|
|
return $self->instance->config_model; |
118
|
|
|
|
|
|
|
} |
119
|
764
|
|
|
764
|
|
1489
|
|
120
|
764
|
|
|
|
|
5271
|
has model => ( is => 'rw', isa => 'HashRef' ); |
121
|
|
|
|
|
|
|
has needs_save => ( is => 'rw', isa => 'Bool', default => 0 ); |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
has backend_mgr => ( is => 'ro', isa => 'Maybe[Config::Model::BackendMgr]' ); |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
# used to avoid warning twice about a deprecated element. Internal methods |
126
|
|
|
|
|
|
|
has warned_deprecated_element => ( |
127
|
|
|
|
|
|
|
is => 'ro', |
128
|
|
|
|
|
|
|
isa => 'HashRef[Str]', |
129
|
|
|
|
|
|
|
traits => ['Hash'], |
130
|
|
|
|
|
|
|
default => sub { {}; }, |
131
|
|
|
|
|
|
|
handles => { |
132
|
|
|
|
|
|
|
warn_element_done => 'set', |
133
|
|
|
|
|
|
|
was_element_warned => 'defined', |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
) ; |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
# attribute is defined in Config::Model::Anything |
138
|
|
|
|
|
|
|
my $self = shift; |
139
|
|
|
|
|
|
|
return $self->backend_mgr ? $self->backend_mgr->support_annotation |
140
|
|
|
|
|
|
|
: $self->parent ? $self->parent->backend_support_annotation |
141
|
|
|
|
|
|
|
: undef ; # no backend at all. test only |
142
|
11
|
|
|
11
|
|
19
|
} |
143
|
11
|
50
|
|
|
|
128
|
|
|
|
100
|
|
|
|
|
|
144
|
|
|
|
|
|
|
my $self = shift; |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
my $caller_class = defined $self->parent ? $self->parent->name : 'user'; |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
my $class_name = $self->config_class_name; |
149
|
764
|
|
|
764
|
1
|
1507
|
$logger->debug("New $class_name requested by $caller_class"); |
150
|
|
|
|
|
|
|
|
151
|
764
|
100
|
|
|
|
3670
|
$self->{original_model} = $self->config_model->model($class_name); |
152
|
|
|
|
|
|
|
$self->model( dclone($self->{original_model}) ) ; |
153
|
764
|
|
|
|
|
1996
|
|
154
|
764
|
|
|
|
|
3273
|
$self->check_properties; |
155
|
|
|
|
|
|
|
|
156
|
764
|
|
|
|
|
8475
|
return $self; |
157
|
764
|
|
|
|
|
47101
|
} |
158
|
|
|
|
|
|
|
|
159
|
764
|
|
|
|
|
2877
|
## Create_* methods are all internal and should not be used directly |
160
|
|
|
|
|
|
|
|
161
|
764
|
|
|
|
|
8720
|
my %args = _resolve_arg_shortcut(\@args, 'name'); |
162
|
|
|
|
|
|
|
my $element_name = $args{name}; |
163
|
|
|
|
|
|
|
my $check = $args{check} || 'yes'; |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
my $element_info = $self->{model}{element}{$element_name}; |
166
|
3670
|
|
|
3670
|
0
|
4680
|
|
|
3670
|
|
|
|
|
4426
|
|
|
3670
|
|
|
|
|
6700
|
|
|
3670
|
|
|
|
|
4405
|
|
167
|
3670
|
|
|
|
|
9132
|
if ( not defined $element_info ) { |
168
|
3670
|
|
|
|
|
6979
|
if ( $check eq 'yes' ) { |
169
|
3670
|
|
50
|
|
|
7870
|
Config::Model::Exception::UnknownElement->throw( |
170
|
|
|
|
|
|
|
object => $self, |
171
|
3670
|
|
|
|
|
7469
|
where => $self->location || 'configuration root', |
172
|
|
|
|
|
|
|
element => $element_name, |
173
|
3670
|
100
|
|
|
|
7210
|
); |
174
|
2
|
100
|
|
|
|
9
|
} |
175
|
1
|
|
50
|
|
|
26
|
else { |
176
|
|
|
|
|
|
|
return; # just skip when check is no or skip |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
Config::Model::Exception::Model->throw( |
181
|
|
|
|
|
|
|
error => "element '$element_name' error: " . "passed information is not a hash ref", |
182
|
1
|
|
|
|
|
5
|
object => $self |
183
|
|
|
|
|
|
|
) unless ref($element_info) eq 'HASH'; |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
Config::Model::Exception::Model->throw( |
186
|
|
|
|
|
|
|
error => "create element '$element_name' error: " . "missing 'type' parameter", |
187
|
3668
|
50
|
|
|
|
8588
|
object => $self |
188
|
|
|
|
|
|
|
) unless defined $element_info->{type}; |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
my $method = $create_sub_for{ $element_info->{type} }; |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
croak $self->{config_class_name}, |
193
|
|
|
|
|
|
|
" error: unknown element type $element_info->{type}, expected ", |
194
|
3668
|
50
|
|
|
|
8144
|
join(' ', sort keys %create_sub_for) |
195
|
|
|
|
|
|
|
unless defined $method; |
196
|
3668
|
|
|
|
|
7708
|
|
197
|
|
|
|
|
|
|
return $self->$method( $element_name, $check ); |
198
|
|
|
|
|
|
|
} |
199
|
3668
|
50
|
|
|
|
6630
|
|
200
|
|
|
|
|
|
|
my ( $self, $element_name, $check ) = @_; |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
my $element_info = dclone( $self->{model}{element}{$element_name} ); |
203
|
3668
|
|
|
|
|
8197
|
my $config_class_name = $element_info->{config_class_name}; |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
Config::Model::Exception::Model->throw( |
206
|
|
|
|
|
|
|
error => "create node '$element_name' error: " . "missing config class name parameter", |
207
|
183
|
|
|
183
|
0
|
528
|
object => $self |
208
|
|
|
|
|
|
|
) unless defined $element_info->{config_class_name}; |
209
|
183
|
|
|
|
|
4308
|
|
210
|
183
|
|
|
|
|
564
|
my @args = ( |
211
|
|
|
|
|
|
|
config_class_name => $config_class_name, |
212
|
|
|
|
|
|
|
instance => $self->{instance}, |
213
|
|
|
|
|
|
|
element_name => $element_name, |
214
|
|
|
|
|
|
|
parent => $self, |
215
|
183
|
50
|
|
|
|
539
|
container => $self, |
216
|
|
|
|
|
|
|
); |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
return $self->{element}{$element_name} = $self->load_node(@args); |
219
|
|
|
|
|
|
|
} |
220
|
183
|
|
|
|
|
762
|
|
221
|
|
|
|
|
|
|
my ( $self, $element_name, $check ) = @_; |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
my $element_info = dclone( $self->{model}{element}{$element_name} ); |
224
|
|
|
|
|
|
|
|
225
|
183
|
|
|
|
|
829
|
my @args = ( |
226
|
|
|
|
|
|
|
instance => $self->{instance}, |
227
|
|
|
|
|
|
|
element_name => $element_name, |
228
|
|
|
|
|
|
|
parent => $self, |
229
|
126
|
|
|
126
|
0
|
392
|
check => $check, |
230
|
|
|
|
|
|
|
container => $self, |
231
|
126
|
|
|
|
|
5728
|
); |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
require Config::Model::WarpedNode; |
234
|
|
|
|
|
|
|
|
235
|
126
|
|
|
|
|
765
|
return $self->{element}{$element_name} = |
236
|
|
|
|
|
|
|
Config::Model::WarpedNode->new( %$element_info, @args ); |
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
my ( $self, $element_name, $check ) = @_; |
240
|
|
|
|
|
|
|
|
241
|
126
|
|
|
|
|
13290
|
my $element_info = dclone( $self->{model}{element}{$element_name} ); |
242
|
|
|
|
|
|
|
|
243
|
126
|
|
|
|
|
1396
|
delete $element_info->{type}; |
244
|
|
|
|
|
|
|
my $leaf_class = delete $element_info->{class} || 'Config::Model::Value'; |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
if ( not defined *{ $leaf_class . '::' } ) { |
247
|
|
|
|
|
|
|
my $file = $leaf_class . '.pm'; |
248
|
2791
|
|
|
2791
|
0
|
5604
|
$file =~ s!::!/!g; |
249
|
|
|
|
|
|
|
require $file; |
250
|
2791
|
|
|
|
|
73573
|
} |
251
|
|
|
|
|
|
|
|
252
|
2791
|
|
|
|
|
7668
|
$element_info->{container} = $element_info->{parent} = $self; |
253
|
2791
|
|
100
|
|
|
10041
|
$element_info->{element_name} = $element_name; |
254
|
|
|
|
|
|
|
$element_info->{instance} = $self->{instance}; |
255
|
2791
|
100
|
|
|
|
3944
|
|
|
2791
|
|
|
|
|
14188
|
|
256
|
1
|
|
|
|
|
4
|
return $self->{element}{$element_name} = $leaf_class->new(%$element_info); |
257
|
1
|
|
|
|
|
5
|
} |
258
|
1
|
|
|
|
|
384
|
|
259
|
|
|
|
|
|
|
my %id_class_hash = ( |
260
|
|
|
|
|
|
|
hash => 'HashId', |
261
|
2791
|
|
|
|
|
6172
|
list => 'ListId', |
262
|
2791
|
|
|
|
|
5301
|
check_list => 'CheckList', |
263
|
2791
|
|
|
|
|
5256
|
); |
264
|
|
|
|
|
|
|
|
265
|
2791
|
|
|
|
|
23115
|
my ( $self, $element_name, $check ) = @_; |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
my $element_info = dclone( $self->{model}{element}{$element_name} ); |
268
|
|
|
|
|
|
|
my $type = delete $element_info->{type}; |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
Config::Model::Exception::Model->throw( |
271
|
|
|
|
|
|
|
error => "create $type element '$element_name' error" . ": missing 'type' parameter", |
272
|
|
|
|
|
|
|
object => $self |
273
|
|
|
|
|
|
|
) unless defined $type; |
274
|
|
|
|
|
|
|
|
275
|
568
|
|
|
568
|
0
|
1305
|
croak "Undefined id_class for type '$type'" |
276
|
|
|
|
|
|
|
unless defined $id_class_hash{$type}; |
277
|
568
|
|
|
|
|
18922
|
|
278
|
568
|
|
|
|
|
1965
|
my $id_class = delete $element_info->{class} |
279
|
|
|
|
|
|
|
|| 'Config::Model::' . $id_class_hash{$type}; |
280
|
568
|
50
|
|
|
|
1419
|
|
281
|
|
|
|
|
|
|
if ( not defined *{ $id_class . '::' } ) { |
282
|
|
|
|
|
|
|
my $file = $id_class . '.pm'; |
283
|
|
|
|
|
|
|
$file =~ s!::!/!g; |
284
|
|
|
|
|
|
|
require $file; |
285
|
|
|
|
|
|
|
} |
286
|
568
|
50
|
|
|
|
1647
|
|
287
|
|
|
|
|
|
|
$element_info->{container} = $element_info->{parent} = $self; |
288
|
|
|
|
|
|
|
$element_info->{element_name} = $element_name; |
289
|
568
|
|
66
|
|
|
2766
|
$element_info->{instance} = $self->{instance}; |
290
|
|
|
|
|
|
|
|
291
|
568
|
100
|
|
|
|
960
|
return $self->{element}{$element_name} = $id_class->new(%$element_info); |
|
568
|
|
|
|
|
3117
|
|
292
|
81
|
|
|
|
|
232
|
} |
293
|
81
|
|
|
|
|
623
|
|
294
|
81
|
|
|
|
|
46685
|
# check validity of level and status declaration. |
295
|
|
|
|
|
|
|
my $self = shift; |
296
|
|
|
|
|
|
|
|
297
|
568
|
|
|
|
|
1789
|
# a model should no longer contain attributes attached to |
298
|
568
|
|
|
|
|
1181
|
# an element (like description, level ...). There are copied here |
299
|
568
|
|
|
|
|
1108
|
# because Node needs them as hash or lists |
300
|
|
|
|
|
|
|
foreach my $bad (qw/description summary level status/) { |
301
|
568
|
|
|
|
|
5399
|
die $self->config_class_name, ": illegal '$bad' parameter in model ", |
302
|
|
|
|
|
|
|
"(Should be handled by Config::Model directly)\n" |
303
|
|
|
|
|
|
|
if defined $self->{model}{$bad}; |
304
|
|
|
|
|
|
|
} |
305
|
|
|
|
|
|
|
|
306
|
764
|
|
|
764
|
0
|
1489
|
foreach my $elt_name ( @{ $self->{model}{element_list} } ) { |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
foreach my $prop (qw/summary description/) { |
309
|
|
|
|
|
|
|
my $info_to_move = delete $self->{model}{element}{$elt_name}{$prop}; |
310
|
|
|
|
|
|
|
$self->{$prop}{$elt_name} = $info_to_move |
311
|
764
|
|
|
|
|
1954
|
if defined $info_to_move; |
312
|
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
|
|
314
|
3056
|
50
|
|
|
|
6519
|
foreach my $prop ( keys %legal_properties ) { |
315
|
|
|
|
|
|
|
my $prop_v |
316
|
|
|
|
|
|
|
= delete $self->{model}{element}{$elt_name}{$prop} |
317
|
764
|
|
|
|
|
1268
|
// get_default_property($prop) ; |
|
764
|
|
|
|
|
2121
|
|
318
|
|
|
|
|
|
|
$self->{$prop}{$elt_name} = $prop_v; |
319
|
4215
|
|
|
|
|
5378
|
|
320
|
8430
|
|
|
|
|
11807
|
croak "Config class $self->{config_class_name} error: ", |
321
|
8430
|
100
|
|
|
|
14058
|
"Unknown $prop: '$prop_v'. Expected ", join( " or ", keys %{ $self->{$prop} } ) |
322
|
|
|
|
|
|
|
unless defined $legal_properties{$prop}{$prop_v}; |
323
|
|
|
|
|
|
|
} |
324
|
|
|
|
|
|
|
} |
325
|
4215
|
|
|
|
|
7295
|
return; |
326
|
|
|
|
|
|
|
} |
327
|
8430
|
|
66
|
|
|
19859
|
|
328
|
|
|
|
|
|
|
return if $self->{initialized}; |
329
|
8430
|
|
|
|
|
14005
|
$self->{initialized} = 1; # avoid recursions |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
my $model = $self->{model}; |
332
|
0
|
|
|
|
|
0
|
|
333
|
8430
|
50
|
|
|
|
17042
|
return unless defined $model->{rw_config}; |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
my $initial_load_backup = $self->instance->initial_load; |
336
|
764
|
|
|
|
|
1481
|
$self->instance->initial_load_start; |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
$self->{backend_mgr} ||= Config::Model::BackendMgr->new( |
339
|
22507
|
|
|
22507
|
0
|
30097
|
# config_dir spec given by application info |
|
22507
|
|
|
|
|
25062
|
|
|
22507
|
|
|
|
|
24255
|
|
|
22507
|
|
|
|
|
23751
|
|
340
|
22507
|
100
|
|
|
|
44044
|
config_dir => $self->instance->config_dir, |
341
|
722
|
|
|
|
|
1480
|
node => $self, |
342
|
|
|
|
|
|
|
rw_config => $model->{rw_config} |
343
|
722
|
|
|
|
|
1290
|
); |
344
|
|
|
|
|
|
|
|
345
|
722
|
100
|
|
|
|
1898
|
$self->read_config_data( check => $self->read_check ); |
346
|
|
|
|
|
|
|
# setup auto_write |
347
|
93
|
|
|
|
|
409
|
$self->backend_mgr->auto_write_init(); |
348
|
93
|
|
|
|
|
591
|
|
349
|
|
|
|
|
|
|
$self->instance->initial_load($initial_load_backup); |
350
|
|
|
|
|
|
|
return; |
351
|
|
|
|
|
|
|
} |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
my ( $self, %args ) = @_; |
354
|
|
|
|
|
|
|
|
355
|
93
|
|
33
|
|
|
2903
|
my $model = $self->{model}; |
356
|
|
|
|
|
|
|
|
357
|
93
|
|
|
|
|
512
|
if ( $self->location and $args{config_file} ) { |
358
|
|
|
|
|
|
|
die "read_config_data: cannot override config_file in non root node (", |
359
|
93
|
|
|
|
|
679
|
$self->location, ")\n"; |
360
|
|
|
|
|
|
|
} |
361
|
93
|
|
|
|
|
842
|
|
362
|
93
|
|
|
|
|
950
|
# setup auto_read |
363
|
|
|
|
|
|
|
# may use an overridden config file |
364
|
|
|
|
|
|
|
return $self->backend_mgr->read_config_data( |
365
|
|
|
|
|
|
|
check => $args{check}, |
366
|
99
|
|
|
99
|
0
|
1836
|
config_file => $args{config_file} || $self->{config_file}, |
367
|
|
|
|
|
|
|
auto_create => $args{auto_create} || $self->instance->auto_create, |
368
|
99
|
|
|
|
|
204
|
); |
369
|
|
|
|
|
|
|
} |
370
|
99
|
50
|
66
|
|
|
650
|
|
371
|
0
|
|
|
|
|
0
|
around notify_change => sub ($orig, $self, %args) { |
372
|
|
|
|
|
|
|
if ($change_logger->is_trace) { |
373
|
|
|
|
|
|
|
my @with = map { "'$_' -> '". ($args{$_} // '<undef>') ."'" } sort keys %args; |
374
|
|
|
|
|
|
|
$change_logger->trace("called for ", $self->name, " from ", join( ' ', caller ), " with ", join( ' ', @with )); |
375
|
|
|
|
|
|
|
} |
376
|
|
|
|
|
|
|
return if $self->instance->initial_load and not $args{really}; |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
$logger->trace( "called while needs_write is ", $self->needs_save, " for ", $self->name ) |
379
|
|
|
|
|
|
|
if $logger->is_trace; |
380
|
99
|
|
100
|
|
|
1343
|
|
|
|
|
33
|
|
|
|
|
381
|
|
|
|
|
|
|
if ( defined $self->backend_mgr ) { |
382
|
|
|
|
|
|
|
$self->needs_save(1); # will trigger a save in config_file |
383
|
|
|
|
|
|
|
$self->$orig( %args, needs_save => 0 ); |
384
|
|
|
|
|
|
|
} |
385
|
|
|
|
|
|
|
else { |
386
|
|
|
|
|
|
|
# save config_file will be done by a node above |
387
|
|
|
|
|
|
|
$self->$orig( %args, needs_save => 1 ); |
388
|
|
|
|
|
|
|
} |
389
|
|
|
|
|
|
|
return; |
390
|
|
|
|
|
|
|
}; |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
return 0 unless defined $self->backend_mgr; |
393
|
|
|
|
|
|
|
return $self->backend_mgr->is_auto_write_for_type(@args); |
394
|
|
|
|
|
|
|
} |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
my $self = shift; |
397
|
|
|
|
|
|
|
return $self->location() || $self->config_class_name; |
398
|
|
|
|
|
|
|
} |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
return 'node'; |
401
|
|
|
|
|
|
|
} |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
return 'node'; |
404
|
|
|
|
|
|
|
} |
405
|
18
|
|
|
18
|
0
|
30
|
|
|
18
|
|
|
|
|
37
|
|
|
18
|
|
|
|
|
38
|
|
|
18
|
|
|
|
|
25
|
|
406
|
18
|
100
|
|
|
|
115
|
# always true. this method is required so that WarpedNode and Node |
407
|
1
|
|
|
|
|
6
|
# have a similar API. |
408
|
|
|
|
|
|
|
return 1; |
409
|
|
|
|
|
|
|
} |
410
|
|
|
|
|
|
|
|
411
|
20758
|
|
|
20758
|
1
|
30667
|
# should I autovivify this element: NO |
412
|
20758
|
|
66
|
|
|
103283
|
my %args = _resolve_arg_shortcut(\@args, 'name'); |
413
|
|
|
|
|
|
|
my $name = $args{name}; |
414
|
|
|
|
|
|
|
my $type = $args{type}; |
415
|
|
|
|
|
|
|
my $autoadd = $args{autoadd} // 1; |
416
|
828
|
|
|
828
|
1
|
1828
|
|
417
|
|
|
|
|
|
|
if ( not defined $name ) { |
418
|
|
|
|
|
|
|
Config::Model::Exception::Internal->throw( |
419
|
|
|
|
|
|
|
object => $self, |
420
|
705
|
|
|
705
|
0
|
1210
|
info => "has_element: missing element name", |
421
|
|
|
|
|
|
|
); |
422
|
|
|
|
|
|
|
} |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
$self->accept_element($name) if $autoadd; |
425
|
|
|
|
|
|
|
return 0 unless defined $self->{model}{element}{$name}; |
426
|
0
|
|
|
0
|
0
|
0
|
return 1 unless defined $type; |
427
|
|
|
|
|
|
|
return $self->{model}{element}{$name}{type} eq $type ? 1 : 0; |
428
|
|
|
|
|
|
|
} |
429
|
|
|
|
|
|
|
|
430
|
4042
|
|
|
4042
|
1
|
5409
|
# should I autovivify this element: NO |
|
4042
|
|
|
|
|
5288
|
|
|
4042
|
|
|
|
|
6914
|
|
|
4042
|
|
|
|
|
5021
|
|
431
|
4042
|
|
|
|
|
10008
|
my ( $self, $name, %args ) = @_; |
432
|
4042
|
|
|
|
|
8001
|
croak "find_element: missing element name" unless defined $name; |
433
|
4042
|
|
|
|
|
6164
|
|
434
|
4042
|
|
100
|
|
|
9934
|
# should be the case if people are using cme edit |
435
|
|
|
|
|
|
|
return $name if defined $self->{model}{element}{$name}; |
436
|
4042
|
50
|
|
|
|
7882
|
|
437
|
0
|
|
|
|
|
0
|
# look for a close element playing with cases; |
438
|
|
|
|
|
|
|
if ( defined $args{case} and $args{case} eq 'any' ) { |
439
|
|
|
|
|
|
|
foreach my $elt ( keys %{ $self->{model}{element} } ) { |
440
|
|
|
|
|
|
|
return $elt if lc($elt) eq lc($name); |
441
|
|
|
|
|
|
|
} |
442
|
|
|
|
|
|
|
} |
443
|
4042
|
100
|
|
|
|
12826
|
|
444
|
4042
|
100
|
|
|
|
9509
|
# now look if the element can be accepted |
445
|
3818
|
100
|
|
|
|
14707
|
$self->accept_element($name); |
446
|
2
|
100
|
|
|
|
12
|
return $name if defined $self->{model}{element}{$name}; |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
return; |
449
|
|
|
|
|
|
|
} |
450
|
|
|
|
|
|
|
|
451
|
0
|
|
|
0
|
1
|
0
|
return $self->{model}{element}{ $elt_name }; |
452
|
0
|
0
|
|
|
|
0
|
} |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
my ($self, $name) = @_; |
455
|
0
|
0
|
|
|
|
0
|
croak "element_type: missing element name" unless $name; |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
my $element_info = $self->{model}{element}{$name} // $self-> _get_accepted_data($name); |
458
|
0
|
0
|
0
|
|
|
0
|
|
459
|
0
|
|
|
|
|
0
|
Config::Model::Exception::UnknownElement->throw( |
|
0
|
|
|
|
|
0
|
|
460
|
0
|
0
|
|
|
|
0
|
object => $self, |
461
|
|
|
|
|
|
|
function => 'element_type', |
462
|
|
|
|
|
|
|
where => $self->location || 'configuration root', |
463
|
|
|
|
|
|
|
element => $name, |
464
|
|
|
|
|
|
|
) unless defined $element_info; |
465
|
0
|
|
|
|
|
0
|
|
466
|
0
|
0
|
|
|
|
0
|
return $element_info->{type}; |
467
|
|
|
|
|
|
|
} |
468
|
0
|
|
|
|
|
0
|
|
469
|
|
|
|
|
|
|
goto &get_element_names; |
470
|
|
|
|
|
|
|
} |
471
|
0
|
|
|
0
|
1
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
472
|
0
|
|
|
|
|
0
|
if (delete $args{for}) { |
473
|
|
|
|
|
|
|
carp "get_element_names arg 'for' is deprecated"; |
474
|
|
|
|
|
|
|
} |
475
|
|
|
|
|
|
|
|
476
|
12462
|
|
|
12462
|
1
|
19662
|
my $type = $args{type}; # optional |
477
|
12462
|
50
|
|
|
|
20554
|
my $cargo_type = $args{cargo_type}; # optional |
478
|
|
|
|
|
|
|
|
479
|
12462
|
|
66
|
|
|
30715
|
$self->init(); |
480
|
|
|
|
|
|
|
|
481
|
12462
|
50
|
0
|
|
|
20417
|
my @result; |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
my $info = $self->{model}; |
484
|
|
|
|
|
|
|
my @element_list = @{ $self->{model}{element_list} }; |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
if ($args{all}) { |
487
|
|
|
|
|
|
|
my @res = grep { $self->{level}{$_} ne 'hidden' } @element_list; |
488
|
12462
|
|
|
|
|
33550
|
return wantarray ? @res : "@res"; |
489
|
|
|
|
|
|
|
} |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
# this is a bit convoluted, but the order of the returned element |
492
|
1463
|
|
|
1463
|
0
|
6147
|
# must respect the order of the elements declared in the model by |
493
|
|
|
|
|
|
|
# the user |
494
|
|
|
|
|
|
|
foreach my $elt (@element_list) { |
495
|
1495
|
|
|
1495
|
1
|
2271
|
|
|
1495
|
|
|
|
|
1919
|
|
|
1495
|
|
|
|
|
2513
|
|
|
1495
|
|
|
|
|
1823
|
|
496
|
1495
|
50
|
|
|
|
3403
|
# create element if they don't exist, this enables warp stuff |
497
|
0
|
|
|
|
|
0
|
# to kick in |
498
|
|
|
|
|
|
|
$self->create_element( name => $elt, check => $args{check} || 'yes' ) |
499
|
|
|
|
|
|
|
unless defined $self->{element}{$elt}; |
500
|
1495
|
|
|
|
|
2235
|
|
501
|
1495
|
|
|
|
|
2166
|
next if $self->{level}{$elt} eq 'hidden'; |
502
|
|
|
|
|
|
|
|
503
|
1495
|
|
|
|
|
3313
|
my $status = $self->{status}{$elt} || get_default_property('status'); |
504
|
|
|
|
|
|
|
next if ( $status eq 'deprecated' or $status eq 'obsolete' ); |
505
|
1495
|
|
|
|
|
1959
|
|
506
|
|
|
|
|
|
|
my $elt_type = $self->{element}{$elt}->get_type; |
507
|
1495
|
|
|
|
|
3040
|
my $elt_cargo = $self->{element}{$elt}->get_cargo_type; |
508
|
1495
|
|
|
|
|
2055
|
if ( ( not defined $type or $type eq $elt_type ) |
|
1495
|
|
|
|
|
6922
|
|
509
|
|
|
|
|
|
|
and ( not defined $cargo_type or $cargo_type eq $elt_cargo ) ) { |
510
|
1495
|
100
|
|
|
|
3462
|
push @result, $elt; |
511
|
21
|
|
|
|
|
45
|
} |
|
42
|
|
|
|
|
129
|
|
512
|
21
|
50
|
|
|
|
113
|
} |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
$logger->trace("got @result"); |
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
return wantarray ? @result : join( ' ', @result ); |
517
|
|
|
|
|
|
|
} |
518
|
1474
|
|
|
|
|
2739
|
|
519
|
|
|
|
|
|
|
my $self = shift; |
520
|
|
|
|
|
|
|
return $self->get_element_names; |
521
|
|
|
|
|
|
|
} |
522
|
|
|
|
|
|
|
|
523
|
8610
|
100
|
100
|
|
|
22283
|
my $element = $args{name}; |
524
|
|
|
|
|
|
|
|
525
|
8610
|
100
|
|
|
|
20656
|
my @elements = @{ $self->{model}{element_list} }; |
526
|
|
|
|
|
|
|
@elements = reverse @elements if $args{reverse}; |
527
|
8517
|
|
33
|
|
|
15549
|
|
528
|
8517
|
100
|
100
|
|
|
21113
|
# if element is empty, start from first element |
529
|
|
|
|
|
|
|
my $found_elt = ( defined $element and $element ) ? 0 : 1; |
530
|
8461
|
|
|
|
|
19863
|
|
531
|
8461
|
|
|
|
|
17295
|
while ( my $name = shift @elements ) { |
532
|
8461
|
100
|
33
|
|
|
24319
|
if ($found_elt) { |
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
533
|
|
|
|
|
|
|
return $name |
534
|
8335
|
|
|
|
|
14992
|
if $self->is_element_available( |
535
|
|
|
|
|
|
|
name => $name, |
536
|
|
|
|
|
|
|
status => $args{status} ); |
537
|
|
|
|
|
|
|
} |
538
|
1474
|
|
|
|
|
7783
|
$found_elt = 1 if defined $element and $element eq $name; |
539
|
|
|
|
|
|
|
} |
540
|
1474
|
50
|
|
|
|
16899
|
|
541
|
|
|
|
|
|
|
croak "next_element: element $element is unknown. Expected @elements" |
542
|
|
|
|
|
|
|
unless $found_elt; |
543
|
|
|
|
|
|
|
return; |
544
|
2
|
|
|
2
|
1
|
4
|
} |
545
|
2
|
|
|
|
|
4
|
|
546
|
|
|
|
|
|
|
return $self->next_element( @args, reverse => 1 ); |
547
|
|
|
|
|
|
|
} |
548
|
239
|
|
|
239
|
1
|
1343
|
|
|
239
|
|
|
|
|
296
|
|
|
239
|
|
|
|
|
562
|
|
|
239
|
|
|
|
|
258
|
|
549
|
239
|
|
|
|
|
338
|
my ( $prop, $elt ) = $self->check_property_args( 'get_element_property', %args ); |
550
|
|
|
|
|
|
|
|
551
|
239
|
|
|
|
|
294
|
return $self->{$prop}{$elt} || get_default_property($prop); |
|
239
|
|
|
|
|
864
|
|
552
|
239
|
100
|
|
|
|
625
|
} |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
my ( $prop, $elt ) = $self->check_property_args( 'set_element_property', %args ); |
555
|
239
|
100
|
100
|
|
|
709
|
|
556
|
|
|
|
|
|
|
my $new_value = $args{value} |
557
|
239
|
|
|
|
|
561
|
|| croak "set_element_property:: missing 'value' parameter"; |
558
|
1046
|
100
|
|
|
|
1488
|
|
559
|
|
|
|
|
|
|
$logger->debug( "Node ", $self->name, ": set $elt property $prop to $new_value" ); |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
return $self->{$prop}{$elt} = $new_value; |
562
|
206
|
100
|
|
|
|
507
|
} |
563
|
|
|
|
|
|
|
|
564
|
843
|
100
|
66
|
|
|
2341
|
my ( $prop, $elt ) = $self->check_property_args( 'reset_element_property', %args ); |
565
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
my $original_value = $self->{config_model}->get_element_property( |
567
|
36
|
50
|
|
|
|
114
|
class => $self->{config_class_name}, |
568
|
|
|
|
|
|
|
%args |
569
|
36
|
|
|
|
|
100
|
); |
570
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
$logger->debug( "Node ", $self->name, ": reset $elt property $prop to $original_value" ); |
572
|
3
|
|
|
3
|
1
|
4
|
|
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
4
|
|
573
|
3
|
|
|
|
|
7
|
return $self->{$prop}{$elt} = $original_value; |
574
|
|
|
|
|
|
|
} |
575
|
|
|
|
|
|
|
|
576
|
30785
|
|
|
30785
|
1
|
34060
|
# internal: called by the property methods to check their arguments |
|
30785
|
|
|
|
|
33051
|
|
|
30785
|
|
|
|
|
56627
|
|
|
30785
|
|
|
|
|
32287
|
|
577
|
30785
|
|
|
|
|
63560
|
my $elt = $args{element} |
578
|
|
|
|
|
|
|
|| croak "$method_name: missing 'element' parameter"; |
579
|
30785
|
|
33
|
|
|
82862
|
my $prop = $args{property} |
580
|
|
|
|
|
|
|
|| croak "$method_name: missing 'property' parameter"; |
581
|
|
|
|
|
|
|
|
582
|
242
|
|
|
242
|
1
|
437
|
my $prop_values = $legal_properties{$prop}; |
|
242
|
|
|
|
|
423
|
|
|
242
|
|
|
|
|
697
|
|
|
242
|
|
|
|
|
331
|
|
583
|
242
|
|
|
|
|
838
|
confess "Unknown property in $method_name: $prop, expected status or ", "level" |
584
|
|
|
|
|
|
|
unless defined $prop_values; |
585
|
|
|
|
|
|
|
|
586
|
242
|
|
33
|
|
|
825
|
return ( $prop, $elt ); |
587
|
|
|
|
|
|
|
} |
588
|
242
|
|
|
|
|
633
|
|
589
|
|
|
|
|
|
|
my %args = _resolve_arg_shortcut(\@args, 'name'); |
590
|
242
|
|
|
|
|
2256
|
my $element_name = $args{name}; |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
Config::Model::Exception::Internal->throw( error => "fetch_element: missing name" ) |
593
|
718
|
|
|
718
|
1
|
1268
|
unless defined $element_name; |
|
718
|
|
|
|
|
1223
|
|
|
718
|
|
|
|
|
1911
|
|
|
718
|
|
|
|
|
994
|
|
594
|
718
|
|
|
|
|
2418
|
|
595
|
|
|
|
|
|
|
my $check = $self->_check_check( $args{check} ); |
596
|
|
|
|
|
|
|
my $accept_hidden = $args{accept_hidden} || 0; |
597
|
|
|
|
|
|
|
my $autoadd = $args{autoadd} // 1; |
598
|
718
|
|
|
|
|
4955
|
|
599
|
|
|
|
|
|
|
$self->init(); |
600
|
|
|
|
|
|
|
|
601
|
718
|
|
|
|
|
2956
|
my $model = $self->{model}; |
602
|
|
|
|
|
|
|
|
603
|
718
|
|
|
|
|
7761
|
# retrieve element (and auto-vivify if needed) |
604
|
|
|
|
|
|
|
if ( not defined $self->{element}{$element_name} ) { |
605
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
# We also need to check if element name is matched by any of 'accept' parameters |
607
|
31745
|
|
|
31745
|
0
|
35494
|
$self->accept_element($element_name) if $autoadd; |
|
31745
|
|
|
|
|
33935
|
|
|
31745
|
|
|
|
|
35373
|
|
|
31745
|
|
|
|
|
44762
|
|
|
31745
|
|
|
|
|
33633
|
|
608
|
|
|
|
|
|
|
$self->create_element( name => $element_name, check => $check ) or return; |
609
|
31745
|
|
33
|
|
|
53709
|
} |
610
|
|
|
|
|
|
|
|
611
|
31745
|
|
33
|
|
|
47620
|
# check level |
612
|
|
|
|
|
|
|
my $element_level = $self->get_element_property( |
613
|
31745
|
|
|
|
|
42290
|
property => 'level', |
614
|
31745
|
50
|
|
|
|
47109
|
element => $element_name |
615
|
|
|
|
|
|
|
); |
616
|
|
|
|
|
|
|
|
617
|
31745
|
|
|
|
|
72077
|
if ( $element_level eq 'hidden' and not $accept_hidden ) { |
618
|
|
|
|
|
|
|
return 0 if ( $check eq 'no' or $check eq 'skip' ); |
619
|
|
|
|
|
|
|
Config::Model::Exception::UnavailableElement->throw( |
620
|
20754
|
|
|
20754
|
1
|
403482
|
object => $self, |
|
20754
|
|
|
|
|
24151
|
|
|
20754
|
|
|
|
|
34007
|
|
|
20754
|
|
|
|
|
22112
|
|
621
|
20754
|
|
|
|
|
44548
|
element => $element_name, |
622
|
20754
|
|
|
|
|
34981
|
info => 'hidden element', |
623
|
|
|
|
|
|
|
); |
624
|
20754
|
50
|
|
|
|
35945
|
} |
625
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
# check status |
627
|
20754
|
|
|
|
|
49226
|
if ( $self->{status}{$element_name} eq 'obsolete' ) { |
628
|
20754
|
|
100
|
|
|
52012
|
|
629
|
20754
|
|
100
|
|
|
46031
|
# obsolete is a status not very different from a missing |
630
|
|
|
|
|
|
|
# item. The only difference is that user will get more |
631
|
20754
|
|
|
|
|
44735
|
# information |
632
|
|
|
|
|
|
|
return 0 if ( $check eq 'no' or $check eq 'skip' ); |
633
|
20754
|
|
|
|
|
28074
|
Config::Model::Exception::ObsoleteElement->throw( |
634
|
|
|
|
|
|
|
object => $self, |
635
|
|
|
|
|
|
|
element => $element_name, |
636
|
20754
|
100
|
|
|
|
40218
|
); |
637
|
|
|
|
|
|
|
} |
638
|
|
|
|
|
|
|
|
639
|
1430
|
100
|
|
|
|
4529
|
# do not warn when when is skip or "no" |
640
|
1430
|
100
|
|
|
|
3850
|
if ($self->{status}{$element_name} eq 'deprecated' and $check eq 'yes' ) { |
641
|
|
|
|
|
|
|
# FIXME elaborate more ? or include parameter description ?? |
642
|
|
|
|
|
|
|
my $msg = "Element '$element_name' of node '". $self->name. "' is deprecated"; |
643
|
|
|
|
|
|
|
if (not $self->was_element_warned($element_name)) { |
644
|
20744
|
|
|
|
|
38820
|
$user_logger->warn($msg); |
645
|
|
|
|
|
|
|
$self->warn_element_done($element_name,1); |
646
|
|
|
|
|
|
|
} |
647
|
|
|
|
|
|
|
# this will also force a rewrite of the file even if no other |
648
|
|
|
|
|
|
|
# semantic change was done |
649
|
20744
|
100
|
100
|
|
|
41277
|
$self->notify_change( |
650
|
4
|
50
|
33
|
|
|
27
|
note => 'dropping deprecated parameter', |
651
|
4
|
|
|
|
|
77
|
path => $self->location . ' ' . $element_name, |
652
|
|
|
|
|
|
|
really => 1, |
653
|
|
|
|
|
|
|
); |
654
|
|
|
|
|
|
|
} |
655
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
return $self->fetch_element_no_check($element_name); |
657
|
|
|
|
|
|
|
} |
658
|
|
|
|
|
|
|
|
659
|
20740
|
100
|
|
|
|
39375
|
my ( $self, $element_name ) = @_; |
660
|
|
|
|
|
|
|
return $self->{element}{$element_name}; |
661
|
|
|
|
|
|
|
} |
662
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
my %args = @args > 1 ? @args : ( name => $args[0] ); |
664
|
1
|
50
|
33
|
|
|
6
|
my $element_name = $args{name}; |
665
|
1
|
|
|
|
|
18
|
my $check = $self->_check_check( $args{check} ); |
666
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
if ( $self->element_type($element_name) ne 'leaf' ) { |
668
|
|
|
|
|
|
|
Config::Model::Exception::WrongType->throw( |
669
|
|
|
|
|
|
|
object => $self->fetch_element($element_name), |
670
|
|
|
|
|
|
|
function => 'fetch_element_value', |
671
|
|
|
|
|
|
|
got_type => $self->element_type($element_name), |
672
|
20739
|
100
|
100
|
|
|
39255
|
expected_type => 'leaf', |
673
|
|
|
|
|
|
|
); |
674
|
19
|
|
|
|
|
67
|
} |
675
|
19
|
100
|
|
|
|
75
|
|
676
|
11
|
|
|
|
|
201
|
return $self->fetch_element(%args)->fetch( check => $check ); |
677
|
11
|
|
|
|
|
528
|
} |
678
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
my %args = _resolve_arg_shortcut(\@args, 'name', 'value'); |
680
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
return $self->fetch_element(%args)->store(%args); |
682
|
19
|
|
|
|
|
596
|
} |
683
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
my ( $elt_name, $status ) = ( undef, 'deprecated' ); |
685
|
|
|
|
|
|
|
if ( @args == 1 ) { |
686
|
|
|
|
|
|
|
$elt_name = $args[0]; |
687
|
|
|
|
|
|
|
} |
688
|
20739
|
|
|
|
|
33041
|
else { |
689
|
|
|
|
|
|
|
my %args = @args; |
690
|
|
|
|
|
|
|
$elt_name = $args{name}; |
691
|
|
|
|
|
|
|
$status = $args{status} if defined $args{status}; |
692
|
20739
|
|
|
20739
|
0
|
29968
|
} |
693
|
20739
|
|
|
|
|
60144
|
|
694
|
|
|
|
|
|
|
croak "is_element_available: missing name parameter" |
695
|
|
|
|
|
|
|
unless defined $elt_name; |
696
|
464
|
|
|
464
|
1
|
944
|
|
|
464
|
|
|
|
|
558
|
|
|
464
|
|
|
|
|
701
|
|
|
464
|
|
|
|
|
475
|
|
697
|
464
|
50
|
|
|
|
1187
|
# force the warp to be done (if possible) so the catalog name |
698
|
464
|
|
|
|
|
663
|
# is updated |
699
|
464
|
|
|
|
|
1322
|
# retrieve element (and auto-vivify if needed) |
700
|
|
|
|
|
|
|
my $element = $self->fetch_element( |
701
|
464
|
50
|
|
|
|
1145
|
name => $elt_name, |
702
|
0
|
|
|
|
|
0
|
# check => 'no' causes problem because elements below (when |
703
|
|
|
|
|
|
|
# loaded by another backend also below) are initialised with |
704
|
|
|
|
|
|
|
# check 'no'. Deprecated elements are loaded but changes are |
705
|
|
|
|
|
|
|
# not notified because of check/no. |
706
|
|
|
|
|
|
|
check => 'skip', |
707
|
|
|
|
|
|
|
accept_hidden => 1 |
708
|
|
|
|
|
|
|
); |
709
|
|
|
|
|
|
|
|
710
|
464
|
|
|
|
|
1083
|
my $element_level = $self->get_element_property( |
711
|
|
|
|
|
|
|
property => 'level', |
712
|
|
|
|
|
|
|
element => $elt_name |
713
|
2
|
|
|
2
|
1
|
5
|
); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
3
|
|
714
|
2
|
|
|
|
|
7
|
|
715
|
|
|
|
|
|
|
if ( $element_level eq 'hidden' ) { |
716
|
2
|
|
|
|
|
8
|
$logger->trace("element $elt_name is level hidden -> return 0"); |
717
|
|
|
|
|
|
|
return 0; |
718
|
|
|
|
|
|
|
} |
719
|
4914
|
|
|
4914
|
1
|
6557
|
|
|
4914
|
|
|
|
|
6368
|
|
|
4914
|
|
|
|
|
8069
|
|
|
4914
|
|
|
|
|
5583
|
|
720
|
4914
|
|
|
|
|
8112
|
my $element_status = $self->get_element_property( |
721
|
4914
|
100
|
|
|
|
9541
|
property => 'status', |
722
|
6
|
|
|
|
|
10
|
element => $elt_name |
723
|
|
|
|
|
|
|
); |
724
|
|
|
|
|
|
|
|
725
|
4908
|
|
|
|
|
9191
|
if ( $element_status ne 'standard' and $element_status ne $status ) { |
726
|
4908
|
|
|
|
|
7272
|
$logger->trace("element $elt_name is status $element_status -> return 0"); |
727
|
4908
|
100
|
|
|
|
11719
|
return 0; |
728
|
|
|
|
|
|
|
} |
729
|
|
|
|
|
|
|
|
730
|
4914
|
50
|
|
|
|
9441
|
return 1; |
731
|
|
|
|
|
|
|
} |
732
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
my ( $self, $name ) = @_; |
734
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
my $model_data = $self->{model}{element}; |
736
|
4914
|
|
|
|
|
10823
|
|
737
|
|
|
|
|
|
|
return $model_data->{$name} if defined $model_data->{$name}; |
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
my $acc = $self-> _get_accepted_data($name); |
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
return $self->reset_accepted_element_model( $name, $acc ) if $acc; |
742
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
return; |
744
|
|
|
|
|
|
|
} |
745
|
|
|
|
|
|
|
|
746
|
4914
|
|
|
|
|
9526
|
# return accepted model data or undef |
747
|
|
|
|
|
|
|
my ( $self, $name ) = @_; |
748
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
return unless defined $self->{model}{accept}; |
750
|
|
|
|
|
|
|
|
751
|
4914
|
100
|
|
|
|
9778
|
eval {require Text::Levenshtein::Damerau} ; |
752
|
16
|
|
|
|
|
98
|
my $has_tld = ! $@ ; |
753
|
16
|
|
|
|
|
202
|
|
754
|
|
|
|
|
|
|
foreach my $accept_regexp ( @{ $self->{model}{accept_list} } ) { |
755
|
|
|
|
|
|
|
next unless $name =~ /^$accept_regexp$/; |
756
|
4898
|
|
|
|
|
8335
|
my $element_list = $self->{original_model}{element_list} ; |
757
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
if ($has_tld and $element_list and @$element_list) { |
759
|
|
|
|
|
|
|
my $tld = Text::Levenshtein::Damerau->new($name); |
760
|
|
|
|
|
|
|
my $tld_arg = {list => $element_list }; |
761
|
4898
|
50
|
66
|
|
|
11311
|
my $dist = $tld->dld_best_distance($tld_arg); |
762
|
0
|
|
|
|
|
0
|
if ($dist < 3) { |
763
|
0
|
|
|
|
|
0
|
my $best = $tld->dld_best_match($tld_arg); |
764
|
|
|
|
|
|
|
$user_logger->warn( |
765
|
|
|
|
|
|
|
"Warning: ".$self->location |
766
|
4898
|
|
|
|
|
16821
|
." '$name' is confusingly close to '$best' (edit distance is $dist)." |
767
|
|
|
|
|
|
|
." Is there a typo ?" |
768
|
|
|
|
|
|
|
); |
769
|
|
|
|
|
|
|
} |
770
|
5391
|
|
|
5391
|
1
|
9939
|
|
771
|
|
|
|
|
|
|
} |
772
|
5391
|
|
|
|
|
9236
|
|
773
|
|
|
|
|
|
|
return $self->{model}{accept}{$accept_regexp}; |
774
|
5391
|
100
|
|
|
|
15274
|
} |
775
|
|
|
|
|
|
|
|
776
|
220
|
|
|
|
|
594
|
return ; |
777
|
|
|
|
|
|
|
} |
778
|
220
|
100
|
|
|
|
563
|
|
779
|
|
|
|
|
|
|
my ($self) = @_; |
780
|
195
|
|
|
|
|
313
|
|
781
|
|
|
|
|
|
|
return @{ $self->{model}{accept_list} || [] }; |
782
|
|
|
|
|
|
|
} |
783
|
|
|
|
|
|
|
|
784
|
|
|
|
|
|
|
my ( $self, $element_name, $accept_model ) = @_; |
785
|
221
|
|
|
221
|
|
448
|
|
786
|
|
|
|
|
|
|
my $model = dclone $accept_model ; |
787
|
221
|
50
|
|
|
|
594
|
delete $model->{name_match}; |
788
|
|
|
|
|
|
|
my $accept_after = delete $model->{accept_after}; |
789
|
221
|
|
|
|
|
412
|
|
|
221
|
|
|
|
|
7807
|
|
790
|
221
|
|
|
|
|
26004
|
foreach my $info_to_move (qw/description summary/) { |
791
|
|
|
|
|
|
|
my $moved_data = delete $model->{$info_to_move}; |
792
|
221
|
|
|
|
|
343
|
next unless defined $moved_data; |
|
221
|
|
|
|
|
710
|
|
793
|
64
|
100
|
|
|
|
697
|
$self->{$info_to_move}{$element_name} = $moved_data; |
794
|
26
|
|
|
|
|
81
|
} |
795
|
|
|
|
|
|
|
|
796
|
26
|
100
|
33
|
|
|
139
|
foreach my $info_to_move (qw/level status/) { |
|
|
|
66
|
|
|
|
|
797
|
14
|
|
|
|
|
51
|
$self->reset_element_property( |
798
|
14
|
|
|
|
|
149
|
element => $element_name, |
799
|
14
|
|
|
|
|
68
|
property => $info_to_move |
800
|
14
|
100
|
|
|
|
13648
|
); |
801
|
4
|
|
|
|
|
11
|
} |
802
|
4
|
|
|
|
|
3502
|
|
803
|
|
|
|
|
|
|
$self->{model}{element}{$element_name} = $model; |
804
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
#add to element list... |
806
|
|
|
|
|
|
|
if ($accept_after) { |
807
|
|
|
|
|
|
|
insert_after_string( $accept_after, $element_name, @{ $self->{model}{element_list} } ); |
808
|
|
|
|
|
|
|
} |
809
|
|
|
|
|
|
|
else { |
810
|
|
|
|
|
|
|
push @{ $self->{model}{element_list} }, $element_name; |
811
|
26
|
|
|
|
|
349
|
} |
812
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
return ($model); |
814
|
195
|
|
|
|
|
434
|
} |
815
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
my $self = shift; |
817
|
|
|
|
|
|
|
my $element_name = shift; |
818
|
5
|
|
|
5
|
1
|
20
|
|
819
|
|
|
|
|
|
|
return defined $self->{model}{element}{$element_name} ? 1 : 0; |
820
|
5
|
50
|
|
|
|
9
|
} |
|
5
|
|
|
|
|
32
|
|
821
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
return defined $self->{element}{ $elt_name }; |
823
|
|
|
|
|
|
|
} |
824
|
25
|
|
|
25
|
0
|
54
|
|
825
|
|
|
|
|
|
|
my %args = _resolve_arg_shortcut(\@args, 'path'); |
826
|
25
|
|
|
|
|
767
|
my $path = delete $args{path}; |
827
|
25
|
|
|
|
|
71
|
my $get_obj = delete $args{get_obj} || 0; |
828
|
25
|
|
|
|
|
46
|
$path =~ s!^/!!; |
829
|
|
|
|
|
|
|
return $self unless length($path); |
830
|
25
|
|
|
|
|
49
|
my ( $item, $new_path ) = split m!/!, $path, 2; |
831
|
50
|
|
|
|
|
76
|
$logger->trace("get: path $path, item $item"); |
832
|
50
|
50
|
|
|
|
109
|
my $elt = $self->fetch_element( name => $item, %args ); |
833
|
0
|
|
|
|
|
0
|
|
834
|
|
|
|
|
|
|
return unless defined $elt; |
835
|
|
|
|
|
|
|
return $elt if ( ( $elt->get_type ne 'leaf' or $get_obj ) and not defined $new_path ); |
836
|
25
|
|
|
|
|
43
|
return $elt->get( path => $new_path, get_obj => $get_obj, %args ); |
837
|
50
|
|
|
|
|
123
|
} |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
$path =~ s!^/!!; |
840
|
|
|
|
|
|
|
my ( $item, $new_path ) = split m!/!, $path, 2; |
841
|
|
|
|
|
|
|
if ( $item =~ /([\w\-]+)\[(\d+)\]/ ) { |
842
|
|
|
|
|
|
|
return $self->fetch_element($1)->fetch_with_id($2)->set( $new_path, @args ); |
843
|
25
|
|
|
|
|
73
|
} |
844
|
|
|
|
|
|
|
else { |
845
|
|
|
|
|
|
|
return $self->fetch_element($item)->set( $new_path, @args ); |
846
|
25
|
100
|
|
|
|
54
|
} |
847
|
3
|
|
|
|
|
4
|
} |
|
3
|
|
|
|
|
19
|
|
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
my $loader = Config::Model::Loader->new( start_node => $self ); |
850
|
22
|
|
|
|
|
27
|
|
|
22
|
|
|
|
|
56
|
|
851
|
|
|
|
|
|
|
my %args = _resolve_arg_shortcut(\@args, 'steps'); |
852
|
|
|
|
|
|
|
if ( defined $args{step} || defined $args{steps}) { |
853
|
25
|
|
|
|
|
48
|
return $loader->load( %args ); |
854
|
|
|
|
|
|
|
} |
855
|
|
|
|
|
|
|
Config::Model::Exception::Load->throw( |
856
|
|
|
|
|
|
|
object => $self, |
857
|
0
|
|
|
0
|
1
|
0
|
message => "load called with no 'steps' parameter", |
858
|
0
|
|
|
|
|
0
|
); |
859
|
|
|
|
|
|
|
return; |
860
|
0
|
0
|
|
|
|
0
|
} |
861
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
my %args = _resolve_arg_shortcut(\@args, 'data'); |
863
|
393
|
|
|
393
|
1
|
646
|
|
|
393
|
|
|
|
|
602
|
|
|
393
|
|
|
|
|
558
|
|
|
393
|
|
|
|
|
510
|
|
864
|
393
|
|
|
|
|
2048
|
my $raw_perl_data = delete $args{data}; |
865
|
|
|
|
|
|
|
my $check = $self->_check_check( $args{check} ); |
866
|
|
|
|
|
|
|
|
867
|
7
|
|
|
7
|
1
|
2080
|
if ( |
|
7
|
|
|
|
|
9
|
|
|
7
|
|
|
|
|
16
|
|
|
7
|
|
|
|
|
7
|
|
868
|
7
|
|
|
|
|
18
|
not defined $raw_perl_data |
869
|
7
|
|
|
|
|
17
|
or ( |
870
|
7
|
|
100
|
|
|
23
|
ref($raw_perl_data) ne 'HASH' |
871
|
7
|
|
|
|
|
23
|
|
872
|
7
|
50
|
|
|
|
14
|
#and not $raw_perl_data->isa( 'HASH' ) |
873
|
7
|
|
|
|
|
18
|
) |
874
|
7
|
|
|
|
|
25
|
) { |
875
|
7
|
|
|
|
|
54
|
Config::Model::Exception::LoadData->throw( |
876
|
|
|
|
|
|
|
object => $self, |
877
|
7
|
100
|
|
|
|
19
|
message => "load_data called with non hash ref arg", |
878
|
6
|
100
|
100
|
|
|
17
|
wrong_data => $raw_perl_data, |
|
|
|
100
|
|
|
|
|
879
|
5
|
|
|
|
|
20
|
) if $check eq 'yes'; |
880
|
|
|
|
|
|
|
return; |
881
|
|
|
|
|
|
|
} |
882
|
2
|
|
|
2
|
1
|
3
|
|
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
3
|
|
883
|
2
|
|
|
|
|
5
|
my $perl_data = dclone $raw_perl_data ; |
884
|
2
|
|
|
|
|
7
|
|
885
|
2
|
50
|
|
|
|
5
|
$logger->info( |
886
|
0
|
|
|
|
|
0
|
"Node load_data (", |
887
|
|
|
|
|
|
|
$self->location, |
888
|
|
|
|
|
|
|
") will load elt ", |
889
|
2
|
|
|
|
|
6
|
join( ' ', sort keys %$perl_data ) ); |
890
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
my $has_stored = 0; |
892
|
|
|
|
|
|
|
# data must be loaded according to the element order defined by |
893
|
398
|
|
|
398
|
1
|
210809
|
# the model. This will not load not yet accepted parameters |
|
398
|
|
|
|
|
840
|
|
|
398
|
|
|
|
|
963
|
|
|
398
|
|
|
|
|
622
|
|
894
|
398
|
|
|
|
|
5301
|
foreach my $elt ( @{ $self->{model}{element_list} } ) { |
895
|
|
|
|
|
|
|
$logger->trace("check element $elt"); |
896
|
398
|
|
|
|
|
4159
|
next unless defined $perl_data->{$elt}; |
897
|
398
|
50
|
66
|
|
|
2344
|
|
898
|
398
|
|
|
|
|
2050
|
if ( $self->is_element_available( name => $elt ) |
899
|
|
|
|
|
|
|
or $check eq 'no' ) { |
900
|
|
|
|
|
|
|
if ( $logger->is_trace ) { |
901
|
0
|
|
|
|
|
0
|
my $v = defined $perl_data->{$elt} ? $perl_data->{$elt} : '<undef>'; |
902
|
|
|
|
|
|
|
$logger->trace("Node load_data for element $elt -> $v"); |
903
|
|
|
|
|
|
|
} |
904
|
0
|
|
|
|
|
0
|
my $obj = $self->fetch_element( |
905
|
|
|
|
|
|
|
name => $elt, |
906
|
|
|
|
|
|
|
check => $check |
907
|
131
|
|
|
131
|
1
|
5522
|
); |
|
131
|
|
|
|
|
190
|
|
|
131
|
|
|
|
|
279
|
|
|
131
|
|
|
|
|
172
|
|
908
|
131
|
|
|
|
|
463
|
|
909
|
|
|
|
|
|
|
if ($obj) { |
910
|
131
|
|
|
|
|
326
|
$has_stored += $obj->load_data( %args, data => delete $perl_data->{$elt} ); |
911
|
131
|
|
|
|
|
559
|
} |
912
|
|
|
|
|
|
|
elsif ( defined $obj ) { |
913
|
131
|
50
|
33
|
|
|
671
|
|
914
|
|
|
|
|
|
|
# skip hidden elements and trash corresponding data |
915
|
|
|
|
|
|
|
$logger->trace("Node load_data drop element $elt"); |
916
|
|
|
|
|
|
|
delete $perl_data->{$elt}; |
917
|
|
|
|
|
|
|
} |
918
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
} |
920
|
|
|
|
|
|
|
elsif ( $check eq 'skip' ) { |
921
|
0
|
0
|
|
|
|
0
|
$logger->trace("Node load_data skips element $elt"); |
922
|
|
|
|
|
|
|
} |
923
|
|
|
|
|
|
|
else { |
924
|
|
|
|
|
|
|
Config::Model::Exception::LoadData->throw( |
925
|
|
|
|
|
|
|
message => "load_data: tried to load hidden " . "element '$elt' with", |
926
|
0
|
|
|
|
|
0
|
wrong_data => $perl_data->{$elt}, |
927
|
|
|
|
|
|
|
object => $self, |
928
|
|
|
|
|
|
|
); |
929
|
131
|
|
|
|
|
3227
|
} |
930
|
|
|
|
|
|
|
} |
931
|
131
|
|
|
|
|
1357
|
|
932
|
|
|
|
|
|
|
# Load elements matched by accept parameter |
933
|
|
|
|
|
|
|
if ( defined $self->{model}{accept} ) { |
934
|
|
|
|
|
|
|
|
935
|
|
|
|
|
|
|
# Now, $perl_data contains all elements not yet parsed |
936
|
|
|
|
|
|
|
# sort is required to have a predictable order of accepted elements |
937
|
131
|
|
|
|
|
1148
|
foreach my $elt ( sort keys %$perl_data ) { |
938
|
|
|
|
|
|
|
|
939
|
|
|
|
|
|
|
#load value |
940
|
131
|
|
|
|
|
203
|
#TODO: annotations |
|
131
|
|
|
|
|
424
|
|
941
|
670
|
|
|
|
|
2005
|
my $obj = $self->fetch_element( name => $elt, check => $check ); |
942
|
670
|
100
|
|
|
|
4963
|
next unless $obj; # in cas of known but unavailable elements |
943
|
|
|
|
|
|
|
$logger->info("Node load_data: accepting element $elt"); |
944
|
331
|
50
|
33
|
|
|
813
|
$has_stored += $obj->load_data( %args, data => delete $perl_data->{$elt} ) if defined $obj; |
|
|
0
|
|
|
|
|
|
945
|
|
|
|
|
|
|
} |
946
|
331
|
100
|
|
|
|
866
|
} |
947
|
27
|
50
|
|
|
|
116
|
|
948
|
27
|
|
|
|
|
91
|
if ( %$perl_data and $check eq 'yes' ) { |
949
|
|
|
|
|
|
|
Config::Model::Exception::LoadData->throw( |
950
|
331
|
|
|
|
|
2094
|
message => "load_data: unknown elements (expected " |
951
|
|
|
|
|
|
|
. join( ' ', @{ $self->{model}{element_list} } ) . ") ", |
952
|
|
|
|
|
|
|
wrong_data => $perl_data, |
953
|
|
|
|
|
|
|
object => $self, |
954
|
|
|
|
|
|
|
); |
955
|
331
|
50
|
|
|
|
688
|
} |
|
|
0
|
|
|
|
|
|
956
|
331
|
|
|
|
|
1356
|
return !! $has_stored; |
957
|
|
|
|
|
|
|
} |
958
|
|
|
|
|
|
|
|
959
|
|
|
|
|
|
|
$self->init(); |
960
|
|
|
|
|
|
|
my $full = delete $args{full_dump} || 0; |
961
|
0
|
|
|
|
|
0
|
if ($full) { |
962
|
0
|
|
|
|
|
0
|
carp "dump_tree: full_dump parameter is deprecated. Please use 'mode => user' instead"; |
963
|
|
|
|
|
|
|
$args{mode} //= 'user'; |
964
|
|
|
|
|
|
|
} |
965
|
|
|
|
|
|
|
my $dumper = Config::Model::Dumper->new; |
966
|
|
|
|
|
|
|
return $dumper->dump_tree( node => $self, %args ); |
967
|
0
|
|
|
|
|
0
|
} |
968
|
|
|
|
|
|
|
|
969
|
|
|
|
|
|
|
$self->init(); |
970
|
|
|
|
|
|
|
Config::Model::Dumper->new->dump_tree( node => $self, mode => 'full', @args ); |
971
|
|
|
|
|
|
|
|
972
|
0
|
|
|
|
|
0
|
return $self->needs_save; |
973
|
|
|
|
|
|
|
} |
974
|
|
|
|
|
|
|
|
975
|
|
|
|
|
|
|
$self->init(); |
976
|
|
|
|
|
|
|
my $dumper = Config::Model::DumpAsData->new; |
977
|
|
|
|
|
|
|
return $dumper->dump_annotations_as_pod( node => $self, @args ); |
978
|
|
|
|
|
|
|
} |
979
|
131
|
50
|
|
|
|
441
|
|
980
|
|
|
|
|
|
|
$self->init(); |
981
|
|
|
|
|
|
|
|
982
|
|
|
|
|
|
|
my $descriptor = Config::Model::Describe->new; |
983
|
131
|
|
|
|
|
359
|
return $descriptor->describe( node => $self, @args ); |
984
|
|
|
|
|
|
|
} |
985
|
|
|
|
|
|
|
|
986
|
|
|
|
|
|
|
$self->init(); |
987
|
12
|
|
|
|
|
36
|
my $reporter = Config::Model::Report->new; |
988
|
12
|
50
|
|
|
|
28
|
return $reporter->report( node => $self ); |
989
|
12
|
|
|
|
|
45
|
} |
990
|
12
|
50
|
|
|
|
123
|
|
991
|
|
|
|
|
|
|
$self->init(); |
992
|
|
|
|
|
|
|
my $reporter = Config::Model::Report->new; |
993
|
|
|
|
|
|
|
return $reporter->report( node => $self, audit => 1 ); |
994
|
131
|
50
|
33
|
|
|
348
|
} |
995
|
|
|
|
|
|
|
|
996
|
|
|
|
|
|
|
my %args = _resolve_arg_shortcut(\@args, 'from'); |
997
|
0
|
|
|
|
|
0
|
my $from = $args{from} || croak "copy_from: missing from argument"; |
|
0
|
|
|
|
|
0
|
|
998
|
|
|
|
|
|
|
my $check = $args{check} || 'yes'; |
999
|
|
|
|
|
|
|
$logger->debug( "node " . $self->location . " copy from " . $from->location ); |
1000
|
|
|
|
|
|
|
my $dump = $from->dump_tree( check => 'no' ); |
1001
|
|
|
|
|
|
|
return $self->load( step => $dump, check => $check ); |
1002
|
131
|
|
|
|
|
670
|
} |
1003
|
|
|
|
|
|
|
|
1004
|
|
|
|
|
|
|
# TODO: need Pod::Text attribute -> move that to a role ? |
1005
|
154
|
|
|
154
|
1
|
46931
|
# to translate Pod description to plain text when help is displayed |
|
154
|
|
|
|
|
317
|
|
|
154
|
|
|
|
|
322
|
|
|
154
|
|
|
|
|
214
|
|
1006
|
154
|
|
|
|
|
494
|
if ($elt_name) { |
1007
|
154
|
|
50
|
|
|
729
|
if ( $tag !~ /^(summary|description)$/ ) { |
1008
|
154
|
50
|
|
|
|
413
|
croak "get_help: wrong argument $tag, expected ", "'description' or 'summary'"; |
1009
|
0
|
|
|
|
|
0
|
} |
1010
|
0
|
|
0
|
|
|
0
|
|
1011
|
|
|
|
|
|
|
return $self->{$tag}{$elt_name} // ''; |
1012
|
154
|
|
|
|
|
1116
|
} |
1013
|
154
|
|
|
|
|
719
|
if ($tag) { |
1014
|
|
|
|
|
|
|
return $self->{description}{ $tag } // ''; |
1015
|
|
|
|
|
|
|
} |
1016
|
0
|
|
|
0
|
1
|
0
|
return $self->{model}{class_description} // ''; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1017
|
0
|
|
|
|
|
0
|
} |
1018
|
0
|
|
|
|
|
0
|
|
1019
|
|
|
|
|
|
|
my $self = shift; |
1020
|
0
|
|
|
|
|
0
|
|
1021
|
|
|
|
|
|
|
my @items = ( 'type: ' . $self->get_type, 'class name: ' . $self->config_class_name, ); |
1022
|
|
|
|
|
|
|
|
1023
|
2
|
|
|
2
|
1
|
1095
|
my @rexp = $self->accept_regexp; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
2
|
|
1024
|
2
|
|
|
|
|
6
|
if (@rexp) { |
1025
|
2
|
|
|
|
|
12
|
push @items, 'accept: /^' . join( '$/, /^', @rexp ) . '$/'; |
1026
|
2
|
|
|
|
|
39
|
} |
1027
|
|
|
|
|
|
|
|
1028
|
|
|
|
|
|
|
return @items; |
1029
|
9
|
|
|
9
|
1
|
20728
|
} |
|
9
|
|
|
|
|
25
|
|
|
9
|
|
|
|
|
23
|
|
|
9
|
|
|
|
|
16
|
|
1030
|
9
|
|
|
|
|
45
|
|
1031
|
|
|
|
|
|
|
return Config::Model::TreeSearcher->new( node => $self, @args ); |
1032
|
9
|
|
|
|
|
64
|
} |
1033
|
9
|
|
|
|
|
41
|
|
1034
|
|
|
|
|
|
|
# define leaf call back |
1035
|
|
|
|
|
|
|
my $do_apply = sub ($name) { |
1036
|
1
|
|
|
1
|
1
|
7
|
return $filter ? $name =~ /$filter/ : 1; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
2
|
|
1037
|
1
|
|
|
|
|
5
|
}; |
1038
|
1
|
|
|
|
|
11
|
|
1039
|
1
|
|
|
|
|
8
|
my $fix_leaf = sub { |
1040
|
|
|
|
|
|
|
my ( $scanner, $data_ref, $node, $element_name, $index, $leaf_object ) = @_; |
1041
|
|
|
|
|
|
|
$leaf_object->apply_fixes if $do_apply->($element_name); |
1042
|
1
|
|
|
1
|
1
|
1427
|
}; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
1
|
|
1043
|
1
|
|
|
|
|
3
|
|
1044
|
1
|
|
|
|
|
9
|
my $fix_hash = sub { |
1045
|
1
|
|
|
|
|
5
|
my ( $scanner, $data_r, $node, $element, @keys ) = @_; |
1046
|
|
|
|
|
|
|
|
1047
|
|
|
|
|
|
|
return unless @keys; |
1048
|
27
|
|
|
27
|
1
|
50
|
|
|
27
|
|
|
|
|
46
|
|
|
27
|
|
|
|
|
62
|
|
|
27
|
|
|
|
|
39
|
|
1049
|
27
|
|
|
|
|
108
|
# leaves must be fixed before the hash, hence the |
1050
|
27
|
|
33
|
|
|
124
|
# calls to scan_hash before apply_fixes |
1051
|
27
|
|
100
|
|
|
94
|
map { $scanner->scan_hash( $data_r, $node, $element, $_ ) } @keys; |
1052
|
27
|
|
|
|
|
191
|
|
1053
|
27
|
|
|
|
|
243
|
$node->fetch_element($element)->apply_fixes if $do_apply->($element); |
1054
|
27
|
|
|
|
|
144
|
}; |
1055
|
|
|
|
|
|
|
|
1056
|
|
|
|
|
|
|
my $fix_list = sub { |
1057
|
|
|
|
|
|
|
my ( $scanner, $data_r, $node, $element, @keys ) = @_; |
1058
|
|
|
|
|
|
|
|
1059
|
124
|
|
|
124
|
1
|
152
|
return unless @keys; |
|
124
|
|
|
|
|
152
|
|
|
124
|
|
|
|
|
166
|
|
|
124
|
|
|
|
|
157
|
|
|
124
|
|
|
|
|
130
|
|
1060
|
124
|
100
|
|
|
|
215
|
|
1061
|
79
|
50
|
|
|
|
279
|
map { $scanner->scan_list( $data_r, $node, $element, $_ ) } @keys; |
1062
|
0
|
|
|
|
|
0
|
$node->fetch_element($element)->apply_fixes if $do_apply->($element); |
1063
|
|
|
|
|
|
|
}; |
1064
|
|
|
|
|
|
|
|
1065
|
79
|
|
100
|
|
|
345
|
my $scan = Config::Model::ObjTreeScanner->new( |
1066
|
|
|
|
|
|
|
hash_element_cb => $fix_hash, |
1067
|
45
|
100
|
|
|
|
71
|
list_element_cb => $fix_list, |
1068
|
44
|
|
100
|
|
|
172
|
leaf_cb => $fix_leaf, |
1069
|
|
|
|
|
|
|
check => 'no', |
1070
|
1
|
|
50
|
|
|
6
|
); |
1071
|
|
|
|
|
|
|
|
1072
|
|
|
|
|
|
|
$fix_logger->debug( "apply fix started from ", $self->name ); |
1073
|
|
|
|
|
|
|
$scan->scan_node( undef, $self ); |
1074
|
2
|
|
|
2
|
1
|
5
|
$fix_logger->trace("apply fix done"); |
1075
|
|
|
|
|
|
|
return $self; |
1076
|
2
|
|
|
|
|
5
|
} |
1077
|
|
|
|
|
|
|
|
1078
|
2
|
|
|
|
|
6
|
$deep_check_logger->trace("called on ".$self->name); |
1079
|
2
|
50
|
|
|
|
5
|
|
1080
|
0
|
|
|
|
|
0
|
# no deep_check defined (yet). Note that value check is done when |
1081
|
|
|
|
|
|
|
# storing value (even during initial load, so there's no need to |
1082
|
|
|
|
|
|
|
# force a check. |
1083
|
2
|
|
|
|
|
5
|
my $check_leaf = sub { }; |
1084
|
|
|
|
|
|
|
|
1085
|
|
|
|
|
|
|
my $check_id = sub { |
1086
|
9
|
|
|
9
|
1
|
9084
|
my ( $scanner, $data_r, $node, $element, @keys ) = @_; |
|
9
|
|
|
|
|
14
|
|
|
9
|
|
|
|
|
19
|
|
|
9
|
|
|
|
|
12
|
|
1087
|
9
|
|
|
|
|
92
|
|
1088
|
|
|
|
|
|
|
$deep_check_logger->trace( "deep check called on from ", $node->name, " elt $element keys @keys" ); |
1089
|
|
|
|
|
|
|
return unless @keys; |
1090
|
7
|
|
|
7
|
1
|
4054
|
$node->fetch_element($element)->deep_check; |
|
7
|
|
|
|
|
12
|
|
|
7
|
|
|
|
|
15
|
|
|
7
|
|
|
|
|
10
|
|
1091
|
|
|
|
|
|
|
|
1092
|
138
|
|
|
138
|
|
144
|
}; |
|
138
|
|
|
|
|
295
|
|
|
138
|
|
|
|
|
156
|
|
1093
|
138
|
100
|
|
|
|
622
|
|
1094
|
7
|
|
|
|
|
33
|
my $scan = Config::Model::ObjTreeScanner->new( |
1095
|
|
|
|
|
|
|
hash_element_hook => $check_id, |
1096
|
|
|
|
|
|
|
list_element_hook => $check_id, |
1097
|
127
|
|
|
127
|
|
209
|
leaf_cb => $check_leaf, |
1098
|
127
|
100
|
|
|
|
198
|
auto_vivify => $args{auto_vivify}, |
1099
|
7
|
|
|
|
|
26
|
check => 'no', |
1100
|
|
|
|
|
|
|
); |
1101
|
|
|
|
|
|
|
|
1102
|
3
|
|
|
3
|
|
8
|
$deep_check_logger->debug( "deep check started from ", $self->name ); |
1103
|
|
|
|
|
|
|
$scan->scan_node( undef, $self ); |
1104
|
3
|
50
|
|
|
|
7
|
$deep_check_logger->trace("deep check done"); |
1105
|
|
|
|
|
|
|
return; |
1106
|
|
|
|
|
|
|
} |
1107
|
|
|
|
|
|
|
|
1108
|
3
|
|
|
|
|
6
|
__PACKAGE__->meta->make_immutable; |
|
7
|
|
|
|
|
20
|
|
1109
|
|
|
|
|
|
|
|
1110
|
3
|
50
|
|
|
|
6
|
1; |
1111
|
7
|
|
|
|
|
27
|
|
1112
|
|
|
|
|
|
|
# ABSTRACT: Class for configuration tree node |
1113
|
|
|
|
|
|
|
|
1114
|
11
|
|
|
11
|
|
28
|
|
1115
|
|
|
|
|
|
|
=pod |
1116
|
11
|
100
|
|
|
|
36
|
|
1117
|
|
|
|
|
|
|
=encoding UTF-8 |
1118
|
8
|
|
|
|
|
19
|
|
|
28
|
|
|
|
|
73
|
|
1119
|
8
|
50
|
|
|
|
19
|
=head1 NAME |
1120
|
7
|
|
|
|
|
22
|
|
1121
|
|
|
|
|
|
|
Config::Model::Node - Class for configuration tree node |
1122
|
7
|
|
|
|
|
48
|
|
1123
|
|
|
|
|
|
|
=head1 VERSION |
1124
|
|
|
|
|
|
|
|
1125
|
|
|
|
|
|
|
version 2.152 |
1126
|
|
|
|
|
|
|
|
1127
|
|
|
|
|
|
|
=head1 SYNOPSIS |
1128
|
|
|
|
|
|
|
|
1129
|
7
|
|
|
|
|
23
|
use Config::Model; |
1130
|
7
|
|
|
|
|
78
|
|
1131
|
7
|
|
|
|
|
27
|
# define configuration tree object |
1132
|
7
|
|
|
|
|
175
|
my $model = Config::Model->new; |
1133
|
|
|
|
|
|
|
$model->create_config_class( |
1134
|
|
|
|
|
|
|
name => 'OneConfigClass', |
1135
|
1
|
|
|
1
|
1
|
204
|
class_description => "OneConfigClass detailed description", |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
3
|
|
1136
|
1
|
|
|
|
|
4
|
|
1137
|
|
|
|
|
|
|
element => [ |
1138
|
|
|
|
|
|
|
[qw/X Y Z/] => { |
1139
|
|
|
|
|
|
|
type => 'leaf', |
1140
|
|
|
|
|
|
|
value_type => 'enum', |
1141
|
1
|
|
|
70
|
|
20
|
choice => [qw/Av Bv Cv/] |
1142
|
|
|
|
|
|
|
} |
1143
|
|
|
|
|
|
|
], |
1144
|
10
|
|
|
10
|
|
26
|
|
1145
|
|
|
|
|
|
|
status => [ X => 'deprecated' ], |
1146
|
10
|
|
|
|
|
23
|
description => [ X => 'X-ray description (can be long)' ], |
1147
|
10
|
100
|
|
|
|
120
|
summary => [ X => 'X-ray' ], |
1148
|
5
|
|
|
|
|
13
|
|
1149
|
|
|
|
|
|
|
accept => [ |
1150
|
1
|
|
|
|
|
5
|
'ip.*' => { |
1151
|
|
|
|
|
|
|
type => 'leaf', |
1152
|
|
|
|
|
|
|
value_type => 'uniline', |
1153
|
|
|
|
|
|
|
summary => 'ip address', |
1154
|
|
|
|
|
|
|
} |
1155
|
|
|
|
|
|
|
] |
1156
|
|
|
|
|
|
|
); |
1157
|
1
|
|
|
|
|
12
|
my $instance = $model->instance (root_class_name => 'OneConfigClass'); |
1158
|
|
|
|
|
|
|
my $root = $instance->config_root ; |
1159
|
|
|
|
|
|
|
|
1160
|
1
|
|
|
|
|
4
|
# X is not shown below because of its deprecated status |
1161
|
1
|
|
|
|
|
15
|
print $root->describe,"\n" ; |
1162
|
1
|
|
|
|
|
5
|
# name value type comment |
1163
|
1
|
|
|
|
|
53
|
# Y [undef] enum choice: Av Bv Cv |
1164
|
|
|
|
|
|
|
# Z [undef] enum choice: Av Bv Cv |
1165
|
|
|
|
|
|
|
|
1166
|
|
|
|
|
|
|
# add some data |
1167
|
|
|
|
|
|
|
$root->load( steps => 'Y=Av' ); |
1168
|
|
|
|
|
|
|
|
1169
|
|
|
|
|
|
|
# add some accepted element, ipA and ipB are created on the fly |
1170
|
|
|
|
|
|
|
$root->load( steps => q!ipA=192.168.1.0 ipB=192.168.1.1"! ); |
1171
|
|
|
|
|
|
|
|
1172
|
|
|
|
|
|
|
# show also ip* element created in the last "load" call |
1173
|
|
|
|
|
|
|
print $root->describe,"\n" ; |
1174
|
|
|
|
|
|
|
# name value type comment |
1175
|
|
|
|
|
|
|
# Y Av enum choice: Av Bv Cv |
1176
|
|
|
|
|
|
|
# Z [undef] enum choice: Av Bv Cv |
1177
|
|
|
|
|
|
|
# ipA 192.168.1.0 uniline |
1178
|
|
|
|
|
|
|
# ipB 192.168.1.1 uniline |
1179
|
|
|
|
|
|
|
|
1180
|
|
|
|
|
|
|
=head1 DESCRIPTION |
1181
|
|
|
|
|
|
|
|
1182
|
|
|
|
|
|
|
This class provides the nodes of a configuration tree. When created, a |
1183
|
|
|
|
|
|
|
node object gets a set of rules that defines its properties |
1184
|
|
|
|
|
|
|
within the configuration tree. |
1185
|
|
|
|
|
|
|
|
1186
|
|
|
|
|
|
|
Each node contain a set of elements. An element can contain: |
1187
|
|
|
|
|
|
|
|
1188
|
|
|
|
|
|
|
=over |
1189
|
|
|
|
|
|
|
|
1190
|
|
|
|
|
|
|
=item * |
1191
|
|
|
|
|
|
|
|
1192
|
|
|
|
|
|
|
A leaf element implemented with L<Config::Model::Value>. A leaf can be |
1193
|
|
|
|
|
|
|
plain (unconstrained value) or be strongly typed (values are checked |
1194
|
|
|
|
|
|
|
against a set of rules). |
1195
|
|
|
|
|
|
|
|
1196
|
|
|
|
|
|
|
=item * |
1197
|
|
|
|
|
|
|
|
1198
|
|
|
|
|
|
|
Another node. |
1199
|
|
|
|
|
|
|
|
1200
|
|
|
|
|
|
|
=item * |
1201
|
|
|
|
|
|
|
|
1202
|
|
|
|
|
|
|
A collection of items: a list element, implemented with |
1203
|
|
|
|
|
|
|
L<Config::Model::ListId>. Each item can be another node or a leaf. |
1204
|
|
|
|
|
|
|
|
1205
|
|
|
|
|
|
|
=item * |
1206
|
|
|
|
|
|
|
|
1207
|
|
|
|
|
|
|
A collection of identified items: a hash element, implemented with |
1208
|
|
|
|
|
|
|
L<Config::Model::HashId>. Each item can be another node or a leaf. |
1209
|
|
|
|
|
|
|
|
1210
|
|
|
|
|
|
|
=back |
1211
|
|
|
|
|
|
|
|
1212
|
|
|
|
|
|
|
=head1 Configuration class declaration |
1213
|
|
|
|
|
|
|
|
1214
|
|
|
|
|
|
|
A class declaration is made of the following parameters: |
1215
|
|
|
|
|
|
|
|
1216
|
|
|
|
|
|
|
=over |
1217
|
|
|
|
|
|
|
|
1218
|
|
|
|
|
|
|
=item B<name> |
1219
|
|
|
|
|
|
|
|
1220
|
|
|
|
|
|
|
Mandatory C<string> parameter. This config class name can be used by a node |
1221
|
|
|
|
|
|
|
element in another configuration class. |
1222
|
|
|
|
|
|
|
|
1223
|
|
|
|
|
|
|
=item B<class_description> |
1224
|
|
|
|
|
|
|
|
1225
|
|
|
|
|
|
|
Optional C<string> parameter. This description is used while |
1226
|
|
|
|
|
|
|
generating user interfaces. |
1227
|
|
|
|
|
|
|
|
1228
|
|
|
|
|
|
|
=item B<class> |
1229
|
|
|
|
|
|
|
|
1230
|
|
|
|
|
|
|
Optional C<string> to specify a Perl class to override the default |
1231
|
|
|
|
|
|
|
implementation (L<Config::Model::Node>). This Perl Class B<must> |
1232
|
|
|
|
|
|
|
inherit L<Config::Model::Node>. Use with care. |
1233
|
|
|
|
|
|
|
|
1234
|
|
|
|
|
|
|
=item B<element> |
1235
|
|
|
|
|
|
|
|
1236
|
|
|
|
|
|
|
Mandatory C<list ref> of elements of the configuration class : |
1237
|
|
|
|
|
|
|
|
1238
|
|
|
|
|
|
|
element => [ foo => { type = 'leaf', ... }, |
1239
|
|
|
|
|
|
|
bar => { type = 'leaf', ... } |
1240
|
|
|
|
|
|
|
] |
1241
|
|
|
|
|
|
|
|
1242
|
|
|
|
|
|
|
Element names can be grouped to save typing: |
1243
|
|
|
|
|
|
|
|
1244
|
|
|
|
|
|
|
element => [ [qw/foo bar/] => { type = 'leaf', ... } ] |
1245
|
|
|
|
|
|
|
|
1246
|
|
|
|
|
|
|
See below for details on element declaration. |
1247
|
|
|
|
|
|
|
|
1248
|
|
|
|
|
|
|
=item B<gist> |
1249
|
|
|
|
|
|
|
|
1250
|
|
|
|
|
|
|
String used to construct a summary of the content of a node. This |
1251
|
|
|
|
|
|
|
parameter is used by user interface to show users the gist of the |
1252
|
|
|
|
|
|
|
content of this node. This parameter has no other effect. This string |
1253
|
|
|
|
|
|
|
may contain element values in the form "C<{foo} or {bar}>". When |
1254
|
|
|
|
|
|
|
constructing the gist, C<{foo}> is replaced by the value of element |
1255
|
|
|
|
|
|
|
C<foo>. Likewise for C<{bar}>. |
1256
|
|
|
|
|
|
|
|
1257
|
|
|
|
|
|
|
=item B<level> |
1258
|
|
|
|
|
|
|
|
1259
|
|
|
|
|
|
|
Optional C<list ref> of the elements whose level are different from |
1260
|
|
|
|
|
|
|
default value (C<normal>). Possible values are C<important>, C<normal> |
1261
|
|
|
|
|
|
|
or C<hidden>. |
1262
|
|
|
|
|
|
|
|
1263
|
|
|
|
|
|
|
The level is used to set how configuration data is presented to the |
1264
|
|
|
|
|
|
|
user in browsing mode. C<Important> elements are shown to the user |
1265
|
|
|
|
|
|
|
no matter what. C<hidden> elements are explained with the I<warp> |
1266
|
|
|
|
|
|
|
notion. |
1267
|
|
|
|
|
|
|
|
1268
|
|
|
|
|
|
|
level => [ [qw/X Y/] => 'important' ] |
1269
|
|
|
|
|
|
|
|
1270
|
|
|
|
|
|
|
=item B<status> |
1271
|
|
|
|
|
|
|
|
1272
|
|
|
|
|
|
|
Optional C<list ref> of the elements whose status are different from |
1273
|
|
|
|
|
|
|
default value (C<standard>). Possible values are C<obsolete>, |
1274
|
|
|
|
|
|
|
C<deprecated> or C<standard>. |
1275
|
|
|
|
|
|
|
|
1276
|
|
|
|
|
|
|
Using a deprecated element issues a warning. Using an obsolete |
1277
|
|
|
|
|
|
|
element raises an exception (See L<Config::Model::Exception>. |
1278
|
|
|
|
|
|
|
|
1279
|
|
|
|
|
|
|
status => [ [qw/X Y/] => 'obsolete' ] |
1280
|
|
|
|
|
|
|
|
1281
|
|
|
|
|
|
|
=item B<description> |
1282
|
|
|
|
|
|
|
|
1283
|
|
|
|
|
|
|
Optional C<list ref> of element summaries. These summaries may be used |
1284
|
|
|
|
|
|
|
when generating user interfaces. |
1285
|
|
|
|
|
|
|
|
1286
|
|
|
|
|
|
|
=item B<description> |
1287
|
|
|
|
|
|
|
|
1288
|
|
|
|
|
|
|
Optional C<list ref> of element descriptions. These descriptions may be |
1289
|
|
|
|
|
|
|
used when generating user interfaces. |
1290
|
|
|
|
|
|
|
|
1291
|
|
|
|
|
|
|
=item B<rw_config> |
1292
|
|
|
|
|
|
|
|
1293
|
|
|
|
|
|
|
=item B<config_dir> |
1294
|
|
|
|
|
|
|
|
1295
|
|
|
|
|
|
|
Parameters used to load on demand configuration data. |
1296
|
|
|
|
|
|
|
See L<Config::Model::BackendMgr> for details. |
1297
|
|
|
|
|
|
|
|
1298
|
|
|
|
|
|
|
=item B<accept> |
1299
|
|
|
|
|
|
|
|
1300
|
|
|
|
|
|
|
Optional list of criteria (i.e. a regular expression to match ) to |
1301
|
|
|
|
|
|
|
accept unknown elements. Each criteria has a list of |
1302
|
|
|
|
|
|
|
specification that enable C<Config::Model> to create a model |
1303
|
|
|
|
|
|
|
snippet for the unknown element. |
1304
|
|
|
|
|
|
|
|
1305
|
|
|
|
|
|
|
Example: |
1306
|
|
|
|
|
|
|
|
1307
|
|
|
|
|
|
|
accept => [ |
1308
|
|
|
|
|
|
|
'list.*' => { |
1309
|
|
|
|
|
|
|
type => 'list', |
1310
|
|
|
|
|
|
|
cargo => { |
1311
|
|
|
|
|
|
|
type => 'leaf', |
1312
|
|
|
|
|
|
|
value_type => 'string', |
1313
|
|
|
|
|
|
|
}, |
1314
|
|
|
|
|
|
|
}, |
1315
|
|
|
|
|
|
|
'str.*' => { |
1316
|
|
|
|
|
|
|
type => 'leaf', |
1317
|
|
|
|
|
|
|
value_type => 'uniline' |
1318
|
|
|
|
|
|
|
}, |
1319
|
|
|
|
|
|
|
] |
1320
|
|
|
|
|
|
|
|
1321
|
|
|
|
|
|
|
All C<element> parameters can be used in specifying accepted elements. |
1322
|
|
|
|
|
|
|
|
1323
|
|
|
|
|
|
|
If L<Text::Levenshtein::Damerau> is installed, a warning is issued if an accepted |
1324
|
|
|
|
|
|
|
element is too close to an existing element. |
1325
|
|
|
|
|
|
|
|
1326
|
|
|
|
|
|
|
The parameter C<accept_after> to specify where to insert the accepted element. |
1327
|
|
|
|
|
|
|
This does not change much the behavior of the tree, but helps generate |
1328
|
|
|
|
|
|
|
a more usable user interface. |
1329
|
|
|
|
|
|
|
|
1330
|
|
|
|
|
|
|
Example: |
1331
|
|
|
|
|
|
|
|
1332
|
|
|
|
|
|
|
element => [ |
1333
|
|
|
|
|
|
|
'Bug' => { type => 'leaf', value_type => 'uniline' } , |
1334
|
|
|
|
|
|
|
] |
1335
|
|
|
|
|
|
|
accept => [ |
1336
|
|
|
|
|
|
|
'Bug-.*' => { |
1337
|
|
|
|
|
|
|
value_type => 'uniline', |
1338
|
|
|
|
|
|
|
type => 'leaf' |
1339
|
|
|
|
|
|
|
accept_after => 'Bug' , |
1340
|
|
|
|
|
|
|
} |
1341
|
|
|
|
|
|
|
] |
1342
|
|
|
|
|
|
|
|
1343
|
|
|
|
|
|
|
The model snippet above ensures that C<Bug-Debian> is shown right after C<bug>. |
1344
|
|
|
|
|
|
|
|
1345
|
|
|
|
|
|
|
=for html <p>For more information, see <a href="http://ddumont.wordpress.com/2010/05/19/improve-config-upgrade-ep-02-minimal-model-for-opensshs-sshd_config/">this blog</a>.</p> |
1346
|
|
|
|
|
|
|
|
1347
|
|
|
|
|
|
|
=back |
1348
|
|
|
|
|
|
|
|
1349
|
|
|
|
|
|
|
=head1 Element declaration |
1350
|
|
|
|
|
|
|
|
1351
|
|
|
|
|
|
|
=head2 Element type |
1352
|
|
|
|
|
|
|
|
1353
|
|
|
|
|
|
|
Each element is declared with a list ref that contains all necessary |
1354
|
|
|
|
|
|
|
information: |
1355
|
|
|
|
|
|
|
|
1356
|
|
|
|
|
|
|
element => [ |
1357
|
|
|
|
|
|
|
foo => { ... } |
1358
|
|
|
|
|
|
|
] |
1359
|
|
|
|
|
|
|
|
1360
|
|
|
|
|
|
|
This most important information from this hash ref is the mandatory |
1361
|
|
|
|
|
|
|
B<type> parameter. The I<type> type can be: |
1362
|
|
|
|
|
|
|
|
1363
|
|
|
|
|
|
|
=over 8 |
1364
|
|
|
|
|
|
|
|
1365
|
|
|
|
|
|
|
=item C<node> |
1366
|
|
|
|
|
|
|
|
1367
|
|
|
|
|
|
|
The element is a node of a tree instantiated from a |
1368
|
|
|
|
|
|
|
configuration class (declared with |
1369
|
|
|
|
|
|
|
L<Config::Model/"create_config_class( ... )">). |
1370
|
|
|
|
|
|
|
See L</"Node element">. |
1371
|
|
|
|
|
|
|
|
1372
|
|
|
|
|
|
|
=item C<warped_node> |
1373
|
|
|
|
|
|
|
|
1374
|
|
|
|
|
|
|
The element is a node whose properties (mostly C<config_class_name>) |
1375
|
|
|
|
|
|
|
can be changed (warped) according to the values of one or more leaf |
1376
|
|
|
|
|
|
|
elements in the configuration tree. See L<Config::Model::WarpedNode> |
1377
|
|
|
|
|
|
|
for details. |
1378
|
|
|
|
|
|
|
|
1379
|
|
|
|
|
|
|
=item C<leaf> |
1380
|
|
|
|
|
|
|
|
1381
|
|
|
|
|
|
|
The element is a scalar value. See L</"Leaf element"> |
1382
|
|
|
|
|
|
|
|
1383
|
|
|
|
|
|
|
=item C<hash> |
1384
|
|
|
|
|
|
|
|
1385
|
|
|
|
|
|
|
The element is a collection of nodes or values (default). Each |
1386
|
|
|
|
|
|
|
element of this collection is identified by a string (Just like a regular |
1387
|
|
|
|
|
|
|
hash, except that you can set up constraint of the keys). |
1388
|
|
|
|
|
|
|
See L</"Hash element"> |
1389
|
|
|
|
|
|
|
|
1390
|
|
|
|
|
|
|
=item C<list> |
1391
|
|
|
|
|
|
|
|
1392
|
|
|
|
|
|
|
The element is a collection of nodes or values (default). Each element |
1393
|
|
|
|
|
|
|
of this collection is identified by an integer (Just like a regular |
1394
|
|
|
|
|
|
|
perl array, except that you can set up constraint of the keys). See |
1395
|
|
|
|
|
|
|
L</"List element"> |
1396
|
|
|
|
|
|
|
|
1397
|
|
|
|
|
|
|
=item C<check_list> |
1398
|
|
|
|
|
|
|
|
1399
|
|
|
|
|
|
|
The element is a collection of values which are unique in the |
1400
|
|
|
|
|
|
|
check_list. See L<CheckList>. |
1401
|
|
|
|
|
|
|
|
1402
|
|
|
|
|
|
|
=item C<class> |
1403
|
|
|
|
|
|
|
|
1404
|
|
|
|
|
|
|
Override the default class for leaf, list and hash elements. The override |
1405
|
|
|
|
|
|
|
class be inherit L<Config::Model::Value> for leaf element, |
1406
|
|
|
|
|
|
|
L<Config::Model::HashId> for hash element and |
1407
|
|
|
|
|
|
|
L<Config::Model::ListId> for list element. |
1408
|
|
|
|
|
|
|
|
1409
|
|
|
|
|
|
|
=back |
1410
|
|
|
|
|
|
|
|
1411
|
|
|
|
|
|
|
=head2 Node element |
1412
|
|
|
|
|
|
|
|
1413
|
|
|
|
|
|
|
When declaring a C<node> element, you must also provide a |
1414
|
|
|
|
|
|
|
C<config_class_name> parameter. For instance: |
1415
|
|
|
|
|
|
|
|
1416
|
|
|
|
|
|
|
$model ->create_config_class |
1417
|
|
|
|
|
|
|
( |
1418
|
|
|
|
|
|
|
name => "ClassWithOneNode", |
1419
|
|
|
|
|
|
|
element => [ |
1420
|
|
|
|
|
|
|
the_node => { |
1421
|
|
|
|
|
|
|
type => 'node', |
1422
|
|
|
|
|
|
|
config_class_name => 'AnotherClass', |
1423
|
|
|
|
|
|
|
}, |
1424
|
|
|
|
|
|
|
] |
1425
|
|
|
|
|
|
|
) ; |
1426
|
|
|
|
|
|
|
|
1427
|
|
|
|
|
|
|
=head2 Leaf element |
1428
|
|
|
|
|
|
|
|
1429
|
|
|
|
|
|
|
When declaring a C<leaf> element, you must also provide a |
1430
|
|
|
|
|
|
|
C<value_type> parameter. See L<Config::Model::Value> for more details. |
1431
|
|
|
|
|
|
|
|
1432
|
|
|
|
|
|
|
=head2 Hash element |
1433
|
|
|
|
|
|
|
|
1434
|
|
|
|
|
|
|
When declaring a C<hash> element, you must also provide a |
1435
|
|
|
|
|
|
|
C<index_type> parameter. |
1436
|
|
|
|
|
|
|
|
1437
|
|
|
|
|
|
|
You can also provide a C<cargo_type> parameter set to C<node> or |
1438
|
|
|
|
|
|
|
C<leaf> (default). |
1439
|
|
|
|
|
|
|
|
1440
|
|
|
|
|
|
|
See L<Config::Model::HashId> and L<Config::Model::AnyId> for more |
1441
|
|
|
|
|
|
|
details. |
1442
|
|
|
|
|
|
|
|
1443
|
|
|
|
|
|
|
=head2 List element |
1444
|
|
|
|
|
|
|
|
1445
|
|
|
|
|
|
|
You can also provide a C<cargo_type> parameter set to C<node> or |
1446
|
|
|
|
|
|
|
C<leaf> (default). |
1447
|
|
|
|
|
|
|
|
1448
|
|
|
|
|
|
|
See L<Config::Model::ListId> and L<Config::Model::AnyId> for more |
1449
|
|
|
|
|
|
|
details. |
1450
|
|
|
|
|
|
|
|
1451
|
|
|
|
|
|
|
=head1 Constructor |
1452
|
|
|
|
|
|
|
|
1453
|
|
|
|
|
|
|
The C<new> constructor accepts the following parameters: |
1454
|
|
|
|
|
|
|
|
1455
|
|
|
|
|
|
|
=over |
1456
|
|
|
|
|
|
|
|
1457
|
|
|
|
|
|
|
=item config_file |
1458
|
|
|
|
|
|
|
|
1459
|
|
|
|
|
|
|
Specify configuration file to be used by backend. This parameter may |
1460
|
|
|
|
|
|
|
override a file declared in the model. Note that this parameter is not |
1461
|
|
|
|
|
|
|
propagated in children nodes. |
1462
|
|
|
|
|
|
|
|
1463
|
|
|
|
|
|
|
=back |
1464
|
|
|
|
|
|
|
|
1465
|
|
|
|
|
|
|
=head1 Introspection methods |
1466
|
|
|
|
|
|
|
|
1467
|
|
|
|
|
|
|
=head2 name |
1468
|
|
|
|
|
|
|
|
1469
|
|
|
|
|
|
|
Returns the location of the node, or its config class name (for root |
1470
|
|
|
|
|
|
|
node). |
1471
|
|
|
|
|
|
|
|
1472
|
|
|
|
|
|
|
=head2 get_type |
1473
|
|
|
|
|
|
|
|
1474
|
|
|
|
|
|
|
Returns C<node>. |
1475
|
|
|
|
|
|
|
|
1476
|
|
|
|
|
|
|
=head2 config_model |
1477
|
|
|
|
|
|
|
|
1478
|
|
|
|
|
|
|
Returns the B<entire> configuration model (L<Config::Model> object). |
1479
|
|
|
|
|
|
|
|
1480
|
|
|
|
|
|
|
=head2 model |
1481
|
|
|
|
|
|
|
|
1482
|
|
|
|
|
|
|
Returns the configuration model of this node (data structure). |
1483
|
|
|
|
|
|
|
|
1484
|
|
|
|
|
|
|
=head2 config_class_name |
1485
|
|
|
|
|
|
|
|
1486
|
|
|
|
|
|
|
Returns the configuration class name of this node. |
1487
|
|
|
|
|
|
|
|
1488
|
|
|
|
|
|
|
=head2 instance |
1489
|
|
|
|
|
|
|
|
1490
|
|
|
|
|
|
|
Returns the instance object containing this node. Inherited from |
1491
|
|
|
|
|
|
|
L<Config::Model::AnyThing> |
1492
|
|
|
|
|
|
|
|
1493
|
|
|
|
|
|
|
=head2 has_element |
1494
|
|
|
|
|
|
|
|
1495
|
|
|
|
|
|
|
Arguments: C<< ( name => element_name, [ type => searched_type ], [ autoadd => 1 ] ) >> |
1496
|
|
|
|
|
|
|
|
1497
|
|
|
|
|
|
|
Returns 1 if the class model has the element declared. |
1498
|
|
|
|
|
|
|
|
1499
|
|
|
|
|
|
|
Returns 1 as well if C<autoadd> is 1 (i.e. by default) and the element |
1500
|
|
|
|
|
|
|
name is matched by the optional C<accept> model parameter. |
1501
|
|
|
|
|
|
|
|
1502
|
|
|
|
|
|
|
If C<type> is specified, the element name must also match the type. |
1503
|
|
|
|
|
|
|
|
1504
|
|
|
|
|
|
|
=head2 find_element |
1505
|
|
|
|
|
|
|
|
1506
|
|
|
|
|
|
|
Parameters: C<< ( element_name , [ case => any ]) >> |
1507
|
|
|
|
|
|
|
|
1508
|
|
|
|
|
|
|
Returns C<$name> if the class model has the element declared or if the element |
1509
|
|
|
|
|
|
|
name is matched by the optional C<accept> parameter. |
1510
|
|
|
|
|
|
|
|
1511
|
|
|
|
|
|
|
If C<case> is set to any, C<has_element> returns the element name who match the passed |
1512
|
|
|
|
|
|
|
name in a case-insensitive manner. |
1513
|
|
|
|
|
|
|
|
1514
|
|
|
|
|
|
|
Returns empty if no matching element is found. |
1515
|
|
|
|
|
|
|
|
1516
|
|
|
|
|
|
|
=head2 model_searcher |
1517
|
|
|
|
|
|
|
|
1518
|
|
|
|
|
|
|
Returns an object dedicated to search an element in the configuration |
1519
|
|
|
|
|
|
|
model. |
1520
|
|
|
|
|
|
|
|
1521
|
|
|
|
|
|
|
This method returns a L<Config::Model::SearchElement> object. See |
1522
|
|
|
|
|
|
|
L<Config::Model::SearchElement> for details on how to handle a search. |
1523
|
|
|
|
|
|
|
|
1524
|
|
|
|
|
|
|
This method is inherited from L<Config::Model::AnyThing>. |
1525
|
|
|
|
|
|
|
|
1526
|
|
|
|
|
|
|
=head2 element_model |
1527
|
|
|
|
|
|
|
|
1528
|
|
|
|
|
|
|
Parameters: C<< ( element_name ) >> |
1529
|
|
|
|
|
|
|
|
1530
|
|
|
|
|
|
|
Returns model of the element. |
1531
|
|
|
|
|
|
|
|
1532
|
|
|
|
|
|
|
=head2 element_type |
1533
|
|
|
|
|
|
|
|
1534
|
|
|
|
|
|
|
Parameters: C<< ( element_name ) >> |
1535
|
|
|
|
|
|
|
|
1536
|
|
|
|
|
|
|
Returns the type (e.g. leaf, hash, list, checklist or node) of the |
1537
|
|
|
|
|
|
|
element. Also returns the type of a potentially accepted element. |
1538
|
|
|
|
|
|
|
Dies if the element is not known or cannot be accepted. |
1539
|
|
|
|
|
|
|
|
1540
|
|
|
|
|
|
|
=head2 element_name |
1541
|
|
|
|
|
|
|
|
1542
|
|
|
|
|
|
|
Returns the element name that contain this object. Inherited from |
1543
|
|
|
|
|
|
|
L<Config::Model::AnyThing> |
1544
|
|
|
|
|
|
|
|
1545
|
|
|
|
|
|
|
=head2 index_value |
1546
|
|
|
|
|
|
|
|
1547
|
|
|
|
|
|
|
See L<Config::Model::AnyThing/"index_value()"> |
1548
|
|
|
|
|
|
|
|
1549
|
|
|
|
|
|
|
=head2 parent |
1550
|
|
|
|
|
|
|
|
1551
|
|
|
|
|
|
|
See L<Config::Model::AnyThing/"parent"> |
1552
|
|
|
|
|
|
|
|
1553
|
|
|
|
|
|
|
=head2 root |
1554
|
|
|
|
|
|
|
|
1555
|
|
|
|
|
|
|
See L<Config::Model::AnyThing/"root"> |
1556
|
|
|
|
|
|
|
|
1557
|
|
|
|
|
|
|
=head2 location |
1558
|
|
|
|
|
|
|
|
1559
|
|
|
|
|
|
|
See L<Config::Model::AnyThing/"location"> |
1560
|
|
|
|
|
|
|
|
1561
|
|
|
|
|
|
|
=head2 backend_support_annotation |
1562
|
|
|
|
|
|
|
|
1563
|
|
|
|
|
|
|
Returns 1 if at least one of the backends attached to self or a parent |
1564
|
|
|
|
|
|
|
node support to read and write annotations (aka comments) in the |
1565
|
|
|
|
|
|
|
configuration file. |
1566
|
|
|
|
|
|
|
|
1567
|
|
|
|
|
|
|
=head1 Element property management |
1568
|
|
|
|
|
|
|
|
1569
|
|
|
|
|
|
|
=head2 get_element_names |
1570
|
|
|
|
|
|
|
|
1571
|
|
|
|
|
|
|
Return all available element names, including the element that were accepted. |
1572
|
|
|
|
|
|
|
|
1573
|
|
|
|
|
|
|
Optional parameters are: |
1574
|
|
|
|
|
|
|
|
1575
|
|
|
|
|
|
|
=over |
1576
|
|
|
|
|
|
|
|
1577
|
|
|
|
|
|
|
=item * |
1578
|
|
|
|
|
|
|
|
1579
|
|
|
|
|
|
|
B<all>: Boolean. When set return all element names, even the hidden |
1580
|
|
|
|
|
|
|
ones and does not trigger warp mechanism. Defaults to 0. This option |
1581
|
|
|
|
|
|
|
should be set to 1 when this method is needed to read configuration data from a |
1582
|
|
|
|
|
|
|
backend. |
1583
|
|
|
|
|
|
|
|
1584
|
|
|
|
|
|
|
=item * |
1585
|
|
|
|
|
|
|
|
1586
|
|
|
|
|
|
|
B<type>: Returns only element of requested type (e.g. C<list>, |
1587
|
|
|
|
|
|
|
C<hash>, C<leaf>,...). By default return elements of any type. |
1588
|
|
|
|
|
|
|
|
1589
|
|
|
|
|
|
|
=item * |
1590
|
|
|
|
|
|
|
|
1591
|
|
|
|
|
|
|
B<cargo_type>: Returns only hash or list elements that contain |
1592
|
|
|
|
|
|
|
the requested cargo type. |
1593
|
|
|
|
|
|
|
E.g. if C<get_element_names> is called with C<< cargo_type => 'leaf' >>, |
1594
|
|
|
|
|
|
|
then C<get_element_names> returns hash |
1595
|
|
|
|
|
|
|
or list elements that contain a L<leaf|Config::Model::Value> object. |
1596
|
|
|
|
|
|
|
|
1597
|
|
|
|
|
|
|
=item * |
1598
|
|
|
|
|
|
|
|
1599
|
|
|
|
|
|
|
B<check>: C<yes>, C<no> or C<skip> |
1600
|
|
|
|
|
|
|
|
1601
|
|
|
|
|
|
|
=back |
1602
|
|
|
|
|
|
|
|
1603
|
|
|
|
|
|
|
C<type> and C<cargo_type> parameters can be specified together. In |
1604
|
|
|
|
|
|
|
this case, this method returns parameters that satisfy B<both> |
1605
|
|
|
|
|
|
|
conditions. I.e. with C<< type =>'hash', cargo_type => 'leaf' >>, this |
1606
|
|
|
|
|
|
|
method returns only hash elements that contain leaf objects. |
1607
|
|
|
|
|
|
|
|
1608
|
|
|
|
|
|
|
Returns a list in array context, and a string |
1609
|
|
|
|
|
|
|
(e.g. C<join(' ',@array)>) in scalar context. |
1610
|
|
|
|
|
|
|
|
1611
|
|
|
|
|
|
|
=head2 children |
1612
|
|
|
|
|
|
|
|
1613
|
|
|
|
|
|
|
Like C<get_element_names> without parameters. Returns the list of elements. This method is |
1614
|
|
|
|
|
|
|
polymorphic for all non-leaf objects of the configuration tree. |
1615
|
|
|
|
|
|
|
|
1616
|
|
|
|
|
|
|
=head2 next_element |
1617
|
|
|
|
|
|
|
|
1618
|
|
|
|
|
|
|
This method provides a way to iterate through the elements of a node. |
1619
|
|
|
|
|
|
|
Mandatory parameter is C<name>. Optional parameter: C<status>. |
1620
|
|
|
|
|
|
|
|
1621
|
|
|
|
|
|
|
Returns the next element name for status (default C<normal>). |
1622
|
|
|
|
|
|
|
Returns undef if no next element is available. |
1623
|
|
|
|
|
|
|
|
1624
|
|
|
|
|
|
|
=head2 previous_element |
1625
|
|
|
|
|
|
|
|
1626
|
|
|
|
|
|
|
Parameters: C<< ( name => element_name ) >> |
1627
|
|
|
|
|
|
|
|
1628
|
|
|
|
|
|
|
This method provides a way to iterate through the elements of a node. |
1629
|
|
|
|
|
|
|
|
1630
|
|
|
|
|
|
|
Returns the previous element name. Returns undef if no previous element is available. |
1631
|
|
|
|
|
|
|
|
1632
|
|
|
|
|
|
|
=head2 get_element_property |
1633
|
|
|
|
|
|
|
|
1634
|
|
|
|
|
|
|
Parameters: C<< ( element => ..., property => ... ) >> |
1635
|
|
|
|
|
|
|
|
1636
|
|
|
|
|
|
|
Retrieve a property of an element. |
1637
|
|
|
|
|
|
|
|
1638
|
|
|
|
|
|
|
I.e. for a model : |
1639
|
|
|
|
|
|
|
|
1640
|
|
|
|
|
|
|
status => [ X => 'deprecated' ] |
1641
|
|
|
|
|
|
|
element => [ X => { ... } ] |
1642
|
|
|
|
|
|
|
|
1643
|
|
|
|
|
|
|
This call returns C<deprecated>: |
1644
|
|
|
|
|
|
|
|
1645
|
|
|
|
|
|
|
$node->get_element_property ( element => 'X', property => 'status' ) |
1646
|
|
|
|
|
|
|
|
1647
|
|
|
|
|
|
|
=head2 set_element_property |
1648
|
|
|
|
|
|
|
|
1649
|
|
|
|
|
|
|
Parameters: C<< ( element => ..., property => ... ) >> |
1650
|
|
|
|
|
|
|
|
1651
|
|
|
|
|
|
|
Set a property of an element. |
1652
|
|
|
|
|
|
|
|
1653
|
|
|
|
|
|
|
=head2 reset_element_property |
1654
|
|
|
|
|
|
|
|
1655
|
|
|
|
|
|
|
Parameters: C<< ( element => ... ) >> |
1656
|
|
|
|
|
|
|
|
1657
|
|
|
|
|
|
|
Reset a property of an element according to the original model. |
1658
|
|
|
|
|
|
|
|
1659
|
|
|
|
|
|
|
=head1 Information management |
1660
|
|
|
|
|
|
|
|
1661
|
|
|
|
|
|
|
=head2 fetch_element |
1662
|
|
|
|
|
|
|
|
1663
|
|
|
|
|
|
|
Arguments: C<< ( name => .. , [ check => ..], [ autoadd => 1 ] ) >> |
1664
|
|
|
|
|
|
|
|
1665
|
|
|
|
|
|
|
Fetch and returns an element from a node if the class model has the |
1666
|
|
|
|
|
|
|
element declared. |
1667
|
|
|
|
|
|
|
|
1668
|
|
|
|
|
|
|
Also fetch and returns an element from a node if C<autoadd> is 1 |
1669
|
|
|
|
|
|
|
(i.e. by default) and the element name is matched by the optional |
1670
|
|
|
|
|
|
|
C<accept> model parameter. |
1671
|
|
|
|
|
|
|
|
1672
|
|
|
|
|
|
|
C<check> can be set to C<yes>, C<no> or C<skip>. |
1673
|
|
|
|
|
|
|
When C<check> is C<no> or C<skip>, this method returns C<undef> when the |
1674
|
|
|
|
|
|
|
element is unknown, or 0 if the element is not available (hidden). |
1675
|
|
|
|
|
|
|
|
1676
|
|
|
|
|
|
|
By default, "accepted" elements are automatically created. Set |
1677
|
|
|
|
|
|
|
C<autoadd> to 0 when this behavior is not wanted. |
1678
|
|
|
|
|
|
|
|
1679
|
|
|
|
|
|
|
=head2 fetch_element_value |
1680
|
|
|
|
|
|
|
|
1681
|
|
|
|
|
|
|
Parameters: C<< ( name => ... [ check => ...] ) >> |
1682
|
|
|
|
|
|
|
|
1683
|
|
|
|
|
|
|
Fetch and returns the I<value> of a leaf element from a node. |
1684
|
|
|
|
|
|
|
|
1685
|
|
|
|
|
|
|
=head2 fetch_gist |
1686
|
|
|
|
|
|
|
|
1687
|
|
|
|
|
|
|
Return the gist of the node. See description of C<gist> parameter above. |
1688
|
|
|
|
|
|
|
|
1689
|
|
|
|
|
|
|
=head2 store_element_value |
1690
|
|
|
|
|
|
|
|
1691
|
|
|
|
|
|
|
Parameters: C<< ( name, value ) >> |
1692
|
|
|
|
|
|
|
|
1693
|
|
|
|
|
|
|
Store a I<value> in a leaf element from a node. |
1694
|
|
|
|
|
|
|
|
1695
|
|
|
|
|
|
|
Can be invoked with named parameters (name, value, check). E.g. |
1696
|
|
|
|
|
|
|
|
1697
|
|
|
|
|
|
|
( name => 'foo', value => 'bar', check => 'skip' ) |
1698
|
|
|
|
|
|
|
|
1699
|
|
|
|
|
|
|
=head2 is_element_available |
1700
|
|
|
|
|
|
|
|
1701
|
|
|
|
|
|
|
Parameters: C<< ( name => ..., ) >> |
1702
|
|
|
|
|
|
|
|
1703
|
|
|
|
|
|
|
Returns 1 if the element C<name> is available and if the element is not "hidden". Returns 0 |
1704
|
|
|
|
|
|
|
otherwise. |
1705
|
|
|
|
|
|
|
|
1706
|
|
|
|
|
|
|
As a syntactic sugar, this method can be called with only one parameter: |
1707
|
|
|
|
|
|
|
|
1708
|
|
|
|
|
|
|
is_element_available( 'element_name' ) ; |
1709
|
|
|
|
|
|
|
|
1710
|
|
|
|
|
|
|
=head2 accept_element |
1711
|
|
|
|
|
|
|
|
1712
|
|
|
|
|
|
|
Parameters: C<< ( name ) >> |
1713
|
|
|
|
|
|
|
|
1714
|
|
|
|
|
|
|
Checks and returns the appropriate model of an acceptable element |
1715
|
|
|
|
|
|
|
(i.e. declared as a model C<element> or part of an C<accept> declaration). |
1716
|
|
|
|
|
|
|
Returns undef if the element cannot be accepted. |
1717
|
|
|
|
|
|
|
|
1718
|
|
|
|
|
|
|
=head2 accept_regexp |
1719
|
|
|
|
|
|
|
|
1720
|
|
|
|
|
|
|
Parameters: C<< ( name ) >> |
1721
|
|
|
|
|
|
|
|
1722
|
|
|
|
|
|
|
Returns the list of regular expressions used to check for acceptable parameters. |
1723
|
|
|
|
|
|
|
Useful for diagnostics. |
1724
|
|
|
|
|
|
|
|
1725
|
|
|
|
|
|
|
=head2 element_exists |
1726
|
|
|
|
|
|
|
|
1727
|
|
|
|
|
|
|
Parameters: C<< ( element_name ) >> |
1728
|
|
|
|
|
|
|
|
1729
|
|
|
|
|
|
|
Returns 1 if the element is known in the model. |
1730
|
|
|
|
|
|
|
|
1731
|
|
|
|
|
|
|
=head2 is_element_defined |
1732
|
|
|
|
|
|
|
|
1733
|
|
|
|
|
|
|
Parameters: C<< ( element_name ) >> |
1734
|
|
|
|
|
|
|
|
1735
|
|
|
|
|
|
|
Returns 1 if the element is defined. |
1736
|
|
|
|
|
|
|
|
1737
|
|
|
|
|
|
|
=head2 grab |
1738
|
|
|
|
|
|
|
|
1739
|
|
|
|
|
|
|
See L<Config::Model::Role::Grab/grab">. |
1740
|
|
|
|
|
|
|
|
1741
|
|
|
|
|
|
|
=head2 grab_value |
1742
|
|
|
|
|
|
|
|
1743
|
|
|
|
|
|
|
See L<Config::Model::Role::Grab/grab_value">. |
1744
|
|
|
|
|
|
|
|
1745
|
|
|
|
|
|
|
=head2 grab_root |
1746
|
|
|
|
|
|
|
|
1747
|
|
|
|
|
|
|
See L<Config::Model::Role::Grab/"grab_root">. |
1748
|
|
|
|
|
|
|
|
1749
|
|
|
|
|
|
|
=head2 get |
1750
|
|
|
|
|
|
|
|
1751
|
|
|
|
|
|
|
Parameters: C<< ( path => ..., mode => ... , check => ... , get_obj => 1|0, autoadd => 1|0) >> |
1752
|
|
|
|
|
|
|
|
1753
|
|
|
|
|
|
|
Get a value from a directory like path. If C<get_obj> is 1, C<get> returns a leaf object |
1754
|
|
|
|
|
|
|
instead of returning its value. |
1755
|
|
|
|
|
|
|
|
1756
|
|
|
|
|
|
|
=head2 set |
1757
|
|
|
|
|
|
|
|
1758
|
|
|
|
|
|
|
Parameters: C<< ( path , value) >> |
1759
|
|
|
|
|
|
|
|
1760
|
|
|
|
|
|
|
Set a value from a directory like path. |
1761
|
|
|
|
|
|
|
|
1762
|
|
|
|
|
|
|
=head1 Validation |
1763
|
|
|
|
|
|
|
|
1764
|
|
|
|
|
|
|
=head2 deep_check |
1765
|
|
|
|
|
|
|
|
1766
|
|
|
|
|
|
|
Scan the tree and deep check on all elements that support this. Currently only hash or |
1767
|
|
|
|
|
|
|
list element have this feature. |
1768
|
|
|
|
|
|
|
|
1769
|
|
|
|
|
|
|
=head1 data modification |
1770
|
|
|
|
|
|
|
|
1771
|
|
|
|
|
|
|
=head2 migrate |
1772
|
|
|
|
|
|
|
|
1773
|
|
|
|
|
|
|
Force a read of the configuration and perform all changes regarding |
1774
|
|
|
|
|
|
|
deprecated elements or values. Return 1 if data needs to be saved. |
1775
|
|
|
|
|
|
|
|
1776
|
|
|
|
|
|
|
=head2 apply_fixes |
1777
|
|
|
|
|
|
|
|
1778
|
|
|
|
|
|
|
Scan the tree from this node and apply fixes that are attached to warning specifications. |
1779
|
|
|
|
|
|
|
See C<warn_if_match> or C<warn_unless_match> in L<Config::Model::Value/>. Return C<$self> since v2.151. |
1780
|
|
|
|
|
|
|
|
1781
|
|
|
|
|
|
|
=head2 load |
1782
|
|
|
|
|
|
|
|
1783
|
|
|
|
|
|
|
Parameters: C<< ( steps => string [ ... ]) >> |
1784
|
|
|
|
|
|
|
|
1785
|
|
|
|
|
|
|
Load configuration data from the string into the node and its siblings. |
1786
|
|
|
|
|
|
|
|
1787
|
|
|
|
|
|
|
This string follows the syntax defined in L<Config::Model::Loader>. |
1788
|
|
|
|
|
|
|
See L<Config::Model::Loader/"load"> for details on parameters. |
1789
|
|
|
|
|
|
|
|
1790
|
|
|
|
|
|
|
This method can also be called with a single parameter: |
1791
|
|
|
|
|
|
|
|
1792
|
|
|
|
|
|
|
$node->load("some data:to be=loaded"); |
1793
|
|
|
|
|
|
|
|
1794
|
|
|
|
|
|
|
=head2 load_data |
1795
|
|
|
|
|
|
|
|
1796
|
|
|
|
|
|
|
Parameters: C<< ( data => hash_ref, [ check => $check, ... ]) >> |
1797
|
|
|
|
|
|
|
|
1798
|
|
|
|
|
|
|
Load configuration data with a hash ref. The hash ref key must match |
1799
|
|
|
|
|
|
|
the available elements of the node (or accepted element). The hash ref structure must match |
1800
|
|
|
|
|
|
|
the structure of the configuration model. |
1801
|
|
|
|
|
|
|
|
1802
|
|
|
|
|
|
|
Use C<< check => skip >> to make data loading more tolerant: bad data are discarded. |
1803
|
|
|
|
|
|
|
|
1804
|
|
|
|
|
|
|
C<load_data> can be called with a single hash ref parameter. |
1805
|
|
|
|
|
|
|
|
1806
|
|
|
|
|
|
|
Returns 1 if some data were saved (instead of skipped). |
1807
|
|
|
|
|
|
|
|
1808
|
|
|
|
|
|
|
=head2 needs_save |
1809
|
|
|
|
|
|
|
|
1810
|
|
|
|
|
|
|
return 1 if one of the elements of the node's sub-tree has been modified. |
1811
|
|
|
|
|
|
|
|
1812
|
|
|
|
|
|
|
=head1 Serialization |
1813
|
|
|
|
|
|
|
|
1814
|
|
|
|
|
|
|
=head2 dump_tree |
1815
|
|
|
|
|
|
|
|
1816
|
|
|
|
|
|
|
Dumps the configuration data of the node and its siblings into a |
1817
|
|
|
|
|
|
|
string. See L<Config::Model::Dumper/dump_tree> for parameter details. |
1818
|
|
|
|
|
|
|
|
1819
|
|
|
|
|
|
|
This string follows the syntax defined in |
1820
|
|
|
|
|
|
|
L<Config::Model::Loader>. The string produced by C<dump_tree> can be |
1821
|
|
|
|
|
|
|
passed to C<load>. |
1822
|
|
|
|
|
|
|
|
1823
|
|
|
|
|
|
|
=head2 dump_annotations_as_pod |
1824
|
|
|
|
|
|
|
|
1825
|
|
|
|
|
|
|
Dumps the configuration annotations of the node and its siblings into a |
1826
|
|
|
|
|
|
|
string. See L<Config::Model::Dumper/dump_annotations_as_pod> for parameter details. |
1827
|
|
|
|
|
|
|
|
1828
|
|
|
|
|
|
|
=head2 describe |
1829
|
|
|
|
|
|
|
|
1830
|
|
|
|
|
|
|
Parameters: C<< ( [ element => ... ] ) >> |
1831
|
|
|
|
|
|
|
|
1832
|
|
|
|
|
|
|
Provides a description of the node elements or of one element. |
1833
|
|
|
|
|
|
|
|
1834
|
|
|
|
|
|
|
=head2 report |
1835
|
|
|
|
|
|
|
|
1836
|
|
|
|
|
|
|
Provides a text report on the content of the configuration below this |
1837
|
|
|
|
|
|
|
node. |
1838
|
|
|
|
|
|
|
|
1839
|
|
|
|
|
|
|
=head2 audit |
1840
|
|
|
|
|
|
|
|
1841
|
|
|
|
|
|
|
Provides a text audit on the content of the configuration below this |
1842
|
|
|
|
|
|
|
node. This audit shows only value different from their default |
1843
|
|
|
|
|
|
|
value. |
1844
|
|
|
|
|
|
|
|
1845
|
|
|
|
|
|
|
=head2 copy_from |
1846
|
|
|
|
|
|
|
|
1847
|
|
|
|
|
|
|
Parameters: C<< ( from => another_node_object, [ check => ... ] ) >> |
1848
|
|
|
|
|
|
|
|
1849
|
|
|
|
|
|
|
Copy configuration data from another node into this node and its |
1850
|
|
|
|
|
|
|
siblings. The copy can be made in a I<tolerant> mode where invalid data |
1851
|
|
|
|
|
|
|
is discarded with C<< check => skip >>. This method can be called with |
1852
|
|
|
|
|
|
|
a single argument: C<< copy_from($another_node) >> |
1853
|
|
|
|
|
|
|
|
1854
|
|
|
|
|
|
|
=head1 Help management |
1855
|
|
|
|
|
|
|
|
1856
|
|
|
|
|
|
|
=head2 get_help |
1857
|
|
|
|
|
|
|
|
1858
|
|
|
|
|
|
|
Parameters: C<< ( [ [ description | summary ] => element_name ] ) >> |
1859
|
|
|
|
|
|
|
|
1860
|
|
|
|
|
|
|
If called without element, returns the description of the class |
1861
|
|
|
|
|
|
|
(Stored in C<class_description> attribute of a node declaration). |
1862
|
|
|
|
|
|
|
|
1863
|
|
|
|
|
|
|
If called with an element name, returns the description of the |
1864
|
|
|
|
|
|
|
element (Stored in C<description> attribute of a node declaration). |
1865
|
|
|
|
|
|
|
|
1866
|
|
|
|
|
|
|
If called with 2 argument, either return the C<summary> or the |
1867
|
|
|
|
|
|
|
C<description> of the element. |
1868
|
|
|
|
|
|
|
|
1869
|
|
|
|
|
|
|
Returns an empty string if no description was found. |
1870
|
|
|
|
|
|
|
|
1871
|
|
|
|
|
|
|
=head2 get_info |
1872
|
|
|
|
|
|
|
|
1873
|
|
|
|
|
|
|
Returns a list of information related to the node. See |
1874
|
|
|
|
|
|
|
L<Config::Model::Value/get_info> for more details. |
1875
|
|
|
|
|
|
|
|
1876
|
|
|
|
|
|
|
=head2 tree_searcher |
1877
|
|
|
|
|
|
|
|
1878
|
|
|
|
|
|
|
Parameters: C<< ( type => ... ) >> |
1879
|
|
|
|
|
|
|
|
1880
|
|
|
|
|
|
|
Returns an object able to search the configuration tree. |
1881
|
|
|
|
|
|
|
Parameters are : |
1882
|
|
|
|
|
|
|
|
1883
|
|
|
|
|
|
|
=over |
1884
|
|
|
|
|
|
|
|
1885
|
|
|
|
|
|
|
=item type |
1886
|
|
|
|
|
|
|
|
1887
|
|
|
|
|
|
|
Where to perform the search. It can be C<element>, C<value>, |
1888
|
|
|
|
|
|
|
C<key>, C<summary>, C<description>, C<help> or C<all>. |
1889
|
|
|
|
|
|
|
|
1890
|
|
|
|
|
|
|
=back |
1891
|
|
|
|
|
|
|
|
1892
|
|
|
|
|
|
|
Then, C<search> method must then be called on the object returned |
1893
|
|
|
|
|
|
|
by C<tree_searcher>. |
1894
|
|
|
|
|
|
|
|
1895
|
|
|
|
|
|
|
Returns a L<Config::Model::TreeSearcher> object. |
1896
|
|
|
|
|
|
|
|
1897
|
|
|
|
|
|
|
=head2 Lazy load of node data |
1898
|
|
|
|
|
|
|
|
1899
|
|
|
|
|
|
|
As configuration model are getting bigger, the load time of a tree |
1900
|
|
|
|
|
|
|
gets longer. The L<Config::Model::BackendMgr> class provides a way to |
1901
|
|
|
|
|
|
|
load the configuration information only when needed. |
1902
|
|
|
|
|
|
|
|
1903
|
|
|
|
|
|
|
=head1 AUTHOR |
1904
|
|
|
|
|
|
|
|
1905
|
|
|
|
|
|
|
Dominique Dumont, (ddumont at cpan dot org) |
1906
|
|
|
|
|
|
|
|
1907
|
|
|
|
|
|
|
=head1 SEE ALSO |
1908
|
|
|
|
|
|
|
|
1909
|
|
|
|
|
|
|
L<Config::Model>, |
1910
|
|
|
|
|
|
|
L<Config::Model::Instance>, |
1911
|
|
|
|
|
|
|
L<Config::Model::HashId>, |
1912
|
|
|
|
|
|
|
L<Config::Model::ListId>, |
1913
|
|
|
|
|
|
|
L<Config::Model::CheckList>, |
1914
|
|
|
|
|
|
|
L<Config::Model::WarpedNode>, |
1915
|
|
|
|
|
|
|
L<Config::Model::Value> |
1916
|
|
|
|
|
|
|
|
1917
|
|
|
|
|
|
|
=head1 AUTHOR |
1918
|
|
|
|
|
|
|
|
1919
|
|
|
|
|
|
|
Dominique Dumont |
1920
|
|
|
|
|
|
|
|
1921
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
1922
|
|
|
|
|
|
|
|
1923
|
|
|
|
|
|
|
This software is Copyright (c) 2005-2022 by Dominique Dumont. |
1924
|
|
|
|
|
|
|
|
1925
|
|
|
|
|
|
|
This is free software, licensed under: |
1926
|
|
|
|
|
|
|
|
1927
|
|
|
|
|
|
|
The GNU Lesser General Public License, Version 2.1, February 1999 |
1928
|
|
|
|
|
|
|
|
1929
|
|
|
|
|
|
|
=cut |