File Coverage

blib/lib/Tak/Loop.pm
Criterion Covered Total %
statement 6 28 21.4
branch 0 4 0.0
condition n/a
subroutine 2 7 28.5
pod 0 5 0.0
total 8 44 18.1


line stmt bran cond sub pod time code
1             package Tak::Loop;
2              
3 1     1   966 use IO::Select;
  1         1922  
  1         50  
4 1     1   8 use Moo;
  1         2  
  1         10  
5              
6             has is_running => (is => 'rw', clearer => 'loop_stop');
7              
8             has _read_watches => (is => 'ro', default => sub { {} });
9             has _read_select => (is => 'ro', default => sub { IO::Select->new });
10              
11             sub pass_watches_to {
12 0     0 0   my ($self, $new_loop) = @_;
13 0           foreach my $fh ($self->_read_select->handles) {
14 0           $new_loop->watch_io(
15             handle => $fh,
16             on_read_ready => $self->_read_watches->{$fh}
17             );
18             }
19             }
20              
21             sub watch_io {
22 0     0 0   my ($self, %watch) = @_;
23 0           my $fh = $watch{handle};
24 0 0         if (my $cb = $watch{on_read_ready}) {
25 0           $self->_read_select->add($fh);
26 0           $self->_read_watches->{$fh} = $cb;
27             }
28             }
29              
30             sub unwatch_io {
31 0     0 0   my ($self, %watch) = @_;
32 0           my $fh = $watch{handle};
33 0 0         if ($watch{on_read_ready}) {
34 0           $self->_read_select->remove($fh);
35 0           delete $self->_read_watches->{$fh};
36             }
37             }
38              
39             sub loop_once {
40 0     0 0   my ($self) = @_;
41 0           my $read = $self->_read_watches;
42 0           my ($readable) = IO::Select->select($self->_read_select, undef, undef, 0.5);
43             # I would love to trap errors in the select call but IO::Select doesn't
44             # differentiate between an error and a timeout.
45             # -- no, love, mst.
46 0           foreach my $fh (@$readable) {
47 0           $read->{$fh}();
48             }
49             }
50              
51             sub loop_forever {
52 0     0 0   my ($self) = @_;
53 0           $self->is_running(1);
54 0           while ($self->is_running) {
55 0           $self->loop_once;
56             }
57             }
58              
59             1;