WEB+DB PressのOAuthコードをPerlで書いてみた

作者: 竹迫良範,和田卓人,じゅんいち☆かとう,太田昌吾,小野修司,ミック,嶋田裕二,個々一番,みやけん,清水亮,おにたま,中島聡,角田直行,はまちや2,上谷隆宏,青木俊介,大塚知洋,生尾剛士,大和田純,WEB+DB PRESS編集部
出版社/メーカー: 技術評論社
発売日: 2011/06/24
メディア: 大型本
購入: 20人クリック: 434回
この商品を含むブログ (22件) を見る

TwitterのOAuthでトークンもらう、つぶやく、タイムライン取得する、という機能がPHPで書かれていたので、Perlにしてみた。
TwitterにごにょごにゅしたいならNet::Twitterが常套だろうけれど、あえてOAuth::Lite::Consumerを使って理解した気になってみた。

conf.yaml

cons_key:      XXXXXXXXXXXXXXXXXXXXX
cons_secret:   XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
callback_url:  http://127.0.0.1/cgi-bin/rightgo09SampleApp/callback.cgi
req_token_url: https://api.twitter.com/oauth/request_token
auth_url:      https://api.twitter.com/oauth/authorize
acs_token_url: https://api.twitter.com/oauth/access_token

auth.cgi

#!/usr/local/perl5/perlbrew/perls/perl-5.14.1/bin/perl
use strict;
use warnings;
use CGI::Session;
use OAuth::Lite::Consumer;
use YAML ();

my $session = CGI::Session->new;

my $conf = YAML::LoadFile('conf.yaml');

my $oauth = OAuth::Lite::Consumer->new(
  consumer_key       => $conf->{cons_key},
  consumer_secret    => $conf->{cons_secret},
  request_token_path => $conf->{req_token_url},
  callback_url       => $conf->{callback_url},
);

my $req_token = $oauth->get_request_token;

$session->param( req_token_secret => $req_token->{secret} );

# 認可ページURLにリダイレクト
my $redirect_url = $conf->{auth_url}.'?oauth_token='.$req_token->{token};
print $session->header(-location => $redirect_url);

callback.cgi

#!/usr/local/perl5/perlbrew/perls/perl-5.14.1/bin/perl
use strict;
use warnings;
use OAuth::Lite::Consumer;
use Encode;
use CGI;
use CGI::Session;
use YAML ();

my $conf = YAML::LoadFile('conf.yaml');

my $cgi = CGI->new;
my $session = CGI::Session->new;

if (defined($cgi->param('denied'))) { # 認可が拒否された場合
  $cgi->redirect('/rightgo09SampleApp/');
  exit;
}

my $oauth = OAuth::Lite::Consumer->new(
  consumer_key       => $conf->{cons_key},
  consumer_secret    => $conf->{cons_secret},
  request_token_path => $conf->{req_token_url},
  access_token_path  => $conf->{acs_token_url},
  authorize_path     => $conf->{auth_url},
);

my $param_oauth_token    = $cgi->param('oauth_token');
my $param_oauth_verifier = $cgi->param('oauth_verifier');

my $access_token = $oauth->get_access_token(
  token    => $param_oauth_token,
  verifier => $param_oauth_verifier,
);

# セッションに保存
$session->param(acs_token => $access_token);

print $session->header( -location => 'result.cgi' );

result.cgi

#!/usr/local/perl5/perlbrew/perls/perl-5.14.1/bin/perl
use strict;
use warnings;
use OAuth::Lite::Consumer;
use Encode;
use CGI;
use CGI::Session;
use URI;
use YAML ();
use JSON;
use Encode qw/ encode_utf8 /;

my $conf = YAML::LoadFile('conf.yaml');
my $cgi = CGI->new;
my $session = CGI::Session->new;

if (!defined($session->param('acs_token'))) {
  $cgi->redirect('/rightgo09SampleApp/');
  exit;
}

my $oauth = OAuth::Lite::Consumer->new(
  consumer_key       => $conf->{cons_key},
  consumer_secret    => $conf->{cons_secret},
  request_token_path => $conf->{req_token_url},
  access_token_path  => $conf->{acs_token_url},
  authorize_path     => $conf->{auth_url},
);

my $access_token = $session->param('acs_token');

# つぶやく
my $res = $oauth->request(
  method => 'POST',
  url    => 'http://api.twitter.com/1/statuses/update.xml',
 #url    => 'http://twitter.com/statuses/update.xml',
  token  => $access_token,
  params => {
    status => scalar localtime,
    token => $access_token,
  },
);

# (ホーム)タイムライン取得
$res = $oauth->request(
  method => 'GET',
 #url    => 'http://api.twitter.com/1/statuses/user_timeline.json',
  url    => 'http://api.twitter.com/1/statuses/home_timeline.json',
  token  => $access_token,
);
my $timeline = decode_json($res->decoded_content);

print $session->header,
'<!doctype html>
<html>
  <head>
    <meta charset="UTF-8">
    <title>result.cgi</title>
    <style>.tweet{border:1px solid #9999ff}</style>
  </head>
  <body>
';
for my $tweet (@$timeline) {
  my $user = $tweet->{user}->{screen_name};
  my $text = encode_utf8($tweet->{text});
  print qq'<div class="tweet">',
        qq'<div class="user">$user</div>',
        qq'<div class="text">$text</div>',
        qq'</div>\n';
}
print '</body></html>';