File Coverage

blib/lib/AnyEvent/SlackRTM.pm
Criterion Covered Total %
statement 30 109 27.5
branch 2 22 9.0
condition 2 14 14.2
subroutine 10 33 30.3
pod 11 11 100.0
total 55 189 29.1


line stmt bran cond sub pod time code
1             package AnyEvent::SlackRTM;
2             $AnyEvent::SlackRTM::VERSION = '1.1';
3 5     5   368149 use v5.14;
  5         49  
4              
5             # ABSTRACT: AnyEvent module for interacting with the Slack RTM API
6              
7 5     5   1663 use AnyEvent;
  5         9043  
  5         125  
8 5     5   2077 use AnyEvent::WebSocket::Client 0.12;
  5         1130780  
  5         176  
9 5     5   39 use Carp;
  5         9  
  5         265  
10 5     5   2346 use Furl;
  5         89697  
  5         164  
11 5     5   2866 use JSON;
  5         42870  
  5         28  
12 5     5   605 use Try::Tiny;
  5         10  
  5         873  
13              
14             our $START_URL = 'https://slack.com/api/rtm.start';
15              
16              
17             sub new {
18 4     4 1 1412 my ($class, $token, $client_opts) = @_;
19              
20 4   100     13 $client_opts //= {};
21 4 100       175 croak "Client options must be passed as a HashRef" unless ref $client_opts eq 'HASH';
22              
23 3         4 my $client;
24             try {
25 3     3   167 $client = AnyEvent::WebSocket::Client->new(%$client_opts);
26             } catch {
27 0     0   0 croak "Can't create client object: $_";
28 3         20 };
29              
30 3         2409 return bless {
31             token => $token,
32             client => $client,
33             registry => {},
34             }, $class;
35             }
36              
37              
38             sub start {
39 0     0 1   my $self = shift;
40              
41 5     5   33 use vars qw( $VERSION );
  5         9  
  5         4088  
42 0   0       $VERSION //= '*-devel';
43              
44 0           my $furl = Furl->new(
45             agent => "AnyEvent::SlackRTM/$VERSION",
46             );
47              
48 0           my $res = $furl->get($START_URL . '?token=' . $self->{token});
49             my $start = try {
50 0     0     decode_json($res->content);
51             }
52             catch {
53 0     0     my $status = $res->status;
54 0           my $message = $res->content;
55 0           croak "unable to start, Slack call failed: $status $message";
56 0           };
57              
58 0           my $ok = $start->{ok};
59 0 0         croak "unable to start, Slack returned an error: $start->{error}"
60             unless $ok;
61              
62             # Store this stuff in case we want it
63 0           $self->{metadata} = $start;
64              
65 0           my $wss = $start->{url};
66 0           my $client = $self->{client};
67              
68             $client->connect($wss)->cb(sub {
69 0     0     my $client = shift;
70              
71             my $conn = try {
72 0           $client->recv;
73             }
74             catch {
75 0           die $_;
76 0           };
77              
78 0           $self->{started}++;
79 0           $self->{id} = 1;
80              
81 0           $self->{conn} = $conn;
82              
83             $self->{pinger} = AnyEvent->timer(
84             after => 60,
85             interval => 60,
86 0           cb => sub { $self->ping },
87 0           );
88              
89 0           $conn->on(each_message => sub { $self->_handle_incoming(@_) });
  0            
90 0           $conn->on(finish => sub { $self->_handle_finish(@_) });
  0            
91 0           });
92             }
93              
94              
95 0   0 0 1   sub metadata { shift->{metadata} // {} }
96             sub quiet {
97 0     0 1   my $self = shift;
98              
99 0 0         if (@_) {
100 0           $self->{quiet} = shift;
101             }
102              
103 0   0       return $self->{quiet} // '';
104             }
105              
106              
107             sub on {
108 0     0 1   my ($self, %registrations) = @_;
109              
110 0           for my $type (keys %registrations) {
111 0           my $cb = $registrations{ $type };
112 0           $self->{registry}{$type} = $cb;
113             }
114             }
115              
116              
117             sub off {
118 0     0 1   my ($self, @types) = @_;
119 0           delete $self->{registry}{$_} for @types;
120             }
121              
122             sub _do {
123 0     0     my ($self, $type, @args) = @_;
124              
125 0 0         if (defined $self->{registry}{$type}) {
126 0           $self->{registry}{$type}->($self, @args);
127             }
128             }
129              
130              
131             sub send {
132 0     0 1   my ($self, $msg) = @_;
133              
134             croak "Cannot send because the Slack connection is not started"
135 0 0         unless $self->{started};
136             croak "Cannot send because Slack has not yet said hello"
137 0 0         unless $self->{said_hello};
138             croak "Cannot send because the connection is finished"
139 0 0         if $self->{finished};
140              
141 0           $msg->{id} = $self->{id}++;
142              
143 0           $self->{conn}->send(encode_json($msg));
144             }
145              
146              
147             sub ping {
148 0     0 1   my ($self, $msg) = @_;
149              
150             $self->send({
151 0   0       %{ $msg // {} },
  0            
152             type => 'ping'
153             });
154             }
155              
156             sub _handle_incoming {
157 0     0     my ($self, $conn, $raw) = @_;
158              
159             my $msg = try {
160 0     0     decode_json($raw->body);
161             }
162             catch {
163 0     0     my $message = $raw->body;
164 0           croak "unable to decode incoming message: $message";
165 0           };
166              
167             # Handle errors when they occur
168 0 0         if ($msg->{error}) {
    0          
    0          
169 0           $self->_handle_error($conn, $msg);
170             }
171              
172             # Handle the initial hello
173             elsif ($msg->{type} eq 'hello') {
174 0           $self->_handle_hello($conn, $msg);
175             }
176              
177             # Periodic response to our pings
178             elsif ($msg->{type} eq 'pong') {
179 0           $self->_handle_pong($conn, $msg);
180             }
181              
182             # And anything else...
183             else {
184 0           $self->_handle_other($conn, $msg);
185             }
186             }
187              
188              
189 0   0 0 1   sub said_hello { shift->{said_hello} // '' }
190 0   0 0 1   sub finished { shift->{finished} // '' }
191              
192             sub _handle_hello {
193 0     0     my ($self, $conn, $msg) = @_;
194              
195 0           $self->{said_hello}++;
196              
197 0           $self->_do(hello => $msg);
198             }
199              
200             sub _handle_error {
201 0     0     my ($self, $conn, $msg) = @_;
202              
203             carp "Error #$msg->{error}{code}: $msg->{error}{msg}"
204 0 0         unless $self->{quiet};
205              
206 0           $self->_do(error => $msg);
207             }
208              
209             sub _handle_pong {
210 0     0     my ($self, $conn, $msg) = @_;
211              
212 0           $self->_do($msg->{type}, $msg);
213             }
214              
215             sub _handle_other {
216 0     0     my ($self, $conn, $msg) = @_;
217              
218 0           $self->_do($msg->{type}, $msg);
219             }
220              
221             sub _handle_finish {
222 0     0     my ($self, $conn) = @_;
223              
224             # Cancel the pinger
225 0           undef $self->{pinger};
226              
227 0           $self->{finished}++;
228              
229 0           $self->_do('finish');
230             }
231              
232              
233 0     0 1   sub close { shift->{conn}->close }
234              
235             __END__