File Coverage

blib/lib/Metrics/Any/AdapterBase/Stored.pm
Criterion Covered Total %
statement 76 76 100.0
branch 9 10 90.0
condition n/a
subroutine 20 20 100.0
pod 2 13 15.3
total 107 119 89.9


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.09;
7              
8 6     6   1903 use v5.14;
  6         21  
9 6     6   32 use warnings;
  6         12  
  6         159  
10              
11 6     6   29 use Carp;
  6         13  
  6         747  
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             # Special non-metrics values can be stored by prefixing the name with "\x00"
43 5         51 return bless {}, $class;
44             }
45              
46             =head1 METHODS
47              
48             =cut
49              
50 6     6   50 use constant HAVE_BATCH_MODE => 1;
  6         13  
  6         6817  
51              
52             sub add_batch_mode_callback
53             {
54 2     2 0 5 my $self = shift;
55 2         6 my ( $cb ) = @_;
56              
57 2         3 push @{ $self->{"\0batch_callbacks"} }, $cb;
  2         8  
58             }
59              
60             sub _make
61             {
62 28     28   49 my $self = shift;
63 28         110 my ( $type, $handle, %args ) = @_;
64              
65 28         69 my $name = $args{name};
66 28 100       135 $name = join "_", @$name if ref $name eq "ARRAY";
67              
68             $self->{$handle} = {
69             type => $type,
70             name => $name,
71             labels => $args{labels},
72 28         240 values => {}, # values per labelset
73             };
74             }
75              
76             sub _metric
77             {
78 44     44   77 my $self = shift;
79 44         112 my ( $type, $handle ) = @_;
80              
81 44         80 my $metric = $self->{$handle};
82 44 50       102 $metric->{type} eq $type or
83             croak "$handle is not a $type metric";
84              
85 44         81 return $metric;
86             }
87              
88             sub _labelset
89             {
90 44     44   82 my $self = shift;
91 44         83 my ( $handle, @labelvalues ) = @_;
92              
93 44         64 my $metric = $self->{$handle};
94              
95 44 100       164 my $labels = $metric->{labels} or return "";
96              
97 13         47 return join "\0", map { "$labels->[$_]:$labelvalues[$_]" } 0 .. $#$labels;
  13         71  
98             }
99              
100             =head2 walk
101              
102             $stored->walk( $code )
103              
104             $code->( $type, $name, $labels, $value )
105              
106             Given a CODE reference, this method invokes it once per labelset of every
107             stored metric.
108              
109             For each labelset, C<$type> will give the metric type (as a string, either
110             C, C, C or C), C<$name> gives the name
111             it was registered with, C<$labels> will be a reference to an even-sized array
112             containing label names and values.
113              
114             For counter and gauge metrics, C<$value> will be a numerical scalar giving the
115             current value. For distribution and timer metrics, C<$value> will be whatever
116             the implementing class's corresponding C or C
117             method returns for them.
118              
119             =cut
120              
121             sub walk
122             {
123 20     20 1 45 my $self = shift;
124 20         36 my ( $code ) = @_;
125              
126 20 100       67 if( my $cbs = $self->{"\0batch_callbacks"} ) {
127 2         5 foreach my $cb ( @$cbs ) { $cb->() }
  2         6  
128             }
129              
130 20         108 foreach my $handle ( sort keys %$self ) {
131 89 100       239 next if $handle =~ m/^\0/;
132              
133 87         123 my $metric = $self->{$handle};
134 87         124 my $values = $metric->{values};
135              
136 87         222 foreach my $labelset ( sort keys %$values ) {
137 37         93 my @labels = map { split m/:/, $_, 2 } split m/\0/, $labelset;
  13         37  
138              
139 37         105 $code->( $metric->{type}, $metric->{name}, \@labels, $values->{$labelset} );
140             }
141             }
142             }
143              
144             =head2 clear_values
145              
146             $stored->clear_values
147              
148             Clears all of the metric storage. Every labelset of every metric is deleted.
149             The metric definitions themselves remain.
150              
151             =cut
152              
153             sub clear_values
154             {
155 12     12 1 22 my $self = shift;
156              
157 12         76 $_->{values} = {} for values %$self;
158             }
159              
160 12     12 0 157 sub make_counter { shift->_make( counter => @_ ) }
161              
162             sub inc_counter_by
163             {
164 20     20 0 37 my $self = shift;
165 20         43 my ( $handle, $amount, @labelvalues ) = @_;
166              
167 20         57 my $metric = $self->_metric( counter => $handle );
168              
169 20         64 $metric->{values}{ $self->_labelset( $handle, @labelvalues ) } += $amount;
170             }
171              
172 6     6 0 20 sub make_distribution { shift->_make( distribution => @_ ) }
173              
174             sub report_distribution
175             {
176 10     10 0 21 my $self = shift;
177 10         22 my ( $handle, $amount, @labelvalues ) = @_;
178              
179 10         33 my $metric = $self->_metric( distribution => $handle );
180              
181 10         30 my $values = $metric->{values};
182 10         24 my $key = $self->_labelset( $handle, @labelvalues );
183              
184 10         39 $values->{$key} = $self->store_distribution( $values->{$key}, $amount );
185             }
186              
187 5     5 0 18 sub make_gauge { shift->_make( gauge => @_ ) }
188              
189             sub inc_gauge_by
190             {
191 5     5 0 22 my $self = shift;
192 5         13 my ( $handle, $amount, @labelvalues ) = @_;
193              
194 5         14 my $metric = $self->_metric( gauge => $handle );
195              
196 5         16 $metric->{values}{ $self->_labelset( $handle, @labelvalues ) } += $amount;
197             }
198              
199             sub set_gauge_to
200             {
201 3     3 0 8 my $self = shift;
202 3         7 my ( $handle, $amount, @labelvalues ) = @_;
203              
204 3         8 my $metric = $self->_metric( gauge => $handle );
205              
206 3         10 $metric->{values}{ $self->_labelset( $handle, @labelvalues ) } = $amount;
207             }
208              
209 5     5 0 16 sub make_timer { shift->_make( timer => @_ ) }
210              
211             sub report_timer
212             {
213 6     6 0 10 my $self = shift;
214 6         14 my ( $handle, $duration, @labelvalues ) = @_;
215              
216 6         17 my $metric = $self->_metric( timer => $handle );
217              
218 6         10 my $values = $metric->{values};
219 6         17 my $key = $self->_labelset( $handle, @labelvalues );
220              
221 6         30 $values->{$key} = $self->store_timer( $values->{$key}, $duration );
222             }
223              
224             =head1 REQUIRED METHODS
225              
226             =head2 store_distribution
227              
228             =head2 store_timer
229              
230             $storage = $stored->store_distribution( $storage, $amount )
231              
232             $storage = $stored->store_timer( $storage, $duration )
233              
234             The implementing class must provide these two methods to assist in the
235             management of storage for distribution and timer metrics.
236              
237             When a new observation for the metric is required, the method will be invoked,
238             passing in the currently-stored perl value for the given metric and label
239             values, and the new observation. Whatever the method returns is stored by the
240             base class, to be passed in next time or used by the L method.
241              
242             The base class stores this value directly and does not otherwise interact with
243             it; letting the implementing class decide what is best. For example, a simple
244             implementation may just store every observation individually by pushing them
245             into an array; so the C<$storage> would be an ARRAY reference:
246              
247             sub store_distribution
248             {
249             my $self = shift;
250             my ( $storage, $amount ) = @_;
251              
252             push @$storage, $amount;
253              
254             return $storage;
255             }
256              
257             =cut
258              
259             =head1 AUTHOR
260              
261             Paul Evans
262              
263             =cut
264              
265             0x55AA;