Hatena::ブログ(Diary)

Perl日誌

2011-12-04

Perl Advent Calendar Japan 2011 Casual Track 4日目に Groonga Casual Tutorial を POSTしました。

| 11:32

Perl Advent Calendar Japan 2011 Casual Track 4日目でGroongaを使った簡易チュートリアルを投稿しました。

groongaをmysql経由で使うのではなく、groongaをhttpサーバーとして起動しておいてhttpリクエストでやり取りをする方式での開発方法を紹介しています。

このチュートリアルを実際に実行してくれる人がいたらうれしいです。

2011-11-27

2011-11-23

Plack::Builder+Plack::Middleware::Staticで Plack::App::Directoryみたいな事をやってみる。

| 09:32

そんなわけでとりとめもない記事です。

ディレクトリ構成

こんな感じ

static.psgi
root/
root/index.html
root/xxx.html
root/hoge/index.html
root/hoge/xxx.html

psgi

% cat static.psgi
use Plack::Builder;builder {
enable "Plack::Middleware::Static",
    path => sub { s!(.*/$)!${1}/index.html! or return qr{^/.+} },
    root => './root/';
};

結果

解説

Plack::Middleware::Staticの_handle_static()を見てみます。

package Plack::Middleware::Static;
use strict;
use warnings;
use parent qw/Plack::Middleware/;
use Plack::App::File;

use Plack::Util::Accessor qw( path root encoding pass_through );

...

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

    my $path_match = $self->path or return;
    my $path = $env->{PATH_INFO};

    for ($path) {
        my $matched = 'CODE' eq ref $path_match ? $path_match->($_) : $_ =~ $path_match;
        return unless $matched;
    }   

    $self->{file} ||= Plack::App::File->new({ root => $self->root || '.', encoding => $self->encoding }); 
    local $env->{PATH_INFO} = $path; # rewrite PATH
    return $self->{file}->call($env);
}

以下の行でAccessorとしてpath, rootと他2つ定義されています。

use Plack::Util::Accessor qw( path root encoding pass_through );

そのpathですが、以下の記述からコードリファレンス、もしくは正規表現リファレンスを期待している事がわかります。

my $matched = 'CODE' eq ref $path_match ? $path_match->($_) : $_ =~ $path_match;

ここで自前で実装したstatic.psgiでpathに対して次のようなコードリファレンスを渡します。これはこの無名関数に渡された文字列の最後が/で終わる場合、その部分を/index.htmlと書き換えます。

sub { s!(.*/$)!${1}/index.html! or return qr{^/.+} }

もし、書き換えられた場合は次の行でrewriteされます。localはそのスコープ内でのみ値を一時的に保存します。

local $env->{PATH_INFO} = $path; # rewrite PATH

localで一時的に保存された値はスコープ内でのみ有効。で、そのスコープ内でPlack::App::File->new->call($env)が実行されます。

$self->{file} ||= Plack::App::File->new({ root => $self->root || '.', encoding => $self->encoding }); 
local $env->{PATH_INFO} = $path; # rewrite PATH
return $self->{file}->call($env);

余談

ちなみになんとなくこの処理はこの順番のほうが(処理の流れを説明する場合は)いい気がする。次のような感じ。

local $env->{PATH_INFO} = $path; # rewrite PATH

$self->{file} ||= Plack::App::File->new({ root => $self->root || '.', encoding => $self->encoding }); 
return $self->{file}->call($env);

でもlocalで変化している期間を最小にしたいなら元の書き方が正しい気もする。うーん。

おわりに

ちなみにこの正規表現では'ディレクトリの最後は/'という前提のものです。

おしまい。

コードの置き場所

https://github.com/okamuuu/Scribbled/blob/master/static.psgi

See Also

https://github.com/miyagawa/Plack/issues/93

独り言

はてなぶろぐつかってみたいなー

zz 2015/08/03 11:43 この場合は全部捕まえるから構わないのですが、
qr{^/.+} じゃなくて m{^/.+} ですね
(qr の方は 1 を返しているのと同じ)

2011-10-30

hachiojipm#10に行ってきた

| 17:41

場所

私は2度目の南米ペルー料理でした。

1度目と違ってビールとかチョリソとかお肉とかパスタとかタコの刺身とかがつがつして食ってました。

もうすでにhachiojipmの常連?

LT

1.norry_gogo さん
  • 最強の学習法について。「試して失敗するという過程」は無駄ではないと。

2.hondallica さん
3.vkgtaro さん
  • どっかで聞いたことある名前だなーと思ったら海賊たろーさんでした。
  • 昔Config::Multiを狂ったように使ってましたよ。
4.yellow844 さん
  • エ○タ○ブ○イ○ってとこで働いていたらしく、奇遇ですね、僕もです。的な。
  • 待遇が恐ろしく違っていたので「あの頃僕は力のある大人達に守られていたんだなあ」と思いました。どこに属するかで運命ってすごくかわるんですね。
  • 発表内容はブラックな人々のお話でした。あるSEさんが言い放った「AJAXつかえませんよ。Tomcatサーバーにいれてませんから。」は伝説です。
5.usayman さん
  • 久しぶりにいらっしゃったらしく、私とは初めまして。発表内容は「職場環境のあるある、ないない」
  • そうじのおばちゃんやヤクルトのおばちゃんは思ったよりも権力があったりしますよね。
  • おばちゃんがさいきょうって事でいいんじゃないかな。

6.me
  • ぼくがかんがえたさいきょうのアレ。後述。

7.norie さん
  • オーケストラを趣味でやってるそうです。なんかぐるぐるしてるやつを担当しているそうです。
  • 発表内容は最強の関数。ぼくはよっばらっていたのでかんすうはよめませんでした。

8.uzulla さん
  • ATND的なイベントツールを作りたい。という構想を発表してました。
  • イベントに来た以上ひとりで終わるのを防ぐ仕組みを、というのはhachiojipmに来ている全員が同意。

9.una さん
  • どちらかというとデザイナさん。エンジニアの会話面白いらしい。
  • 技術ばっかの話じゃないからねぇ。みなさんも気軽におこしやす。

10.ktat さん
  • 自己紹介されるまで以前面接行った会社のCTOと気づきませんでした。その節はどうも。
  • 発表内容は設定ファイルでWEBアプリケーションのテストをしましょうというツールです。
  • ログイン、ログアウトの処理もできるそうです。

11.hsksyuskさん
12. kyannyさん
  • はじめまして。こんにちは。なんとなく場慣れしているので誰だろうとずっと思ってましたが
  • 帰ってブログ見て刺身ブーラランさんだと気づきました。よくよく考えればすごい名前。
  • REMPというクロム拡張ツールを紹介。youtubeの動画を登録して自動再生。なんなら他人と共有。
  • https://chrome.google.com/webstore/detail/cdmjnmpmcgfkkdjjdgpkikbgnnojbmbo?hl=ja
  • yellow844さんが「弊社と競合している…」とか言ってたような。
13. ytnobodyさん
  • YAPCではリポーターお疲れさまでした。実際にやってみた感想を発表。
  • hirataraさんは最強リポーターとの事。一緒に働いた人がそう言うなら間違いない。
14. hide_o_55さん
  • node学園経由のため若干遅刻してました。ライアン(だっけ?)のライブコーディングがパねぇらしいです。
  • ぼくのかんがえたさいきょうのモジュール。「例外を投げたいだと?投げられるのはてめぇーだ!!」
  • ちなみに帰りの電車で技術的な会話してましたが、とても高度な事ばっかし言うのでなんとなく投げられた気分です。
15. hirobanexさん
  • エアhachiojipm常連のhirobanexさんが此度のpmにはいらして下さいました。
  • LT後に各地でO/Rマッパ宗教論が勃発してました。
16.makamaka2_donzokoさん
  • お約束の若干遅刻にて登場。LTが始まる前に急いで血中濃度を上げないといけないので大変です。
  • これまでで最も強度な材質(通称段ボール)でのlT。もう彼には普通のLTが許されないのかもしれない。。。

私の発表

groongaをもっと手軽に使えるようにしておけばgroonga使う人増えると思ったのでgroongaを意識しなくてもgroongaの恩恵を受けることができるアプリを作ってみようかと思いました。

http://okamuuu.github.com/Gang/presen/index.html

https://github.com/okamuuu/Gangoka

実はGroongaはそもそもWEB管理画面をデフォルトで装備しているのでCRUDを実装する必要あるのかだとか、WEBAPIのエンドポイントも最初からあるのでは、という話ではあるんですが

若干使いづらい箇所がいくつかあったのでBlogに特化したインターフェースにしたいなと思った次第です(まだそうなってませんが)

今後リファクタリングして完成度を上げてから、どこかで再度発表する予定です。

しばらくプロセスきらずにいるので自由にお試し下さい。

http://106.187.44.245/article/list

感想

hachiojipmではお酒を一緒に飲む仲間ができました。今後この活動が継続できる事を願ってます。

提案

いつも同じメンバーがMac持ってきてくれていますが(私、持ってきてません)、

そもそも水をかぶるリスクを彼らのみが負っているのでいざという時の保険というか一人500円とか保険積み立てするとか

そういう仕組みがあればいいかも。

まとめ

hachiojipmサイコー。今度町田でもやるよ。

2011-09-22

フィボナッチ数をPerlで実装できますか?

| 11:07

フィボナッチ数Perlで実装できますか?

そもそもフィボナッチ数が何なのかまったくわからなかった。くやしいです。

くやしいので勉強してみた。

フィボナッチ数とは

くわしくはwikiを参照

http://ja.wikipedia.org/wiki/%E3%83%95%E3%82%A3%E3%83%9C%E3%83%8A%E3%83%83%E3%83%81%E6%95%B0

コード置き場

ここにコードを置いてあります。

https://github.com/okamuuu/Fibonacci

実装前に準備すること

スケルトン作成

% module-setup Fibonacci                                   
...
% cd Fibonacci

テスト作成。

#!/usr/bin/env perl
use strict;
use warnings;
use Test::More;

BEGIN {
    use_ok('Fibonacci');
};

my $expected = [ 0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987 ];

subtest 'get fibonacci number' => sub {

    my $got = Fibonacci->get_number_at(4);
    is($got, $expected->[4]);
};

done_testing;

実行する。もちろん失敗。

:!prove -vl t/01_fibonacci.t                                               
t/01_fibonacci.t .. 
ok 1 - use Fibonacci;
Can't locate object method "get_number_at" via package "Fibonacci" at t/01_fibonacci.t line 14.
    # Child (get fibonacci number) exited without calling finalize()
not ok 2 - get fibonacci number
...

実装開始

フィボナッチ数の定義はどの項もその前の2つの項の和となっている。という事なのでベタに次のように書いてみる

package Fibonacci;
use strict;
use warnings;
our $VERSION = '0.01';
use Carp ();

sub get_number_at {
    my ($class, $length) = @_;

    if ( $length == 0 ) {
        return 0;
    }

    ### 1つ目、2つ目の数はその2つ前の値が存在しない
    if ( $length == 1 or $length == 2 )  {
        return 1;
    }   

    my @numbers;

    for my $len ( 1 .. $length ) { 
        if ( $len == 1 ) { 
            $numbers[$len] = 1;
        }   
        elsif ( $len == 2 ) { 
            $numbers[$len] = 1;
        }   
        else {
            $numbers[$len] = $numbers[$len-1] + $numbers[$len-2]; 
        }   
    }   

    return $numbers[$length-1] + $numbers[$length-2];
}

1;

テスト実行。成功。

:!prove -vl t/01_fibonacci.t
...
All tests successful.
};

done_testing;

テストケースを増やしてみて再度prove実行。成功。

#!/usr/bin/env perl
use strict;
use warnings;
use Test::More;

BEGIN {
    use_ok('Fibonacci');
};

my $expected = [ 0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987 ];

subtest 'get fibonacci number' => sub {

    my $count = scalar @{ $expected } - 1;
    for my $length ( 0 .. $count ) { 
        my $got = Fibonacci->get_number_at($length);
        is($got, $expected->[$length]);
    }  
};

done_testing;
:!prove -vl t/01_fibonacci.t
...
All tests successful.
Files=1, Tests=2,  0 wallclock secs ( 0.05 usr  0.01 sys +  0.04 cusr  0.00 csys =  0.10 CPU)
Result: PASS

面接官が試したかった事。

Fibonacci.pmのget_number_atメソッドの最後にあるこの記述。再帰の匂いがぷんぷんします。

return $numbers[$length-1] + $numbers[$length-2];

ああなるほど面接官が知りたかったのは「再帰処理を書けるのかい?んん?」とそういうわけですね。承知した。

再帰処理に書き換える

lib/Fibonacci.pmを次のように書き換えます。

うおー。シンプル!!

package Fibonacci;
use strict;
use warnings;
our $VERSION = '0.01';

sub get_number_at {
    my ($class, $length) = @_; 

    if ( $length == 0 ) { 
        return 0; 
    }   

    if ( $length == 1 or $length == 2 ) { 
        return 1;
    }   

    return $class->get_number_at($length-1) + $class->get_number_at($length-2);
}

1;

テスト実行。当然成功。

:!prove -vl t/01_fibonacci.t                                               
t/01_fibonacci.t .. 
..
All tests successful.

感想

再帰処理は見た目何が何やら分からないかも知れませんが、どっかにwarnでも挿入して実行してみると何やってるか良く分かります。

小一時間程度でしたが割といい勉強になりました。おしまい。