package Cache::Profile::CorrelateMissTiming;
# ABSTRACT: Guess the time to compute a cache miss by correlating C<set> and C<get>

our $VERSION = '0.06';

use Moose;
use Guard;
use Time::HiRes 1.84 qw(tv_interval clock gettimeofday);
use namespace::autoclean;

extends qw(Cache::Profile);

has _last_get_timing => (
    traits => [qw(Hash)],
    isa => "HashRef",
    is => "rw",
    handles => {
        _missed_key => "delete",
        _clear_missed => "clear",
    },
);

has _in_compute => (
    isa => "Bool",
    is  => "rw",
);

sub compute {
    my $self = shift;

    scope_guard {
        $self->_in_compute(0);
    };

    $self->_in_compute(1);

    $self->SUPER::compute(@_);
}

sub clear {
    my $self = shift;

    $self->_clear_missed;

    $self->SUPER::clear(@_);
}

sub _record_get {
    my ( $self, %args ) = @_;

    $self->SUPER::_record_get(%args);

    return if $self->_in_compute;

    my ( @keys, @ret );

    if ( $self->cache->isa("Cache::Ref") ) {
        # mget by default
        @keys = @{ $args{args} };
        @ret  = @{ $args{ret} };
    } else {
        @keys = ( $args{args}[0] );
        @ret  = ( $args{ret}[0] );
    }

    my %timing;
    my %data;
    for ( my $i = 0; $i < @keys; $i++ ) {
        my ( $key, $value ) = ( $keys[$i], $ret[$i] );

        unless ( defined $value ) {
            $data{$key} = \%timing,
        }
    }

    $self->_last_get_timing(\%data);

    $timing{start_r} = [gettimeofday];
    $timing{start_c} = clock;
}

sub _record_set {
    my ( $self, %args ) = @_;

    unless ( $self->_in_compute ) {
        my %pairs = @{ $args{args} };

        foreach my $key ( keys %pairs ) {
            if ( my $start_timing = $self->_missed_key($key) ) {
                my $set_timing = $args{timing};

                my %timing = (
                    start_c => $start_timing->{start_c},
                    end_c => $set_timing->{start_c},
                    time_c => $set_timing->{start_c} - $start_timing->{start_c},
                    start_r => $start_timing->{start_r},
                    end_r => $set_timing->{end_r},
                    time_r => tv_interval($start_timing->{start_r}, $set_timing->{end_r}),
                );

                $self->_record_miss(
                    %args,
                    counter => "miss",
                    timing => \%timing,
                );
            }
        }
    }

    $self->SUPER::_record_set(%args);
}

__PACKAGE__->meta->make_immutable;

__PACKAGE__;

=pod

=encoding UTF-8

=head1 NAME

Cache::Profile::CorrelateMissTiming - Guess the time to compute a cache miss by correlating C<set> and C<get>

=head1 VERSION

version 0.06

=head1 SYNOPSIS

    # see Cache::Profile

=head1 DESCRIPTION

This class will make a guess at the time it took to generate values, by saving
the time just before returning from a C<get> with a cache miss, until the
beginning of a C<set>.

This value is a guess and may be completely wrong.

It also fails to account for the overhead of profiling/delegating/etc, so it's
only really useful when the cost of a cache miss is more than a simple
computation.

Otherwise it works exactly like C<Cache::Profile>

=head1 SUPPORT

Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=Cache-Profile>
(or L<bug-Cache-Profile@rt.cpan.org|mailto:bug-Cache-Profile@rt.cpan.org>).

=head1 AUTHOR

יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>

=head1 COPYRIGHT AND LICENCE

This software is copyright (c) 2010 by יובל קוג'מן (Yuval Kogman).

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut

__END__


# ex: set sw=4 et: