コマンドラインからPSGIアプリを一度だけ実行する

ときどきPSGIアプリをコマンドラインから呼び出したくなる*1ので、ハンドラを書きました。それなり*2に$psgi_envを整えてくれるので便利です。

• https://github.com/gfx/p5-Plack-Handler-CLI
• http://search.cpan.org/dist/Plack-Handler-CLI/

`plackup -s CLI app.psgi`で実行できます。また、以下のようにしてREQUEST_URIやQUERY_STRINGを渡せます。

$ plackup -s CLI app.psgi           # Request: /
$ plackup -s CLI app.psgi --foo bar # Request: /?foo=bar
$ plackup -s CLI app.psgi hoge fuga # Request: /hoge/fuga

これを使えば、PSGIに則ってCLIコマンドを作ることも出来ます。たとえばcat(1)の実装は以下のようになります。

#!perl -w
# Plack-Handler-CLI/example/cat.psgi
# usage: cat.psgi [files...]
use strict;
use URI::Escape qw(uri_unescape);
use Errno qw(ENOENT EPERM);
use Plack::Request;

our $VERSION = '1.0';

sub _request_error {
    my($errno, @msg) = @_;
    my $status =
          $errno == ENOENT ? 404  # not found
        : $errno == EPERM  ? 403  # permission denied
        :                    400; # something wrong

    return [
        $status,
        [ 'Content-Type' => 'text/plain' ],
        \@msg,
    ];
}

sub main {
    my($env) = @_;
    my $req  = Plack::Request->new($env);
    my $res  = $req->new_response(
        200,
        ['Content-Type' => 'text/plain; charset=utf8'],
    );

    if($req->param('version')) {
        $res->body("cat.psgi version $VERSION ($0)\n");
    }
    elsif($req->param('help')) {
        $res->body("cat.psgi [--version] [--help] files...\n");
    }
    else {
        my @files = grep { length } split '/', $req->path_info;

        local $/;

        my @contents;
        if(@files) {
            foreach my $file(@files) {
                my $f = uri_unescape($file);
                open my $fh, '<', $f
                    or return _request_error($!, "Cannot open '$f': $!\n");

                push @contents, readline($fh);
            }
        }
        else {
            push @contents, readline($env->{'psgi.input'});
        }
        $res->body(\@contents);
    }

    return $res->finalize();
}

if(caller) {
    # from plackup(1)
    return \&main;
}
else {
    # from perl(1)
    # perl cat.psgi として呼び出した場合はheaderの出力を行わないものとする
    require Plack::Handler::CLI;
    my $handler = Plack::Handler::CLI->new(need_headers => 0);
    $handler->run(\&main, \@ARGV);
}
__END__

Enjoy PSGI!

*1:主にテストのため

*2:Plack::Test::Suiteはパスします。