File Coverage

blib/lib/Slack/RTM/Bot/Client.pm
Criterion Covered Total %
statement 85 195 43.5
branch 16 52 30.7
condition 13 30 43.3
subroutine 17 32 53.1
pod 0 8 0.0
total 131 317 41.3


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