MT3.3をmod_perl2で動かすpatch(その1)
前のエントリー の続き。
速さ重視のウェブサービスってわけじゃないからこだわらずに CGI モジュールを使えばいいと思って該当箇所を見てみたところ、
require Apache::Request; $app->{apache} = $param{ApacheObject} || Apache->request; $app->{query} = Apache::Request->instance($app->{apache}, POST_MAX => $app->config('CGIMaxUpload'));
といった感じで Apache::Request を呼ぶ作りになっていたので、簡単な patch を書いてみた。
セットアップ → 日記を書いて保存するところまで動作確認してます。
http://bonnu.heteml.jp/MT-App-MP2.diff
--- lib/MT/App.pm.orig 2006-06-03 03:12:21.000000000 +0900 +++ lib/MT/App.pm 2006-06-03 05:47:00.000000000 +0900 @@ -113,7 +113,11 @@ } else { $app->{apache}->status($app->response_code || 200); } - $app->{apache}->send_http_header($type); + if (exists $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) { + $app->{apache}->content_type($type); + } else { + $app->{apache}->send_http_header($type); + } } else { $app->{cgi_headers}{-status} = ($app->response_code || 200) . " " . ($app->{response_message} || ""); @@ -137,7 +141,11 @@ sub handler ($$) { my $class = shift; my($r) = @_; - require Apache::Constants; + if (exists $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) { + require Apache2::Const; + } else { + require Apache::Constants; + } if (lc($r->dir_config('Filter') || '') eq 'on') { $r = $r->filter_register; } @@ -161,7 +169,8 @@ } $app->run; - return Apache::Constants::OK(); + return (exists $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) + ? Apache2::Const::OK() : Apache::Constants::OK(); } sub init { @@ -204,10 +213,17 @@ $app->{trace} = ''; $app->{author} = $app->{$COOKIE_NAME} = undef; if ($ENV{MOD_PERL}) { - require Apache::Request; - $app->{apache} = $param{ApacheObject} || Apache->request; - $app->{query} = Apache::Request->instance($app->{apache}, - POST_MAX => $app->config('CGIMaxUpload')); + if (exists $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) { + require Apache2::Request; + $app->{apache} = $param{ApacheObject} || Apache2::RequestUtil->request; + $app->{query} = Apache2::Request->new($app->{apache}, + POST_MAX => $app->config('CGIMaxUpload')); + } else { + require Apache::Request; + $app->{apache} = $param{ApacheObject} || Apache->request; + $app->{query} = Apache::Request->instance($app->{apache}, + POST_MAX => $app->config('CGIMaxUpload')); + } } else { if ($param{CGIObject}) { $app->{query} = $param{CGIObject}; @@ -501,7 +517,9 @@ $app->{request_method} = shift; } elsif (!exists $app->{request_method}) { if ($ENV{MOD_PERL}) { - $app->{request_method} = Apache->request->method; + $app->{request_method} = + (exists $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) + ? $app->{apache}->method : Apache->request->method; } else { $app->{request_method} = $ENV{REQUEST_METHOD}; } @@ -532,14 +550,27 @@ $param{-domain} = $cfg->CookieDomain; } if ($ENV{MOD_PERL}) { - require Apache::Cookie; - my $cookie = Apache::Cookie->new($app->{apache}, %param); - if ($param{-expires} && ($cookie->expires =~ m/%/)) { - # Fix for oddball Apache::Cookie error reported on Windows. - require CGI::Util; - $cookie->expires(CGI::Util::expires($param{-expires}, 'cookie')); + my $cookie; + if (exists $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) { + require Apache2::Cookie; + $cookie = Apache2::Cookie->new($app->{apache}, %param); + if ($param{-expires}) { + # Fix for oddball Apache::Cookie error reported on Windows. + require CGI::Util; + $cookie->expires(CGI::Util::expires($param{-expires}, 'cookie')); + } + $cookie->bake($app->{apache}); + } else { + require Apache::Cookie; + $cookie = Apache::Cookie->new($app->{apache}, %param); + if ($param{-expires} && ($cookie->expires =~ m/%/)) { + # Fix for oddball Apache::Cookie error reported on Windows. + require CGI::Util; + $cookie->expires(CGI::Util::expires($param{-expires}, 'cookie')); + } + $cookie->bake; } - $cookie->bake; + } else { require CGI::Cookie; my $cookie = CGI::Cookie->new(%param); @@ -550,7 +581,11 @@ sub cookies { my $app = shift; unless ($app->{cookies}) { - my $class = $ENV{MOD_PERL} ? 'Apache::Cookie' : 'CGI::Cookie'; + my $class = $ENV{MOD_PERL} + ? exists $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2 + ? 'Apache2::Cookie' + : 'Apache::Cookie' + : 'CGI::Cookie'; eval "use $class;"; $app->{cookies} = $class->fetch; } @@ -604,10 +639,20 @@ eval { if ($ENV{MOD_PERL}) { unless ($app->{no_read_body}) { - my $status = $q->parse; - unless ($status == Apache::Constants::OK()) { - die $app->translate('The file you uploaded is too large.') . - "\n<!--$status-->"; + my($status, $ok); + if (exists $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) { + eval { $status = $q->parse }; + if ($@) { + die $app->translate('The file you uploaded is too large.') . + "\n<!--$@-->"; + } + } else { + $status = $q->parse; + $ok = Apache::Constants::OK(); + unless ($status eq $ok) { + die $app->translate('The file you uploaded is too large.') . + "\n<!--$status-->"; + } } } } else { @@ -679,9 +724,14 @@ $app->{redirect} . '">'); } else { if ($ENV{MOD_PERL}) { - $app->{apache}->header_out(Location => $url); - $app->response_code(Apache::Constants::REDIRECT()); - $app->send_http_header; + if (exists $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) { + $app->{apache}->headers_out->add(Location => $url); + $app->{apache}->status(Apache2::Const::REDIRECT); + } else { + $app->{apache}->header_out(Location => $url); + $app->response_code(Apache::Constants::REDIRECT()); + $app->send_http_header; + } } else { print $q->redirect(-uri => $url, %{ $app->{cgi_headers} }); } @@ -966,8 +1016,13 @@ my $q = $app->{query}; return unless $q; if ($ENV{MOD_PERL}) { - my $tab = $q->parms; - $tab->unset($key); + my $tab; + if (exists $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) { + # APR::Request::Param::Table->delete? method undefined + } else { + $tab = $q->parms; + $tab->unset($key); + } } else { $q->delete($key); } @@ -1261,8 +1316,13 @@ my $ip = $TransparentProxyIPs ? $app->get_header('X-Forwarded-For') : ($ENV{MOD_PERL} - ? $app->{apache}->connection->remote_ip - : $ENV{REMOTE_ADDR}); + ? do { + if (exists $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) { + require Apache2::Connection; + } + $app->{apache}->connection->remote_ip + } : $ENV{REMOTE_ADDR} + ); $ip ||= '127.0.0.1'; if ($ip =~ m/,/) { $ip =~ s/.+,\s*//;
app に mod_perl のバージョン情報を持たせればもっとコードがスッキリするけど今回は「えいやっ」と適当に。
この辺りも適当なので改善したいところです。