File Coverage

lib/AnyEvent/Tools.pm

Criterion	Covered	Total	%
statement	114	123	92.6
branch	23	34	67.6
condition	6	12	50.0
subroutine	32	33	96.9
pod	7	8	87.5
total	182	210	86.6

package AnyEvent::Tools;

use 5.010001;
use strict;
use warnings;
use Carp;

require Exporter;
use AnyEvent::Util;
use AnyEvent::AggressiveIdle 0.04, qw(aggressive_idle stop_aggressive_idle);

our @ISA = qw(Exporter);

our %EXPORT_TAGS = (
    all => [
            qw(
                    mutex rw_mutex
                    async_for async_repeat
                    async_rfor async_foreach
                    pool buffer
            )
    ],
    mutex   => [ qw( mutex rw_mutex ) ],
    foreach => [ qw( async_for async_rfor async_repeat )   ],
    pool    => [ qw( pool buffer ) ],


);

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw();

our $VERSION = '0.12';

sub pool(@)
{
    require AnyEvent::Tools::Pool;

    no strict 'refs';
    no warnings 'redefine';
    *{ __PACKAGE__ . "::pool" } = sub (@) {
        return AnyEvent::Tools::Pool->new(@_);
    };

    goto &pool;
}


sub buffer(@)
{
    require AnyEvent::Tools::Buffer;
    no warnings 'redefine';
    no strict 'refs';
    *{ __PACKAGE__ . "::buffer" } = sub (@) {
        return new AnyEvent::Tools::Buffer(@_);
    };

    goto &buffer;
}

sub mutex()
{
    require AnyEvent::Tools::Mutex;

    no strict 'refs';
    no warnings 'redefine';
    *{ __PACKAGE__ . "::mutex" } = sub () {
        return AnyEvent::Tools::Mutex->new;
    };

    goto &mutex;
}

sub rw_mutex()
{
    require AnyEvent::Tools::RWMutex;

    no strict 'refs';
    no warnings 'redefine';
    *{ __PACKAGE__ . "::rw_mutex" } = sub () {
        return AnyEvent::Tools::RWMutex->new;
    };

    goto &rw_mutex;
}

sub _async_repeati($$&;&);
sub async_repeat($&;&) {
    my ($count, $cb, $cbe) = @_;

    if (!$count) {
        $cbe->() if $cbe;
        return;
    }
    return &_async_repeati(0, $count, $cb, $cbe);
}

sub async_for($&;&) {
    my ($obj, $cb, $cbe) = @_;
    if ('ARRAY' eq ref $obj or "$obj" =~ /=ARRAY\(/) {
        unless (@$obj) {
            $cbe->() if $cbe;
            return;
        }
        return &async_repeat(
            scalar(@$obj),
            sub {
                my ($g, $index, $first, $last) = @_;
                $cb->($g, $obj->[$index], $index, $first, $last);
            },
            $cbe
        );
    }

    if ('HASH' eq ref $obj or "$obj" =~ /=HASH\(/) {
        unless (%$obj) {
            $cbe->() if $cbe;
            return;
        }

        my @keys = keys %$obj;
        return &async_repeat(
            scalar(@keys),
            sub {
                my ($g, $index, $first, $last) = @_;
                $cb->($g, $keys[$index], $obj->{$keys[$index]}, $first, $last);
            },
            $cbe
        );
    }

    croak "Usage: async_for ARRAYREF|HASHREF, callback [, end_callback ]";
}


sub async_foreach($&;&) { goto &async_for; }


sub async_rfor($&;&) {
    my ($obj, $cb, $cbe) = @_;
    if ('ARRAY' eq ref $obj or "$obj" =~ /=ARRAY\(/) {
        unless (@$obj) {
            $cbe->() if $cbe;
            return;
        }
        return &async_repeat(
            scalar(@$obj),
            sub {
                my ($g, $index, $first, $last) = @_;
                $cb->(
                    $g,
                    $obj->[$#$obj - $index],
                    $#$obj - $index,
                    $first,
                    $last
                );
            },
            $cbe
        );
    }

    if ('HASH' eq ref $obj or "$obj" =~ /=HASH\(/) {
        unless (%$obj) {
            $cbe->() if $cbe;
            return;
        }

        my @keys = keys %$obj;
        return &async_repeat(
            scalar(@keys),
            sub {
                my ($g, $index, $first, $last) = @_;
                $cb->(
                    $g,
                    $keys[$#keys - $index],
                    $obj->{$keys[$#keys - $index]},
                    $first,
                    $last
                );
            },
            $cbe
        );
    }

    croak "Usage: async_for ARRAYREF|HASHREF, callback [, end_callback ]";
}

sub _async_repeati($$&;&) {
    my ($start, $count, $cb, $cbe) = @_;

    my $idle;
    my $wantarray = wantarray;
    $idle = aggressive_idle sub {

        my (undef, $guard) = @_;
        my $first = $start == 0;
        my $last  = $start >= $count - 1;

        if ($start >= $count) {
            $cbe->() if $cbe;
            undef $idle;
            undef $cb;
            undef $cbe;
            undef $guard;
            return;
        }

        $cb->($guard, $start, $first, $last);
        $start++;
    };

    return unless defined $wantarray;
    return guard { undef $cbe; undef $cb; undef $idle; };
}

1;
__END__