File Coverage

blib/lib/Log/Timer.pm

Criterion	Covered	Total	%
statement	61	61	100.0
branch	6	8	75.0
condition	13	17	76.4
subroutine	14	14	100.0
pod	4	4	100.0
total	98	104	94.2

package Log::Timer;

use strict;
use warnings;
use Exporter 'import';
our $VERSION = '1.0.1'; # VERSION
# ABSTRACT: track nested timing information


our @EXPORT = our @EXPORT_OK = qw/ timer subroutine_timer /;

use Guard::Timer;
use List::AllUtils qw/ max /;
use Statistics::Descriptive;
use Log::Any qw/ $log /;


my $name__context = {
    "" => {
        indent => 1,
    },
};
my $message_stats = {};


sub timer {
    my ($message, $options) = @_;
    $options //= {};

    my $log_prefix = $options->{prefix} // "";

    # If you run async code, you need to distinguish the context this
    # is running in. Human readable.
    my $context_name = $options->{context} //= "";

    # Create context at the same level we're at, assuming we're always
    # branching off the default "process wide" context
    my $context = $name__context->{ $context_name } //= {
        start_indent => $name__context->{ "" }->{indent},
        %{ $name__context->{ "" } },
    };

    my $indent_increase = $options->{indent_increase} // 4;

    $context->{indent} += $indent_increase;

    my $context_prefix = $context_name eq ""
        ? ""
        : "$context_name: ";

    return timer_guard(
        sub {
            my $duration = shift;
            _collect_timing($message, $duration);

            # Un-nest indentation level
            my $indent = $context->{indent} -= $indent_increase;

            my $indentation = " " x max(1, $indent);
            $log->trace("${log_prefix}duration($duration)$indentation$context_prefix$message");

            # Clean up context if we're done with it
            if(my $start_indent = $context->{start_indent}) {
                if( $indent == $start_indent ) {
                    delete $name__context->{ $context_name };
                }
            }
        },
        4, # decimal points
    );
}


sub subroutine_timer {
    my ($message, $options) = @_;
    $options //= {};

    my $depth = $options->{depth} || 1;
    my (undef, undef, undef, $subroutine) = caller($depth);
    $subroutine =~ s/::(\w+)$/->$1/;
    $message = defined($message) ? ": $message" : "";

    return timer( "$subroutine$message", $options );
}

sub _collect_timing {
    my ($message, $duration) = @_;
    my $stats = $message_stats->{$message} ||= Statistics::Descriptive::Sparse->new();
    $stats->add_data($duration);
}


sub report_timing_stats {
    my @what = ( "mean", "sum", "min", "max", "standard_deviation" );

    my @messages =
        map  { $_->{message} }
        reverse
        sort { $a->{order} <=> $b->{order} }
        map  {
            my $stats = $message_stats->{$_};
            +{
                message => "Stats: "
                    . sprintf("%-12s", "count(" . $stats->count . "), ")
                    . join(
                        ", ",
                        map { sprintf("$_(%.3f)", ($stats->$_)) } @what
                    ) . " for ($_)",
                order => $stats->sum,
            };
        }
        keys %$message_stats;

    for my $message (@messages) {
        $log->info($message);
    }

    clear_timing_stats();
}


sub clear_timing_stats {
    $message_stats = {};
}

END {
    report_timing_stats();
}

1;

__END__