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   355 with "Config::Model::Role::NodeLoader";
  59         114  
  59         348  
13              
14             use Carp;
15 59     59   19568 use 5.020;
  59         114  
  59         3087  
16 59     59   1050  
  59         186  
17             use Config::Model::TypeConstraints;
18 59     59   335 use Config::Model::Instance;
  59         123  
  59         1420  
19 59     59   330 use Config::Model::Exception;
  59         111  
  59         1603  
20 59     59   310 use Config::Model::Loader;
  59         121  
  59         1292  
21 59     59   27839 use Config::Model::Dumper;
  59         194  
  59         1992  
22 59     59   25847 use Config::Model::DumpAsData;
  59         196  
  59         2193  
23 59     59   26080 use Config::Model::Report;
  59         181  
  59         1817  
24 59     59   21465 use Config::Model::TreeSearcher;
  59         176  
  59         1788  
25 59     59   22591 use Config::Model::Describe;
  59         185  
  59         1827  
26 59     59   25220 use Config::Model::BackendMgr;
  59         194  
  59         2010  
27 59     59   25210 use Log::Log4perl qw(get_logger :levels);
  59         181  
  59         2084  
28 59     59   402 use Storable qw/dclone/;
  59         114  
  59         256  
29 59     59   6080 use List::MoreUtils qw(insert_after_string);
  59         119  
  59         2331  
30 59     59   315  
  59         105  
  59         427  
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   35895 no warnings qw/experimental::signatures experimental::postderef/;
  59         124  
  59         5419  
41 59     59   348  
  59         130  
  59         440291  
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 10 $gist =~ s!{([\w -]+)}!$self->grab($1)->fetch // ''!ge;
94 4   50     19 return $gist;
95 4   50     82 }
  8         36  
96 4         31  
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   1308  
120 764         5682 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       124  
    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 1511 $logger->debug("New $class_name requested by $caller_class");
150              
151 764 100       3588 $self->{original_model} = $self->config_model->model($class_name);
152             $self->model( dclone($self->{original_model}) ) ;
153 764         1837  
154 764         2964 $self->check_properties;
155              
156 764         8052 return $self;
157 764         44988 }
158              
159 764         2686 ## Create_* methods are all internal and should not be used directly
160              
161 764         8800 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 4428  
  3670         5035  
  3670         6098  
  3670         4143  
167 3670         9543 if ( not defined $element_info ) {
168 3670         6683 if ( $check eq 'yes' ) {
169 3670   50     7786 Config::Model::Exception::UnknownElement->throw(
170             object => $self,
171 3670         7219 where => $self->location || 'configuration root',
172             element => $element_name,
173 3670 100       6750 );
174 2 100       7 }
175 1   50     16 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       7782 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       7561 join(' ', sort keys %create_sub_for)
195             unless defined $method;
196 3668         8146  
197             return $self->$method( $element_name, $check );
198             }
199 3668 50       6418  
200             my ( $self, $element_name, $check ) = @_;
201              
202             my $element_info = dclone( $self->{model}{element}{$element_name} );
203 3668         7368 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 481 object => $self
208             ) unless defined $element_info->{config_class_name};
209 183         4088  
210 183         508 my @args = (
211             config_class_name => $config_class_name,
212             instance => $self->{instance},
213             element_name => $element_name,
214             parent => $self,
215 183 50       472 container => $self,
216             );
217              
218             return $self->{element}{$element_name} = $self->load_node(@args);
219             }
220 183         683  
221             my ( $self, $element_name, $check ) = @_;
222              
223             my $element_info = dclone( $self->{model}{element}{$element_name} );
224              
225 183         783 my @args = (
226             instance => $self->{instance},
227             element_name => $element_name,
228             parent => $self,
229 126     126 0 366 check => $check,
230             container => $self,
231 126         5314 );
232              
233             require Config::Model::WarpedNode;
234              
235 126         747 return $self->{element}{$element_name} =
236             Config::Model::WarpedNode->new( %$element_info, @args );
237             }
238              
239             my ( $self, $element_name, $check ) = @_;
240              
241 126         12301 my $element_info = dclone( $self->{model}{element}{$element_name} );
242              
243 126         1339 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 5448 $file =~ s!::!/!g;
249             require $file;
250 2791         71585 }
251              
252 2791         7292 $element_info->{container} = $element_info->{parent} = $self;
253 2791   100     9591 $element_info->{element_name} = $element_name;
254             $element_info->{instance} = $self->{instance};
255 2791 100       3638  
  2791         13775  
256 1         4 return $self->{element}{$element_name} = $leaf_class->new(%$element_info);
257 1         7 }
258 1         488  
259             my %id_class_hash = (
260             hash => 'HashId',
261 2791         5989 list => 'ListId',
262 2791         5003 check_list => 'CheckList',
263 2791         4837 );
264              
265 2791         23068 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 1359 croak "Undefined id_class for type '$type'"
276             unless defined $id_class_hash{$type};
277 568         19363  
278 568         1819 my $id_class = delete $element_info->{class}
279             || 'Config::Model::' . $id_class_hash{$type};
280 568 50       1519  
281             if ( not defined *{ $id_class . '::' } ) {
282             my $file = $id_class . '.pm';
283             $file =~ s!::!/!g;
284             require $file;
285             }
286 568 50       1661  
287             $element_info->{container} = $element_info->{parent} = $self;
288             $element_info->{element_name} = $element_name;
289 568   66     2814 $element_info->{instance} = $self->{instance};
290              
291 568 100       901 return $self->{element}{$element_name} = $id_class->new(%$element_info);
  568         3339  
292 81         220 }
293 81         585  
294 81         45638 # check validity of level and status declaration.
295             my $self = shift;
296              
297 568         1751 # a model should no longer contain attributes attached to
298 568         1152 # an element (like description, level ...). There are copied here
299 568         1238 # because Node needs them as hash or lists
300             foreach my $bad (qw/description summary level status/) {
301 568         5559 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 1324 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         1595 if defined $info_to_move;
312             }
313              
314 3056 50       6150 foreach my $prop ( keys %legal_properties ) {
315             my $prop_v
316             = delete $self->{model}{element}{$elt_name}{$prop}
317 764         1303 // get_default_property($prop) ;
  764         2064  
318             $self->{$prop}{$elt_name} = $prop_v;
319 4215         5353  
320 8430         11776 croak "Config class $self->{config_class_name} error: ",
321 8430 100       13939 "Unknown $prop: '$prop_v'. Expected ", join( " or ", keys %{ $self->{$prop} } )
322             unless defined $legal_properties{$prop}{$prop_v};
323             }
324             }
325 4215         6976 return;
326             }
327 8430   66     19507  
328             return if $self->{initialized};
329 8430         13628 $self->{initialized} = 1; # avoid recursions
330              
331             my $model = $self->{model};
332 0         0  
333 8430 50       16211 return unless defined $model->{rw_config};
334              
335             my $initial_load_backup = $self->instance->initial_load;
336 764         1244 $self->instance->initial_load_start;
337              
338             $self->{backend_mgr} ||= Config::Model::BackendMgr->new(
339 22507     22507 0 31402 # config_dir spec given by application info
  22507         24491  
  22507         25264  
  22507         24492  
340 22507 100       45718 config_dir => $self->instance->config_dir,
341 722         1310 node => $self,
342             rw_config => $model->{rw_config}
343 722         1151 );
344              
345 722 100       1925 $self->read_config_data( check => $self->read_check );
346             # setup auto_write
347 93         379 $self->backend_mgr->auto_write_init();
348 93         494  
349             $self->instance->initial_load($initial_load_backup);
350             return;
351             }
352              
353             my ( $self, %args ) = @_;
354              
355 93   33     2614 my $model = $self->{model};
356              
357 93         453 if ( $self->location and $args{config_file} ) {
358             die "read_config_data: cannot override config_file in non root node (",
359 93         522 $self->location, ")\n";
360             }
361 93         799  
362 93         823 # 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 1677 config_file => $args{config_file} || $self->{config_file},
367             auto_create => $args{auto_create} || $self->instance->auto_create,
368 99         231 );
369             }
370 99 50 66     618  
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     1112  
      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 22  
  18         23  
  18         28  
  18         24  
406 18 100       88 # always true. this method is required so that WarpedNode and Node
407 1         8 # have a similar API.
408             return 1;
409             }
410              
411 20758     20758 1 29228 # should I autovivify this element: NO
412 20758   66     102741 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 1731  
417             if ( not defined $name ) {
418             Config::Model::Exception::Internal->throw(
419             object => $self,
420 705     705 0 1224 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 5461 # should I autovivify this element: NO
  4042         4946  
  4042         7084  
  4042         4532  
431 4042         10084 my ( $self, $name, %args ) = @_;
432 4042         7646 croak "find_element: missing element name" unless defined $name;
433 4042         5969  
434 4042   100     9385 # should be the case if people are using cme edit
435             return $name if defined $self->{model}{element}{$name};
436 4042 50       7352  
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       12918  
444 4042 100       9150 # now look if the element can be accepted
445 3818 100       14885 $self->accept_element($name);
446 2 100       15 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 20047 my $type = $args{type}; # optional
477 12462 50       20355 my $cargo_type = $args{cargo_type}; # optional
478              
479 12462   66     30448 $self->init();
480              
481 12462 50 0     20309 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         33408 return wantarray ? @res : "@res";
489             }
490              
491             # this is a bit convoluted, but the order of the returned element
492 1463     1463 0 6231 # 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 2208  
  1495         1889  
  1495         2543  
  1495         2169  
496 1495 50       3346 # 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         2217  
501 1495         2135 next if $self->{level}{$elt} eq 'hidden';
502              
503 1495         3485 my $status = $self->{status}{$elt} || get_default_property('status');
504             next if ( $status eq 'deprecated' or $status eq 'obsolete' );
505 1495         1972  
506             my $elt_type = $self->{element}{$elt}->get_type;
507 1495         2763 my $elt_cargo = $self->{element}{$elt}->get_cargo_type;
508 1495         2019 if ( ( not defined $type or $type eq $elt_type )
  1495         5319  
509             and ( not defined $cargo_type or $cargo_type eq $elt_cargo ) ) {
510 1495 100       3506 push @result, $elt;
511 21         56 }
  42         108  
512 21 50       97 }
513              
514             $logger->trace("got @result");
515              
516             return wantarray ? @result : join( ' ', @result );
517             }
518 1474         2644  
519             my $self = shift;
520             return $self->get_element_names;
521             }
522              
523 8610 100 100     22565 my $element = $args{name};
524              
525 8610 100       19587 my @elements = @{ $self->{model}{element_list} };
526             @elements = reverse @elements if $args{reverse};
527 8517   33     15436  
528 8517 100 100     20332 # if element is empty, start from first element
529             my $found_elt = ( defined $element and $element ) ? 0 : 1;
530 8461         19702  
531 8461         17085 while ( my $name = shift @elements ) {
532 8461 100 33     23776 if ($found_elt) {
      100        
      66        
533             return $name
534 8335         14756 if $self->is_element_available(
535             name => $name,
536             status => $args{status} );
537             }
538 1474         7715 $found_elt = 1 if defined $element and $element eq $name;
539             }
540 1474 50       16592  
541             croak "next_element: element $element is unknown. Expected @elements"
542             unless $found_elt;
543             return;
544 2     2 1 5 }
545 2         8  
546             return $self->next_element( @args, reverse => 1 );
547             }
548 239     239 1 1381  
  239         284  
  239         492  
  239         309  
549 239         306 my ( $prop, $elt ) = $self->check_property_args( 'get_element_property', %args );
550              
551 239         260 return $self->{$prop}{$elt} || get_default_property($prop);
  239         603  
552 239 100       443 }
553              
554             my ( $prop, $elt ) = $self->check_property_args( 'set_element_property', %args );
555 239 100 100     611  
556             my $new_value = $args{value}
557 239         473 || croak "set_element_property:: missing 'value' parameter";
558 1046 100       1373  
559             $logger->debug( "Node ", $self->name, ": set $elt property $prop to $new_value" );
560              
561             return $self->{$prop}{$elt} = $new_value;
562 206 100       431 }
563              
564 843 100 66     2262 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       64 class => $self->{config_class_name},
568             %args
569 36         75 );
570              
571             $logger->debug( "Node ", $self->name, ": reset $elt property $prop to $original_value" );
572 3     3 1 7  
  3         6  
  3         6  
  3         4  
573 3         8 return $self->{$prop}{$elt} = $original_value;
574             }
575              
576 30785     30785 1 32707 # internal: called by the property methods to check their arguments
  30785         32384  
  30785         52739  
  30785         33172  
577 30785         60586 my $elt = $args{element}
578             || croak "$method_name: missing 'element' parameter";
579 30785   33     81530 my $prop = $args{property}
580             || croak "$method_name: missing 'property' parameter";
581              
582 242     242 1 365 my $prop_values = $legal_properties{$prop};
  242         346  
  242         608  
  242         318  
583 242         729 confess "Unknown property in $method_name: $prop, expected status or ", "level"
584             unless defined $prop_values;
585              
586 242   33     679 return ( $prop, $elt );
587             }
588 242         561  
589             my %args = _resolve_arg_shortcut(\@args, 'name');
590 242         2065 my $element_name = $args{name};
591              
592             Config::Model::Exception::Internal->throw( error => "fetch_element: missing name" )
593 718     718 1 1284 unless defined $element_name;
  718         1063  
  718         1599  
  718         996  
594 718         2148  
595             my $check = $self->_check_check( $args{check} );
596             my $accept_hidden = $args{accept_hidden} || 0;
597             my $autoadd = $args{autoadd} // 1;
598 718         4101  
599             $self->init();
600              
601 718         2770 my $model = $self->{model};
602              
603 718         6989 # 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 36313 $self->accept_element($element_name) if $autoadd;
  31745         34260  
  31745         34221  
  31745         43766  
  31745         31637  
608             $self->create_element( name => $element_name, check => $check ) or return;
609 31745   33     52252 }
610              
611 31745   33     47407 # check level
612             my $element_level = $self->get_element_property(
613 31745         41244 property => 'level',
614 31745 50       45390 element => $element_name
615             );
616              
617 31745         69778 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 354447 object => $self,
  20754         23350  
  20754         36272  
  20754         22386  
621 20754         46106 element => $element_name,
622 20754         33927 info => 'hidden element',
623             );
624 20754 50       35275 }
625              
626             # check status
627 20754         49161 if ( $self->{status}{$element_name} eq 'obsolete' ) {
628 20754   100     51348  
629 20754   100     47435 # obsolete is a status not very different from a missing
630             # item. The only difference is that user will get more
631 20754         43086 # information
632             return 0 if ( $check eq 'no' or $check eq 'skip' );
633 20754         28241 Config::Model::Exception::ObsoleteElement->throw(
634             object => $self,
635             element => $element_name,
636 20754 100       41233 );
637             }
638              
639 1430 100       4556 # do not warn when when is skip or "no"
640 1430 100       3896 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         42025 $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     41769 $self->notify_change(
650 4 50 33     24 note => 'dropping deprecated parameter',
651 4         69 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       40462 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     7 my $element_name = $args{name};
665 1         21 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     37345 expected_type => 'leaf',
673             );
674 19         80 }
675 19 100       110  
676 11         179 return $self->fetch_element(%args)->fetch( check => $check );
677 11         587 }
678              
679             my %args = _resolve_arg_shortcut(\@args, 'name', 'value');
680              
681             return $self->fetch_element(%args)->store(%args);
682 19         752 }
683              
684             my ( $elt_name, $status ) = ( undef, 'deprecated' );
685             if ( @args == 1 ) {
686             $elt_name = $args[0];
687             }
688 20739         33933 else {
689             my %args = @args;
690             $elt_name = $args{name};
691             $status = $args{status} if defined $args{status};
692 20739     20739 0 29034 }
693 20739         58828  
694             croak "is_element_available: missing name parameter"
695             unless defined $elt_name;
696 464     464 1 1034  
  464         545  
  464         616  
  464         488  
697 464 50       1234 # force the warp to be done (if possible) so the catalog name
698 464         693 # is updated
699 464         1363 # retrieve element (and auto-vivify if needed)
700             my $element = $self->fetch_element(
701 464 50       1074 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         1100 my $element_level = $self->get_element_property(
711             property => 'level',
712             element => $elt_name
713 2     2 1 4 );
  2         4  
  2         3  
  2         3  
714 2         8  
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 6463  
  4914         6154  
  4914         7785  
  4914         6082  
720 4914         8256 my $element_status = $self->get_element_property(
721 4914 100       9571 property => 'status',
722 6         10 element => $elt_name
723             );
724              
725 4908         9454 if ( $element_status ne 'standard' and $element_status ne $status ) {
726 4908         7402 $logger->trace("element $elt_name is status $element_status -> return 0");
727 4908 100       11076 return 0;
728             }
729              
730 4914 50       10021 return 1;
731             }
732              
733             my ( $self, $name ) = @_;
734              
735             my $model_data = $self->{model}{element};
736 4914         11362  
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         9282 # return accepted model data or undef
747             my ( $self, $name ) = @_;
748              
749             return unless defined $self->{model}{accept};
750              
751 4914 100       9496 eval {require Text::Levenshtein::Damerau} ;
752 16         75 my $has_tld = ! $@ ;
753 16         166  
754             foreach my $accept_regexp ( @{ $self->{model}{accept_list} } ) {
755             next unless $name =~ /^$accept_regexp$/;
756 4898         9050 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     10957 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         16979 ." '$name' is confusingly close to '$best' (edit distance is $dist)."
767             ." Is there a typo ?"
768             );
769             }
770 5391     5391 1 9311  
771             }
772 5391         9993  
773             return $self->{model}{accept}{$accept_regexp};
774 5391 100       14025 }
775              
776 220         576 return ;
777             }
778 220 100       550  
779             my ($self) = @_;
780 195         324  
781             return @{ $self->{model}{accept_list} || [] };
782             }
783              
784             my ( $self, $element_name, $accept_model ) = @_;
785 221     221   436  
786             my $model = dclone $accept_model ;
787 221 50       553 delete $model->{name_match};
788             my $accept_after = delete $model->{accept_after};
789 221         377  
  221         7675  
790 221         25198 foreach my $info_to_move (qw/description summary/) {
791             my $moved_data = delete $model->{$info_to_move};
792 221         365 next unless defined $moved_data;
  221         651  
793 64 100       586 $self->{$info_to_move}{$element_name} = $moved_data;
794 26         56 }
795              
796 26 100 33     118 foreach my $info_to_move (qw/level status/) {
      66        
797 14         34 $self->reset_element_property(
798 14         125 element => $element_name,
799 14         21 property => $info_to_move
800 14 100       11021 );
801 4         8 }
802 4         2659  
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         303 }
812              
813             return ($model);
814 195         397 }
815              
816             my $self = shift;
817             my $element_name = shift;
818 5     5 1 16  
819             return defined $self->{model}{element}{$element_name} ? 1 : 0;
820 5 50       7 }
  5         32  
821              
822             return defined $self->{element}{ $elt_name };
823             }
824 25     25 0 47  
825             my %args = _resolve_arg_shortcut(\@args, 'path');
826 25         608 my $path = delete $args{path};
827 25         53 my $get_obj = delete $args{get_obj} || 0;
828 25         38 $path =~ s!^/!!;
829             return $self unless length($path);
830 25         43 my ( $item, $new_path ) = split m!/!, $path, 2;
831 50         60 $logger->trace("get: path $path, item $item");
832 50 50       87 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         34 return $elt->get( path => $new_path, get_obj => $get_obj, %args );
837 50         95 }
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         49 }
844             else {
845             return $self->fetch_element($item)->set( $new_path, @args );
846 25 100       44 }
847 3         4 }
  3         10  
848              
849             my $loader = Config::Model::Loader->new( start_node => $self );
850 22         33  
  22         49  
851             my %args = _resolve_arg_shortcut(\@args, 'steps');
852             if ( defined $args{step} || defined $args{steps}) {
853 25         53 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 608  
  393         675  
  393         640  
  393         513  
864 393         2139 my $raw_perl_data = delete $args{data};
865             my $check = $self->_check_check( $args{check} );
866              
867 7     7 1 1800 if (
  7         11  
  7         11  
  7         9  
868 7         18 not defined $raw_perl_data
869 7         13 or (
870 7   100     22 ref($raw_perl_data) ne 'HASH'
871 7         33  
872 7 50       16 #and not $raw_perl_data->isa( 'HASH' )
873 7         18 )
874 7         27 ) {
875 7         62 Config::Model::Exception::LoadData->throw(
876             object => $self,
877 7 100       18 message => "load_data called with non hash ref arg",
878 6 100 100     16 wrong_data => $raw_perl_data,
      100        
879 5         17 ) if $check eq 'yes';
880             return;
881             }
882 2     2 1 2  
  2         3  
  2         3  
  2         4  
  2         2  
883 2         6 my $perl_data = dclone $raw_perl_data ;
884 2         6  
885 2 50       6 $logger->info(
886 0         0 "Node load_data (",
887             $self->location,
888             ") will load elt ",
889 2         4 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 186753 # the model. This will not load not yet accepted parameters
  398         670  
  398         797  
  398         582  
894 398         4414 foreach my $elt ( @{ $self->{model}{element_list} } ) {
895             $logger->trace("check element $elt");
896 398         3952 next unless defined $perl_data->{$elt};
897 398 50 66     2045  
898 398         1799 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 5508 );
  131         241  
  131         289  
  131         191  
908 131         480  
909             if ($obj) {
910 131         316 $has_stored += $obj->load_data( %args, data => delete $perl_data->{$elt} );
911 131         564 }
912             elsif ( defined $obj ) {
913 131 50 33     692  
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         3554 }
930             }
931 131         1363  
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         1103 foreach my $elt ( sort keys %$perl_data ) {
938              
939             #load value
940 131         202 #TODO: annotations
  131         398  
941 670         2084 my $obj = $self->fetch_element( name => $elt, check => $check );
942 670 100       4984 next unless $obj; # in cas of known but unavailable elements
943             $logger->info("Node load_data: accepting element $elt");
944 331 50 33     1078 $has_stored += $obj->load_data( %args, data => delete $perl_data->{$elt} ) if defined $obj;
    0          
945             }
946 331 100       1062 }
947 27 50       137  
948 27         106 if ( %$perl_data and $check eq 'yes' ) {
949             Config::Model::Exception::LoadData->throw(
950 331         2359 message => "load_data: unknown elements (expected "
951             . join( ' ', @{ $self->{model}{element_list} } ) . ") ",
952             wrong_data => $perl_data,
953             object => $self,
954             );
955 331 50       776 }
    0          
956 331         1544 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       456  
980             $self->init();
981              
982             my $descriptor = Config::Model::Describe->new;
983 131         363 return $descriptor->describe( node => $self, @args );
984             }
985              
986             $self->init();
987 12         26 my $reporter = Config::Model::Report->new;
988 12 50       28 return $reporter->report( node => $self );
989 12         47 }
990 12 50       110  
991             $self->init();
992             my $reporter = Config::Model::Report->new;
993             return $reporter->report( node => $self, audit => 1 );
994 131 50 33     389 }
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         877 }
1003              
1004             # TODO: need Pod::Text attribute -> move that to a role ?
1005 154     154 1 45920 # to translate Pod description to plain text when help is displayed
  154         299  
  154         297  
  154         232  
1006 154         466 if ($elt_name) {
1007 154   50     686 if ( $tag !~ /^(summary|description)$/ ) {
1008 154 50       444 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         1050 }
1013 154         634 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 1170 my @rexp = $self->accept_regexp;
  2         5  
  2         7  
  2         3  
1024 2         7 if (@rexp) {
1025 2         14 push @items, 'accept: /^' . join( '$/, /^', @rexp ) . '$/';
1026 2         10 }
1027              
1028             return @items;
1029 9     9 1 17990 }
  9         18  
  9         18  
  9         12  
1030 9         29  
1031             return Config::Model::TreeSearcher->new( node => $self, @args );
1032 9         50 }
1033 9         28  
1034             # define leaf call back
1035             my $do_apply = sub ($name) {
1036 1     1 1 3 return $filter ? $name =~ /$filter/ : 1;
  1         3  
  1         2  
  1         2  
1037 1         5 };
1038 1         12  
1039 1         7 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 1323 };
  1         2  
  1         2  
  1         3  
1043 1         5  
1044 1         10 my $fix_hash = sub {
1045 1         8 my ( $scanner, $data_r, $node, $element, @keys ) = @_;
1046              
1047             return unless @keys;
1048 27     27 1 44  
  27         44  
  27         50  
  27         35  
1049 27         81 # leaves must be fixed before the hash, hence the
1050 27   33     89 # calls to scan_hash before apply_fixes
1051 27   100     73 map { $scanner->scan_hash( $data_r, $node, $element, $_ ) } @keys;
1052 27         158  
1053 27         219 $node->fetch_element($element)->apply_fixes if $do_apply->($element);
1054 27         108 };
1055              
1056             my $fix_list = sub {
1057             my ( $scanner, $data_r, $node, $element, @keys ) = @_;
1058              
1059 124     124 1 156 return unless @keys;
  124         154  
  124         177  
  124         208  
  124         161  
1060 124 100       243  
1061 79 50       290 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     317 my $scan = Config::Model::ObjTreeScanner->new(
1066             hash_element_cb => $fix_hash,
1067 45 100       98 list_element_cb => $fix_list,
1068 44   100     237 leaf_cb => $fix_leaf,
1069             check => 'no',
1070 1   50     7 );
1071              
1072             $fix_logger->debug( "apply fix started from ", $self->name );
1073             $scan->scan_node( undef, $self );
1074 2     2 1 4 $fix_logger->trace("apply fix done");
1075             return $self;
1076 2         14 }
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 7969 my ( $scanner, $data_r, $node, $element, @keys ) = @_;
  9         15  
  9         16  
  9         11  
1087 9         101  
1088             $deep_check_logger->trace( "deep check called on from ", $node->name, " elt $element keys @keys" );
1089             return unless @keys;
1090 7     7 1 3786 $node->fetch_element($element)->deep_check;
  7         13  
  7         14  
  7         8  
1091              
1092 138     138   128 };
  138         296  
  138         145  
1093 138 100       567  
1094 7         27 my $scan = Config::Model::ObjTreeScanner->new(
1095             hash_element_hook => $check_id,
1096             list_element_hook => $check_id,
1097 127     127   205 leaf_cb => $check_leaf,
1098 127 100       205 auto_vivify => $args{auto_vivify},
1099 7         27 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       6 $deep_check_logger->trace("deep check done");
1105             return;
1106             }
1107              
1108 3         7 __PACKAGE__->meta->make_immutable;
  7         19  
1109              
1110 3 50       7 1;
1111 7         18  
1112             # ABSTRACT: Class for configuration tree node
1113              
1114 11     11   25  
1115             =pod
1116 11 100       29  
1117             =encoding UTF-8
1118 8         13  
  28         62  
1119 8 50       16 =head1 NAME
1120 7         20  
1121             Config::Model::Node - Class for configuration tree node
1122 7         47  
1123             =head1 VERSION
1124              
1125             version 2.151
1126              
1127             =head1 SYNOPSIS
1128              
1129 7         26 use Config::Model;
1130 7         71  
1131 7         24 # define configuration tree object
1132 7         179 my $model = Config::Model->new;
1133             $model->create_config_class(
1134             name => 'OneConfigClass',
1135 1     1 1 241 class_description => "OneConfigClass detailed description",
  1         2  
  1         2  
  1         1  
1136 1         5  
1137             element => [
1138             [qw/X Y Z/] => {
1139             type => 'leaf',
1140             value_type => 'enum',
1141 1     70   25 choice => [qw/Av Bv Cv/]
1142             }
1143             ],
1144 10     10   22  
1145             status => [ X => 'deprecated' ],
1146 10         21 description => [ X => 'X-ray description (can be long)' ],
1147 10 100       120 summary => [ X => 'X-ray' ],
1148 5         10  
1149             accept => [
1150 1         5 'ip.*' => {
1151             type => 'leaf',
1152             value_type => 'uniline',
1153             summary => 'ip address',
1154             }
1155             ]
1156             );
1157 1         16 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         17 print $root->describe,"\n" ;
1162 1         4 # name value type comment
1163 1         42 # 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