die しても Sledge::Plugin::DebugScreen で出しましょう 2 - にぽたん研究所

December 12, 2005

このエントリーをはてなブックマークに追加
さて「id:tokuhirom だけが支えている」と言われつつも、空前の Sledge ブームなわけですが、ちょうどさっきのエントリを書いてたら、id:tokuhirom が既に対応してたりしました…
で、その後に
MoFedge::Plugin::TokuLog! - StackTrace とソースコード
http://tokuhirom.dnsalias.org/~tokuhirom/tokulog/93183.html
まぁ、↑こんな感じで、ソースコードの前後3行ぐらいを表示してくれると最強っぽい。
とか言って「いいもの使ってる感」だけでは不十分だとのたまうので、まぁ確かに最強っぽげだったのでやってみる価値はありそげでしたね。

やってみたらこんなんなりました。 Sledge::Plugin::DebugScreen

例によって patch による提供ですが。

0.01 にあてる patch
--- DebugScreen.pm	Mon Dec 12 15:33:22 2005
+++ DebugScreen.pm	Mon Dec 12 18:12:28 2005
@@ -1,9 +1,11 @@
 package Sledge::Plugin::DebugScreen;
 use strict;
 use warnings;
-our $VERSION = '0.01';
+our $VERSION = '0.03';
 
 use Template;
+use Devel::StackTrace;
+use IO::File;
 
 our $TEMPLATE = q{
 <?xml version="1.0" encoding="euc-jp"?>
@@ -51,6 +53,22 @@
            div.url {
                font-size: x-small;
            }
+           pre {
+               font-size: .8em;
+               line-height: 120%;
+               font-family: 'Courier New', Courier, monospace;
+               background-color: #fee;
+               color: #333;
+               border: 1px dotted #000;
+               padding: 5px;
+               margin: 8px;
+               width: 90%;
+           }
+           pre b {
+               font-weight: bold;
+               color: #000;
+               background-color: #f99;
+           }
        </style>
    </head>
    <body>
@@ -73,9 +91,12 @@
                    </tr>
                    [% FOR s IN stacktrace -%]
                        <tr>
-                           <td>[% s.pkg  | html %]</td>
-                           <td>[% s.line | html %]</td>
-                           <td>[% s.file | html %]</td>
+                           <td>[% (s.pkg  || s.package) | html %]</td>
+                           <td>[%  s.line               | html %]</td>
+                           <td>[% filename = (s.file || s.filename) %][% filename | html %]</td>
+                       </tr>
+                       <tr>
+                           <td colspan="3">[% code_preview = context(filename, s.line) %][% IF code_preview %]<pre>[% code_preview %]</pre>[% END %]</td>
                        </tr>
                    [%- END %]
                </table>
@@ -88,7 +109,10 @@
 sub import {
    my $self = shift;
    my $pkg  = caller;
-
+   local $pkg::SIG{__DIE__} = sub {
+       &_handle_exception($self, @_);
+       die @_;
+   };
    no strict 'refs';
    *{"$pkg\::handle_exception"} = \&_handle_exception;
 }
@@ -101,8 +125,10 @@
            title => ref $self || $self,
            desc  => "$E",
            pages => $self,
+           context => \&print_context,
        };
-       $vars->{stacktrace} = $E->stacktrace if $E->can('stacktrace');
+       $vars->{stacktrace} = $E->can('stacktrace') ?
+           $E->stacktrace : [Devel::StackTrace->new->frames];
 
        my $tmpl = Template->new;
        my $output;
@@ -117,6 +143,39 @@
    } else {
        die $E;
    }
+}
+
+sub print_context {
+    my($file, $linenum) = @_;
+    my $code;
+    if (-f $file) {
+        my $start = $linenum - 3;
+        my $end   = $linenum + 3;
+        $start = $start < 1 ? 1 : $start;
+        if (my $fh = IO::File->new($file, 'r')) {
+            my $cur_line = 0;
+            while (my $line = <$fh>) {
+                ++$cur_line;
+                last if $cur_line > $end;
+                next if $cur_line < $start;
+                my @tag = $cur_line == $linenum ? qw(<b> </b>) : ();
+                $code .= sprintf(
+                    '%s%5d: %s%s',
+                        $tag[0], $cur_line, html_escape($line), $tag[1],
+                );
+            }
+        }
+    }
+    return $code;
+}
+
+sub html_escape {
+    my $str = shift;
+    $str =~ s/&/&amp;/g;
+    $str =~ s/</&lt;/g;
+    $str =~ s/>/&gt;/g;
+    $str =~ s/"/&quot;/g;
+    return $str;
 }
 
 1;
さっき公開した 0.02 の patch をあてたやつにあてる patch
--- DebugScreen.pm	Mon Dec 12 16:29:04 2005
+++ DebugScreen.pm	Mon Dec 12 18:12:28 2005
@@ -1,10 +1,11 @@
 package Sledge::Plugin::DebugScreen;
 use strict;
 use warnings;
-our $VERSION = '0.02';
+our $VERSION = '0.03';
 
 use Template;
 use Devel::StackTrace;
+use IO::File;
 
 our $TEMPLATE = q{
 <?xml version="1.0" encoding="euc-jp"?>
@@ -52,6 +53,22 @@
            div.url {
                font-size: x-small;
            }
+           pre {
+               font-size: .8em;
+               line-height: 120%;
+               font-family: 'Courier New', Courier, monospace;
+               background-color: #fee;
+               color: #333;
+               border: 1px dotted #000;
+               padding: 5px;
+               margin: 8px;
+               width: 90%;
+           }
+           pre b {
+               font-weight: bold;
+               color: #000;
+               background-color: #f99;
+           }
        </style>
    </head>
    <body>
@@ -74,9 +91,12 @@
                    </tr>
                    [% FOR s IN stacktrace -%]
                        <tr>
-                           <td>[% (s.pkg  || s.package)   | html %]</td>
-                           <td>[%  s.line                 | html %]</td>
-                           <td>[% (s.file || s.filename)  | html %]</td>
+                           <td>[% (s.pkg  || s.package) | html %]</td>
+                           <td>[%  s.line               | html %]</td>
+                           <td>[% filename = (s.file || s.filename) %][% filename | html %]</td>
+                       </tr>
+                       <tr>
+                           <td colspan="3">[% code_preview = context(filename, s.line) %][% IF code_preview %]<pre>[% code_preview %]</pre>[% END %]</td>
                        </tr>
                    [%- END %]
                </table>
@@ -105,6 +125,7 @@
            title => ref $self || $self,
            desc  => "$E",
            pages => $self,
+           context => \&print_context,
        };
        $vars->{stacktrace} = $E->can('stacktrace') ?
            $E->stacktrace : [Devel::StackTrace->new->frames];
@@ -122,6 +143,39 @@
    } else {
        die $E;
    }
+}
+
+sub print_context {
+    my($file, $linenum) = @_;
+    my $code;
+    if (-f $file) {
+        my $start = $linenum - 3;
+        my $end   = $linenum + 3;
+        $start = $start < 1 ? 1 : $start;
+        if (my $fh = IO::File->new($file, 'r')) {
+            my $cur_line = 0;
+            while (my $line = <$fh>) {
+                ++$cur_line;
+                last if $cur_line > $end;
+                next if $cur_line < $start;
+                my @tag = $cur_line == $linenum ? qw(<b> </b>) : ();
+                $code .= sprintf(
+                    '%s%5d: %s%s',
+                        $tag[0], $cur_line, html_escape($line), $tag[1],
+                );
+            }
+        }
+    }
+    return $code;
+}
+
+sub html_escape {
+    my $str = shift;
+    $str =~ s/&/&amp;/g;
+    $str =~ s/</&lt;/g;
+    $str =~ s/>/&gt;/g;
+    $str =~ s/"/&quot;/g;
+    return $str;
 }
 
 1;
構文の parse まではやってないので、その行だけハイライトしたりとかしてますが、「最強」に少しだけ近付けたんじゃないかなーとかホザいてみるテスト。


あ、あと見映えはアレなので、良きにアレしてください。

nipotan at 18:35 | Comments(2) | TrackBack(0) | 技術 
このエントリーをはてなブックマークに追加

Trackback URL for this entry

Comments

1. Posted by cert sheets   January 14, 2011 14:22
あ、あと見映えはアレなので、良きにアレしてください。

2. Posted by 642-973   February 10, 2011 02:09
4 「最強」に少しだけ近付けたんじゃないかなーとかホザいてみるテスト。

Post a comment

Name:
URL:
  Remember info?: Rate: Face    Star