File Coverage

blib/lib/Mercury/Pattern/Bus.pm
Criterion Covered Total %
statement 27 28 96.4
branch 4 4 100.0
condition n/a
subroutine 6 6 100.0
pod 3 3 100.0
total 40 41 97.5


line stmt bran cond sub pod time code
1             package Mercury::Pattern::Bus;
2             our $VERSION = '0.015';
3             # ABSTRACT: A messaging pattern where all peers share messages
4              
5             #pod =head1 SYNOPSIS
6             #pod
7             #pod =head1 DESCRIPTION
8             #pod
9             #pod =head1 SEE ALSO
10             #pod
11             #pod =cut
12              
13 2     2   15 use Mojo::Base 'Mojo';
  2         6  
  2         15  
14              
15             #pod =attr peers
16             #pod
17             #pod The list of peers connected to this bus.
18             #pod
19             #pod =cut
20              
21             has peers => sub { [] };
22              
23             #pod =method add_peer
24             #pod
25             #pod $pat->add_peer( $tx )
26             #pod
27             #pod Add the given connection as a peer to this bus.
28             #pod
29             #pod =cut
30              
31             sub add_peer {
32 6     6 1 49 my ( $self, $tx ) = @_;
33             $tx->on( message => sub {
34 3     3   28939 my ( $tx, $msg ) = @_;
35 3         14 $self->send_message( $msg, $tx );
36 6         50 } );
37             $tx->on( finish => sub {
38 6     6   288 my ( $tx ) = @_;
39 6         29 $self->remove_peer( $tx );
40 6         81 } );
41 6         38 push @{ $self->peers }, $tx;
  6         22  
42 6         29 return;
43             }
44              
45             #pod =method remove_peer
46             #pod
47             #pod Remove the connection from this bus. Called automatically by the C
48             #pod handler.
49             #pod
50             #pod =cut
51              
52             sub remove_peer {
53 6     6 1 20 my ( $self, $tx ) = @_;
54 6         15 my @peers = @{ $self->peers };
  6         25  
55 6         60 for my $i ( 0.. $#peers ) {
56 12 100       54 if ( $peers[$i] eq $tx ) {
57 6         19 splice @peers, $i, 1;
58 6         34 return;
59             }
60             }
61 0         0 return;
62             }
63              
64             #pod =method send_message
65             #pod
66             #pod $pat->send_message( $message, $from )
67             #pod
68             #pod Send a message to all the peers on this bus. If a C<$from> websocket is
69             #pod specified, will not send to that peer (they should know what they sent).
70             #pod
71             #pod =cut
72              
73             sub send_message {
74 4     4 1 51 my ( $self, $msg, $from_tx ) = @_;
75 4         11 my @peers = @{ $self->peers };
  4         16  
76 4 100       36 if ( $from_tx ) {
77 3         8 @peers = grep { $_ ne $from_tx } @peers;
  12         43  
78             }
79 4         23 $_->send( $msg ) for @peers;
80             }
81              
82              
83             1;
84              
85             __END__