File Coverage

blib/lib/Starch/Plugin/TimeoutStore.pm

Criterion	Covered	Total	%
statement	18	18	100.0
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	24	24	100.0

package Starch::Plugin::TimeoutStore;

$Starch::Plugin::TimeoutStore::VERSION = '0.07';

=head1 NAME

Starch::Plugin::TimeoutStore - Throw an exception if store access surpass a timeout.

=head1 SYNOPSIS

    my $starch = Starch->new(
        plugins => ['::TimeoutStore'],
        store => {
            class => '::Memory',
            timeout => 0.1, # 1/10th of a second
        },
        ...,
    );

=head1 DESCRIPTION

This plugin causes all calls to C, C, and C to throw
an exception if they surpass a timeout period.

The timeout is implemented using L.

Note that some stores implement timeouts themselves and their native
may be better than this naive implementation.

The whole point of detecting timeouts is so that you can still serve
a web page even if the underlying store backend is failing, so
using this plugin with L is
probably a good idea.

=cut

use Types::Common::Numeric -types;
use Starch::Util qw( croak );
use Sys::SigAction qw( timeout_call );

use Moo::Role;
use strictures 2;
use namespace::clean;

with qw(
    Starch::Plugin::ForStore
);

=head1 OPTIONAL STORE ARGUMENTS

These arguments are added to classes which consume the
L role.

=head2 timeout

How many seconds to timeout.  Fractional seconds may be passed, but
may not be supported on all systems (see L).
Set to C<0> to disable timeout checking.  Defaults to C<0>.

=cut

has timeout => (
    is      => 'ro',
    isa     => PositiveOrZeroNum,
    default => 0,
);

foreach my $method (qw( set get remove )) {
    around $method => sub{
        my $orig = shift;
        my $self = shift;

        local $Carp::Internal{ (__PACKAGE__) } = 1;

        my $timeout = $self->timeout();
        return $self->$orig( @_ ) if $timeout == 0;

        my @args = @_;
        my $data;

        if ( timeout_call( $timeout, sub{
            $data = $self->$orig( @args );
        }) ) {
            croak sprintf(
                'The %s method %s exceeded the timeout of %s seconds',
                $self->short_class_name(), $method, $timeout,
            );
        }

        return $data if $method eq 'get';
        return;
    };
}

1;
__END__