File Coverage

blib/lib/CHI/Stats.pm

Criterion	Covered	Total	%
statement	18	102	17.6
branch	0	22	0.0
condition	0	10	0.0
subroutine	6	16	37.5
pod	4	8	50.0
total	28	158	17.7

package CHI::Stats;
$CHI::Stats::VERSION = '0.59';
use CHI::Util qw(json_encode json_decode);
use List::Util qw(sum);
use Log::Any qw($log);
use Moo;
use strict;
use warnings;

has 'chi_root_class' => ( is => 'ro' );
has 'data'           => ( is => 'ro', default => sub { {} } );
has 'enabled'        => ( is => 'rwp', default => sub { 0 } );
has 'start_time'     => ( is => 'ro', default => sub { time } );

sub enable  { $_[0]->_set_enabled(1) }
sub disable { $_[0]->_set_enabled(0) }

sub flush {
    my ($self) = @_;

    my $data = $self->data;
    foreach my $label ( sort keys %$data ) {
        my $label_stats = $data->{$label};
        foreach my $namespace ( sort keys(%$label_stats) ) {
            my $namespace_stats = $label_stats->{$namespace};
            if (%$namespace_stats) {
                $self->log_namespace_stats( $label, $namespace,
                    $namespace_stats );
            }
        }
    }
    $self->clear();
}

sub log_namespace_stats {
    my ( $self, $label, $namespace, $namespace_stats ) = @_;

    my %data = (
        label      => $label,
        end_time   => time(),
        namespace  => $namespace,
        root_class => $self->chi_root_class,
        %$namespace_stats
    );
    %data =
      map { /_ms$/ ? ( $_, int( $data{$_} ) ) : ( $_, $data{$_} ) }
      keys(%data);
    $log->infof( 'CHI stats: %s', json_encode( \%data ) );
}

sub format_time {
    my ($time) = @_;

    my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
      localtime($time);
    return sprintf(
        "%04d%02d%02d:%02d:%02d:%02d",
        $year + 1900,
        $mon + 1, $mday, $hour, $min, $sec
    );
}

sub stats_for_driver {
    my ( $self, $cache ) = @_;

    my $stats =
      ( $self->data->{ $cache->label }->{ $cache->namespace } ||= {} );
    $stats->{start_time} ||= time;
    return $stats;
}

sub parse_stats_logs {
    my $self = shift;
    my ( %results_hash, @results, %numeric_fields_seen );
    foreach my $log_file (@_) {
        my $logfh;
        if ( ref($log_file) ) {
            $logfh = $log_file;
        }
        else {
            open( $logfh, '<', $log_file ) or die "cannot open $log_file: $!";
            $log->infof( "processing '%s'", $log_file );
        }
        while ( my $line = <$logfh> ) {
            chomp($line);
            if ( my ($json) = ( $line =~ /CHI stats: (\{.*\})$/ ) ) {
                my %hash       = %{ json_decode($json) };
                my $root_class = delete( $hash{root_class} );
                my $namespace  = delete( $hash{namespace} );
                my $label      = delete( $hash{label} );
                my $results_set =
                  ( $results_hash{$root_class}->{$label}->{$namespace} ||= {} );
                if ( !%$results_set ) {
                    $results_set->{root_class} = $root_class;
                    $results_set->{namespace}  = $namespace;
                    $results_set->{label}      = $label;
                    push( @results, $results_set );
                }
                while ( my ( $key, $value ) = each(%hash) ) {
                    next if $key =~ /_time$/;
                    $results_set->{$key} += $value;
                    $numeric_fields_seen{$key}++;
                }
            }
        }
    }
    my @numeric_fields = sort( keys(%numeric_fields_seen) );

    my $sum = sub {
        my ( $rs, $name, @fields ) = @_;
        if ( grep { $rs->{$_} } @fields ) {
            $rs->{$name} = sum( map { $rs->{$_} || 0 } @fields );
        }
    };
    foreach my $rs (@results) {
        $sum->( $rs, 'misses', 'absent_misses', 'expired_misses' );
        $sum->( $rs, 'gets',   'hits',          'misses' );
    }

    my %totals = map { ( $_, 'TOTALS' ) } qw(root_class namespace label);
    foreach my $field (@numeric_fields) {
        $totals{$field} = sum( map { $_->{$field} || 0 } @results );
    }
    push( @results, \%totals );

    my $divide = sub {
        my ( $rs, $name, $top, $bottom ) = @_;
        if ( $rs->{$top} && $rs->{$bottom} ) {
            $rs->{$name} = ( $rs->{$top} / $rs->{$bottom} );
        }
    };

    foreach my $rs (@results) {
        $divide->( $rs, 'avg_compute_time_ms', 'compute_time_ms', 'computes' );
        $divide->( $rs, 'avg_get_time_ms',     'get_time_ms',     'gets' );
        $divide->( $rs, 'avg_set_time_ms',     'set_time_ms',     'sets' );
        $divide->( $rs, 'avg_set_key_size',    'set_key_size',    'sets' );
        $divide->( $rs, 'avg_set_value_size',  'set_value_size',  'sets' );
        $divide->( $rs, 'hit_rate',            'hits',            'gets' );
    }
    return \@results;
}

sub clear {
    my ($self) = @_;

    my $data = $self->data;
    foreach my $key ( keys %{$data} ) {
        %{ $data->{$key} } = ();
    }
    $self->{start_time} = time;
}

1;

__END__