1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
package Config::Model::Role::ComputeFunction;
# ABSTRACT: compute &index or &element functions
use Mouse::Role;
use strict;
use warnings;
use Carp;
use Mouse::Util;
use Log::Log4perl qw(get_logger :levels);
my $logger = get_logger("ComputeFunction");
sub compute_string {
my ($self, $string, $check) = @_;
$string =~ s/&(index|element)(?:\(([- \d])\))?/$self->eval_function($1,$2,$check)/eg;
return $string;
}
sub eval_function {
my ($self, $function, $up, $check) = @_;
if (defined $up) {
# get now the object referred
$up =~ s/\s//g;
$up =~ s/-(\d+)/'- ' x $1/e; # change -3 -> - - -
$up =~ s/(-+)/'- ' x length($1)/e; # change --- -> - - -
}
my $target = eval {
defined $up ? $self->grab( step => $up, check => $check ) : $self;
};
if ($@) {
my $e = $@;
my $msg = ref($e) && $e->can('full_message') ? $e->full_message : $e;
Config::Model::Exception::Model->throw(
object => $self,
error => "Compute function argument '$up':\n" . $msg
);
}
my $result ;
if ( $function eq 'element' ) {
$result = $target->element_name;
Config::Model::Exception::Model->throw(
object => $self,
error => "Compute function error: '". $target->name. "' has no element name"
) unless defined $result;
}
elsif ( $function eq 'index' ) {
$result = $target->index_value;
Config::Model::Exception::Model->throw(
object => $self,
error => "Compute function error: '". $target->name. "' has no index value"
) unless defined $result;
}
else {
Config::Model::Exception::Model->throw(
object => $self,
error => "Unknown compute function &$function, "
. "expected &element(...) or &index(...)"
);
}
return $result;
}
1;
__END__
=head1 SYNOPSIS
$value->eval_function('index');
$value->eval_function('element');
$value->eval_function('index','-');
$value->eval_function('index','- -');
$value->eval_function('index','-3');
$value->compute_string('&element(-)')
$value->compute_string('&index(- -)');
=head1 DESCRIPTION
Role used to let a value object get the index or the element name of
C<$self> or of a node above.
=head1 METHODS
=head2 eval_function
Retrieve the index or the element name. Parameters are
( function_name , [ up ])
=over
=item function_name
C<element> or C<index>
=item up
Optional parameter to indicate how many level to go up before
retrieving the index or element name. Each C<-> is equivalent to a
call to C<parent|Config::Model::Node/parent>. Can be repeated dashes
("C<->", "C<- ->", ...)
or a dash with a multiplier
("C<->", "C<-2>", ...). White spaces are ignored.
=back
=head2 compute_string
Perform a similar function as C<eval_function> using a string where
function names are extracted.
E.g. C<compute_string('&element(-)')> calls C<eval_function('element','-')>
=cut
|
