| [b4d59be] | 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 | 
|---|
| [e960958] | 12 | use Net::Twitter::Lite::WithAPIv1_1; | 
|---|
| [b4d59be] | 13 | use FindBin qw($Bin); | 
|---|
|  | 14 | use YAML::Tiny; | 
|---|
|  | 15 | use Data::Dumper; | 
|---|
|  | 16 | use Encode; | 
|---|
|  | 17 |  | 
|---|
| [fe75883] | 18 | my $help = sub { | 
|---|
| [f1b126a] | 19 | die <<EOM; | 
|---|
|  | 20 | usage: $0 | 
|---|
| [0f8acb5] | 21 | [{u}ser_timeline(default)|{m}sentions|{s}earch | 
|---|
| [f1b126a] | 22 | [screen_name | 
|---|
|  | 23 | [number_of_pages|all | 
|---|
|  | 24 | [dump] | 
|---|
|  | 25 | ] | 
|---|
|  | 26 | ] | 
|---|
|  | 27 | ] | 
|---|
|  | 28 | EOM | 
|---|
| [fe75883] | 29 | }; | 
|---|
|  | 30 | if ($ARGV[0] && ($ARGV[0] eq '--help' || $ARGV[0] eq '-h') ) { | 
|---|
|  | 31 | &{$help}; | 
|---|
| [b4d59be] | 32 | } | 
|---|
| [fe75883] | 33 |  | 
|---|
| [f1b126a] | 34 | my $method = $ARGV[0] || 'user_timeline'; | 
|---|
|  | 35 | my $screen_name = $ARGV[1] || ''; | 
|---|
|  | 36 | my $pages = $ARGV[2] || 1; | 
|---|
| [b4d59be] | 37 | if ($pages eq 'all') { | 
|---|
|  | 38 | $pages = -1; | 
|---|
|  | 39 | } | 
|---|
| [f1b126a] | 40 | my $dump = $ARGV[3] || 0; | 
|---|
| [b4d59be] | 41 |  | 
|---|
|  | 42 | my $conf = loadconf("$Bin/config.yml"); | 
|---|
|  | 43 | if (! defined $conf) { | 
|---|
| [fe75883] | 44 | die "$0: cannot parse config file."; | 
|---|
| [b4d59be] | 45 | } | 
|---|
|  | 46 |  | 
|---|
|  | 47 | my $bot = login($conf); | 
|---|
|  | 48 | if (! $bot->authorized) { | 
|---|
| [fe75883] | 49 | die "$0: this client is not yet authorized."; | 
|---|
| [b4d59be] | 50 | } | 
|---|
|  | 51 |  | 
|---|
|  | 52 |  | 
|---|
|  | 53 | eval { | 
|---|
|  | 54 | my $page = 0; | 
|---|
| [c1b8ad4] | 55 | while ($pages - $page && $page <= 20) { | 
|---|
| [b4d59be] | 56 | $page++; | 
|---|
| [f1b126a] | 57 |  | 
|---|
|  | 58 | my $param = ($screen_name) | 
|---|
| [c1b8ad4] | 59 | ? { page => $page, screen_name => $screen_name, count => 200, } | 
|---|
|  | 60 | : { page => $page, count => 200, } | 
|---|
| [f1b126a] | 61 | ; | 
|---|
|  | 62 |  | 
|---|
|  | 63 | my $res; | 
|---|
| [5fa546f] | 64 | if ($method eq 'user_timeline' || $method eq 'u') { | 
|---|
| [f1b126a] | 65 | $res = $bot->user_timeline($param); | 
|---|
|  | 66 | } | 
|---|
| [5fa546f] | 67 | elsif ($method eq 'mentions' || $method eq 'm') { | 
|---|
| [f1b126a] | 68 | $res = $bot->mentions($param); | 
|---|
|  | 69 | } | 
|---|
| [52c76fd] | 70 | elsif ($method eq 'search' || $method eq 's') { | 
|---|
|  | 71 | my $key; | 
|---|
|  | 72 | foreach my $word (@{ $conf->{hashtag} }) { | 
|---|
|  | 73 | if ($key) { | 
|---|
|  | 74 | $key .= " OR $word"; | 
|---|
|  | 75 | } | 
|---|
|  | 76 | else { | 
|---|
|  | 77 | $key = $word; | 
|---|
|  | 78 | } | 
|---|
|  | 79 | } | 
|---|
|  | 80 | $param->{q} = $key; | 
|---|
|  | 81 | $res = $bot->search($param)->{results}; | 
|---|
|  | 82 | } | 
|---|
| [f1b126a] | 83 | else { | 
|---|
| [fe75883] | 84 | warn "$0: unknown method '$method'"; | 
|---|
|  | 85 | &{$help}; | 
|---|
| [f1b126a] | 86 | } | 
|---|
| [b4d59be] | 87 |  | 
|---|
|  | 88 | if ($dump) { | 
|---|
|  | 89 | foreach my $line (split /\n/, Dumper $res) { | 
|---|
|  | 90 | if ($line =~ /undef/) { next; } | 
|---|
|  | 91 | print $line, "\n"; | 
|---|
|  | 92 | } | 
|---|
|  | 93 | } | 
|---|
|  | 94 | else { | 
|---|
|  | 95 | foreach my $status (@{$res}) { | 
|---|
|  | 96 | my $text = ""; | 
|---|
| [ee655ec] | 97 | $text .= "(". $status->{id} . ") "; | 
|---|
| [6852f37] | 98 | $text .= ($status->{user}{screen_name}) ? | 
|---|
|  | 99 | $status->{user}{screen_name} : $status->{from_user}; | 
|---|
|  | 100 | $text .= "|"; | 
|---|
|  | 101 | $text .= ($status->{user}{name}) ? | 
|---|
|  | 102 | $status->{user}{name} : $status->{from_user_name}; | 
|---|
| [b4d59be] | 103 | $text .= " [" . $status->{created_at} . "]"; | 
|---|
| [294a3aa] | 104 | $text .= " ".  $status->{text}; | 
|---|
| [b4d59be] | 105 | $text =~ s/\n//; | 
|---|
| [294a3aa] | 106 | print encode('utf8', $text), "\n"; | 
|---|
| [b4d59be] | 107 | } | 
|---|
|  | 108 | } | 
|---|
|  | 109 | } | 
|---|
|  | 110 | }; | 
|---|
|  | 111 | if ($@) { | 
|---|
|  | 112 | evalrescue($@); | 
|---|
|  | 113 | } | 
|---|
|  | 114 |  | 
|---|
|  | 115 |  | 
|---|
|  | 116 | sub loadconf { | 
|---|
|  | 117 | # load configration data from yaml formatted file | 
|---|
|  | 118 | #   param   => scalar string of filename | 
|---|
|  | 119 | #   ret     => hash object of yaml data | 
|---|
|  | 120 |  | 
|---|
|  | 121 | my $file = shift @_; | 
|---|
|  | 122 |  | 
|---|
|  | 123 | my $yaml = YAML::Tiny->read($file); | 
|---|
|  | 124 |  | 
|---|
|  | 125 | if ($!) { | 
|---|
| [fe75883] | 126 | warn "$0: '$file' $!"; | 
|---|
| [b4d59be] | 127 | } | 
|---|
|  | 128 |  | 
|---|
|  | 129 | return $yaml->[0]; | 
|---|
|  | 130 | } | 
|---|
|  | 131 |  | 
|---|
|  | 132 | sub login { | 
|---|
| [e960958] | 133 | # make Net::Twitter::Lite::WithAPIv1_1 object and login | 
|---|
| [b4d59be] | 134 | #   param   => hash object of configration | 
|---|
| [e960958] | 135 | #   ret     => Net::Twitter::Lite::WithAPIv1_1 object | 
|---|
| [b4d59be] | 136 |  | 
|---|
|  | 137 | my $conf = shift @_; | 
|---|
|  | 138 |  | 
|---|
| [e960958] | 139 | my $bot = Net::Twitter::Lite::WithAPIv1_1->new( | 
|---|
| [b4d59be] | 140 | consumer_key    => $conf->{consumer_key}, | 
|---|
|  | 141 | consumer_secret => $conf->{consumer_secret}, | 
|---|
| [43d739e] | 142 | legacy_lists_api => 0, | 
|---|
| [7848b0b] | 143 | ssl             => 1, | 
|---|
| [b4d59be] | 144 | ); | 
|---|
|  | 145 |  | 
|---|
|  | 146 | $bot->access_token($conf->{access_token}); | 
|---|
|  | 147 | $bot->access_token_secret($conf->{access_token_secret}); | 
|---|
|  | 148 |  | 
|---|
|  | 149 | return $bot; | 
|---|
|  | 150 | } | 
|---|
|  | 151 |  | 
|---|
|  | 152 | sub evalrescue { | 
|---|
|  | 153 | # output error message at eval error | 
|---|
|  | 154 |  | 
|---|
|  | 155 | use Scalar::Util qw(blessed); | 
|---|
|  | 156 |  | 
|---|
|  | 157 | if (blessed $@ && $@->isa('Net::Twitter::Lite::Error')) { | 
|---|
|  | 158 | warn $@->error; | 
|---|
|  | 159 | if ($@->twitter_error) { | 
|---|
| [a5b6bf1] | 160 | my $twitter_error = $@->twitter_error; | 
|---|
|  | 161 | if (defined $twitter_error->{errors}) { | 
|---|
|  | 162 | foreach my $error (@{$twitter_error->{errors}}) { | 
|---|
|  | 163 | warn "code => "   , $error->{code}, "\n"; | 
|---|
|  | 164 | warn "message => ", $error->{message}, "\n"; | 
|---|
|  | 165 | } | 
|---|
|  | 166 | } | 
|---|
|  | 167 | else { | 
|---|
|  | 168 | # unknown HASH structure | 
|---|
|  | 169 | use Data::Dumper; | 
|---|
|  | 170 | warn Dumper $twitter_error; | 
|---|
|  | 171 | } | 
|---|
| [b4d59be] | 172 | } | 
|---|
|  | 173 | } | 
|---|
|  | 174 | else { | 
|---|
|  | 175 | warn $@; | 
|---|
|  | 176 | } | 
|---|
|  | 177 | } | 
|---|