Changeset 23605

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

stacktrace にソース表示するようにした。例によって nipotan のコードをコピペ。
thanks to nipotan++

Files:
1 modified

Legend:

Unmodified
Added
Removed

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

    r23604 r23605  
    4040        while ( my ($package, $filename, $line,) = caller($i) ) { 
    4141            last if $filename eq 'bin/cgi-server.pl'; 
    42             push @trace, {level => $i, package => $package, filename => $filename, line => $line}; 
     42            my $context = sub { 
     43                my ( $file, $linenum ) = @_; 
     44                my $code; 
     45                if ( -f $file ) { 
     46                    my $start = $linenum - 3; 
     47                    my $end   = $linenum + 3; 
     48                    $start = $start < 1 ? 1 : $start; 
     49                    open my $fh, '<:utf8', $file or die "エラー画面表示用に ${file} を開こうとしたのに開けません: $!"; 
     50                    my $cur_line = 0; 
     51                    while ( my $line = <$fh> ) { 
     52                        ++$cur_line; 
     53                        last if $cur_line > $end; 
     54                        next if $cur_line < $start; 
     55                        my @tag = 
     56                            $cur_line == $linenum 
     57                            ? (q{<b style="color: #000;background-color: #f99;">}, '</b>') 
     58                            : ( '', '' ); 
     59                        $code .= sprintf( '%s%5d: %s%s', 
     60                            $tag[0], $cur_line, 
     61                            escape_html($line), 
     62                            $tag[1], ); 
     63                    } 
     64                    close $file; 
     65                } 
     66                return $code; 
     67            }->($filename, $line); 
     68            push @trace, {level => $i, package => $package, filename => $filename, line => $line, context => $context }; 
    4369            $i++; 
    4470        } 
    … …  
    107133                my $out = qq{<!doctype html><title>INTERNAL SERVER ERROR!!! HACKED BY MENTA</title><body style="background: red; color: white; font-weight: bold"><marquee behavior="alternate" scrolldelay="66" style="text-transform: uppercase"><span style="font-size: xx-large; color: black">&#x2620;</span> <span style="color: green">500</span> Internal Server Error <span style="font-size: xx-large; color: black">&#x2620;</span></marquee><p><span style="color: blue">$msg</span></p><ol>}; 
    108134                for my $stack (@{$err->{trace}}) { 
    109                     $out .= '<li>' . escape_html(join(', ', $stack->{package}, $stack->{filename}, $stack->{line})) . '</li>'; 
     135                    $out .= '<li>' . escape_html(join(', ', $stack->{package}, $stack->{filename}, $stack->{line})) 
     136                        . qq(<pre style="background-color: #fee;color: #333;">$stack->{context}</pre></li>); 
    110137                } 
    111138                $out .= qq{</ol><p style="text-align: right; color: black"><strong>Regards,<br>MENTA</strong></p>\n};