File Coverage

blib/lib/BGS/Limit.pm
Criterion Covered Total %
statement 24 30 80.0
branch 3 4 75.0
condition n/a
subroutine 9 10 90.0
pod 0 5 0.0
total 36 49 73.4


line stmt bran cond sub pod time code
1             package BGS::Limit;
2              
3 4     4   223976 use strict;
  4         48  
  4         104  
4 4     4   16 use warnings;
  4         4  
  4         92  
5              
6 4     4   16 use Exporter;
  4         8  
  4         256  
7             our @ISA = qw(Exporter);
8             our @EXPORT = qw(bgs_call bgs_back bgs_wait bgs_break);
9              
10             our $VERSION = '0.08';
11              
12 4     4   896 use BGS ();
  4         24  
  4         1312  
13              
14              
15             my @jobs = ();
16              
17 12     12 0 32 sub bgs_call(&$) { push @jobs, \@_ }
18 12     12 0 364 sub bgs_back(&) { shift }
19              
20              
21             sub do_job {
22 11 100   11 0 75 my $job = shift @jobs or return;
23 9         50 my ($sub, $callback) = @$job;
24             &BGS::bgs_call($sub, sub {
25 4     4   130 my $r = shift;
26 4         25 $callback->($r);
27 4         5657 do_job();
28 9         107 });
29             }
30              
31              
32             sub bgs_wait($) {
33 4     4 0 24 my ($max) = @_;
34 4 50       12 if ($max) {
35 4         20 do_job() foreach 1 .. $max;
36 2         50 BGS::bgs_wait();
37             } else {
38 0           foreach (@jobs) {
39 0           my ($sub, $callback) = @$_;
40 0           my $r = $sub->();
41 0           $callback->($r);
42             }
43             }
44             }
45              
46              
47             sub bgs_break() {
48 0     0 0   @jobs = ();
49 0           BGS::bgs_break();
50             }
51              
52              
53             1;
54              
55              
56             __END__