Flickr::API と Cookie を

2006-11-06

Perl

だいたい掴んだ。

意味もよくわからず、CGI::Session に secure オプションをつけて、「おかしいなー、クッキー取れないなぁ」とかって半日悩んだ。3連休最後、いろんな意味ですばらしい締めくくり。

Cookie仕様日本語訳 - http://www.futomi.com/lecture/cookie/specification.html

今の会社に転職するまで、Cookie も JavaScript もないモバイルな環境の仕事しかしてこなかったので（すごい言い訳）、Cookie、知ってはいるけれど具体的にナニをアレしてとか、さっぱりやったことなかったけど、今日ようやく。

CGI::App で Flickr::API を使った認証するのを、Web+DB Press Vol.34 みながら書いてみた。CGI::App化したの以外はだいたい同じ。だらだら全部コード貼り付けておいてみる。

WEB+DB PRESS Vol.34

ルートクラス。

package MyAuth;

use strict;
use warnings;
use base qw(CGI::Application);

use CGI::Application::Plugin::TT;
use CGI::Application::Plugin::Stash;
use CGI::Application::Plugin::Session;
use CGI::Application::Plugin::DebugScreen;

sub cgiapp_init {
    my ($self) = @_;

    $self->tt_config(
        TEMPLATE_OPTIONS => {
            COMPILE_DIR => '/tmp/ttcache',
            PRE_CHOMP  => 1,
            INCLUDE_PATH => '/home/www/lab/auth/tmpl',
        },
    );

    $self->session_config(
        CGI_SESSION_OPTIONS => [
            "driver:file",
            $self->query,
            { Directory => '/tmp/cgisess' },
        ],
        COOKIE_PARAMS => {
            -domain  => 'lab.norainu.net',
            -expires => '+1h',
            -path    => $self->query->url(-absolute => 1),
        },
        SEND_COOKIE => 1,
    );

    $self->mode_param(
        path_info => 1,
    );
}

1;

Flickr::API でログインなクラス。

package MyAuth::Flickr;

use strict;
use warnings;
use base qw(MyAuth);

use CGI::Application::Plugin::Redirect;

use Flickr::API;
use XML::Parser::Lite::Tree::XPath;

sub setup {
    my $self = shift;

    $self->start_mode('default');
    $self->run_modes(
        default => 'default',
        login   => 'index',
        verify  => 'verify',
        logout  => 'logout',
    );

    my $api = Flickr::API->new({
        key    => 'アレ',
        secret => 'ソレ',
    });
    $self->stash->{api} = $api;

    $self->stash->{apiname}   = 'Flickr::API';
    $self->stash->{login_uri} = $api->request_auth_url('read');
}

sub default {
    my $self = shift;

    if ($self->session->param('logged_in_flickr')) {
        $self->stash->{session} = $self->session->dataref;
        $self->stash->{is_logged_in} = 1;
    }

    $self->tt_process('index.tt');
}

sub login {
    die "cannot /login";
}

sub verify {
    my $self = shift;
    my $uinfo = $self->_process_verify;

    $self->session->param(
        logged_in_flickr => 1,
        username         => $uinfo->{username},
    );
    $self->redirect($self->query->url);
}

sub logout {
    my $self = shift;

    $self->session->delete;
    $self->redirect($self->query->url);
}

sub _process_verify {
    my $self = shift;

    my $api = $self->stash->{api};
    my $q   = $self->query;

    my ($nsid, $token);
    {
        my $frob = $q->param('frob');
        my $res  = $api->execute_method(
            'flickr.auth.getToken',
            { frob => $frob },
        );
        $res->{success} or die $res->{error_message};
        my $xpath = XML::Parser::Lite::Tree::XPath->new($res->{tree}) or die;

        my ($node) = $xpath->select_nodes('/auth/user');
        $nsid = $node->{attributes}{nsid};

        ($node) = $xpath->select_nodes('/auth/token');
        $token = $node->{children}[0]{content};
    }

    my ($xpath);
    {
        my $res = $api->execute_method(
            'flickr.people.getInfo',
            { user_id => $nsid, auth_token => $token },
        );
        $res->{success} or die $res->{error_message};
        $xpath = XML::Parser::Lite::Tree::XPath->new($res->{tree});
    }

    my $uinfo = {};
    for my $field (qw(username realname mbox_sha1sum profileurl photosurl)) {
        my ($node) = $xpath->select_nodes("/person/$field");
        $uinfo->{$field} = $node->{children}[0]{content};
    }

    return $uinfo;
}

1;

Hatena::API::Auth と Authen::TypeKeyも試しておこう。