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