File Coverage

blib/lib/WWW/Pusher/Client.pm
Criterion Covered Total %
statement 38 51 74.5
branch 3 8 37.5
condition 1 5 20.0
subroutine 12 15 80.0
pod 2 3 66.6
total 56 82 68.2


line stmt bran cond sub pod time code
1             package WWW::Pusher::Client;
2             # ABSTRACT: Laughably incomplete Perl client for Pusher WS API
3             $WWW::Pusher::Client::VERSION = '0.03';
4 1     1   82012 use strict;
  1         1  
  1         30  
5 1     1   3 use warnings;
  1         1  
  1         19  
6 1     1   22 use 5.010_001;
  1         7  
  1         23  
7 1     1   446 use Moo;
  1         10320  
  1         5  
8 1     1   1781 use JSON;
  1         8991  
  1         4  
9 1     1   542 use AnyEvent::WebSocket::Client;
  1         127075  
  1         30  
10 1     1   7 use Digest::SHA qw(hmac_sha256_hex);
  1         1  
  1         785  
11              
12              
13             has 'auth_key' => (
14             is => 'ro' ,
15             required => 1
16             );
17              
18             has 'secret' => (
19             is => 'ro',
20             required => 1
21             );
22              
23             has 'channel' => (
24             is => 'rw',
25             predicate => 'has_channel'
26             );
27              
28             has 'client' => (
29             is => 'ro',
30             lazy => 1,
31             default => sub { AnyEvent::WebSocket::Client->new }
32             );
33              
34             has 'ws_url' => (
35             is => 'ro',
36             lazy => 1,
37             builder => sub {
38 4     4   1388 my $self = shift;
39              
40 4         63 return $self->_scheme . $self->_pusher_base . $self->_port
41             . "/app/" . $self->auth_key
42             . "?protocol=" . $self->_protocol
43             . "&client=" . $self->_client_name
44             . "&version=" . $self->_version
45             }
46             );
47              
48             has 'ws_conn' => (
49             is => 'ro',
50             lazy => 1,
51             builder => sub {
52 4     4   351 my $self = shift;
53              
54             # open the connection and immediately ->recv the condvar to
55             # return control back to us
56 4         56 return $self->client->connect($self->ws_url)->recv;
57             }
58             );
59              
60             has '_scheme' => (
61             is => 'ro',
62             default => sub { 'ws' }
63             );
64              
65             has '_port' => (
66             is => 'ro',
67             default => sub { 80 }
68             );
69              
70             has '_pusher_base' => (
71             is => 'ro',
72             default => sub { '://ws.pusherapp.com:' }
73             );
74              
75             has '_protocol' => (
76             is => 'ro',
77             default => sub { 7 }
78             );
79              
80             has '_client_name' => (
81             is => 'ro',
82             default => sub { 'perl-pusher-client' }
83             );
84              
85             has '_version' => (
86             is => 'ro',
87             default => sub { '0.001' }
88             );
89              
90             has '_socket_id' => (
91             is => 'rw'
92             );
93              
94              
95             sub BUILD {
96 4     4 0 82 my $self = shift;
97              
98             $self->ws_conn->on(
99             next_message => sub {
100 0     0   0 my ($conn, $message) = @_;
101 0         0 my $body = from_json($message->decoded_body);
102              
103 0 0       0 if ($body->{event} eq 'pusher:connection_established') {
104 0         0 $self->_socket_id(from_json($body->{data})->{socket_id});
105              
106 0 0       0 $self->subscribe($self->channel) if $self->has_channel;
107             }
108             else {
109 0         0 die 'Connection error?' . $message->decoded_body;
110             }
111 4         61 });
112             }
113              
114              
115             sub subscribe {
116 0     0 1 0 my ($self, $channel) = @_;
117              
118 0         0 my $data = $self->_construct_private_auth_data($channel);
119              
120 0         0 return $self->ws_conn->send(to_json({
121             event => 'pusher:subscribe',
122             data => $data
123             }));
124             }
125              
126             sub _construct_private_auth_data {
127 2     2   340325 my ($self, $channel) = @_;
128 2   33     114 $channel //= $self->channel;
129              
130             # Public channels only need the channel name in the payload
131 2         9 my $data = { channel => $channel };
132              
133             # Private channels need a key:signature in the auth key for
134             # authorization
135 2 100       12 if ($channel =~ /^private-/) {
136 1         4 my $signature = $self->_socket_auth($channel);
137 1         7 $data->{auth} = $self->auth_key . ':' . $signature;
138             }
139              
140 2         4 return $data;
141             }
142              
143             sub _socket_auth {
144 2     2   192029 my ($self, $channel) = @_;
145 2 50       8 die 'Missing socket_id, sorry...' unless $self->_socket_id;
146              
147 2         8 my $plainSignature = $self->_socket_id . ':' . $channel;
148 2         48 return hmac_sha256_hex($plainSignature, $self->secret);
149             }
150              
151              
152             sub trigger {
153 0     0 1   my $self = shift;
154 0   0       my $event = shift // 'ws update';
155 0           my $message = shift;
156              
157 0           $self->ws_conn->send(to_json({
158             event => $event,
159             channel => $self->channel,
160             data => $message
161             }));
162             }
163              
164              
165             1;
166              
167             __END__