line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# |
2
|
|
|
|
|
|
|
# $Id$ |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# client::twitter Brik |
5
|
|
|
|
|
|
|
# |
6
|
|
|
|
|
|
|
package Metabrik::Client::Twitter; |
7
|
1
|
|
|
1
|
|
737
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
29
|
|
8
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
27
|
|
9
|
|
|
|
|
|
|
|
10
|
1
|
|
|
1
|
|
5
|
use base qw(Metabrik); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
1661
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
sub brik_properties { |
13
|
|
|
|
|
|
|
return { |
14
|
0
|
|
|
0
|
1
|
|
revision => '$Revision$', |
15
|
|
|
|
|
|
|
tags => [ qw(unstable) ], |
16
|
|
|
|
|
|
|
author => 'GomoR ', |
17
|
|
|
|
|
|
|
license => 'http://opensource.org/licenses/BSD-3-Clause', |
18
|
|
|
|
|
|
|
commands => { |
19
|
|
|
|
|
|
|
connect => [ qw(consumer_key|OPTIONAL consumer_secret|OPTIONAL access_token|OPTIONAL access_token_secret|OPTIONAL) ], |
20
|
|
|
|
|
|
|
tweet => [ qw(message) ], |
21
|
|
|
|
|
|
|
account_settings => [ ], |
22
|
|
|
|
|
|
|
followers => [ ], |
23
|
|
|
|
|
|
|
following => [ ], |
24
|
|
|
|
|
|
|
follow => [ qw(username) ], |
25
|
|
|
|
|
|
|
unfollow => [ qw(username) ], |
26
|
|
|
|
|
|
|
disconnect => [ ], |
27
|
|
|
|
|
|
|
rate_limit_status => [ ], |
28
|
|
|
|
|
|
|
}, |
29
|
|
|
|
|
|
|
attributes => { |
30
|
|
|
|
|
|
|
consumer_key => [ qw(string) ], |
31
|
|
|
|
|
|
|
consumer_secret => [ qw(string) ], |
32
|
|
|
|
|
|
|
access_token => [ qw(string) ], |
33
|
|
|
|
|
|
|
access_token_secret => [ qw(string) ], |
34
|
|
|
|
|
|
|
net_twitter => [ qw(object|INTERNAL) ], |
35
|
|
|
|
|
|
|
}, |
36
|
|
|
|
|
|
|
require_modules => { |
37
|
|
|
|
|
|
|
'Net::Twitter' => [ ], |
38
|
|
|
|
|
|
|
}, |
39
|
|
|
|
|
|
|
}; |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
# |
43
|
|
|
|
|
|
|
# REST API: |
44
|
|
|
|
|
|
|
# https://dev.twitter.com/rest/public |
45
|
|
|
|
|
|
|
# |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
sub connect { |
48
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
49
|
0
|
|
|
|
|
|
my ($consumer_key, $consumer_secret, $access_token, $access_token_secret) = @_; |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
# Return the handle if already connected. |
52
|
0
|
0
|
|
|
|
|
if (defined($self->net_twitter)) { |
53
|
0
|
|
|
|
|
|
return $self->net_twitter; |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
# Get API keys: authenticate and go to https://apps.twitter.com/app/new |
57
|
|
|
|
|
|
|
|
58
|
0
|
|
0
|
|
|
|
$consumer_key ||= $self->consumer_key; |
59
|
0
|
|
0
|
|
|
|
$consumer_secret ||= $self->consumer_secret; |
60
|
0
|
|
0
|
|
|
|
$access_token ||= $self->access_token; |
61
|
0
|
|
0
|
|
|
|
$access_token_secret ||= $self->access_token_secret; |
62
|
0
|
0
|
|
|
|
|
$self->brik_help_run_undef_arg('connect', $consumer_key) or return; |
63
|
0
|
0
|
|
|
|
|
$self->brik_help_run_undef_arg('connect', $consumer_secret) or return; |
64
|
0
|
0
|
|
|
|
|
$self->brik_help_run_undef_arg('connect', $access_token) or return; |
65
|
0
|
0
|
|
|
|
|
$self->brik_help_run_undef_arg('connect', $access_token_secret) or return; |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
# Without that, we got: |
68
|
|
|
|
|
|
|
# "500 Can't connect to api.twitter.com:443 (Crypt-SSLeay can't verify hostnames)" |
69
|
|
|
|
|
|
|
#$ENV{'PERL_LWP_SSL_VERIFY_HOSTNAME'} = 0; |
70
|
|
|
|
|
|
|
|
71
|
0
|
|
|
|
|
|
my $nt; |
72
|
0
|
|
|
|
|
|
eval { |
73
|
0
|
|
|
|
|
|
local $ENV{PERL_NET_HTTPS_SSL_SOCKET_CLASS} = 'IO::Socket::SSL'; |
74
|
0
|
|
|
|
|
|
$nt = Net::Twitter->new( |
75
|
|
|
|
|
|
|
traits => [qw/API::RESTv1_1/], |
76
|
|
|
|
|
|
|
consumer_key => $consumer_key, |
77
|
|
|
|
|
|
|
consumer_secret => $consumer_secret, |
78
|
|
|
|
|
|
|
access_token => $access_token, |
79
|
|
|
|
|
|
|
access_token_secret => $access_token_secret, |
80
|
|
|
|
|
|
|
); |
81
|
|
|
|
|
|
|
}; |
82
|
0
|
0
|
|
|
|
|
if ($@) { |
|
|
0
|
|
|
|
|
|
83
|
0
|
|
|
|
|
|
chomp($@); |
84
|
0
|
|
|
|
|
|
return $self->log->error("connect: unable to connect [$@]"); |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
elsif (! defined($nt)) { |
87
|
0
|
|
|
|
|
|
return $self->log->error("connect: unable to connect [unknown error]"); |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
|
90
|
0
|
|
|
|
|
|
return $self->net_twitter($nt); |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
sub tweet { |
94
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
95
|
0
|
|
|
|
|
|
my ($message) = @_; |
96
|
|
|
|
|
|
|
|
97
|
0
|
0
|
|
|
|
|
$self->brik_help_run_undef_arg('tweet', $message) or return; |
98
|
|
|
|
|
|
|
|
99
|
0
|
0
|
|
|
|
|
my $nt = $self->connect or return; |
100
|
|
|
|
|
|
|
|
101
|
0
|
|
|
|
|
|
my $r; |
102
|
0
|
|
|
|
|
|
eval { |
103
|
0
|
|
|
|
|
|
local $ENV{PERL_NET_HTTPS_SSL_SOCKET_CLASS} = 'IO::Socket::SSL'; |
104
|
0
|
|
|
|
|
|
$r = $nt->update($message); |
105
|
|
|
|
|
|
|
}; |
106
|
0
|
0
|
|
|
|
|
if ($@) { |
|
|
0
|
|
|
|
|
|
107
|
0
|
|
|
|
|
|
chomp($@); |
108
|
0
|
|
|
|
|
|
return $self->log->error("tweet: unable to tweet [$@]"); |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
elsif (! defined($r)) { |
111
|
0
|
|
|
|
|
|
return $self->log->error("tweet: unable to tweet [unknown error]"); |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
0
|
|
|
|
|
|
return $message; |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
sub account_settings { |
118
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
119
|
|
|
|
|
|
|
|
120
|
0
|
0
|
|
|
|
|
my $nt = $self->connect or return; |
121
|
|
|
|
|
|
|
|
122
|
0
|
|
|
|
|
|
my $r; |
123
|
0
|
|
|
|
|
|
eval { |
124
|
0
|
|
|
|
|
|
local $ENV{PERL_NET_HTTPS_SSL_SOCKET_CLASS} = 'IO::Socket::SSL'; |
125
|
0
|
|
|
|
|
|
$r = $nt->account_settings; |
126
|
|
|
|
|
|
|
}; |
127
|
0
|
0
|
|
|
|
|
if ($@) { |
|
|
0
|
|
|
|
|
|
128
|
0
|
|
|
|
|
|
chomp($@); |
129
|
0
|
|
|
|
|
|
return $self->log->error("account_settings: unable to call method [$@]"); |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
elsif (! defined($r)) { |
132
|
0
|
|
|
|
|
|
return $self->log->error("account_settings: unable to call method [unknown error]"); |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
|
135
|
0
|
|
|
|
|
|
return $r; |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
sub followers { |
139
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
140
|
|
|
|
|
|
|
|
141
|
0
|
0
|
|
|
|
|
my $nt = $self->connect or return; |
142
|
|
|
|
|
|
|
|
143
|
0
|
|
|
|
|
|
my @list = (); |
144
|
|
|
|
|
|
|
|
145
|
0
|
|
|
|
|
|
eval { |
146
|
0
|
|
|
|
|
|
my $r; |
147
|
|
|
|
|
|
|
my $previous_cursor; |
148
|
0
|
|
|
|
|
|
my $next_cursor = -1; |
149
|
0
|
|
|
|
|
|
while ($next_cursor) { |
150
|
0
|
|
|
|
|
|
$self->log->info("followers: iterating on users with next_cursor [$next_cursor]"); |
151
|
|
|
|
|
|
|
|
152
|
0
|
|
|
|
|
|
local $ENV{PERL_NET_HTTPS_SSL_SOCKET_CLASS} = 'IO::Socket::SSL'; |
153
|
0
|
|
|
|
|
|
$r = $nt->followers({ cursor => $next_cursor }); |
154
|
0
|
0
|
|
|
|
|
last if ! defined($r); |
155
|
0
|
|
|
|
|
|
$next_cursor = $r->{next_cursor}; |
156
|
0
|
|
0
|
|
|
|
$r->{previous_cursor} = $previous_cursor || 0; |
157
|
0
|
|
|
|
|
|
$previous_cursor = $next_cursor; |
158
|
|
|
|
|
|
|
|
159
|
0
|
|
|
|
|
|
for my $user (@{$r->{users}}) { |
|
0
|
|
|
|
|
|
|
160
|
0
|
|
|
|
|
|
$self->log->verbose("followers: found user [".$user->{screen_name}."]"); |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
push @list, { |
163
|
|
|
|
|
|
|
name => $user->{name}, |
164
|
|
|
|
|
|
|
screen_name => $user->{screen_name}, |
165
|
|
|
|
|
|
|
description => $user->{description}, |
166
|
|
|
|
|
|
|
location => $user->{location}, |
167
|
|
|
|
|
|
|
following_count => $user->{friends_count}, |
168
|
|
|
|
|
|
|
followers_count => $user->{followers_count}, |
169
|
|
|
|
|
|
|
created => $user->{created_at}, |
170
|
|
|
|
|
|
|
language => $user->{lang}, |
171
|
0
|
|
|
|
|
|
}; |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
}; |
175
|
0
|
0
|
|
|
|
|
if ($@) { |
176
|
0
|
|
|
|
|
|
chomp($@); |
177
|
|
|
|
|
|
|
|
178
|
0
|
0
|
|
|
|
|
if ($@ =~ m{Rate limit exceeded}i) { |
179
|
0
|
|
|
|
|
|
$self->log->warning("followers: rate limit exceeded, returning partial results"); |
180
|
0
|
|
|
|
|
|
return \@list; |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
|
183
|
0
|
|
|
|
|
|
return $self->log->error("followers: unable to call method [$@]"); |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
|
186
|
0
|
|
|
|
|
|
return \@list; |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
sub following { |
190
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
191
|
|
|
|
|
|
|
|
192
|
0
|
0
|
|
|
|
|
my $nt = $self->connect or return; |
193
|
|
|
|
|
|
|
|
194
|
0
|
|
|
|
|
|
my @list = (); |
195
|
|
|
|
|
|
|
|
196
|
0
|
|
|
|
|
|
eval { |
197
|
0
|
|
|
|
|
|
my $r; |
198
|
0
|
|
|
|
|
|
my $cursor = -1; |
199
|
0
|
|
|
|
|
|
while ($cursor) { |
200
|
0
|
|
|
|
|
|
$self->log->info("following: iterating on users with cursor [$cursor]"); |
201
|
|
|
|
|
|
|
|
202
|
0
|
|
|
|
|
|
local $ENV{PERL_NET_HTTPS_SSL_SOCKET_CLASS} = 'IO::Socket::SSL'; |
203
|
0
|
|
|
|
|
|
$r = $nt->friends({ cursor => $cursor }); |
204
|
0
|
0
|
|
|
|
|
last if ! defined($r); |
205
|
0
|
|
|
|
|
|
$cursor = $r->{next_cursor}; |
206
|
|
|
|
|
|
|
|
207
|
0
|
|
|
|
|
|
for my $user (@{$r->{users}}) { |
|
0
|
|
|
|
|
|
|
208
|
0
|
|
|
|
|
|
$self->log->verbose("following: found user [".$user->{screen_name}."]"); |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
push @list, { |
211
|
|
|
|
|
|
|
name => $user->{name}, |
212
|
|
|
|
|
|
|
screen_name => $user->{screen_name}, |
213
|
|
|
|
|
|
|
description => $user->{description}, |
214
|
|
|
|
|
|
|
location => $user->{location}, |
215
|
|
|
|
|
|
|
following_count => $user->{friends_count}, |
216
|
|
|
|
|
|
|
followers_count => $user->{followers_count}, |
217
|
|
|
|
|
|
|
created => $user->{created_at}, |
218
|
|
|
|
|
|
|
language => $user->{lang}, |
219
|
0
|
|
|
|
|
|
}; |
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
} |
222
|
|
|
|
|
|
|
}; |
223
|
0
|
0
|
|
|
|
|
if ($@) { |
224
|
0
|
|
|
|
|
|
chomp($@); |
225
|
|
|
|
|
|
|
|
226
|
0
|
0
|
|
|
|
|
if ($@ =~ m{Rate limit exceeded}i) { |
227
|
0
|
|
|
|
|
|
$self->log->warning("following: rate limit exceeded, returning partial results"); |
228
|
0
|
|
|
|
|
|
return \@list; |
229
|
|
|
|
|
|
|
} |
230
|
|
|
|
|
|
|
|
231
|
0
|
|
|
|
|
|
return $self->log->error("following: unable to call method [$@]"); |
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
|
234
|
0
|
|
|
|
|
|
return \@list; |
235
|
|
|
|
|
|
|
} |
236
|
|
|
|
|
|
|
sub follow { |
237
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
238
|
0
|
|
|
|
|
|
my ($username) = @_; |
239
|
|
|
|
|
|
|
|
240
|
0
|
0
|
|
|
|
|
$self->brik_help_run_undef_arg('follow', $username) or return; |
241
|
|
|
|
|
|
|
|
242
|
0
|
0
|
|
|
|
|
my $nt = $self->connect or return; |
243
|
|
|
|
|
|
|
|
244
|
0
|
|
|
|
|
|
my $r; |
245
|
0
|
|
|
|
|
|
eval { |
246
|
0
|
|
|
|
|
|
local $ENV{PERL_NET_HTTPS_SSL_SOCKET_CLASS} = 'IO::Socket::SSL'; |
247
|
0
|
|
|
|
|
|
$r = $nt->follow($username); |
248
|
|
|
|
|
|
|
}; |
249
|
0
|
0
|
|
|
|
|
if ($@) { |
250
|
0
|
|
|
|
|
|
chomp($@); |
251
|
0
|
|
|
|
|
|
return $self->log->error("follow: unable to call method [$@]"); |
252
|
|
|
|
|
|
|
} |
253
|
|
|
|
|
|
|
|
254
|
0
|
|
|
|
|
|
return $username; |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
sub unfollow { |
258
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
259
|
0
|
|
|
|
|
|
my ($username) = @_; |
260
|
|
|
|
|
|
|
|
261
|
0
|
0
|
|
|
|
|
$self->brik_help_run_undef_arg('unfollow', $username) or return; |
262
|
|
|
|
|
|
|
|
263
|
0
|
0
|
|
|
|
|
my $nt = $self->connect or return; |
264
|
|
|
|
|
|
|
|
265
|
0
|
|
|
|
|
|
my $r; |
266
|
0
|
|
|
|
|
|
eval { |
267
|
0
|
|
|
|
|
|
local $ENV{PERL_NET_HTTPS_SSL_SOCKET_CLASS} = 'IO::Socket::SSL'; |
268
|
0
|
|
|
|
|
|
$r = $nt->unfollow($username); |
269
|
|
|
|
|
|
|
}; |
270
|
0
|
0
|
|
|
|
|
if ($@) { |
|
|
0
|
|
|
|
|
|
271
|
0
|
|
|
|
|
|
chomp($@); |
272
|
0
|
|
|
|
|
|
return $self->log->error("unfollow: unable to call method [$@]"); |
273
|
|
|
|
|
|
|
} |
274
|
|
|
|
|
|
|
elsif (! defined($r)) { |
275
|
0
|
|
|
|
|
|
return $self->log->error("unfollow: unable to call method [unknown error]"); |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
|
278
|
0
|
|
|
|
|
|
return $username; |
279
|
|
|
|
|
|
|
} |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
sub disconnect { |
282
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
283
|
|
|
|
|
|
|
|
284
|
0
|
|
|
|
|
|
$self->net_twitter(undef); |
285
|
|
|
|
|
|
|
|
286
|
0
|
|
|
|
|
|
return 1; |
287
|
|
|
|
|
|
|
} |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
# |
290
|
|
|
|
|
|
|
# https://dev.twitter.com/rest/public/rate-limits |
291
|
|
|
|
|
|
|
# |
292
|
|
|
|
|
|
|
sub rate_limit_status { |
293
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
294
|
|
|
|
|
|
|
|
295
|
0
|
0
|
|
|
|
|
my $nt = $self->connect or return; |
296
|
|
|
|
|
|
|
|
297
|
0
|
|
|
|
|
|
my $r; |
298
|
0
|
|
|
|
|
|
eval { |
299
|
0
|
|
|
|
|
|
local $ENV{PERL_NET_HTTPS_SSL_SOCKET_CLASS} = 'IO::Socket::SSL'; |
300
|
0
|
|
|
|
|
|
$r = $nt->rate_limit_status; |
301
|
|
|
|
|
|
|
}; |
302
|
0
|
0
|
|
|
|
|
if ($@) { |
|
|
0
|
|
|
|
|
|
303
|
0
|
|
|
|
|
|
chomp($@); |
304
|
0
|
|
|
|
|
|
return $self->log->error("rate_limit_status: unable to call method [$@]"); |
305
|
|
|
|
|
|
|
} |
306
|
|
|
|
|
|
|
elsif (! defined($r)) { |
307
|
0
|
|
|
|
|
|
return $self->log->error("rate_limit_status: unable to call method ". |
308
|
|
|
|
|
|
|
"[unknown error]"); |
309
|
|
|
|
|
|
|
} |
310
|
|
|
|
|
|
|
|
311
|
0
|
|
|
|
|
|
return $r; |
312
|
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
1; |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
__END__ |