source: lab.git/Dev/twitter/twitterbot.pl @ 641934f

trunk
Last change on this file since 641934f was 641934f, checked in by mitty <mitty@…>, 14 years ago
  • add more debug output
  • NEW: retweet only allowed users' tweets
    • like this
      allow:
        screen_name:
          - mittyorz
        user_id:
          - 211556294
      
    • this feature only works when "allow:" entry exists

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

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