Profile of Devel/StackTrace/AsHTML.pm

← 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
Statements | Executed 16 statements in 1.02ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 3.52ms | 3.85ms | Devel::StackTrace::AsHTML::::BEGIN@7Devel::StackTrace::AsHTML::BEGIN@7
1 | 1 | 1 | 13µs | 26µs | Devel::StackTrace::AsHTML::::BEGIN@3Devel::StackTrace::AsHTML::BEGIN@3
1 | 1 | 1 | 12µs | 12µs | Devel::StackTrace::AsHTML::::BEGIN@4Devel::StackTrace::AsHTML::BEGIN@4
1 | 1 | 1 | 8µs | 18µs | Devel::StackTrace::AsHTML::::BEGIN@11Devel::StackTrace::AsHTML::BEGIN@11
1 | 1 | 1 | 6µs | 21µs | Devel::StackTrace::AsHTML::::BEGIN@9Devel::StackTrace::AsHTML::BEGIN@9
1 | 1 | 1 | 5µs | 5µs | Devel::StackTrace::AsHTML::::BEGIN@8Devel::StackTrace::AsHTML::BEGIN@8
0 | 0 | 0 | 0s | 0s | Devel::StackTrace::AsHTML::::__ANON__[:124]Devel::StackTrace::AsHTML::__ANON__[:124]
0 | 0 | 0 | 0s | 0s | Devel::StackTrace::AsHTML::::_build_argumentsDevel::StackTrace::AsHTML::_build_arguments
0 | 0 | 0 | 0s | 0s | Devel::StackTrace::AsHTML::::_build_contextDevel::StackTrace::AsHTML::_build_context
0 | 0 | 0 | 0s | 0s | Devel::StackTrace::AsHTML::::_build_lexicalsDevel::StackTrace::AsHTML::_build_lexicals
0 | 0 | 0 | 0s | 0s | Devel::StackTrace::AsHTML::::encode_htmlDevel::StackTrace::AsHTML::encode_html
0 | 0 | 0 | 0s | 0s | Devel::StackTrace::AsHTML::::renderDevel::StackTrace::AsHTML::render
0 | 0 | 0 | 0s | 0s | Devel::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
--- | --- | --- | --- | --- | ---
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 use strict; # 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 use 5.008_001; # 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 use Data::Dumper; # 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 use Devel::StackTrace; # 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 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 |  |  |  |  |
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 no warnings 'qw'; # 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( & &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 |  |  |  |  |
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__