File Coverage

blib/lib/AnySan/Provider/Slack.pm
Criterion Covered Total %
statement 30 109 27.5
branch 0 28 0.0
condition 0 23 0.0
subroutine 10 26 38.4
pod 0 7 0.0
total 40 193 20.7


line stmt bran cond sub pod time code
1             package AnySan::Provider::Slack;
2 1     1   819 use strict;
  1         2  
  1         29  
3 1     1   6 use warnings;
  1         2  
  1         43  
4             our $VERSION = '0.06';
5              
6 1     1   5 use base 'AnySan::Provider';
  1         3  
  1         466  
7             our @EXPORT = qw(slack);
8 1     1   772 use AnySan;
  1         11529  
  1         38  
9 1     1   415 use AnySan::Receive;
  1         303  
  1         30  
10 1     1   510 use HTTP::Request::Common;
  1         23503  
  1         80  
11 1     1   614 use AnyEvent::HTTP;
  1         27503  
  1         89  
12 1     1   544 use AnyEvent::SlackRTM;
  1         255839  
  1         42  
13 1     1   10 use JSON;
  1         3  
  1         6  
14 1     1   124 use Encode;
  1         3  
  1         1288  
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           my $rtm = AnyEvent::SlackRTM->new($self->{config}{token});
53             $rtm->on('hello' => sub {
54             # create hash table of users
55 0     0     my $users = {};
56 0           for my $user (@{$self->metadata->{users}}) {
  0            
57 0   0       $users->{$user->{id}} ||= $user;
58 0   0       $users->{$user->{name}} ||= $user;
59             }
60 0           $self->{_users} = $users;
61              
62 0           my $bots = {};
63 0           for my $bot (@{$self->metadata->{bots}}) {
  0            
64 0   0       $bots->{$bot->{id}} ||= $bot;
65 0   0       $bots->{$bot->{name}} ||= $bot;
66             }
67 0           $self->{_bots} = $bots;
68 0           });
69             $rtm->on('message' => sub {
70 0     0     my ($rtm, $message) = @_;
71 0 0         my $metadata = $self->metadata or return;
72 0 0         if ($message->{subtype}) {
73 0   0       my $filter = $self->{config}{subtypes} || [];
74 0 0         return unless grep { $_ eq 'all' || $_ eq $message->{subtype} } @$filter;
  0 0          
75             }
76              
77             # search user nickname
78 0           my $nickname = '';
79 0   0       my $user_id = encode_utf8($message->{user} || '');
80 0           my $user = $self->user($user_id);
81 0           my $bot = $self->bot($user_id);
82 0 0         $nickname = $user->{name} if $user;
83 0 0         $nickname = $bot->{name} if $bot;
84              
85 0           my $receive; $receive = AnySan::Receive->new(
86             provider => 'slack',
87             event => 'message',
88             message => encode_utf8($message->{text} || ''),
89             nickname => encode_utf8($metadata->{self}{name} || ''),
90             from_nickname => $nickname,
91             attribute => {
92             channel => $message->{channel},
93             subtype => $message->{subtype},
94             user => $user,
95             bot => $bot,
96             },
97 0           cb => sub { $self->event_callback($receive, @_) },
98 0   0       );
      0        
99 0           AnySan->broadcast_message($receive);
100 0           });
101             $rtm->on('finish' => sub {
102             # reconnect
103 0     0     undef $self->{rtm};
104 0           while (1) {
105 0           eval { $self->start };
  0            
106 0 0         last unless $@;
107             }
108 0           });
109             $rtm->on('user_change' => sub {
110 0     0     my ($rtm, $message) = @_;
111 0           my $user = $message->{user};
112 0           my $user_id = $user->{id};
113              
114             # remove from cache
115 0 0         if (my $old_user = $self->{_users}{$user_id}) {
116 0           delete $self->{_users}{$user_id};
117 0           delete $self->{_users}{$old_user->{name}};
118             }
119              
120             # add new user info to cache
121 0           $self->{_users}{$user_id} = $user;
122 0           $self->{_users}{$user->{name}} = $user;
123 0           });
124 0           $rtm->start;
125 0           $self->{rtm} = $rtm;
126             }
127              
128             sub event_callback {
129 0     0 0   my($self, $receive, $type, @args) = @_;
130              
131 0 0         if ($type eq 'reply') {
132             $self->_call('chat.postMessage', [
133             channel => $receive->attribute('channel'),
134             text => $args[0],
135             as_user => $self->{config}->{as_user} ? 'true' : 'false',
136             link_names => $self->{config}->{link_names} ? 'true' : 'false',
137 0 0   0     ], sub {});
    0          
138             }
139             }
140              
141             sub send_message {
142 0     0 0   my($self, $message, %args) = @_;
143              
144             $self->_call('chat.postMessage', [
145             text => $message,
146             channel => $args{channel},
147             as_user => $self->{config}->{as_user} ? 'true' : 'false',
148             link_names => $self->{config}->{link_names} ? 'true' : 'false',
149 0 0         %{ $args{params} || +{} },
150 0 0   0     ], sub {});
    0          
151             }
152              
153             sub _call {
154 0     0     my ($self, $method, $params, $cb) = @_;
155             my $req = POST "https://slack.com/api/$method", [
156             token => $self->{config}{token},
157 0           @$params,
158             ];
159 0           my %headers = map { $_ => $req->header($_), } $req->headers->header_field_names;
  0            
160 0   0       my $jd = $self->{json_driver} ||= JSON->new->utf8;
161 0           my $r;
162             $r = http_post $req->uri, $req->content, headers => \%headers, sub {
163 0     0     my $body = shift;
164 0           my $res = $jd->decode($body);
165 0           $cb->($res);
166 0           undef $r;
167 0           };
168             }
169              
170             1;
171             __END__