3923a6b0dda3842a07a186b234e81a41f82e7604
[lab.git] / Dev / twitter / twitterbot.pl
1 #! /usr/bin/perl -w
2
3 use strict;
4 use warnings;
5 use utf8;
6
7 ## IMPORTANT ##
8 # When Net::Twitter::Lite encounters a Twitter API error or a network error, 
9 # it throws a Net::Twitter::Lite::Error object. 
10 # You can catch and process these exceptions by using eval blocks and testing $@
11 ## from http://search.cpan.org/perldoc?Net::Twitter::Lite#ERROR_HANDLING
12 use Net::Twitter::Lite;
13 use FindBin qw($Bin);
14 use YAML::Tiny;
15 use Date::Parse qw(str2time);
16 use Mail::Sendmail;
17 use Encode;
18
19 my $_execmode = $ARGV[0] || 0;
20 sub VERBOSE () { $_execmode eq 'verbose' };
21 sub DEBUG   () { VERBOSE or $_execmode eq 'debug' };
22 use Data::Dumper;
23
24 DEBUG and warn "$0: debug mode";
25
26 my $conf = loadconf("$Bin/config.yml");
27 if (! defined $conf) {
28     die "$0: cannot parse config file.\n";
29 }
30 my $stat = loadconf("$Bin/status.yml");
31 if (! defined $stat) {
32     $stat = {};
33 }
34
35 my $bot = login($conf);
36 if (! $bot->authorized) {
37     die "$0: this client is not yet authorized.\n";
38 }
39
40 my $tweets = {};
41 %$tweets = (
42     %$tweets,
43     %{ or_search($bot, $conf->{hashtag}, $stat->{search}) }
44 );
45 %$tweets = (
46     %$tweets,
47     %{ mentions_ids($bot, $stat->{mention}) }
48 );
49
50 foreach my $id (sort keys %$tweets) {
51     # $tweets->{$id}{type} eq 'search'  => found by search API
52     #                      eq 'mention' => found by mention API
53     my $skip;
54     if ($tweets->{$id}{type} eq 'retweet') {
55         DEBUG and warn "skipping $id that was already retweeted\n";
56         $skip = 'retweet';
57     }
58     if (defined $conf->{allow}) {
59         $skip = 'allow';
60         foreach my $screen_name ( @{ $conf->{allow}{screen_name} } ) {
61             if ($tweets->{$id}{screen_name} eq $screen_name) {
62                 DEBUG and warn "$id was allowed by screen_name\n";
63                 undef $skip;
64                 last;
65             }
66         }
67         foreach my $user_id ( @{ $conf->{allow}{user_id} } ) {
68             if ($tweets->{$id}{user_id} eq $user_id) {
69                 DEBUG and warn "$id was allowed by user_id\n";
70                 undef $skip;
71                 last;
72             }
73         }
74     }
75     
76     if (defined $conf->{mail}) {
77         my $send;
78         foreach my $pickup ( @{ $conf->{mail}{pickup} } ) {
79             if ($tweets->{$id}{type} eq $pickup) {
80                 $send = 1;
81                 last;
82             }
83         }
84         if ($conf->{mail}{ignore_allowed}) {
85             if (defined $conf->{allow} and ! defined $skip) {
86                 # this tweet was allowed to retweet, so that be ignored on mail
87                 undef $send;
88             }
89         }
90         
91         if ($send) {
92             if (! exists($conf->{mail}{body}) ) {
93                 $conf->{mail}{body} =
94                     "[localtime(date)] http://twitter.com/<screen_name>/status/<status_id> text\n" .
95                     "----------------------------------------\n"
96                 ;
97             }
98             $conf->{mail}{body} .=
99                 "[" . localtime($tweets->{$id}{date}) . "] " .
100                 "http://twitter.com/" .
101                 $tweets->{$id}{screen_name} . "/status/" .
102                 $tweets->{$id}{status_id} . " " .
103                 $tweets->{$id}{text} . "\n"
104             ;
105         }
106     }
107     
108     if ($skip) {
109         $stat->{$tweets->{$id}{type}} = $id;
110         next;
111     }
112     
113     DEBUG or sleep($conf->{sleep});
114     
115     # do retweet found tweets
116     my $res;
117     eval {
118         DEBUG  or $res = $bot->retweet($id);
119         DEBUG and warn "retweet($id) => ", Dumper($tweets->{$id});
120     };
121     if ($@) {
122         evalrescue($@);
123         warn "status_id => $id\n";
124         next;
125     }
126     
127     $stat->{$tweets->{$id}{type}} = $id;
128 }
129
130 if ($conf->{mail}{body}) {
131     my $body = encode("iso-2022-jp", $conf->{mail}{body});
132     
133     my %mail = (
134         Smtp            => $conf->{mail}{server},
135         From            => $conf->{mail}{from},
136         To              => join(", ", @{ $conf->{mail}{to} }),
137         Subject         => $conf->{mail}{subject},
138         "Content-Type"  => $conf->{mail}{contenttype},
139         Body            => $body,
140     );
141     DEBUG and warn "sending mail => ", Dumper(\%mail);
142     
143     DEBUG or sendmail(%mail) or warn "Error sending mail: $Mail::Sendmail::error\n";
144 }
145
146 if ($tweets) {
147     # save last status to yaml file
148     DEBUG  or YAML::Tiny::DumpFile("$Bin/status.yml", $stat);
149     DEBUG and warn "status.yml => ", Dumper($stat);
150 }
151
152
153 sub loadconf {
154     # load configration data from yaml formatted file
155     #   param   => scalar string of filename
156     #   ret     => hash object of yaml data
157     
158     my $file = shift @_;
159     
160     my $yaml = YAML::Tiny->read($file);
161     
162     if ($!) {
163         warn "$0: '$file' $!\n";
164     }
165     
166     DEBUG and warn "'$file' => ", Dumper($yaml);
167     
168     return $yaml->[0];
169 }
170
171 sub login {
172     # make Net::Twitter::Lite object and login
173     #   param   => hash object of configration
174     #   ret     => Net::Twitter::Lite object
175     
176     my $conf = shift @_;
177     
178     my $bot = Net::Twitter::Lite->new(
179         consumer_key    => $conf->{consumer_key},
180         consumer_secret => $conf->{consumer_secret},
181     );
182     
183     $bot->access_token($conf->{access_token});
184     $bot->access_token_secret($conf->{access_token_secret});
185     
186     return $bot;
187 }
188
189 sub or_search {
190     # search tweets containing keywords
191     #   param   => Net::Twitter::Lite object, ArrayRef of keywords, since_id
192     #   ret     => HashRef of status_id (timeline order is destroyed)
193     #               or undef (none is found)
194     
195     my $bot      = shift @_;
196     my $keywords = shift @_;
197     my $since_id = shift @_ || 1;
198     
199     my $key = "";
200     foreach my $word (@$keywords) {
201         if ($key) {
202             $key .= " OR $word";
203         }
204         else {
205             $key = $word;
206         }
207     }
208     DEBUG and warn "searching '$key'";
209     
210     my $res;
211     my $ids = {};
212     eval {
213         if ($key) {
214             $res = $bot->search(
215                 {
216                     q           => $key,
217                     since_id    => $since_id,
218                 }
219             );
220         }
221         VERBOSE and warn Dumper($res);
222         if ($res->{results}) {
223             foreach my $tweet (@{$res->{results}}) {
224                 my $res = $bot->show_status($tweet->{id});
225                 VERBOSE and warn Dumper($res);
226                 
227                 my $id = {
228                     date        => str2time($res->{created_at}),
229                     screen_name => $res->{user}{screen_name},
230                     status_id   => $res->{id},
231                     text        => $res->{text},
232                     user_id     => $res->{user}{id},
233                 };
234                 if ($res->{retweeted_status}) {
235                     $id->{retweet_of}   = $res->{retweeted_status}{id};
236                     $id->{type}         = 'retweet';
237                 }
238                 else {
239                     $id->{type} = 'search';
240                 }
241                 $ids->{$tweet->{id}} = $id;
242             }
243         }
244     };
245     if ($@) {
246         evalrescue($@);
247     }
248     
249     DEBUG and warn "search result => ", Dumper($ids);
250     return $ids;
251 }
252
253 sub mentions_ids {
254     # return status_ids mentioned to me
255     #   param   => Net::Twitter::Lite object, since_id
256     #   ret     => HashRef of status_id (timeline order is destroyed)
257     #               or undef (none is found)
258     
259     my $bot      = shift @_;
260     my $since_id = shift @_ || 1;
261     
262     my $res;
263     eval {
264         $res = $bot->mentions(
265             {
266                 since_id    => $since_id,
267             }
268         );
269         VERBOSE and warn Dumper($res);
270     };
271     if ($@) {
272         evalrescue($@);
273     }
274     
275     my $ids = {};
276     if ($res && @{$res}) {
277         $ids = {
278             map {
279                 $_->{id} => {
280                     date        => str2time($_->{created_at}),
281                     screen_name => $_->{user}{screen_name},
282                     status_id   => $_->{id},
283                     text        => $_->{text},
284                     type        => 'mention',
285                     user_id     => $_->{user}{id},
286                 }
287             } @{$res}
288         };
289     }
290     
291     DEBUG and warn "mentions result => ", Dumper($ids);
292     return $ids;
293 }
294
295 sub evalrescue {
296     # output error message at eval error
297     
298     use Scalar::Util qw(blessed);
299     
300     if (blessed $@ && $@->isa('Net::Twitter::Lite::Error')) {
301         warn $@->error;
302         if ($@->twitter_error) {
303             my %twitter_error = %{$@->twitter_error};
304             map {
305                 $twitter_error{"$_ => "} = $twitter_error{$_} . "\n";
306                 delete $twitter_error{$_}
307             } keys %twitter_error;
308             warn join("", %twitter_error);
309         }
310     }
311     else {
312         warn $@;
313     }
314 }