File Coverage

blib/lib/CHI/Stats.pm
Criterion Covered Total %
statement 44 102 43.1
branch 3 22 13.6
condition 4 10 40.0
subroutine 11 16 68.7
pod 4 8 50.0
total 66 158 41.7


line stmt bran cond sub pod time code
1             package CHI::Stats;
2             $CHI::Stats::VERSION = '0.61';
3 21     21   8423 use CHI::Util qw(json_encode json_decode);
  21         61  
  21         1525  
4 21     21   148 use List::Util qw(sum);
  21         41  
  21         2156  
5 21     21   10748 use Log::Any qw($log);
  21         181867  
  21         107  
6 21     21   1335711 use Moo;
  21         187015  
  21         196  
7 21     21   34537 use strict;
  21         54  
  21         419  
8 21     21   100 use warnings;
  21         46  
  21         27050  
9              
10             has 'chi_root_class' => ( is => 'ro' );
11             has 'data' => ( is => 'ro', default => sub { {} } );
12             has 'enabled' => ( is => 'rwp', default => sub { 0 } );
13             has 'start_time' => ( is => 'ro', default => sub { time } );
14              
15 1     1 1 7 sub enable { $_[0]->_set_enabled(1) }
16 0     0 1 0 sub disable { $_[0]->_set_enabled(0) }
17              
18             sub flush {
19 1     1 1 2 my ($self) = @_;
20              
21 1         4 my $data = $self->data;
22 1         7 foreach my $label ( sort keys %$data ) {
23 2         94 my $label_stats = $data->{$label};
24 2         7 foreach my $namespace ( sort keys(%$label_stats) ) {
25 2         5 my $namespace_stats = $label_stats->{$namespace};
26 2 50       6 if (%$namespace_stats) {
27 2         7 $self->log_namespace_stats( $label, $namespace,
28             $namespace_stats );
29             }
30             }
31             }
32 1         70 $self->clear();
33             }
34              
35             sub log_namespace_stats {
36 2     2 0 6 my ( $self, $label, $namespace, $namespace_stats ) = @_;
37              
38 2         20 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 2 100       10 map { /_ms$/ ? ( $_, int( $data{$_} ) ) : ( $_, $data{$_} ) }
  23         64  
47             keys(%data);
48 2         12 $log->infof( 'CHI stats: %s', json_encode( \%data ) );
49             }
50              
51             sub format_time {
52 0     0 0 0 my ($time) = @_;
53              
54 0         0 my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
55             localtime($time);
56 0         0 return sprintf(
57             "%04d%02d%02d:%02d:%02d:%02d",
58             $year + 1900,
59             $mon + 1, $mday, $hour, $min, $sec
60             );
61             }
62              
63             sub stats_for_driver {
64 6     6 0 13 my ( $self, $cache ) = @_;
65              
66             my $stats =
67 6   100     114 ( $self->data->{ $cache->label }->{ $cache->namespace } ||= {} );
68 6   66     54 $stats->{start_time} ||= time;
69 6         14 return $stats;
70             }
71              
72             sub parse_stats_logs {
73 0     0 1 0 my $self = shift;
74 0         0 my ( %results_hash, @results, %numeric_fields_seen );
75 0         0 foreach my $log_file (@_) {
76 0         0 my $logfh;
77 0 0       0 if ( ref($log_file) ) {
78 0         0 $logfh = $log_file;
79             }
80             else {
81 0 0       0 open( $logfh, '<', $log_file ) or die "cannot open $log_file: $!";
82 0         0 $log->infof( "processing '%s'", $log_file );
83             }
84 0         0 while ( my $line = <$logfh> ) {
85 0         0 chomp($line);
86 0 0       0 if ( my ($json) = ( $line =~ /CHI stats: (\{.*\})$/ ) ) {
87 0         0 my %hash = %{ json_decode($json) };
  0         0  
88 0         0 my $root_class = delete( $hash{root_class} );
89 0         0 my $namespace = delete( $hash{namespace} );
90 0         0 my $label = delete( $hash{label} );
91             my $results_set =
92 0   0     0 ( $results_hash{$root_class}->{$label}->{$namespace} ||= {} );
93 0 0       0 if ( !%$results_set ) {
94 0         0 $results_set->{root_class} = $root_class;
95 0         0 $results_set->{namespace} = $namespace;
96 0         0 $results_set->{label} = $label;
97 0         0 push( @results, $results_set );
98             }
99 0         0 while ( my ( $key, $value ) = each(%hash) ) {
100 0 0       0 next if $key =~ /_time$/;
101 0         0 $results_set->{$key} += $value;
102 0         0 $numeric_fields_seen{$key}++;
103             }
104             }
105             }
106             }
107 0         0 my @numeric_fields = sort( keys(%numeric_fields_seen) );
108              
109             my $sum = sub {
110 0     0   0 my ( $rs, $name, @fields ) = @_;
111 0 0       0 if ( grep { $rs->{$_} } @fields ) {
  0         0  
112 0 0       0 $rs->{$name} = sum( map { $rs->{$_} || 0 } @fields );
  0         0  
113             }
114 0         0 };
115 0         0 foreach my $rs (@results) {
116 0         0 $sum->( $rs, 'misses', 'absent_misses', 'expired_misses' );
117 0         0 $sum->( $rs, 'gets', 'hits', 'misses' );
118             }
119              
120 0         0 my %totals = map { ( $_, 'TOTALS' ) } qw(root_class namespace label);
  0         0  
121 0         0 foreach my $field (@numeric_fields) {
122 0 0       0 $totals{$field} = sum( map { $_->{$field} || 0 } @results );
  0         0  
123             }
124 0         0 push( @results, \%totals );
125              
126             my $divide = sub {
127 0     0   0 my ( $rs, $name, $top, $bottom ) = @_;
128 0 0 0     0 if ( $rs->{$top} && $rs->{$bottom} ) {
129 0         0 $rs->{$name} = ( $rs->{$top} / $rs->{$bottom} );
130             }
131 0         0 };
132              
133 0         0 foreach my $rs (@results) {
134 0         0 $divide->( $rs, 'avg_compute_time_ms', 'compute_time_ms', 'computes' );
135 0         0 $divide->( $rs, 'avg_get_time_ms', 'get_time_ms', 'gets' );
136 0         0 $divide->( $rs, 'avg_set_time_ms', 'set_time_ms', 'sets' );
137 0         0 $divide->( $rs, 'avg_set_key_size', 'set_key_size', 'sets' );
138 0         0 $divide->( $rs, 'avg_set_value_size', 'set_value_size', 'sets' );
139 0         0 $divide->( $rs, 'hit_rate', 'hits', 'gets' );
140             }
141 0         0 return \@results;
142             }
143              
144             sub clear {
145 1     1 0 3 my ($self) = @_;
146              
147 1         4 my $data = $self->data;
148 1         3 foreach my $key ( keys %{$data} ) {
  1         4  
149 2         4 %{ $data->{$key} } = ();
  2         5  
150             }
151 1         4 $self->{start_time} = time;
152             }
153              
154             1;
155              
156             __END__