File Coverage

blib/lib/Bot/ChatBots/Role/Poller.pm
Criterion Covered Total %
statement 24 50 48.0
branch 0 8 0.0
condition 0 3 0.0
subroutine 8 13 61.5
pod 3 3 100.0
total 35 77 45.4


line stmt bran cond sub pod time code
1             package Bot::ChatBots::Role::Poller;
2 1     1   725 use strict;
  1         3  
  1         29  
3 1     1   4 use warnings;
  1         2  
  1         65  
4             { our $VERSION = '0.009'; }
5              
6 1     1   6 use Ouch;
  1         2  
  1         9  
7 1     1   74 use Mojo::IOLoop ();
  1         1  
  1         28  
8 1     1   5 use Log::Any qw< $log >;
  1         2  
  1         10  
9 1     1   266 use Try::Tiny;
  1         2  
  1         87  
10              
11 1     1   6 use Moo::Role;
  1         2  
  1         6  
12 1     1   428 use namespace::clean;
  1         2  
  1         6  
13              
14             with 'Bot::ChatBots::Role::Source'; # requires normalize_record
15             requires qw< parse_response poll process_updates >;
16              
17             has interval => (is => 'ro', required => 1);
18             has args => (is => 'ro', default => sub { return [] });
19              
20             sub BUILD {
21 0     0 1   my $self = shift;
22 0           $self->schedule($self->interval, @{$self->args});
  0            
23 0           return $self; # ignored
24             }
25              
26             sub poller {
27 0     0 1   my $self = shift;
28 0 0 0       my $args = (@_ && ref($_[0]) ? $_[0] : {@_});
29              
30             # flag variable to avoid instances treading on each other
31 0           my $is_busy;
32              
33             # callback where the poll function should push received data
34             my $on_data = sub {
35 0     0     my ($data) = @_;
36              
37 0           my @updates;
38             try {
39 0           @updates = $self->parse_response($data);
40             }
41             catch {
42 0           $log->error(bleep $_);
43 0 0         die $_ if $self->should_rethrow($args);
44 0           };
45              
46 0           my @retval = $self->process_updates(
47             refs => {
48             data => $data,
49             },
50             source_pairs => { },
51             updates => \@updates,
52             %$args, # may override it all!
53             );
54              
55 0 0         $self->processed(@retval) if $self->can('processed');
56 0           $is_busy = 0;
57 0           };
58              
59             # this is what should be scheduled
60             return sub {
61 0 0   0     return if $is_busy;
62 0           $is_busy = 1; # $on_data below will reset $is_busy when ready
63 0           $self->poll($on_data, $args);
64 0           };
65             }
66              
67             sub schedule {
68 0     0 1   my ($self, $interval, @rest) = @_;
69 0           my $poller = $self->poller(@rest);
70 0           Mojo::IOLoop->timer(0 => $poller);
71 0           Mojo::IOLoop->recurring($interval, $poller);
72 0           return $self;
73             }
74              
75             1;