File Coverage

blib/lib/AnySan/Provider/Slack.pm
Criterion Covered Total %
statement 30 110 27.2
branch 0 30 0.0
condition 0 23 0.0
subroutine 10 26 38.4
pod 0 7 0.0
total 40 196 20.4


line stmt bran cond sub pod time code
1             package AnySan::Provider::Slack;
2 1     1   908 use strict;
  1         2  
  1         35  
3 1     1   6 use warnings;
  1         2  
  1         49  
4             our $VERSION = '0.07';
5              
6 1     1   6 use base 'AnySan::Provider';
  1         1  
  1         549  
7             our @EXPORT = qw(slack);
8 1     1   775 use AnySan;
  1         12723  
  1         41  
9 1     1   487 use AnySan::Receive;
  1         397  
  1         33  
10 1     1   531 use HTTP::Request::Common;
  1         21684  
  1         106  
11 1     1   821 use AnyEvent::HTTP;
  1         30639  
  1         122  
12 1     1   787 use AnyEvent::SlackRTM;
  1         309801  
  1         38  
13 1     1   9 use JSON;
  1         3  
  1         5  
14 1     1   133 use Encode;
  1         3  
  1         1225  
15              
16             sub slack {
17 0     0 0   my(%config) = @_;
18              
19 0           my $self = __PACKAGE__->new(
20             client => undef,
21             config => \%config,
22             );
23              
24             # join channels
25 0           my @channels = keys %{ $config{channels} };
  0            
26 0           for my $channel (@channels) {
27             $self->_call('channels.join', [
28             name => $channel,
29 0     0     ], sub {});
30             }
31              
32 0           $self->start;
33              
34 0           return $self;
35             }
36              
37 0     0 0   sub metadata { shift->{rtm}->metadata }
38              
39             sub user {
40 0     0 0   my ($self, $id) = @_;
41 0           return $self->{_users}{$id};
42             }
43              
44             sub bot {
45 0     0 0   my ($self, $id) = @_;
46 0           return $self->{_bots}{$id};
47             }
48              
49             sub start {
50 0     0 0   my $self = shift;
51              
52 0 0         my $client_opt = $self->{config}{timeout} ? { timeout => $self->{config}{timeout} } : undef;
53 0           my $rtm = AnyEvent::SlackRTM->new($self->{config}{token}, $client_opt);
54             $rtm->on('hello' => sub {
55             # create hash table of users
56 0     0     my $users = {};
57 0           for my $user (@{$self->metadata->{users}}) {
  0            
58 0   0       $users->{$user->{id}} ||= $user;
59 0   0       $users->{$user->{name}} ||= $user;
60             }
61 0           $self->{_users} = $users;
62              
63 0           my $bots = {};
64 0           for my $bot (@{$self->metadata->{bots}}) {
  0            
65 0   0       $bots->{$bot->{id}} ||= $bot;
66 0   0       $bots->{$bot->{name}} ||= $bot;
67             }
68 0           $self->{_bots} = $bots;
69 0           });
70             $rtm->on('message' => sub {
71 0     0     my ($rtm, $message) = @_;
72 0 0         my $metadata = $self->metadata or return;
73 0 0         if ($message->{subtype}) {
74 0   0       my $filter = $self->{config}{subtypes} || [];
75 0 0         return unless grep { $_ eq 'all' || $_ eq $message->{subtype} } @$filter;
  0 0          
76             }
77              
78             # search user nickname
79 0           my $nickname = '';
80 0   0       my $user_id = encode_utf8($message->{user} || '');
81 0           my $user = $self->user($user_id);
82 0           my $bot = $self->bot($user_id);
83 0 0         $nickname = $user->{name} if $user;
84 0 0         $nickname = $bot->{name} if $bot;
85              
86 0           my $receive; $receive = AnySan::Receive->new(
87             provider => 'slack',
88             event => 'message',
89             message => encode_utf8($message->{text} || ''),
90             nickname => encode_utf8($metadata->{self}{name} || ''),
91             from_nickname => $nickname,
92             attribute => {
93             channel => $message->{channel},
94             subtype => $message->{subtype},
95             user => $user,
96             bot => $bot,
97             },
98 0           cb => sub { $self->event_callback($receive, @_) },
99 0   0       );
      0        
100 0           AnySan->broadcast_message($receive);
101 0           });
102             $rtm->on('finish' => sub {
103             # reconnect
104 0     0     undef $self->{rtm};
105 0           while (1) {
106 0           eval { $self->start };
  0            
107 0 0         last unless $@;
108             }
109 0           });
110             $rtm->on('user_change' => sub {
111 0     0     my ($rtm, $message) = @_;
112 0           my $user = $message->{user};
113 0           my $user_id = $user->{id};
114              
115             # remove from cache
116 0 0         if (my $old_user = $self->{_users}{$user_id}) {
117 0           delete $self->{_users}{$user_id};
118 0           delete $self->{_users}{$old_user->{name}};
119             }
120              
121             # add new user info to cache
122 0           $self->{_users}{$user_id} = $user;
123 0           $self->{_users}{$user->{name}} = $user;
124 0           });
125 0           $rtm->start;
126 0           $self->{rtm} = $rtm;
127             }
128              
129             sub event_callback {
130 0     0 0   my($self, $receive, $type, @args) = @_;
131              
132 0 0         if ($type eq 'reply') {
133             $self->_call('chat.postMessage', [
134             channel => $receive->attribute('channel'),
135             text => $args[0],
136             as_user => $self->{config}->{as_user} ? 'true' : 'false',
137             link_names => $self->{config}->{link_names} ? 'true' : 'false',
138 0 0   0     ], sub {});
    0          
139             }
140             }
141              
142             sub send_message {
143 0     0 0   my($self, $message, %args) = @_;
144              
145             $self->_call('chat.postMessage', [
146             text => $message,
147             channel => $args{channel},
148             as_user => $self->{config}->{as_user} ? 'true' : 'false',
149             link_names => $self->{config}->{link_names} ? 'true' : 'false',
150 0 0         %{ $args{params} || +{} },
151 0 0   0     ], sub {});
    0          
152             }
153              
154             sub _call {
155 0     0     my ($self, $method, $params, $cb) = @_;
156             my $req = POST "https://slack.com/api/$method", [
157             token => $self->{config}{token},
158 0           @$params,
159             ];
160 0           my %headers = map { $_ => $req->header($_), } $req->headers->header_field_names;
  0            
161 0   0       my $jd = $self->{json_driver} ||= JSON->new->utf8;
162 0           my $r;
163             $r = http_post $req->uri, $req->content, headers => \%headers, sub {
164 0     0     my $body = shift;
165 0           my $res = $jd->decode($body);
166 0           $cb->($res);
167 0           undef $r;
168 0           };
169             }
170              
171             1;
172             __END__