File Coverage

blib/lib/Config/Model/Role/ComputeFunction.pm
Criterion Covered Total %
statement 39 43 90.7
branch 10 16 62.5
condition 0 3 0.0
subroutine 8 8 100.0
pod 2 2 100.0
total 59 72 81.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             # ABSTRACT: compute &index or &element functions
12              
13             use Mouse::Role;
14 59     59   28884 use strict;
  59         137  
  59         446  
15 59     59   18716 use warnings;
  59         133  
  59         1095  
16 59     59   280 use Carp;
  59         117  
  59         1505  
17 59     59   296  
  59         127  
  59         3592  
18             use Mouse::Util;
19 59     59   379 use Log::Log4perl qw(get_logger :levels);
  59         147  
  59         405  
20 59     59   4237  
  59         146  
  59         579  
21             my $logger = get_logger("ComputeFunction");
22              
23             my ($self, $string, $check) = @_;
24             $string =~ s/&(index|element)(?:\(([- \d])\))?/$self->eval_function($1,$2,$check)/eg;
25 136     136 1 454 return $string;
26 136         785 }
  159         472  
27 136         454  
28             my ($self, $function, $up, $check) = @_;
29              
30             if (defined $up) {
31 179     179 1 661 # get now the object referred
32             $up =~ s/\s//g;
33 179 100       427 $up =~ s/-(\d+)/'- ' x $1/e; # change -3 -> - - -
34             $up =~ s/(-+)/'- ' x length($1)/e; # change --- -> - - -
35 124         265 }
36 124         195  
  2         8  
37 124         471 my $target = eval {
  124         454  
38             defined $up ? $self->grab( step => $up, check => $check ) : $self;
39             };
40 179         314  
41 179 100       619 if ($@) {
42             my $e = $@;
43             my $msg = ref($e) && $e->can('full_message') ? $e->full_message : $e;
44 179 50       364 Config::Model::Exception::Model->throw(
45 0         0 object => $self,
46 0 0 0     0 error => "Compute function argument '$up':\n" . $msg
47 0         0 );
48             }
49              
50             my $result ;
51             if ( $function eq 'element' ) {
52             $result = $target->element_name;
53 179         228 Config::Model::Exception::Model->throw(
54 179 100       400 object => $self,
    50          
55 114         345 error => "Compute function error: '". $target->name. "' has no element name"
56 114 50       231 ) unless defined $result;
57             }
58             elsif ( $function eq 'index' ) {
59             $result = $target->index_value;
60             Config::Model::Exception::Model->throw(
61             object => $self,
62 65         247 error => "Compute function error: '". $target->name. "' has no index value"
63 65 50       141 ) unless defined $result;
64             }
65             else {
66             Config::Model::Exception::Model->throw(
67             object => $self,
68             error => "Unknown compute function &$function, "
69 0         0 . "expected &element(...) or &index(...)"
70             );
71             }
72              
73             return $result;
74             }
75              
76 179         731 1;
77              
78              
79             =pod
80              
81             =encoding UTF-8
82              
83             =head1 NAME
84              
85             Config::Model::Role::ComputeFunction - compute &index or &element functions
86              
87             =head1 VERSION
88              
89             version 2.152
90              
91             =head1 SYNOPSIS
92              
93             $value->eval_function('index');
94             $value->eval_function('element');
95              
96             $value->eval_function('index','-');
97             $value->eval_function('index','- -');
98             $value->eval_function('index','-3');
99              
100             $value->compute_string('&element(-)')
101             $value->compute_string('&index(- -)');
102              
103             =head1 DESCRIPTION
104              
105             Role used to let a value object get the index or the element name of
106             C<$self> or of a node above.
107              
108             =head1 METHODS
109              
110             =head2 eval_function
111              
112             Retrieve the index or the element name. Parameters are
113              
114             ( function_name , [ up ])
115              
116             =over
117              
118             =item function_name
119              
120             C<element> or C<index>
121              
122             =item up
123              
124             Optional parameter to indicate how many level to go up before
125             retrieving the index or element name. Each C<-> is equivalent to a
126             call to C<parent|Config::Model::Node/parent>. Can be repeated dashes
127             ("C<->", "C<- ->", ...)
128             or a dash with a multiplier
129             ("C<->", "C<-2>", ...). White spaces are ignored.
130              
131             =back
132              
133             =head2 compute_string
134              
135             Perform a similar function as C<eval_function> using a string where
136             function names are extracted.
137              
138             E.g. C<compute_string('&element(-)')> calls C<eval_function('element','-')>
139              
140             =head1 AUTHOR
141              
142             Dominique Dumont
143              
144             =head1 COPYRIGHT AND LICENSE
145              
146             This software is Copyright (c) 2005-2022 by Dominique Dumont.
147              
148             This is free software, licensed under:
149              
150             The GNU Lesser General Public License, Version 2.1, February 1999
151              
152             =cut