Changeset 26380 for lang/perl/MENTA

Show
Ignore:
Timestamp:
12/11/08 17:27:49 (5 years ago)
Author:
tokuhirom
Message:

mod_perl で動くように変更

Location:
lang/perl/MENTA/trunk
Files:
2 added
5 modified

Legend:

Unmodified
Added
Removed
  • lang/perl/MENTA/trunk/app/controller/manual/index.mt

    r25372 r26380  
    1515 
    1616<h2 class="subtitle">開発者</h2> 
    17 <ol><?=r join "\n", map { '<li>' . escape_html($_) . '</li>' } split /[\r\n]+/, file_read('AUTHORS') ?></ol> 
     17<ol><?=r join "\n", map { '<li>' . escape_html($_) . '</li>' } split /[\r\n]+/, file_read(MENTA::base_dir() . 'AUTHORS') ?></ol> 
    1818 
    1919?= render('footer.mt') 
  • lang/perl/MENTA/trunk/app/controller/manual/tutorial.mt

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

    r26366 r26380  
    2323    sub context { $context } 
    2424    sub run_context { 
    25         my ($class, $config, $req, $code) = @_; 
     25        my ($class, $config, $req, $engine, $code) = @_; 
    2626        local $context = MENTA::Context->new( 
    27             config  => $config, 
    28             request => $req, 
     27            config   => $config, 
     28            request  => $req, 
     29            __engine => $engine, 
    2930        ); 
    3031        $code->(); 
     
    3233} 
    3334 
    34 # Class::Trigger はロードに時間かかるので自前で実装してる 
    35 sub call_trigger { 
    36     my ($class, $triggername, @args) = @_; 
    37     my $c = context(); 
    38     for my $code (@{$c->{triggers}->{$triggername}}) { 
    39         $code->($c, @args); 
    40     } 
    41 } 
    42  
    43 sub add_trigger { 
    44     my ($class, $triggername, $code) = @_; 
    45     push @{context()->{triggers}->{$triggername}}, $code; 
     35{ 
     36    # Class::Trigger はロードに時間かかるので自前で実装してる 
     37    my $static_triggers; 
     38    sub call_trigger { 
     39        my ($class, $triggername, @args) = @_; 
     40        my $c = context(); 
     41        for my $code (@{$c->{triggers}->{$triggername}}, @{ $static_triggers->{triggers}->{$triggername} || [] }) { 
     42            $code->($c, @args); 
     43        } 
     44    } 
     45 
     46    sub add_trigger { 
     47        my ($class, $triggername, $code) = @_; 
     48        if (ref context()) { 
     49            push @{context()->{triggers}->{$triggername}}, $code; 
     50        } else { 
     51            push @{$static_triggers->{triggers}->{$triggername}}, $code; 
     52        } 
     53    } 
    4654} 
    4755 
    4856# run as cgi 
    4957sub run_menta { 
    50     my $class  = shift; 
    51     my $config = shift; 
    52  
    53     HTTP::Engine->new( 
     58    my ($class, $config) = @_; 
     59    $class->create_engine($config, 'MinimalCGI')->run; 
     60} 
     61 
     62sub create_engine { 
     63    my ($class, $config, $interface) = @_; 
     64 
     65    my $engine; 
     66    $engine = HTTP::Engine->new( 
    5467        interface => { 
    55             module => 'MinimalCGI', 
     68            module => $interface, 
    5669            request_handler => sub { 
    5770                my $req = shift; 
     71                local $MENTA::STASH; 
    5872                CGI::ExceptionManager->run( 
    5973                    callback => sub { 
    6074                        MENTA->run_context( 
    61                             $config, $req, sub { 
     75                            $config, $req, $engine, sub { 
     76                                MENTA->call_trigger('BEFORE_DISPATCH'); 
    6277                                MENTA::Dispatch->dispatch() 
    6378                            } 
     
    7085            } 
    7186        } 
    72     )->run; 
     87    ); 
    7388} 
    7489 
     
    106121} 
    107122 
     123sub base_dir { 
     124    my $basedir = config->{menta}->{base_dir}; 
     125    return '' unless $basedir; 
     126    $basedir =~ s!([^/])$!$1/!; 
     127    return $basedir; 
     128} 
     129 
    108130sub controller_dir { 
    109     config->{menta}->{controller_dir} || 'app/controller/' 
     131    config->{menta}->{controller_dir} ||= base_dir() . 'app/controller/'; 
     132    config->{menta}->{controller_dir}; 
    110133} 
    111134 
    112135sub data_dir { 
    113     config->{menta}->{data_dir} || 'app/data/' 
     136    config->{menta}->{data_dir} ||= base_dir() . 'app/controller/'; 
     137    config->{menta}->{data_dir}; 
    114138} 
    115139 
     
    297321            my $plugin = shift; 
    298322            return if $plugin_loaded->{$plugin}; 
    299             my $path = "plugins/${plugin}.pl"; 
     323            my $path = MENTA::base_dir() . "plugins/${plugin}.pl"; 
    300324            require $path; 
    301325            $plugin_loaded->{$plugin}++; 
  • lang/perl/MENTA/trunk/lib/MENTA/Controller.pm

    r26366 r26380  
    55 
    66sub import { 
     7    my $controller_dir = MENTA::controller_dir(); 
     8 
    79    Filter::Util::Call::filter_add(sub { 
    810        my $status; 
     
    1921        my $pkg = do { 
    2022            local $_ = (caller(0))[1]; 
    21             s{^app/controller/+|\.pl$}{}g; 
     23            s{^$controller_dir/*|\.pl$}{}g; 
    2224            s{/}{::}; 
    2325            "MENTA::Controller::$_"; 
  • lang/perl/MENTA/trunk/lib/MENTA/Dispatch.pm

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