File Coverage

blib/lib/Moo/Role/RequestReplyHandler.pm
Criterion Covered Total %
statement 18 79 22.7
branch 0 8 0.0
condition 0 4 0.0
subroutine 6 12 50.0
pod 2 6 33.3
total 26 109 23.8


line stmt bran cond sub pod time code
1             package Moo::Role::RequestReplyHandler;
2 1     1   4204 use Moo::Role;
  1         2  
  1         6  
3 1     1   292 use Filter::signatures;
  1         2  
  1         4  
4 1     1   22 use feature 'signatures';
  1         1  
  1         65  
5 1     1   6 no warnings 'experimental::signatures';
  1         2  
  1         40  
6 1     1   5 use Scalar::Util 'weaken';
  1         2  
  1         40  
7 1     1   437 use Moo::Role::RequestReplyHandler::EventListener;
  1         2  
  1         642  
8              
9             our $VERSION = '0.02';
10              
11             requires 'get_reply_key';
12              
13             has outstanding_messages => (
14             is => 'ro',
15             default => sub { {} },
16             );
17              
18             has event_listeners => (
19             is => 'ro',
20             default => sub { {} },
21             );
22              
23             has message_id => (
24             is => 'rw',
25             default => '0',
26             );
27              
28 0     0 0   sub use_message_id( $self ) {
  0            
  0            
29 0           my $id = $self->message_id;
30 0           $self->message_id( $id++ );
31 0           return $id
32             };
33              
34 0     0 0   sub on_message( $self, $id, $callback ) {
  0            
  0            
  0            
  0            
35 0           $self->outstanding_messages->{$id} = $callback;
36             };
37              
38 0     0 0   sub message_received( $self, $msg ) {
  0            
  0            
  0            
39 0           my $id = $self->get_reply_key( $msg );
40 0 0         if( my $handler = delete $self->outstanding_messages->{$id} ) {
41 0           $handler->($msg);
42             } else {
43 0           warn "Unhandled message '$id' ignored";
44             };
45             }
46              
47 0     0 0   sub event_received( $self, $type, $ev ) {
  0            
  0            
  0            
  0            
48 0           my $handled;
49 0 0         if( my $listeners = $self->event_listeners->{ $type } ) {
50 0           @$listeners = grep { defined $_ } @$listeners;
  0            
51 0           for my $listener (@$listeners) {
52 0           eval {
53 0           $listener->notify( $ev );
54             };
55 0 0         warn $@ if $@;
56             };
57             # re-weaken our references
58 0           for (0..$#$listeners) {
59 0           weaken $listeners->[$_];
60             };
61              
62 0           $handled++;
63             };
64 0           $handled;
65             }
66              
67             =head2 C<< ->add_listener >>
68              
69             my $l = $driver->add_listener(
70             'Page.domContentEventFired',
71             sub {
72             warn "The DOMContent event was fired";
73             },
74             );
75              
76             # ...
77              
78             undef $l; # stop listening
79              
80             Adds a callback for the given event name. The callback will be removed once
81             the return value goes out of scope.
82              
83             =cut
84              
85 0     0 1   sub add_listener( $self, $event, $callback ) {
  0            
  0            
  0            
  0            
86 0           my $listener = Moo::Role::RequestReplyHandler::EventListener->new(
87             target => $self,
88             callback => $callback,
89             event => $event,
90             );
91 0   0       $self->event_listeners->{ $event } ||= [];
92 0           push @{ $self->event_listeners->{ $event }}, $listener;
  0            
93 0           weaken $self->event_listeners->{ $event }->[-1];
94 0           $listener
95             }
96              
97             =head2 C<< ->remove_listener >>
98              
99             $driver->remove_listener($l);
100              
101             Explicitly remove a listener.
102              
103             =cut
104              
105 0     0 1   sub remove_listener( $self, $listener ) {
  0            
  0            
  0            
106             # $listener->{event} can be undef during global destruction
107 0 0         if( my $event = $listener->event ) {
108 0   0       my $l = $self->event_listeners->{ $event } ||= [];
109 0           @{$l} = grep { $_ != $listener }
  0            
110 0           grep { defined $_ }
111 0           @{$self->event_listeners->{ $event }};
  0            
112             # re-weaken our references
113 0           for (0..$#$l) {
114 0           weaken $l->[$_];
115             };
116             };
117             }
118              
119             1;