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