Commit | Line | Data |
9e72f0cf |
1 | package Object::Remote::MiniLoop; |
2 | |
3 | use IO::Select; |
befabdee |
4 | use Time::HiRes qw(time); |
9e72f0cf |
5 | use Moo; |
6 | |
7 | # this is ro because we only actually set it using local in sub run |
8 | |
9 | has is_running => (is => 'ro', clearer => 'stop'); |
10 | |
11 | has _read_watches => (is => 'ro', default => sub { {} }); |
12 | has _read_select => (is => 'ro', default => sub { IO::Select->new }); |
13 | |
befabdee |
14 | has _timers => (is => 'ro', default => sub { [] }); |
15 | |
9e72f0cf |
16 | sub pass_watches_to { |
17 | my ($self, $new_loop) = @_; |
18 | foreach my $fh ($self->_read_select->handles) { |
19 | $new_loop->watch_io( |
20 | handle => $fh, |
21 | on_read_ready => $self->_read_watches->{$fh} |
22 | ); |
23 | } |
24 | } |
25 | |
26 | sub watch_io { |
27 | my ($self, %watch) = @_; |
28 | my $fh = $watch{handle}; |
29 | if (my $cb = $watch{on_read_ready}) { |
30 | $self->_read_select->add($fh); |
31 | $self->_read_watches->{$fh} = $cb; |
32 | } |
33 | } |
34 | |
35 | sub unwatch_io { |
36 | my ($self, %watch) = @_; |
37 | my $fh = $watch{handle}; |
38 | if ($watch{on_read_ready}) { |
39 | $self->_read_select->remove($fh); |
40 | delete $self->_read_watches->{$fh}; |
41 | } |
befabdee |
42 | return; |
43 | } |
44 | |
45 | sub watch_time { |
46 | my ($self, %watch) = @_; |
47 | my $at = $watch{at} || do { |
48 | die "watch_time requires at or after" unless my $after = $watch{after}; |
49 | time() + $after; |
50 | }; |
51 | die "watch_time requires code" unless my $code = $watch{code}; |
52 | my $timers = $self->_timers; |
53 | my $new = [ $at => $code ]; |
54 | @{$timers} = sort { $a->[0] <=> $b->[0] } @{$timers}, $new; |
55 | return "$new"; |
56 | } |
57 | |
58 | sub unwatch_time { |
59 | my ($self, $id) = @_; |
60 | @$_ = grep !($_ eq $id), @$_ for $self->_timers; |
61 | return; |
9e72f0cf |
62 | } |
63 | |
64 | sub loop_once { |
65 | my ($self) = @_; |
66 | my $read = $self->_read_watches; |
67 | my ($readable) = IO::Select->select($self->_read_select, undef, undef, 0.5); |
68 | # I would love to trap errors in the select call but IO::Select doesn't |
69 | # differentiate between an error and a timeout. |
70 | # -- no, love, mst. |
71 | foreach my $fh (@$readable) { |
72 | $read->{$fh}(); |
73 | } |
befabdee |
74 | my $timers = $self->_timers; |
75 | my $now = time(); |
76 | while (@$timers and $timers->[0][0] <= $now) { |
77 | (shift @$timers)->[1]->(); |
78 | } |
79 | return; |
9e72f0cf |
80 | } |
81 | |
6c597351 |
82 | sub want_run { |
83 | my ($self) = @_; |
84 | $self->{want_running}++; |
85 | } |
86 | |
87 | sub run_while_wanted { |
88 | my ($self) = @_; |
89 | $self->loop_once while $self->{want_running}; |
befabdee |
90 | return; |
6c597351 |
91 | } |
92 | |
93 | sub want_stop { |
94 | my ($self) = @_; |
95 | $self->{want_running}-- if $self->{want_running}; |
96 | } |
97 | |
9e72f0cf |
98 | sub run { |
99 | my ($self) = @_; |
100 | local $self->{is_running} = 1; |
101 | while ($self->is_running) { |
102 | $self->loop_once; |
103 | } |
befabdee |
104 | return; |
9e72f0cf |
105 | } |
106 | |
107 | 1; |