Perl で twitter のボットを作ろうとして少し調べてみたんですが、ネット上の情報では、その多くが Net::Twitter や Net::Twitter::Lite の CPAN モジュールを利用しています。これらのモジュールは他に依存するモジュールが多くて、レンタルサーバ上にインストールして動作させるにはちょっと厳しい感じです。仕方なく英語ドキュメントと格闘しながら、Perl で OAuth を突破して twitter にポストするスクリプトを 0 から書いてみました。
#!/usr/bin/perl use strict; use MIME::Base64; use Digest::HMAC_SHA1; use HTTP::Request; use LWP::UserAgent; use Data::Dumper; use constant { REQUEST_METHOD => 'POST', REQUEST_URI => 'http://api.twitter.com/1/statuses/update.xml', CONSUMER_KEY => 'CONSUMER_KEY', CONSUMER_SECRET => 'CONSUMER_SECRET', ACCESS_TOKEN => 'ACCESS_TOKEN', ACCESS_SECRET => 'ACCESS_SECRET', }; ### リクエストパラメータの準備 my %oauth = ( oauth_consumer_key => CONSUMER_KEY, oauth_token => ACCESS_TOKEN, oauth_signature_method => 'HMAC-SHA1', oauth_timestamp => time, oauth_nonce => generate_nonce (), oauth_version => '1.0', ); my %param = ( status => _encode_url ('Hello, World!'), ); $oauth{oauth_signature} = get_signature ( REQUEST_METHOD, REQUEST_URI, %oauth, %param); ### リクエストを生成する my $req = HTTP::Request->new (REQUEST_METHOD, REQUEST_URI, [ 'Authorization' => get_oauth_header (%oauth), ], get_content (%param)) or die 'Failed to initialize HTTP::Request'; ### リクエストを投げる my $ua = LWP::UserAgent->new or die 'Failed to initialize LWP::UserAgent'; my $res = $ua->request ($req) or die 'Failed to request'; print '-' x 72, " ", "Response ", '-' x 72, " ", Dumper ($res);#DEBUG ### oauth_nonce を生成する sub generate_nonce { my $str = _encode_base64 (pack 'C*', map { int rand 256 } 1..12 ); # 記号は除く $str =~ tr!+=/!012!; $str; } ### 送信するパラメータから oauth_signature を求める sub get_signature { my ($method, $uri, %params) = @_; my $params = join '&', map { join '=', $_, $params{$_}; } sort keys %params; my $base_string = join '&', $method, _encode_url ($uri), _encode_url ($params); my $key = join '&', CONSUMER_SECRET, ACCESS_SECRET; _encode_base64 (Digest::HMAC_SHA1::hmac_sha1 ($base_string, $key)); } ### OAuth HTTP ヘッダ文字列の生成する sub get_oauth_header { my (%param) = @_; 'OAuth '. join ', ', map { sprintf '%s="%s"', $_, _encode_url ($param{$_}); } keys %param; } ### POST するデータ文字列を生成する sub get_content { my (%param) = @_; join '&', map { sprintf '%s=%s', $_, $param{$_}; } keys %param; } ### 文字列を URL エンコードする sub _encode_url { my ($str) = @_; $str =~ s!([^a-zA-Z0-9_.~-])!sprintf '%%%02X',ord($1)!ge; $str; } ### データを MIME::Base64 エンコードする sub _encode_base64 { my ($str) = @_; $str = MIME::Base64::encode ($str); # エンコードされた文字列の末尾に改行コードがくっついてくるっぽい $str =~ s/^s+|s+$//g; $str; }
generate_nonce
)get_signature
)MIME::Base64::encode
では、勝手に末尾に改行を付与してくれるので、自前関数でラッピングした(_encode_base64
)
寄せられたコメント (全 1 件中、最新 5 件まで表示しています)
ありがとうございました。