Changeset 24403 for lang

Show
Ignore:
Timestamp:
11/20/08 11:29:10 (5 years ago)
Author:
tokuhirom
Message:

MENTA::Dispatch に分離

Location:
lang/perl/MENTA/trunk/lib
Files:
1 added
1 modified

Legend:

Unmodified
Added
Removed

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

    r24402 r24403  
    44use utf8; 
    55use CGI::ExceptionManager; 
     6use MENTA::Dispatch (); 
    67 
    78our $VERSION = '0.05'; 
    … …  
    3637    CGI::ExceptionManager->run( 
    3738        callback => sub { 
    38             dispatch() 
     39            MENTA::Dispatch->dispatch() 
    3940        }, 
    4041        powered_by => '<strong>MENTA</strong>, Web Application Framework.', 
    4142        (config->{menta}->{fatals_to_browser} ? () : (renderer => sub { "INTERNAL SERVER ERROR!" x 100 })) 
    4243    ); 
    43 } 
    44  
    45 sub dispatch { 
    46     my $path = $ENV{PATH_INFO} || '/'; 
    47     $path =~ s!^/+!!g; 
    48     if ($path =~ /^[a-z0-9_]*$/) { 
    49         $path ||= 'index'; 
    50         my $cdir = controller_dir(); 
    51         my $controller = "${cdir}/${path}.pl"; 
    52         my $controller_mt = controller_dir() . "/${path}.mt"; 
    53         if (-f $controller) { 
    54             my $meth = "do_$path"; 
    55             package main; 
    56             do $controller; 
    57             if (my $e = $@) { 
    58                 if (ref $e) { 
    59                     warn "KTKR"; 
    60                     return; 
    61                 } else { 
    62                     die $e; 
    63                 } 
    64             } 
    65             die $@ if $@; 
    66             if (my $code = main->can($meth)) { 
    67                 $code->(); 
    68                 die "なにも出力してません"; 
    69             } else { 
    70                 die "「${path}」というモードは存在しません!${controller} の中に ${meth} が定義されていないようです"; 
    71             } 
    72         } elsif (-f $controller_mt) { 
    73             my $out = __render_partial("${path}.mt", controller_dir()); 
    74             utf8::encode($out); 
    75             print "Content-Type: text/html; charset=utf-8\r\n"; 
    76             print "\r\n"; 
    77             print $out; 
    78         } else { 
    79             die "「${path}」というモードは存在しません。コントローラファイルもありません(${controller})。テンプレートファイルもありません(${controller_mt})"; 
    80         } 
    81     } elsif ($path ne 'menta.cgi' && -f "app/$path" && $path =~ /^static\//) { 
    82         $path = "app/$path"; 
    83         if (open my $fh, '<', $path) { 
    84             binmode $fh; 
    85             binmode STDOUT; 
    86             printf "Content-Type: %s\r\n\r\n", guess_mime_type($path); 
    87             print do { local $/; <$fh> }; 
    88             close $fh; 
    89         } else { 
    90             die "ファイルが開きません"; 
    91         } 
    92     } elsif ($path =~ /^(?:crossdomain\.xml|favicon\.ico|robots\.txt)$/) { 
    93         print "status: 404\r\ncontent-type: text/plain\r\n\r\n"; 
    94     } else { 
    95         die "${path} を処理する方法がわかりません"; 
    96     } 
    9744} 
    9845 
    … …  
    11764    s/&amp;/&/g; 
    11865    return $_; 
    119 } 
    120  
    121 sub guess_mime_type { 
    122     my $ext = shift; 
    123     $ext =~ s/.+\.(.+)$/$1/; 
    124  
    125     # TODO should be moved to other. 
    126     my $mime_map = { 
    127         css => 'text/css', 
    128         js  => 'application/javascript', 
    129         jpg => 'image/jpeg', 
    130         gif => 'image/gif', 
    131         png => 'image/png', 
    132         txt => 'text/plain', 
    133     }; 
    134     $mime_map->{$ext} || 'application/octet-stream'; 
    13566} 
    13667