source: lab.git/Dev/twitter/twitterbot.pl @ 702399e

trunk
Last change on this file since 702399e was 702399e, checked in by mitty <mitty@…>, 14 years ago
  • change skip flag logic
  • bot behavior and results are not changed

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

  • Property mode set to 100755
File size: 6.8 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);
[5ce2daf]16
[f3ef4f6]17my $_execmode = $ARGV[0] || 0;
18sub VERBOSE () { $_execmode eq 'verbose' };
19sub DEBUG   () { VERBOSE or $_execmode eq 'debug' };
[f72bb76]20use Data::Dumper;
21
22DEBUG and warn "$0: debug mode";
23
[5ce2daf]24my $conf = loadconf("$Bin/config.yml");
25if (! defined $conf) {
26    die "$0: cannot parse config file.\n";
27}
28my $stat = loadconf("$Bin/status.yml");
29if (! defined $stat) {
[35889d4]30    $stat = {};
[5ce2daf]31}
32
33my $bot = login($conf);
34if (! $bot->authorized) {
35    die "$0: this client is not yet authorized.\n";
36}
37
[ac68e58]38my $tweets = {};
[e0c0679]39%$tweets = (
40    %$tweets,
41    %{ or_search($bot, $conf->{hashtag}, $stat->{search}) }
42);
43%$tweets = (
44    %$tweets,
45    %{ mentions_ids($bot, $stat->{mention}) }
46);
[5ce2daf]47
[ac68e58]48foreach my $id (sort keys %$tweets) {
49    # $tweets->{$id}{type} eq 'search'  => found by search API
50    #                      eq 'mention' => found by mention API
[702399e]51    my $skip;
[ac68e58]52    if ($tweets->{$id}{type} eq 'retweet') {
[641934f]53        DEBUG and warn "skipping $id that was already retweeted\n";
[702399e]54        $skip = $id;
[5ce2daf]55    }
[641934f]56    if (defined $conf->{allow}) {
[702399e]57        $skip = $id;
[641934f]58        foreach my $screen_name ( @{ $conf->{allow}{screen_name} } ) {
59            if ($tweets->{$id}{screen_name} eq $screen_name) {
60                DEBUG and warn "$id was allowed by screen_name\n";
[702399e]61                undef $skip;
[641934f]62                last;
63            }
64        }
65        foreach my $user_id ( @{ $conf->{allow}{user_id} } ) {
66            if ($tweets->{$id}{user_id} eq $user_id) {
67                DEBUG and warn "$id was allowed by user_id\n";
[702399e]68                undef $skip;
[641934f]69                last;
70            }
71        }
[702399e]72    }
73   
74    if ($skip) {
75        next;
[641934f]76    }
77   
[f72bb76]78    DEBUG or sleep($conf->{sleep});
[ac68e58]79   
80    # do retweet found tweets
[5ce2daf]81    my $res;
82    eval {
[f72bb76]83        DEBUG  or $res = $bot->retweet($id);
[ac68e58]84        DEBUG and warn "retweet($id) => ", Dumper($tweets->{$id});
[5ce2daf]85    };
86    if ($@) {
87        evalrescue($@);
88        warn "status_id => $id\n";
89        next;
90    }
91   
[ac68e58]92    $stat->{$tweets->{$id}{type}} = $id;
[5ce2daf]93}
94
[ac68e58]95if ($tweets) {
[5ce2daf]96    # save last status to yaml file
[f72bb76]97    DEBUG  or YAML::Tiny::DumpFile("$Bin/status.yml", $stat);
98    DEBUG and warn "status.yml => ", Dumper($stat);
[5ce2daf]99}
100
101
102sub loadconf {
103    # load configration data from yaml formatted file
104    #   param   => scalar string of filename
105    #   ret     => hash object of yaml data
106   
107    my $file = shift @_;
108   
109    my $yaml = YAML::Tiny->read($file);
110   
111    if ($!) {
112        warn "$0: '$file' $!\n";
113    }
114   
[641934f]115    DEBUG and warn "'$file' => ", Dumper($yaml);
116   
[5ce2daf]117    return $yaml->[0];
118}
119
120sub login {
121    # make Net::Twitter::Lite object and login
122    #   param   => hash object of configration
123    #   ret     => Net::Twitter::Lite object
124   
125    my $conf = shift @_;
126   
127    my $bot = Net::Twitter::Lite->new(
128        consumer_key    => $conf->{consumer_key},
129        consumer_secret => $conf->{consumer_secret},
130    );
131   
132    $bot->access_token($conf->{access_token});
133    $bot->access_token_secret($conf->{access_token_secret});
134   
135    return $bot;
136}
137
138sub or_search {
139    # search tweets containing keywords
140    #   param   => Net::Twitter::Lite object, ArrayRef of keywords, since_id
141    #   ret     => HashRef of status_id (timeline order is destroyed)
142    #               or undef (none is found)
143   
144    my $bot      = shift @_;
145    my $keywords = shift @_;
[35889d4]146    my $since_id = shift @_ || 1;
[5ce2daf]147   
148    my $key = "";
149    foreach my $word (@$keywords) {
150        if ($key) {
151            $key .= " OR $word";
152        }
153        else {
154            $key = $word;
155        }
156    }
[f72bb76]157    DEBUG and warn "searching '$key'";
[5ce2daf]158   
159    my $res;
160    my $ids = {};
161    eval {
162        if ($key) {
163            $res = $bot->search(
164                {
165                             => $key,
166                    since_id    => $since_id,
167                }
168            );
169        }
[139622c]170        VERBOSE and warn Dumper($res);
[5ce2daf]171        if ($res->{results}) {
172            foreach my $tweet (@{$res->{results}}) {
173                my $res = $bot->show_status($tweet->{id});
[139622c]174                VERBOSE and warn Dumper($res);
175               
176                my $id = {
177                    date        => str2time($res->{created_at}),
178                    screen_name => $res->{user}{screen_name},
179                    status_id   => $res->{id},
180                    text        => $res->{text},
[567a134]181                    user_id     => $res->{user}{id},
[139622c]182                };
[5ce2daf]183                if ($res->{retweeted_status}) {
[567a134]184                    $id->{retweet_of}   = $res->{retweeted_status}{id};
185                    $id->{type}         = 'retweet';
[5ce2daf]186                }
187                else {
[139622c]188                    $id->{type} = 'search';
[5ce2daf]189                }
[139622c]190                $ids->{$tweet->{id}} = $id;
[5ce2daf]191            }
192        }
193    };
194    if ($@) {
195        evalrescue($@);
196    }
197   
[f72bb76]198    DEBUG and warn "search result => ", Dumper($ids);
[5ce2daf]199    return $ids;
200}
201
202sub mentions_ids {
203    # return status_ids mentioned to me
204    #   param   => Net::Twitter::Lite object, since_id
205    #   ret     => HashRef of status_id (timeline order is destroyed)
206    #               or undef (none is found)
207   
208    my $bot      = shift @_;
[35889d4]209    my $since_id = shift @_ || 1;
[5ce2daf]210   
211    my $res;
212    eval {
213        $res = $bot->mentions(
214            {
215                since_id    => $since_id,
216            }
217        );
[f72bb76]218        VERBOSE and warn Dumper($res);
[5ce2daf]219    };
220    if ($@) {
221        evalrescue($@);
222    }
223   
[f72bb76]224    my $ids = {};
[5ce2daf]225    if ($res && @{$res}) {
226        $ids = {
[ac68e58]227            map {
228                $_->{id} => {
[139622c]229                    date        => str2time($_->{created_at}),
230                    screen_name => $_->{user}{screen_name},
231                    status_id   => $_->{id},
232                    text        => $_->{text},
233                    type        => 'mention',
[567a134]234                    user_id     => $_->{user}{id},
[ac68e58]235                }
236            } @{$res}
[5ce2daf]237        };
238    }
239   
[f72bb76]240    DEBUG and warn "mentions result => ", Dumper($ids);
[5ce2daf]241    return $ids;
242}
243
244sub evalrescue {
245    # output error message at eval error
246   
247    use Scalar::Util qw(blessed);
248   
249    if (blessed $@ && $@->isa('Net::Twitter::Lite::Error')) {
250        warn $@->error;
251        if ($@->twitter_error) {
252            my %twitter_error = %{$@->twitter_error};
253            map {
254                $twitter_error{"$_ => "} = $twitter_error{$_} . "\n";
255                delete $twitter_error{$_}
256            } keys %twitter_error;
257            warn join("", %twitter_error);
258        }
259    }
260    else {
261        warn $@;
262    }
263}
Note: See TracBrowser for help on using the repository browser.