| 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. |