← Index
NYTProf Performance Profile   « line view »
For ./view
  Run on Fri Jul 31 18:42:36 2015
Reported on Fri Jul 31 18:48:13 2015

Filename/var/www/foswikidev/core/lib/Foswiki/Configure/Reporter.pm
StatementsExecuted 13 statements in 1.51ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1114.81ms5.13msFoswiki::Configure::Reporter::::BEGIN@10Foswiki::Configure::Reporter::BEGIN@10
1112.61ms21.5msFoswiki::Configure::Reporter::::BEGIN@9Foswiki::Configure::Reporter::BEGIN@9
11116µs31µsFoswiki::Configure::Reporter::::BEGIN@4Foswiki::Configure::Reporter::BEGIN@4
11112µs49µsFoswiki::Configure::Reporter::::BEGIN@13Foswiki::Configure::Reporter::BEGIN@13
11111µs44µsFoswiki::Configure::Reporter::::BEGIN@7Foswiki::Configure::Reporter::BEGIN@7
11111µs16µsFoswiki::Configure::Reporter::::BEGIN@5Foswiki::Configure::Reporter::BEGIN@5
0000s0sFoswiki::Configure::Reporter::::CHANGEDFoswiki::Configure::Reporter::CHANGED
0000s0sFoswiki::Configure::Reporter::::ERRORFoswiki::Configure::Reporter::ERROR
0000s0sFoswiki::Configure::Reporter::::NOTEFoswiki::Configure::Reporter::NOTE
0000s0sFoswiki::Configure::Reporter::::WARNFoswiki::Configure::Reporter::WARN
0000s0sFoswiki::Configure::Reporter::::WIZARDFoswiki::Configure::Reporter::WIZARD
0000s0sFoswiki::Configure::Reporter::::changesFoswiki::Configure::Reporter::changes
0000s0sFoswiki::Configure::Reporter::::clearFoswiki::Configure::Reporter::clear
0000s0sFoswiki::Configure::Reporter::::ellipsisFoswiki::Configure::Reporter::ellipsis
0000s0sFoswiki::Configure::Reporter::::has_levelFoswiki::Configure::Reporter::has_level
0000s0sFoswiki::Configure::Reporter::::messagesFoswiki::Configure::Reporter::messages
0000s0sFoswiki::Configure::Reporter::::newFoswiki::Configure::Reporter::new
0000s0sFoswiki::Configure::Reporter::::stringifyFoswiki::Configure::Reporter::stringify
0000s0sFoswiki::Configure::Reporter::::stripStacktraceFoswiki::Configure::Reporter::stripStacktrace
0000s0sFoswiki::Configure::Reporter::::unevalFoswiki::Configure::Reporter::uneval
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1# See bottom of file for license and copyright information
2package Foswiki::Configure::Reporter;
3
4232µs247µs
# spent 31µs (16+16) within Foswiki::Configure::Reporter::BEGIN@4 which was called: # once (16µs+16µs) by Foswiki::Configure::FileUtil::BEGIN@19 at line 4
use strict;
# spent 31µs making 1 call to Foswiki::Configure::Reporter::BEGIN@4 # spent 16µs making 1 call to strict::import
5237µs221µs
# spent 16µs (11+5) within Foswiki::Configure::Reporter::BEGIN@5 which was called: # once (11µs+5µs) by Foswiki::Configure::FileUtil::BEGIN@19 at line 5
use warnings;
# spent 16µs making 1 call to Foswiki::Configure::Reporter::BEGIN@5 # spent 5µs making 1 call to warnings::import
6
7232µs277µs
# spent 44µs (11+33) within Foswiki::Configure::Reporter::BEGIN@7 which was called: # once (11µs+33µs) by Foswiki::Configure::FileUtil::BEGIN@19 at line 7
use Assert;
# spent 44µs making 1 call to Foswiki::Configure::Reporter::BEGIN@7 # spent 33µs making 1 call to Exporter::import
8
92134µs121.5ms
# spent 21.5ms (2.61+18.9) within Foswiki::Configure::Reporter::BEGIN@9 which was called: # once (2.61ms+18.9ms) by Foswiki::Configure::FileUtil::BEGIN@19 at line 9
use JSON ();
# spent 21.5ms making 1 call to Foswiki::Configure::Reporter::BEGIN@9
102137µs15.13ms
# spent 5.13ms (4.81+319µs) within Foswiki::Configure::Reporter::BEGIN@10 which was called: # once (4.81ms+319µs) by Foswiki::Configure::FileUtil::BEGIN@19 at line 10
use Data::Dumper ();
# spent 5.13ms making 1 call to Foswiki::Configure::Reporter::BEGIN@10
11
12# Number of levels of a stack trace to keep
1321.13ms287µs
# spent 49µs (12+38) within Foswiki::Configure::Reporter::BEGIN@13 which was called: # once (12µs+38µs) by Foswiki::Configure::FileUtil::BEGIN@19 at line 13
use constant KEEP_STACK_LEVELS => 0; #( (DEBUG) ? 2 : 0 );
# spent 49µs making 1 call to Foswiki::Configure::Reporter::BEGIN@13 # spent 38µs making 1 call to constant::import
14
15=begin TML
16
17---+ package Foswiki::Configure::Reporter
18
19Report package for configure, supporting text reporting and
20simple TML expansion to HTML.
21
22This class doesn't actually handle expansion of TML to anything else;
23it simply stores messages for processing by formatting back ends.
24However it is a sensible place to define the subset of TML that is expected
25to be supported by renderers.
26
27 * Single level of lists (* and 1)
28 * Blank line = paragraph break <p />
29 * > at start of line = <br> before and after
30 (i.e. line stands alone)
31 * Simple tables | like | this |
32 * Text styling e.g. <nop>*bold*, <nop>=code= etc
33 * URL links [<nop>[http://that][text description]]
34 * &lt;verbatim&gt;...&lt;/verbatim&gt;
35 * HTML types =button=, =select=, =option= and =textarea= are supported
36 for wizard inputs, if the renderer supports them. Non-interactive
37 renderers should ignore them.
38 * ---+++ Headings
39
40Each of the reporting methods (NOTE, WARN, ERROR) accepts any number of
41message parameters. These are treated as individual error messages, rather
42than being concatenated into a single message. \n can be used in any
43message, and it will survive into the final TML.
44
45Most renderers will assume an implicit > at the front of every WARN and
46ERROR message.
47
48=cut
49
50sub new {
51 my ($class) = @_;
52
53 my $this = bless( {}, $class );
54 $this->clear();
55 return $this;
56}
57
58=begin TML
59
60---++ ObjectMethod NOTE(@notes) -> $this
61
62Report one or more notes. Each parameter is handled as an independent
63message. Returns the reporter to allow chaining.
64
65=cut
66
67sub NOTE {
68 my $this = shift;
69 push( @{ $this->{messages} }, map { { level => 'notes', text => $_ } } @_ );
70 return $this;
71}
72
73=begin TML
74
75---++ ObjectMethod WARN(@warnings)
76
77Report one or more warnings. Each parameter is handled as an independent
78message. Returns the reporter to allow chaining.
79
80=cut
81
82sub WARN {
83 my $this = shift;
84 push(
85 @{ $this->{messages} },
86 map { { level => 'warnings', text => $_ } } @_
87 );
88}
89
90=begin TML
91
92---++ ObjectMethod ERROR(@errors) -> $this
93
94Report one or more errors. Each parameter is handled as an independent
95message. Returns the reporter to allow chaining.
96
97=cut
98
99sub ERROR {
100 my $this = shift;
101 push( @{ $this->{messages} },
102 map { { level => 'errors', text => $_ } } @_ );
103 return $this;
104}
105
106=begin TML
107
108---++ ObjectMethod CHANGED($keys) -> $this
109
110Report that a =Foswiki::cfg= entry has changed. The new value will
111be taken from the current value in =$Foswiki::cfg= at the time of
112the call to CHANGED.
113
114Example: =$reporter->CHANGED('{Email}{Method}')=
115
116Returns the reporter to allow chaining.
117
118=cut
119
120sub CHANGED {
121 my ( $this, $keys ) = @_;
122 $this->{changes}->{$keys} = uneval( eval("\$Foswiki::cfg$keys") );
123 return $this;
124}
125
126=begin TML
127
128---++ ObjectMethod WIZARD($label, $data) -> $note
129
130Generate a wizard button suitable for adding to the stream.
131This should return '' if the reporter does not support wizards.
132The default is to create an HTML button.
133
134Caller is expected to add the result to the reporter stream using
135NOTE etc.
136
137=cut
138
139sub WIZARD {
140 my ( $this, $label, $data ) = @_;
141 my $json = JSON->new->encode($data);
142 $json =~ s/"/&quot;/g;
143 return
144 "<button class=\"wizard_button\" data-wizard=\"$json\">$label</button>";
145}
146
147=begin TML
148
149---++ ObjectMethod has_level( $level ) -> $boolean
150
151Return true if the reporter has seen at least one $level message, where
152$level is one of notes, warnings or errors.
153
154=cut
155
156sub has_level {
157 my ( $this, $level ) = @_;
158 foreach my $m ( @{ $this->{messages} } ) {
159 return 1 if ( $m->{level} eq $level );
160 }
161 return 0;
162}
163
164=begin TML
165
166---++ ObjectMethod clear() -> $this
167
168Clear all contents from the reporter.
169Returns the reporter to allow chaining.
170
171=cut
172
173sub clear {
174 my $this = shift;
175 $this->{messages} = [];
176 $this->{changes} = {};
177 return $this;
178}
179
180=begin TML
181
182---++ ObjectMethod messages() -> \@messages
183
184Get the content of the reporter. @messages is an ordered array of hashes,
185each of which has fields:
186 * level: one of errors, warnings, notes
187 * text: text of the message
188Each message corresponds to a single parameter to one of the ERROR,
189WARN or NOTES methods.
190
191=cut
192
193sub messages {
194 my ($this) = @_;
195
196 return $this->{messages};
197}
198
199=begin TML
200
201---++ ObjectMethod changes() -> \%changes
202
203Get the content of the reporter. %changes is a hash mapping a key
204to a (new) value. Each entry corresponds to a call to the CHANGED
205method (though multiple calls to CHANGED with the same keys will
206only result in one entry).
207
208=cut
209
210sub changes {
211 my ($this) = @_;
212
213 return $this->{changes};
214}
215
216=begin TML
217
218---++ ObjectMethod stringify(@levels) -> $text
219
220Used for debugging, simply generates a plain text string from the
221content of the reporter.
222 * =@levels= optional list of levels to report (default is all levels)
223 from notes, warnings, errors, changes
224=cut
225
226sub stringify {
227 my ( $this, @levels ) = @_;
228
229 my $all_levels;
230 my $many_levels;
231 my %l;
232 if ( scalar(@levels) ) {
233 %l = map { $_ => 1 } @levels;
234 $all_levels = 0;
235 $many_levels = ( scalar(@levels) > 1 );
236 }
237 else {
238 $all_levels = 1;
239 $many_levels = 1;
240 }
241 my @report;
242
243 push(
244 @report,
245 map {
246 (
247 $many_levels
248 ? ( uc( substr( $_->{level}, 0, -1 ) ) . ': ' )
249 : ''
250 )
251 . $_->{text}
252 }
253 grep { $all_levels || $l{ $_->{level} } } @{ $this->messages() }
254 );
255
256 if ( $all_levels || $l{changes} ) {
257 push(
258 @report,
259 map {
260 ( $many_levels ? 'CHANGE: ' : '' ) . "$_ = "
261 . (
262 defined $this->changes()->{$_}
263 ? $this->changes()->{$_}
264 : 'undef'
265 )
266 } keys %{ $this->changes() }
267 );
268 }
269 return '' unless scalar(@report);
270 return join( "\n", @report ) . "\n";
271}
272
273=begin TML
274
275---++ StaticMethod uneval($datum [, $indent]) -> $string
276
277Serialise the perl datum $datum as a perl string that can be
278evalled to recover the original value.
279
280$indent can be used to override the default setting (0) for
281$Data::Dumper::Indent. See perldoc Data::Dumper for more information.
282
283=cut
284
285# THIS IS NOT THE SAME AS Foswiki::Configure::Value::encodeValue.
286# This function is returning a *perl expression* which, when evaled,
287# will yield the correct value, and doesn't need any type information.
288#
289# encodeValue generates a string that can be passed back to
290# a UI and then recycled back as a new value. As such the resultant
291# value requires type information to be correctly interpreted.
292#
293sub uneval {
294 my ( $datum, $indent ) = @_;
295 if ( ref($datum) eq 'Regexp' ) {
296
297 # Convert to string
298 $datum = "$datum";
299
300 # Strip off useless furniture (?^: ... )
301 $datum =~ s/^\(\?\^:(.*)\)$/$1/;
302 $datum =~ s{'}{\\'}g;
303 return "'$datum'";
304 }
305 local $Data::Dumper::Sortkeys = 1;
306 local $Data::Dumper::Terse = 1;
307 local $Data::Dumper::Indent = $indent || 0;
308 $datum = Data::Dumper->Dump( [$datum] );
309 $datum =~ s/;\s*$//s;
310 if ( $datum =~ s/^(\$VAR\d+\s*=\s*)//s ) {
311 my $sp = ' ' x length($1);
312 $datum =~ s/^$sp//g;
313 }
314 return $datum;
315}
316
317=begin TML
318
319---++ StaticMethod ellipsis($string, $limit) -> $string
320
321If $string exceeds $limit in length, truncate the string to
322$limit-3 characters and append ellipsis (...)
323
324=cut
325
326sub ellipsis {
327 my ( $string, $limit ) = @_;
328 if ( length($string) > $limit - 3 ) {
329 $string = substr( $string, 0, $limit - 3 ) . '...';
330 }
331 return $string;
332}
333
334=begin TML
335
336---++ StaticMethod stripStacktrace($stacktrace) -> $message
337
338Strip traceback from die and carp for a user message
339
340=cut
341
342sub stripStacktrace {
343 my ($message) = @_;
344
345 return '' unless ( length $message );
346
347 print STDERR $message;
348
349 my @lines = split( /\n/, $message );
350 splice( @lines, KEEP_STACK_LEVELS + 1 );
351 return join(
352 "\n",
353 map {
354 $_ =~ s/ at .*? line \d+\.?$//;
355 $_;
356 } @lines
357 );
358}
359
36013µs1;
361__END__