source: lab.git/Dev/twitter/twitterbot.pl @ d9a45a4

Last change on this file since d9a45a4 was d9a45a4, checked in by Ken-ichi Mito <mitty@…>, 11 years ago

FIX: print error message causes error

  • Net::Twitter::Lite::Error->twitter_error->{errors} is sometimes simple string
  • Property mode set to 100755
File size: 8.9 KB
Line 
1#! /usr/bin/perl -w
2
3use strict;
4use warnings;
5use 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
12use Net::Twitter::Lite::WithAPIv1_1;
13use FindBin qw($Bin);
14use YAML::Tiny;
15use Date::Parse qw(str2time);
16use Mail::Sendmail;
17use Encode;
18
19my $_execmode = $ARGV[0] || 0;
20sub VERBOSE () { $_execmode eq 'verbose' };
21sub DEBUG   () { VERBOSE or $_execmode eq 'debug' };
22use Data::Dumper;
23
24DEBUG and warn "$0: debug mode";
25
26my $conf = loadconf("$Bin/config.yml");
27if (! defined $conf) {
28    die "$0: cannot parse config file.\n";
29}
30my $stat = loadconf("$Bin/status.yml");
31if (! defined $stat) {
32    $stat = {};
33}
34
35my $bot = login($conf);
36if (! $bot->authorized) {
37    die "$0: this client is not yet authorized.\n";
38}
39
40my $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
50foreach 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
130if ($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
146if (ref $tweets and keys %{$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
153sub 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
171sub login {
172    # make Net::Twitter::Lite::WithAPIv1_1 object and login
173    #   param   => hash object of configration
174    #   ret     => Net::Twitter::Lite::WithAPIv1_1 object
175   
176    my $conf = shift @_;
177   
178    my $bot = Net::Twitter::Lite::WithAPIv1_1->new(
179        consumer_key    => $conf->{consumer_key},
180        consumer_secret => $conf->{consumer_secret},
181        legacy_lists_api => 0,
182    );
183   
184    $bot->access_token($conf->{access_token});
185    $bot->access_token_secret($conf->{access_token_secret});
186   
187    return $bot;
188}
189
190sub or_search {
191    # search tweets containing keywords
192    #   param   => Net::Twitter::Lite::WithAPIv1_1 object, ArrayRef of keywords, since_id
193    #   ret     => HashRef of status_id (timeline order is destroyed)
194    #               or undef (none is found)
195   
196    my $bot      = shift @_;
197    my $keywords = shift @_;
198    my $since_id = shift @_ || 1;
199   
200    my $key = "";
201    foreach my $word (@$keywords) {
202        if ($key) {
203            $key .= " OR $word";
204        }
205        else {
206            $key = $word;
207        }
208    }
209    DEBUG and warn "searching '$key'";
210   
211    my $res;
212    my $ids = {};
213    eval {
214        if ($key) {
215            $res = $bot->search(
216                {
217                             => $key,
218                    since_id    => $since_id,
219                }
220            );
221        }
222        VERBOSE and warn Dumper($res);
223        if ($res->{statuses}) {
224            foreach my $tweet (@{$res->{statuses}}) {
225                my $res = $bot->show_status($tweet->{id});
226                VERBOSE and warn Dumper($res);
227               
228                my $id = {
229                    date        => str2time($res->{created_at}),
230                    screen_name => $res->{user}{screen_name},
231                    status_id   => $res->{id},
232                    text        => $res->{text},
233                    user_id     => $res->{user}{id},
234                };
235                if ($res->{retweeted_status}) {
236                    $id->{retweet_of}   = $res->{retweeted_status}{id};
237                    $id->{type}         = 'retweet';
238                }
239                else {
240                    $id->{type} = 'search';
241                }
242                $ids->{$tweet->{id}} = $id;
243            }
244        }
245    };
246    if ($@) {
247        evalrescue($@);
248    }
249   
250    DEBUG and warn "search result => ", Dumper($ids);
251    return $ids;
252}
253
254sub mentions_ids {
255    # return status_ids mentioned to me
256    #   param   => Net::Twitter::Lite::WithAPIv1_1 object, since_id
257    #   ret     => HashRef of status_id (timeline order is destroyed)
258    #               or undef (none is found)
259   
260    my $bot      = shift @_;
261    my $since_id = shift @_ || 1;
262   
263    my $res;
264    eval {
265        $res = $bot->mentions(
266            {
267                since_id    => $since_id,
268            }
269        );
270        VERBOSE and warn Dumper($res);
271    };
272    if ($@) {
273        evalrescue($@);
274    }
275   
276    my $ids = {};
277    if ($res && @{$res}) {
278        $ids = {
279            map {
280                $_->{id} => {
281                    date        => str2time($_->{created_at}),
282                    screen_name => $_->{user}{screen_name},
283                    status_id   => $_->{id},
284                    text        => $_->{text},
285                    type        => 'mention',
286                    user_id     => $_->{user}{id},
287                }
288            } @{$res}
289        };
290    }
291   
292    DEBUG and warn "mentions result => ", Dumper($ids);
293    return $ids;
294}
295
296sub evalrescue {
297    # output error message at eval error
298   
299    use Scalar::Util qw(blessed);
300   
301    if (blessed $@ && $@->isa('Net::Twitter::Lite::Error')) {
302        warn $@->error;
303        if ($@->twitter_error) {
304            my $twitter_error = $@->twitter_error;
305            if (defined $twitter_error->{errors} && ref($twitter_error->{errors})) {
306                foreach my $error (@{$twitter_error->{errors}}) {
307                    warn "code => "   , $error->{code}, "\n";
308                    warn "message => ", $error->{message}, "\n";
309                }
310            }
311            else {
312                # unknown HASH structure
313                use Data::Dumper;
314                warn Dumper $twitter_error;
315            }
316        }
317    }
318    else {
319        warn $@;
320    }
321}
Note: See TracBrowser for help on using the repository browser.