File Coverage

blib/lib/Slack/RTM/Bot/Client.pm
Criterion Covered Total %
statement 85 189 44.9
branch 16 44 36.3
condition 13 27 48.1
subroutine 17 32 53.1
pod 0 8 0.0
total 131 300 43.6


line stmt bran cond sub pod time code
1             package Slack::RTM::Bot::Client;
2            
3 8     8   59 use strict;
  8         19  
  8         246  
4 8     8   45 use warnings;
  8         16  
  8         223  
5            
6 8     8   40 use JSON;
  8         18  
  8         42  
7 8     8   4804 use Encode;
  8         123323  
  8         654  
8 8     8   5041 use Data::Dumper;
  8         50708  
  8         555  
9            
10 8     8   4430 use HTTP::Request::Common qw(POST GET);
  8         165310  
  8         666  
11 8     8   5746 use LWP::UserAgent;
  8         208433  
  8         352  
12 8     8   4198 use LWP::Protocol::https;
  8         743173  
  8         439  
13            
14 8     8   4153 use Protocol::WebSocket::Client;
  8         181270  
  8         313  
15 8     8   77 use IO::Socket::SSL qw/SSL_VERIFY_NONE/;
  8         23  
  8         81  
16            
17 8     8   4603 use Slack::RTM::Bot::Information;
  8         34  
  8         381  
18 8     8   3371 use Slack::RTM::Bot::Response;
  8         42  
  8         16069  
19            
20             my $ua = LWP::UserAgent->new(
21             ssl_opts => {
22             verify_hostname => 0,
23             SSL_verify_mode => SSL_VERIFY_NONE
24             }
25             );
26             $ua->agent('Slack::RTM::Bot');
27            
28             sub new {
29 3     3 0 30 my $pkg = shift;
30 3         13 my $self = {
31             @_
32             };
33 3 50       13 die "token is required." unless $self->{token};
34 3         15 return bless $self, $pkg;
35             }
36            
37             sub connect {
38 1     1 0 2 my $self = shift;
39 1         3 my ($token) = @_;
40            
41 1         6 my $res = $ua->request(POST 'https://slack.com/api/rtm.start', [ token => $token ]);
42 1         309444 my $content;
43 1         3 eval {
44 1         8 $content = JSON::from_json($res->content);
45             };
46 1 50       81 if ($@) {
47 0         0 die 'connect response fail:'.Dumper $res->content;
48             }
49 1 50       52 die 'connect response fail: '.$res->content unless ($content->{ok});
50            
51 0         0 $self->{info} = Slack::RTM::Bot::Information->new(%{$content});
  0         0  
52 0         0 $res = $ua->request(POST 'https://slack.com/api/conversations.list ', [ token => $token ]);
53 0         0 eval {
54 0         0 $content = JSON::decode_json($res->content);
55             };
56 0 0       0 if ($@) {
57 0         0 die 'connect response fail:'.Dumper $res->content;
58             }
59 0 0       0 die 'connect response fail: '.$res->content unless ($content->{ok});
60            
61 0         0 for my $im (@{$content->{channels}}) {
  0         0  
62 0         0 $self->{info}->{channels}->{$im->{id}} = { %$im, name => '@'.$im->{name} };
63             }
64 0         0 $self->_connect;
65             }
66            
67             sub _connect {
68 0     0   0 my $self = shift;
69 0         0 my ($host) = $self->{info}->{url} =~ m{wss://(.+)/websocket};
70 0         0 my $socket = IO::Socket::SSL->new(
71             SSL_verify_mode => SSL_VERIFY_NONE,
72             PeerHost => $host,
73             PeerPort => 443
74             );
75 0         0 $socket->blocking(0);
76 0         0 $socket->connect;
77            
78 0         0 my $ws_client = Protocol::WebSocket::Client->new(url => $self->{info}->{url});
79 0 0       0 $ws_client->{hs}->req->{max_message_size} = $self->{options}->{max_message_size} if $self->{options}->{max_message_size};
80 0 0       0 $ws_client->{hs}->res->{max_message_size} = $self->{options}->{max_message_size} if $self->{options}->{max_message_size};
81             $ws_client->on(read => sub {
82 0     0   0 my ($cli, $buffer) = @_;
83 0         0 $self->_listen($buffer);
84 0         0 });
85             $ws_client->on(write => sub {
86 0     0   0 my ($cli, $buffer) = @_;
87 0         0 syswrite $socket, $buffer;
88 0         0 });
89             $ws_client->on(connect => sub {
90 0 0   0   0 print "RTM (re)connected.\n" if ($self->{options}->{debug});
91 0         0 });
92             $ws_client->on(error => sub {
93 0     0   0 my ($cli, $error) = @_;
94 0         0 print STDERR 'error: '. $error;
95 0         0 });
96 0         0 $ws_client->connect;
97            
98 0         0 $self->{ws_client} = $ws_client;
99 0         0 $self->{socket} = $socket;
100             }
101            
102             sub disconnect {
103 0     0 0 0 my $self = shift;
104 0         0 $self->{ws_client}->disconnect;
105 0         0 undef $self;
106             }
107            
108             sub read {
109 0     0 0 0 my $self = shift;
110 0         0 my $data = '';
111 0         0 while (my $line = readline $self->{socket}) {
112 0         0 $data .= $line;
113             }
114 0 0       0 if ($data) {
115 0         0 $self->{ws_client}->read($data);
116 0         0 return $data =~ /.*hello.*/;
117             }
118             }
119            
120             sub write {
121 0     0 0 0 my $self = shift;
122 0         0 $self->{ws_client}->write(JSON::encode_json({@_}));
123             }
124            
125             sub find_conversation_id {
126 0     0 0 0 my $self = shift;
127 0         0 my ($name) = @_;
128 0         0 my $id = $self->{info}->_find_conversation_id($name);
129 0 0 0     0 $id ||= $self->_refetch_conversation_id($name) or die "There are no conversations of such name: $name";
130 0         0 return $id;
131             }
132            
133             sub _refetch_conversation_id {
134 0     0   0 my $self = shift;
135 0         0 my ($name) = @_;
136 0         0 $self->_refetch_conversations;
137 0         0 return $self->{info}->_find_conversation_id($name);
138             }
139            
140             sub find_conversation_name {
141 1     1 0 2 my $self = shift;
142 1         5 my ($id) = @_;
143 1         7 my $name = $self->{info}->_find_conversation_name($id);
144 1 50 33     5 $name ||= $self->_refetch_conversation_name($id) or warn "There are no conversations of such id: $id";
145 1   33     2 $name ||= $id;
146 1         3 return $name;
147             }
148            
149             sub _refetch_conversation_name {
150 0     0   0 my $self = shift;
151 0         0 my ($id) = @_;
152 0         0 $self->_refetch_conversations;
153 0         0 return $self->{info}->_find_conversation_name($id);
154             }
155            
156             sub _refetch_conversations {
157 0     0   0 my $self = shift;
158 0         0 my $res;
159 0         0 eval {
160 0         0 my $conversations = {};
161 0         0 my $cursor = "";
162 0         0 do {
163 0         0 $res = $ua->request(GET "https://slack.com/api/conversations.list?types=public_channel,private_channel&token=$self->{token}&cursor=$cursor&limit=1000");
164 0         0 my $args = JSON::from_json($res->content);
165 0         0 for my $conversation (@{$args->{channels}}) {
  0         0  
166 0         0 $conversations->{$conversation->{id}} = $conversation;
167             }
168 0         0 $cursor = $args->{response_metadata}->{next_cursor};
169             } until ($cursor eq "");
170 0         0 $self->{info}->{channels} = $conversations;
171             };
172 0 0       0 if ($@) {
173 0         0 die '_refetch_conversations response fail:'.Dumper $res->content;
174             }
175             }
176            
177             sub find_user_name {
178 1     1 0 3 my $self = shift;
179 1         2 my ($id) = @_;
180 1         4 my $name = $self->{info}->_find_user_name($id);
181 1 50 33     4 $name ||= $self->_refetch_user_name($id) or warn "There are no users of such id: $id";
182 1   33     4 $name ||= $id;
183 1         2 return $name;
184             }
185            
186             sub _refetch_user_id {
187 0     0   0 my $self = shift;
188 0         0 my ($name) = @_;
189 0         0 $self->_refetch_users;
190 0         0 return $self->{info}->_find_user_id($name);
191             }
192            
193             sub _refetch_user_name {
194 0     0   0 my $self = shift;
195 0         0 my ($id) = @_;
196 0         0 $self->_refetch_users;
197 0         0 return $self->{info}->_find_user_name($id);
198             }
199            
200             sub _refetch_users {
201 0     0   0 my $self = shift;
202 0         0 my $res;
203 0         0 eval {
204 0         0 my $users = {};
205 0         0 my $cursor = "";
206 0         0 do {
207 0         0 $res = $ua->request(GET "https://slack.com/api/users.list?token=$self->{token}&cursor=$cursor");
208 0         0 my $args = JSON::from_json($res->content);
209 0         0 for my $user (@{$args->{users}}) {
  0         0  
210 0         0 $users->{$user->{id}} = $user;
211             }
212 0         0 $cursor = $args->{response_metadata}->{next_cursor};
213             } until ($cursor eq "");
214 0         0 $self->{info}->{users} = $users;
215             };
216 0 0       0 if ($@) {
217 0         0 die '_refetch_users response fail:'.Dumper $res->content;
218             }
219             }
220            
221             sub _listen {
222 5     5   2776 my $self = shift;
223 5         12 my ($buffer) = @_;
224 5         7 my $buffer_obj;
225 5         9 eval {
226 5         17 $buffer_obj = JSON::from_json($buffer);
227             };
228 5 50       104 if ($@) {
229 0         0 die "response is not json string. : $buffer";
230             }
231 5 50 33     33 if ($buffer_obj->{type} && $buffer_obj->{type} eq 'reconnect_url') {
232 0         0 $self->{info}->{url} = $buffer_obj->{url};
233             }
234            
235 5         11 my ($user, $channel);
236 5 100 66     21 if ($buffer_obj->{user} && !ref($buffer_obj->{user})) {
237 1         5 $user = $self->find_user_name($buffer_obj->{user});
238 1 50       4 warn "There are no users of such id: $buffer_obj->{user}" unless $user;
239             }
240 5 100 100     30 if ($buffer_obj->{channel} && !ref($buffer_obj->{channel})) {
241 1         6 $channel = $self->find_conversation_name($buffer_obj->{channel});
242 1 50       3 warn "There are no conversations of such id: $buffer_obj->{channel}" unless $channel;
243            
244             }
245 5         26 my $response = Slack::RTM::Bot::Response->new(
246             buffer => $buffer_obj,
247             user => $user,
248             channel => $channel
249             );
250 5         36 ACTION: for my $action(@{$self->{actions}}){
  5         18  
251 10         15 for my $key(keys %{$action->{events}}){
  10         31  
252 9         15 my $regex = $action->{events}->{$key};
253 9 100 100     64 if(!defined $response->{$key} || $response->{$key} !~ $regex){
254 5         24 next ACTION;
255             }
256             }
257 5         11 eval {
258 5         17 $action->{routine}->($response);
259             };
260 5 50       1461 if ($@) {
261 0           warn $@;
262 0           kill 9, @{$self->{pids}};
  0            
263 0           exit(1);
264             }
265             }
266             };
267            
268             1;