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

trunk
Last change on this file since b949a0f was b9060c8, checked in by mitty <mitty@…>, 14 years ago
  • save status.yml only when new tweets were found

git-svn-id: https://lab.mitty.jp/svn/lab/trunk@106 7d2118f6-f56c-43e7-95a2-4bb3031d96e7

  • Property mode set to 100755
File size: 8.5 KB
RevLine 
[5ce2daf]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;
13use FindBin qw($Bin);
14use YAML::Tiny;
[139622c]15use Date::Parse qw(str2time);
[45a20c3]16use Mail::Sendmail;
17use Encode;
[5ce2daf]18
[f3ef4f6]19my $_execmode = $ARGV[0] || 0;
20sub VERBOSE () { $_execmode eq 'verbose' };
21sub DEBUG   () { VERBOSE or $_execmode eq 'debug' };
[f72bb76]22use Data::Dumper;
23
24DEBUG and warn "$0: debug mode";
25
[5ce2daf]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) {
[35889d4]32    $stat = {};
[5ce2daf]33}
34
35my $bot = login($conf);
36if (! $bot->authorized) {
37    die "$0: this client is not yet authorized.\n";
38}
39
[ac68e58]40my $tweets = {};
[e0c0679]41%$tweets = (
42    %$tweets,
43    %{ or_search($bot, $conf->{hashtag}, $stat->{search}) }
44);
45%$tweets = (
46    %$tweets,
47    %{ mentions_ids($bot, $stat->{mention}) }
48);
[5ce2daf]49
[ac68e58]50foreach my $id (sort keys %$tweets) {
51    # $tweets->{$id}{type} eq 'search'  => found by search API
52    #                      eq 'mention' => found by mention API
[702399e]53    my $skip;
[ac68e58]54    if ($tweets->{$id}{type} eq 'retweet') {
[641934f]55        DEBUG and warn "skipping $id that was already retweeted\n";
[45a20c3]56        $skip = 'retweet';
[5ce2daf]57    }
[641934f]58    if (defined $conf->{allow}) {
[45a20c3]59        $skip = 'allow';
[641934f]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";
[702399e]63                undef $skip;
[641934f]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";
[702399e]70                undef $skip;
[641934f]71                last;
72            }
73        }
[702399e]74    }
75   
[45a20c3]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   
[702399e]108    if ($skip) {
[24fa584]109        $stat->{$tweets->{$id}{type}} = $id;
[702399e]110        next;
[641934f]111    }
112   
[f72bb76]113    DEBUG or sleep($conf->{sleep});
[ac68e58]114   
115    # do retweet found tweets
[5ce2daf]116    my $res;
117    eval {
[f72bb76]118        DEBUG  or $res = $bot->retweet($id);
[ac68e58]119        DEBUG and warn "retweet($id) => ", Dumper($tweets->{$id});
[5ce2daf]120    };
121    if ($@) {
122        evalrescue($@);
123        warn "status_id => $id\n";
124        next;
125    }
126   
[ac68e58]127    $stat->{$tweets->{$id}{type}} = $id;
[5ce2daf]128}
129
[45a20c3]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
[b9060c8]146if (ref $tweets and keys %{$tweets}) {
[5ce2daf]147    # save last status to yaml file
[f72bb76]148    DEBUG  or YAML::Tiny::DumpFile("$Bin/status.yml", $stat);
149    DEBUG and warn "status.yml => ", Dumper($stat);
[5ce2daf]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   
[641934f]166    DEBUG and warn "'$file' => ", Dumper($yaml);
167   
[5ce2daf]168    return $yaml->[0];
169}
170
171sub 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
189sub 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 @_;
[35889d4]197    my $since_id = shift @_ || 1;
[5ce2daf]198   
199    my $key = "";
200    foreach my $word (@$keywords) {
201        if ($key) {
202            $key .= " OR $word";
203        }
204        else {
205            $key = $word;
206        }
207    }
[f72bb76]208    DEBUG and warn "searching '$key'";
[5ce2daf]209   
210    my $res;
211    my $ids = {};
212    eval {
213        if ($key) {
214            $res = $bot->search(
215                {
216                             => $key,
217                    since_id    => $since_id,
218                }
219            );
220        }
[139622c]221        VERBOSE and warn Dumper($res);
[5ce2daf]222        if ($res->{results}) {
223            foreach my $tweet (@{$res->{results}}) {
224                my $res = $bot->show_status($tweet->{id});
[139622c]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},
[567a134]232                    user_id     => $res->{user}{id},
[139622c]233                };
[5ce2daf]234                if ($res->{retweeted_status}) {
[567a134]235                    $id->{retweet_of}   = $res->{retweeted_status}{id};
236                    $id->{type}         = 'retweet';
[5ce2daf]237                }
238                else {
[139622c]239                    $id->{type} = 'search';
[5ce2daf]240                }
[139622c]241                $ids->{$tweet->{id}} = $id;
[5ce2daf]242            }
243        }
244    };
245    if ($@) {
246        evalrescue($@);
247    }
248   
[f72bb76]249    DEBUG and warn "search result => ", Dumper($ids);
[5ce2daf]250    return $ids;
251}
252
253sub 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 @_;
[35889d4]260    my $since_id = shift @_ || 1;
[5ce2daf]261   
262    my $res;
263    eval {
264        $res = $bot->mentions(
265            {
266                since_id    => $since_id,
267            }
268        );
[f72bb76]269        VERBOSE and warn Dumper($res);
[5ce2daf]270    };
271    if ($@) {
272        evalrescue($@);
273    }
274   
[f72bb76]275    my $ids = {};
[5ce2daf]276    if ($res && @{$res}) {
277        $ids = {
[ac68e58]278            map {
279                $_->{id} => {
[139622c]280                    date        => str2time($_->{created_at}),
281                    screen_name => $_->{user}{screen_name},
282                    status_id   => $_->{id},
283                    text        => $_->{text},
284                    type        => 'mention',
[567a134]285                    user_id     => $_->{user}{id},
[ac68e58]286                }
287            } @{$res}
[5ce2daf]288        };
289    }
290   
[f72bb76]291    DEBUG and warn "mentions result => ", Dumper($ids);
[5ce2daf]292    return $ids;
293}
294
295sub 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}
Note: See TracBrowser for help on using the repository browser.