時計を壊せ

駆け出しWebプログラマーの雑記

SledgeのPSGI対応について。

いろいろあってすっかり放置してました。


前回の記事でid:otsuneさんに紹介して頂いた、id:tokuhiromさんがPSGIに対応させたSledgeについてです。

そもそもPSGIって何?

PSGIは正確にはPerl Server Gateway Interfaceとか言うらしいです。
名前のとおり、Perlとサーバーとのゲートウェイインターフェースって事ですね。


PSGIの仕様に則ったアプリケーションはこんな感じです。

use Data::Dumper;

# helloworld.psgi
my $app = sub{
    my $env = shift; # 環境変数の入ったハッシュへのリファレンスが渡される。

    return [
        200,# HTTPレスポンスコード
        ['Content-Type' => 'text/plane'],# HTTPレスポンスヘッダ(複数渡せる)
        [Dumper($env)]# レスポンスの中身(HTMLとか)
    ];
}


$appにコードリファレンスを渡してる環境変数を受け取り、レスポンスを配列リファレンスで返す無名サブルーチンPSGIアプリケーションの本体です。


PSGIの仕様に則った「無名サブルーチンへのコードリファレンスが最後にあるファイル」を外部プログラムやモジュールからdoすると、
doの返り値としてPSGIアプリケーションの本体のコードリファレンスが渡されます。


そのコードリファレンスに環境変数の入ったハッシュへのリファレンスを渡してあげて、返り値の配列リファレンスをごにょごにょする外部プログラムやモジュールを様々な環境向けに作る事で、
環境に依存しないWebアプリケーションが実装できます。
そういう、とても面倒臭くてとても重要な部分を実装してくれてあるのがPlackとかstarmanとかであるわけです。


WebアプリケーションフレームワークPSGIの仕様に合わせたインターフェースを用意する事によって、
容易に、様々な環境での動作に対応させることができます。


もちろん、Sledgeも例外ではありません。
SledgeをPSGIに対応させることで、Apache2+mod_perl2の環境に対応させる事ができます。


それをSledgeのために実装したものの一つが紹介して頂いた、id:tokuhiromさんのfeature-psgiです。

使用方法

このようにして使用します。(Sledgeの基本的な使い方については前回の記事を参照)
今回はPlack::Handler::Apache2::Registryを使います。
まずPSGIアプリケーション。

# helloworld.psgi
use strict;
use warnings;
use HelloWorld::Pages::Index;

my $app = sub{
    return HelloWorld::Pages::Index->new(shift)->dispatch('hello');
}


次にプロジェクトのPages.pm。

# Pages.pm
package HelloWorld::Pages;
use strict;
use base qw(Sledge::Pages::PSGI);

# ...


最後に、Plack::Handler::Apache2::Registryで読み込ませるので、
httpd.confか、若しくはそれにインクルードされるファイルで、

  Alias /helloworld/ "/usr/local/www/sledge/HelloWorld/htdocs/"
  <Location //helloworld>
    SetHandler modperl
    PerlHandler Plack::Handler::Apache2::Registry
    SetEnv PERL5LIB /usr/local/www/sledge/HelloWorld/lib/
    Options +ExecCGI
    PerlSendHeader On
  </Location>

等と設定します。
これでSledgeでPSGIアプリケーションを作ることができ、Apache2+mod_perl2環境下でSledgeアプリケーションを動作させることができます。

更に実用性を高めるための提案

ここからは蛇足です。
id:tokuhiromさんのSledge::Pages::PSGIの実装は

package Sledge::Pages::PSGI;
# $Id: CGI.pm,v 1.1.1.1 2003/02/13 06:59:36 miyagawa Exp $
#
# Tatsuhiko Miyagawa <miyagawa@edge.co.jp>
# Livin' On The EDGE, Co., Ltd..
#

use strict;
use warnings;
use base qw(Sledge::Pages::Base);

use 5.008001;

use Sledge::Request::PSGI;

# my $res = My::Pages->new($env)->dispatch('index');
sub create_request {
    my($self, $env) = @_;
    return Sledge::Request::PSGI->new($env);
}

sub dispatch {
    my($self, $page) = @_;
    my $r = $self->r;
    $self->SUPER::dispatch($page);
    return $r->finalize;
}

1;

となっていましたが、これだとmod_perl環境やCGI環境で使っていたSledgeプロジェクトのトリガーをPSGIにしたいときに
全てのトリガーを書き換えなければなりません。


なのでこうしてみました。

package Sledge::Pages::PSGI;
# $Id: CGI.pm,v 1.1.1.1 2003/02/13 06:59:36 miyagawa Exp $
#
# Tatsuhiko Miyagawa <miyagawa@edge.co.jp>
# Livin' On The EDGE, Co., Ltd..
#

use strict;
use warnings;
use base qw(Sledge::Pages::Base);

use 5.008001;

use Sledge::Request::PSGI;

# my $res = My::Pages->new($env)->dispatch('index'); #
# my $res = My::Pages->new->dispatch('index');       # more easy

sub new {
    return $_[0]; # I haven't made object yet
}

sub dispatch {
    my($class, $page) = @_;

    return
        sub{
            my $self = $class->SUPER::new($_[0]);
            my $r = $self->r;
            $self->SUPER::dispatch($page);

            return $r->finalize;
        };
}

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

    return Sledge::Request::PSGI->new($env);
}

1;

すこし強引ですが、これならトリガーを書き換えずに従来通りのdispatchの呼び出し方で、
従来のSledgeプロジェクトのトリガーをPSGIにする事が出来ます。

蛇足の蛇足

Sledge::Pages::Compatはこんな感じにすると良いかも。

package Sledge::Pages::Compat;
# $Id: Compat.pm,v 1.1.1.1 2003/02/13 06:59:36 miyagawa Exp $
#
# Tatsuhiko Miyagawa <miyagawa@edge.co.jp>
# Livin' On The EDGE, Co., Ltd..
#

use strict;
use utf8;
use constant {
    MOD_PERL  => exists($ENV{MOD_PERL}),
    MOD_PERL2 => exists($ENV{MOD_PERL}) && ($ENV{MOD_PERL} =~ m|^mod_perl/2|),
    PSGI      => exists($ENV{GATEWAY_INTERFACE})
};

sub import {
    my $base = PSGI ?
        'Sledge::Pages::PSGI':
        MOD_PERL ?
          MOD_PERL2 ?
            'Sledge::Pages::Apache2': # or Sledge::Pages::CGI etc...
            'Sledge::Pages::Apache' :
          'Sledge::Pages::CGI';
    eval qq{require $base};
    {
        my $pkg = caller;
        no strict 'refs';
        unshift @{"$pkg\::ISA"}, $base;
    }
}

1;