Changeset 23283

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

lib/MENTA.pm を分離させた

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

Legend:

Unmodified
Added
Removed

  • lang/perl/MENTA/trunk/bin/menta.pl

    r23273 r23283  
    4141                local $Data::Dumper::Terse  = 1; 
    4242                local $Data::Dumper::Sortkeys = 1; 
    43                 q{my $CONFIG = } . Data::Dumper->Dump([{%$ini}]) . q{;}; 
     43                q{$MENTA::CONFIG = } . Data::Dumper->Dump([{%$ini}]) . q{;}; 
     44            }, 
     45            MAIN => do { 
     46                '{' . read_file('lib/MENTA.pm') . '}' 
    4447            }, 
    4548            CONTROLLER => do { 

  • lang/perl/MENTA/trunk/src/menta.pl

    r23280 r23283  
    4141} 
    4242 
    43 { 
    44     package MENTA; 
    45     use strict; 
    46     use warnings; 
    47     use utf8; 
    48     use Encode; 
    49  
    50     our $FINISHED; 
    51     our $REQ; 
    52  
    53     ### CONFIG ### 
    54  
    55     sub config { $CONFIG } 
    56  
    57     sub run { 
    58         eval { 
    59             my $input; 
    60             if ($ENV{'REQUEST_METHOD'} eq "POST") { 
    61                 if ($ENV{CONTENT_LENGTH} > $CONFIG->{menta}->{max_post_body}) { 
    62                     die "投稿データが長すぎです"; 
    63                 } else { 
    64                     read(STDIN, $input, $ENV{'CONTENT_LENGTH'}); 
    65                 } 
    66             } else { 
    67                 $input = $ENV{QUERY_STRING}; 
    68             } 
    69             local $REQ = {}; 
    70             local $FINISHED = 0; 
    71  
    72             for ( split /&/, $input) { 
    73                 my ($key, $val) = split /=/, $_; 
    74                 $val =~ tr/+/ /; 
    75                 $val =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("H2", $1)/eg; 
    76                 $REQ->{$key} = $val; 
    77             } 
    78  
    79             { 
    80                 my $mode = $REQ->{mode} || 'index'; 
    81                 my $meth = "do_$mode"; 
    82                 if (my $code = MENTA::Controller->can($meth)) { 
    83                     $code->($REQ); 
    84                     unless ($FINISHED) { 
    85                         die "なにも出力してません"; 
    86                     } 
    87                 } else { 
    88                     die "'$mode' というモードはしらないんだ"; 
    89                 } 
    90             } 
    91         }; 
    92         if (my $err = $@) { 
    93             # TODO: 美麗な画面を出す 
    94             print "Content-type: text/html; charset=utf-8\n"; 
    95             print "\n"; 
    96             if ($CONFIG->{menta}->{kcatch_mode}) { 
    97                 print encode_utf8(qq{<html><body><div color="red">500 Internal Server Error: $err</div></body></html>\n}); 
    98             } else { 
    99                 print qq{<html><body><div color="red">500 Internal Server Error</div></body></html>\n}; 
    100             } 
    101         } 
    102     } 
    103 } 
     43### MAIN ### 
    10444 
    10545package main; 
     46### CONFIG ### 
    10647MENTA->run(); 
    10748