libanyevent-tools-perl-0.12/0000755000000000000000000000000011533510617014552 5ustar rootrootlibanyevent-tools-perl-0.12/README0000644000000000000000000000224511522456146015441 0ustar rootrootAnyEvent-Tools version 0.01 =========================== The README is used to introduce the module and provide instructions on how to install the module, any machine dependencies it may have (for example C compilers and installed libraries) and any other information that should be provided before the module is installed. A README file is required for CPAN modules since CPAN extracts the README file from a module distribution so that people browsing the archive can use it get an idea of the modules uses. It is usually a good idea to provide version information here so that people can decide whether fixes for the module are worth downloading. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES This module requires these other modules and libraries: blah blah blah COPYRIGHT AND LICENCE Put the correct copyright and licence information here. Copyright (C) 2011 by Dmitry E. Oboukhov This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.10.1 or, at your option, any later version of Perl 5 you may have available. libanyevent-tools-perl-0.12/Makefile.PL0000644000000000000000000000167211533404272016531 0ustar rootrootuse 5.010001; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( NAME => 'AnyEvent::Tools', VERSION_FROM => 'lib/AnyEvent/Tools.pm', # finds $VERSION PREREQ_PM => { AnyEvent => '0', 'AnyEvent::AggressiveIdle' => '0.04', }, # e.g., Module::Name => 1.1 ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT_FROM => 'lib/AnyEvent/Tools.pm', # retrieve abstract from module AUTHOR => 'Dmitry E. Oboukhov ') : ()), LIBS => [''], # e.g., '-lm' DEFINE => '', # e.g., '-DHAVE_SOMETHING' INC => '-I.', # e.g., '-I. -I/usr/include/other' # Un-comment this if you add C files to link with later: # OBJECT => '$(O_FILES)', # link all the C files too ); libanyevent-tools-perl-0.12/t/0000775000000000000000000000000011533152651015017 5ustar rootrootlibanyevent-tools-perl-0.12/t/07_buffer.t0000644000000000000000000000721211533150047016760 0ustar rootroot#!/usr/bin/perl use warnings; use strict; use utf8; use open qw(:std :utf8); use lib qw(lib ../lib); use Test::More tests => 25; use Encode qw(decode encode); use Time::HiRes qw(time); use AnyEvent; BEGIN { # Подготовка объекта тестирования для работы с utf8 my $builder = Test::More->builder; binmode $builder->output, ":utf8"; binmode $builder->failure_output, ":utf8"; binmode $builder->todo_output, ":utf8"; use_ok 'AnyEvent::AggressiveIdle', 'aggressive_idle'; use_ok 'AnyEvent::Tools', 'buffer'; } { my @res; my $cv = condvar AnyEvent; my $number = 1; my $b = buffer size => 5, on_flush => sub { my ($g, $a) = @_; push @res, $a; }; my $idle; $idle = aggressive_idle sub { $b->push($number++); if ($number > 100) { $b->flush; undef $idle; $cv->send; } }; $cv->recv; ok @res == grep({@$_ == 5} @res), "Flush buffer after overflow"; } { my @res; my $cv = condvar AnyEvent; my $number = 1; my $count = 0; my $b; my $idle; $b = buffer size => 5, on_flush => sub { my ($g, $a) = @_; if ($count++ == 3) { my $timer; $timer = AE::timer 0.0005, 0 => sub { $b->unshift_back($a); undef $g; undef $timer; }; return; } push @res, $a; if (@res == 5) { undef $idle; $cv->send; } }; $idle = aggressive_idle sub { $b->push($number++); }; $cv->recv; ok @res == grep({@$_ >= 5} @res), "Flush buffer after overflow"; ok @{ $res[3] } > 5, "unshift_back works properly"; my $i = 1; my $ok; for (map { @$_ } @res) { $ok = $_ == $i++; last unless $ok; } # note explain [ $i, \@res ]; ok $ok, "Sequence order is right"; } { my @res; my $cv = condvar AnyEvent; my $number = 1; my $count = 0; my $start_time = time; my $idle; my $b = buffer interval => 0.2, on_flush => sub { my ($g, $a) = @_; push @res, { time => time, obj => $a }; return if $count++ < 3; undef $idle; $cv->send; }; $idle = aggressive_idle sub { $b->unshift($number++); }; $cv->recv; ok @res == 4, "Flush buffer after overflow"; my @time = (0.18, .38, .58, .78, .98); for my $i (0 .. 3) { my $delay = $res[$i]{time} - $start_time; my $count = @{ $res[$i]{obj} }; ok $delay >= $time[$i], "$i flush was in time (count: $count)"; ok $delay < $time[$i + 1], "$i flush was in time (count: $count)"; ok $count > 100, "A lot iterations were done"; my $ok; for (0 .. $#{ $res[$i]{obj} } - 1) { $ok = $res[$i]{obj}[$_] > $res[$i]{obj}[$_ + 1]; last unless $ok; } ok $ok, "$i sequence order is right (count: $count)"; } } { my @res; my $cv = condvar AnyEvent; my $idle; my $count = 0; my $b = buffer unique_cb => sub { $_[0][0] }, interval => 0.05, on_flush => sub { push @res, $_[1]; $count = 0; $cv->send if @res >= 100 }; $idle = aggressive_idle sub { $b->push([int rand 10, ++$count ]) }; $cv->recv; ok !grep({ @$_ > 10 } @res), "Unique elements were extract"; ok 10 < grep({ 0 < grep { $_->[1] > 10 } @$_ } @res), "A lot of pushes"; } libanyevent-tools-perl-0.12/t/01_mutex.t0000644000000000000000000000666111527011273016652 0ustar rootroot#!/usr/bin/perl use warnings; use strict; use utf8; use open qw(:std :utf8); use lib qw(lib ../lib); use Test::More tests => 9; use Encode qw(decode encode); use Time::HiRes qw(time); BEGIN { # Подготовка объекта тестирования для работы с utf8 my $builder = Test::More->builder; binmode $builder->output, ":utf8"; binmode $builder->failure_output, ":utf8"; binmode $builder->todo_output, ":utf8"; use_ok 'AnyEvent'; use_ok 'AnyEvent::Tools', ':mutex'; } { my $mutex = mutex; my ($counter, $total) = (0, 0); my $cv = condvar AnyEvent; my ($timer1, $timer2, $timer3); $timer1 = AE::timer 0, 0.2 => sub { $total++; if ($mutex->is_locked) { $counter++; } }; $timer2 = AE::timer 1, 0 => sub { $mutex->lock(sub { my ($g) = @_; undef $timer2; my $timer; $timer = AE::timer 2, 0 => sub { undef $g; undef $timer; }; }); return; }; $timer3 = AE::timer 5, 0 => sub { $cv->send; }; $cv->recv; ok $counter < 13 && $counter > 8, "Mutex was locked correct time ($counter/$total)"; } { my $cv = condvar AnyEvent; my $mutex = mutex; my $idle; my %res; $mutex->lock(sub { my $start_time = time; my $mutex_guard = shift; my $timer; $timer = AE::timer 0.1, 0 => sub { $res{1} = { start => $start_time, stop => time}; undef $timer; undef $mutex_guard; }; }); $mutex->lock(sub { my $start_time = time; my $mutex_guard = shift; my $timer; $timer = AE::timer 0.1, 0 => sub { $res{2} = { start => $start_time, stop => time}; undef $timer; undef $mutex_guard; }; }); $mutex->lock(sub { my $start_time = time; my $mutex_guard = shift; my $timer; $timer = AE::timer 0.1, 0 => sub { $res{3} = { start => $start_time, stop => time}; undef $timer; undef $mutex_guard; }; }); $idle = AE::timer 0, 0.05 => sub { return unless 3 == keys %res; undef $idle; $cv->send; }; $cv->recv; ok abs($res{1}{start} - $res{2}{start}) > 0.09, "First and second processes followed sequentially"; ok $res{1}{stop} < $res{2}{start}, "Second process was started after first had finished"; ok abs($res{2}{start} - $res{3}{start}) > 0.09, "Second and third processes followed sequentially"; ok $res{2}{stop} < $res{3}{start}, "Third process was started after second had finished"; } { my $cv = condvar AnyEvent; my $error; my $mutex = mutex; my $counter = 0; $mutex->lock(sub { my ($guard) = @_; my $timer; $timer = AE::timer .1, 0 => sub { undef $guard; undef $timer; $counter++; }; }); my $mguard = $mutex->lock(sub { $error = 1; }); $mutex->lock(sub { $counter++; }); my $timer; $timer = AE::timer .05, 0 => sub { undef $timer; undef $mguard; }; my $timer2 = AE::timer 0.5, 0 => sub { $cv->send; }; $cv->recv; ok !$error, "Cancel lock request"; ok $counter == 2, "All lock requests were handled"; } libanyevent-tools-perl-0.12/t/04_foreach_array.t0000644000000000000000000001014011523523172020305 0ustar rootroot#!/usr/bin/perl use warnings; use strict; use utf8; use open qw(:std :utf8); use lib qw(lib ../lib); use Test::More tests => 23; use Encode qw(decode encode); use Time::HiRes qw(time); BEGIN { # Подготовка объекта тестирования для работы с utf8 my $builder = Test::More->builder; binmode $builder->output, ":utf8"; binmode $builder->failure_output, ":utf8"; binmode $builder->todo_output, ":utf8"; use_ok 'AnyEvent'; use_ok 'AnyEvent::Tools', ':foreach'; } { my $cv = condvar AnyEvent; my $count = 0; async_for [], sub { $count++ }, sub { $cv->send }; $cv->recv; ok $count == 0, "async_for with empty array"; } { my $cv = condvar AnyEvent; my $count = 0; async_for [], sub { $count++ }; my $t = AE::timer 0.5, 0 => sub { $cv->send }; $cv->recv; ok $count == 0, "async_for with empty array, without endfucntion"; } { my $cv = condvar AnyEvent; my %res; my $number = 0; async_for [ 0 .. 9 ], sub { my ($g, $value, $index, $first, $last) = @_; $res{$index} = { value => $value, first => $first, last => $last, called => $number++, time => time, }; }, sub { $cv->send; }; $cv->recv; ok keys(%res) == 10, "All array elements were processed"; ok grep({ $res{$_}{called} == $res{$_}{value} } keys %res) == 10, "The sequence order is right"; ok $res{0}{first}, "First element was detected properly"; ok $res{9}{last}, "Last element was detected properly"; ok grep({ $res{$_}{first} } keys %res) == 1, "Only one element was detected as first"; ok grep({ $res{$_}{last} } keys %res) == 1, "Only one element was detected as last"; } # catch guard tests { my $cv = condvar AnyEvent; my %res; my $number = 0; async_for [ 0 .. 9 ], sub { my ($g, $value, $index, $first, $last) = @_; $res{$index} = { value => $value, first => $first, last => $last, called => $number++, time => time, }; my $timer; $timer = AE::timer .05, 0 => sub { undef $timer; undef $g; }; }, sub { $cv->send; }; $cv->recv; # note explain \%res; # exit; ok keys(%res) == 10, "All array elements were processed"; ok grep({ $res{$_}{called} == $res{$_}{value} } keys %res) == 10, "The sequence order is right"; ok $res{0}{first}, "First element was detected properly"; ok $res{9}{last}, "Last element was detected properly"; ok grep({ $res{$_}{first} } keys %res) == 1, "Only one element was detected as first"; ok grep({ $res{$_}{last} } keys %res) == 1, "Only one element was detected as last"; my $timing_test = 1; for (0 .. 8) { $timing_test = 0 if $res{$_+1}{time} - $res{$_}{time} < 0.045; } ok $timing_test, "Hold guard test"; } # reverse for { my $cv = condvar AnyEvent; my %res; my $number; async_rfor [ 0 .. 9 ], sub { my ($g, $value, $index, $first, $last) = @_; $res{$index} = { value => $value, first => $first, last => $last, called => $number++, time => time, }; }, sub { $cv->send; }; $cv->recv; ok keys(%res) == 10, "All array elements were processed"; ok grep({ 9 - $res{$_}{called} == $res{$_}{value} } keys %res) == 10, "The sequence order is right"; ok $res{9}{first}, "First element was detected properly"; ok $res{0}{last}, "Last element was detected properly"; ok grep({ $res{$_}{first} } keys %res) == 1, "Only one element was detected as first"; ok grep({ $res{$_}{last} } keys %res) == 1, "Only one element was detected as last"; } libanyevent-tools-perl-0.12/t/02_rw_mutex.t0000644000000000000000000000712311524704766017372 0ustar rootroot#!/usr/bin/perl use warnings; use strict; use utf8; use open qw(:std :utf8); use lib qw(lib ../lib); use Test::More tests => 8; use Encode qw(decode encode); use Time::HiRes qw(time); BEGIN { # Подготовка объекта тестирования для работы с utf8 my $builder = Test::More->builder; binmode $builder->output, ":utf8"; binmode $builder->failure_output, ":utf8"; binmode $builder->todo_output, ":utf8"; use_ok 'AnyEvent'; use_ok 'AnyEvent::Tools', ':mutex'; } { my $mutex = rw_mutex; my $cv = condvar AnyEvent; my $counter = 0; my $done_counter = 0; my $timer; $timer = AE::timer 0.13, 0 => sub { $cv->send }; $mutex->rlock(sub { my ($g) = @_; my $t; my $mcounter = 0; $t = AE::timer 0.01, 0.01 => sub { $mcounter++; if ($mcounter++ >= 10) { undef $t; undef $g; $done_counter++; $cv->send if $done_counter == 2; return; } $counter++; }; }); $mutex->rlock(sub { my ($g) = @_; my $t; my $mcounter = 0; $t = AE::timer 0.01, 0.01 => sub { $mcounter++; if ($mcounter++ >= 10) { undef $t; undef $g; $done_counter++; $cv->send if $done_counter == 2; return; } $counter++; }; }); $cv->recv; ok $counter == 10, "Two rlock work properly"; } { my $mutex = rw_mutex; my $cv = condvar AnyEvent; my %res; my $time = time; $mutex->rlock(sub { my ($g) = @_; $res{'first-start'} = time - $time; my $t; $t = AE::timer 0.3, 0 => sub { $res{'first-stop'} = time - $time; undef $g; undef $t; }; }); $mutex->rlock(sub { $res{'second'} = time - $time; }); $mutex->wlock(sub { my ($g) = @_; $res{'third-start'} = time - $time; my $t; $t = AE::timer 0.2, 0 => sub { $res{'third-stop'} = time - $time; undef $g; undef $t; }; }); $mutex->rlock(sub { my ($g) = @_; $res{'fourth-start'} = time - $time; my $t; $t = AE::timer 0.2, 0 => sub { $res{'fourth-stop'} = time - $time; undef $g; undef $t; $cv->send; }; }); $mutex->rlock(sub { $res{'fifth'} = time - $time; }); $cv->recv; ok abs($res{'first-start'} - $res{second}) < .001, "First and second started simultaneously"; ok $res{'third-start'} > $res{'first-stop'}, "Write lock was after all rlock were freed"; ok $res{'fourth-start'} > $res{'third-stop'}, "Read lock waited until write lock is done"; ok abs($res{fifth} - $res{'fourth-start'}) < .001, "Waited rlocks sarted simultaneously"; } { my $cv = condvar AnyEvent; my $mutex = rw_mutex; $mutex->rlock_limit(2); my @res; for my $step (1 .. 20) { $mutex->rlock(sub { my ($g) = @_; my $t; $t = AE::timer .1, 0, sub { push @res, time; undef $t; undef $g; $cv->send if $step == 20; }; }); } $cv->recv; my $ok = 1; for (my $i = 0; $i < @res - 2; $i += 2) { $ok = $res[$i + 2] - $res[$i] >= .095; last unless $ok; } ok $ok, "rlock_limit works fine"; } libanyevent-tools-perl-0.12/t/05_foreach_hash.t0000644000000000000000000000554011523522432020121 0ustar rootroot#!/usr/bin/perl use warnings; use strict; use utf8; use open qw(:std :utf8); use lib qw(lib ../lib); use Test::More tests => 16; use Encode qw(decode encode); use Time::HiRes qw(time); BEGIN { # Подготовка объекта тестирования для работы с utf8 my $builder = Test::More->builder; binmode $builder->output, ":utf8"; binmode $builder->failure_output, ":utf8"; binmode $builder->todo_output, ":utf8"; use_ok 'AnyEvent'; use_ok 'AnyEvent::Tools', ':foreach'; } { my $cv = condvar AnyEvent; my %res; my $called = 0; my %hash = map {($_ => 100 + $_) } 0 .. 9; my $first = (keys %hash)[0]; my $last = (keys %hash)[-1]; async_for \%hash, sub { my ($g, $key, $value, $first, $last) = @_; $res{$key} = { value => $value, first => $first, last => $last, called => $called++ }; }, sub { $cv->send; }; $cv->recv; ok keys(%res) == 10, "All array elements were processed"; ok grep({ $res{$_}{value} == 100 + $_ } keys %res) == 10, "All values are correct"; ok 1 == grep({$res{$_}{first}} 0 .. 9), "First element was detected"; ok 1 == grep({$res{$_}{last}} 0 .. 9), "Last element was detected"; ok $res{$first}{first}, "First element was detected properly"; ok $res{$last}{last}, "Last element was detected properly"; my $seq_ok = 1; $called = 0; for (keys %hash) { $seq_ok = 0 unless $res{$_}{called} == $called; $called++; } ok $seq_ok, "The sequence order is right"; } { my $cv = condvar AnyEvent; my %res; my $called = 0; my %hash = map {($_ => 100 + $_) } 0 .. 9; my $first = (keys %hash)[-1]; my $last = (keys %hash)[0]; async_rfor \%hash, sub { my ($g, $key, $value, $first, $last) = @_; $res{$key} = { value => $value, first => $first, last => $last, called => $called++ }; }, sub { $cv->send; }; $cv->recv; ok keys(%res) == 10, "All array elements were processed"; ok grep({ $res{$_}{value} == 100 + $_ } keys %res) == 10, "All values are correct"; ok 1 == grep({$res{$_}{first}} 0 .. 9), "First element was detected"; ok 1 == grep({$res{$_}{last}} 0 .. 9), "Last element was detected"; ok $res{$first}{first}, "First element was detected properly"; ok $res{$last}{last}, "Last element was detected properly"; my $seq_ok = 1; $called = 0; for (reverse keys %hash) { $seq_ok = 0 unless $res{$_}{called} == $called; $called++; } ok $seq_ok, "The sequence order is right"; } libanyevent-tools-perl-0.12/t/06_pool.t0000644000000000000000000000444411533152651016466 0ustar rootroot#!/usr/bin/perl use warnings; use strict; use utf8; use open qw(:std :utf8); use lib qw(lib ../lib); use Test::More tests => 6; use Time::HiRes qw(time); use Encode qw(decode encode); use AnyEvent; BEGIN { my $builder = Test::More->builder; binmode $builder->output, ":utf8"; binmode $builder->failure_output, ":utf8"; binmode $builder->todo_output, ":utf8"; use_ok 'AnyEvent::Tools', 'pool'; } { my $cv = condvar AnyEvent; my $pool = pool qw( a b ); my $order = 0; my @res; my $busy = 0; my $cnt = 1; my $idle; $idle = AE::idle sub { $pool->get(sub { my ($guard, $object) = @_; $busy++; push @res, { b => $busy, t => time }; my $timer; $timer = AE::timer 0.1, 0 => sub { $busy--; undef $timer; undef $guard; if (@res >= 40) { undef $idle; $cv->send; } }; }); undef $idle if $cnt++ >= 40; }; $cv->recv; my $ok; for (my $i = 0 ; $i < @res - 2; $i += 2) { $ok = $res[$i + 2]{t} - $res[$i]{t} >= .09; last unless $ok; } diag explain \@res unless ok $ok, "Sequence order is right"; ok 0 == grep({ $_->{b} > 2 } @res), "Pool works fine"; } { my $cv = condvar AnyEvent; my $pool = pool qw( a b ); my $order = 0; my @res; my $dtime = 0; my $ano = $pool->push('c'); my $t; $t = AE::timer 0.7, 0 => sub { $pool->delete($ano => sub { $dtime = time }); undef $t; }; for (0 .. 10) { $pool->get(sub { my ($guard, $object) = @_; my $timer; $timer = AE::timer 0.5, 0 => sub { push @res, { obj => $object, time => time, order => $order++ }; undef $timer; undef $guard; $cv->send if @res == 11; }; }); } $cv->recv; ok 2 == grep({ $_->{obj} eq 'c' } @res), "delete method works fine"; my ($f, $s) = grep { $_->{obj} eq 'c' } @res; diag explain \@res unless ok $s->{time} - $f->{time} >= 0.45, "Sequence order is right"; ok $dtime - $f->{time} >= 0.45, "delete only if resource free"; } libanyevent-tools-perl-0.12/t/03_repeat.t0000644000000000000000000001314311530656416016773 0ustar rootroot#!/usr/bin/perl use warnings; use strict; use utf8; use open qw(:std :utf8); use lib qw(lib ../lib); use Time::HiRes qw(time); use Test::More tests => 16; use Encode qw(decode encode); BEGIN { # Подготовка объекта тестирования для работы с utf8 my $builder = Test::More->builder; binmode $builder->output, ":utf8"; binmode $builder->failure_output, ":utf8"; binmode $builder->todo_output, ":utf8"; use_ok 'AnyEvent'; use_ok 'AnyEvent::Tools', ':foreach'; } { my $cv = condvar AnyEvent; my $count = 0; async_repeat 0, sub { $count++ }, sub { $cv->send }; $cv->recv; ok $count == 0, "Repeat 0 times"; } { my $cv = condvar AnyEvent; my $count = 0; async_repeat 0, sub { $count++ }; my $timer_end; $timer_end = AE::timer 0.5, 0 => sub { undef $timer_end; $cv->send; }; $cv->recv; ok $count == 0, "Repeat 0 times without endfucntion"; } { my $cv = condvar AnyEvent; my $count = 0; async_repeat 10, sub { $count++ }, sub { $cv->send }; $cv->recv; diag $count unless ok $count == 10, "Repeat 10 times"; } { my $cv = condvar AnyEvent; my $count = 0; async_repeat 10, sub { $count++; my ($g, $no, $first, $last) = @_; $cv->send if $last; }; $cv->recv; ok $count == 10, "Repeat 10 times without endfucntion"; } { my $cv = condvar AnyEvent; my $count = 0; async_repeat 10, sub { my ($g, $no, $first, $last) = @_; my $timer; $timer = AE::timer 0.05, 0 => sub { undef $g; undef $timer; $count++; $cv->send if $last; }; }; $cv->recv; ok $count == 10, "Repeat 10 times with catching guards and without endfucntion"; } { my %res; my $cv = condvar AnyEvent; my $count = 0; my $repeat_guard; $repeat_guard = async_repeat 10, sub { my ($g, $no, $first, $last) = @_; my $timer; my $time = time; $timer = AE::timer 0.05, 0 => sub { $res{$count} = { time => time - $time, start_time => $time, no => $count }; $count++; undef $g; undef $timer; $cv->send if $last; }; }; $cv->recv; ok 9 == grep({ $res{$_}{start_time} - $res{$_ - 1}{start_time} > 0.045 } 1 .. 9), "Hold guard test"; ok 10 == grep({ $res{$_}{time} >= .045 } 0 .. 9), "All timers have done"; } { my $cv = condvar AnyEvent; my $end_called = 0; my $count = 0; my $repeat_guard; $repeat_guard = async_repeat 15, sub { undef $repeat_guard if $count == 9; $count++; }, sub { $end_called = 1; }; my $timer = AE::timer 0.5, 0 => sub { $cv->send }; $cv->recv; ok $count == 10, "Main guard is undefined before local guard"; ok $end_called == 0, "Finish callback won't be called if repeating is canceled"; } { my $cv = condvar AnyEvent; my $count = 0; my $repeat_guard; $repeat_guard = async_repeat 15, sub { my ($g) = @_; undef $g; undef $repeat_guard if $count == 9; $count++; }; my $timer = AE::timer 0.5, 0 => sub { $cv->send }; $cv->recv; ok $count == 10, "Main guard is undefined after local guard"; } { my $cv = condvar AnyEvent; my $repeat_guard; my $end_called = 0; $repeat_guard = async_repeat 15, sub { my ($g, $idx, $first, $last) = @_; undef $repeat_guard if $last; undef $g; }, sub { $end_called = 1 }; my $timer = AE::timer 0.5, 0 => sub { $cv->send }; $cv->recv; ok $end_called == 0, "Cancel repeating inside the last iteration"; } { my $cv = condvar AnyEvent; my $count = 0; my $repeat_guard; $repeat_guard = async_repeat 15, sub { my ($g, $no, $first, $last) = @_; my $timer; my $time = time; $timer = AE::timer 0.05, 0 => sub { undef $repeat_guard if $count == 9; $count++; undef $g; undef $timer; }; }; my $timer = AE::timer 0.05 * 16, 0 => sub { $cv->send }; $cv->recv; diag $count unless ok $count == 10, "Cancel repeating with catching guards"; } { my $cv = condvar AnyEvent; my $count = 0; my $repeat_guard; $repeat_guard = async_repeat 15, sub { my ($g, $no, $first, $last) = @_; my $timer; my $time = time; $timer = AE::timer 0.05, 0 => sub { undef $g; undef $timer; undef $repeat_guard if $count == 9; $count++; }; }; my $timer = AE::timer 0.05 * 16, 0 => sub { $cv->send }; $cv->recv; diag $count unless ok $count == 10, "Cancel repeating with catching guards, after freeing guard"; } { my $cv = condvar AnyEvent; my %res; async_repeat 4, sub { my ($g, $no, $first, $last) = @_; my $timer; my $time = time; $res{$no}{start} = $time; $timer = AE::timer 0.05, 0 => sub { $res{$no}{finish} = time; $res{$no}{time} = $res{$no}{finish} - $time; undef $timer; undef $g; }; }, sub { $res{finish} = time; $cv->send; }; $cv->recv; ok $res{finish} - $res{3}{start} >= 0.045, "Finish callback is called after last is done"; } libanyevent-tools-perl-0.12/MANIFEST0000664000000000000000000000054611524162460015711 0ustar rootrootChanges debian/changelog debian/compat debian/control debian/copyright debian/rules lib/AnyEvent/Tools/Mutex.pm lib/AnyEvent/Tools.pm lib/AnyEvent/Tools/Pool.pm lib/AnyEvent/Tools/RWMutex.pm lib/AnyEvent/Tools/Buffer.pm Makefile.PL MANIFEST README t/01_mutex.t t/02_rw_mutex.t t/03_repeat.t t/04_foreach_array.t t/05_foreach_hash.t t/06_pool.t t/07_buffer.t libanyevent-tools-perl-0.12/Changes0000644000000000000000000000161511533404351016045 0ustar rootrootRevision history for Perl extension AnyEvent::Tools. 0.01 Thu Feb 3 00:17:46 2011 - original version; created by h2xs 1.23 with options -n AnyEvent::Tools 0.03 Mon Feb 7 22:09:23 MSK 2011 - added Debian's infrastructure - added 'pool' function - fix autoload in rw_mutex 0.04 Tue Feb 8 11:07:40 MSK 2011 - added 'buffer' function - rewrite 'pool' tests - revision all guards (when they actuates the parent object can be destroyed) 0.05 Thu Feb 10 09:54:36 MSK 2011 - add 'rlock_limit' into rw_mutex. 0.06 Fri Feb 11 09:36:10 MSK 2011 - pool.t was rewritten. 0.07 Mon Feb 14 10:55:33 MSK 2011 - all tests pass under EV. 0.08 Mon Feb 14 18:08:06 MSK 2011 - add unique_cb to buffer 0.10 Sat Feb 19 22:20:39 MSK 2011 - use aggressive_idle instead AE::idle 0.12 Wed Mar 2 12:07:36 MSK 2011 - fix depends libanyevent-tools-perl-0.12/lib/0000775000000000000000000000000011522456146015326 5ustar rootrootlibanyevent-tools-perl-0.12/lib/AnyEvent/0000775000000000000000000000000011533510465017054 5ustar rootrootlibanyevent-tools-perl-0.12/lib/AnyEvent/Tools/0000775000000000000000000000000011530013577020153 5ustar rootrootlibanyevent-tools-perl-0.12/lib/AnyEvent/Tools/Buffer.pm0000644000000000000000000001124611530013577021724 0ustar rootrootuse utf8; use strict; use warnings; package AnyEvent::Tools::Buffer; use AnyEvent::AggressiveIdle qw(aggressive_idle stop_aggressive_idle); use AnyEvent::Util; use Carp; sub new { my $class = shift; croak "usage: buffer(on_flush => sub { ... }, ...)" if @_ % 2; my (%opts) = @_; my $self = bless { queue => [], exists => {}, timer => undef, lock => 0, do_flush => 0, unique_cb => undef, } => ref($class) || $class; $self->on_flush($opts{on_flush}); $self->size($opts{size} || 0); $self->interval($opts{interval} || 0); $self->unique_cb($opts{unique_cb}); return $self; } sub interval { my ($self, $ival) = @_; return $self->{interval} if @_ == 1; undef $self->{timer} unless $ival; return $self->{interval} = $ival; } sub on_flush { my ($self, $cb) = @_; croak "callback must be CODEREF" if $cb and 'CODE' ne ref $cb; return $self->{on_flush} = $cb; } sub unique_cb { my ($self, $cb) = @_; # disable unique checking unless($cb) { $self->{exists} = {}; return $self->{unique_cb} = $cb; } croak "unique_cb must be CODEREF" unless 'CODE' eq ref $cb; $self->flush; return $self->{unique_cb} = $cb; } sub push :method { my ($self, @data) = @_; if (@data) { if ($self->{unique_cb}) { while(@data) { my $add = shift @data; my $key = $self->{unique_cb}->($add); croak "unique_cb must return defined SCALAR" if ref $key or !defined($key); next if exists $self->{exists}{$key}; $self->{exists}{$key} = 1; push @{ $self->{queue} }, $add; } } else { push @{ $self->{queue} }, @data; } } $self->_check_buffer; return; } sub unshift :method { my ($self, @data) = @_; if (@data) { if ($self->{unique_cb}) { while(@data) { my $add = pop @data; my $key = $self->{unique_cb}->($add); croak "unique_cb must return defined SCALAR" if ref $key or !defined($key); next if exists $self->{exists}{$key}; $_++ for values %{ $self->{exists} }; $self->{exists}{$key} = 1; unshift @{ $self->{queue} }, $add; } } else { unshift @{ $self->{queue} }, @data; } } $self->_check_buffer; return; } sub unshift_back { my ($self, $data) = @_; croak "Guard has already been destroyed" unless $self->{lock}; unless ($self->{unique_cb}) { unshift @{ $self->{queue} }, @$data; return; } my @buffer; $self->{exists} = {}; for (@$data, @{ $self->{queue} }) { my $key = $self->{unique_cb}->($_); next if exists $self->{exists}{$key}; $self->{exists}{$key} = 1; push @buffer, $_; } $self->{queue} = \@buffer; return; } sub size { my ($self, $value) = @_; return $self->{size} if @_ == 1; $self->{size} = $value; $self->_check_buffer; return $self->{size}; } sub flush { my ($self) = @_; return unless @{ $self->{queue} }; return unless $self->{on_flush}; if ($self->{lock}) { $self->{do_flush} = 1; return; } undef $self->{timer}; my $queue = $self->{queue}; $self->{queue} = []; $self->{exists} = {}; my $guard = guard sub { return unless $self; # it can be destroyed $self->{lock} = 0; if ($self->{do_flush}) { $self->{do_flush} = 0; return unless @{ $self->{queue} }; aggressive_idle sub { # avoid recursion stop_aggressive_idle $_[0]; $self->flush if $self; }; return; } return unless $self; return unless @{ $self->{queue} }; aggressive_idle sub { # avoid recursion stop_aggressive_idle $_[0]; $self->_check_buffer if $self; # can be destroyed again }; return; }; $self->{lock} = 1; $self->{on_flush}->($guard, $queue); return; } sub _check_buffer { my ($self) = @_; return if $self->{lock}; return unless $self->{on_flush}; unless (@{ $self->{queue} }) { undef $self->{timer}; return; } if ($self->size) { if (@{ $self->{queue} } >= $self->size) { $self->flush; return; } } return if $self->{timer}; return unless $self->interval; $self->{timer} = AE::timer $self->interval, 0 => sub { $self->flush }; return; } 1; libanyevent-tools-perl-0.12/lib/AnyEvent/Tools/Mutex.pm0000644000000000000000000000315711524170042021611 0ustar rootrootpackage AnyEvent::Tools::Mutex; use Carp; use AnyEvent::Util; sub new { my ($class) = @_; return bless { queue => [], cache => {}, hno => 0, process => 0, } => ref($class) || $class; } sub lock { my ($self, $cb) = @_; croak 'Usage: $mutex->lock(sub { something })' unless 'CODE' eq ref $cb; my $name = $self->_add_client($cb); $self->_check_mutex; return unless defined wantarray; return unless keys %{ $self->{cache} }; return guard { $self->_check_mutex if $self and $self->_delete_client($name) }; } sub is_locked { my ($self) = @_; return $self->{process}; } sub _add_client { my ($self, $cb) = @_; my $name = ++$self->{hno}; $self->{cache}{$name} = @{ $self->{queue} }; push @{ $self->{queue} }, [ $name, $cb ]; return $name; } sub _delete_client { my ($self, $name) = @_; return 0 unless exists $self->{cache}{$name}; my $idx = delete $self->{cache}{$name}; if ($idx == $#{ $self->{queue} }) { pop @{ $self->{queue} }; return 1; } splice @{ $self->{queue} }, $idx, 1; for (values %{ $self->{cache} }) { next unless $_ > $idx; $_--; } return 1; } sub _check_mutex { my ($self) = @_; return if $self->is_locked; return unless @{ $self->{queue} }; $self->{process}++; my $info = $self->{queue}[0]; $self->_delete_client($info->[0]); my $guard = guard { if ($self) { # it can be aleady destroyed $self->{process}--; $self->_check_mutex; } }; $info->[1]->($guard); } 1; libanyevent-tools-perl-0.12/lib/AnyEvent/Tools/Pool.pm0000644000000000000000000000451311524171041021415 0ustar rootrootuse utf8; use strict; use warnings; package AnyEvent::Tools::Pool; use Carp; use AnyEvent::Util; sub new { my $class = shift; my $self = bless { pool => {}, no => 0, queue => [], free => [], delete => [], } => ref($class) || $class; $self->push($_) for @_; return $self; } sub delete { my ($self, $no, $cb) = @_; croak "Can't find object: $no" unless exists $self->{pool}{$no}; croak "Callback must be CODEREF" if $cb and ref($cb) ne 'CODE'; push @{ $self->{delete} }, [ $no, $cb ]; $self->_check_pool; return; } sub push :method { croak 'usage: $pool->push($object)' unless @_ == 2; my ($self, $object) = @_; my $no = $self->{no}++; push @{ $self->{free} }, $no; $self->{pool}{$no} = $object; $self->_check_pool; return $no; } sub get { croak 'usage: $pool->get(sub { ($g, $o) = @_ .. })' unless @_ == 2; my ($self, $cb) = @_; croak 'Callback must be coderef', unless 'CODE' eq ref $cb; push @{ $self->{queue} }, $cb; $self->_check_pool; return; } sub _check_pool { my ($self) = @_; return unless @{ $self->{free} }; # delete object if (@{ $self->{delete} }) { CHECK_CYCLE: for (my $di = $#{ $self->{delete} }; $di >= 0; $di--) { for (my $fi = $#{ $self->{free} }; $fi >= 0; $fi--) { if ($self->{free}[$fi] == $self->{delete}[$di][0]) { my ($no, $cb) = @{ $self->{delete}[$di] }; splice @{ $self->{free} }, $fi, 1; splice @{ $self->{delete} }, $di, 1; delete $self->{pool}{$no}; if ($cb) { $cb->(); goto &_check_pool if $self; return; } next CHECK_CYCLE; } } } return unless @{ $self->{free} }; } return unless @{ $self->{queue} }; my $ono = shift @{ $self->{free} }; my $cb = shift @{ $self->{queue} }; my $guard = guard { if ($self) { # can be destroyed push @{ $self->{free} }, $ono; $self->_check_pool; } }; $cb->($guard, $self->{pool}{$ono}); } 1; libanyevent-tools-perl-0.12/lib/AnyEvent/Tools/RWMutex.pm0000644000000000000000000000575111524704467022102 0ustar rootrootpackage AnyEvent::Tools::RWMutex; use Carp; use AnyEvent::Util; sub new { my ($class) = @_; return bless { rlock => [], wlock => [], hno => 0, rprocess => 0, wprocess => 0, cache => {}, rlock_limit => 0, } => ref($class) || $class; } for my $m (qw(wlock rlock)) { no strict 'refs'; * { __PACKAGE__ . "::$m" } = sub { my ($self, $cb) = @_; croak "Usage: \$mutex->$m(sub { something })" unless 'CODE' eq ref $cb; my $name = $self->_add_client($m, $cb); $self->_check_mutex; return unless defined wantarray; return unless keys %{ $self->{cache} }; return guard { $self->_check_mutex if $self and $self->_delete_client($name) }; } } sub rlock_limit { my ($self, $value) = @_; return $self->{rlock_limit} if @_ == 1; return $self->{rlock_limit} = $value || 0; } sub is_wlocked { my ($self) = @_; return $self->{wprocess}; } sub is_rlocked { my ($self) = @_; return $self->{rprocess}; } sub is_locked { my ($self) = @_; return $self->is_wlocked || $self->is_rlocked; } sub _add_client { my ($self, $queue, $cb) = @_; my $name = ++$self->{hno}; $self->{cache}{$name} = [ $queue, scalar @{ $self->{$queue} } ]; push @{ $self->{$queue} }, [ $name, $cb ]; return $name; } sub _delete_client { my ($self, $name) = @_; return 0 unless exists $self->{cache}{$name}; my ($queue, $idx) = @{ delete $self->{cache}{$name} }; if ($idx == $#{ $self->{$queue} }) { pop @{ $self->{$queue} }; return 1; } splice @{ $self->{$queue} }, $idx, 1; for (values %{ $self->{cache} }) { next unless $_->[1] > $idx; next unless $_->[0] eq $queue; $_->[1]--; } return 1; } sub _check_mutex { my ($self) = @_; return if $self->is_wlocked; my $info; if ($self->is_rlocked) { return if @{ $self->{wlock} }; return unless @{ $self->{rlock} }; goto LOCK_RMUTEX; } if (@{ $self->{wlock} }) { $info = $self->{wlock}[0]; $self->_delete_client($info->[0]); $self->{wprocess}++; my $guard = guard { if ($self) { # it can be already destroyed $self->{wprocess}--; $self->_check_mutex; } }; $info->[1]->($guard); return; } goto LOCK_RMUTEX if @{ $self->{rlock} }; return; LOCK_RMUTEX: return if $self->rlock_limit and $self->{rprocess} >= $self->rlock_limit; $info = $self->{rlock}[0]; $self->_delete_client($info->[0]); $self->{rprocess}++; my $guard = guard { if ($self) { # it can be already destroyed $self->{rprocess}--; $self->_check_mutex; } }; $info->[1]->($guard); goto &_check_mutex if @{ $self->{rlock} }; return; } 1; libanyevent-tools-perl-0.12/lib/AnyEvent/Tools.pm0000644000000000000000000003403411533510465020514 0ustar rootrootpackage 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__ =head1 NAME AnyEvent::Tools - instrument collection for L. =head1 SYNOPSIS =head2 Objects pool use AnyEvent::Tools qw(pool); my $dbh1 = ... my $dbh2 = ... ... my $dbhN = ... my $pool = pool($dbh1, $dbh2, $dbh3, ..., $dbhN); # later ... $pool->get(sub { my ($guard, $dbh) = @_; ... # Enjoy $dbh here undef $guard; # the other process can use the $dbh }); =head2 Mutexes use AnyEvent::Tools qw(mutex); my $dbh = new AnyEvent::DBI(bla); my $mutex_dbh = mutex; sub some_callback() { ... $mutex_dbh->lock(sub { my ($mutex_guard) = @_; $dbh->exec("SELECT * FROM table", sub { my ($dbh, $rows, $rv) = @_; ... undef $mutex_guard; # unlock mutex }); }); } =head2 Read/Write mutexes # Your data my @shared_data; use AnyEvent::Tools qw(rw_mutex); use AnyEvent::Tools qw(:mutex); # mutex and rw_mutex my $rw_mutex = rw_mutex; sub some_callback() { ... $rw_mutex->rlock(sub { my ($mutex_guard) = @_; ... # You can read Your data here ... # later ... = sub { # done undef $mutex_guard; # unlock mutex } }); } sub other_callback() { ... $rw_mutex->wlock(sub { my ($mutex_guard) = @_; ... # You can write Your data here ... # later ... = sub { # done undef $mutex_guard; # unlock mutex } }); } =head2 Foreaches use AnyEvent::Tools qw(:foreach); async_repeat $count, sub { my ($guard, $iteration, $first_flag, $last_flag) = @_; ... do something $count times }, sub { ... # do something after all cycles }; async_foreach \@array, sub { my ($guard, $element, $index, $first_flag, $last_flag) = @_; ... # do something with $array[$index]; }, sub { ... # do something after all cycles }; async_foreach \%hash, sub { my ($guard, $key, $value, $first_flag, $last_flag) = @_; ... # do something with $hash{$key}; }, sub { my ($guard) = @_; ... # do something after all cycles }; =head2 Buffers use AnyEvent::Tools ':pool'; # pool and buffer use AnyEvent::Tools qw(buffer); # buffer only my $buffer = buffer; $buffer->on_flush( sub { ($guard, $objects_aref) = @_; .... }); ... $buffer->push($obj1); $buffer->push($obj2); $buffer->push($obj3); $buffer->push($obj4); $buffer->flush; # autoflush after 30 second $buffer->interval(30); # autoflush if it contains more than 50 elements $buffer->size(50); =head1 DESCRIPTION In spite of event machine is started as one process, You may want to share one resource between a lot of subprocesses. Sometimes You also want to do something with a lot of data placed in hashes/arrays. =head1 FUNCTIONS =head2 mutex returns unlocked mutex. This object provides the following methods: =head3 lock(CODEREF) You declare that You want to lock mutex. When it is possible the mutex will be locked and Your callback will be called. If the method is called in non-void context it returns guard object which can be destroyed. So if You want You can cancel Your lockrequest. Example: $mutex->lock(sub { my $guard = shift; ... # do something undef $guard; # unlock mutex }); The callback receives a guard (see L) which unlocks the mutex. Hold the guard while You need locked resourse. =head3 is_locked Returns B if mutex is locked now. Usually You shoudn't use the function. =head2 rw_mutex returns unlocked read-write mutex. This object provides the following methods: =head3 rlock(CODEREF) You declare that You want to lock mutex for reading. When it is possible the mutex will be locked and Your callback will be called. There may be a lot of read processes running simultaneously that catch the lock. =head3 wlock(CODEREF). You declare that You want to lock mutex for writing. When it is possible the mutex will be locked and Your callback will be called. There may be only one write process that catches the lock. Both callbacks receive a guard to hold the mutex locked. =head3 rlock_limit(NUMBER) Get/Set count limit for rlock. If an rlock request is come and this limit is reached the request will be queued. =head3 is_locked Returns B if the mutex has 'read' or 'write' lock status. =head3 is_rlocked Returns B if the mutex has 'read' lock status. B: this method returns B if the mutex is wlocked (L), so if You want to know if any lock is set, use the function L. =head3 is_wlocked Returns B if the mutex has 'write' lock status. Usually You shoudn't use is_[rw]?locked functions. =head2 async_repeat(COUNT, CALLBACK [, DONE_CALLBACK ]) Repeats calling Your callback(s). async_repeat 10, sub { $count++ }; async_repeat 20, sub { $count++ }, sub { $done = 1 }; The function async_repeat returns the guard if it is called in non-void context. Destroy the guard if You want to cancel iterations. Iteration callback receives the following arguments: =over =item 1. guard The next iteration will not start until the guard is destroyed. =item 2. iteration number The number of current iteration. =item 3. first_flag TRUE on the first iteration. =item 4. last_flag TRUE on the last iteration. =back =head2 async_for(HASREF|ARRAYREF, CALLBACK [, DONE_CALLBACK ]); Calls Your callbacks for each array or hash element. The function returns the guard if it is called in non-void context. Destroy the guard if You want to cancel iterations. If You process an array using the function, iteration callback will receive the following arguments: =over =item 1. guard The next iteration will not start until the guard is destroyed. =item 2. element Next array element. =item 3. index Index of array element. =item 4. first_flag The iteration is the first. =item 5. last_flag The iteration is the last. =back If You process a hash using the function, iteration callback will receive the following arguments: =over =item 1. guard The next iteration will not start until the guard is destroyed. =item 2. key =item 3. value =item 4. first_flag The iteration is the first. =item 5. last_flag The iteration is the last. =back =head2 async_rfor(HASREF|ARRAYREF, CALLBACK [, DONE_CALLBACK ]); The same as async_for but has reverse sequence. =head2 pool Returns the object that incapsulates object collection. You can cacth one object of the collection using the method: =head3 get($callback) $pool->get(sub { my ($guard, $object) = @_; ... }); If there is a free object in the pool, Your callback will be called. The callback receives also a guard. Hold the guard while You use the object. There are also a few methods: =head3 push($object); my $id = $pool->push($dbh); Add an object in pool. Returns the object's identifier. You can use that to delete the object from pool: =head3 delete($id) $pool->delete($id); $pool->delete($id, sub { # on_delete }); Deletes object from pool. B: The function will croak if it receives an ivalid object id. =head2 buffer Returns the buffer object. Can receive a few named arguments: L, L, L. They are the same that the following functions. It provides the following methods: =head3 push Push the object into buffer. $buffer->push(123); $buffer->push($obj); $buffer->push(1,2,3); =head3 unshift Unshift the object into buffer $buffer->unshift(123); $buffer->unshift(1,2,3); =head3 unshift_back The function can be called only inside L handler (until its guard destroyed). It can be used to unshift non-flushed data (for example: if an error was occured) back to buffer. Receives B (like L's callback). =head3 flush Flush buffer (calls L function) =head3 interval Get/Set autoflush interval (zero == periodical autoflush is disabled) =head3 size Get/Set buffer size (zero == buffer overflow autoflush is disabled) =head3 unique_cb If the callback is defined it will be called for each pushing element to determine its key value. If the key has already appeared since last L the element will be ignored. So buffer will contain only unique objects. =head3 on_flush Set flush callback. It will be called if L function is called or buffer overflow is detected or timeout is exceeded. The callback receives two arguments: =over =item guard If You hold the guard, and user calls L, flushing will be delayed. =item arrayref Reference to object list that were accumulated. =back =head1 SEE ALSO L =head1 AUTHOR Dmitry E. Oboukhov, Eunera@debian.orgE =head1 COPYRIGHT AND LICENSE Copyright (C) 2011 by Dmitry E. Oboukhov This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.10.1 or, at your option, any later version of Perl 5 you may have available. =head1 VCS The project is placed in my git repo. See here: L =cut