← Index
NYTProf Performance Profile   « line view »
For script/ponapi
  Run on Wed Feb 10 15:51:26 2016
Reported on Thu Feb 11 09:43:11 2016

Filename/usr/local/share/perl/5.18.2/Devel/StackTrace/AsHTML.pm
StatementsExecuted 16 statements in 1.02ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1113.52ms3.85msDevel::StackTrace::AsHTML::::BEGIN@7Devel::StackTrace::AsHTML::BEGIN@7
11113µs26µsDevel::StackTrace::AsHTML::::BEGIN@3Devel::StackTrace::AsHTML::BEGIN@3
11112µs12µsDevel::StackTrace::AsHTML::::BEGIN@4Devel::StackTrace::AsHTML::BEGIN@4
1118µs18µsDevel::StackTrace::AsHTML::::BEGIN@11Devel::StackTrace::AsHTML::BEGIN@11
1116µs21µsDevel::StackTrace::AsHTML::::BEGIN@9Devel::StackTrace::AsHTML::BEGIN@9
1115µs5µsDevel::StackTrace::AsHTML::::BEGIN@8Devel::StackTrace::AsHTML::BEGIN@8
0000s0sDevel::StackTrace::AsHTML::::__ANON__[:124]Devel::StackTrace::AsHTML::__ANON__[:124]
0000s0sDevel::StackTrace::AsHTML::::_build_argumentsDevel::StackTrace::AsHTML::_build_arguments
0000s0sDevel::StackTrace::AsHTML::::_build_contextDevel::StackTrace::AsHTML::_build_context
0000s0sDevel::StackTrace::AsHTML::::_build_lexicalsDevel::StackTrace::AsHTML::_build_lexicals
0000s0sDevel::StackTrace::AsHTML::::encode_htmlDevel::StackTrace::AsHTML::encode_html
0000s0sDevel::StackTrace::AsHTML::::renderDevel::StackTrace::AsHTML::render
0000s0sDevel::StackTrace::::as_html Devel::StackTrace::as_html
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Devel::StackTrace::AsHTML;
2
3224µs239µ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
use strict;
# spent 26µs making 1 call to Devel::StackTrace::AsHTML::BEGIN@3 # spent 13µs making 1 call to strict::import
4247µs112µ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
use 5.008_001;
# spent 12µs making 1 call to Devel::StackTrace::AsHTML::BEGIN@4
51400nsour $VERSION = '0.14';
6
72130µs23.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
use Data::Dumper;
# spent 3.85ms making 1 call to Devel::StackTrace::AsHTML::BEGIN@7 # spent 40µs making 1 call to Exporter::import
8221µs15µ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
use Devel::StackTrace;
# spent 5µs making 1 call to Devel::StackTrace::AsHTML::BEGIN@8
9222µs236µ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
use Scalar::Util;
# spent 21µs making 1 call to Devel::StackTrace::AsHTML::BEGIN@9 # spent 15µs making 1 call to Exporter::import
10
112765µs229µ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
no warnings 'qw';
# spent 18µs making 1 call to Devel::StackTrace::AsHTML::BEGIN@11 # spent 11µs making 1 call to warnings::unimport
1214µsmy %enc = qw( & &amp; > &gt; < &lt; " &quot; ' &#39; );
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
22sub 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
29sub Devel::StackTrace::as_html {
30 __PACKAGE__->render(@_);
31}
32
33sub 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;
42a.toggle { color: #444 }
43body { margin: 0; padding: 0; background: #fff; color: #000; }
44h1 { margin: 0 0 .5em; padding: .25em .5em .1em 1.5em; border-bottom: thick solid #002; background: #444; color: #eee; font-size: x-large; }
45pre.message { margin: .5em 1em; }
46li.frame { font-size: small; margin-top: 3em }
47li.frame:nth-child(1) { margin-top: 0 }
48pre.context { border: 1px solid #aaa; padding: 0.2em 0; background: #fff; color: #444; font-size: medium; }
49pre .match { color: #000;background-color: #f99; font-weight: bold }
50pre.vardump { margin:0 }
51pre code strong { color: #000; background: #f88; }
52
53table.lexicals, table.arguments { border-collapse: collapse }
54table.lexicals td, table.arguments td { border: 1px solid #000; margin: 0; padding: .3em }
55table.lexicals tr:nth-child(2n) { background: #DDDDFF }
56table.arguments tr:nth-child(2n) { background: #DDFFDD }
57.lexicals, .arguments { display: none }
58.variable, .value { font-family: monospace; white-space: pre }
59td.variable { vertical-align: top }
60STYLE
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">
70function 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
78function toggleArguments(ref) {
79 toggleThing(ref, 'arguments', 'Hide function arguments', 'Show function arguments');
80}
81
82function 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>
89HEAD
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
117my $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;
12412µs};
125
126sub _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
150sub _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
174sub _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
20414µs1;
205__END__