Filename | /var/www/foswikidev/core/lib/Foswiki/Configure/Reporter.pm |
Statements | Executed 13 statements in 1.51ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 4.81ms | 5.13ms | BEGIN@10 | Foswiki::Configure::Reporter::
1 | 1 | 1 | 2.61ms | 21.5ms | BEGIN@9 | Foswiki::Configure::Reporter::
1 | 1 | 1 | 16µs | 31µs | BEGIN@4 | Foswiki::Configure::Reporter::
1 | 1 | 1 | 12µs | 49µs | BEGIN@13 | Foswiki::Configure::Reporter::
1 | 1 | 1 | 11µs | 44µs | BEGIN@7 | Foswiki::Configure::Reporter::
1 | 1 | 1 | 11µs | 16µs | BEGIN@5 | Foswiki::Configure::Reporter::
0 | 0 | 0 | 0s | 0s | CHANGED | Foswiki::Configure::Reporter::
0 | 0 | 0 | 0s | 0s | ERROR | Foswiki::Configure::Reporter::
0 | 0 | 0 | 0s | 0s | NOTE | Foswiki::Configure::Reporter::
0 | 0 | 0 | 0s | 0s | WARN | Foswiki::Configure::Reporter::
0 | 0 | 0 | 0s | 0s | WIZARD | Foswiki::Configure::Reporter::
0 | 0 | 0 | 0s | 0s | changes | Foswiki::Configure::Reporter::
0 | 0 | 0 | 0s | 0s | clear | Foswiki::Configure::Reporter::
0 | 0 | 0 | 0s | 0s | ellipsis | Foswiki::Configure::Reporter::
0 | 0 | 0 | 0s | 0s | has_level | Foswiki::Configure::Reporter::
0 | 0 | 0 | 0s | 0s | messages | Foswiki::Configure::Reporter::
0 | 0 | 0 | 0s | 0s | new | Foswiki::Configure::Reporter::
0 | 0 | 0 | 0s | 0s | stringify | Foswiki::Configure::Reporter::
0 | 0 | 0 | 0s | 0s | stripStacktrace | Foswiki::Configure::Reporter::
0 | 0 | 0 | 0s | 0s | uneval | Foswiki::Configure::Reporter::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | # See bottom of file for license and copyright information | ||||
2 | package Foswiki::Configure::Reporter; | ||||
3 | |||||
4 | 2 | 32µs | 2 | 47µ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 # spent 31µs making 1 call to Foswiki::Configure::Reporter::BEGIN@4
# spent 16µs making 1 call to strict::import |
5 | 2 | 37µs | 2 | 21µ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 # spent 16µs making 1 call to Foswiki::Configure::Reporter::BEGIN@5
# spent 5µs making 1 call to warnings::import |
6 | |||||
7 | 2 | 32µs | 2 | 77µ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 # spent 44µs making 1 call to Foswiki::Configure::Reporter::BEGIN@7
# spent 33µs making 1 call to Exporter::import |
8 | |||||
9 | 2 | 134µs | 1 | 21.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 # spent 21.5ms making 1 call to Foswiki::Configure::Reporter::BEGIN@9 |
10 | 2 | 137µs | 1 | 5.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 # spent 5.13ms making 1 call to Foswiki::Configure::Reporter::BEGIN@10 |
11 | |||||
12 | # Number of levels of a stack trace to keep | ||||
13 | 2 | 1.13ms | 2 | 87µ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 # 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 | |||||
19 | Report package for configure, supporting text reporting and | ||||
20 | simple TML expansion to HTML. | ||||
21 | |||||
22 | This class doesn't actually handle expansion of TML to anything else; | ||||
23 | it simply stores messages for processing by formatting back ends. | ||||
24 | However it is a sensible place to define the subset of TML that is expected | ||||
25 | to 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 | * <verbatim>...</verbatim> | ||||
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 | |||||
40 | Each of the reporting methods (NOTE, WARN, ERROR) accepts any number of | ||||
41 | message parameters. These are treated as individual error messages, rather | ||||
42 | than being concatenated into a single message. \n can be used in any | ||||
43 | message, and it will survive into the final TML. | ||||
44 | |||||
45 | Most renderers will assume an implicit > at the front of every WARN and | ||||
46 | ERROR message. | ||||
47 | |||||
48 | =cut | ||||
49 | |||||
50 | sub 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 | |||||
62 | Report one or more notes. Each parameter is handled as an independent | ||||
63 | message. Returns the reporter to allow chaining. | ||||
64 | |||||
65 | =cut | ||||
66 | |||||
67 | sub 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 | |||||
77 | Report one or more warnings. Each parameter is handled as an independent | ||||
78 | message. Returns the reporter to allow chaining. | ||||
79 | |||||
80 | =cut | ||||
81 | |||||
82 | sub 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 | |||||
94 | Report one or more errors. Each parameter is handled as an independent | ||||
95 | message. Returns the reporter to allow chaining. | ||||
96 | |||||
97 | =cut | ||||
98 | |||||
99 | sub 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 | |||||
110 | Report that a =Foswiki::cfg= entry has changed. The new value will | ||||
111 | be taken from the current value in =$Foswiki::cfg= at the time of | ||||
112 | the call to CHANGED. | ||||
113 | |||||
114 | Example: =$reporter->CHANGED('{Email}{Method}')= | ||||
115 | |||||
116 | Returns the reporter to allow chaining. | ||||
117 | |||||
118 | =cut | ||||
119 | |||||
120 | sub 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 | |||||
130 | Generate a wizard button suitable for adding to the stream. | ||||
131 | This should return '' if the reporter does not support wizards. | ||||
132 | The default is to create an HTML button. | ||||
133 | |||||
134 | Caller is expected to add the result to the reporter stream using | ||||
135 | NOTE etc. | ||||
136 | |||||
137 | =cut | ||||
138 | |||||
139 | sub WIZARD { | ||||
140 | my ( $this, $label, $data ) = @_; | ||||
141 | my $json = JSON->new->encode($data); | ||||
142 | $json =~ s/"/"/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 | |||||
151 | Return 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 | |||||
156 | sub 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 | |||||
168 | Clear all contents from the reporter. | ||||
169 | Returns the reporter to allow chaining. | ||||
170 | |||||
171 | =cut | ||||
172 | |||||
173 | sub 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 | |||||
184 | Get the content of the reporter. @messages is an ordered array of hashes, | ||||
185 | each of which has fields: | ||||
186 | * level: one of errors, warnings, notes | ||||
187 | * text: text of the message | ||||
188 | Each message corresponds to a single parameter to one of the ERROR, | ||||
189 | WARN or NOTES methods. | ||||
190 | |||||
191 | =cut | ||||
192 | |||||
193 | sub messages { | ||||
194 | my ($this) = @_; | ||||
195 | |||||
196 | return $this->{messages}; | ||||
197 | } | ||||
198 | |||||
199 | =begin TML | ||||
200 | |||||
201 | ---++ ObjectMethod changes() -> \%changes | ||||
202 | |||||
203 | Get the content of the reporter. %changes is a hash mapping a key | ||||
204 | to a (new) value. Each entry corresponds to a call to the CHANGED | ||||
205 | method (though multiple calls to CHANGED with the same keys will | ||||
206 | only result in one entry). | ||||
207 | |||||
208 | =cut | ||||
209 | |||||
210 | sub changes { | ||||
211 | my ($this) = @_; | ||||
212 | |||||
213 | return $this->{changes}; | ||||
214 | } | ||||
215 | |||||
216 | =begin TML | ||||
217 | |||||
218 | ---++ ObjectMethod stringify(@levels) -> $text | ||||
219 | |||||
220 | Used for debugging, simply generates a plain text string from the | ||||
221 | content of the reporter. | ||||
222 | * =@levels= optional list of levels to report (default is all levels) | ||||
223 | from notes, warnings, errors, changes | ||||
224 | =cut | ||||
225 | |||||
226 | sub 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 | |||||
277 | Serialise the perl datum $datum as a perl string that can be | ||||
278 | evalled 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 | # | ||||
293 | sub 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 | |||||
321 | If $string exceeds $limit in length, truncate the string to | ||||
322 | $limit-3 characters and append ellipsis (...) | ||||
323 | |||||
324 | =cut | ||||
325 | |||||
326 | sub 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 | |||||
338 | Strip traceback from die and carp for a user message | ||||
339 | |||||
340 | =cut | ||||
341 | |||||
342 | sub 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 | |||||
360 | 1 | 3µs | 1; | ||
361 | __END__ |