File Coverage

blib/lib/Slack/RTM/Bot.pm
Criterion Covered Total %
statement 42 114 36.8
branch 8 38 21.0
condition 6 6 100.0
subroutine 12 16 75.0
pod 5 6 83.3
total 73 180 40.5


line stmt bran cond sub pod time code
1             package Slack::RTM::Bot;
2              
3 8     8   497638 use 5.008001;
  8         116  
4 8     8   44 use strict;
  8         15  
  8         180  
5 8     8   46 use warnings;
  8         16  
  8         330  
6              
7 8     8   3923 use POSIX qw/sys_wait_h/;
  8         51419  
  8         38  
8              
9 8     8   17662 use JSON;
  8         94254  
  8         40  
10 8     8   4216 use Slack::RTM::Bot::Client;
  8         35  
  8         10132  
11              
12             our $VERSION = "1.14";
13              
14             pipe(READH, WRITEH);
15             select(WRITEH);$|=1;
16             pipe(READH2, WRITEH2);
17             select(WRITEH2);$|=1;
18             select(STDOUT);
19              
20             sub new {
21 7     7 1 5107 my $pkg = shift;
22 7         31 my $self = {
23             @_
24             };
25 7 100       53 die 'need token!' unless $self->{token};
26 6         26 return bless $self, $pkg;
27             }
28              
29             sub start_RTM {
30 1     1 1 47 my $self = shift;
31 1         3 my ($sub) = @_;
32 1         10 $self->_connect($self->{options});
33              
34 0         0 my $parent = $$;
35              
36 0 0       0 if ($^O ne 'MSWin32') {
37 0         0 my @children = ();
38              
39 0         0 my $pid = fork;
40 0         0 push @children, $pid;
41 0 0       0 unless ($pid) {
42 0         0 while (1) {
43 0 0       0 unless (kill 0, $pid) {
44 0         0 kill 9, $pid;
45 0         0 waitpid($pid, WUNTRACED);
46 0         0 last;
47             }
48 0         0 print WRITEH "\n";
49 0         0 sleep 1;
50             }
51             } else {
52 0         0 my $pid = fork;
53 0         0 push @children, $pid;
54 0 0       0 unless ($pid) {
55 0         0 $self->{client}->{pids} = [$parent, @children];
56 0         0 my $i = 0;
57 0         0 while (1) {
58 0 0       0 unless (kill 0, $parent) {
59 0         0 kill 9, $pid;
60 0         0 waitpid($pid, WUNTRACED);
61 0         0 last;
62             }
63 0 0       0 if ($self->{client}->read) {
64 0         0 print WRITEH2 "\n";
65             }
66 0         0 (my $buffer = ) =~ s/\n.*$//;
67 0 0       0 if ($buffer) {
68             $self->{client}->write(
69 0         0 %{JSON::from_json(Encode::decode_utf8($buffer))}
  0         0  
70             );
71             }
72 0 0       0 if (++$i % 30 == 0) {
73             $self->{client}->write(
74 0         0 id => $i,
75             type => 'ping'
76             );
77             }
78             }
79             } else {
80 0         0 $self->{children} = \@children;
81             # wait until connected
82 0         0 ;
83 0 0       0 &$sub($self) if $sub;
84             }
85             };
86             } else {
87 0         0 require threads;
88 0         0 require Thread::Queue;
89              
90             threads->create(
91             sub {
92 0     0   0 while (kill 0, $parent) {
93 0         0 print WRITEH "\n";
94 0         0 sleep 1;
95             }
96             }
97 0         0 )->detach;
98              
99             threads->create(
100             sub {
101 0     0   0 my $i = 0;
102 0         0 while (kill 0, $parent) {
103 0 0       0 if ($self->{client}->read) {
104 0         0 print WRITEH2 "\n";
105             }
106 0         0 (my $buffer = ) =~ s/\n.*$//;
107 0 0       0 if ($buffer) {
108             $self->{client}->write(
109 0         0 %{JSON::from_json(Encode::decode_utf8($buffer))}
  0         0  
110             );
111             }
112 0 0       0 if (++$i % 30 == 0) {
113             $self->{client}->write(
114 0         0 id => $i,
115             type => 'ping'
116             );
117             }
118             }
119             }
120 0         0 )->detach;
121              
122 0         0 $self->{queue} = Thread::Queue->new();
123             $self->{worker} = threads->create(sub {
124 0     0   0 while (defined(my $req = $self->{queue}->dequeue())) {
125 0         0 print WRITEH $req;
126             }
127 0         0 });
128              
129             # wait until connected
130 0         0 ;
131 0 0       0 &$sub($self) if $sub;
132             }
133             }
134              
135             sub stop_RTM {
136 0     0 1 0 my $self = shift;
137              
138 0         0 sleep 1;
139 0         0 $self->{client}->disconnect;
140 0         0 undef $self->{client};
141              
142 0 0       0 if ($^O ne 'MSWin32') {
143 0         0 for my $child (@{$self->{children}}) {
  0         0  
144 0         0 kill 9, $child;
145 0         0 waitpid($child, WUNTRACED);
146             }
147 0         0 undef $self->{children};
148             } else {
149 0         0 $self->{queue}->end();
150 0         0 $self->{worker}->join();
151             }
152             }
153              
154             sub _connect {
155 1     1   2 my $self = shift;
156              
157             my $client = Slack::RTM::Bot::Client->new(
158             token => $self->{token},
159             actions => $self->{actions},
160             options => $self->{options}
161 1         8 );
162 1         5 $client->connect($self->{token});
163              
164 0         0 $self->{client} = $client;
165             }
166              
167             sub say {
168 6     6 1 5393 my $self = shift;
169 6         11 my $args;
170 6 100 100     35 if(!@_ || scalar @_ % 2 != 0) {
171 2         23 die "argument is not a HASH or ARRAY."
172             }
173 4         13 $args = {@_};
174 4 100 100     19 if(!defined $args->{text} || !defined $args->{channel}) {
175 2         19 die "argument needs keys 'text' and 'channel'.";
176             }
177              
178 2 50       24 die "RTM not started." unless $self->{client};
179              
180             my $request = JSON::to_json({
181             type => 'message',
182             subtype => 'bot_message',
183             bot_id => $self->{client}->{info}->{self}->{id},
184             %$args,
185             channel => $self->{client}->find_conversation_id($args->{channel})
186 0         0 })."\n";
187 0         0 print WRITEH $request;
188             }
189              
190             sub on {
191 6     6 1 12 my $self = shift;
192 6 50       23 die "RTM already started." if $self->{info};
193 6         14 my ($events, $routine) = @_;
194 6         10 push @{$self->{actions}}, {
  6         29  
195             events => $events,
196             routine => $routine
197             };
198             }
199              
200             sub add_action {
201 6     6 0 1400 my $self = shift;
202 6         20 $self->on(@_);
203             }
204              
205             1;
206             __END__