1package CHI::Stats;
2$CHI::Stats::VERSION = '0.60';
3use CHI::Util qw(json_encode json_decode);
4use List::Util qw(sum);
5use Log::Any qw($log);
6use Moo;
7use strict;
8use warnings;
9
10has 'chi_root_class' => ( is => 'ro' );
11has 'data'           => ( is => 'ro', default => sub { {} } );
12has 'enabled'        => ( is => 'rwp', default => sub { 0 } );
13has 'start_time'     => ( is => 'ro', default => sub { time } );
14
15sub enable  { $_[0]->_set_enabled(1) }
16sub disable { $_[0]->_set_enabled(0) }
17
18sub flush {
19    my ($self) = @_;
20
21    my $data = $self->data;
22    foreach my $label ( sort keys %$data ) {
23        my $label_stats = $data->{$label};
24        foreach my $namespace ( sort keys(%$label_stats) ) {
25            my $namespace_stats = $label_stats->{$namespace};
26            if (%$namespace_stats) {
27                $self->log_namespace_stats( $label, $namespace,
28                    $namespace_stats );
29            }
30        }
31    }
32    $self->clear();
33}
34
35sub log_namespace_stats {
36    my ( $self, $label, $namespace, $namespace_stats ) = @_;
37
38    my %data = (
39        label      => $label,
40        end_time   => time(),
41        namespace  => $namespace,
42        root_class => $self->chi_root_class,
43        %$namespace_stats
44    );
45    %data =
46      map { /_ms$/ ? ( $_, int( $data{$_} ) ) : ( $_, $data{$_} ) }
47      keys(%data);
48    $log->infof( 'CHI stats: %s', json_encode( \%data ) );
49}
50
51sub format_time {
52    my ($time) = @_;
53
54    my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
55      localtime($time);
56    return sprintf(
57        "%04d%02d%02d:%02d:%02d:%02d",
58        $year + 1900,
59        $mon + 1, $mday, $hour, $min, $sec
60    );
61}
62
63sub stats_for_driver {
64    my ( $self, $cache ) = @_;
65
66    my $stats =
67      ( $self->data->{ $cache->label }->{ $cache->namespace } ||= {} );
68    $stats->{start_time} ||= time;
69    return $stats;
70}
71
72sub parse_stats_logs {
73    my $self = shift;
74    my ( %results_hash, @results, %numeric_fields_seen );
75    foreach my $log_file (@_) {
76        my $logfh;
77        if ( ref($log_file) ) {
78            $logfh = $log_file;
79        }
80        else {
81            open( $logfh, '<', $log_file ) or die "cannot open $log_file: $!";
82            $log->infof( "processing '%s'", $log_file );
83        }
84        while ( my $line = <$logfh> ) {
85            chomp($line);
86            if ( my ($json) = ( $line =~ /CHI stats: (\{.*\})$/ ) ) {
87                my %hash       = %{ json_decode($json) };
88                my $root_class = delete( $hash{root_class} );
89                my $namespace  = delete( $hash{namespace} );
90                my $label      = delete( $hash{label} );
91                my $results_set =
92                  ( $results_hash{$root_class}->{$label}->{$namespace} ||= {} );
93                if ( !%$results_set ) {
94                    $results_set->{root_class} = $root_class;
95                    $results_set->{namespace}  = $namespace;
96                    $results_set->{label}      = $label;
97                    push( @results, $results_set );
98                }
99                while ( my ( $key, $value ) = each(%hash) ) {
100                    next if $key =~ /_time$/;
101                    $results_set->{$key} += $value;
102                    $numeric_fields_seen{$key}++;
103                }
104            }
105        }
106    }
107    my @numeric_fields = sort( keys(%numeric_fields_seen) );
108
109    my $sum = sub {
110        my ( $rs, $name, @fields ) = @_;
111        if ( grep { $rs->{$_} } @fields ) {
112            $rs->{$name} = sum( map { $rs->{$_} || 0 } @fields );
113        }
114    };
115    foreach my $rs (@results) {
116        $sum->( $rs, 'misses', 'absent_misses', 'expired_misses' );
117        $sum->( $rs, 'gets',   'hits',          'misses' );
118    }
119
120    my %totals = map { ( $_, 'TOTALS' ) } qw(root_class namespace label);
121    foreach my $field (@numeric_fields) {
122        $totals{$field} = sum( map { $_->{$field} || 0 } @results );
123    }
124    push( @results, \%totals );
125
126    my $divide = sub {
127        my ( $rs, $name, $top, $bottom ) = @_;
128        if ( $rs->{$top} && $rs->{$bottom} ) {
129            $rs->{$name} = ( $rs->{$top} / $rs->{$bottom} );
130        }
131    };
132
133    foreach my $rs (@results) {
134        $divide->( $rs, 'avg_compute_time_ms', 'compute_time_ms', 'computes' );
135        $divide->( $rs, 'avg_get_time_ms',     'get_time_ms',     'gets' );
136        $divide->( $rs, 'avg_set_time_ms',     'set_time_ms',     'sets' );
137        $divide->( $rs, 'avg_set_key_size',    'set_key_size',    'sets' );
138        $divide->( $rs, 'avg_set_value_size',  'set_value_size',  'sets' );
139        $divide->( $rs, 'hit_rate',            'hits',            'gets' );
140    }
141    return \@results;
142}
143
144sub clear {
145    my ($self) = @_;
146
147    my $data = $self->data;
148    foreach my $key ( keys %{$data} ) {
149        %{ $data->{$key} } = ();
150    }
151    $self->{start_time} = time;
152}
153
1541;
155
156__END__
157
158=pod
159
160=head1 NAME
161
162CHI::Stats - Record and report per-namespace cache statistics
163
164=head1 VERSION
165
166version 0.60
167
168=head1 SYNOPSIS
169
170    # Turn on statistics collection
171    CHI->stats->enable();
172
173    # Perform cache operations
174
175    # Flush statistics to logs
176    CHI->stats->flush();
177
178    ...
179
180    # Parse logged statistics
181    my $results = CHI->stats->parse_stats_logs($file1, ...);
182
183=head1 DESCRIPTION
184
185CHI can record statistics, such as number of hits, misses and sets, on a
186per-namespace basis and log the results to your L<Log::Any|Log::Any> logger.
187You can then parse the logs to get a combined summary.
188
189A single CHI::Stats object is maintained for each CHI root class, and tallies
190statistics over any number of CHI::Driver objects.
191
192Statistics are reported when you call the L</flush> method. You can choose to
193do this once at process end, or on a periodic basis.
194
195=head1 METHODS
196
197=over
198
199=item enable, disable, enabled
200
201Enable, disable, and query the current enabled status.
202
203When stats are enabled, each new cache object will collect statistics. Enabling
204and disabling does not affect existing cache objects. e.g.
205
206    my $cache1 = CHI->new(...);
207    CHI->stats->enable();
208    # $cache1 will not collect statistics
209    my $cache2 = CHI->new(...);
210    CHI->stats->disable();
211    # $cache2 will continue to collect statistics
212
213=item flush
214
215Log all statistics to L<Log::Any|Log::Any> (at Info level in the CHI::Stats
216category), then clear statistics from memory. There is one log message for each
217distinct triplet of L<root class|CHI/chi_root_class>, L<cache label|CHI/label>,
218and L<namespace|CHI/namespace>. Each log message contains the string "CHI
219stats:" followed by a JSON encoded hash of statistics. e.g.
220
221    CHI stats: {"absent_misses":1,"label":"File","end_time":1338410398,
222       "get_time_ms":5,"namespace":"Foo","root_class":"CHI",
223       "set_key_size":6,"set_time_ms":23,"set_value_size":20,"sets":1,
224       "start_time":1338409391}
225
226=item parse_stats_logs
227
228Accepts one or more stats log files as parameters. Parses the logs and returns
229a listref of stats hashes by root class, cache label, and namespace. e.g.
230
231    [
232        {
233            root_class     => 'CHI',
234            label          => 'File',
235            namespace      => 'Foo',
236            absent_misses  => 100,
237            avg_compute_time_ms => 23,
238            ...
239        },
240        {
241            root_class     => 'CHI',
242            label          => 'File',
243            namespace      => 'Bar',
244            ...
245        },
246    ]
247
248Lines with the same root class, cache label, and namespace are summed together.
249Non-stats lines are ignored. The parser will ignore anything on the line before
250the "CHI stats:" string, e.g. a timestamp.
251
252Each parameter to this method may be a filename or a reference to an open
253filehandle.
254
255=back
256
257=head1 STATISTICS
258
259The following statistics are tracked in the logs:
260
261=over
262
263=item *
264
265C<absent_misses> - Number of gets that failed due to item not being in the
266cache
267
268=item *
269
270C<compute_time_ms> - Total time spent computing missed results in
271L<compute|CHI/compute>, in ms (divide by number of computes to get average).
272i.e. the amount of time spent in the code reference passed as the third
273argument to compute().
274
275=item *
276
277C<computes> - Number of L<compute|CHI/compute> calls
278
279=item *
280
281C<expired_misses> - Number of gets that failed due to item expiring
282
283=item *
284
285C<get_errors> - Number of caught runtime errors during gets
286
287=item *
288
289C<get_time_ms> - Total time spent in get operation, in ms (divide by number of
290gets to get average)
291
292=item *
293
294C<hits> - Number of gets that succeeded
295
296=item *
297
298C<set_key_size> - Number of bytes in set keys (divide by number of sets to get
299average)
300
301=item *
302
303C<set_value_size> - Number of bytes in set values (divide by number of sets to
304get average)
305
306=item *
307
308C<set_time_ms> - Total time spent in set operation, in ms (divide by number of
309sets to get average)
310
311=item *
312
313C<sets> - Number of sets
314
315=item *
316
317C<set_errors> - Number of caught runtime errors during sets
318
319=back
320
321The following additional derived/aggregate statistics are computed by
322L<parse_stats_logs|/parse_stats_logs>:
323
324=over
325
326=item *
327
328C<misses> - C<absent_misses> + C<expired_misses>
329
330=item *
331
332C<gets> - C<hits> + C<misses>
333
334=item *
335
336C<avg_compute_time_ms> - C<compute_time_ms> / C<computes>
337
338=item *
339
340C<avg_get_time_ms> - C<get_time_ms> / C<gets>
341
342=item *
343
344C<avg_set_time_ms> - C<set_time_ms> / C<sets>
345
346=item *
347
348C<avg_set_key_size> - C<set_key_size> / C<sets>
349
350=item *
351
352C<avg_set_value_size> - C<set_value_size> / C<sets>
353
354=item *
355
356C<hit_rate> - C<hits> / C<gets>
357
358=back
359
360=head1 SEE ALSO
361
362L<CHI|CHI>
363
364=head1 AUTHOR
365
366Jonathan Swartz <swartz@pobox.com>
367
368=head1 COPYRIGHT AND LICENSE
369
370This software is copyright (c) 2012 by Jonathan Swartz.
371
372This is free software; you can redistribute it and/or modify it under
373the same terms as the Perl 5 programming language system itself.
374
375=cut
376