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
  17 my $_execmode = $ARGV[0] || 0;
  18 sub VERBOSE () { $_execmode eq 'verbose' };
  19 sub DEBUG   () { VERBOSE or $_execmode eq 'debug' };
  20 use Data::Dumper;
  21
  22 DEBUG and warn "$0: debug mode";
  23
  24 my $conf = loadconf("$Bin/config.yml");
  25 if (! defined $conf) {
  26     die "$0: cannot parse config file.\n";
  27 }
  28 my $stat = loadconf("$Bin/status.yml");
  29 if (! defined $stat) {
  30     $stat = {};
  31 }
  32
  33 my $bot = login($conf);
  34 if (! $bot->authorized) {
  35     die "$0: this client is not yet authorized.\n";
  36 }
  37
  38 my $tweets = {};
  39 %$tweets = (
  40     %$tweets,
  41     %{ or_search($bot, $conf->{hashtag}, $stat->{search}) }
  42 );
  43 %$tweets = (
  44     %$tweets,
  45     %{ mentions_ids($bot, $stat->{mention}) }
  46 );
  47
  48 foreach 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') {
  52         DEBUG and warn "skipping $id that was already retweeted\n";
  53         next;
  54     }
  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
  76     DEBUG or sleep($conf->{sleep});
  77
  78     # do retweet found tweets
  79     my $res;
  80     eval {
  81         DEBUG  or $res = $bot->retweet($id);
  82         DEBUG and warn "retweet($id) => ", Dumper($tweets->{$id});
  83     };
  84     if ($@) {
  85         evalrescue($@);
  86         warn "status_id => $id\n";
  87         next;
  88     }
  89
  90     $stat->{$tweets->{$id}{type}} = $id;
  91 }
  92
  93 if ($tweets) {
  94     # save last status to yaml file
  95     DEBUG  or YAML::Tiny::DumpFile("$Bin/status.yml", $stat);
  96     DEBUG and warn "status.yml => ", Dumper($stat);
  97 }
  98
  99
 100 sub 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
 113     DEBUG and warn "'$file' => ", Dumper($yaml);
 114
 115     return $yaml->[0];
 116 }
 117
 118 sub 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
 136 sub 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 @_;
 144     my $since_id = shift @_ || 1;
 145
 146     my $key = "";
 147     foreach my $word (@$keywords) {
 148         if ($key) {
 149             $key .= " OR $word";
 150         }
 151         else {
 152             $key = $word;
 153         }
 154     }
 155     DEBUG and warn "searching '$key'";
 156
 157     my $res;
 158     my $ids = {};
 159     eval {
 160         if ($key) {
 161             $res = $bot->search(
 162                 {
 163                     q           => $key,
 164                     since_id    => $since_id,
 165                 }
 166             );
 167         }
 168         VERBOSE and warn Dumper($res);
 169         if ($res->{results}) {
 170             foreach my $tweet (@{$res->{results}}) {
 171                 my $res = $bot->show_status($tweet->{id});
 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},
 179                     user_id     => $res->{user}{id},
 180                 };
 181                 if ($res->{retweeted_status}) {
 182                     $id->{retweet_of}   = $res->{retweeted_status}{id};
 183                     $id->{type}         = 'retweet';
 184                 }
 185                 else {
 186                     $id->{type} = 'search';
 187                 }
 188                 $ids->{$tweet->{id}} = $id;
 189             }
 190         }
 191     };
 192     if ($@) {
 193         evalrescue($@);
 194     }
 195
 196     DEBUG and warn "search result => ", Dumper($ids);
 197     return $ids;
 198 }
 199
 200 sub 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 @_;
 207     my $since_id = shift @_ || 1;
 208
 209     my $res;
 210     eval {
 211         $res = $bot->mentions(
 212             {
 213                 since_id    => $since_id,
 214             }
 215         );
 216         VERBOSE and warn Dumper($res);
 217     };
 218     if ($@) {
 219         evalrescue($@);
 220     }
 221
 222     my $ids = {};
 223     if ($res && @{$res}) {
 224         $ids = {
 225             map {
 226                 $_->{id} => {
 227                     date        => str2time($_->{created_at}),
 228                     screen_name => $_->{user}{screen_name},
 229                     status_id   => $_->{id},
 230                     text        => $_->{text},
 231                     type        => 'mention',
 232                     user_id     => $_->{user}{id},
 233                 }
 234             } @{$res}
 235         };
 236     }
 237
 238     DEBUG and warn "mentions result => ", Dumper($ids);
 239     return $ids;
 240 }
 241
 242 sub 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 }