*Acme::Person::Bonnu

■[Perl][MovableType]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 のバージョン情報を持たせればもっとコードがスッキリするけど今回は「えいやっ」と適当に。

• Apache2::Cookie の expires
• APR::Request::Param::Table でのパラメータの削除
• POST 容量のチェック

この辺りも適当なので改善したいところです。

Permalink | コメント(1) | トラックバック(0) | 06:08