File Coverage

blib/lib/Config/Model/IdElementReference.pm
Criterion Covered Total %
statement 71 82 86.5
branch 17 22 77.2
condition 7 7 100.0
subroutine 7 9 77.7
pod 2 5 40.0
total 104 125 83.2


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   358  
  59         115  
  59         334  
13             use Carp;
14 59     59   19299 use Config::Model::ValueComputer;
  59         178  
  59         3156  
15 59     59   375 use Log::Log4perl qw(get_logger :levels);
  59         116  
  59         1756  
16 59     59   363  
  59         132  
  59         440  
17             my $logger = get_logger("Tree::Element::IdElementReference");
18              
19             # config_elt is a reference to the object that called new
20             has config_elt => ( is => 'ro', isa => 'Config::Model::AnyThing', required => 1, weak_ref => 1 );
21             has refer_to => ( is => 'ro', isa => 'Maybe[Str]' );
22             has computed_refer_to => ( is => 'ro', isa => 'Maybe[HashRef]' );
23              
24             my $self = shift;
25              
26 84     84 1 1410 my $found = scalar grep { defined $self->$_; } qw/refer_to computed_refer_to/;
27              
28 84         210 if ( not $found ) {
  168         694  
29             Config::Model::Exception::Model->throw(
30 84 50       383 object => $self->config_elt,
    50          
31 0         0 message => "missing " . "refer_to or computed_refer_to parameter"
32             );
33             }
34             elsif ( $found > 1 ) {
35             Config::Model::Exception::Model->throw(
36             object => $self->config_elt,
37 0         0 message => "cannot specify both " . "refer_to and computed_refer_to parameters"
38             );
39             }
40              
41             my $rft = $self->{refer_to};
42             my $crft = $self->{computed_refer_to} || {};
43 84         243 my %c_args = %$crft;
44 84   100     451  
45 84         272 my $refer_path =
46             defined $rft
47             ? $rft
48             : delete $c_args{formula};
49              
50 84 100       258 # split refer_path on + then create as many ValueComputer as
51             # required
52             my @references = split /\s+\+\s+/, $refer_path;
53              
54 84         589 foreach my $single_path (@references) {
55             push @{ $self->{compute} }, Config::Model::ValueComputer->new(
56 84         244 formula => $single_path,
57 130         2808 variables => {},
58             %c_args,
59             value_object => $self->{config_elt},
60             value_type => 'string' # a reference is always a string
61             );
62 130         233 }
63              
64             return $self;
65             }
66 84         731  
67             # internal
68              
69             # FIXME: do not call back value object -> may recurse
70             my $self = shift;
71              
72             my $config_elt = $self->{config_elt};
73 319     319 0 698 my @enum_choice = $config_elt->get_default_choice;
74              
75 319         727 foreach my $compute_obj ( @{ $self->{compute} } ) {
76 319         1147 my $user_spec = $compute_obj->compute;
77              
78 319         646 next unless defined $user_spec;
  319         931  
79 472         1940  
80             my @path = split( /\s+/, $user_spec );
81 472 100       1493  
82             $logger->trace("path: @path");
83 469         2747  
84             my $referred_to = eval { $config_elt->grab("@path"); };
85 469         2383  
86             if (ref $@) {
87 469         3752 my $e = $@;
  469         2503  
88             # don't use $e->full_description as it will recurse badly
89 469 100       1371 Config::Model::Exception::Model->throw(
90 2         4 object => $config_elt,
91             error => "'refer_to' parameter with path '@path': " .$e->description
92 2         27 );
93             }
94              
95             my $element = pop @path;
96             my $obj = $referred_to->parent;
97             my $type = $obj->element_type($element);
98 467         1030  
99 467         1397 my @choice;
100 467         1509 if ( $type eq 'check_list' ) {
101             @choice = $obj->fetch_element($element)->get_checked_list();
102 467         850 }
103 467 100       1681 elsif ( $type eq 'hash' ) {
    100          
    50          
104 9         27 @choice = $obj->fetch_element($element)->fetch_all_indexes();
105             }
106             elsif ( $type eq 'list' ) {
107 454         1190 my $list_obj = $obj->fetch_element($element);
108             my $ct = $list_obj->get_cargo_type;
109             if ( $ct eq 'leaf' ) {
110 4         14 @choice = $list_obj->fetch_all_values( mode => 'user' );
111 4         34 }
112 4 50       16 else {
113 4         25 Config::Model::Exception::Model->throw(
114             object => $obj,
115             message => "element '$element' cargo_type is $ct. " . "Expected 'leaf'"
116 0         0 );
117             }
118             }
119             else {
120             Config::Model::Exception::Model->throw(
121             object => $obj,
122             message => "element '$element' type is $type. "
123 0         0 . "Expected hash or list or check_list"
124             );
125             }
126              
127             # use a hash so choices are unique
128             push @enum_choice, @choice;
129             }
130              
131 467         1801 # prune out repeated items
132             my %h;
133             my @unique =
134             grep { my $found = $h{$_} || 0; $h{$_} = 1; not $found; } @enum_choice;
135 317         702  
136             my @res;
137 317   100     679 if ( $config_elt->value_type eq 'check_list' and $config_elt->ordered ) {
  707         1939  
  707         1195  
  707         1561  
138             @res = @unique;
139 317         583 }
140 317 100 100     1854 else {
141 3         9 @res = sort @unique;
142             }
143              
144 314         1019 $logger->debug( "Setting choice to '", join( "','", @res ), "'" );
145              
146             $config_elt->setup_reference_choice(@res);
147 317         1785 }
148              
149 317         3468 my $self = shift;
150             my $str = "choice was retrieved with: ";
151              
152             foreach my $compute_obj ( @{ $self->{compute} } ) {
153 1     1 1 3 my $path = $compute_obj->formula;
154 1         2 $path = defined $path ? "'$path'" : 'undef';
155             $str .= "\n\tpath $path";
156 1         2 $str .= "\n\t" . $compute_obj->compute_info;
  1         3  
157 2         9 }
158 2 50       8 return $str;
159 2         4 }
160 2         8  
161             my $self = shift;
162 1         5 return @{ $self->{compute} };
163             }
164              
165             my $self = shift;
166 0     0 0   return map { $_->formula } @{ $self->{compute} };
167 0           }
  0            
168              
169             __PACKAGE__->meta->make_immutable;
170              
171 0     0 0   1;
172 0            
  0            
  0            
173             # ABSTRACT: Refer to id element(s) and extract keys
174              
175              
176             =pod
177              
178             =encoding UTF-8
179              
180             =head1 NAME
181              
182             Config::Model::IdElementReference - Refer to id element(s) and extract keys
183              
184             =head1 VERSION
185              
186             version 2.151
187              
188             =head1 SYNOPSIS
189              
190             # synopsis shows an example of model of a network to use references
191              
192             use Config::Model;
193              
194             my $model = Config::Model->new;
195              
196             # model of several hosts with several NICs
197             $model->create_config_class(
198             name => 'Host',
199             'element' => [
200             ip_nic => {
201             type => 'hash',
202             index_type => 'string',
203             cargo => {
204             type => 'leaf',
205             value_type => 'uniline',
206             }
207             },
208             ]
209             );
210              
211             # model to choose a master host and a master NIC (whatever that may be)
212             # among configured hosts. Once these 2 are configured, the model computes
213             # the master IP
214              
215             $model->create_config_class(
216             name => "MyNetwork",
217              
218             element => [
219             host => {
220             type => 'hash',
221             index_type => 'string',
222             cargo => {
223             type => 'node',
224             config_class_name => 'Host'
225             },
226             },
227              
228             # master_host is one of the configured hosts
229             master_host => {
230             type => 'leaf',
231             value_type => 'reference', # provided by tConfig::Model::IdElementReference
232             refer_to => '! host'
233             },
234              
235             # master_nic is one NIC of the master host
236             master_nic => {
237             type => 'leaf',
238             value_type => 'reference', # provided by tConfig::Model::IdElementReference
239             computed_refer_to => { # provided by Config::Model::ValueComputer
240             formula => ' ! host:$h ip_nic ',
241             variables => { h => '- master_host' }
242             }
243             },
244              
245             # provided by Config::Model::ValueComputer
246             master_ip => {
247             type => 'leaf',
248             value_type => 'string',
249             compute => {
250             formula => '$ip',
251             variables => {
252             h => '- master_host',
253             nic => '- master_nic',
254             ip => '! host:$h ip_nic:$nic'
255             }
256             }
257             },
258              
259             ],
260             );
261              
262             my $inst = $model->instance(root_class_name => 'MyNetwork' );
263              
264             my $root = $inst->config_root ;
265              
266             # configure hosts on my network
267             my $steps = 'host:foo ip_nic:eth0=192.168.0.1 ip_nic:eth1=192.168.1.1 -
268             host:bar ip_nic:eth0=192.168.0.2 ip_nic:eth1=192.168.1.2 -
269             host:baz ip_nic:eth0=192.168.0.3 ip_nic:eth1=192.168.1.3 ';
270             $root->load( steps => $steps );
271              
272             print "master host can be one of ",
273             join(' ',$root->fetch_element('master_host')->get_choice),"\n" ;
274             # prints: master host can be one of bar baz foo
275              
276             # choose master host
277             $root->load('master_host=bar') ;
278              
279             print "master NIC of master host can be one of ",
280             join(' ',$root->fetch_element('master_nic')->get_choice),"\n" ;
281             # prints: master NIC of master host can be one of eth0 eth1
282              
283             # choose master nic
284             $root->load('master_nic=eth1') ;
285              
286             # check what is the master IP computed by the model
287             print "master IP is ",$root->grab_value('master_ip'),"\n";
288             # prints master IP is 192.168.1.2
289              
290             =head1 DESCRIPTION
291              
292             This class is user by L<Config::Model::Value> to set up an enumerated
293             value where the possible choice depends on the key of a
294             L<Config::Model::HashId> or the content of a L<Config::Model::ListId>
295             object.
296              
297             This class is also used by L<Config::Model::CheckList> to define the
298             checklist items from the keys of another hash (or content of a list).
299              
300             =head1 CONSTRUCTOR
301              
302             Construction is handled by the calling object (L<Config::Model::Node>).
303              
304             =head1 Config class parameters
305              
306             =over
307              
308             =item refer_to
309              
310             C<refer_to> is used to specify a hash element that is used as a
311             reference. C<refer_to> points to an array or hash element in the
312             configuration tree using the path syntax (See
313             L<Config::Model::Role::Grab/grab> for details).
314              
315             =item computed_refer_to
316              
317             When C<computed_refer_to> is used, the path is computed using values
318             from several elements in the configuration tree. C<computed_refer_to>
319             is a hash with 2 mandatory elements: C<formula> and C<variables>.
320              
321             =back
322              
323             The available choice of this (computed or not) reference value is made
324             from the available keys of the C<referred_to> hash element or the values
325             of the C<referred_to> array element.
326              
327             The example means the the value must correspond to an existing host:
328              
329             value_type => 'reference',
330             refer_to => '! host'
331              
332             This example means the the value must correspond to an existing lan
333             within the host whose Id is specified by hostname:
334              
335             value_type => 'reference',
336             computed_refer_to => {
337             formula => '! host:$a lan',
338             variables => { a => '- hostname' }
339             }
340              
341             If you need to combine possibilities from several hash, use the "C<+>"
342             token to separate 2 paths:
343              
344             value_type => 'reference',
345             computed_refer_to => {
346             formula => '! host:$a lan + ! host:foobar lan',
347             variables => { a => '- hostname' }
348             }
349              
350             You can specify C<refer_to> or C<computed_refer_to> with a C<choice>
351             argument so the possible enum value will be the combination of the
352             specified choice and the referred_to values.
353              
354             =head1 Methods
355              
356             =head2 reference_info
357              
358             Returns a human readable string with explains how is retrieved the
359             reference. This method is mostly used to construct an error messages.
360              
361             =head1 AUTHOR
362              
363             Dominique Dumont, (ddumont at cpan dot org)
364              
365             =head1 SEE ALSO
366              
367             L<Config::Model>, L<Config::Model::Value>,
368             L<Config::Model::AnyId>, L<Config::Model::CheckList>
369              
370             =head1 AUTHOR
371              
372             Dominique Dumont
373              
374             =head1 COPYRIGHT AND LICENSE
375              
376             This software is Copyright (c) 2005-2022 by Dominique Dumont.
377              
378             This is free software, licensed under:
379              
380             The GNU Lesser General Public License, Version 2.1, February 1999
381              
382             =cut