Twitter API 1.1対応の自動ツイートコード

ツイッターAPI1.1に対応するPerlでのツイート用コードです。
http://www.magicvox.net/archive/2010/12311401/のソースを一部改変しています。

use uft8;
use strict;
use warnings;
use Encode qw(encode decode);
use MIME::Base64;
use LWP::UserAgent;
use Digest::HMAC_SHA1;
use HTTP::Request;

use constant {
##Twitter
	REQUEST_METHOD  => 'POST',
	REQUEST_URI     => 'http://api.twitter.com/1.1/statuses/update.json',
	CONSUMER_KEY    => 'コンシューマーキー',
	CONSUMER_SECRET => 'コンシューマーシークレット',
	ACCESS_TOKEN    => 'アクセストークン',
	ACCESS_SECRET   => 'アクセスシークレット',
};

###########################################
## 以下のソースコードは
## http://www.magicvox.net/archive/2010/12311401/
## 掲載のものを一部修正したもの。
## MITライセンス
sub tweetMessage{
	my $message = shift;
	my $lat		= shift;
	my $lon		= shift;
	my $log		= '';
	#文字数チェックと改行除く。
	my $c_text = $message;
	$c_text =~ s/\r//sig;
	$c_text =~ s/\n//sig;
	my $length = length($c_text);
	if($length > 200){
		return("Message length[$length] too much at tweetMessage.[$c_text]\n");
	}
	### リクエストパラメータの準備
	my %oauth = (
	oauth_consumer_key => CONSUMER_KEY,
	oauth_token => ACCESS_TOKEN,
	oauth_signature_method => 'HMAC-SHA1',
	oauth_timestamp => time,
	oauth_nonce => 'SD'.sprintf("%09d",int(rand(100000000))),
	oauth_version => '1.0');

	my %param = (status => _encode_url($c_text));
	if($lat && $lon){$param{lat} = $lat; $param{long} = $lon;}
	
	$oauth{oauth_signature} = get_signature(
		REQUEST_METHOD,
		REQUEST_URI,
		%oauth,
		%param);
	my $res;
	eval{
		### リクエストを生成する
		my $content = get_content(%param);
		my $req = HTTP::Request->new (REQUEST_METHOD, REQUEST_URI, ['Authorization' => get_oauth_header(%oauth), 'Content-Type' => 'application/x-www-form-urlencoded'], $content)
			or die 'Failed to initialize HTTP::Request';
		### リクエストを投げる
		if(not(F_DEBUG)){
			my $ua = LWP::UserAgent->new	or die 'Failed to initialize LWP::UserAgent';
			$res = $ua->request ($req)		or die 'Failed to request';
			my $sl = $res->status_line;
			$log .= &addLog("twitter status_line is $sl.");
		}
	};
	if($@){	$log .= &addLog("$@");}
	else{	$log .= &addLog("tweet『$c_text』with lat:$lat, lng:$lon.");}
	return ($log);
}
### 送信するパラメータから oauth_signature を求める
sub get_signature {
	my ($method, $uri, %params) = @_;
	my $param = join '&', map {
		join '=', $_, $params{$_};
		} sort keys %params;
	my $base_string = join '&',
		$method,
		_encode_url ($uri),
		_encode_url ($param);
	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 = encode('UTF-8',shift);
	$str =~ s!([^a-zA-Z0-9_.~-])!sprintf '%%%02X',ord($1)!ge;
	return ($str);
}
### データを MIME::Base64 エンコードする
sub _encode_base64 {
	my $str = shift;
	$str = MIME::Base64::encode ($str);
	# エンコードされた文字列の末尾に改行コードがくっついてくるっぽい
	$str =~ s/^s+|s+$//g;
	return ($str);
###########################################
## 以下のソースコードは
## http://www.magicvox.net/archive/2010/12311401/
## 掲載のものを一部修正したもの。
## MITライセンス
sub tweetMessage{
	my $message = shift;
	my $lat		= shift;
	my $lon		= shift;
	my $log		= '';
	#文字数チェックと改行除く。
	my $c_text = $message;
	$c_text =~ s/\r//sig;
	$c_text =~ s/\n//sig;
	my $length = length($c_text);
	if($length > 200){
		return("Message length[$length] too much at tweetMessage.[$c_text]\n");
	}
	### リクエストパラメータの準備
	my %oauth = (
	oauth_consumer_key => CONSUMER_KEY,
	oauth_token => ACCESS_TOKEN,
	oauth_signature_method => 'HMAC-SHA1',
	oauth_timestamp => time,
	oauth_nonce => 'SD'.sprintf("%09d",int(rand(100000000))),
	oauth_version => '1.0');

	my %param = (status => _encode_url($c_text));
	if($lat && $lon){$param{lat} = $lat; $param{long} = $lon;}
	
	$oauth{oauth_signature} = get_signature(
		REQUEST_METHOD,
		REQUEST_URI,
		%oauth,
		%param);
	my $res;
	eval{
		### リクエストを生成する
		my $content = get_content(%param);
		my $req = HTTP::Request->new (REQUEST_METHOD, REQUEST_URI, ['Authorization' => get_oauth_header(%oauth), 'Content-Type' => 'application/x-www-form-urlencoded'], $content)
			or die 'Failed to initialize HTTP::Request';
		### リクエストを投げる
		if(not(F_DEBUG)){
			my $ua = LWP::UserAgent->new	or die 'Failed to initialize LWP::UserAgent';
			$res = $ua->request ($req)		or die 'Failed to request';
			my $sl = $res->status_line;
			$log .= &addLog("twitter status_line is $sl.");
		}
	};
	if($@){	$log .= &addLog("$@");}
	else{	$log .= &addLog("tweet『$c_text』with lat:$lat, lng:$lon.");}
	return ($log);
}
### 送信するパラメータから oauth_signature を求める
sub get_signature {
	my ($method, $uri, %params) = @_;
	my $param = join '&', map {
		join '=', $_, $params{$_};
		} sort keys %params;
	my $base_string = join '&',
		$method,
		_encode_url ($uri),
		_encode_url ($param);
	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 = encode('UTF-8',shift);
	$str =~ s!([^a-zA-Z0-9_.~-])!sprintf '%%%02X',ord($1)!ge;
	return ($str);
}
### データを MIME::Base64 エンコードする
sub _encode_base64 {
	my $str = shift;
	$str = MIME::Base64::encode ($str);
	# エンコードされた文字列の末尾に改行コードがくっついてくるっぽい
	$str =~ s/^s+|s+$//g;
	return ($str);
}

 No comments