File Coverage

blib/lib/Loop/Sustainable.pm

Criterion	Covered	Total	%
statement	18	53	33.9
branch	0	12	0.0
condition	0	2	0.0
subroutine	6	8	75.0
pod	1	1	100.0
total	25	76	32.8

package Loop::Sustainable;

use strict;
use warnings;

use Carp;
use Exporter qw(import);
use Class::Load qw(load_class);
use Time::HiRes qw(tv_interval gettimeofday);

our $VERSION = '0.02';
our @EXPORT  = qw(loop_sustainable);

sub loop_sustainable (&&;$) {
    my ( $cb, $terminator, $args ) = @_;

    $args ||= +{};
    %$args = (
        wait_interval => 0.1,
        check_strategy_interval => 10,
        strategy => +{
            class => 'ByLoad',
            args  => +{ load => 0.5 },
        },
        %$args,
    );

    my $strategy_cb;

    if ( ref $args->{strategy} eq 'HASH' ) {
        my ( $strategy_class ) = index($args->{strategy}{class}, '+') == 1 ?
            substr($args->{strategy}{class}, 1) : 'Loop::Sustainable::Strategy::' . $args->{strategy}{class};

        load_class( $strategy_class );

        my $strategy = $strategy_class->new(
            check_strategy_interval => $args->{check_strategy_interval},
            %{$args->{strategy}{args}}
        );

        $strategy_cb = sub {
            my ( $execute_count, $time_sum, $rv ) = @_;
            $strategy->wait_correction( $execute_count, $time_sum, $rv );
        };
    }
    elsif ( ref $args->{strategy} eq 'CODE' ) {
        $strategy_cb = $args->{strategy};
    }
    else {
        croak 'Not supported strategy type. The strategy field must be hash reference or code reference.';
    }

    my $i               = 1;
    my $time_sum        = 0;
    my $time_total      = 0;
    my $wait_interval   = $args->{wait_interval};
    my $additional_wait = 0;

    for (;;) {
        my $t0      = [ Time::HiRes::gettimeofday ];
        my @ret = $cb->( $i, $wait_interval );
        my $elapsed = Time::HiRes::tv_interval( $t0, [ Time::HiRes::gettimeofday ] );

        $time_sum   += $elapsed;
        $time_total += $elapsed;

        if ( $terminator->( $i, $time_sum, \@ret ) ) {
            last;
        }

        Time::HiRes::sleep($wait_interval);

        if ( $i % $args->{check_strategy_interval} == 0 ) {
            $additional_wait = $strategy_cb->( $i, $time_sum, \@ret );
            $wait_interval   = $args->{wait_interval} + $additional_wait;
            $time_sum        = 0;
        }

        $i++;
    }

    my %result = (
        executed => $i,
        total_time => $time_total
    );

    return wantarray ? %result : \%result;
}

1;
__END__