lib/Object/Remote/MiniLoop.pm

   1 package Object::Remote::MiniLoop;
   2
   3 use IO::Select;
   4 use Time::HiRes qw(time);
   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
  14 has _timers => (is => 'ro', default => sub { [] });
  15
  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   }
  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;
  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   }
  74   my $timers = $self->_timers;
  75   my $now = time();
  76   while (@$timers and $timers->[0][0] <= $now) {
  77     (shift @$timers)->[1]->();
  78   }
  79   return;
  80 }
  81
  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};
  90   return;
  91 }
  92
  93 sub want_stop {
  94   my ($self) = @_;
  95   $self->{want_running}-- if $self->{want_running};
  96 }
  97
  98 sub run {
  99   my ($self) = @_;
 100   local $self->{is_running} = 1;
 101   while ($self->is_running) {
 102     $self->loop_once;
 103   }
 104   return;
 105 }
 106
 107 1;