File Coverage

blib/lib/Metrics/Any/Adapter/File.pm
Criterion Covered Total %
statement 55 64 85.9
branch 5 12 41.6
condition n/a
subroutine 14 15 93.3
pod 0 10 0.0
total 74 101 73.2


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::Adapter::File 0.09;
7              
8 2     2   939 use v5.14;
  2         7  
9 2     2   10 use warnings;
  2         4  
  2         53  
10              
11 2     2   9 use Carp;
  2         4  
  2         1971  
12              
13             =head1 NAME
14              
15             C - write metrics to a file
16              
17             =head1 SYNOPSIS
18              
19             use Metrics::Any::Adapter 'File', path => "metrics.log";
20              
21             =head1 DESCRIPTION
22              
23             This L adapter type writes observations of metric values into a
24             file. This may be helpful while debugging or otherwise testing code that
25             reports metrics.
26              
27             For example, by setting the C environment variable to
28             configure the adapter, a metric log will be written as a side-effect of
29             running a unit test:
30              
31             $ METRICS_ANY_ADAPTER=File:path=metrics.log perl -Mblib t/01test.t
32              
33             The generated file can then be inspected to see what metric values were
34             reported while the program was running.
35              
36             In particular, specifying the file F allows the full metrics
37             generation path to be tested with the code under test seeing a "real" adapter
38             even though the output goes nowhere.
39              
40             $ METRICS_ANY_ADAPTER=File:path=/dev/null ./Build test
41              
42             Distribution and timing metrics are tracked with a running total and count of
43             observations.
44              
45             This adapter type does not support batch mode reporting.
46              
47             =head1 ARGUMENTS
48              
49             The following additional arguments are recognised
50              
51             =head2 path
52              
53             The path to the file to write to.
54              
55             =cut
56              
57             my %metrics;
58              
59             sub new
60             {
61 1     1 0 3 my $class = shift;
62 1         3 my %args = @_;
63              
64 1         2 my $fh;
65 1 50       4 if( $args{fh} ) {
    0          
66             # fh isn't documented but useful for unit testing
67 1         2 $fh = $args{fh};
68             }
69             elsif( $args{path} ) {
70 0 0       0 open $fh, ">>", $args{path} or die "Cannot open $args{path} for writing - $!\n";
71             }
72             else {
73 0         0 croak "Require a 'path' argument";
74             }
75              
76 1         9 $fh->autoflush;
77              
78 1         64 return bless {
79             __fh => $fh,
80             }, $class;
81             }
82              
83             sub _make
84             {
85 4     4   17 my $self = shift;
86 4         15 my ( $type, $handle, %args ) = @_;
87              
88 4         7 my $name = $args{name};
89 4 50       11 $name = join "_", @$name if ref $name eq "ARRAY";
90              
91             $self->{$handle} = {
92             type => $type,
93             name => $name,
94             labels => $args{labels},
95 4         25 };
96             }
97              
98             sub _key
99             {
100 16     16   23 my $self = shift;
101 16         27 my ( $handle, $suffix, @labelvalues ) = @_;
102              
103 16         23 my $meta = $self->{$handle};
104              
105 16         23 my $key = $meta->{name};
106 16 100       43 $key .= $suffix if defined $suffix;
107              
108 16 50       34 if( my $labels = $meta->{labels} ) {
109 0         0 $key .= " $labels->[$_]:$labelvalues[$_]" for 0 .. $#$labels;
110             }
111              
112 16         84 return $key;
113             }
114              
115 1     1 0 3 sub make_counter { shift->_make( counter => @_ ) }
116              
117             sub inc_counter_by
118             {
119 2     2 0 5 my $self = shift;
120 2         3 my ( $handle, $amount, @labelvalues ) = @_;
121 2         4 my $fh = $self->{__fh};
122              
123 2         5 my $key = $self->_key( $handle, undef, @labelvalues );
124 2         5 my $current = $metrics{$key} += $amount;
125              
126 2         26 printf $fh "METRIC COUNTER %s %+g => %g\n",
127             $key, $amount, $current;
128             }
129              
130 1     1 0 3 sub make_distribution { shift->_make( distribution => @_ ) }
131              
132             sub report_distribution
133             {
134 2     2 0 3 my $self = shift;
135 2         4 my ( $handle, $amount, @labelvalues ) = @_;
136 2         4 my $fh = $self->{__fh};
137              
138 2         4 my $count = $metrics{ $self->_key( $handle, "_count", @labelvalues ) } += 1;
139 2         6 my $total = $metrics{ $self->_key( $handle, "_total", @labelvalues ) } += $amount;
140              
141 2         9 printf $fh "METRIC DISTRIBUTION %s +%g => %g/%d [avg=%g]\n",
142             $self->_key( $handle, undef, @labelvalues ), $amount, $total, $count, $total/$count;
143             }
144              
145 1     1 0 3 sub make_gauge { shift->_make( gauge => @_ ) }
146              
147             sub inc_gauge_by
148             {
149 2     2 0 4 my $self = shift;
150 2         4 my ( $handle, $amount, @labelvalues ) = @_;
151 2         3 my $fh = $self->{__fh};
152              
153 2         6 my $key = $self->_key( $handle, undef, @labelvalues );
154 2         5 my $current = $metrics{$key} += $amount;
155              
156 2         21 printf $fh "METRIC GAUGE %s %+g => %g\n",
157             $key, $amount, $current;
158             }
159              
160             sub set_gauge_to
161             {
162 0     0 0 0 my $self = shift;
163 0         0 my ( $handle, $amount, @labelvalues ) = @_;
164 0         0 my $fh = $self->{__fh};
165              
166 0         0 my $key = $self->_key( $handle, undef, @labelvalues );
167 0         0 my $current = $metrics{$key} = $amount;
168              
169 0         0 printf $fh "METRIC GAUGE %s => %g\n",
170             $key, $current;
171             }
172              
173 1     1 0 3 sub make_timer { shift->_make( timer => @_ ) }
174              
175             sub report_timer
176             {
177 2     2 0 3 my $self = shift;
178 2         5 my ( $handle, $duration, @labelvalues ) = @_;
179 2         3 my $fh = $self->{__fh};
180              
181 2         6 my $count = $metrics{ $self->_key( $handle, "_count", @labelvalues ) } += 1;
182 2         6 my $total = $metrics{ $self->_key( $handle, "_total", @labelvalues ) } += $duration;
183              
184 2         6 printf $fh "METRIC TIMER %s +%.3g => %.3g/%d [avg=%g]\n",
185             $self->_key( $handle, undef, @labelvalues ), $duration, $total, $count, $total/$count;
186             }
187              
188             =head1 AUTHOR
189              
190             Paul Evans
191              
192             =cut
193              
194             0x55AA;