新しいblogに移行しました

新ブログ "All Yout Bugs Are Belong To Ass" に移行しました!

ラベル Plack の投稿を表示しています。 すべての投稿を表示
ラベル Plack の投稿を表示しています。 すべての投稿を表示

2011-04-13

[Perl]Plack::Middleware::*を作ってみる

いい加減Plackが当たり前のこの頃ですが、いまだにPlack::Middleware::*を作ったことが無かったので、練習してみました。
なお、あまり気にせずに書いていたら、内容がほとんどPlack::Middlewareのドキュメントと似たものになってしまいました。

基本型

以下が、だいたい定型となるコードです。
package Plack::Middleware::OreOre;
use strict;
use warnings;
use parent qw/ Plack::Middleware /;

### enableでオプションを受け取る時に使用
# use Plack::Util::Accessor qw/ oreore watewate soregashisoregashi /;

our $VERSION = '0.01';

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

    ### ここに処理をかく ###

    $self->app->( $env );
}

1;
__END__
Plack::Middleware::*を作るには、Plack::Middlewareを継承する必要があります。
で、callというメソッドですが、ここに実際の処理を書いてあげて、最後に$self->app->( $env )としてappを実行するようにします。もしHTTPレスポンスを返したい場合は、途中でPlack::Response形式のarrayrefをreturnしてあげればOKです。
もしenableするときにオプション値を取りたい(enable "OreOre", foo => 'bar'; とか)場合は、Plack::Util::Accessorを使う必要があります。
多分、これだけあれば大抵の機能をPlackに組み込むことができそうです。

ごく単純な例

ある特定パスにアクセスされた時に、他のページにリダイレクトする、というだけの単純なPlack::Middleware::Hogehogeをつくってみました。
package Plack::Middleware::Hogehoge;
use strict;
use warnings;
use parent qw/ Plack::Middleware /;
use Plack::Util::Accessor qw/ jump_url listen_path /;
our $VERSION = '0.01';

sub call {
    my ( $self, $env ) = @_;
    return [ 301, [ 'Location', $self->jump_url ], [''] ] if $env->{ PATH_INFO } eq $self->listen_path;
    $self->app->( $env );
}

1;
__END__
この場合、実際に使うときは以下の様なpsgiになります。
use Plack::Builder;

my $app = sub { [ 200, [ 'Content-Type', 'text/html' ], ['<h1>hoge!</h1>'] ] };

builder {
    enable "Hogehoge", listen_path => '/yahoo', jump_url => 'http://www.yahoo.co.jp/';
    $app;
};
これをplackupすると、/yahooにアクセスしたときだけYahoo!Japanにリダイレクトされ、それ以外は"hoge!"とかかれたページが表示されます。

ようやく少しはPlackの使い方に慣れてきました!

2011-03-04

[Perl]plackアプリとAttribute::Handlersの相性は悪い

先日作ったRouter::Simple::Attributeを使ってPlackベースのWAFを作ろうとしたのですが、どういうわけかrouterの中身がカラッポになってしまい、ちっともまともに動作してくれませんでしたorz

で、よくよく調べてみると、どうやらPlack::SandboxとAttribute::Handlersの相性がよろしくない模様でした。

検証用コード - eg/sample.pl

まあ幾つかツッコミどころが有りますけど、問題の本質とは関連がないものばかりの筈なのでスルー。
use warnings;
use strict;
use lib qw( ../lib ./lib );
use Attribute::Handlers;
use Router::Simple;
use Data::Dumper;

my $router;

BEGIN {
    $router = Router::Simple->new();
}

sub Path :ATTR {
    warn Dumper( @_ );
    my $path = $_[4];
    my $code = $_[2];
    $router->connect( $path, { code => $code } );
}

sub myapp : Path(/) { 
    warn Dumper( @_ );
    [ 200, ['text/html'], ['Hello, world!'] ];
}

warn Dumper( $router, __PACKAGE__ );

sub {
    my $env = shift;
    if ( my $p = $router->match( $env ) ) {
        $p->{ code }->( $p );
    }
    else {
        [404, [], ['no']];
    }
};

perlコマンドから直接実行して見た場合

$ perl eg/sample.pl 
Useless use of reference constructor in void context at eg/sample.pl line 35.
$VAR1 = 'main';
$VAR2 = \*::myapp;
$VAR3 = sub { "DUMMY" };
$VAR4 = 'Path';
$VAR5 = '/';
$VAR6 = 'CHECK';
$VAR7 = 'eg/sample.pl';
$VAR8 = 24;
$VAR1 = bless( {
                 'routes' => [
                               bless( {
                                        'pattern_re' => qr/(?-xism:^\\/$)/,
                                        'pattern' => '/',
                                        'capture' => [],
                                        'dest' => {
                                                    'code' => sub { "DUMMY" }
                                                  },
                                        'name' => undef,
                                        'on_match' => undef
                                      }, 'Router::Simple::Route' )
                             ]
               }, 'Router::Simple' );
$VAR2 = 'main';
一応、Pathアトリビュートのトリガが引かれていることが確認できてます。

plackupした場合

では、今度はeg/sample.plをplackupで起こしてみます。
$ plackup eg/sample.pl 
$VAR1 = bless( {
                 'routes' => []
               }, 'Router::Simple' );
$VAR2 = 'Plack::Sandbox::eg_2fsample_2epl';
HTTP::Server::PSGI: Accepting connections at http://0:5000/
こんな感じで、Pathアトリビュートのトリガが引かれません。

誰かおしえてください

そんなわけで、plackupからでも問題なく使用できるメソッドアトリビュートハンドラを探しています。
どなたかご存知の方、教えてください。よろしくお願いしますm(_ _)m


教えていただきました!

Twitterで、色々な方にご教示頂きました!この場を借りて、改めて御礼申し上げます。
まとめると、僕は「Attribute病」:) に罹患していたらしく、

・PSGIアプリではINIT/CHECKなどが呼ばれないため、アトリビュートはほぼ動かない。
・アトリビュート使うと、第3者からみて「何してるかわからないコード」になってしまい、おすすめできない。
・Attr::Handlers sucks, and Perl5 attribute sucks too. で FA。

ということらしいです。従って結論は

アトリビュートを使うのはお止しなさい