File Coverage

blib/lib/Test/AnyEvent/Time.pm

Criterion	Covered	Total	%
statement	60	66	90.9
branch	16	18	88.8
condition	12	12	100.0
subroutine	12	12	100.0
pod	4	4	100.0
total	104	112	92.8

package Test::AnyEvent::Time;

use warnings;
use strict;

use base ('Exporter');

use AnyEvent;
use Scalar::Util qw(looks_like_number);
use Test::Builder;

our @EXPORT = qw(time_within_ok time_cmp_ok time_between_ok elapsed_time);

my $Tester = Test::Builder->new();


## ** borrowed from Test::Exception
sub import {
    my $self = shift;
    if( @_ ) {
        my $package = caller;
        $Tester->exported_to($package);
        $Tester->plan( @_ );
    }
    $self->export_to_level( 1, $self, $_ ) foreach @EXPORT;
}



=head1 NAME

Test::AnyEvent::Time - Time-related tests for asynchronous routines using AnyEvent

=head1 VERSION

Version 0.01

=cut

our $VERSION = '0.01';




sub elapsed_time {
    my ($cb, $timeout) = @_;
    if(!defined($cb)) {
        return undef;
    }
    if(ref($cb) ne 'CODE') {
        return undef;
    }
    my $cv = AE::cv;
    my $w;
    my $timed_out = 0;
    if(defined($timeout)) {
        $w = AE::timer $timeout, 0, sub {
            undef $w;
            $timed_out = 1;
            $cv->send();
        };
    }
    my $before = AE::now;
    $cb->($cv);
    $cv->recv();
    if($timed_out) {
        return -1;
    }
    return (AE::now - $before);
}

sub time_cmp_ok {
    my ($cb, $op, $cmp_time, $timeout, $desc) = @_;
    if(!defined($desc) && defined($timeout) && !looks_like_number($timeout)) {
        $desc = $timeout;
        $timeout = undef;
    }
    if(!defined($op) || !defined($cb) || !defined($cmp_time) || ref($cb) ne "CODE") {
        $Tester->ok(0, $desc);
        $Tester->diag("Invalid arguments.");
        return 0;
    }
    my $time = elapsed_time($cb, $timeout);
    if(!defined($time)) {
        $Tester->ok(0, $desc);
        $Tester->diag("Invalid arguments.");
        return 0;
    }elsif($time < 0) {
        $Tester->ok(0, $desc);
        $Tester->diag("Timeout ($timeout sec)");
        return 0;
    }else {
        return $Tester->cmp_ok($time, $op, $cmp_time, $desc);
    }
}

sub time_between_ok {
    my ($cb, $min_time, $max_time, $desc) = @_;
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    return time_cmp_ok($cb, '>', $min_time, $max_time, $desc);
}

sub time_within_ok {
    my ($cb, $time, $desc) = @_;
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    return time_cmp_ok($cb, '<', $time, $time, $desc);
}

1;

__END__