| Filename | /usr/local/share/perl/5.18.2/Devel/StackTrace/AsHTML.pm |
| Statements | Executed 16 statements in 1.02ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 3.52ms | 3.85ms | Devel::StackTrace::AsHTML::BEGIN@7 |
| 1 | 1 | 1 | 13µs | 26µs | Devel::StackTrace::AsHTML::BEGIN@3 |
| 1 | 1 | 1 | 12µs | 12µs | Devel::StackTrace::AsHTML::BEGIN@4 |
| 1 | 1 | 1 | 8µs | 18µs | Devel::StackTrace::AsHTML::BEGIN@11 |
| 1 | 1 | 1 | 6µs | 21µs | Devel::StackTrace::AsHTML::BEGIN@9 |
| 1 | 1 | 1 | 5µs | 5µs | Devel::StackTrace::AsHTML::BEGIN@8 |
| 0 | 0 | 0 | 0s | 0s | Devel::StackTrace::AsHTML::__ANON__[:124] |
| 0 | 0 | 0 | 0s | 0s | Devel::StackTrace::AsHTML::_build_arguments |
| 0 | 0 | 0 | 0s | 0s | Devel::StackTrace::AsHTML::_build_context |
| 0 | 0 | 0 | 0s | 0s | Devel::StackTrace::AsHTML::_build_lexicals |
| 0 | 0 | 0 | 0s | 0s | Devel::StackTrace::AsHTML::encode_html |
| 0 | 0 | 0 | 0s | 0s | Devel::StackTrace::AsHTML::render |
| 0 | 0 | 0 | 0s | 0s | Devel::StackTrace::as_html |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package Devel::StackTrace::AsHTML; | ||||
| 2 | |||||
| 3 | 2 | 24µs | 2 | 39µs | # spent 26µs (13+13) within Devel::StackTrace::AsHTML::BEGIN@3 which was called:
# once (13µs+13µs) by Plack::Middleware::StackTrace::BEGIN@6 at line 3 # spent 26µs making 1 call to Devel::StackTrace::AsHTML::BEGIN@3
# spent 13µs making 1 call to strict::import |
| 4 | 2 | 47µs | 1 | 12µs | # spent 12µs within Devel::StackTrace::AsHTML::BEGIN@4 which was called:
# once (12µs+0s) by Plack::Middleware::StackTrace::BEGIN@6 at line 4 # spent 12µs making 1 call to Devel::StackTrace::AsHTML::BEGIN@4 |
| 5 | 1 | 400ns | our $VERSION = '0.14'; | ||
| 6 | |||||
| 7 | 2 | 130µs | 2 | 3.89ms | # spent 3.85ms (3.52+332µs) within Devel::StackTrace::AsHTML::BEGIN@7 which was called:
# once (3.52ms+332µs) by Plack::Middleware::StackTrace::BEGIN@6 at line 7 # spent 3.85ms making 1 call to Devel::StackTrace::AsHTML::BEGIN@7
# spent 40µs making 1 call to Exporter::import |
| 8 | 2 | 21µs | 1 | 5µs | # spent 5µs within Devel::StackTrace::AsHTML::BEGIN@8 which was called:
# once (5µs+0s) by Plack::Middleware::StackTrace::BEGIN@6 at line 8 # spent 5µs making 1 call to Devel::StackTrace::AsHTML::BEGIN@8 |
| 9 | 2 | 22µs | 2 | 36µs | # spent 21µs (6+15) within Devel::StackTrace::AsHTML::BEGIN@9 which was called:
# once (6µs+15µs) by Plack::Middleware::StackTrace::BEGIN@6 at line 9 # spent 21µs making 1 call to Devel::StackTrace::AsHTML::BEGIN@9
# spent 15µs making 1 call to Exporter::import |
| 10 | |||||
| 11 | 2 | 765µs | 2 | 29µs | # spent 18µs (8+11) within Devel::StackTrace::AsHTML::BEGIN@11 which was called:
# once (8µs+11µs) by Plack::Middleware::StackTrace::BEGIN@6 at line 11 # spent 18µs making 1 call to Devel::StackTrace::AsHTML::BEGIN@11
# spent 11µs making 1 call to warnings::unimport |
| 12 | 1 | 4µs | my %enc = qw( & & > > < < " " ' ' ); | ||
| 13 | |||||
| 14 | # NOTE: because we don't know which encoding $str is in, or even if | ||||
| 15 | # $str is a wide character (decoded strings), we just leave the low | ||||
| 16 | # bits, including latin-1 range and encode everything higher as HTML | ||||
| 17 | # entities. I know this is NOT always correct, but should mostly work | ||||
| 18 | # in case $str is encoded in utf-8 bytes or wide chars. This is a | ||||
| 19 | # necessary workaround since we're rendering someone else's code which | ||||
| 20 | # we can't enforce string encodings. | ||||
| 21 | |||||
| 22 | sub encode_html { | ||||
| 23 | my $str = shift; | ||||
| 24 | $str =~ s/([^\x00-\x21\x23-\x25\x28-\x3b\x3d\x3f-\xff])/$enc{$1} || '&#' . ord($1) . ';' /ge; | ||||
| 25 | utf8::downgrade($str); | ||||
| 26 | $str; | ||||
| 27 | } | ||||
| 28 | |||||
| 29 | sub Devel::StackTrace::as_html { | ||||
| 30 | __PACKAGE__->render(@_); | ||||
| 31 | } | ||||
| 32 | |||||
| 33 | sub render { | ||||
| 34 | my $class = shift; | ||||
| 35 | my $trace = shift; | ||||
| 36 | my %opt = @_; | ||||
| 37 | |||||
| 38 | my $msg = encode_html($trace->frame(0)->as_string(1)); | ||||
| 39 | my $out = qq{<!doctype html><head><title>Error: ${msg}</title>}; | ||||
| 40 | |||||
| 41 | $opt{style} ||= \<<STYLE; | ||||
| 42 | a.toggle { color: #444 } | ||||
| 43 | body { margin: 0; padding: 0; background: #fff; color: #000; } | ||||
| 44 | h1 { margin: 0 0 .5em; padding: .25em .5em .1em 1.5em; border-bottom: thick solid #002; background: #444; color: #eee; font-size: x-large; } | ||||
| 45 | pre.message { margin: .5em 1em; } | ||||
| 46 | li.frame { font-size: small; margin-top: 3em } | ||||
| 47 | li.frame:nth-child(1) { margin-top: 0 } | ||||
| 48 | pre.context { border: 1px solid #aaa; padding: 0.2em 0; background: #fff; color: #444; font-size: medium; } | ||||
| 49 | pre .match { color: #000;background-color: #f99; font-weight: bold } | ||||
| 50 | pre.vardump { margin:0 } | ||||
| 51 | pre code strong { color: #000; background: #f88; } | ||||
| 52 | |||||
| 53 | table.lexicals, table.arguments { border-collapse: collapse } | ||||
| 54 | table.lexicals td, table.arguments td { border: 1px solid #000; margin: 0; padding: .3em } | ||||
| 55 | table.lexicals tr:nth-child(2n) { background: #DDDDFF } | ||||
| 56 | table.arguments tr:nth-child(2n) { background: #DDFFDD } | ||||
| 57 | .lexicals, .arguments { display: none } | ||||
| 58 | .variable, .value { font-family: monospace; white-space: pre } | ||||
| 59 | td.variable { vertical-align: top } | ||||
| 60 | STYLE | ||||
| 61 | |||||
| 62 | if (ref $opt{style}) { | ||||
| 63 | $out .= qq(<style type="text/css">${$opt{style}}</style>); | ||||
| 64 | } else { | ||||
| 65 | $out .= qq(<link rel="stylesheet" type="text/css" href=") . encode_html($opt{style}) . q(" />); | ||||
| 66 | } | ||||
| 67 | |||||
| 68 | $out .= <<HEAD; | ||||
| 69 | <script language="JavaScript" type="text/javascript"> | ||||
| 70 | function toggleThing(ref, type, hideMsg, showMsg) { | ||||
| 71 | var css = document.getElementById(type+'-'+ref).style; | ||||
| 72 | css.display = css.display == 'block' ? 'none' : 'block'; | ||||
| 73 | |||||
| 74 | var hyperlink = document.getElementById('toggle-'+ref); | ||||
| 75 | hyperlink.textContent = css.display == 'block' ? hideMsg : showMsg; | ||||
| 76 | } | ||||
| 77 | |||||
| 78 | function toggleArguments(ref) { | ||||
| 79 | toggleThing(ref, 'arguments', 'Hide function arguments', 'Show function arguments'); | ||||
| 80 | } | ||||
| 81 | |||||
| 82 | function toggleLexicals(ref) { | ||||
| 83 | toggleThing(ref, 'lexicals', 'Hide lexical variables', 'Show lexical variables'); | ||||
| 84 | } | ||||
| 85 | </script> | ||||
| 86 | </head> | ||||
| 87 | <body> | ||||
| 88 | <h1>Error trace</h1><pre class="message">$msg</pre><ol> | ||||
| 89 | HEAD | ||||
| 90 | |||||
| 91 | my $i = 0; | ||||
| 92 | while (my $frame = $trace->next_frame) { | ||||
| 93 | $i++; | ||||
| 94 | my $next_frame = $trace->frame($i); # peek next | ||||
| 95 | $out .= join( | ||||
| 96 | '', | ||||
| 97 | '<li class="frame">', | ||||
| 98 | ($next_frame && $next_frame->subroutine) ? encode_html("in " . $next_frame->subroutine) : '', | ||||
| 99 | ' at ', | ||||
| 100 | $frame->filename ? encode_html($frame->filename) : '', | ||||
| 101 | ' line ', | ||||
| 102 | $frame->line, | ||||
| 103 | q(<pre class="context"><code>), | ||||
| 104 | _build_context($frame) || '', | ||||
| 105 | q(</code></pre>), | ||||
| 106 | _build_arguments($i, $next_frame), | ||||
| 107 | $frame->can('lexicals') ? _build_lexicals($i, $frame->lexicals) : '', | ||||
| 108 | q(</li>), | ||||
| 109 | ); | ||||
| 110 | } | ||||
| 111 | $out .= qq{</ol>}; | ||||
| 112 | $out .= "</body></html>"; | ||||
| 113 | |||||
| 114 | $out; | ||||
| 115 | } | ||||
| 116 | |||||
| 117 | my $dumper = sub { | ||||
| 118 | my $value = shift; | ||||
| 119 | $value = $$value if ref $value eq 'SCALAR' or ref $value eq 'REF'; | ||||
| 120 | my $d = Data::Dumper->new([ $value ]); | ||||
| 121 | $d->Indent(1)->Terse(1)->Deparse(1); | ||||
| 122 | chomp(my $dump = $d->Dump); | ||||
| 123 | $dump; | ||||
| 124 | 1 | 2µs | }; | ||
| 125 | |||||
| 126 | sub _build_arguments { | ||||
| 127 | my($id, $frame) = @_; | ||||
| 128 | my $ref = "arg-$id"; | ||||
| 129 | |||||
| 130 | return '' unless $frame && $frame->args; | ||||
| 131 | |||||
| 132 | my @args = $frame->args; | ||||
| 133 | |||||
| 134 | my $html = qq(<p><a class="toggle" id="toggle-$ref" href="javascript:toggleArguments('$ref')">Show function arguments</a></p><table class="arguments" id="arguments-$ref">); | ||||
| 135 | |||||
| 136 | # Don't use while each since Dumper confuses that | ||||
| 137 | for my $idx (0 .. @args - 1) { | ||||
| 138 | my $value = $args[$idx]; | ||||
| 139 | my $dump = $dumper->($value); | ||||
| 140 | $html .= qq{<tr>}; | ||||
| 141 | $html .= qq{<td class="variable">\$_[$idx]</td>}; | ||||
| 142 | $html .= qq{<td class="value">} . encode_html($dump) . qq{</td>}; | ||||
| 143 | $html .= qq{</tr>}; | ||||
| 144 | } | ||||
| 145 | $html .= qq(</table>); | ||||
| 146 | |||||
| 147 | return $html; | ||||
| 148 | } | ||||
| 149 | |||||
| 150 | sub _build_lexicals { | ||||
| 151 | my($id, $lexicals) = @_; | ||||
| 152 | my $ref = "lex-$id"; | ||||
| 153 | |||||
| 154 | return '' unless keys %$lexicals; | ||||
| 155 | |||||
| 156 | my $html = qq(<p><a class="toggle" id="toggle-$ref" href="javascript:toggleLexicals('$ref')">Show lexical variables</a></p><table class="lexicals" id="lexicals-$ref">); | ||||
| 157 | |||||
| 158 | # Don't use while each since Dumper confuses that | ||||
| 159 | for my $var (sort keys %$lexicals) { | ||||
| 160 | my $value = $lexicals->{$var}; | ||||
| 161 | my $dump = $dumper->($value); | ||||
| 162 | $dump =~ s/^\{(.*)\}$/($1)/s if $var =~ /^\%/; | ||||
| 163 | $dump =~ s/^\[(.*)\]$/($1)/s if $var =~ /^\@/; | ||||
| 164 | $html .= qq{<tr>}; | ||||
| 165 | $html .= qq{<td class="variable">} . encode_html($var) . qq{</td>}; | ||||
| 166 | $html .= qq{<td class="value">} . encode_html($dump) . qq{</td>}; | ||||
| 167 | $html .= qq{</tr>}; | ||||
| 168 | } | ||||
| 169 | $html .= qq(</table>); | ||||
| 170 | |||||
| 171 | return $html; | ||||
| 172 | } | ||||
| 173 | |||||
| 174 | sub _build_context { | ||||
| 175 | my $frame = shift; | ||||
| 176 | my $file = $frame->filename; | ||||
| 177 | my $linenum = $frame->line; | ||||
| 178 | my $code; | ||||
| 179 | if (-f $file) { | ||||
| 180 | my $start = $linenum - 3; | ||||
| 181 | my $end = $linenum + 3; | ||||
| 182 | $start = $start < 1 ? 1 : $start; | ||||
| 183 | open my $fh, '<', $file | ||||
| 184 | or die "cannot open $file:$!"; | ||||
| 185 | my $cur_line = 0; | ||||
| 186 | while (my $line = <$fh>) { | ||||
| 187 | ++$cur_line; | ||||
| 188 | last if $cur_line > $end; | ||||
| 189 | next if $cur_line < $start; | ||||
| 190 | $line =~ s|\t| |g; | ||||
| 191 | my @tag = $cur_line == $linenum | ||||
| 192 | ? (q{<strong class="match">}, '</strong>') | ||||
| 193 | : ('', ''); | ||||
| 194 | $code .= sprintf( | ||||
| 195 | '%s%5d: %s%s', $tag[0], $cur_line, encode_html($line), | ||||
| 196 | $tag[1], | ||||
| 197 | ); | ||||
| 198 | } | ||||
| 199 | close $file; | ||||
| 200 | } | ||||
| 201 | return $code; | ||||
| 202 | } | ||||
| 203 | |||||
| 204 | 1 | 4µs | 1; | ||
| 205 | __END__ |