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     my $skip;
  52     if ($tweets->{$id}{type} eq 'retweet') {
  53         DEBUG and warn "skipping $id that was already retweeted\n";
  54         $skip = $id;
  55     }
  56     if (defined $conf->{allow}) {
  57         $skip = $id;
  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";
  61                 undef $skip;
  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";
  68                 undef $skip;
  69                 last;
  70             }
  71         }
  72     }
  73
  74     if ($skip) {
  75         next;
  76     }
  77
  78     DEBUG or sleep($conf->{sleep});
  79
  80     # do retweet found tweets
  81     my $res;
  82     eval {
  83         DEBUG  or $res = $bot->retweet($id);
  84         DEBUG and warn "retweet($id) => ", Dumper($tweets->{$id});
  85     };
  86     if ($@) {
  87         evalrescue($@);
  88         warn "status_id => $id\n";
  89         next;
  90     }
  91
  92     $stat->{$tweets->{$id}{type}} = $id;
  93 }
  94
  95 if ($tweets) {
  96     # save last status to yaml file
  97     DEBUG  or YAML::Tiny::DumpFile("$Bin/status.yml", $stat);
  98     DEBUG and warn "status.yml => ", Dumper($stat);
  99 }
 100
 101
 102 sub 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
 115     DEBUG and warn "'$file' => ", Dumper($yaml);
 116
 117     return $yaml->[0];
 118 }
 119
 120 sub 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
 138 sub 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 @_;
 146     my $since_id = shift @_ || 1;
 147
 148     my $key = "";
 149     foreach my $word (@$keywords) {
 150         if ($key) {
 151             $key .= " OR $word";
 152         }
 153         else {
 154             $key = $word;
 155         }
 156     }
 157     DEBUG and warn "searching '$key'";
 158
 159     my $res;
 160     my $ids = {};
 161     eval {
 162         if ($key) {
 163             $res = $bot->search(
 164                 {
 165                     q           => $key,
 166                     since_id    => $since_id,
 167                 }
 168             );
 169         }
 170         VERBOSE and warn Dumper($res);
 171         if ($res->{results}) {
 172             foreach my $tweet (@{$res->{results}}) {
 173                 my $res = $bot->show_status($tweet->{id});
 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},
 181                     user_id     => $res->{user}{id},
 182                 };
 183                 if ($res->{retweeted_status}) {
 184                     $id->{retweet_of}   = $res->{retweeted_status}{id};
 185                     $id->{type}         = 'retweet';
 186                 }
 187                 else {
 188                     $id->{type} = 'search';
 189                 }
 190                 $ids->{$tweet->{id}} = $id;
 191             }
 192         }
 193     };
 194     if ($@) {
 195         evalrescue($@);
 196     }
 197
 198     DEBUG and warn "search result => ", Dumper($ids);
 199     return $ids;
 200 }
 201
 202 sub 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 @_;
 209     my $since_id = shift @_ || 1;
 210
 211     my $res;
 212     eval {
 213         $res = $bot->mentions(
 214             {
 215                 since_id    => $since_id,
 216             }
 217         );
 218         VERBOSE and warn Dumper($res);
 219     };
 220     if ($@) {
 221         evalrescue($@);
 222     }
 223
 224     my $ids = {};
 225     if ($res && @{$res}) {
 226         $ids = {
 227             map {
 228                 $_->{id} => {
 229                     date        => str2time($_->{created_at}),
 230                     screen_name => $_->{user}{screen_name},
 231                     status_id   => $_->{id},
 232                     text        => $_->{text},
 233                     type        => 'mention',
 234                     user_id     => $_->{user}{id},
 235                 }
 236             } @{$res}
 237         };
 238     }
 239
 240     DEBUG and warn "mentions result => ", Dumper($ids);
 241     return $ids;
 242 }
 243
 244 sub 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 }