とりあえず、PerlCasual#02を受けてのアウトプット第1弾。
PerlCasual#02のライブコーディングに影響を受けてTwitter BOTを作るための前準備としてちょっとしたスクリプトとモジュールを書きました。基本構造はライブコーディングの例を参考にさせていただきました。
Net::Twitterを使えば、もっと簡単にできるんでしょうけど、勉強のためあえてLWPを使ってやってみました。
コードを見れば分かりますが、Windows(sjis)環境しか想定していないです。
下記の3つの実行スクリプトとTwitterにアクセスするクラスを定義しています。
- twitter_post.pl - Twitterに投稿するスクリプト
- twitter_timeline.pl - TwitterからHome Time Lineを取得するスクリプト
- twitter_search.pl - Twitterからキーワードを検索するスクリプト
twitter_post.pl
Twitterに投稿するスクリプト
どの実行スクリプトに関しても特筆すべきところはないです。
#!/usr/bin/env perl use strict; use warnings; use utf8; use Encode; use Readonly; use Twitter; use TwitterUtil; sub main { my %options = init(); my $twitter = new Twitter{ user => $options{'-u'}, password => $options{'-p'}, }; die 'Input post text' if (not exists $options{'-t'}); $twitter->post(decode('sjis', $options{'-t'})); } main() if (not caller());
実行形式はこんな感じ。-t オプションの後に投稿内容を指定します。
perl twitter_post.pl -u USER -p PASSWORD -t "TWEET"
twitter_timeline.pl
TwitterからHome Time Lineを取得するスクリプト
#!/usr/bin/env perl use strict; use warnings; use utf8; use Twitter; use TwitterUtil; sub main { my %options = init(); my $twitter = new Twitter{ user => $options{'-u'}, password => $options{'-p'}, }; $twitter->timeline(); } main() if (not caller());
実行形式はこんな感じ
perl twitter_timeline.pl -u USER -p PASSWORD
twitter_search.pl
Twitterからキーワードを検索するスクリプト。
検索に関しては、アカウントが必要ないため、Twitterクラスに空のuserとaccountを渡しています。ちょっとこの辺が気持ち悪いのですが、良い方法がすぐに思いつかなかったのでそのままです。
#!/usr/bin/env perl use strict; use warnings; use utf8; use Encode; use Twitter; use TwitterUtil; sub main { die 'Input search keyword' if (not exists $ARGV[0]); my $twitter = new Twitter({ user => "", password => "", }); $twitter->search(decode('sjis', $ARGV[0])); } main() if (not caller());
実行形式はこんな感じ
perl twitter_search.pl "SEARCH WORD"
Twitter.pm
Twitterにアクセスするクラス。
LWPを使用して実装しています。UserAgentオブジェクトを作成し、credentialsメソッドで認証します。
postに関しては、UPDATE API URIに対してハッシュリファレンスの内容をpostしています。単純な投稿の場合は、statusをキーにTweetを値とします。
package Twitter; use strict; use warnings; use utf8; use Carp; use Encode; use JSON; use LWP::UserAgent; use Readonly; Readonly my $TWITTER_URI => 'twitter.com:80'; Readonly my $TWITTER_API => 'Twitter API'; Readonly my $UPDATE_API => 'http://twitter.com/statuses/update.json'; Readonly my $TIMELINE_API => 'http://twitter.com/statuses/home_timeline.json'; Readonly my $SEARCH_URI => 'http://search.twitter.com/search.json?q='; sub new { my ($class, $options) = @_; croak "Twitter - Must pass in a hash ref of options!" if (not ref($options) eq 'HASH'); croak 'Twitter - Missing user' if (not defined $options->{'user'}); croak 'Twitter - Missing password' if (not defined $options->{'password'}); $options->{'ua'} = LWP::UserAgent->new( timeout => 10, ); $options->{'ua'}->credentials( $TWITTER_URI, $TWITTER_API, $options->{'user'}, $options->{'password'}, ); return bless $options, $class; } sub post { my ($self, $message) = @_; my $response = $self->{'ua'}->post( $UPDATE_API, { status => decode_utf8($message) } ); if(not $response->is_success) { croak 'Bad Request', $response->as_string; } } sub search { my ($self, $key_word) = @_; my $response = $self->{'ua'}->get($SEARCH_URI . $key_word); if(not $response->is_success) { die 'Bad Request', $response->as_string; } my $tweets = decode_json($response->decoded_content); for my $tweet (@{ $tweets->{results} }) { my $text = sprintf( "name: %-10s replyto: %-10s \n%s\n\n", $tweet->{'from_user'}, defined($tweet->{'to_user'}) ? $tweet->{'to_user'} : "", $tweet->{'text'}, ); print encode('sjis', $text); } } sub timeline { my ($self, $message) = @_; my $response = $self->{'ua'}->get( $TIMELINE_API, ); if(not $response->is_success) { croak 'Bad Request', $response->as_string; } my $tweets = decode_json($response->decoded_content); for my $tweet (@{$tweets}) { my $text = sprintf( "name: %-10s id: %-10s\n%s\n\n", $tweet->{'user'}->{'name'}, $tweet->{'user'}->{'screen_name'}, $tweet->{'text'} ); print encode('sjis', $text); } } 1;
TwitterUtil.pm
とりあえずスクリプト間での共通関数を置くパッケージ。
userとpasswordが指定されていない場合、入力を求めます。
package TwitterUtil; use strict; use warnings; use utf8; use Exporter; our @ISA = qw(Exporter); our @EXPORT = qw(init); sub init { my %options = @ARGV; if (not exists $options{'-u'}) { print 'User : '; $options{'-u'} = <STDIN>; chomp $options{'-u'}; } if (not exists $options{'-p'}) { print 'Password : '; $options{'-p'} = <STDIN>; chomp $options{'-p'}; } return %options; } 1;