MT3.3をmod_perl2で動かすpatch（その１）
前のエントリー の続き。
速さ重視のウェブサービスってわけじゃないからこだわらずに 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 のバージョン情報を持たせればもっとコードがスッキリするけど今回は「えいやっ」と適当に。
この辺りも適当なので改善したいところです。
