Changeset 26380 for lang/perl/MENTA

Timestamp:

12/11/08 17:27:49 (4 years ago)

Author:

tokuhirom

Message:

mod_perl で動くように変更

Location:

lang/perl/MENTA/trunk

Files:

• app/controller/manual/index.mt (modified) (1 diff)
• app/controller/manual/tutorial.mt (modified) (2 diffs)
• config.pl (added)
• lib/MENTA.pm (modified) (5 diffs)
• lib/MENTA/Controller.pm (modified) (2 diffs)
• lib/MENTA/Dispatch.pm (modified) (2 diffs)
• lib/MENTA/ModPerl.pm (added)

lang/perl/MENTA/trunk/app/controller/manual/index.mt

@@ -15 +15 @@
 
 <h2 class="subtitle">開発者</h2>
-<ol><?=r join "\n", map { '<li>' . escape_html($_) . '</li>' } split /[\r\n]+/, file_read('AUTHORS') ?></ol>
+<ol><?=r join "\n", map { '<li>' . escape_html($_) . '</li>' } split /[\r\n]+/, file_read(MENTA::base_dir() . 'AUTHORS') ?></ol>
 
 ?= render('footer.mt')

lang/perl/MENTA/trunk/app/controller/manual/tutorial.mt

@@ -30 +30 @@
 ? my $hello = 'app/controller/demo/hello.mt'
 <p>下記のようなファイルを、<?= $hello ?> におきます。</p>
-<pre><code><?= file_read($hello) ?></code></pre>
+<pre><code><?= file_read(MENTA::base_dir() . $hello) ?></code></pre>
 <p><code>param("user")</code> と書くと、<code><?= uri_for('demo/hello', { user => 'kazuhooku' }) ?></code> の <code>kazuhooku</code> の部分がとりだせます。</p>
 <p><a href="<?= uri_for('demo/hello', { user => 'kazuhooku' }) ?>">実際にうごくデモ</a></p>
@@ -36 +36 @@
 <h3>カウンターをつけてみる</h3>
 ? my $counter = 'app/controller/demo/counter.mt'
-<pre><code><?= file_read($counter) ?></code></pre>
+<pre><code><?= file_read(MENTA::base_dir() . $counter) ?></code></pre>
 <p>このようにすると、カウンターを簡単に HTML の中にうめこめます。</p>
 <p><code>counter_increment("test")</code> と書くと、<code>test</code> という名前のカウンターが 1 増えます。<code>counter_increment</code> の返却値として、1 増えた結果がかえってきますのでそのまま表示するだけでカウンターになります。</p>

lang/perl/MENTA/trunk/lib/MENTA.pm

@@ -23 +23 @@
     sub context { $context }
     sub run_context {
-        my ($class, $config, $req, $code) = @_;
+        my ($class, $config, $req, $engine, $code) = @_;
         local $context = MENTA::Context->new(
-            config  => $config,
-            request => $req,
+            config   => $config,
+            request  => $req,
+            __engine => $engine,
         );
         $code->();
@@ -32 +33 @@
 }
 
-# Class::Trigger はロードに時間かかるので自前で実装してる
-sub call_trigger {
-    my ($class, $triggername, @args) = @_;
-    my $c = context();
-    for my $code (@{$c->{triggers}->{$triggername}}) {
-        $code->($c, @args);
-    }
-}
-
-sub add_trigger {
-    my ($class, $triggername, $code) = @_;
-    push @{context()->{triggers}->{$triggername}}, $code;
+{
+    # Class::Trigger はロードに時間かかるので自前で実装してる
+    my $static_triggers;
+    sub call_trigger {
+        my ($class, $triggername, @args) = @_;
+        my $c = context();
+        for my $code (@{$c->{triggers}->{$triggername}}, @{ $static_triggers->{triggers}->{$triggername} || [] }) {
+            $code->($c, @args);
+        }
+    }
+
+    sub add_trigger {
+        my ($class, $triggername, $code) = @_;
+        if (ref context()) {
+            push @{context()->{triggers}->{$triggername}}, $code;
+        } else {
+            push @{$static_triggers->{triggers}->{$triggername}}, $code;
+        }
+    }
 }
 
 # run as cgi
 sub run_menta {
-    my $class  = shift;
-    my $config = shift;
-
-    HTTP::Engine->new(
+    my ($class, $config) = @_;
+    $class->create_engine($config, 'MinimalCGI')->run;
+}
+
+sub create_engine {
+    my ($class, $config, $interface) = @_;
+
+    my $engine;
+    $engine = HTTP::Engine->new(
         interface => {
-            module => 'MinimalCGI',
+            module => $interface,
             request_handler => sub {
                 my $req = shift;
+                local $MENTA::STASH;
                 CGI::ExceptionManager->run(
                     callback => sub {
                         MENTA->run_context(
-                            $config, $req, sub {
+                            $config, $req, $engine, sub {
+                                MENTA->call_trigger('BEFORE_DISPATCH');
                                 MENTA::Dispatch->dispatch()
                             }
@@ -70 +85 @@
             }
         }
-    )->run;
+    );
 }
 
@@ -106 +121 @@
 }
 
+sub base_dir {
+    my $basedir = config->{menta}->{base_dir};
+    return '' unless $basedir;
+    $basedir =~ s!([^/])$!$1/!;
+    return $basedir;
+}
+
 sub controller_dir {
-    config->{menta}->{controller_dir} || 'app/controller/'
+    config->{menta}->{controller_dir} ||= base_dir() . 'app/controller/';
+    config->{menta}->{controller_dir};
 }
 
 sub data_dir {
-    config->{menta}->{data_dir} || 'app/data/'
+    config->{menta}->{data_dir} ||= base_dir() . 'app/controller/';
+    config->{menta}->{data_dir};
 }
 
@@ -297 +321 @@
             my $plugin = shift;
             return if $plugin_loaded->{$plugin};
-            my $path = "plugins/${plugin}.pl";
+            my $path = MENTA::base_dir() . "plugins/${plugin}.pl";
             require $path;
             $plugin_loaded->{$plugin}++;

lang/perl/MENTA/trunk/lib/MENTA/Controller.pm

@@ -5 +5 @@
 
 sub import {
+    my $controller_dir = MENTA::controller_dir();
+
     Filter::Util::Call::filter_add(sub {
         my $status;
@@ -19 +21 @@
         my $pkg = do {
             local $_ = (caller(0))[1];
-            s{^app/controller/+|\.pl$}{}g;
+            s{^$controller_dir/*|\.pl$}{}g;
             s{/}{::};
             "MENTA::Controller::$_";

lang/perl/MENTA/trunk/lib/MENTA/Dispatch.pm

@@ -42 +42 @@
             MENTA::finalize($out);
         } else {
-            die "「${path}」というモードは存在しません。コントローラファイルもありません(${controller})。テンプレートファイルもありません(${controller_mt})";
+            die "「${path}」というモードは存在しません。コントローラファイルもありません(${controller})。テンプレートファイルもありません(${controller_mt})。ベースディレクトリは @{[ MENTA::base_dir() ]} です。";
         }
-    } elsif ($path ne 'menta.cgi' && -f "app/$path" && $path =~ /^static\//) {
+    } elsif ($path ne 'menta.cgi' && -f (MENTA::base_dir() . "app/$path") && $path =~ /^static\//) {
         show_static("app/$path");
     } elsif ($path =~ /^(?:crossdomain\.xml|favicon\.ico|robots\.txt)$/) {
         print "status: 404\r\ncontent-type: text/plain\r\n\r\n";
     } else {
-        die "'${path}' を処理する方法がわかりません";
+        die "'${path}' を処理する方法がわかりません(@{[ MENTA::base_dir() . 'app/' . $path ]})";
     }
 }
@@ -58 +58 @@
     MENTA::Util::require_once('File/Spec.pm');
     MENTA::Util::require_once('CGI/Simple/Util.pm');
-    $path = Cwd::realpath($path);
-    my $appdir = Cwd::realpath(File::Spec->catfile(Cwd::cwd(), 'app', 'static'));
+    $path = Cwd::realpath(File::Spec->catfile(MENTA::base_dir(), $path));
+    my $appdir = Cwd::realpath(File::Spec->catfile(MENTA::base_dir(), 'app', 'static'));
     if (index($path, $appdir) != 0) {
         die "どうやら攻撃されているようだ: $path";