Plack::Component
「Plack::App::*」モジュールをつくるためのベースクラス。
prepare_appとcallをオーバーライドする。
callはto_appで呼び出されるようになっている。
Plack::App::PHPCGIでは以下のように実装している(コメント追加)。
sub prepare_app { my $self = shift; # PHPスクリプトのパス my $script = $self->script or croak "'script' is not set"; $script = File::Spec->rel2abs($script); # php-cgiコマンドの設定、設定されていない場合はパスを自動検出する my $php_cgi = $self->php_cgi; $php_cgi ||= which('php-cgi'); croak "cannot find 'php-cgi' command" unless -x $php_cgi; # _appはアクセサ。 # wrap_php関数でPHPの設定 $self->_app(wrap_php($php_cgi, $script)); } sub call { my($self, $env) = @_; $self->_app->($env); }
pipe関数
パイプを生成する関数。
forkした後に親プロセスと子プロセスで通信するパイプを作ったりすることができる。
use strict; use warnings; $| = 1; pipe(my $rh, my $wh); my $pid; if ($pid = fork()) { # 親プロセス # 入力はしないため、閉じる close $rh; # 子プロセスにメッセージを送る syswrite($wh, '親メッセージ'); close $wh; # 子プロセスの終了を待つ wait; } elsif (defined $pid) { # 子プロセス # 出力はしないため、閉じる close $wh; # 親プロセスからのメッセージを受け取る sysread($rh, my $buff, 100); close $rh; print "親プロセスからのメッセージ: $buff\n"; } else { die "forkに失敗しました\n"; }
open関数
「>&」でリダイレクトができる。
use strict; use warnings; open my $fh, '>', 'test.txt'; open my $oldout, '>&', fileno($fh) or die ""; print $oldout "test"; warn fileno($fh); # -> 3 warn fileno($oldout); # -> 4 close $oldout; close $fh;
「>&=」だとfilenoを再利用する。
use strict; use warnings; open my $fh, '>', 'test.txt'; open my $oldout, '>&', fileno($fh) or die ""; print $oldout "test"; warn fileno($fh); # -> 3 warn fileno($oldout); # -> 3 close $oldout; close $fh;
## no critic
「## no critic」と書くことで、Test::Perl::Criticのチェックで無視されるようになる。
http://gihyo.jp/dev/feature/01/test-perl/0004
wrap_php
以上のことを踏まえて、Plack::App::PHPCGIのwrap_phpメソッドを読む。
sub wrap_php { my ($php_cgi, $script) = @_; my $app = sub { my $env = shift; # 標準出力でphp-cgiとレスポンスをやりとりするためのパイプ pipe( my $stdoutr, my $stdoutw ); # 標準入力でphp-cgiとリクエストをやりとりするためのパイプ pipe( my $stdinr, my $stdinw ); # フォーク my $pid = fork(); Carp::croak("fork failed: $!") unless defined $pid; # 子プロセス if ($pid == 0) { # child # シグナル local $SIG{__DIE__} = sub { print STDERR @_; exit(1); }; # 子プロセスでは使わないので閉じる close $stdoutr; close $stdinw; # 環境変数の設定 local %ENV = (%ENV, CGI::Emulate::PSGI->emulate_environment($env)); local $ENV{REDIRECT_STATUS} = 1; local $ENV{SCRIPT_FILENAME} = $script; # 標準出力を$stdoutwにリダイレクト open( STDOUT, ">&=" . fileno($stdoutw) ) ## no critic or Carp::croak "Cannot dup STDOUT: $!"; # 標準入力を$stdinrにリダイレクト open( STDIN, "<&=" . fileno($stdinr) ) ## no critic or Carp::croak "Cannot dup STDIN: $!"; # php-cgiを実行 exec($php_cgi,$script) or Carp::croak("cannot exec: $!"); exit(2); } # 親プロセスでは使わないので閉じる close $stdoutw; close $stdinr; # psgi.inputの内容をphp-cgiに渡す syswrite($stdinw, do { local $/; my $fh = $env->{'psgi.input'}; <$fh>; }); # close STDIN so child will stop waiting close $stdinw; # cgi-phpからのレスポンスを受け取る my $res = ''; while (waitpid($pid, WNOHANG) <= 0) { $res .= do { local $/; <$stdoutr> }; } $res .= do { local $/; <$stdoutr> }; # 子プロセスの終了が正常に終了した場合、レスポンスをPSGI形式にパースする if (POSIX::WIFEXITED($?)) { return CGI::Parse::PSGI::parse_cgi_output(\$res); } else { Carp::croak("Error at run_on_shell CGI: $!"); } }; $app; }