File Coverage

blib/lib/Mojo/SlackRTM.pm
Criterion Covered Total %
statement 24 146 16.4
branch 0 32 0.0
condition 0 15 0.0
subroutine 8 27 29.6
pod 13 13 100.0
total 45 233 19.3


line stmt bran cond sub pod time code
1             package Mojo::SlackRTM;
2 1     1   24237 use Mojo::Base 'Mojo::EventEmitter';
  1         12721  
  1         10  
3              
4 1     1   3011 use IO::Socket::SSL;
  1         70598  
  1         12  
5 1     1   645 use Mojo::IOLoop;
  1         180458  
  1         14  
6 1     1   773 use Mojo::JSON ();
  1         18841  
  1         42  
7 1     1   764 use Mojo::Log;
  1         1999  
  1         15  
8 1     1   813 use Mojo::UserAgent;
  1         90180  
  1         10  
9 1     1   37 use Scalar::Util ();
  1         1  
  1         24  
10              
11 1     1   6 use constant DEBUG => $ENV{MOJO_SLACKRTM_DEBUG};
  1         1  
  1         1557  
12              
13             our $VERSION = '0.04';
14              
15             has ioloop => sub { Mojo::IOLoop->singleton };
16             has ua => sub { Mojo::UserAgent->new };
17             has log => sub { Mojo::Log->new };
18             has "token";
19             has "pinger";
20             has 'ws';
21             has 'auto_reconnect' => 1;
22              
23             our $SLACK_URL = "https://slack.com/api";
24              
25             sub _dump {
26 0     0     shift;
27 0           require Data::Dumper;
28 0           local $Data::Dumper::Sortkeys = 1;
29 0           local $Data::Dumper::Indent = 1;
30 0           local $Data::Dumper::Terse = 1;
31 0           my $dump = Data::Dumper::Dumper(@_);
32 0 0         if (-t STDOUT) {
33 0           warn " \e[33m$_\e[m\n" for split /\n/, $dump;
34             } else {
35 0           warn " $_\n" for split /\n/, $dump;
36             }
37             }
38              
39             my $TX_ERROR = sub {
40             my $tx = shift;
41             return if $tx->success and $tx->res->json("/ok");
42             if ($tx->success) {
43             my $error = $tx->res->json("/error") || "Unknown error";
44             return $error;
45             } else {
46             my $error = $tx->error;
47             return $error->{code} ? "$error->{code} $error->{message}" : $error->{message};
48             }
49             };
50              
51             sub metadata {
52 0     0 1   my $self = shift;
53 0 0         return $self->{_metadata} unless @_;
54 0           my $metadata = shift;
55 0           $self->{_metadata} = $metadata;
56 0 0         unless ($metadata) {
57 0           $self->{$_} = undef for qw(_users _channels);
58 0           return;
59             }
60             $self->{_users} = [
61 0           +{ map { ($_->{id}, $_->{name}) } @{$metadata->{users}} },
  0            
62 0           +{ map { ($_->{name}, $_->{id}) } @{$metadata->{users}} },
  0            
  0            
63             ];
64             $self->{_channels} = [
65 0           +{ map { ($_->{id}, $_->{name}) } @{$metadata->{channels}} },
  0            
66 0           +{ map { ($_->{name}, $_->{id}) } @{$metadata->{channels}} },
  0            
  0            
67             ];
68 0           $metadata;
69             }
70             sub next_id {
71 0     0 1   my $self = shift;
72 0   0       $self->{_id} //= 0;
73 0           ++$self->{_id};
74             }
75              
76             sub start {
77 0     0 1   my $self = shift;
78 0           $self->connect;
79 0 0         $self->ioloop->start unless $self->ioloop->is_running;
80             }
81              
82             sub connect {
83 0     0 1   my $self = shift;
84 0 0         my $token = $self->token or die "Missing token";
85 0           my $tx = $self->ua->get("$SLACK_URL/rtm.start?token=$token");
86 0 0         if (my $error = $TX_ERROR->($tx)) {
87 0           $self->log->fatal("failed to get $SLACK_URL/rtm.start?token=XXX: $error");
88 0           return;
89             }
90 0           my $metadata = $tx->res->json;
91 0           $self->metadata($metadata);
92 0           my $url = $metadata->{url};
93             $self->ua->websocket($url => sub {
94 0     0     my ($ua, $ws) = @_;
95 0 0         unless ($ws->is_websocket) {
96 0           $self->log->fatal("$url does not return websocket connection");
97 0           return;
98             }
99 0           $self->ws($ws);
100 0           $self->pinger( $self->ioloop->recurring(10 => sub { $self->ping }) );
  0            
101             $self->ws->on(json => sub {
102 0           my ($ws, $event) = @_;
103 0           $self->_handle_event($event);
104 0           });
105             $self->ws->on(finish => sub {
106 0           my ($ws) = @_;
107 0           $self->log->warn("detect 'finish' event");
108 0           $self->_clear;
109 0 0         Mojo::IOLoop->timer(1 => sub { $self->connect }) if $self->auto_reconnect;
  0            
110 0           });
111 0           });
112             }
113              
114             sub finish {
115 0     0 1   my $self = shift;
116 0 0         $self->ws->finish if $self->ws;
117 0           $self->_clear;
118             }
119              
120             sub reconnect {
121 0     0 1   my $self = shift;
122 0           $self->finish;
123 0           $self->connect;
124             }
125              
126             sub _clear {
127 0     0     my $self = shift;
128 0 0         if (my $pinger = $self->pinger) {
129 0           $self->ioloop->remove($pinger);
130 0           $self->pinger(undef);
131             }
132 0           $self->ws(undef);
133 0           $self->metadata(undef);
134 0           $self->{_id} = 0;
135             }
136              
137             sub _handle_event {
138 0     0     my ($self, $event) = @_;
139 0 0         if (my $type = $event->{type}) {
140 0 0 0       if ($type eq "message" and defined(my $reply_to = $event->{reply_to})) {
141 0           DEBUG and $self->log->debug("===> skip 'message' event with reply_to $reply_to");
142 0           DEBUG and $self->_dump($event);
143 0           return;
144             }
145 0           DEBUG and $self->log->debug("===> emit '$type' event");
146 0           DEBUG and $self->_dump($event);
147 0           $self->emit($type, $event);
148             } else {
149 0           DEBUG and $self->log->debug("===> got event without 'type'");
150 0           DEBUG and $self->_dump($event);
151             }
152             }
153              
154             sub ping {
155 0     0 1   my $self = shift;
156 0           my $hash = {id => $self->next_id, type => "ping"};
157 0           DEBUG and $self->log->debug("===> emit 'ping' event");
158 0           DEBUG and $self->_dump($hash);
159 0           $self->ws->send({json => $hash});
160             }
161              
162             sub find_channel_id {
163 0     0 1   my ($self, $name) = @_;
164 0           $self->{_channels}[1]{$name};
165             }
166             sub find_channel_name {
167 0     0 1   my ($self, $id) = @_;
168 0           $self->{_channels}[0]{$id};
169             }
170             sub find_user_id {
171 0     0 1   my ($self, $name) = @_;
172 0           $self->{_users}[1]{$name};
173             }
174             sub find_user_name {
175 0     0 1   my ($self, $id) = @_;
176 0           $self->{_users}[0]{$id};
177             }
178              
179             sub send_message {
180 0     0 1   my ($self, $channel, $text, %option) = @_;
181 0           my $hash = {
182             id => $self->next_id,
183             type => "message",
184             channel => $channel,
185             text => $text,
186             %option,
187             };
188 0           DEBUG and $self->log->debug("===> send message");
189 0           DEBUG and $self->_dump($hash);
190 0           $self->ws->send({json => $hash});
191             }
192              
193             sub call_api {
194 0     0 1   my ($self, $method) = (shift, shift);
195 0           my ($param, $cb);
196 0 0 0       if (@_ and ref $_[-1] eq "CODE") {
197 0           $cb = pop;
198 0           $param = shift;
199             } else {
200 0           $param = shift;
201             }
202 0   0       $param ||= +{};
203             $cb ||= sub {
204 0     0     my ($slack, $tx) = @_;
205 0 0         if (my $error = $TX_ERROR->($tx)) {
206 0           $slack->log->warn("$method: $error");
207             }
208 0   0       };
209              
210             # Data structures like "attachments" need to be serialized to JSON
211 0           for my $key (keys %$param) {
212 0 0 0       if (ref $param->{$key} && !Scalar::Util::blessed($param->{$key})) {
213 0           $param->{$key} = Mojo::JSON::to_json($param->{$key});
214             }
215             }
216              
217 0 0         $param->{token} = $self->token unless exists $param->{token};
218              
219 0           DEBUG and $self->log->debug("===> call api '$method'");
220 0           DEBUG and $self->_dump($param);
221 0           my $url = "$SLACK_URL/$method";
222             $self->ua->post($url => form => $param => sub {
223 0     0     (undef, my $tx) = @_;
224 0           $cb->($self, $tx);
225 0           });
226             }
227              
228             1;
229             __END__