line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package POE::Component::Server::Twirc; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
15452
|
use MooseX::POE; |
|
2
|
|
|
|
|
302435
|
|
|
2
|
|
|
|
|
8
|
|
4
|
|
|
|
|
|
|
|
5
|
2
|
|
|
2
|
|
471769
|
use utf8; |
|
2
|
|
|
|
|
15
|
|
|
2
|
|
|
|
|
8
|
|
6
|
2
|
|
|
2
|
|
1359
|
use Log::Log4perl qw/:easy/; |
|
2
|
|
|
|
|
58997
|
|
|
2
|
|
|
|
|
8
|
|
7
|
2
|
|
|
2
|
|
756
|
use POE qw(Component::Server::IRC); |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
15
|
|
8
|
2
|
|
|
2
|
|
162677
|
use Net::OAuth; |
|
2
|
|
|
|
|
881
|
|
|
2
|
|
|
|
|
45
|
|
9
|
2
|
|
|
2
|
|
902
|
use Digest::SHA; |
|
2
|
|
|
|
|
4722
|
|
|
2
|
|
|
|
|
86
|
|
10
|
2
|
|
|
2
|
|
710
|
use String::Truncate elide => { marker => 'â¦' }; |
|
2
|
|
|
|
|
5527
|
|
|
2
|
|
|
|
|
11
|
|
11
|
2
|
|
|
2
|
|
923
|
use POE::Component::Server::Twirc::LogAppender; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
39
|
|
12
|
2
|
|
|
2
|
|
596
|
use POE::Component::Server::Twirc::State; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
100
|
|
13
|
2
|
|
|
2
|
|
16
|
use Encode qw/decode/; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
102
|
|
14
|
2
|
|
|
2
|
|
8
|
use Try::Tiny; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
87
|
|
15
|
2
|
|
|
2
|
|
8
|
use Scalar::Util qw/reftype weaken/; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
79
|
|
16
|
2
|
|
|
2
|
|
1918
|
use AnyEvent; |
|
2
|
|
|
|
|
7219
|
|
|
2
|
|
|
|
|
53
|
|
17
|
2
|
|
|
2
|
|
885
|
use AnyEvent::Twitter; |
|
2
|
|
|
|
|
112722
|
|
|
2
|
|
|
|
|
53
|
|
18
|
2
|
|
|
2
|
|
834
|
use AnyEvent::Twitter::Stream; |
|
2
|
|
|
|
|
12724
|
|
|
2
|
|
|
|
|
62
|
|
19
|
2
|
|
|
2
|
|
848
|
use HTML::Entities; |
|
2
|
|
|
|
|
21668
|
|
|
2
|
|
|
|
|
233
|
|
20
|
2
|
|
|
2
|
|
1194
|
use Regexp::Common qw/URI/; |
|
2
|
|
|
|
|
4375
|
|
|
2
|
|
|
|
|
9
|
|
21
|
2
|
|
|
2
|
|
36381
|
use JSON::MaybeXS; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
15268
|
|
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
with 'MooseX::Log::Log4perl'; |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
=head1 NAME |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
POE::Component::Server::Twirc - Twitter/IRC gateway |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
=head1 SYNOPSIS |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
use POE::Component::Server::Twirc; |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
POE::Component::Server::Twirc->new; |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
POE::Kernel->run; |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
=head1 DESCRIPTION |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
C<POE::Component::Server::Twirc> provides an IRC/Twitter gateway. Twitter |
40
|
|
|
|
|
|
|
friends are added to a channel and messages they post on twitter appear as |
41
|
|
|
|
|
|
|
channel messages in IRC. The IRC interface supports several Twitter features, |
42
|
|
|
|
|
|
|
including posting status updates, following and un-following Twitter feeds, |
43
|
|
|
|
|
|
|
enabling and disabling mobile device notifications or retweets, sending direct |
44
|
|
|
|
|
|
|
messages, and querying information about specific Twitter users. |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
Friends who are also followers are given "voice" as a visual clue in IRC. |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
=head1 METHODS |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
=head2 new |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
Spawns a POE component encapsulating the Twitter/IRC gateway. |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
Arguments: |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
=over 4 |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
=item irc_server_name |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
(Optional) The name of the IRC server. Defaults to C<twitter.irc>. |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
=cut |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
has irc_server_name => isa => 'Str', is => 'ro', default => 'twitter.irc'; |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
=item irc_server_port |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
(Optional) The port number the IRC server binds to. Defaults to 6667. |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=cut |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
has irc_server_port => isa => 'Int', is => 'ro', default => 6667; |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
=item irc_server_bindaddr |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
(Optional) The local address to bind to. Defaults to '127.0.0.1'. |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
=cut |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
# will be defaulted to INADDR_ANY by POE::Wheel::SocketFactory |
82
|
|
|
|
|
|
|
has irc_server_bindaddr => isa => 'Str', is => 'ro', default => '127.0.0.1'; |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=item irc_mask |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
(Optional) The IRC user/host mask used to restrict connecting users. Defaults to C<*@127.0.0.1>. |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
=cut |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
has irc_mask => isa => 'Str', is => 'ro', default => '*@127.0.0.1'; |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
=item irc_password |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
(Optional) Password used to authenticate to the IRC server. |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
=cut |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
has irc_password => isa => 'Str', is => 'ro'; |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
=item irc_botname |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
(Optional) The name of the channel operator bot. Defaults to C<tweeter>. Select a name |
105
|
|
|
|
|
|
|
that does not conflict with friends, followers, or your own IRC nick. |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=cut |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
has irc_botname => isa => 'Str', is => 'ro', default => 'tweeter'; |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=item irc_botircname |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
(Optional) Text to be used as the channel operator bot's IRC full name. |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
=cut |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
has irc_botircname => isa => 'Str', is => 'ro', default => 'Your friendly Twitter agent'; |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
=item irc_channel |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
(Optional) The name of the channel to use. Defaults to C<&twitter>. |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
=cut |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
has irc_channel => isa => 'Str', is => 'ro', default => '&twitter'; |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
=item selection_count |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
(Optional) How many favorites candidates to display for selection. Defaults to 3. |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
=cut |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
has selection_count => isa => 'Int', is => 'ro', default => 3; |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
=item truncate_to |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
(Optional) When displaying tweets for selection, they will be truncated to this length. |
140
|
|
|
|
|
|
|
Defaults to 60. |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
=cut |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
has truncate_to => isa => 'Int', is => 'ro', default => 60; |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
=item log_channel |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
(Optional) If specified, twirc will post log messages to this channel. |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
=cut |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
has log_channel => isa => 'Str', is => 'ro'; |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
=item state_file |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
(Optional) File used to store state information between sessions, including last message read for |
158
|
|
|
|
|
|
|
replies, direct messages, and timelines. |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
=cut |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
has state_file => isa => 'Str', is => 'ro'; |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
=item plugins |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
(Optional) An array of plugin objects. |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
=cut |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
has plugins => isa => 'ArrayRef[Object]', is => 'ro', default => sub { [] }; |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
=back |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
=cut |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
has irc_nickname => isa => 'Str', is => 'rw', init_arg => undef; |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
has ircd => ( |
180
|
|
|
|
|
|
|
isa => 'POE::Component::Server::IRC', |
181
|
|
|
|
|
|
|
is => 'rw', |
182
|
|
|
|
|
|
|
weak_ref => 1, |
183
|
|
|
|
|
|
|
handles => { |
184
|
|
|
|
|
|
|
add_auth => 'add_auth', |
185
|
|
|
|
|
|
|
is_channel_member => 'state_is_chan_member', |
186
|
|
|
|
|
|
|
nick_exists => 'state_nick_exists', |
187
|
|
|
|
|
|
|
post_ircd => 'yield', |
188
|
|
|
|
|
|
|
user_route => '_state_user_route', |
189
|
|
|
|
|
|
|
}, |
190
|
|
|
|
|
|
|
); |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
has _users_by_nick => |
193
|
|
|
|
|
|
|
traits => [qw/Hash/], |
194
|
|
|
|
|
|
|
isa => 'HashRef[HashRef|Object]', |
195
|
|
|
|
|
|
|
is => 'rw', |
196
|
|
|
|
|
|
|
init_arg => undef, |
197
|
|
|
|
|
|
|
lazy => 1, |
198
|
|
|
|
|
|
|
default => sub { +{ map { lc($$_{screen_name}) => $_ } shift->get_users } }, |
199
|
|
|
|
|
|
|
handles => { |
200
|
|
|
|
|
|
|
set_user => 'set', |
201
|
|
|
|
|
|
|
get_user_by_nick => 'get', |
202
|
|
|
|
|
|
|
delete_user => 'delete', |
203
|
|
|
|
|
|
|
user_nicks => 'keys', |
204
|
|
|
|
|
|
|
}; |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
around set_user => sub { |
207
|
|
|
|
|
|
|
my ( $orig, $self, $user ) = @_; |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
$self->set_user_by_id($user->{id}, $user); |
210
|
|
|
|
|
|
|
$self->$orig(lc $user->{screen_name}, $user); |
211
|
|
|
|
|
|
|
}; |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
around get_user_by_nick => sub { |
214
|
|
|
|
|
|
|
my ( $orig, $self, $nick ) = @_; |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
$self->$orig(lc $nick); |
217
|
|
|
|
|
|
|
}; |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
around delete_user => sub { |
220
|
|
|
|
|
|
|
my ( $orig, $self, $user ) = @_; |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
$self->delete_user_by_id($user->{id}); |
223
|
|
|
|
|
|
|
$self->$orig(lc $user->{screen_name}); |
224
|
|
|
|
|
|
|
}; |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
has has_joined_channel => ( |
227
|
|
|
|
|
|
|
init_arg => undef, |
228
|
|
|
|
|
|
|
is => 'ro', |
229
|
|
|
|
|
|
|
traits => [ qw/Bool/ ], |
230
|
|
|
|
|
|
|
default => 0, |
231
|
|
|
|
|
|
|
handles => { |
232
|
|
|
|
|
|
|
joined_channel => 'set', |
233
|
|
|
|
|
|
|
left_channel => 'unset', |
234
|
|
|
|
|
|
|
}, |
235
|
|
|
|
|
|
|
); |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
has stash => ( |
238
|
|
|
|
|
|
|
init_arg => undef, |
239
|
|
|
|
|
|
|
isa => 'HashRef', |
240
|
|
|
|
|
|
|
traits => [ qw/Hash/ ], |
241
|
|
|
|
|
|
|
is => 'rw', |
242
|
|
|
|
|
|
|
predicate => 'has_stash', |
243
|
|
|
|
|
|
|
clearer => 'clear_stash', |
244
|
|
|
|
|
|
|
handles => { |
245
|
|
|
|
|
|
|
stashed_candidates => [ get => 'candidates' ], |
246
|
|
|
|
|
|
|
stashed_handler => [ get => 'handler' ], |
247
|
|
|
|
|
|
|
stashed_message => [ get => 'message' ], |
248
|
|
|
|
|
|
|
delete_stashed_handler => [ delete => 'handler' ], |
249
|
|
|
|
|
|
|
}, |
250
|
|
|
|
|
|
|
); |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
around stashed_candidates => sub { |
253
|
|
|
|
|
|
|
my ( $orig, $self ) = @_; |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
return @{ $self->$orig || [] }; |
256
|
|
|
|
|
|
|
}; |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
has state => ( |
259
|
|
|
|
|
|
|
isa => 'POE::Component::Server::Twirc::State', |
260
|
|
|
|
|
|
|
is => 'rw', |
261
|
|
|
|
|
|
|
lazy => 1, |
262
|
|
|
|
|
|
|
default => sub { POE::Component::Server::Twirc::State->new }, |
263
|
|
|
|
|
|
|
handles => [qw/ |
264
|
|
|
|
|
|
|
access_token |
265
|
|
|
|
|
|
|
access_token_secret |
266
|
|
|
|
|
|
|
delete_user_by_id |
267
|
|
|
|
|
|
|
followers |
268
|
|
|
|
|
|
|
add_follower_id |
269
|
|
|
|
|
|
|
remove_follower_id |
270
|
|
|
|
|
|
|
is_follower_id |
271
|
|
|
|
|
|
|
followers_updated_at |
272
|
|
|
|
|
|
|
get_user_by_id |
273
|
|
|
|
|
|
|
get_users |
274
|
|
|
|
|
|
|
set_user_by_id |
275
|
|
|
|
|
|
|
store |
276
|
|
|
|
|
|
|
/], |
277
|
|
|
|
|
|
|
); |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
has client_encoding => isa => 'Str', is => 'rw', default => sub { 'utf-8' }; |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
has reconnect_delay => is => 'rw', isa => 'Num', default => 0; |
282
|
|
|
|
|
|
|
has twitter_stream_watcher => ( |
283
|
|
|
|
|
|
|
is => 'rw', |
284
|
|
|
|
|
|
|
clearer => 'disconnect_twitter_stream', |
285
|
|
|
|
|
|
|
predicate => 'has_twitter_stream_watcher', |
286
|
|
|
|
|
|
|
); |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
has authenticated_user => ( |
289
|
|
|
|
|
|
|
is => 'rw', |
290
|
|
|
|
|
|
|
isa => 'HashRef', |
291
|
|
|
|
|
|
|
traits => [ qw/Hash/ ], |
292
|
|
|
|
|
|
|
init_arg => undef, |
293
|
|
|
|
|
|
|
handles => { |
294
|
|
|
|
|
|
|
twitter_screen_name => [ get => 'screen_name' ], |
295
|
|
|
|
|
|
|
twitter_id => [ get => 'id' ], |
296
|
|
|
|
|
|
|
}, |
297
|
|
|
|
|
|
|
); |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
has is_shutting_down => ( |
300
|
|
|
|
|
|
|
is => 'ro', |
301
|
|
|
|
|
|
|
traits => [ qw/Bool/ ], |
302
|
|
|
|
|
|
|
default => 0, |
303
|
|
|
|
|
|
|
handles => { |
304
|
|
|
|
|
|
|
shutting_down => 'set', |
305
|
|
|
|
|
|
|
}, |
306
|
|
|
|
|
|
|
); |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
has twitter_rest_api => ( |
309
|
|
|
|
|
|
|
is => 'ro', |
310
|
|
|
|
|
|
|
lazy => 1, |
311
|
|
|
|
|
|
|
default => sub { |
312
|
|
|
|
|
|
|
my $self = shift; |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
AnyEvent::Twitter->new( |
315
|
|
|
|
|
|
|
$self->_twitter_auth, |
316
|
|
|
|
|
|
|
token => $self->access_token, |
317
|
|
|
|
|
|
|
token_secret => $self->access_token_secret, |
318
|
|
|
|
|
|
|
); |
319
|
|
|
|
|
|
|
}, |
320
|
|
|
|
|
|
|
handles => { |
321
|
|
|
|
|
|
|
twitter_rest_api_request => 'request', |
322
|
|
|
|
|
|
|
}, |
323
|
|
|
|
|
|
|
); |
324
|
|
|
|
|
|
|
|
325
|
0
|
|
|
0
|
0
|
|
sub to_json { JSON::MaybeXS->new->encode($_[1]) } |
326
|
0
|
|
|
0
|
0
|
|
sub to_pretty_json { JSON::MaybeXS->new->pretty>encode($_[1]) } |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
# force build of users by nick hash early |
329
|
0
|
|
|
0
|
0
|
|
sub BUILD { shift->_users_by_nick } |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
event get_authenticated_user => sub { |
332
|
0
|
|
|
0
|
|
|
my $self = $_[OBJECT]; |
333
|
|
|
|
|
|
|
|
334
|
0
|
|
|
|
|
|
$self->twitter(verify_credentials => { include_entities => 1 }, |
335
|
|
|
|
|
|
|
$_[SESSION]->callback('get_authenticated_user_response') |
336
|
|
|
|
|
|
|
); |
337
|
|
|
|
|
|
|
}; |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
event get_authenticated_user_response => sub { |
340
|
0
|
|
|
0
|
|
|
my $self = $_[OBJECT]; |
341
|
0
|
|
|
|
|
|
my ( $r ) = @{ $_[ARG1] }; |
|
0
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
|
343
|
0
|
0
|
|
|
|
|
if ( $r ) { |
344
|
0
|
|
|
|
|
|
$self->authenticated_user($r); |
345
|
0
|
0
|
|
|
|
|
if ( my $status = delete $$r{status} ) { |
346
|
0
|
|
|
|
|
|
$$status{user} = $r; |
347
|
0
|
|
|
|
|
|
$self->set_topic($self->formatted_status_text($status)); |
348
|
|
|
|
|
|
|
} |
349
|
0
|
|
|
|
|
|
$self->yield('connect_twitter_stream'); |
350
|
|
|
|
|
|
|
} |
351
|
|
|
|
|
|
|
else { |
352
|
0
|
|
|
|
|
|
FATAL("Failed to get authenticated user data from twitter (verify_credentials)"); |
353
|
0
|
|
|
|
|
|
$self->yield('poco_shutdown'); |
354
|
|
|
|
|
|
|
} |
355
|
|
|
|
|
|
|
}; |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
my %endpoint_for = ( |
358
|
|
|
|
|
|
|
add_list_member => [ post => 'lists/members/create' ], |
359
|
|
|
|
|
|
|
create_block => [ post => 'blocks/create' ], |
360
|
|
|
|
|
|
|
create_favorite => [ post => 'favorites/create' ], |
361
|
|
|
|
|
|
|
create_friend => [ post => 'friendships/create' ], |
362
|
|
|
|
|
|
|
destroy_block => [ post => 'blocks/destroy' ], |
363
|
|
|
|
|
|
|
destroy_friend => [ post => 'friendships/destroy' ], |
364
|
|
|
|
|
|
|
followers_ids => [ get => 'followers/ids' ], |
365
|
|
|
|
|
|
|
lookup_users => [ get => 'users/lookup' ], |
366
|
|
|
|
|
|
|
new_direct_message => [ post => 'direct_messages/new' ], |
367
|
|
|
|
|
|
|
rate_limit_status => [ get => 'application/rate_limit_status' ], |
368
|
|
|
|
|
|
|
remove_list_member => [ post => 'lists/members/destroy' ], |
369
|
|
|
|
|
|
|
report_spam => [ post => 'users/report_spam' ], |
370
|
|
|
|
|
|
|
retweet => [ post => 'statuses/retweet/:id' ], |
371
|
|
|
|
|
|
|
show_friendship => [ get => 'friendships/show' ], |
372
|
|
|
|
|
|
|
show_user => [ get => 'users/show' ], |
373
|
|
|
|
|
|
|
update => [ post => 'statuses/update' ], |
374
|
|
|
|
|
|
|
update_friendship => [ post => 'friendships/update' ], |
375
|
|
|
|
|
|
|
user_timeline => [ get => 'statuses/user_timeline' ], |
376
|
|
|
|
|
|
|
verify_credentials => [ get => 'account/verify_credentials' ], |
377
|
|
|
|
|
|
|
); |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
sub twitter { |
380
|
0
|
0
|
0
|
0
|
0
|
|
my $cb = ref $_[-1] && reftype $_[-1] eq 'CODE' ? pop : sub {}; |
|
0
|
|
|
0
|
|
|
|
381
|
0
|
|
|
|
|
|
my ( $self, $method, $args ) = @_; |
382
|
0
|
|
|
|
|
|
weaken $self; |
383
|
|
|
|
|
|
|
|
384
|
0
|
0
|
|
|
|
|
my ( $http_method, $endpoint ) = @{ $endpoint_for{$method} || [] } |
|
0
|
0
|
|
|
|
|
|
385
|
|
|
|
|
|
|
or return ERROR("no endopoint defined for $method"); |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
# Flatten array args into comma delimited strings |
388
|
0
|
|
|
|
|
|
for my $k ( keys %$args ) { |
389
|
0
|
0
|
|
|
|
|
$args->{$k} = join ',' => @{ $args->{$k} } if ref $args->{$k} eq ref []; |
|
0
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
} |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
# handle path parameters |
393
|
0
|
|
|
|
|
|
$endpoint =~ s/:(\w+)$/delete $$args{$1}/e; |
|
0
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
|
395
|
0
|
|
|
|
|
|
DEBUG(qq/Twitter API call: $http_method $endpoint ${ \join ', ' => map { "$_ => '$$args{$_}'" } keys %$args }/); |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
|
397
|
0
|
|
|
|
|
|
my $w; $w = $self->twitter_rest_api_request( |
398
|
|
|
|
|
|
|
method => $http_method, |
399
|
|
|
|
|
|
|
api => $endpoint, |
400
|
|
|
|
|
|
|
params => $args, |
401
|
|
|
|
|
|
|
sub { |
402
|
0
|
|
|
0
|
|
|
my ( $header, $r, $reason, $http_response ) = @_; |
403
|
|
|
|
|
|
|
|
404
|
0
|
|
|
|
|
|
undef $w; |
405
|
0
|
0
|
|
|
|
|
if ( $r ) { |
406
|
0
|
|
|
|
|
|
$cb->($r); |
407
|
|
|
|
|
|
|
} |
408
|
|
|
|
|
|
|
else { |
409
|
0
|
|
|
|
|
|
$self->twitter_error(qq/$$header{Status}: $reason => ${ \join ', ' => map { "$$_{code}: $$_{message}" } @{ $http_response->{errors} } }/); |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
} |
411
|
|
|
|
|
|
|
} |
412
|
0
|
|
|
|
|
|
); |
413
|
|
|
|
|
|
|
} |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
sub bot_says { |
416
|
0
|
|
|
0
|
0
|
|
my ($self, $channel, $text) = @_; |
417
|
|
|
|
|
|
|
|
418
|
0
|
|
|
|
|
|
$self->post_ircd('daemon_cmd_privmsg', $self->irc_botname, $channel, $text); |
419
|
|
|
|
|
|
|
}; |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
sub bot_notice { |
422
|
0
|
|
|
0
|
0
|
|
my ($self, $channel, $text) = @_; |
423
|
|
|
|
|
|
|
|
424
|
0
|
|
|
|
|
|
$self->post_ircd(daemon_cmd_notice => $self->irc_botname, $channel, $text); |
425
|
|
|
|
|
|
|
} |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
sub twitter_error { |
429
|
0
|
|
|
0
|
0
|
|
my ($self, $text) = @_; |
430
|
|
|
|
|
|
|
|
431
|
0
|
|
|
|
|
|
$self->bot_notice($self->irc_channel, "Twitter error: $text"); |
432
|
|
|
|
|
|
|
}; |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
# set topic from status, iff newest status |
435
|
|
|
|
|
|
|
sub set_topic { |
436
|
0
|
|
|
0
|
0
|
|
my ($self, $text) = @_; |
437
|
|
|
|
|
|
|
|
438
|
0
|
|
|
|
|
|
$self->post_ircd(daemon_cmd_topic => $self->irc_botname, $self->irc_channel, $text); |
439
|
|
|
|
|
|
|
}; |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
# match any nick |
442
|
|
|
|
|
|
|
sub nicks_alternation { |
443
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
444
|
|
|
|
|
|
|
|
445
|
0
|
|
|
|
|
|
return join '|', map quotemeta, $self->user_nicks; |
446
|
|
|
|
|
|
|
} |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
sub add_user { |
449
|
0
|
|
|
0
|
0
|
|
my ($self, $user) = @_; |
450
|
|
|
|
|
|
|
|
451
|
0
|
|
|
|
|
|
my $nick = $$user{screen_name}; |
452
|
0
|
|
|
|
|
|
TRACE("add_user: $nick"); |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
# handle nick changes |
455
|
0
|
0
|
|
|
|
|
if ( my $current_user = $self->get_user_by_id($$user{id}) ) { |
456
|
0
|
0
|
|
|
|
|
$self->post_ircd(daemon_cmd_nick => $$current_user{screen_name}, $nick) |
457
|
|
|
|
|
|
|
if $nick ne $$current_user{screen_name}; |
458
|
|
|
|
|
|
|
} |
459
|
|
|
|
|
|
|
|
460
|
0
|
|
|
|
|
|
$$user{FRESH} = time; |
461
|
0
|
|
|
|
|
|
$self->set_user($user); |
462
|
|
|
|
|
|
|
|
463
|
0
|
0
|
|
|
|
|
unless ( $self->nick_exists($nick) ) { |
464
|
0
|
|
|
|
|
|
$self->post_ircd(add_spoofed_nick => { nick => $nick, ircname => $$user{name} }); |
465
|
|
|
|
|
|
|
} |
466
|
|
|
|
|
|
|
} |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
sub _twitter_auth { |
469
|
|
|
|
|
|
|
# ROT13: Gjvggre qbrf abg jnag pbafhzre xrl/frperg vapyhqrq va bcra |
470
|
|
|
|
|
|
|
# fbhepr nccf. Gurl frrz gb guvax cebcevrgnel pbqr vf fnsre orpnhfr |
471
|
|
|
|
|
|
|
# gur pbafhzre perqragvnyf ner boshfpngrq. Fb, jr'yy boshfpngr gurz |
472
|
|
|
|
|
|
|
# urer jvgu ebg13 naq jr'yy or "frpher" whfg yvxr n cebcevrgnel ncc. |
473
|
0
|
|
|
0
|
|
|
( grep tr/a-zA-Z/n-za-mN-ZA-M/, map $_, |
474
|
|
|
|
|
|
|
pbafhzre_xrl => 'ntqifMSFhMC0NdSWmBWgtN', |
475
|
|
|
|
|
|
|
pbafhzre_frperg => 'CDDA2pAiDcjb6saxt0LLwezCBV97VPYGAF0LMa0oH', |
476
|
|
|
|
|
|
|
), |
477
|
|
|
|
|
|
|
} |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
sub max_reconnect_delay () { 600 } # ten minutes |
480
|
|
|
|
|
|
|
sub twitter_stream_timeout () { 65 } # should get activity every 30 seconds |
481
|
|
|
|
|
|
|
sub friends_stale_after () { 7*24*3600 } # 1 week |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
sub is_user_stale { |
484
|
0
|
|
|
0
|
0
|
|
my ( $self, $user ) = @_; |
485
|
|
|
|
|
|
|
|
486
|
0
|
|
|
|
|
|
return time - $user->{FRESH} > $self->friends_stale_after; |
487
|
|
|
|
|
|
|
} |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
sub followers_stale_after () { 24*3600 } # 1 day |
490
|
|
|
|
|
|
|
sub are_followers_stale { |
491
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
492
|
|
|
|
|
|
|
|
493
|
0
|
|
|
|
|
|
return time - $self->followers_updated_at > $self->followers_stale_after; |
494
|
|
|
|
|
|
|
} |
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
sub formatted_status_text { |
497
|
0
|
|
|
0
|
0
|
|
my ( $self, $status ) = @_; |
498
|
|
|
|
|
|
|
|
499
|
0
|
|
|
|
|
|
my $is_retweet = !!$$status{retweeted_status}; |
500
|
0
|
|
0
|
|
|
|
my $s = $$status{retweeted_status} || $status; |
501
|
0
|
|
|
|
|
|
my $text = $$s{text}; |
502
|
0
|
0
|
|
|
|
|
for my $e ( reverse @{$$s{entities}{urls} || []} ) { |
|
0
|
|
|
|
|
|
|
503
|
0
|
|
|
|
|
|
my ($start, $end) = @{$$e{indices}}; |
|
0
|
|
|
|
|
|
|
504
|
0
|
|
|
|
|
|
substr $text, $start, $end - $start, "[$$e{display_url}]($$e{url})"; |
505
|
|
|
|
|
|
|
} |
506
|
|
|
|
|
|
|
|
507
|
0
|
|
|
|
|
|
decode_entities($text); |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
# When the status is a retweet from verify_credentials, it doesn't have a user element |
510
|
0
|
|
0
|
|
|
|
my $orig_author = $$s{user}{screen_name} || $$status{entities}{user_mentions}[0]{screen_name}; |
511
|
0
|
0
|
|
|
|
|
$text = "RT \@$orig_author: $text" if $is_retweet; |
512
|
|
|
|
|
|
|
|
513
|
0
|
|
|
|
|
|
return $text; |
514
|
|
|
|
|
|
|
} |
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
event connect_twitter_stream => sub { |
517
|
0
|
|
|
0
|
|
|
weaken(my $self = $_[OBJECT]); |
518
|
|
|
|
|
|
|
|
519
|
0
|
|
|
|
|
|
TRACE('connect_twitter_stream'); |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
my $w = AnyEvent::Twitter::Stream->new( |
522
|
|
|
|
|
|
|
$self->_twitter_auth, |
523
|
|
|
|
|
|
|
token => $self->access_token, |
524
|
|
|
|
|
|
|
token_secret => $self->access_token_secret, |
525
|
|
|
|
|
|
|
method => 'userstream', |
526
|
|
|
|
|
|
|
timeout => $self->twitter_stream_timeout, |
527
|
|
|
|
|
|
|
on_connect => sub { |
528
|
0
|
|
|
0
|
|
|
INFO('Connected to Twitter'); |
529
|
0
|
|
|
|
|
|
$self->bot_notice($self->irc_channel, "Twitter stream connected"); |
530
|
0
|
|
|
|
|
|
$self->reconnect_delay(0); |
531
|
|
|
|
|
|
|
}, |
532
|
|
|
|
|
|
|
on_eof => sub { |
533
|
0
|
|
|
0
|
|
|
$self->disconnect_twitter_stream; |
534
|
0
|
|
|
|
|
|
TRACE("on_eof"); |
535
|
0
|
|
|
|
|
|
$self->bot_notice($self->irc_channel, "Twitter stream disconnected"); |
536
|
0
|
0
|
|
|
|
|
$self->yield('connect_twitter_stream') unless $self->is_shutting_down; |
537
|
|
|
|
|
|
|
}, |
538
|
|
|
|
|
|
|
on_error => sub { |
539
|
0
|
|
|
0
|
|
|
my $e = shift; |
540
|
|
|
|
|
|
|
|
541
|
0
|
|
|
|
|
|
ERROR("on_error: $e"); |
542
|
0
|
|
|
|
|
|
$self->bot_notice($self->irc_channel, "Twitter stream error: $e"); |
543
|
0
|
0
|
|
|
|
|
if ( $e =~ /^420:/ ) { |
544
|
0
|
|
|
|
|
|
FATAL("excessive login rate; shutting down"); |
545
|
0
|
|
|
|
|
|
$self->yield('poco_shutdown'); |
546
|
0
|
|
|
|
|
|
return; |
547
|
|
|
|
|
|
|
} |
548
|
|
|
|
|
|
|
|
549
|
0
|
|
|
|
|
|
$self->disconnect_twitter_stream; |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
# progressively backoff on reconnection attepts to max_reconnect_delay |
552
|
0
|
0
|
|
|
|
|
if ( my $delay = $self->reconnect_delay ) { |
553
|
0
|
|
|
|
|
|
DEBUG("delaying $delay seconds before reconnecting"); |
554
|
|
|
|
|
|
|
} |
555
|
0
|
|
|
|
|
|
my $t; $t = AE::timer $self->reconnect_delay, 0, sub { |
556
|
0
|
|
|
|
|
|
undef $t; |
557
|
0
|
|
0
|
|
|
|
my $next_delay = $self->reconnect_delay * 2 || 1; |
558
|
0
|
0
|
|
|
|
|
$next_delay = $self->max_reconnect_delay if $next_delay > $self->max_reconnect_delay; |
559
|
0
|
|
|
|
|
|
$self->reconnect_delay($next_delay); |
560
|
0
|
|
|
|
|
|
$self->yield('connect_twitter_stream'); |
561
|
0
|
|
|
|
|
|
}; |
562
|
|
|
|
|
|
|
}, |
563
|
|
|
|
|
|
|
on_keepalive => sub { |
564
|
0
|
|
|
0
|
|
|
TRACE("on_keepalive"); |
565
|
|
|
|
|
|
|
}, |
566
|
|
|
|
|
|
|
on_friends => sub { |
567
|
0
|
|
|
0
|
|
|
TRACE("on_friends: ", $self->to_json(@_)); |
568
|
0
|
|
|
|
|
|
$self->yield(friends_ids => shift); |
569
|
|
|
|
|
|
|
}, |
570
|
|
|
|
|
|
|
on_event => sub { |
571
|
0
|
|
|
0
|
|
|
my $msg = shift; |
572
|
|
|
|
|
|
|
|
573
|
0
|
|
|
|
|
|
TRACE("on_event: $$msg{event}"); |
574
|
0
|
|
|
|
|
|
$self->yield(on_event => $msg); |
575
|
|
|
|
|
|
|
}, |
576
|
|
|
|
|
|
|
on_tweet => sub { |
577
|
0
|
|
|
0
|
|
|
my $msg = shift; |
578
|
|
|
|
|
|
|
|
579
|
0
|
|
|
|
|
|
TRACE("on_tweet"); |
580
|
|
|
|
|
|
|
|
581
|
0
|
0
|
|
|
|
|
return unless $self->has_joined_channel; |
582
|
|
|
|
|
|
|
|
583
|
0
|
0
|
|
|
|
|
if ( exists $$msg{sender} ) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
584
|
0
|
|
|
|
|
|
DEBUG('received old style direct_message'); |
585
|
0
|
|
|
|
|
|
$self->yield(on_direct_message => $msg); |
586
|
|
|
|
|
|
|
} |
587
|
|
|
|
|
|
|
elsif ( exists $$msg{text} ) { |
588
|
0
|
|
|
|
|
|
$self->yield(on_tweet => $msg); |
589
|
|
|
|
|
|
|
} |
590
|
|
|
|
|
|
|
elsif ( exists $$msg{direct_message} ) { |
591
|
0
|
|
|
|
|
|
$self->yield(on_direct_message => $$msg{direct_message}); |
592
|
|
|
|
|
|
|
} |
593
|
|
|
|
|
|
|
elsif ( exists $$msg{limit} ) { |
594
|
0
|
|
|
|
|
|
WARN("track limit: $$msg{limit}{track}"); |
595
|
0
|
|
|
|
|
|
$self->bot_notice($self->irc_channel, |
596
|
|
|
|
|
|
|
"Track limit received - $$msg{limit}{track} statuses missed."); |
597
|
|
|
|
|
|
|
} |
598
|
|
|
|
|
|
|
elsif ( exists $$msg{scrub_geo} ) { |
599
|
|
|
|
|
|
|
# $$msg{scrub_geo} = {"user_id":14090452,"user_id_str":"14090452","up_to_status_id":23260136625,"up_to_status_id_str":"23260136625"} |
600
|
0
|
|
|
|
|
|
my $e = $$msg{scrub_geo}; |
601
|
0
|
|
|
|
|
|
INFO("scrub_geo: user_id=$$e{user_id}, up_to_status_id=$$e{up_to_status_id}"); |
602
|
|
|
|
|
|
|
} |
603
|
|
|
|
|
|
|
else { |
604
|
0
|
|
|
|
|
|
ERROR("unexpected message: ", $self->to_pretty_json($msg)); |
605
|
0
|
|
|
|
|
|
$self->bot_notice($self->irc_channel, "Unexpected twitter packet, see the log for details"); |
606
|
|
|
|
|
|
|
} |
607
|
|
|
|
|
|
|
}, |
608
|
|
|
|
|
|
|
on_delete => sub { |
609
|
0
|
|
|
0
|
|
|
TRACE("on_delete"); |
610
|
|
|
|
|
|
|
}, |
611
|
0
|
|
|
|
|
|
); |
612
|
|
|
|
|
|
|
|
613
|
0
|
|
|
|
|
|
$self->twitter_stream_watcher($w); |
614
|
|
|
|
|
|
|
}; |
615
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
sub START { |
617
|
0
|
|
|
0
|
0
|
|
weaken(my $self = $_[OBJECT]); |
618
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
$self->ircd( |
620
|
|
|
|
|
|
|
POE::Component::Server::IRC->spawn( |
621
|
|
|
|
|
|
|
config => { |
622
|
|
|
|
|
|
|
servername => $self->irc_server_name, |
623
|
|
|
|
|
|
|
nicklen => 15, |
624
|
|
|
|
|
|
|
network => 'SimpleNET' |
625
|
|
|
|
|
|
|
}, |
626
|
|
|
|
|
|
|
inline_states => { |
627
|
0
|
|
|
0
|
|
|
_stop => sub { TRACE('[ircd:stop]') }, |
628
|
|
|
|
|
|
|
}, |
629
|
|
|
|
|
|
|
) |
630
|
0
|
|
|
|
|
|
); |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
# register ircd to receive events |
633
|
0
|
|
|
|
|
|
$self->post_ircd('register' ); |
634
|
0
|
|
|
|
|
|
$self->add_auth( |
635
|
|
|
|
|
|
|
mask => $self->irc_mask, |
636
|
|
|
|
|
|
|
password => $self->irc_password, |
637
|
|
|
|
|
|
|
no_tilde => 1, |
638
|
|
|
|
|
|
|
); |
639
|
0
|
|
|
|
|
|
$self->post_ircd('add_listener', port => $self->irc_server_port, |
640
|
|
|
|
|
|
|
bindaddr => $self->irc_server_bindaddr); |
641
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
# add super user |
643
|
0
|
|
|
|
|
|
$self->post_ircd(add_spoofed_nick => { |
644
|
|
|
|
|
|
|
nick => $self->irc_botname, |
645
|
|
|
|
|
|
|
ircname => $self->irc_botircname, |
646
|
|
|
|
|
|
|
}); |
647
|
0
|
|
|
|
|
|
$self->post_ircd(daemon_cmd_join => $self->irc_botname, $self->irc_channel); |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
# logging |
650
|
0
|
0
|
|
|
|
|
if ( $self->log_channel ) { |
651
|
0
|
|
|
|
|
|
$self->post_ircd(daemon_cmd_join => $self->irc_botname, $self->log_channel); |
652
|
0
|
|
|
|
|
|
my $logger = Log::Log4perl->get_logger(''); |
653
|
0
|
|
|
|
|
|
my $appender = Log::Log4perl::Appender->new( |
654
|
|
|
|
|
|
|
'POE::Component::Server::Twirc::LogAppender', |
655
|
|
|
|
|
|
|
name => 'twirc-logger', |
656
|
|
|
|
|
|
|
ircd => $self->ircd, |
657
|
|
|
|
|
|
|
irc_botname => $self->irc_botname, |
658
|
|
|
|
|
|
|
irc_channel => $self->log_channel, |
659
|
|
|
|
|
|
|
); |
660
|
0
|
|
|
|
|
|
$logger->add_appender($appender); |
661
|
|
|
|
|
|
|
} |
662
|
|
|
|
|
|
|
|
663
|
0
|
|
|
|
|
|
POE::Kernel->sig(TERM => 'poco_shutdown'); |
664
|
0
|
|
|
|
|
|
POE::Kernel->sig(INT => 'poco_shutdown'); |
665
|
|
|
|
|
|
|
|
666
|
0
|
|
|
|
|
|
$self->yield('get_authenticated_user'); |
667
|
|
|
|
|
|
|
|
668
|
0
|
|
|
|
|
|
return $self; |
669
|
|
|
|
|
|
|
} |
670
|
|
|
|
|
|
|
|
671
|
|
|
|
|
|
|
# Without detaching the ircd child session, the application will not |
672
|
|
|
|
|
|
|
# shut down. Bug in PoCo::Server::IRC? |
673
|
|
|
|
|
|
|
event _child => sub { |
674
|
0
|
|
|
0
|
|
|
my ($self, $kernel, $event, $child) = @_[OBJECT, KERNEL, ARG0, ARG1]; |
675
|
|
|
|
|
|
|
|
676
|
0
|
|
|
|
|
|
TRACE("[_child] $event $child"); |
677
|
0
|
0
|
|
|
|
|
$kernel->detach_child($child) if $event eq 'create'; |
678
|
|
|
|
|
|
|
}; |
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
event poco_shutdown => sub { |
681
|
0
|
|
|
0
|
|
|
my ($self) = @_; |
682
|
|
|
|
|
|
|
|
683
|
0
|
|
|
|
|
|
TRACE("[poco_shutdown]"); |
684
|
0
|
|
|
|
|
|
$self->shutting_down; |
685
|
0
|
|
|
|
|
|
$self->disconnect_twitter_stream; |
686
|
0
|
|
|
|
|
|
$_[KERNEL]->alarm_remove_all(); |
687
|
0
|
|
|
|
|
|
$self->post_ircd('unregister'); |
688
|
0
|
|
|
|
|
|
$self->post_ircd('shutdown'); |
689
|
0
|
0
|
|
|
|
|
if ( $self->state_file ) { |
690
|
0
|
|
|
0
|
|
|
try { $self->store($self->state_file) } |
691
|
|
|
|
|
|
|
catch { |
692
|
0
|
|
|
0
|
|
|
s/ at .*//s; |
693
|
0
|
|
|
|
|
|
ERROR($_); |
694
|
0
|
|
|
|
|
|
$self->bot_notice($self->irc_channel, "Error storing state file: $_"); |
695
|
0
|
|
|
|
|
|
}; |
696
|
|
|
|
|
|
|
} |
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
# TODO: Why does twirc often fail to shut down? |
699
|
|
|
|
|
|
|
# This is surely the WRONG thing to do, but hit the big red kill switch. |
700
|
0
|
|
|
|
|
|
exit 0; |
701
|
|
|
|
|
|
|
}; |
702
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
######################################################################## |
704
|
|
|
|
|
|
|
# IRC events |
705
|
|
|
|
|
|
|
######################################################################## |
706
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
event ircd_daemon_nick => sub { |
708
|
0
|
|
|
0
|
|
|
my ($self, $sender, $nick) = @_[OBJECT, SENDER, ARG0]; |
709
|
|
|
|
|
|
|
|
710
|
0
|
|
|
|
|
|
TRACE("[ircd_daemon_nick] $nick"); |
711
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
# if it's a nick change, we only get ARG0 and ARG1 |
713
|
0
|
0
|
|
|
|
|
return unless defined $_[ARG2]; |
714
|
0
|
0
|
|
|
|
|
return if $self->user_route($nick) eq 'spoofed'; |
715
|
|
|
|
|
|
|
|
716
|
0
|
|
|
|
|
|
$self->irc_nickname($nick); |
717
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
# Abuse! Calling the private implementation of ircd to force-join the connecting |
719
|
|
|
|
|
|
|
# user to the twitter channel. ircd set's it's heap to $self: see ircd's perldoc. |
720
|
0
|
|
|
|
|
|
$sender->get_heap->_daemon_cmd_join($nick, $self->irc_channel); |
721
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
# Give the user half ops (just a visual cue) |
723
|
0
|
|
|
|
|
|
$self->post_ircd(daemon_cmd_mode => $self->irc_botname, $self->irc_channel, '+h', $nick); |
724
|
|
|
|
|
|
|
}; |
725
|
|
|
|
|
|
|
|
726
|
|
|
|
|
|
|
event ircd_daemon_join => sub { |
727
|
0
|
|
|
0
|
|
|
my($self, $sender, $user, $ch) = @_[OBJECT, SENDER, ARG0, ARG1]; |
728
|
|
|
|
|
|
|
|
729
|
0
|
|
|
|
|
|
TRACE("[ircd_daemon_join] $user, $ch"); |
730
|
0
|
0
|
|
|
|
|
return unless my($nick) = $user =~ /^([^!]+)!/; |
731
|
0
|
0
|
|
|
|
|
return if $self->user_route($nick) eq 'spoofed'; |
732
|
|
|
|
|
|
|
|
733
|
0
|
0
|
0
|
|
|
|
if ( $ch eq $self->irc_channel ) { |
|
|
0
|
|
|
|
|
|
734
|
0
|
|
|
|
|
|
$self->joined_channel; |
735
|
0
|
|
|
|
|
|
TRACE(" joined!"); |
736
|
0
|
|
|
|
|
|
return; |
737
|
|
|
|
|
|
|
} |
738
|
|
|
|
|
|
|
elsif ( $self->log_channel && $ch eq $self->log_channel ) { |
739
|
0
|
|
|
|
|
|
my $appender = Log::Log4perl->appender_by_name('twirc-logger'); |
740
|
0
|
|
|
|
|
|
$appender->dump_history; |
741
|
|
|
|
|
|
|
} |
742
|
|
|
|
|
|
|
else { |
743
|
0
|
|
|
|
|
|
TRACE(" ** part **"); |
744
|
|
|
|
|
|
|
# only one channel allowed |
745
|
0
|
|
|
|
|
|
$sender->get_heap()->_daemon_cmd_part($nick, $ch); |
746
|
|
|
|
|
|
|
} |
747
|
|
|
|
|
|
|
}; |
748
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
event ircd_daemon_part => sub { |
750
|
0
|
|
|
0
|
|
|
my($self, $user_name, $ch) = @_[OBJECT, ARG0, ARG1]; |
751
|
|
|
|
|
|
|
|
752
|
0
|
0
|
|
|
|
|
return unless my($nick) = $user_name =~ /^([^!]+)!/; |
753
|
0
|
0
|
|
|
|
|
return if $nick eq $self->irc_botname; |
754
|
|
|
|
|
|
|
|
755
|
0
|
0
|
|
|
|
|
if ( my $user = $self->get_user_by_nick($nick) ) { |
756
|
0
|
|
|
|
|
|
$self->delete_user($user); |
757
|
|
|
|
|
|
|
} |
758
|
|
|
|
|
|
|
|
759
|
0
|
0
|
0
|
|
|
|
$self->left_channel if $ch eq $self->irc_channel && $nick eq $self->irc_nickname; |
760
|
|
|
|
|
|
|
}; |
761
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
event ircd_daemon_quit => sub { |
763
|
0
|
|
|
0
|
|
|
my($self, $user) = @_[OBJECT, ARG0]; |
764
|
|
|
|
|
|
|
|
765
|
0
|
|
|
|
|
|
TRACE("[ircd_daemon_quit]"); |
766
|
0
|
0
|
|
|
|
|
return unless my($nick) = $user =~ /^([^!]+)!/; |
767
|
0
|
0
|
|
|
|
|
return unless $nick eq $self->irc_nickname; |
768
|
|
|
|
|
|
|
|
769
|
0
|
|
|
|
|
|
$self->left_channel; |
770
|
0
|
|
|
|
|
|
$self->yield('poco_shutdown'); |
771
|
|
|
|
|
|
|
}; |
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
event ircd_daemon_public => sub { |
774
|
0
|
|
|
0
|
|
|
my ($self, $user, $channel, $text) = @_[OBJECT, ARG0, ARG1, ARG2]; |
775
|
|
|
|
|
|
|
|
776
|
0
|
0
|
|
|
|
|
return unless $channel eq $self->irc_channel; |
777
|
|
|
|
|
|
|
|
778
|
0
|
|
|
|
|
|
$text = decode($self->client_encoding, $text); |
779
|
|
|
|
|
|
|
|
780
|
0
|
|
|
|
|
|
$text =~ s/\s+$//; |
781
|
|
|
|
|
|
|
|
782
|
0
|
|
|
|
|
|
my $nick = ( $user =~ m/^(.*)!/)[0]; |
783
|
|
|
|
|
|
|
|
784
|
0
|
|
|
|
|
|
TRACE("[ircd_daemon_public] $nick: $text"); |
785
|
0
|
0
|
|
|
|
|
return unless $nick eq $self->irc_nickname; |
786
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
# give any command handler a shot |
788
|
0
|
0
|
|
|
|
|
if ( $self->has_stash ) { |
789
|
0
|
|
|
|
|
|
DEBUG("stash exists..."); |
790
|
0
|
|
|
|
|
|
my $handler = $self->delete_stashed_handler; |
791
|
0
|
0
|
|
|
|
|
if ( $handler ) { |
792
|
0
|
0
|
|
|
|
|
return if $self->call($handler, $channel, $text); # handled |
793
|
0
|
|
|
|
|
|
$self->clear_stash; |
794
|
|
|
|
|
|
|
} |
795
|
|
|
|
|
|
|
else { |
796
|
0
|
|
|
|
|
|
ERROR("stash exists with no handler"); |
797
|
|
|
|
|
|
|
} |
798
|
|
|
|
|
|
|
# the user ignored a command completion request, kill it |
799
|
0
|
|
|
|
|
|
$self->clear_stash; |
800
|
|
|
|
|
|
|
} |
801
|
|
|
|
|
|
|
|
802
|
0
|
|
|
|
|
|
for my $plugin ( @{$self->plugins} ) { |
|
0
|
|
|
|
|
|
|
803
|
0
|
0
|
0
|
|
|
|
$plugin->preprocess($self, $channel, $nick, \$text) && last |
804
|
|
|
|
|
|
|
if $plugin->can('preprocess'); |
805
|
|
|
|
|
|
|
} |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
# treat "nick: ..." as "post @nick ..." |
808
|
0
|
|
|
|
|
|
my $nick_alternation = $self->nicks_alternation; |
809
|
0
|
|
|
|
|
|
$text =~ s/^(?:post\s+)?($nick_alternation):\s+/post \@$1 /i; |
810
|
|
|
|
|
|
|
|
811
|
0
|
|
|
|
|
|
my ($command, $argstr) = split /\s+/, $text, 2; |
812
|
0
|
0
|
|
|
|
|
if ( $command =~ /^\w+$/ ) { |
813
|
0
|
|
|
|
|
|
my $event = "cmd_$command"; |
814
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
# Give each plugin a opportunity: |
816
|
|
|
|
|
|
|
# - Plugins return true if they swallow the event; false to continue |
817
|
|
|
|
|
|
|
# the processing chain. |
818
|
|
|
|
|
|
|
# - Plugins can modify the text, so pass a ref. |
819
|
0
|
|
|
|
|
|
for my $plugin ( @{$self->plugins} ) { |
|
0
|
|
|
|
|
|
|
820
|
0
|
0
|
0
|
|
|
|
$plugin->$event($self, $channel, $nick, \$argstr) && return |
821
|
|
|
|
|
|
|
if $plugin->can($event); |
822
|
|
|
|
|
|
|
} |
823
|
0
|
0
|
|
|
|
|
if ( $self->can($event) ) { |
824
|
0
|
|
|
|
|
|
$self->yield($event, $channel, $argstr); |
825
|
|
|
|
|
|
|
} |
826
|
|
|
|
|
|
|
else { |
827
|
0
|
|
|
|
|
|
$self->bot_says($channel, qq/I don't understand "$command". Try "help"./) |
828
|
|
|
|
|
|
|
} |
829
|
|
|
|
|
|
|
} |
830
|
|
|
|
|
|
|
else { |
831
|
0
|
|
|
|
|
|
$self->bot_says($channel, qq/That doesn't look like a command. Try "help"./); |
832
|
|
|
|
|
|
|
} |
833
|
|
|
|
|
|
|
}; |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
event ircd_daemon_privmsg => sub { |
836
|
0
|
|
|
0
|
|
|
my ($self, $user, $target_nick, $text) = @_[OBJECT, ARG0..ARG2]; |
837
|
|
|
|
|
|
|
|
838
|
|
|
|
|
|
|
# owning user is the only one allowed to send direct messages |
839
|
0
|
|
|
|
|
|
my $me = $self->irc_nickname; |
840
|
0
|
0
|
|
|
|
|
return unless $user =~ /^\Q$me\E!/; |
841
|
|
|
|
|
|
|
|
842
|
0
|
|
|
|
|
|
$text = decode($self->client_encoding, $text); |
843
|
|
|
|
|
|
|
|
844
|
0
|
0
|
|
|
|
|
unless ( $self->get_user_by_nick($target_nick) ) { |
845
|
|
|
|
|
|
|
# TODO: handle the error the way IRC would?? (What channel?) |
846
|
0
|
|
|
|
|
|
$self->bot_says($self->irc_channel, qq/You don't appear to be following $target_nick; message not sent./); |
847
|
0
|
|
|
|
|
|
return; |
848
|
|
|
|
|
|
|
} |
849
|
|
|
|
|
|
|
|
850
|
0
|
|
|
|
|
|
$self->twitter(new_direct_message => { screen_name => $target_nick, text => $text }); |
851
|
|
|
|
|
|
|
}; |
852
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
event friend_join => sub { |
854
|
0
|
|
|
0
|
|
|
my ( $self, $friend ) = @_[OBJECT, ARG0]; |
855
|
|
|
|
|
|
|
|
856
|
0
|
|
|
|
|
|
my $nick = $$friend{screen_name}; |
857
|
0
|
|
|
|
|
|
TRACE("friend_join: $nick"); |
858
|
|
|
|
|
|
|
|
859
|
0
|
0
|
|
|
|
|
$self->post_ircd(add_spoofed_nick => { nick => $nick, ircname => $$friend{name} }) |
860
|
|
|
|
|
|
|
unless $self->nick_exists($nick); |
861
|
|
|
|
|
|
|
|
862
|
0
|
|
|
|
|
|
$self->post_ircd(daemon_cmd_join => $nick, $self->irc_channel); |
863
|
0
|
0
|
|
|
|
|
if ( $self->is_follower_id($$friend{id}) ) { |
864
|
0
|
|
|
|
|
|
$self->post_ircd(daemon_cmd_mode => $self->irc_botname, $self->irc_channel, '+v', $nick); |
865
|
|
|
|
|
|
|
} |
866
|
|
|
|
|
|
|
}; |
867
|
|
|
|
|
|
|
|
868
|
|
|
|
|
|
|
event lookup_friends => sub { |
869
|
0
|
|
|
0
|
|
|
my ( $self, $session, $ids ) = @_[OBJECT, SESSION, ARG0]; |
870
|
|
|
|
|
|
|
|
871
|
0
|
0
|
|
|
|
|
return unless @$ids; |
872
|
|
|
|
|
|
|
|
873
|
0
|
|
|
|
|
|
$self->twitter(lookup_users => { user_id => $ids }, |
874
|
|
|
|
|
|
|
$session->callback('lookup_friends_response') |
875
|
|
|
|
|
|
|
); |
876
|
|
|
|
|
|
|
}; |
877
|
|
|
|
|
|
|
|
878
|
|
|
|
|
|
|
event lookup_friends_response => sub { |
879
|
0
|
|
|
0
|
|
|
my $self = $_[OBJECT]; |
880
|
0
|
|
|
|
|
|
my ( $r ) = @{ $_[ARG1] }; |
|
0
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
|
882
|
0
|
0
|
|
|
|
|
for my $friend ( @{$r || []} ) { |
|
0
|
|
|
|
|
|
|
883
|
0
|
|
|
|
|
|
delete $friend->{status}; |
884
|
0
|
|
|
|
|
|
$self->add_user($friend); |
885
|
0
|
|
|
|
|
|
$self->yield(friend_join => $friend); |
886
|
|
|
|
|
|
|
} |
887
|
0
|
0
|
|
|
|
|
$self->store($self->state_file) if $self->state_file; |
888
|
|
|
|
|
|
|
}; |
889
|
|
|
|
|
|
|
|
890
|
|
|
|
|
|
|
event get_followers_ids => sub { |
891
|
0
|
|
|
0
|
|
|
weaken(my $self = $_[OBJECT]); |
892
|
|
|
|
|
|
|
|
893
|
0
|
|
|
|
|
|
$self->twitter(followers_ids => { cursor => -1 }, |
894
|
|
|
|
|
|
|
$_[SESSION]->callback(get_followers_ids_response => {}) |
895
|
|
|
|
|
|
|
); |
896
|
|
|
|
|
|
|
}; |
897
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
event get_followers_ids_response => sub { |
899
|
0
|
|
|
0
|
|
|
weaken(my $self = $_[OBJECT]); |
900
|
0
|
|
|
|
|
|
my ( $followers ) = @{ $_[ARG0] }; |
|
0
|
|
|
|
|
|
|
901
|
0
|
|
|
|
|
|
my ( $r ) = @{ $_[ARG1] }; |
|
0
|
|
|
|
|
|
|
902
|
|
|
|
|
|
|
|
903
|
0
|
|
|
|
|
|
$$followers{$_} = undef for @{$$r{ids}}; |
|
0
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
|
905
|
0
|
0
|
|
|
|
|
if ( my $cursor = $r->{next_cursor} ) { |
906
|
0
|
|
|
|
|
|
$self->twitter(follower_ids => { cursor => $cursor }, |
907
|
|
|
|
|
|
|
$_[SESSION]->callback(get_followers_ids_response => $followers) |
908
|
|
|
|
|
|
|
); |
909
|
0
|
|
|
|
|
|
return; |
910
|
|
|
|
|
|
|
} |
911
|
0
|
0
|
|
|
|
|
if ( %$followers ) { |
912
|
0
|
|
|
|
|
|
$self->followers($followers); |
913
|
0
|
|
|
|
|
|
$self->followers_updated_at(time); |
914
|
|
|
|
|
|
|
|
915
|
0
|
|
|
|
|
|
$self->yield('set_voice'); |
916
|
|
|
|
|
|
|
} |
917
|
|
|
|
|
|
|
}; |
918
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
event set_voice => sub { |
920
|
0
|
|
|
0
|
|
|
my $self = $_[OBJECT]; |
921
|
|
|
|
|
|
|
|
922
|
0
|
|
|
|
|
|
for my $user ( $self->get_users ) { |
923
|
0
|
0
|
|
|
|
|
my $mode = $self->is_follower_id($$user{id}) ? '+v' : '-v'; |
924
|
|
|
|
|
|
|
|
925
|
0
|
|
|
|
|
|
$self->post_ircd(daemon_cmd_mode => $self->irc_botname, $self->irc_channel, $mode, |
926
|
|
|
|
|
|
|
$$user{screen_name}); |
927
|
|
|
|
|
|
|
} |
928
|
|
|
|
|
|
|
}; |
929
|
|
|
|
|
|
|
|
930
|
|
|
|
|
|
|
######################################################################## |
931
|
|
|
|
|
|
|
# Twitter events |
932
|
|
|
|
|
|
|
######################################################################## |
933
|
|
|
|
|
|
|
|
934
|
|
|
|
|
|
|
event friends_ids => sub { |
935
|
0
|
|
|
0
|
|
|
my ( $self, $kernel, $friends_ids ) = @_[OBJECT, KERNEL, ARG0]; |
936
|
|
|
|
|
|
|
|
937
|
0
|
|
|
|
|
|
my $buffer = []; |
938
|
0
|
|
|
|
|
|
for my $id ( @$friends_ids ) { |
939
|
0
|
|
|
|
|
|
my $friend = $self->get_user_by_id($id); |
940
|
0
|
0
|
0
|
|
|
|
if ( !$friend || $self->is_user_stale($friend) ) { |
941
|
0
|
|
|
|
|
|
push @$buffer, $id; |
942
|
0
|
0
|
|
|
|
|
if ( @$buffer == 100 ) { |
943
|
0
|
|
|
|
|
|
$self->yield(lookup_friends => [ @$buffer ]); |
944
|
0
|
|
|
|
|
|
$buffer = []; |
945
|
0
|
|
|
|
|
|
$kernel->run_one_timeslice; |
946
|
|
|
|
|
|
|
} |
947
|
|
|
|
|
|
|
} |
948
|
|
|
|
|
|
|
else { |
949
|
0
|
|
|
|
|
|
$self->yield(friend_join => $friend); |
950
|
|
|
|
|
|
|
} |
951
|
|
|
|
|
|
|
} |
952
|
|
|
|
|
|
|
|
953
|
0
|
|
|
|
|
|
$self->yield(lookup_friends => $buffer); |
954
|
0
|
|
|
|
|
|
$self->yield('get_followers_ids'); |
955
|
|
|
|
|
|
|
}; |
956
|
|
|
|
|
|
|
|
957
|
|
|
|
|
|
|
event on_tweet => sub { |
958
|
0
|
|
|
0
|
|
|
my ( $self, $status ) = @_[OBJECT, ARG0]; |
959
|
|
|
|
|
|
|
|
960
|
|
|
|
|
|
|
# add or freshen user |
961
|
0
|
|
|
|
|
|
$self->add_user($$status{user}); |
962
|
|
|
|
|
|
|
|
963
|
0
|
|
|
|
|
|
my $nick = $$status{user}{screen_name}; |
964
|
0
|
|
|
|
|
|
my $text = $self->formatted_status_text($status); |
965
|
0
|
0
|
|
|
|
|
if ( $nick eq $self->irc_nickname ) { |
966
|
0
|
|
|
|
|
|
$self->set_topic($text); |
967
|
|
|
|
|
|
|
} |
968
|
|
|
|
|
|
|
|
969
|
0
|
0
|
|
|
|
|
unless ( $self->is_channel_member($nick, $self->irc_channel) ) { |
970
|
0
|
|
|
|
|
|
$self->post_ircd(daemon_cmd_join => $nick, $self->irc_channel); |
971
|
|
|
|
|
|
|
} |
972
|
|
|
|
|
|
|
|
973
|
0
|
|
|
|
|
|
TRACE("on_tweet: <$nick> $text"); |
974
|
0
|
|
|
|
|
|
$self->post_ircd(daemon_cmd_privmsg => $nick, $self->irc_channel, $_) for split /[\r\n]+/, $text; |
975
|
|
|
|
|
|
|
}; |
976
|
|
|
|
|
|
|
|
977
|
|
|
|
|
|
|
event on_event => sub { |
978
|
0
|
|
|
0
|
|
|
my ( $self, $msg ) = @_[OBJECT, ARG0]; |
979
|
|
|
|
|
|
|
|
980
|
|
|
|
|
|
|
### Potential events: |
981
|
|
|
|
|
|
|
# |
982
|
|
|
|
|
|
|
## implemented: |
983
|
|
|
|
|
|
|
# retweet |
984
|
|
|
|
|
|
|
# follow unfollow |
985
|
|
|
|
|
|
|
# block unblock |
986
|
|
|
|
|
|
|
# favorite unfavorite |
987
|
|
|
|
|
|
|
# |
988
|
|
|
|
|
|
|
## unimplemented: |
989
|
|
|
|
|
|
|
# user_update |
990
|
|
|
|
|
|
|
# list_created list_updated list_destroyed |
991
|
|
|
|
|
|
|
# list_member_added list_member_removed |
992
|
|
|
|
|
|
|
# list_user_subscribed list_user_unsubscribed |
993
|
|
|
|
|
|
|
|
994
|
0
|
|
|
|
|
|
my $method = "on_event_$$msg{event}"; |
995
|
0
|
0
|
|
|
|
|
return $self->$method($msg) if $self->can($method); |
996
|
|
|
|
|
|
|
|
997
|
0
|
|
|
|
|
|
$self->bot_notice($self->irc_channel, "Unhandled Twitter stream event: $$msg{event}"); |
998
|
0
|
|
|
|
|
|
DEBUG("unhandled event", $self->to_pretty_json($msg)); |
999
|
|
|
|
|
|
|
}; |
1000
|
|
|
|
|
|
|
|
1001
|
|
|
|
|
|
|
sub on_event_follow { |
1002
|
0
|
|
|
0
|
0
|
|
my ( $self, $event ) = @_; |
1003
|
|
|
|
|
|
|
|
1004
|
0
|
0
|
|
|
|
|
if ( my $source = $$event{source} ) { |
1005
|
0
|
0
|
|
|
|
|
my $target = $$event{target} or return; |
1006
|
|
|
|
|
|
|
|
1007
|
|
|
|
|
|
|
# new friend |
1008
|
0
|
0
|
|
|
|
|
if ( $$source{id} eq $self->twitter_id ) { |
|
|
0
|
|
|
|
|
|
1009
|
0
|
|
|
|
|
|
$self->yield(friend_join => $target); |
1010
|
0
|
|
|
|
|
|
$self->bot_notice($self->irc_channel, qq/Now following $$target{screen_name}./); |
1011
|
|
|
|
|
|
|
} |
1012
|
|
|
|
|
|
|
|
1013
|
|
|
|
|
|
|
# new follower |
1014
|
|
|
|
|
|
|
elsif ( $$target{id} eq $self->twitter_id ) { |
1015
|
0
|
|
|
|
|
|
$self->bot_notice($self->irc_channel, qq`\@$$source{screen_name} "$$source{name}" ` |
1016
|
|
|
|
|
|
|
. qq`is following you https://twitter.com/$$source{screen_name}`); |
1017
|
0
|
|
|
|
|
|
$self->add_follower_id($$source{id}); |
1018
|
|
|
|
|
|
|
} |
1019
|
|
|
|
|
|
|
} |
1020
|
|
|
|
|
|
|
} |
1021
|
|
|
|
|
|
|
|
1022
|
|
|
|
|
|
|
sub on_event_unfollow { |
1023
|
0
|
|
|
0
|
0
|
|
my ( $self, $event ) = @_; |
1024
|
|
|
|
|
|
|
|
1025
|
0
|
|
|
|
|
|
my $screen_name = $event->{target}{screen_name}; |
1026
|
0
|
0
|
|
|
|
|
if( my $user = $self->get_user_by_nick($screen_name) ) { |
1027
|
0
|
|
|
|
|
|
$self->delete_user($user); |
1028
|
|
|
|
|
|
|
} |
1029
|
0
|
|
|
|
|
|
$self->post_ircd(daemon_cmd_part => $screen_name, $self->irc_channel); |
1030
|
0
|
|
|
|
|
|
$self->post_ircd(del_spooked_nick => $screen_name); |
1031
|
0
|
|
|
|
|
|
$self->bot_notice($self->irc_channel, qq/No longer following $screen_name./); |
1032
|
|
|
|
|
|
|
} |
1033
|
|
|
|
|
|
|
|
1034
|
0
|
|
|
0
|
0
|
|
sub on_event_favorite { shift->_favorite_or_retweet(favorited => @_) } |
1035
|
0
|
|
|
0
|
0
|
|
sub on_event_unfavorite { shift->_favorite_or_retweet(unfavorited => @_) } |
1036
|
0
|
|
|
0
|
0
|
|
sub on_event_retweet { shift->_favorite_or_retweet(retweeted => @_) } |
1037
|
|
|
|
|
|
|
sub _favorite_or_retweet { |
1038
|
0
|
|
|
0
|
|
|
my ( $self, $verb, $event ) = @_; |
1039
|
|
|
|
|
|
|
|
1040
|
0
|
|
|
|
|
|
my $status = $$event{target_object}; |
1041
|
0
|
0
|
|
|
|
|
my $who = $$event{source}{id} eq $self->twitter_id ? 'You' : $$event{source}{screen_name}; |
1042
|
0
|
0
|
|
|
|
|
my $whom = $$event{target}{id} eq $self->twitter_id ? 'your' : "$$event{target}{screen_name}'s"; |
1043
|
0
|
|
|
|
|
|
my $link = "https://twitter.com/$$status{user}{screen_name}/status/$$status{id}"; |
1044
|
0
|
|
|
|
|
|
my $text = $self->formatted_status_text($status); |
1045
|
|
|
|
|
|
|
|
1046
|
0
|
|
|
|
|
|
$self->bot_notice($self->irc_channel, |
1047
|
|
|
|
|
|
|
elide(qq/$who $verb $whom "$text"/, 80, { marker => 'â¦"' }) . " [$link]"); |
1048
|
|
|
|
|
|
|
} |
1049
|
|
|
|
|
|
|
|
1050
|
|
|
|
|
|
|
# No need to alert, here. We also get an on_event_favorite for the same tweet |
1051
|
0
|
|
|
0
|
0
|
|
sub on_event_favorited_retweet {} |
1052
|
|
|
|
|
|
|
|
1053
|
|
|
|
|
|
|
sub on_event_block { |
1054
|
0
|
|
|
0
|
0
|
|
my ( $self, $event ) = @_; |
1055
|
|
|
|
|
|
|
|
1056
|
0
|
|
|
|
|
|
my $target = $$event{target}; |
1057
|
0
|
0
|
|
|
|
|
if ( $self->get_user_by_id($$target{id}) ) { |
1058
|
0
|
|
|
|
|
|
$self->post_ircd(daemon_cmd_mode => |
1059
|
|
|
|
|
|
|
$self->irc_botname, $self->irc_channel, '-v', $$target{screen_name}); |
1060
|
0
|
|
|
|
|
|
$self->remove_follower_id($$target{id}); |
1061
|
|
|
|
|
|
|
} |
1062
|
0
|
|
|
|
|
|
$self->bot_notice($self->irc_channel, qq/You blocked $$target{screen_name}./); |
1063
|
|
|
|
|
|
|
} |
1064
|
|
|
|
|
|
|
|
1065
|
|
|
|
|
|
|
sub on_event_unblock { |
1066
|
0
|
|
|
0
|
0
|
|
my ( $self, $event ) = @_; |
1067
|
|
|
|
|
|
|
|
1068
|
0
|
|
|
|
|
|
my $target = $$event{target}; |
1069
|
0
|
0
|
|
|
|
|
if ( $self->get_user_by_id($$target{id}) ) { |
1070
|
0
|
|
|
|
|
|
$self->post_ircd(daemon_cmd_mode => |
1071
|
|
|
|
|
|
|
$self->irc_botname, $self->irc_channel, '+v', $$target{screen_name}); |
1072
|
|
|
|
|
|
|
} |
1073
|
0
|
|
|
|
|
|
$self->bot_notice($self->irc_channel, qq/You unblocked $$target{screen_name}./); |
1074
|
|
|
|
|
|
|
} |
1075
|
|
|
|
|
|
|
|
1076
|
0
|
|
|
0
|
0
|
|
sub on_event_list_member_added { shift->_list_add_or_remove(qw/added to/, @_) } |
1077
|
0
|
|
|
0
|
0
|
|
sub on_event_list_member_removed { shift->_list_add_or_remove(qw/removed from/, @_) } |
1078
|
|
|
|
|
|
|
sub _list_add_or_remove { |
1079
|
0
|
|
|
0
|
|
|
my ( $self, $verb, $preposition, $event ) = @_; |
1080
|
|
|
|
|
|
|
|
1081
|
0
|
|
|
|
|
|
my $list = $$event{target_object}; |
1082
|
0
|
0
|
|
|
|
|
my $who = $$event{source}{id} eq $self->twitter_id ? 'You' : $$event{source}{screen_name}; |
1083
|
0
|
0
|
|
|
|
|
my $whom = $$event{target}{id} eq $self->twitter_id ? 'you' : $$event{target}{screen_name}; |
1084
|
0
|
|
|
|
|
|
my $link = "https://twitter.com$$list{uri}"; |
1085
|
|
|
|
|
|
|
|
1086
|
0
|
|
|
|
|
|
$self->bot_notice($self->irc_channel, "$who $verb $whom $preposition list [$$list{name}]($link)"); |
1087
|
|
|
|
|
|
|
} |
1088
|
|
|
|
|
|
|
|
1089
|
|
|
|
|
|
|
event on_direct_message => sub { |
1090
|
0
|
|
|
0
|
|
|
my ( $self, $msg ) = @_[OBJECT, ARG0]; |
1091
|
|
|
|
|
|
|
|
1092
|
0
|
0
|
|
|
|
|
if ( $$msg{recipient_screen_name} ne $self->twitter_screen_name ) { |
1093
|
0
|
|
|
|
|
|
INFO('direct message sent to @', $$msg{recipient_screen_name}); |
1094
|
0
|
|
|
|
|
|
return; |
1095
|
|
|
|
|
|
|
} |
1096
|
|
|
|
|
|
|
|
1097
|
0
|
|
|
|
|
|
my $nick = $$msg{sender_screen_name}; |
1098
|
0
|
|
|
|
|
|
my $sender = $$msg{sender}; |
1099
|
|
|
|
|
|
|
|
1100
|
0
|
0
|
|
|
|
|
unless ( $self->nick_exists($nick) ) { |
1101
|
|
|
|
|
|
|
# This shouldn't happen - twitter only allows direct messages to followers, so |
1102
|
|
|
|
|
|
|
# we *should* already have $nick on board. |
1103
|
0
|
|
|
|
|
|
$self->post_ircd(add_spoofed_nick => { nick => $nick, ircname => $$sender{name} }); |
1104
|
0
|
|
|
|
|
|
$self->add_user($sender); |
1105
|
|
|
|
|
|
|
} |
1106
|
|
|
|
|
|
|
|
1107
|
0
|
|
|
|
|
|
my $text = $self->formatted_status_text($msg); |
1108
|
|
|
|
|
|
|
$self->post_ircd(daemon_cmd_privmsg => $nick, $self->irc_nickname, $_) |
1109
|
0
|
|
|
|
|
|
for split /\r?\n/, $text; |
1110
|
|
|
|
|
|
|
}; |
1111
|
|
|
|
|
|
|
|
1112
|
|
|
|
|
|
|
sub on_event_retweeted_retweet { |
1113
|
0
|
|
|
0
|
0
|
|
my ( $self, $msg ) = @_; |
1114
|
|
|
|
|
|
|
|
1115
|
0
|
|
|
|
|
|
my $screen_name = $msg->{source}{screen_name}; |
1116
|
0
|
|
|
|
|
|
my $text = $self->formatted_status_text($msg->{target_object}); |
1117
|
|
|
|
|
|
|
|
1118
|
0
|
|
|
|
|
|
$self->bot_notice($self->irc_channel, "$screen_name retweeted your retweet: $text"); |
1119
|
|
|
|
|
|
|
} |
1120
|
|
|
|
|
|
|
|
1121
|
|
|
|
|
|
|
######################################################################## |
1122
|
|
|
|
|
|
|
# Commands |
1123
|
|
|
|
|
|
|
######################################################################## |
1124
|
|
|
|
|
|
|
|
1125
|
|
|
|
|
|
|
=head2 COMMANDS |
1126
|
|
|
|
|
|
|
|
1127
|
|
|
|
|
|
|
Commands are entered as public messages in the IRC channel in the form: |
1128
|
|
|
|
|
|
|
|
1129
|
|
|
|
|
|
|
command arg1 arg2 ... argn |
1130
|
|
|
|
|
|
|
|
1131
|
|
|
|
|
|
|
Where the arguments, if any, depend upon the command. |
1132
|
|
|
|
|
|
|
|
1133
|
|
|
|
|
|
|
=over 4 |
1134
|
|
|
|
|
|
|
|
1135
|
|
|
|
|
|
|
=item post I<status> |
1136
|
|
|
|
|
|
|
|
1137
|
|
|
|
|
|
|
Post a status update. E.g., |
1138
|
|
|
|
|
|
|
|
1139
|
|
|
|
|
|
|
post Now cooking tweets with twirc! |
1140
|
|
|
|
|
|
|
|
1141
|
|
|
|
|
|
|
=cut |
1142
|
|
|
|
|
|
|
|
1143
|
|
|
|
|
|
|
event cmd_post => sub { |
1144
|
0
|
|
|
0
|
|
|
my ($self, $channel, $text) = @_[OBJECT, ARG0, ARG1]; |
1145
|
|
|
|
|
|
|
|
1146
|
0
|
|
|
|
|
|
TRACE("[cmd_post_status]"); |
1147
|
|
|
|
|
|
|
|
1148
|
0
|
0
|
|
|
|
|
return if $self->status_text_too_long($channel, $text); |
1149
|
|
|
|
|
|
|
|
1150
|
0
|
|
|
|
|
|
$self->twitter(update => { status => $text }, |
1151
|
|
|
|
|
|
|
$_[SESSION]->callback('cmd_post_response') |
1152
|
|
|
|
|
|
|
); |
1153
|
|
|
|
|
|
|
}; |
1154
|
|
|
|
|
|
|
|
1155
|
|
|
|
|
|
|
event cmd_post_response => sub { |
1156
|
0
|
|
|
0
|
|
|
my $self = $_[OBJECT]; |
1157
|
0
|
|
|
|
|
|
my ( $r ) = @{ $_[ARG1] }; |
|
0
|
|
|
|
|
|
|
1158
|
|
|
|
|
|
|
|
1159
|
0
|
0
|
|
|
|
|
TRACE(" update returned $r->{id}") if $r; |
1160
|
|
|
|
|
|
|
}; |
1161
|
|
|
|
|
|
|
|
1162
|
|
|
|
|
|
|
sub status_text_too_long { |
1163
|
0
|
|
|
0
|
0
|
|
my ( $self, $channel, $text ) = @_; |
1164
|
|
|
|
|
|
|
|
1165
|
0
|
0
|
|
|
|
|
if ( (my $n = $self->_calc_text_length($text) - 140) > 0 ) { |
1166
|
0
|
|
|
|
|
|
$self->bot_says($channel, "$n characters too long."); |
1167
|
0
|
|
|
|
|
|
return $n; |
1168
|
|
|
|
|
|
|
} |
1169
|
|
|
|
|
|
|
|
1170
|
0
|
|
|
|
|
|
return; |
1171
|
|
|
|
|
|
|
} |
1172
|
|
|
|
|
|
|
|
1173
|
|
|
|
|
|
|
sub _calc_text_length { |
1174
|
0
|
|
|
0
|
|
|
my ( $self, $text ) = @_; |
1175
|
|
|
|
|
|
|
|
1176
|
0
|
|
|
|
|
|
my $http_urls = $text =~ s/$RE{URI}{HTTP}//g; |
1177
|
0
|
|
|
|
|
|
my $https_urls = $text =~ s/$RE{URI}{HTTP}{-scheme => 'https'}//g; |
1178
|
|
|
|
|
|
|
|
1179
|
0
|
|
|
|
|
|
return length($text) + $http_urls * 20 + $https_urls * 21; |
1180
|
|
|
|
|
|
|
} |
1181
|
|
|
|
|
|
|
|
1182
|
|
|
|
|
|
|
=item follow I<id> |
1183
|
|
|
|
|
|
|
|
1184
|
|
|
|
|
|
|
Follow a new Twitter user, I<id>. In Twitter parlance, this creates a friendship. |
1185
|
|
|
|
|
|
|
|
1186
|
|
|
|
|
|
|
=cut |
1187
|
|
|
|
|
|
|
|
1188
|
|
|
|
|
|
|
event cmd_follow => sub { |
1189
|
0
|
|
|
0
|
|
|
my ($self, $channel, $id) = @_[OBJECT, ARG0, ARG1]; |
1190
|
|
|
|
|
|
|
|
1191
|
0
|
0
|
|
|
|
|
if ( $id !~ /^\w+$/ ) { |
1192
|
0
|
|
|
|
|
|
$self->bot_says($channel, qq/"$id" doesn't look like a user ID to me./); |
1193
|
0
|
|
|
|
|
|
return; |
1194
|
|
|
|
|
|
|
} |
1195
|
|
|
|
|
|
|
|
1196
|
0
|
|
|
|
|
|
$self->twitter(create_friend => { screen_name => $id }); |
1197
|
|
|
|
|
|
|
}; |
1198
|
|
|
|
|
|
|
|
1199
|
|
|
|
|
|
|
=item unfollow I<id> |
1200
|
|
|
|
|
|
|
|
1201
|
|
|
|
|
|
|
Stop following Twitter user I<id>. In Twitter, parlance, this destroys a |
1202
|
|
|
|
|
|
|
friendship. |
1203
|
|
|
|
|
|
|
|
1204
|
|
|
|
|
|
|
=cut |
1205
|
|
|
|
|
|
|
|
1206
|
|
|
|
|
|
|
event cmd_unfollow => sub { |
1207
|
0
|
|
|
0
|
|
|
my ($self, $channel, $id) = @_[OBJECT, ARG0, ARG1]; |
1208
|
|
|
|
|
|
|
|
1209
|
0
|
|
|
|
|
|
my $user = $self->get_user_by_nick($id); |
1210
|
0
|
0
|
|
|
|
|
unless ( $user ) { |
1211
|
0
|
|
|
|
|
|
$self->bot_says($channel, qq/You don't appear to be following $id./); |
1212
|
0
|
|
|
|
|
|
return; |
1213
|
|
|
|
|
|
|
} |
1214
|
|
|
|
|
|
|
|
1215
|
0
|
|
|
|
|
|
$self->twitter(destroy_friend => { screen_name => $id }); |
1216
|
|
|
|
|
|
|
}; |
1217
|
|
|
|
|
|
|
|
1218
|
|
|
|
|
|
|
=item block I<id> |
1219
|
|
|
|
|
|
|
|
1220
|
|
|
|
|
|
|
Block Twitter user I<id>. |
1221
|
|
|
|
|
|
|
|
1222
|
|
|
|
|
|
|
=cut |
1223
|
|
|
|
|
|
|
|
1224
|
|
|
|
|
|
|
event cmd_block => sub { |
1225
|
0
|
|
|
0
|
|
|
my ($self, $channel, $id) = @_[OBJECT, ARG0, ARG1]; |
1226
|
|
|
|
|
|
|
|
1227
|
0
|
0
|
|
|
|
|
if ( $id !~ /^\w+$/ ) { |
1228
|
0
|
|
|
|
|
|
$self->bot_says($channel, qq/"$id" doesn't look like a user ID to me./); |
1229
|
0
|
|
|
|
|
|
return; |
1230
|
|
|
|
|
|
|
} |
1231
|
|
|
|
|
|
|
|
1232
|
0
|
|
|
|
|
|
$self->twitter(create_block => { screen_name => $id }); |
1233
|
|
|
|
|
|
|
}; |
1234
|
|
|
|
|
|
|
|
1235
|
|
|
|
|
|
|
=item unblock I<id> |
1236
|
|
|
|
|
|
|
|
1237
|
|
|
|
|
|
|
Stop blocking Twitter user I<id>. |
1238
|
|
|
|
|
|
|
|
1239
|
|
|
|
|
|
|
=cut |
1240
|
|
|
|
|
|
|
|
1241
|
|
|
|
|
|
|
event cmd_unblock => sub { |
1242
|
0
|
|
|
0
|
|
|
my ( $self, $channel, $id ) = @_[OBJECT, ARG0, ARG1]; |
1243
|
|
|
|
|
|
|
|
1244
|
0
|
0
|
|
|
|
|
if ( $id !~ /^\w+$/ ) { |
1245
|
0
|
|
|
|
|
|
$self->bot_says($self->irc_channel, qq/"$id" doesn't look like a Twitter screen name to me./); |
1246
|
0
|
|
|
|
|
|
return; |
1247
|
|
|
|
|
|
|
} |
1248
|
|
|
|
|
|
|
|
1249
|
0
|
|
|
|
|
|
$self->twitter(destroy_block => { screen_name => $id}); |
1250
|
|
|
|
|
|
|
}; |
1251
|
|
|
|
|
|
|
|
1252
|
|
|
|
|
|
|
=item whois I<id> |
1253
|
|
|
|
|
|
|
|
1254
|
|
|
|
|
|
|
Displays information about Twitter user I<id>, including name, location, and |
1255
|
|
|
|
|
|
|
description. |
1256
|
|
|
|
|
|
|
|
1257
|
|
|
|
|
|
|
=cut |
1258
|
|
|
|
|
|
|
|
1259
|
|
|
|
|
|
|
event cmd_whois => sub { |
1260
|
0
|
|
|
0
|
|
|
my ($self, $channel, $nick) = @_[OBJECT, ARG0, ARG1]; |
1261
|
|
|
|
|
|
|
|
1262
|
0
|
|
|
|
|
|
TRACE("[cmd_whois] $nick"); |
1263
|
|
|
|
|
|
|
|
1264
|
|
|
|
|
|
|
|
1265
|
0
|
0
|
|
|
|
|
if ( my $user = $self->get_user_by_nick($nick) ) { |
1266
|
0
|
|
|
|
|
|
$self->yield('cmd_whois_response' => [ $channel, $nick ], [ $user ]); |
1267
|
|
|
|
|
|
|
} |
1268
|
|
|
|
|
|
|
else { |
1269
|
0
|
|
|
|
|
|
TRACE(" $nick not in users; fetching"); |
1270
|
0
|
|
|
|
|
|
$self->twitter(show_user => { screen_name => $nick }, |
1271
|
|
|
|
|
|
|
$_[SESSION]->callback(cmd_whois_response => $channel, $nick) |
1272
|
|
|
|
|
|
|
); |
1273
|
|
|
|
|
|
|
} |
1274
|
|
|
|
|
|
|
}; |
1275
|
|
|
|
|
|
|
|
1276
|
|
|
|
|
|
|
event cmd_whois_response => sub { |
1277
|
0
|
|
|
0
|
|
|
my $self = $_[OBJECT]; |
1278
|
0
|
|
|
|
|
|
my ( $channel, $nick ) = @{ $_[ARG0] }; |
|
0
|
|
|
|
|
|
|
1279
|
0
|
|
|
|
|
|
my ( $user ) = @{ $_[ARG1] }; |
|
0
|
|
|
|
|
|
|
1280
|
|
|
|
|
|
|
|
1281
|
0
|
0
|
|
|
|
|
if ( $user ) { |
1282
|
0
|
|
|
|
|
|
$self->bot_says($channel, sprintf '%s [%s]: %s, %s', |
1283
|
0
|
|
|
|
|
|
@{$user}{qw/screen_name id name/}, |
1284
|
|
|
|
|
|
|
(map decode_entities(defined $_ ? $_ : ''), |
1285
|
0
|
0
|
|
|
|
|
@{$user}{qw/location description/}), |
1286
|
|
|
|
|
|
|
$$user{url} |
1287
|
|
|
|
|
|
|
); |
1288
|
|
|
|
|
|
|
} |
1289
|
|
|
|
|
|
|
else { |
1290
|
0
|
|
|
|
|
|
$self->bot_says($channel, "I don't know $nick."); |
1291
|
|
|
|
|
|
|
} |
1292
|
|
|
|
|
|
|
}; |
1293
|
|
|
|
|
|
|
|
1294
|
|
|
|
|
|
|
=item notify I<on|off> I<screen_name ...> |
1295
|
|
|
|
|
|
|
|
1296
|
|
|
|
|
|
|
Turns mobile device notifications on or off for the list of I<screen_name>s. |
1297
|
|
|
|
|
|
|
|
1298
|
|
|
|
|
|
|
=cut |
1299
|
|
|
|
|
|
|
|
1300
|
|
|
|
|
|
|
event cmd_notify => sub { |
1301
|
0
|
|
|
0
|
|
|
my $self = $_[OBJECT]; |
1302
|
0
|
|
|
|
|
|
$self->call(_update_fship => 'device', @_[ARG0, ARG1]); |
1303
|
|
|
|
|
|
|
}; |
1304
|
|
|
|
|
|
|
|
1305
|
|
|
|
|
|
|
=item retweets I<on|off> I<screen_name ...> |
1306
|
|
|
|
|
|
|
|
1307
|
|
|
|
|
|
|
Turns retweet display on your timeline on or off for the list of |
1308
|
|
|
|
|
|
|
I<screen_name>s. |
1309
|
|
|
|
|
|
|
|
1310
|
|
|
|
|
|
|
=cut |
1311
|
|
|
|
|
|
|
|
1312
|
|
|
|
|
|
|
event cmd_retweets => sub { |
1313
|
0
|
|
|
0
|
|
|
my $self = $_[OBJECT]; |
1314
|
0
|
|
|
|
|
|
$self->call(_update_fship => 'retweets', @_[ARG0, ARG1]); |
1315
|
|
|
|
|
|
|
}; |
1316
|
|
|
|
|
|
|
|
1317
|
|
|
|
|
|
|
# Call update_friendships |
1318
|
|
|
|
|
|
|
# All settings updated at once so existing must be preserved |
1319
|
|
|
|
|
|
|
event _update_fship => sub { |
1320
|
0
|
|
|
0
|
|
|
my ($self, $command, $channel, $argstr) = @_[OBJECT, ARG0..ARG2]; |
1321
|
|
|
|
|
|
|
|
1322
|
0
|
|
|
|
|
|
my @nicks = split /\s+/, $argstr; |
1323
|
0
|
|
|
|
|
|
my $onoff = shift @nicks; |
1324
|
|
|
|
|
|
|
|
1325
|
0
|
0
|
0
|
|
|
|
unless ( $onoff && $onoff =~ /^on$|^off$/ ) { |
1326
|
0
|
|
|
|
|
|
$self->bot_says($channel, "Usage: $command on|off nick[ nick [...]]"); |
1327
|
0
|
|
|
|
|
|
return; |
1328
|
|
|
|
|
|
|
} |
1329
|
|
|
|
|
|
|
|
1330
|
0
|
0
|
|
|
|
|
my $setting = $onoff eq 'on' ? 1 : 0; |
1331
|
0
|
|
|
|
|
|
for my $nick ( @nicks ) { |
1332
|
0
|
|
|
|
|
|
$self->twitter(show_friendship => { target_screen_name => $nick }, |
1333
|
|
|
|
|
|
|
$_[SESSION]->callback( _update_fship_response => |
1334
|
|
|
|
|
|
|
$command, $channel, $nick, $setting |
1335
|
|
|
|
|
|
|
) |
1336
|
|
|
|
|
|
|
); |
1337
|
|
|
|
|
|
|
} |
1338
|
|
|
|
|
|
|
}; |
1339
|
|
|
|
|
|
|
|
1340
|
|
|
|
|
|
|
event _update_fship_response => sub { |
1341
|
0
|
|
|
0
|
|
|
my $self = $_[OBJECT]; |
1342
|
0
|
0
|
|
|
|
|
my ( $r ) = @{ $_[ARG1] } or return; |
|
0
|
|
|
|
|
|
|
1343
|
0
|
|
|
|
|
|
my ( $command, $channel, $nick, $setting ) = @{ $_[ARG0] }; |
|
0
|
|
|
|
|
|
|
1344
|
|
|
|
|
|
|
|
1345
|
0
|
|
|
|
|
|
my $source = $r->{relationship}{source}; |
1346
|
|
|
|
|
|
|
# Pull out existing settings |
1347
|
|
|
|
|
|
|
# Quoted values to get 0/1 vs weird JSON:: things that break the API |
1348
|
0
|
|
|
|
|
|
my %current_value = ( |
1349
|
|
|
|
|
|
|
device => "$source->{notifications_enabled}", |
1350
|
|
|
|
|
|
|
retweets => "$source->{want_retweets}", |
1351
|
|
|
|
|
|
|
); |
1352
|
|
|
|
|
|
|
|
1353
|
|
|
|
|
|
|
# Skip unnecessary updates |
1354
|
0
|
0
|
|
|
|
|
if ( $current_value{$command} == $setting ) { |
1355
|
0
|
|
|
|
|
|
$self->bot_says($channel, "No need to update $nick"); |
1356
|
0
|
|
|
|
|
|
return; |
1357
|
|
|
|
|
|
|
} |
1358
|
|
|
|
|
|
|
|
1359
|
|
|
|
|
|
|
# Update |
1360
|
0
|
|
|
|
|
|
$self->twitter(update_friendship => { |
1361
|
|
|
|
|
|
|
screen_name => $nick, |
1362
|
|
|
|
|
|
|
# current values as default |
1363
|
|
|
|
|
|
|
%current_value, |
1364
|
|
|
|
|
|
|
# override with new value |
1365
|
|
|
|
|
|
|
$command => $setting |
1366
|
|
|
|
|
|
|
}); |
1367
|
|
|
|
|
|
|
}; |
1368
|
|
|
|
|
|
|
|
1369
|
|
|
|
|
|
|
=item favorite I<screen_name> [I<count>] |
1370
|
|
|
|
|
|
|
|
1371
|
|
|
|
|
|
|
Mark a tweet as a favorite. Specify the user by I<screen_name> and select from a |
1372
|
|
|
|
|
|
|
list of recent tweets. Optionally, specify the number of tweets to display for |
1373
|
|
|
|
|
|
|
selection with I<count> (Defaults to 3.) |
1374
|
|
|
|
|
|
|
|
1375
|
|
|
|
|
|
|
=cut |
1376
|
|
|
|
|
|
|
|
1377
|
|
|
|
|
|
|
event cmd_favorite => sub { |
1378
|
0
|
|
|
0
|
|
|
my ($self, $channel, $args) = @_[OBJECT, ARG0, ARG1]; |
1379
|
|
|
|
|
|
|
|
1380
|
0
|
|
|
|
|
|
my ($nick, $count) = split /\s+/, $args; |
1381
|
0
|
|
0
|
|
|
|
$count ||= $self->selection_count; |
1382
|
|
|
|
|
|
|
|
1383
|
0
|
|
|
|
|
|
TRACE("[cmd_favorite] $nick"); |
1384
|
|
|
|
|
|
|
|
1385
|
0
|
|
|
|
|
|
$self->twitter(user_timeline => { screen_name => $nick, count => $count }, |
1386
|
|
|
|
|
|
|
$_[SESSION]->callback(cmd_favorite_response => $channel, $nick) |
1387
|
|
|
|
|
|
|
); |
1388
|
|
|
|
|
|
|
}; |
1389
|
|
|
|
|
|
|
|
1390
|
|
|
|
|
|
|
event cmd_favorite_response => sub { |
1391
|
0
|
|
|
0
|
|
|
my $self = $_[OBJECT]; |
1392
|
0
|
0
|
|
|
|
|
my ( $recent ) = @{ $_[ARG1] } or return; |
|
0
|
|
|
|
|
|
|
1393
|
0
|
|
|
|
|
|
my ( $channel, $nick ) = @{ $_[ARG0] }; |
|
0
|
|
|
|
|
|
|
1394
|
|
|
|
|
|
|
|
1395
|
0
|
0
|
|
|
|
|
if ( @$recent == 0 ) { |
1396
|
0
|
|
|
|
|
|
$self->bot_says($channel, "$nick has no recent tweets"); |
1397
|
0
|
|
|
|
|
|
return; |
1398
|
|
|
|
|
|
|
} |
1399
|
|
|
|
|
|
|
|
1400
|
|
|
|
|
|
|
$self->stash({ |
1401
|
0
|
|
|
|
|
|
handler => '_handle_favorite', |
1402
|
|
|
|
|
|
|
candidates => [ map $$_{id_str}, @$recent ], |
1403
|
|
|
|
|
|
|
}); |
1404
|
|
|
|
|
|
|
|
1405
|
0
|
|
|
|
|
|
$self->bot_says($channel, 'Which tweet?'); |
1406
|
0
|
|
|
|
|
|
for ( 1..@$recent ) { |
1407
|
0
|
|
|
|
|
|
$self->bot_says($channel, "[$_] " . |
1408
|
|
|
|
|
|
|
elide( |
1409
|
|
|
|
|
|
|
$self->formatted_status_text($recent->[$_ - 1]), |
1410
|
|
|
|
|
|
|
$self->truncate_to |
1411
|
|
|
|
|
|
|
) |
1412
|
|
|
|
|
|
|
); |
1413
|
|
|
|
|
|
|
} |
1414
|
|
|
|
|
|
|
}; |
1415
|
|
|
|
|
|
|
|
1416
|
|
|
|
|
|
|
event _handle_favorite => sub { |
1417
|
0
|
|
|
0
|
|
|
my ( $self, $channel, $index ) = @_[OBJECT, ARG0, ARG1]; |
1418
|
|
|
|
|
|
|
|
1419
|
0
|
|
|
|
|
|
TRACE("[handle_favorite] $index"); |
1420
|
|
|
|
|
|
|
|
1421
|
0
|
|
|
|
|
|
my @candidates = $self->stashed_candidates; |
1422
|
0
|
0
|
0
|
|
|
|
if ( $index =~ /^\d+$/ && 0 < $index && $index <= @candidates ) { |
|
|
|
0
|
|
|
|
|
1423
|
0
|
|
|
|
|
|
$self->twitter(create_favorite => { id => $candidates[$index - 1] }); |
1424
|
0
|
|
|
|
|
|
return 1; # handled |
1425
|
|
|
|
|
|
|
} |
1426
|
0
|
|
|
|
|
|
return 0; # unhandled |
1427
|
|
|
|
|
|
|
}; |
1428
|
|
|
|
|
|
|
|
1429
|
|
|
|
|
|
|
=item rate_limit_status |
1430
|
|
|
|
|
|
|
|
1431
|
|
|
|
|
|
|
Displays the remaining number of API requests available in the current hour. |
1432
|
|
|
|
|
|
|
|
1433
|
|
|
|
|
|
|
=cut |
1434
|
|
|
|
|
|
|
|
1435
|
|
|
|
|
|
|
event cmd_rate_limit_status => sub { |
1436
|
0
|
|
|
0
|
|
|
my ($self, $channel) = @_[OBJECT, ARG0]; |
1437
|
|
|
|
|
|
|
|
1438
|
0
|
|
|
|
|
|
$self->twitter('rate_limit_status', {}, |
1439
|
|
|
|
|
|
|
$_[SESSION]->callback(cmd_rate_limit_status_response => $channel) |
1440
|
|
|
|
|
|
|
); |
1441
|
|
|
|
|
|
|
}; |
1442
|
|
|
|
|
|
|
|
1443
|
|
|
|
|
|
|
event cmd_rate_limit_status_response => sub { |
1444
|
0
|
|
|
0
|
|
|
my $self = $_[OBJECT]; |
1445
|
0
|
0
|
|
|
|
|
my ( $r ) = @{ $_[ARG1] } or return; |
|
0
|
|
|
|
|
|
|
1446
|
0
|
|
|
|
|
|
my ( $channel ) = @{ $_[ARG0] }; |
|
0
|
|
|
|
|
|
|
1447
|
|
|
|
|
|
|
|
1448
|
0
|
|
|
|
|
|
my $reset_time = sprintf "%02d:%02d:%02d", (localtime $r->{reset_time_in_seconds})[2,1,0]; |
1449
|
0
|
|
|
|
|
|
my $seconds_remaining = $r->{reset_time_in_seconds} - time; |
1450
|
0
|
|
|
|
|
|
my $time_remaining = sprintf "%d:%02d", int($seconds_remaining / 60), $seconds_remaining % 60; |
1451
|
0
|
|
|
|
|
|
$self->bot_says($channel, sprintf "%s API calls remaining for the next %s (until %s), hourly limit is %s", |
1452
|
|
|
|
|
|
|
$$r{remaining_hits}, |
1453
|
|
|
|
|
|
|
$time_remaining, |
1454
|
|
|
|
|
|
|
$reset_time, |
1455
|
|
|
|
|
|
|
$$r{hourly_limit}, |
1456
|
|
|
|
|
|
|
); |
1457
|
|
|
|
|
|
|
}; |
1458
|
|
|
|
|
|
|
|
1459
|
|
|
|
|
|
|
=item retweet I<screen_name> [I<count>] |
1460
|
|
|
|
|
|
|
|
1461
|
|
|
|
|
|
|
Re-tweet another user's status. Specify the user by I<screen_name> and select from a |
1462
|
|
|
|
|
|
|
list of recent tweets. Optionally, specify the number of tweets to display for |
1463
|
|
|
|
|
|
|
selection with I<count> (Defaults to 3.) |
1464
|
|
|
|
|
|
|
|
1465
|
|
|
|
|
|
|
=cut |
1466
|
|
|
|
|
|
|
|
1467
|
|
|
|
|
|
|
event cmd_retweet => sub { |
1468
|
0
|
|
|
0
|
|
|
my ( $self, $channel, $args ) = @_[OBJECT, ARG0, ARG1]; |
1469
|
|
|
|
|
|
|
|
1470
|
0
|
0
|
|
|
|
|
unless ( defined $args ) { |
1471
|
0
|
|
|
|
|
|
$self->bot_says($channel, 'usage: retweet nick [-N]'); |
1472
|
0
|
|
|
|
|
|
return; |
1473
|
|
|
|
|
|
|
} |
1474
|
|
|
|
|
|
|
|
1475
|
0
|
|
|
|
|
|
my ( $nick, $count ) = split /\s+/, $args; |
1476
|
|
|
|
|
|
|
|
1477
|
0
|
|
0
|
|
|
|
$count ||= $self->selection_count; |
1478
|
|
|
|
|
|
|
|
1479
|
0
|
|
|
|
|
|
$self->twitter(user_timeline => { screen_name => $nick, count => $count }, |
1480
|
|
|
|
|
|
|
$_[SESSION]->callback(cmd_retweet_response => $channel, $nick) |
1481
|
|
|
|
|
|
|
); |
1482
|
|
|
|
|
|
|
}; |
1483
|
|
|
|
|
|
|
|
1484
|
|
|
|
|
|
|
event cmd_retweet_response => sub { |
1485
|
0
|
|
|
0
|
|
|
my $self = $_[OBJECT]; |
1486
|
0
|
0
|
|
|
|
|
my ( $recent ) = @{ $_[ARG1] } or return; |
|
0
|
|
|
|
|
|
|
1487
|
0
|
|
|
|
|
|
my ( $channel, $nick ) = @{ $_[ARG0] }; |
|
0
|
|
|
|
|
|
|
1488
|
|
|
|
|
|
|
|
1489
|
0
|
0
|
|
|
|
|
if ( @$recent == 0 ) { |
1490
|
0
|
|
|
|
|
|
$self->bot_says($channel, "$nick has no recent tweets"); |
1491
|
0
|
|
|
|
|
|
return; |
1492
|
|
|
|
|
|
|
} |
1493
|
|
|
|
|
|
|
|
1494
|
|
|
|
|
|
|
$self->stash({ |
1495
|
0
|
|
|
|
|
|
handler => '_handle_retweet', |
1496
|
|
|
|
|
|
|
candidates => [ map $$_{id_str}, @$recent ], |
1497
|
|
|
|
|
|
|
}); |
1498
|
|
|
|
|
|
|
|
1499
|
0
|
|
|
|
|
|
$self->bot_says($channel, 'Which tweet?'); |
1500
|
0
|
|
|
|
|
|
for ( 1..@$recent ) { |
1501
|
0
|
|
|
|
|
|
$self->bot_says($channel, "[$_] " . |
1502
|
|
|
|
|
|
|
elide( |
1503
|
|
|
|
|
|
|
$self->formatted_status_text($recent->[$_ - 1]), |
1504
|
|
|
|
|
|
|
$self->truncate_to |
1505
|
|
|
|
|
|
|
) |
1506
|
|
|
|
|
|
|
); |
1507
|
|
|
|
|
|
|
} |
1508
|
|
|
|
|
|
|
}; |
1509
|
|
|
|
|
|
|
|
1510
|
|
|
|
|
|
|
=item rt I<screen_name> [I<count>] |
1511
|
|
|
|
|
|
|
|
1512
|
|
|
|
|
|
|
An alias for the C<retweet> command. |
1513
|
|
|
|
|
|
|
|
1514
|
|
|
|
|
|
|
=cut |
1515
|
|
|
|
|
|
|
|
1516
|
0
|
|
|
0
|
|
|
event cmd_rt => sub { shift->cmd_retweet(@_) }; |
1517
|
|
|
|
|
|
|
|
1518
|
|
|
|
|
|
|
event _handle_retweet => sub { |
1519
|
0
|
|
|
0
|
|
|
my ( $self, $channel, $index ) = @_[OBJECT, ARG0, ARG1]; |
1520
|
|
|
|
|
|
|
|
1521
|
0
|
|
|
|
|
|
my @candidates = $self->stashed_candidates; |
1522
|
0
|
0
|
0
|
|
|
|
if ( $index =~ /^\d+$/ && 0 < $index && $index <= @candidates ) { |
|
|
|
0
|
|
|
|
|
1523
|
0
|
|
|
|
|
|
$self->twitter(retweet => { id => $candidates[$index - 1] }); |
1524
|
0
|
|
|
|
|
|
return 1; # handled |
1525
|
|
|
|
|
|
|
} |
1526
|
0
|
|
|
|
|
|
return 0; # unhandled |
1527
|
|
|
|
|
|
|
}; |
1528
|
|
|
|
|
|
|
|
1529
|
|
|
|
|
|
|
=item reply I<screen_name> [I<-count>] I<message> |
1530
|
|
|
|
|
|
|
|
1531
|
|
|
|
|
|
|
Reply to another user's status. Specify the user by I<screen_name> and select |
1532
|
|
|
|
|
|
|
from a list of recent tweets. Optionally, specify the number of tweets to |
1533
|
|
|
|
|
|
|
display for selection with I<-count> (Defaults to 3.) Note that the count |
1534
|
|
|
|
|
|
|
parameter is prefixed with a dash. |
1535
|
|
|
|
|
|
|
|
1536
|
|
|
|
|
|
|
=cut |
1537
|
|
|
|
|
|
|
|
1538
|
|
|
|
|
|
|
event cmd_reply => sub { |
1539
|
0
|
|
|
0
|
|
|
my ( $self, $channel, $args ) = @_[OBJECT, ARG0, ARG1]; |
1540
|
|
|
|
|
|
|
|
1541
|
0
|
0
|
|
|
|
|
unless ( defined $args ) { |
1542
|
0
|
|
|
|
|
|
$self->bot_says($channel, "usage: reply nick [-N] message-text"); |
1543
|
0
|
|
|
|
|
|
return; |
1544
|
|
|
|
|
|
|
} |
1545
|
|
|
|
|
|
|
|
1546
|
0
|
|
|
|
|
|
my ( $nick, $count, $message ) = $args =~ / |
1547
|
|
|
|
|
|
|
^@?(\S+) # nick; strip leading @ if there is one |
1548
|
|
|
|
|
|
|
\s+ |
1549
|
|
|
|
|
|
|
(?:-(\d+)\s+)? # optional count: -N |
1550
|
|
|
|
|
|
|
(.*) # the message |
1551
|
|
|
|
|
|
|
/x; |
1552
|
0
|
0
|
0
|
|
|
|
unless ( defined $nick && defined $message ) { |
1553
|
0
|
|
|
|
|
|
$self->bot_says($channel, "usage: reply nick [-N] message-text"); |
1554
|
0
|
|
|
|
|
|
return; |
1555
|
|
|
|
|
|
|
} |
1556
|
|
|
|
|
|
|
|
1557
|
0
|
|
|
|
|
|
$message = "\@$nick $message"; |
1558
|
0
|
0
|
|
|
|
|
return if $self->status_text_too_long($channel, $message); |
1559
|
|
|
|
|
|
|
|
1560
|
0
|
|
0
|
|
|
|
$count ||= $self->selection_count; |
1561
|
|
|
|
|
|
|
|
1562
|
0
|
|
|
|
|
|
$self->twitter(user_timeline => { screen_name => $nick, count => $count }, |
1563
|
|
|
|
|
|
|
$_[SESSION]->callback(cmd_reply_response => $channel, $nick, $message) |
1564
|
|
|
|
|
|
|
); |
1565
|
|
|
|
|
|
|
}; |
1566
|
|
|
|
|
|
|
|
1567
|
|
|
|
|
|
|
event cmd_reply_response => sub { |
1568
|
0
|
|
|
0
|
|
|
my $self = $_[OBJECT]; |
1569
|
0
|
0
|
|
|
|
|
my ( $recent ) = @{ $_[ARG1] } or return; |
|
0
|
|
|
|
|
|
|
1570
|
0
|
|
|
|
|
|
my ( $channel, $nick, $message ) = @{ $_[ARG0] }; |
|
0
|
|
|
|
|
|
|
1571
|
|
|
|
|
|
|
|
1572
|
0
|
0
|
|
|
|
|
if ( @$recent == 0 ) { |
1573
|
0
|
|
|
|
|
|
$self->bot_says($channel, "$nick has no recent tweets"); |
1574
|
0
|
|
|
|
|
|
return; |
1575
|
|
|
|
|
|
|
} |
1576
|
|
|
|
|
|
|
|
1577
|
|
|
|
|
|
|
$self->stash({ |
1578
|
0
|
|
|
|
|
|
handler => '_handle_reply', |
1579
|
|
|
|
|
|
|
candidates => [ map $_->{id_str}, @$recent ], |
1580
|
|
|
|
|
|
|
message => $message, |
1581
|
|
|
|
|
|
|
}); |
1582
|
|
|
|
|
|
|
|
1583
|
0
|
|
|
|
|
|
$self->bot_says($channel, 'Which tweet?'); |
1584
|
0
|
|
|
|
|
|
for ( 1..@$recent ) { |
1585
|
0
|
|
|
|
|
|
$self->bot_says($channel, "[$_] " . |
1586
|
|
|
|
|
|
|
elide( |
1587
|
|
|
|
|
|
|
$self->formatted_status_text($recent->[$_ - 1]), |
1588
|
|
|
|
|
|
|
$self->truncate_to |
1589
|
|
|
|
|
|
|
) |
1590
|
|
|
|
|
|
|
); |
1591
|
|
|
|
|
|
|
} |
1592
|
|
|
|
|
|
|
}; |
1593
|
|
|
|
|
|
|
|
1594
|
|
|
|
|
|
|
event _handle_reply => sub { |
1595
|
0
|
|
|
0
|
|
|
my ( $self, $channel, $index ) = @_[OBJECT, ARG0, ARG1]; |
1596
|
|
|
|
|
|
|
|
1597
|
0
|
|
|
|
|
|
my @candidates = $self->stashed_candidates; |
1598
|
0
|
0
|
0
|
|
|
|
if ( $index =~ /^\d+$/ && 0 < $index && $index <= @candidates ) { |
|
|
|
0
|
|
|
|
|
1599
|
0
|
|
|
|
|
|
$self->twitter(update => { |
1600
|
|
|
|
|
|
|
status => $self->stashed_message, |
1601
|
|
|
|
|
|
|
in_reply_to_status_id => $candidates[$index - 1], |
1602
|
|
|
|
|
|
|
}); |
1603
|
0
|
|
|
|
|
|
return 1; # handled |
1604
|
|
|
|
|
|
|
} |
1605
|
0
|
|
|
|
|
|
return 0; # unhandled |
1606
|
|
|
|
|
|
|
}; |
1607
|
|
|
|
|
|
|
|
1608
|
|
|
|
|
|
|
=item report_spam |
1609
|
|
|
|
|
|
|
|
1610
|
|
|
|
|
|
|
Report 1 or more screen names as spammers. |
1611
|
|
|
|
|
|
|
|
1612
|
|
|
|
|
|
|
=cut |
1613
|
|
|
|
|
|
|
|
1614
|
|
|
|
|
|
|
event cmd_report_spam => sub { |
1615
|
0
|
|
|
0
|
|
|
my ( $self, $channel, $args ) = @_[OBJECT, ARG0, ARG1]; |
1616
|
|
|
|
|
|
|
|
1617
|
0
|
0
|
|
|
|
|
unless ( $args ) { |
1618
|
0
|
|
|
|
|
|
$self->bot_says($channel, "spam requires list of 1 or more spammers"); |
1619
|
0
|
|
|
|
|
|
return; |
1620
|
|
|
|
|
|
|
} |
1621
|
|
|
|
|
|
|
|
1622
|
0
|
|
|
|
|
|
for my $spammer ( split /\s+/, $args ) { |
1623
|
0
|
|
|
|
|
|
$self->yield(report_spam_helper => $spammer); |
1624
|
|
|
|
|
|
|
} |
1625
|
|
|
|
|
|
|
}; |
1626
|
|
|
|
|
|
|
|
1627
|
|
|
|
|
|
|
event report_spam_helper => sub { |
1628
|
0
|
|
|
0
|
|
|
my ( $self, $spammer ) = @_[OBJECT, ARG0]; |
1629
|
|
|
|
|
|
|
|
1630
|
0
|
|
|
|
|
|
$self->twitter(report_spam => { screen_name => $spammer }); |
1631
|
|
|
|
|
|
|
}; |
1632
|
|
|
|
|
|
|
|
1633
|
|
|
|
|
|
|
=item add I<screen_name> to I<list-slug> |
1634
|
|
|
|
|
|
|
|
1635
|
|
|
|
|
|
|
Add a user to one of your lists. |
1636
|
|
|
|
|
|
|
|
1637
|
|
|
|
|
|
|
=cut |
1638
|
|
|
|
|
|
|
|
1639
|
0
|
|
|
0
|
|
|
event cmd_add => sub { $_[OBJECT]->_add_remove_list_member(qw/add to/, @_[ARG0, ARG1]) }; |
1640
|
|
|
|
|
|
|
|
1641
|
|
|
|
|
|
|
sub _add_remove_list_member { |
1642
|
0
|
|
|
0
|
|
|
my ( $self, $verb, $preposition, $channel, $args ) = @_; |
1643
|
|
|
|
|
|
|
|
1644
|
0
|
|
0
|
|
|
|
my ( $nick, $slug ) = ($args || '') =~ / |
1645
|
|
|
|
|
|
|
^@?(\w+) # nick; strip leading @ if there is one |
1646
|
|
|
|
|
|
|
\s+$preposition\s+ |
1647
|
|
|
|
|
|
|
([-\w]+) # the list-slug |
1648
|
|
|
|
|
|
|
\s*$ |
1649
|
|
|
|
|
|
|
/x; |
1650
|
|
|
|
|
|
|
|
1651
|
0
|
0
|
|
|
|
|
unless ( defined $nick ) { |
1652
|
0
|
|
|
|
|
|
$self->bot_says($channel, "usage: $verb <nick> $preposition <list-slug>"); |
1653
|
0
|
|
|
|
|
|
return; |
1654
|
|
|
|
|
|
|
} |
1655
|
|
|
|
|
|
|
|
1656
|
0
|
|
|
|
|
|
$self->twitter($verb . '_list_member' => { |
1657
|
|
|
|
|
|
|
owner_id => $self->twitter_id, |
1658
|
|
|
|
|
|
|
slug => $slug, |
1659
|
|
|
|
|
|
|
screen_name => $nick, |
1660
|
|
|
|
|
|
|
}); |
1661
|
|
|
|
|
|
|
}; |
1662
|
|
|
|
|
|
|
|
1663
|
|
|
|
|
|
|
=item remove I<screen_name> from I<list-slug> |
1664
|
|
|
|
|
|
|
|
1665
|
|
|
|
|
|
|
Add a user to one of your lists. |
1666
|
|
|
|
|
|
|
|
1667
|
|
|
|
|
|
|
=cut |
1668
|
|
|
|
|
|
|
|
1669
|
0
|
|
|
0
|
|
|
event cmd_remove => sub { $_[OBJECT]->_add_remove_list_member(qw/remove from/, @_[ARG0, ARG1]) }; |
1670
|
|
|
|
|
|
|
|
1671
|
|
|
|
|
|
|
=item help |
1672
|
|
|
|
|
|
|
|
1673
|
|
|
|
|
|
|
Display a simple help message |
1674
|
|
|
|
|
|
|
|
1675
|
|
|
|
|
|
|
=cut |
1676
|
|
|
|
|
|
|
|
1677
|
|
|
|
|
|
|
event cmd_help => sub { |
1678
|
0
|
|
|
0
|
|
|
my ($self, $channel, $argstr)=@_[OBJECT, ARG0, ARG1]; |
1679
|
0
|
|
|
|
|
|
$self->bot_says($channel, "Available commands:"); |
1680
|
0
|
|
|
|
|
|
$self->bot_says($channel, join ' ' => sort qw/ |
1681
|
|
|
|
|
|
|
post follow unfollow block unblock whois notify retweets favorite |
1682
|
|
|
|
|
|
|
rate_limit_status retweet report_spam |
1683
|
|
|
|
|
|
|
/); |
1684
|
0
|
|
|
|
|
|
$self->bot_says($channel, '/msg nick for a direct message.') |
1685
|
|
|
|
|
|
|
}; |
1686
|
|
|
|
|
|
|
|
1687
|
|
|
|
|
|
|
1; |
1688
|
|
|
|
|
|
|
|
1689
|
|
|
|
|
|
|
__END__ |
1690
|
|
|
|
|
|
|
|
1691
|
|
|
|
|
|
|
=item /msg I<id> I<text> |
1692
|
|
|
|
|
|
|
|
1693
|
|
|
|
|
|
|
Sends a direct message to Twitter user I<id> using an IRC private message. |
1694
|
|
|
|
|
|
|
|
1695
|
|
|
|
|
|
|
=back |
1696
|
|
|
|
|
|
|
|
1697
|
|
|
|
|
|
|
=head1 SEE ALSO |
1698
|
|
|
|
|
|
|
|
1699
|
|
|
|
|
|
|
L<App::Twirc> |
1700
|
|
|
|
|
|
|
|
1701
|
|
|
|
|
|
|
=head1 AUTHOR |
1702
|
|
|
|
|
|
|
|
1703
|
|
|
|
|
|
|
Marc Mims <marc@questright.com> |
1704
|
|
|
|
|
|
|
|
1705
|
|
|
|
|
|
|
=head1 CONTRIBUTORS |
1706
|
|
|
|
|
|
|
|
1707
|
|
|
|
|
|
|
Adam Prime <adam.prime@utoronto.ca> (@adamprime) |
1708
|
|
|
|
|
|
|
Peter Roberts <me+dev@peter-r.co.uk> |
1709
|
|
|
|
|
|
|
|
1710
|
|
|
|
|
|
|
=head1 LICENSE |
1711
|
|
|
|
|
|
|
|
1712
|
|
|
|
|
|
|
Copyright (c) 2008 Marc Mims |
1713
|
|
|
|
|
|
|
|
1714
|
|
|
|
|
|
|
You may distribute this code and/or modify it under the same terms as Perl itself. |