Changeset 23419

Show
Ignore:
Timestamp:
11/12/08 21:50:52 (5 years ago)
Author:
drry
Message:
  • added the document root pref.
  • et cetera.
Location:
lang/perl/MENTA/trunk
Files:
1 added
5 modified

Legend:

Unmodified
Added
Removed

  • lang/perl/MENTA/trunk/app/index.cgi

    r23415 r23419  
    2121    # あなたのアプリの設定 
    2222    application => { 
    23         title => "MENTA サンプルアプリ", 
     23        docroot => '', 
     24        title => 'MENTA サンプルアプリ', 
    2425    }, 
    2526}); 

  • lang/perl/MENTA/trunk/app/tmpl/index.html

    r23372 r23419  
     1% my $docroot = config()->{application}->{docroot} 
     2% my $title   = config()->{application}->{title} 
    13<!doctype html> 
    2 <title><%= config()->{application}->{title} %></title> 
    3 <link rel="stylesheet" type="text/css" href="/static/style-sites.css"> 
    4 <script type="text/javascript" src="/static/jquery-latest.js"></script> 
    5 <script type="text/javascript"> 
     4<title><%= $title %></title> 
     5<link rel="stylesheet" type="text/css" href="<%= $docroot %>static/style-sites.css"> 
     6<script type="text/javascript" src="<%= $docroot %>static/jquery.js"></script> 
     7<script type="text/javascript"><!-- 
    68$(function() { 
    79    var $this = $('h1'); 
    810    $this.css({background : 'orange'}).text($this.text().replace('MENTA', 'めんた')); 
    911}); 
    10 </script> 
    11 <h1><%= config()->{application}->{title} %></h1> 
     12//--></script> 
     13 
     14<h1><%= $title %></h1> 
    1215<p><%= localtime time %></p> 

  • lang/perl/MENTA/trunk/app/tmpl/users.html

    r23414 r23419  
     1% my $docroot = config()->{application}->{docroot} 
     2% my $title   = config()->{application}->{title} . ' users' 
    13<!doctype html> 
    2 <title><%= config()->{application}->{title} %></title> 
    3 <link rel="stylesheet" type="text/css" href="/static/style-sites.css"> 
    4 <h1><%= config()->{application}->{title} %></h1> 
     4<title><%= $title %></title> 
     5<link rel="stylesheet" type="text/css" href="<%= $docroot %>static/style-sites.css"> 
     6 
     7<h1><%= $title %></h1> 
    58<table border="1"> 
    6 <% for my $a (@{$_[0]}) { %> 
    7 <tr> 
    8         <td><%= $a->{id} %></td><td><%= $a->{name} %></td> 
    9 </tr> 
    10 <% } %> 
     9% for my $a (@{$_[0]}) { 
     10 <tr> 
     11  <td><%= $a->{id} %></td><td><%= $a->{name} %></td> 
     12 </tr> 
     13% } 
    1114</table> 

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

    r23408 r23419  
    3030        my $config = config(); 
    3131        if (! $config) { 
    32             die "config()でアプリケーション設定がされていません!"; 
     32            die "config() でアプリケーション設定がされていません!"; 
    3333        } 
    3434 
    … …  
    5656        } 
    5757 
    58         my $static_file = $ENV{PATH_INFO} || ''; 
    59         $static_file =~ s!^/*!!g; 
    60         if ($static_file !~ /index\.cgi/ && -f $static_file) { 
    61             if (open my $fh, '<', $static_file) { 
    62                 printf "Content-Type: %s\n\n", guess_mime_type($static_file); 
    63                 print do { local $/; <$fh> }; 
    64                 close $fh; 
    65             } else { 
    66                 die "ファイルが見つかりません"; 
     58        if (my $static_file = $ENV{PATH_INFO}) { 
     59            $static_file =~ s!^/+!!g; 
     60            if ($static_file !~ /\bindex\.cgi\b/ && -f $static_file) { 
     61                if (open my $fh, '<', $static_file) { 
     62                    printf "Content-Type: %s\r\n\r\n", guess_mime_type($static_file); 
     63                    print do { local $/; <$fh> }; 
     64                    close $fh; 
     65                    return 1; 
     66                } else { 
     67                    die "ファイルが開きません"; 
     68                } 
     69            } 
     70        } 
     71 
     72        my $mode = $MENTA::REQ->{mode} || 'index'; 
     73        my $meth = "do_$mode"; 
     74        if (my $code = main->can($meth)) { 
     75            $code->($MENTA::REQ); 
     76            unless ($MENTA::FINISHED) { 
     77                die "なにも出力してません"; 
    6778            } 
    6879        } else { 
    69             my $mode = $MENTA::REQ->{mode} || 'index'; 
    70             my $meth = "do_$mode"; 
    71             if (my $code = main->can($meth)) { 
    72                 $code->($MENTA::REQ); 
    73                 unless ($MENTA::FINISHED) { 
    74                     die "なにも出力してません"; 
    75                 } 
    76             } else { 
    77                 die "'$mode' というモードは存在しません"; 
    78             } 
     80            die "「$mode」というモードは存在しません"; 
    7981        } 
    8082    }; 
    … …  
    9193            if ($config->{menta}->{kcatch_mode}) { 
    9294                $err = escape_html($err); 
    93                 qq{<html><body style="background: red; color: white"><p>500 Internal Server Error: $err</p></body></html>\n}; 
     95                qq{<html><body style="background: red; color: white; font-weight: bold"><p><span style="font-size: xx-large; color: black">&#x2620;</span> 500 Internal Server Error <span style="font-size: xx-large; color: black">&#x2620;</span>: $err</p></body></html>\n}; 
    9496            } else { 
    95                 qq{<html><body style="background: red; color: white"><p>500 Internal Server Error</p></body></html>\n}; 
     97                qq{<html><body><p style="color: red">500 Internal Server Error</p></body></html>\n}; 
    9698            } 
    9799        }; 
    … …  
    143145        $out = $tmplcode->(@params); 
    144146    } else { 
    145         die "$tmplfname という名前のテンプレートファイルは見つかりません" unless -f $tmplfname; 
     147        die "「$tmplfname」という名前のテンプレートファイルは見つかりません" unless -f $tmplfname; 
    146148        require MENTA::Template; 
    147149        my $tmplsrc = read_file($tmplfname); 

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

    r23408 r23419  
    3535    my $one_level = 4; 
    3636    my $indent = ' ' x ($indent_level*$one_level); 
    37     "{\n$indent" . join("\n$indent", split("\n", read_file($fname))) . "\n" . (' ' x (($indent_level-1)*$one_level)) . "}\n"; 
     37    "{\n" . join("\n", grep { /^\s*$/ or $_ = $indent . $_; 1 } 
     38                       split("\n", read_file($fname))) 
     39          . "\n" . (' ' x (($indent_level-1)*$one_level)) . "}\n"; 
    3840} 
    3941