Kyoto.pm 04 Hackathonに参加しました

"Kyoto.pm 04 Hackathon"に参加しました.

畳部屋でかつ,人間をだめにするクッションの上で開発してました. とても快適でした.

作ったのはぼくの研究活動を快適にするための Net::Signaletというモジュールです.

y-uuki/Net-Signalet · GitHub

サーバクライアントモデルのベンチマークアプリケーションでサーバサイドのプロファイルを取りたい.ただし,普通にやるとサーバ側はクライアントと通信していない間は遊んでしまっているので,端末Aでサーバを起動し端末Bでクライアントを起動する間のプロファイルには意味がない.(通信終了後についても同様) そこで,クライアントの通信開始から終了までの期間のみプロファイルしたい.

というときに使います. アイデアは,サーバクライアントそれぞれに対して親プロセスとなるSupervisor的なプロセスを用意し,それぞれのSupervisorが独自のシグナルを送受信することにより,サーバの起動終了タイミングをクライアントの起動終了と同期させます.

f:id:y_uuki:20130402222858j:plain

カーネルに詳しいid:shohex さんがいらしていたので懇親会でもっとカーネルの話聞きたいみたいな感じでしたが,Perlとはぜんぜん関係ないみたいな感じだったので,また別の機会にカーネルの話聞きたいですね.

id:kiyotune さんには,"Twitterでこっそりブロックしてすぐにブロック解除する.フォローがはずれた理由はTwitterのバグ."というソリューションを教えて頂きました.

懇親会終わった後,id:kfly8 さんとラーメン食べてました. すがりに行こうとしたけどもう閉まってたから,天天有行きました. 東京の業界情報をいろいろ教えて頂きました. MF社に遊びにいきます.

id:shiba_yu36 先生,おつかれさまでした. 次回は東京のすごい人を呼ぶ感じらしいです.

#kyotopm 04 Hackathonを開催して、Cinnamonの並列化に取り組んでいました - $shibayu36->blog;

Kansai.pmでORMのパフォーマンスチェッカの構想についてLTしてきた

Kansai.pm #15に参加してきた.  

JPA派遣講師として来ていただいた@yusukebeさんの話が今回の目玉だった.

BoketeのValidationの話聞いて,そういえばPerlのValidationを真面目に考えたことなかったなと思って,FormのValidationにはForm::Validator::Lite,ModelのValidationにはData::Validatorというところだけ覚えておいてあとは自分で試してみる.

id:shiba_yu36 さんが作ってるCinnamon、普通に便利そうだし,Capもよくわからずに適当に使ってる感があるからCapにこだわってないし使ってみたい. 次回のKyoto.pmを4月か5月くらいにやるみたいな感じらしい.参加します.

LT枠が空いていてやりますといっていたけれど,前日までネタを作ってなくて,とりあえずプロファイラ便利ツールみたいなのに興味あったから,前日から作り始めた分と構想についてしゃべった.

単純なテーブルに対して単純なクエリ発行したときに,DBIからそのままSQL叩く場合とTengのRowクラスでラップしない場合とで実行時間はそんなに差がないということがわかったりした. ちなみにRowクラスでラップした場合の実行時間は,ラップしない場合と比較して2倍ほど遅かった.

Perl,一般的にはもうそんなに流行らんだろみたいなテンションだけど,今日は普通に盛り上がってたし,Perlコミュニティ力感じた.

yusukebeさん、普通に気さくな感じだったし普通にしゃべっていただいた.

あと,Mixiの@goccy54さんが1人で作ったというコピペ検出器やばかった. goccy/p5-Compiler-Tools-CopyPasteDetector · GitHub
Perl5の言語処理系つくれるとかやばすぎるし,Mixi社の技術力の高さを垣間見た.
Mixiの中の話もいろいろ教えていただいて参考になった.

今日こういう雰囲気で激しい感じだった.

Plack::Middlewareの書き方

前回,Plack::Middleware書いたので,Plack::Middlewareの書き方をメモしておく.

Plack::Middlewareモジュールに最低限必要なのは基本的に2つしかない. Plack::Middlewareを継承することcallメソッドを実装しておくだけ.

callメソッドの返り値はPSGI形式のレスポンスである.

リクエストがとんでくると,builderブロック内でenableした順番にそれぞれのcallが発行される.

package Plack::Middleware::MyMy;
use strict;
use warnings;

use parent 'Plack::Middleware';

sub call {
    my ($self, $env) = @_;

    return $self->app->($env); # 次にenableしたMiddlewareのcallを呼び出す
}

$self->appは次のenableしたMiddlewareオブジェクトである.
$self->app->($env)で次のMiddlewareのcallを実行する.
$envがどんどん次のMiddlewareに引き渡されていくイメージ.

call以外にprepare_appというメソッドにより,サーバ起動時に一度だけ実行される前処理を書ける. リクエストのたびに実行させたくないような処理はここで実行させて結果を$selfに突っ込んでおくとcallが呼ばれたときに使いまわせる.

package Plack::Middleware::MyMy;
use strict;
use warnings;

use parent 'Plack::Middleware';

sub prepare_app {
    my $self = shift;
    $self->{foo} = Foo->new;
}

sub call {
    my ($self, $env) = @_;
    $self->{foo}; #=> "Fooオブジェクト"
    return $self->app->($env); # 次にenableした
}

.psgiファイル内でenableするときに第2引数以降にMiddlewareへ渡すパラメータを指定できる. 以下ではstateとstoreキーにそれぞれオブジェクトをセットしている.

    enable "Plack::Middleware::Session",
        state => Plack::Session::State::Cookie->new(
            session_key => 's',
            expires => undef,
        ),
        store => Plack::Session::Store::File->new(
            dir          => config->root->subdir('session'),
            serializer   => sub { $MessagePack->pack(+shift) },
            deserializer => sub { eval { $MessagePack->unpack(+shift) } || +{} },
        );

これらのパラメータはそのままMiddlewareオブジェクトのメンバとなる. Middlewareモジュール内でアクセッサを定義し,アクセッサ経由でパラメータを参照してることが多い.

package Plack::Middleware::Session;
use strict;
use warnings;

use parent 'Plack::Middleware';

use Plack::Util::Accessor qw(state store);

sub call {
    my ($self, $env) = @_;
    $self->state;
}
...

基本的にcallだけ書けばよい感じなので,わかりやすいけど,返り値を何にすればよいとか$self->appとは何かを気にしだすとソースを読まなければわからない感じだった. Middlewareの仕組み自体はそんなに難しくないと思うけど,subrefをネストして生成して,遅延実行していく感じのコードなのでちゃんと実行経路を辿らないと??って感じだった.

$self->app->($env)が一番謎で,次にenableされたMiddlewareオブジェクトのcallを実行するということがわかったのが収穫だった.

※ ソース読んでいっただけなので,何か間違いがあるかもしれない

Plack::Middleware::OAuth::Lite的なものを書いてる

TwitterとかGitHubユーザに対して自前のWebアプリケーションでOAuth認証するためのPlack::Middlewareを書いてる.

同様の動作をするモジュールとしてすでに Plack::Middleware::OAuth があったけど,Session周りでよくわからないエラーがでてよくわからなかったから,自分で書き始めた.

(よくわからないエラーというのは,$env->{psgix.session}と$env->{psgix.session.options}がundefになってて,Plack::Session->new($env)したときに,これらがHASHリファレンスじゃないと怒られる感じだった.

結局,Middlewareの読み込み順が間違ってて,Plack::Middleware::Sessionを先に書いてないだけだった.
Plack::Middleware::OAuthはPlack::Middleware::Sessionまたは他のSessionストレージの使用が前提になっている気がする.

builder {
   
    enable "Plack::Middleware::Session", # 先に書く
        ...

    enable 'Plack::Middleware::OAuth',
       ...

    $app
};

)

Plack::Middleware::OAuth::Liteは,各プロバイダのエンドポイントなどの設定を内部に持っていなくて,enable時に設定を書くようになっている.

あと,OAuth2.0には対応してない. OAuth2.0はシグネチャのためのハッシュ値計算みたいなのをやらなくて良いから外部モジュール使わずに手で書けばいい気がする.

OAuth認証まわりはOAuth::Lite::Consumerを使ってる.

書いてみたはいいけど,Plack::Middleware::OAuthのほうがあきらかによいインタフェースだということがわかってよかった. ただ,Plack::Middleware::OAuthのコールバックルーチンに渡される第一引数$selfにはredirectとかrenderとかが生えていて,これらは自前で実装してるようなので,この辺うまくPlack::Requestを使えなかったんだろうか.

Plack::Middleware::OAuthは内部でいろいろよしなにやってくれる感じで自由度が低めに感じたので,外からいろいろ設定を渡せるようにしたけど,なんだか微妙な感じになった感がある.

Plack::Middleware::OAtuhを使いましょう.

psgiファイルの設定

    enable "Plack::Middleware::Session";

    enable 'Plack::Middleware::OAuth::Lite',
        on_success => sub {
            my ($res, $provider_name, $token, $user_info, $location) = @_;
            $res->redirect("/auth/signup/$provider_name");
            return $res;
        },
        on_error => sub {
            my ($res, $error) = @_;
            $res->redirect("/oauth/error?reason=".$error);
            return $res;
        },
        providers => {
            'twitter' => {
                consumer_key       => 'XXXXXX',
                consumer_secret    => XXXXXX',
                site               => 'http://api.twitter.com/',
          request_token_path => 'https://api.twitter.com/oauth/request_token',
                access_token_path  => 'https://api.twitter.com/oauth/access_token',
          authorize_path     => 'https://api.twitter.com/oauth/authorize',
                login_path         => '/auth/twitter',
                scope              => '',
                user_info_uri      => qq{https://api.twitter.com/1.1/account/verify_credentials.json},
                user_info_uri_method => 'GET',
            },
            hatena => {
                consumer_key       => 'XXXXXX',
                consumer_secret    => 'XXXXXX',
                site                  => qq{https://www.hatena.com},
                request_token_path => qq{https://www.hatena.com/oauth/initiate},
                access_token_path  => qq{https://www.hatena.com/oauth/token},
                authorize_path     => qq{https://www.hatena.ne.jp/oauth/authorize},
                login_path         => '/auth/hatena',
                scope              => 'read_public',
                user_info_uri      => qq{http://n.hatena.com/applications/my.json},
                user_info_uri_method => 'POST',
        },

        };
package Plack::Middleware::OAuth::Lite;
use utf8;
use strict;
use warnings;

our $VERSION = '0.01';

use parent 'Plack::Middleware';
use Plack::Util;
use Plack::Util::Accessor qw(providers on_success on_error flash_success_message);
use Plack::Request;
use Plack::Session;

use Carp ();
use JSON::XS qw(decode_json);
use OAuth::Lite::Consumer;
use Try::Tiny;

our $CONFIG_KEYS = [qw(
    consumer_key
    consumer_secret
    site
    request_token_path
    access_token_path
    authorize_path
    login_path
    scope
    user_info_uri
)];

sub prepare_app {
    my ($self) = shift;
    my $p = $self->providers || Carp::croak "require providers";

    $self->{client_info}     ||= {}; # {provider_name => 'OAuth::Lire::Consumer instance'}
    $self->{login_path_info} ||= {}; # {provider_name => 'path'}
    $self->{scope_info}      ||= {}; # {provider_name => 'read,write'}
    $self->{user_info}       ||= {}; # {provider_name => {uri => 'user_info', method => 'HTTP Method', user_name_key => 'key name'}
    for my $provider_name (keys %$p) {
        my $config = $p->{$provider_name};
        check_config($config);

        my $lc_name = lc($provider_name);
        $self->{client_info}{$lc_name} = OAuth::Lite::Consumer->new(
            consumer_key       => $config->{consumer_key},
            consumer_secret    => $config->{consumer_secret},
            site               => $config->{site},
            request_token_path => $config->{request_token_path},
            access_token_path  => $config->{access_token_path},
            authorize_path     => $config->{authorize_path},
        );
        $self->{login_path_info}{$lc_name} = $config->{login_path};
        $self->{scope_info}{$lc_name} = $config->{scope};
        $self->{user_info}{$lc_name} = {
            uri      => $config->{user_info_uri},
            method   => $config->{user_info_uri_method} || 'GET',
        };
    }
}

sub check_config {
    my ($config) = @_;
    for my $expected (@$CONFIG_KEYS) {
        unless (grep {$expected eq $_} keys %$config) {
            Carp::croak "require $expected";
        }
    }
}

sub call {
    my ($self, $env) = @_;

    my $session = Plack::Session->new($env);

    $self->{handlers} //= do {
        my $handlers = {};
        while (my ($provider_name, $login_path) = each %{$self->{login_path_info}}) {
            $login_path =~ s!(.+)/$!$1!; # add
            my $callback_path = "$login_path/callback";
            my $consumer = $self->{client_info}{$provider_name};

            $handlers->{$login_path} = sub {
                my ($env) = @_;
                my $req = Plack::Request->new($env);
                my $res = $req->new_response(200);
                my $request_token = $consumer->get_request_token(
                    callback_url => _callback_uri($req->base, $callback_path),
                    scope        => $self->{scope_info}->{$provider_name} || undef,
                ) or die $consumer->errstr;

                $session->set($provider_name.'oauth_request_token' => {%$request_token});
                $session->set($provider_name.'oauth_location'      => $req->param('location'));
                $res->redirect($consumer->url_to_authorize(token => $request_token));

                return $res->finalize;
            };

            $handlers->{$callback_path} = sub {
                my ($env) = @_;
                my $req = Plack::Request->new($env);
                my $res = $req->new_response(200);

                if ($req->param('denied')) {
                    return $res->redirect('/');
                }

                my $verifier = $req->param('oauth_verifier')
                    || die "No oauth verifier";

                my $access_token = $consumer->get_access_token(
                    token    => (bless $session->get($provider_name.'oauth_request_token'), 'OAuth::Lite::Token'),
                    verifier => $verifier,
                ) or die $consumer->errstr;

                $session->remove($provider_name.'oauth_request_token');
                $session->set($provider_name.'oauth_access_token', {%$access_token});

                {
                    my $u = $self->{user_info}{$provider_name};
                    my $u_res = $consumer->request(
                        method => $u->{method}, url => $u->{uri}, token  => $access_token,
                    );
                    $u_res->is_success or die "failed getting user info";

                    my $user_info = eval { decode_json($u_res->decoded_content || $res->content) };
                    $session->set($provider_name.'oauth_user_info', $user_info);

                    my $location = $session->get($provider_name.'oauth_location') || "/";
                    $res = $self->on_success->($res, $provider_name, $access_token, $user_info, {
                        location => $location,
                    });
                }
                return $res->finalize;
            };
        }
        $handlers;
    };

    return $self->_run($env, $self->{handlers});
}

sub _run {
    my ($self, $env, $handlers) = @_;

    my $app = $handlers->{$env->{PATH_INFO}};
    return $self->app->($env) unless $app;

    my $res;
    try {
      $res = $app->($env);
    } catch {
        my $req = Plack::Request->new($env);
        my $res = $req->new_response(200);
        $_ =~ /(.*)\sat/;
        $res = $self->on_error->($res, $1);
        return $res->finalize;
    }
    $res;
}

sub _callback_uri {
    my ($base_uri, $callback_path) = @_;
    $callback_path =~ s!^/?(.+)!$1!; # remove head '/'
    $base_uri . $callback_path;
}

1;
__END__

Perl屋さんに便利なVim Pluginを2つ書いた

この記事は Vim Advent Calendar 2012 の22日目の記事です.

21日目は @AmaiSaeta さんの 「このVim plugin達に感謝しなければ年を越せない!私が今年使い倒した2012年のベストを全部ご紹介! 」 でした.



最近,Vim Scriptを書き始めていて, 今回は,Perl的に便利なVim Pluginを2つ書いたのでご紹介します.

unite-perl-module.vim

GitHub y-uuki/unite-perl-module.vim

unite-perl-module.vim はClass::Acceccor::Liteなどのモジュール名をUniteのインタフェースで検索し,選択したモジュール名をカーソル位置に書き込むPluginです.

Linda_pp先生のunite-ruby-require.vimを参考にして作りました.

機能は以下の2つです.

  • perl/global: 標準モジュールおよびcpanmなどでインストールしたモジュールの検索
  • perl/loccal: プロジェクト内のモジュールおよびcartonやlocal::libでインストールしたモジュールの検索

インストール

unite.vimをインストールしてください.

NeoBundleなどで本プラグインをインストールしてください.

NeoBundle "y-uuki/unite-perl-module.vim"

使い方

:Unite perl/global

f:id:y_uuki:20121222212104p:plain

:Unite perl/local

f:id:y_uuki:20121222212057p:plain


注意事項

VimのカレントパスがHOMEなどのディレクトリ以下に大量のファイルがあるところでは,perl/globalの実行時間が遅くなってしまう問題があります. これは,perl/global内で使用している cpan -l コマンドが,カレントディレクトリ以下のモジュールを再帰的に探しに行ってしまっているためだと思います.

perl-local-lib-path.vim

GitHub y-uuki/perl-local-lib-path.vim

プロジェクト内のモジュールやcartonでインストールしたモジュールにはVimのpathが通っていないので,gfでファイル間移動ができないという問題があります.

perl-local-lib-pathは,現在のプロジェクト内のモジュールやcartonでインストールしたモジュールに自動でpathを通します.


インストール

依存するプラグインは特にありません. NeoBundleなどで本プラグインをインストールしてください.

NeoBundle "y-uuki/perl-local-lib-path.vim"

使い方

vimrcに以下のような設定を書きます.

g:perl_local_lib_path = "vendor/lib"    "" 任意
autocmd FileType perl PerlLocalLibPath

g:perl_local_lib_path にはプロジェクトルート・ディレクトリ(.gitがあるディレクトリなど)からのモジュールディレクトリへの相対パスを指定することができます. 何も指定しなくても,デフォルトで'lib','local/lib/perl5'と'extlib'をモジュールディレクトリとして判定します.

これで,project-root/local/lib/perl5/Plack/Request.pmのようなcartonで管理されたモジュールにもジャンプできるようになります.

参考

紹介した2つのプラグインではどちらも自動でプロジェクトルートの判定を行なっています. プロジェクトルートと同じディレクトリに".git", ".gitmodules","Makefile.PL","Build.PL"があればプロジェクトルートとして判定しています. このあたりは,id:antipopさんのProject::Libsを参考にしました.

carton周りのVimの話は@taka84u9 さんの

を参考にしました.

明日の担当は @mfumi2さんです.
よろしくお願いします.

Perlにおける括弧なし関数とその引数と||の結合強度

Perlで何気なく

use File::Which qw(which);

my $cmd = which "foobar" || croak "FAIELD";

とか書いてたら,which "foobar"の返り値はundefなのにも関わらず,croakに引っかからなかった. あれ?とか思ってたら単に,括弧なし関数の右からみた結合強度よりも||のほうが強かっただけだった. つまり,まず"foobar"を見て評価値が真なのでその時点でcroak文は評価されないことになる.

以下優先順位の降順

左結合 || //
非結合 .. ...
右結合 ?:
右結合 = += -= *= などの代入演算子
左結合 , =>
非結合 リスト演算子 (右方向に対して)
右結合 not
左結合 and
左結合 or xor
perlop - Perl の演算子と優先順位 - perldoc.jp

ここで引数"foobar"からみたwhichは,リスト演算子(右方向に対して)扱いになる. したがって,||の代わりにリスト演算子よりも結合が弱いorを使うか,もしくはwhich("foobar")のように括弧をつければよい.

何も特別なことはないけれど,PerlやRubyでぼんやり書いてしまいそうなので気をつけたい.

AUTOLOADによる他クラスへのメソッドの委譲のテスト

最近,Net::Qiita http://search.cpan.org/~yuuki/Net-Qiita-0.03/lib/Net/Qiita.pm というモジュールを作った. そのモジュールの中で,Net::QiitaクラスのAUTOLOADで,Net::Qiita::Clientが持っているメソッドを動的に呼び出す(委譲するとかいうらしい)ということをやった. Rubyでmethod_missingでメソッド名を取得してrespond_toしてsendする感じ.

use Net::Qiita::Client;

sub new {
    my ($class, %options) = @_;

    Net::Qiita::Client->new(\%options);
}

# Delegate method to Net::Qiita::Client object
sub AUTOLOAD {
    my $func = our $AUTOLOAD;
       $func =~ s/.*://g;
    my (@args) = @_;

    {
        no strict 'refs';

        *{$AUTOLOAD} = sub {
            my $class  = shift;
            my $client = $class->new;
            defined $client->can($func) || croak "no such func $func";
            shift @args;
            $client->$func(@args);
        };
    }
    goto &$AUTOLOAD;
}

そもそも,わざわざメタなことをする必要があったのかということはまた別に書くとして,メソッドの委譲処理が仕様どおりかどうかテストする方法を考えていた.

まず考えたこと

Test::Moreの can を使ってクラスがメソッドをもっているかどうかを確認できると考えた.

ok Net::Qiita->can('user_items'); #Net::Qiitaクラスがuser_itemsメソッドをもっているかどうか

# can_okを使うほうがスマートだけど,説明の都合上直接canを直接使う

これは結論から言うとダメで,理由は perldoc に書いてあった.

can はオブジェクトが AUTOLOAD を通してメソッドを提供可能かどうかは 知ることができません, そのため undef が返ってきてもオブジェクトが そのメソッド呼び出しを処理することができないとは限りません. これを 回避するにはモジュールの作者が AUTOLOAD を使って処理するメソッドに対して 前方宣言を使うことです(perlsub参照). そのような'ダミー'の関数は can はコードリファレンスを返しますが, それが呼び出された時には AUTOLOAD へとフォールスルーされます.

UNIVERSAL::canは現在のクラスと親クラスのメソッドしか探さないみたい. (UNIVERSALクラスの"system"を引数にとるとundefになるので,UNIVERSALクラスは探さないっぽい.)

解決策は,perldocに書いてある通り,use subsを使って前方宣言すればよいらしい. ただし,use subsを使うやり方のデメリットとして以下の2つを考えた, - 委譲を許すメソッド名を列挙しなければいけなくてDRYに反する. - AUTOLOAD内の処理をテストできない(前方宣言さえしていればcanはコードリファレンスを返してしまってAUTOLOADを実行しない)

メリットとしてはhitodeさんに言われたけれど補完が効くことが挙げられる.

採用したやり方

AUTOLOAD内の処理をテストできないのが一番よくないと思っていて,(何かやり方ないかな) 結局テストは以下のように書いた.

use Test::More;
use Test::Fatal;
use Test::Mock::Guard;

my $stub_ref = sub { return 1 };

my $user_mock_funcs = +{
    user_items           => $stub_ref,
    user_following_tags  => $stub_ref,
    user_following_users => $stub_ref,
    user_stocks          => $stub_ref,
    user                 => $stub_ref,
};

my $mock = mock_guard 'Net::Qiita::Client::Users', $user_mock_funcs;

for (keys %$user_mock_funcs) {
    is Net::Qiita->$_, 1;
}

like exception {Net::Qiita->nainai; }, qr(no such func);

委譲するメソッドを例外を投げるだけのスタブにして,その例外をキャッチできたら,正しく委譲できているとしている. hitodeさん「例外投げなくても1とか返せばいいんじゃないですか」「はい」

例外投げる意味何もなかったので,1返すようにした.

デメリットは,Test::Mock::GuardとかTest::MockObjectでスタブ化しないといけないので,テストコードが冗長になってしまうこと. ただ,本体のコードが冗長になるよりは,テストコードが冗長になる方がマシだと思っているのでとりあえずこうしている.

サボるとしたら,スタブ化をやめてno such func以外の例外メッセージをキャッチしたら正しいみたいにするか.

unlike exception {Net::Qiita->user_items}, qr(no such func)

ただし,今回の場合はuser_itemsの中でHTTPリクエストを投げるので,タイムアウトするまでテストが終わらないとかになってダサいので,スタブにしてる.

ベストプラクティスほしい.