line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# You may distribute under the terms of either the GNU General Public License |
2
|
|
|
|
|
|
|
# or the Artistic License (the same terms as Perl itself) |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# (C) Paul Evans, 2020 -- leonerd@leonerd.org.uk |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
package Metrics::Any::AdapterBase::Stored 0.08; |
7
|
|
|
|
|
|
|
|
8
|
6
|
|
|
6
|
|
1987
|
use v5.14; |
|
6
|
|
|
|
|
20
|
|
9
|
6
|
|
|
6
|
|
27
|
use warnings; |
|
6
|
|
|
|
|
9
|
|
|
6
|
|
|
|
|
127
|
|
10
|
|
|
|
|
|
|
|
11
|
6
|
|
|
6
|
|
28
|
use Carp; |
|
6
|
|
|
|
|
10
|
|
|
6
|
|
|
|
|
5475
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
=head1 NAME |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
C - a base class for metrics adapters which store values |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
=head1 DESCRIPTION |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
This base class assists in creating L classes which |
20
|
|
|
|
|
|
|
store values of reported metrics directly. These can then be retrieved later |
21
|
|
|
|
|
|
|
by the containing application, or the subclass code, by using the L |
22
|
|
|
|
|
|
|
method. |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
This base class internally stores counter and gauge metrics as single scalar |
25
|
|
|
|
|
|
|
values directly. In order to provide flexibility for a variety of |
26
|
|
|
|
|
|
|
use-cases, it requires assistance from the implementing class on how to store |
27
|
|
|
|
|
|
|
distribution and timer metrics. The implementing class should provide these |
28
|
|
|
|
|
|
|
methods, returning whatever values it wishes to implement them with. These |
29
|
|
|
|
|
|
|
values are stored by the base class, and handed back as part of the L |
30
|
|
|
|
|
|
|
method. |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
The base class stores a value for each unique set of labels and values on |
33
|
|
|
|
|
|
|
every metric; the subclass does not need to handle this. |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
=cut |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
sub new |
38
|
|
|
|
|
|
|
{ |
39
|
5
|
|
|
5
|
0
|
12
|
my $class = shift; |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
# Metrics are keys of $self, named by handle |
42
|
5
|
|
|
|
|
59
|
return bless {}, $class; |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
=head1 METHODS |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
=cut |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
sub _make |
50
|
|
|
|
|
|
|
{ |
51
|
28
|
|
|
28
|
|
40
|
my $self = shift; |
52
|
28
|
|
|
|
|
79
|
my ( $type, $handle, %args ) = @_; |
53
|
|
|
|
|
|
|
|
54
|
28
|
|
|
|
|
49
|
my $name = $args{name}; |
55
|
28
|
100
|
|
|
|
98
|
$name = join "_", @$name if ref $name eq "ARRAY"; |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
$self->{$handle} = { |
58
|
|
|
|
|
|
|
type => $type, |
59
|
|
|
|
|
|
|
name => $name, |
60
|
|
|
|
|
|
|
labels => $args{labels}, |
61
|
28
|
|
|
|
|
214
|
values => {}, # values per labelset |
62
|
|
|
|
|
|
|
}; |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
sub _metric |
66
|
|
|
|
|
|
|
{ |
67
|
40
|
|
|
40
|
|
52
|
my $self = shift; |
68
|
40
|
|
|
|
|
61
|
my ( $type, $handle ) = @_; |
69
|
|
|
|
|
|
|
|
70
|
40
|
|
|
|
|
60
|
my $metric = $self->{$handle}; |
71
|
40
|
50
|
|
|
|
77
|
$metric->{type} eq $type or |
72
|
|
|
|
|
|
|
croak "$handle is not a $type metric"; |
73
|
|
|
|
|
|
|
|
74
|
40
|
|
|
|
|
93
|
return $metric; |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
sub _labelset |
78
|
|
|
|
|
|
|
{ |
79
|
40
|
|
|
40
|
|
47
|
my $self = shift; |
80
|
40
|
|
|
|
|
64
|
my ( $handle, @labelvalues ) = @_; |
81
|
|
|
|
|
|
|
|
82
|
40
|
|
|
|
|
54
|
my $metric = $self->{$handle}; |
83
|
|
|
|
|
|
|
|
84
|
40
|
100
|
|
|
|
123
|
my $labels = $metric->{labels} or return ""; |
85
|
|
|
|
|
|
|
|
86
|
13
|
|
|
|
|
36
|
return join "\0", map { "$labels->[$_]:$labelvalues[$_]" } 0 .. $#$labels; |
|
13
|
|
|
|
|
61
|
|
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
=head2 walk |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
$stored->walk( $code ) |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
$code->( $type, $name, $labels, $value ) |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
Given a CODE reference, this method invokes it once per labelset of every |
96
|
|
|
|
|
|
|
stored metric. |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
For each labelset, C<$type> will give the metric type (as a string, either |
99
|
|
|
|
|
|
|
C, C, C or C), C<$name> gives the name |
100
|
|
|
|
|
|
|
it was registered with, C<$labels> will be a reference to an even-sized array |
101
|
|
|
|
|
|
|
containing label names and values. |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
For counter and gauge metrics, C<$value> will be a numerical scalar giving the |
104
|
|
|
|
|
|
|
current value. For distribution and timer metrics, C<$value> will be whatever |
105
|
|
|
|
|
|
|
the implementing class's corresponding C or C |
106
|
|
|
|
|
|
|
method returns for them. |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
=cut |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
sub walk |
111
|
|
|
|
|
|
|
{ |
112
|
18
|
|
|
18
|
1
|
30
|
my $self = shift; |
113
|
18
|
|
|
|
|
29
|
my ( $code ) = @_; |
114
|
|
|
|
|
|
|
|
115
|
18
|
|
|
|
|
106
|
foreach my $handle ( sort keys %$self ) { |
116
|
74
|
|
|
|
|
130
|
my $metric = $self->{$handle}; |
117
|
74
|
|
|
|
|
90
|
my $values = $metric->{values}; |
118
|
|
|
|
|
|
|
|
119
|
74
|
|
|
|
|
165
|
foreach my $labelset ( sort keys %$values ) { |
120
|
33
|
|
|
|
|
86
|
my @labels = map { split m/:/, $_, 2 } split m/\0/, $labelset; |
|
13
|
|
|
|
|
31
|
|
121
|
|
|
|
|
|
|
|
122
|
33
|
|
|
|
|
82
|
$code->( $metric->{type}, $metric->{name}, \@labels, $values->{$labelset} ); |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
=head2 clear_values |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
$stored->clear_values |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
Clears all of the metric storage. Every labelset of every metric is deleted. |
132
|
|
|
|
|
|
|
The metric definitions themselves remain. |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=cut |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
sub clear_values |
137
|
|
|
|
|
|
|
{ |
138
|
10
|
|
|
10
|
1
|
20
|
my $self = shift; |
139
|
|
|
|
|
|
|
|
140
|
10
|
|
|
|
|
54
|
$_->{values} = {} for values %$self; |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
|
143
|
12
|
|
|
12
|
0
|
45
|
sub make_counter { shift->_make( counter => @_ ) } |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
sub inc_counter_by |
146
|
|
|
|
|
|
|
{ |
147
|
18
|
|
|
18
|
0
|
50
|
my $self = shift; |
148
|
18
|
|
|
|
|
54
|
my ( $handle, $amount, @labelvalues ) = @_; |
149
|
|
|
|
|
|
|
|
150
|
18
|
|
|
|
|
51
|
my $metric = $self->_metric( counter => $handle ); |
151
|
|
|
|
|
|
|
|
152
|
18
|
|
|
|
|
63
|
$metric->{values}{ $self->_labelset( $handle, @labelvalues ) } += $amount; |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
|
155
|
6
|
|
|
6
|
0
|
21
|
sub make_distribution { shift->_make( distribution => @_ ) } |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
sub report_distribution |
158
|
|
|
|
|
|
|
{ |
159
|
10
|
|
|
10
|
0
|
20
|
my $self = shift; |
160
|
10
|
|
|
|
|
21
|
my ( $handle, $amount, @labelvalues ) = @_; |
161
|
|
|
|
|
|
|
|
162
|
10
|
|
|
|
|
22
|
my $metric = $self->_metric( distribution => $handle ); |
163
|
|
|
|
|
|
|
|
164
|
10
|
|
|
|
|
17
|
my $values = $metric->{values}; |
165
|
10
|
|
|
|
|
23
|
my $key = $self->_labelset( $handle, @labelvalues ); |
166
|
|
|
|
|
|
|
|
167
|
10
|
|
|
|
|
41
|
$values->{$key} = $self->store_distribution( $values->{$key}, $amount ); |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
|
170
|
5
|
|
|
5
|
0
|
22
|
sub make_gauge { shift->_make( gauge => @_ ) } |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
sub inc_gauge_by |
173
|
|
|
|
|
|
|
{ |
174
|
5
|
|
|
5
|
0
|
13
|
my $self = shift; |
175
|
5
|
|
|
|
|
14
|
my ( $handle, $amount, @labelvalues ) = @_; |
176
|
|
|
|
|
|
|
|
177
|
5
|
|
|
|
|
14
|
my $metric = $self->_metric( gauge => $handle ); |
178
|
|
|
|
|
|
|
|
179
|
5
|
|
|
|
|
17
|
$metric->{values}{ $self->_labelset( $handle, @labelvalues ) } += $amount; |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
sub set_gauge_to |
183
|
|
|
|
|
|
|
{ |
184
|
1
|
|
|
1
|
0
|
2
|
my $self = shift; |
185
|
1
|
|
|
|
|
3
|
my ( $handle, $amount, @labelvalues ) = @_; |
186
|
|
|
|
|
|
|
|
187
|
1
|
|
|
|
|
24
|
my $metric = $self->_metric( gauge => $handle ); |
188
|
|
|
|
|
|
|
|
189
|
1
|
|
|
|
|
5
|
$metric->{values}{ $self->_labelset( $handle, @labelvalues ) } = $amount; |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
|
192
|
5
|
|
|
5
|
0
|
19
|
sub make_timer { shift->_make( timer => @_ ) } |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
sub report_timer |
195
|
|
|
|
|
|
|
{ |
196
|
6
|
|
|
6
|
0
|
13
|
my $self = shift; |
197
|
6
|
|
|
|
|
11
|
my ( $handle, $duration, @labelvalues ) = @_; |
198
|
|
|
|
|
|
|
|
199
|
6
|
|
|
|
|
15
|
my $metric = $self->_metric( timer => $handle ); |
200
|
|
|
|
|
|
|
|
201
|
6
|
|
|
|
|
14
|
my $values = $metric->{values}; |
202
|
6
|
|
|
|
|
13
|
my $key = $self->_labelset( $handle, @labelvalues ); |
203
|
|
|
|
|
|
|
|
204
|
6
|
|
|
|
|
22
|
$values->{$key} = $self->store_timer( $values->{$key}, $duration ); |
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
=head1 REQUIRED METHODS |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
=head2 store_distribution |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
=head2 store_timer |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
$storage = $stored->store_distribution( $storage, $amount ) |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
$storage = $stored->store_timer( $storage, $duration ) |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
The implementing class must provide these two methods to assist in the |
218
|
|
|
|
|
|
|
management of storage for distribution and timer metrics. |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
When a new observation for the metric is required, the method will be invoked, |
221
|
|
|
|
|
|
|
passing in the currently-stored perl value for the given metric and label |
222
|
|
|
|
|
|
|
values, and the new observation. Whatever the method returns is stored by the |
223
|
|
|
|
|
|
|
base class, to be passed in next time or used by the L method. |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
The base class stores this value directly and does not otherwise interact with |
226
|
|
|
|
|
|
|
it; letting the implementing class decide what is best. For example, a simple |
227
|
|
|
|
|
|
|
implementation may just store every observation individually by pushing them |
228
|
|
|
|
|
|
|
into an array; so the C<$storage> would be an ARRAY reference: |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
sub store_distribution |
231
|
|
|
|
|
|
|
{ |
232
|
|
|
|
|
|
|
my $self = shift; |
233
|
|
|
|
|
|
|
my ( $storage, $amount ) = @_; |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
push @$storage, $amount; |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
return $storage; |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
=cut |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
=head1 AUTHOR |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
Paul Evans |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
=cut |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
0x55AA; |