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