File Coverage

blib/lib/Config/Model/Node.pm
Criterion Covered Total %
statement 556 605 91.9
branch 145 208 69.7
condition 83 136 61.0
subroutine 76 81 93.8
pod 39 54 72.2
total 899 1084 82.9


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