File Coverage

blib/lib/Metrics/Any/AdapterBase/Stored.pm
Criterion Covered Total %
statement 65 65 100.0
branch 5 6 83.3
condition n/a
subroutine 18 18 100.0
pod 2 12 16.6
total 90 101 89.1


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;