Filename | /var/www/foswikidev/core/lib/Foswiki/Configure/Item.pm |
Statements | Executed 9 statements in 1.39ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 12µs | 24µs | BEGIN@27 | Foswiki::Configure::Item::
1 | 1 | 1 | 8µs | 12µs | BEGIN@28 | Foswiki::Configure::Item::
1 | 1 | 1 | 8µs | 46µs | BEGIN@33 | Foswiki::Configure::Item::
1 | 1 | 1 | 4µs | 4µs | BEGIN@30 | Foswiki::Configure::Item::
0 | 0 | 0 | 0s | 0s | DESTROY | Foswiki::Configure::Item::
0 | 0 | 0 | 0s | 0s | TO_JSON | Foswiki::Configure::Item::
0 | 0 | 0 | 0s | 0s | _matches | Foswiki::Configure::Item::
0 | 0 | 0 | 0s | 0s | _parseOptions | Foswiki::Configure::Item::
0 | 0 | 0 | 0s | 0s | append | Foswiki::Configure::Item::
0 | 0 | 0 | 0s | 0s | clear | Foswiki::Configure::Item::
0 | 0 | 0 | 0s | 0s | find | Foswiki::Configure::Item::
0 | 0 | 0 | 0s | 0s | find_also_dependencies | Foswiki::Configure::Item::
0 | 0 | 0 | 0s | 0s | getAllValueKeys | Foswiki::Configure::Item::
0 | 0 | 0 | 0s | 0s | getPath | Foswiki::Configure::Item::
0 | 0 | 0 | 0s | 0s | getSectionObject | Foswiki::Configure::Item::
0 | 0 | 0 | 0s | 0s | getValueObject | Foswiki::Configure::Item::
0 | 0 | 0 | 0s | 0s | hasDeep | Foswiki::Configure::Item::
0 | 0 | 0 | 0s | 0s | new | Foswiki::Configure::Item::
0 | 0 | 0 | 0s | 0s | parseTypeParams | Foswiki::Configure::Item::
0 | 0 | 0 | 0s | 0s | promoteSetting | Foswiki::Configure::Item::
0 | 0 | 0 | 0s | 0s | prune | Foswiki::Configure::Item::
0 | 0 | 0 | 0s | 0s | search | Foswiki::Configure::Item::
0 | 0 | 0 | 0s | 0s | set | Foswiki::Configure::Item::
0 | 0 | 0 | 0s | 0s | stringify | Foswiki::Configure::Item::
0 | 0 | 0 | 0s | 0s | unparent | Foswiki::Configure::Item::
0 | 0 | 0 | 0s | 0s | visit | Foswiki::Configure::Item::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | # See bottom of file for license and copyright information | ||||
2 | |||||
3 | =begin TML | ||||
4 | |||||
5 | ---++ package Foswiki::Configure::Item | ||||
6 | |||||
7 | Abstract base class of all nodes in a configuration spec tree. | ||||
8 | Item is the base class for all of Section (collection) Value (an | ||||
9 | individual value). | ||||
10 | |||||
11 | Objects of this class are intended to form a tree with references in | ||||
12 | both directions, circular references ahead. | ||||
13 | |||||
14 | IMPORTANT: there are some naming conventions for fields that apply to | ||||
15 | all subclasses of this class: | ||||
16 | * All internal attributes of this class are named [a-z][a-z_]* | ||||
17 | i.e. lowercase alphabetic | ||||
18 | * All internal attributes *that must not be serialised* (such as | ||||
19 | tree pointers) are named _[a-z][a-z_]* i.e. with a | ||||
20 | leading underscore. | ||||
21 | * All attributes read dynamically from the .spec must be [A-Z][A-Z_]+ | ||||
22 | |||||
23 | =cut | ||||
24 | |||||
25 | package Foswiki::Configure::Item; | ||||
26 | |||||
27 | 2 | 26µs | 2 | 36µs | # spent 24µs (12+12) within Foswiki::Configure::Item::BEGIN@27 which was called:
# once (12µs+12µs) by Foswiki::Configure::Section::BEGIN@19 at line 27 # spent 24µs making 1 call to Foswiki::Configure::Item::BEGIN@27
# spent 12µs making 1 call to strict::import |
28 | 2 | 24µs | 2 | 16µs | # spent 12µs (8+4) within Foswiki::Configure::Item::BEGIN@28 which was called:
# once (8µs+4µs) by Foswiki::Configure::Section::BEGIN@19 at line 28 # spent 12µs making 1 call to Foswiki::Configure::Item::BEGIN@28
# spent 4µs making 1 call to warnings::import |
29 | |||||
30 | 2 | 31µs | 1 | 4µs | # spent 4µs within Foswiki::Configure::Item::BEGIN@30 which was called:
# once (4µs+0s) by Foswiki::Configure::Section::BEGIN@19 at line 30 # spent 4µs making 1 call to Foswiki::Configure::Item::BEGIN@30 |
31 | |||||
32 | # Schema for dynamic attributes | ||||
33 | 2 | 1.30ms | 2 | 84µs | # spent 46µs (8+38) within Foswiki::Configure::Item::BEGIN@33 which was called:
# once (8µs+38µs) by Foswiki::Configure::Section::BEGIN@19 at line 33 # spent 46µs making 1 call to Foswiki::Configure::Item::BEGIN@33
# spent 38µs making 1 call to constant::import |
34 | |||||
35 | sub new { | ||||
36 | my ( $class, @opts ) = @_; | ||||
37 | |||||
38 | my $this = bless( | ||||
39 | { | ||||
40 | _parent => undef, | ||||
41 | depth => 0, | ||||
42 | |||||
43 | # Serialisable attribtes | ||||
44 | desc => '', | ||||
45 | defined_at => undef # where it is defined [ "file", line ] | ||||
46 | }, | ||||
47 | $class | ||||
48 | ); | ||||
49 | |||||
50 | $this->set(@opts); | ||||
51 | |||||
52 | return $this; | ||||
53 | } | ||||
54 | |||||
55 | sub stringify { | ||||
56 | my $this = shift; | ||||
57 | my $s = Data::Dumper->Dump( [ $this->TO_JSON() ] ); | ||||
58 | $s =~ s/^.*?= //; | ||||
59 | return $s; | ||||
60 | } | ||||
61 | |||||
62 | sub DESTROY { | ||||
63 | my $this = shift; | ||||
64 | |||||
65 | # Clear dynamic attributes | ||||
66 | foreach my $field ( keys %{ $this->{ATTRSPEC} } ) { | ||||
67 | undef $this->{$field}; | ||||
68 | } | ||||
69 | |||||
70 | # Undef unserialisable internals | ||||
71 | map { undef $this->{$_} } grep { /^__/ } keys %$this; | ||||
72 | } | ||||
73 | |||||
74 | =begin TML | ||||
75 | |||||
76 | ---++ ObjectMethod set(@what) / set(%what) | ||||
77 | * =@what= array of key-value pairs for attributes to set e.g. | ||||
78 | set(typename=> 'BLAH'). The array may be interpreted as a hash, | ||||
79 | so must be even-sized. | ||||
80 | Add options. The default implementation supports setting keys directly, | ||||
81 | and also supports a special 'opts' key, which defines a string that is | ||||
82 | parsed according to the .spec standard for options. | ||||
83 | Subclasses define ATTRSPEC to declare attribute types valid for the | ||||
84 | entity, used while parsing this string. | ||||
85 | |||||
86 | Note that all internal fields of this class use a leading underscore | ||||
87 | naming convention, while all dynamically-read attributes are all | ||||
88 | upper case with no leading underscore. | ||||
89 | |||||
90 | Note that the global $RAW_VALS=1 will | ||||
91 | supress calling of the parsers responsible to expanding attribute | ||||
92 | values. | ||||
93 | |||||
94 | When the same option is set twice in the parameters, the *second* | ||||
95 | value will take precedence. This allows the caller to declare defaults | ||||
96 | early in the list before appending options from other sources. | ||||
97 | |||||
98 | =cut | ||||
99 | |||||
100 | sub set { | ||||
101 | my ( $this, @params ) = @_; | ||||
102 | |||||
103 | while ( my $k = shift(@params) ) { | ||||
104 | die "Uneven sized options hash " . join( ' ', caller ) | ||||
105 | unless scalar(@params); | ||||
106 | my $v = shift @params; | ||||
107 | if ( $k eq 'opts' ) { | ||||
108 | $this->_parseOptions($v); | ||||
109 | } | ||||
110 | else { | ||||
111 | $this->{$k} = $v; | ||||
112 | } | ||||
113 | } | ||||
114 | } | ||||
115 | |||||
116 | # Implemented by subclasses to perform type-specific attribute parsing | ||||
117 | sub parseTypeParams { | ||||
118 | my ( $this, $str ) = @_; | ||||
119 | return $str; | ||||
120 | } | ||||
121 | |||||
122 | sub _parseOptions { | ||||
123 | my ( $this, $str, %controls ) = @_; | ||||
124 | |||||
125 | # Parcel out defaults | ||||
126 | while ( my ( $attr, $spec ) = each %{ $this->ATTRSPEC } ) { | ||||
127 | next unless ref($spec); | ||||
128 | if ( !defined $this->{$attr} && defined $spec->{default} ) { | ||||
129 | if ( ref $spec->{default} eq 'ARRAY' ) { | ||||
130 | @{ $this->{$attr} } = @{ $spec->{default} }; | ||||
131 | } | ||||
132 | elsif ( ref $spec->{default} eq 'HASH' ) { | ||||
133 | %{ $this->{$attr} } = %{ $spec->{default} }; | ||||
134 | } | ||||
135 | else { | ||||
136 | $this->{$attr} = $spec->{default}; | ||||
137 | } | ||||
138 | } | ||||
139 | } | ||||
140 | |||||
141 | # A couple of special cases, specific to Values | ||||
142 | $str = $this->parseTypeParams($str); | ||||
143 | |||||
144 | # Parse the options | ||||
145 | while ( $str =~ s/^\s*([A-Za-z0-9_]+)// ) { | ||||
146 | |||||
147 | my $key = $1; | ||||
148 | my $spec = $this->ATTRSPEC; | ||||
149 | my $remove = 0; | ||||
150 | if ( $key =~ s/^NO// ) { | ||||
151 | $remove = 1; | ||||
152 | } | ||||
153 | if ( $spec && defined $spec->{$key} && !ref( $spec->{$key} ) ) { | ||||
154 | |||||
155 | # Rename single-character keys | ||||
156 | $key = $spec->{$key}; | ||||
157 | } | ||||
158 | $spec = $spec->{$key}; | ||||
159 | |||||
160 | die "Bad option '$key' in .spec before $str" unless $spec; | ||||
161 | my $val; | ||||
162 | if ( $str =~ s/^\s*=// ) { | ||||
163 | if ( $str =~ s/^\s*(["'])(.*?[^\\])\1// ) { | ||||
164 | |||||
165 | # =string | ||||
166 | $val = $2; | ||||
167 | } | ||||
168 | elsif ( $str =~ s/^\s*([A-Z0-9]+)// ) { | ||||
169 | |||||
170 | # =keyword or number | ||||
171 | $val = $1; | ||||
172 | } | ||||
173 | else { | ||||
174 | die "Parse error when reading .spec options at $key=$str"; | ||||
175 | } | ||||
176 | } | ||||
177 | elsif ( $spec->{openclose} ) { | ||||
178 | $str =~ s/^(.*?)(\/$key|$)//; | ||||
179 | $val = $1; | ||||
180 | } | ||||
181 | else { | ||||
182 | $val = 1; | ||||
183 | } | ||||
184 | if ($remove) { | ||||
185 | delete $this->{$key}; | ||||
186 | $val = undef; | ||||
187 | } | ||||
188 | |||||
189 | if ( defined $spec->{handler} | ||||
190 | && !$Foswiki::Configure::LoadSpec::RAW_VALS ) | ||||
191 | { | ||||
192 | my $fn = $spec->{handler}; | ||||
193 | $this->{key} = $this->$fn( $val, $key ); | ||||
194 | } | ||||
195 | else { | ||||
196 | $this->{$key} = $val; | ||||
197 | } | ||||
198 | } | ||||
199 | die "Parse failed at $str" unless $str =~ m/^\s*$/; | ||||
200 | } | ||||
201 | |||||
202 | =begin TML | ||||
203 | |||||
204 | ---++ ObjectMethod clear(%what) | ||||
205 | Delete attributes set by =set=. | ||||
206 | |||||
207 | =cut | ||||
208 | |||||
209 | sub clear { | ||||
210 | my $this = shift; | ||||
211 | return unless (@_); | ||||
212 | |||||
213 | delete @{$this}{@_}; | ||||
214 | } | ||||
215 | |||||
216 | =begin TML | ||||
217 | |||||
218 | ---++ ObjectMethod append($key, $str) | ||||
219 | |||||
220 | Concatenate $str to the string value of $key. | ||||
221 | |||||
222 | =cut | ||||
223 | |||||
224 | sub append { | ||||
225 | my ( $this, $key, $str ) = @_; | ||||
226 | |||||
227 | if ( $this->{$key} ) { | ||||
228 | $this->{$key} .= "\n$str"; | ||||
229 | } | ||||
230 | else { | ||||
231 | $this->{$key} .= $str; | ||||
232 | } | ||||
233 | } | ||||
234 | |||||
235 | =begin TML | ||||
236 | |||||
237 | ---++ ObjectMethod hasDeep($attrname) -> $boolean | ||||
238 | |||||
239 | Determine if this item (or any sub-item if this is a collection) | ||||
240 | has the given boolean attribute | ||||
241 | |||||
242 | =cut | ||||
243 | |||||
244 | sub hasDeep { | ||||
245 | my ( $this, $attrname ) = @_; | ||||
246 | return $this->{$attrname}; | ||||
247 | } | ||||
248 | |||||
249 | =begin TML | ||||
250 | |||||
251 | ---++ ObjectMethod getAllValueKeys() -> @list | ||||
252 | |||||
253 | Return a list of all the keys for value objects under this node. | ||||
254 | |||||
255 | =cut | ||||
256 | |||||
257 | sub getAllValueKeys { | ||||
258 | my $this = shift; | ||||
259 | |||||
260 | return (); | ||||
261 | } | ||||
262 | |||||
263 | =begin TML | ||||
264 | |||||
265 | ---++ ObjectMethod find_also_dependencies([$root]) | ||||
266 | |||||
267 | Find 'also' dependencies by scanning values. | ||||
268 | |||||
269 | 'also' dependencies are checker dependencies that are inferred from the | ||||
270 | values of DISPLAY_IF and ENABLE_IF attributes. Some 'also' dependencies | ||||
271 | may 'also' be explicitly declared in the CHECK clause of an item. | ||||
272 | |||||
273 | 'also' dependencies are used to trigger checks of other items when the | ||||
274 | value of an item they depend on changes. | ||||
275 | |||||
276 | * =$root= - root used to getValueObject for keys found | ||||
277 | |||||
278 | =cut | ||||
279 | |||||
280 | sub find_also_dependencies { | ||||
281 | my ( $this, $root ) = @_; | ||||
282 | die 'Subclasses must define this method'; | ||||
283 | } | ||||
284 | |||||
285 | =begin TML | ||||
286 | |||||
287 | ---++ ObjectMethod getPath() -> @list | ||||
288 | |||||
289 | Get the path down to a configuration item. The path is a list of | ||||
290 | titles (headlines and keys). | ||||
291 | |||||
292 | =cut | ||||
293 | |||||
294 | sub getPath { | ||||
295 | my $this = shift; | ||||
296 | my @path = (); | ||||
297 | |||||
298 | if ( $this->{_parent} ) { | ||||
299 | @path = $this->{_parent}->getPath(); | ||||
300 | push( @path, $this->{_parent}->{headline} ) | ||||
301 | if $this->{_parent}->{headline}; | ||||
302 | } | ||||
303 | return @path; | ||||
304 | } | ||||
305 | |||||
306 | =begin TML | ||||
307 | |||||
308 | ---++ ObjectMethod unparent() | ||||
309 | |||||
310 | Unparent a configuration item. This only clears the parent of the node, | ||||
311 | it does not remove the node from the parent. After removing parents | ||||
312 | only the top-down structure remains, and methods that use the parent, | ||||
313 | such as getPath, will not work any more, so use with great caution. | ||||
314 | |||||
315 | The main purpose of this method is to prepare a spec node for isolated | ||||
316 | use (e.g. serialisation). | ||||
317 | |||||
318 | =cut | ||||
319 | |||||
320 | sub unparent { | ||||
321 | my $this = shift; | ||||
322 | delete $this->{_parent}; | ||||
323 | delete $this->{_vobCache}; | ||||
324 | } | ||||
325 | |||||
326 | =begin TML | ||||
327 | |||||
328 | ---++ ObjectMethod prune($depth) | ||||
329 | |||||
330 | Prunes the subtree under $this to a maximum depth of $depth, discarding | ||||
331 | children under that point. | ||||
332 | |||||
333 | $depth = 0 will prune immediate children | ||||
334 | $depth = 1 will prune children-of-children | ||||
335 | |||||
336 | etc. | ||||
337 | |||||
338 | =cut | ||||
339 | |||||
340 | sub prune { | ||||
341 | my ( $this, $depth ) = @_; | ||||
342 | |||||
343 | # NOP | ||||
344 | } | ||||
345 | |||||
346 | =begin TML | ||||
347 | |||||
348 | ---++ ObjectMethod getSectionObject($head, $depth) -> $item | ||||
349 | |||||
350 | This gets the section object that has the heading $head and | ||||
351 | $this->{depth} == $depth below this item. If $depth is not given, | ||||
352 | will return the first headline that matches. | ||||
353 | |||||
354 | Subclasses must provide an implementation. | ||||
355 | |||||
356 | =cut | ||||
357 | |||||
358 | sub getSectionObject { | ||||
359 | die 'Subclasses must define this method'; | ||||
360 | } | ||||
361 | |||||
362 | =begin TML | ||||
363 | |||||
364 | ---++ find(%search) -> @result | ||||
365 | |||||
366 | Find the first item that matches the search keys given in %search. | ||||
367 | For example, find(keys => '{Keys}') or find(headline => 'Section'). | ||||
368 | Searches recursively. You can use the pseudo-key =parent= to look up the | ||||
369 | tree, and =depth= to match the depth (the spec root is at depth 0). | ||||
370 | |||||
371 | An empty search matches the first thing found. | ||||
372 | If there are search terms, then the entire subtree is searched, | ||||
373 | but the shallowest matching node is returned. | ||||
374 | All search terms must be matched. | ||||
375 | |||||
376 | =cut | ||||
377 | |||||
378 | # True if the given configuration item matches the given search | ||||
379 | sub _matches { | ||||
380 | my ( $this, %search ) = @_; | ||||
381 | |||||
382 | while ( my ( $k, $e ) = each %search ) { | ||||
383 | if ( ref($e) ) { | ||||
384 | return 0 | ||||
385 | unless ( ref( $this->{"_$k"} ) | ||||
386 | && $this->{"_$k"}->isa('Foswiki::Configure::Item') | ||||
387 | && $this->{"_$k"}->_matches(%$e) ); | ||||
388 | } | ||||
389 | elsif ( !defined $e ) { | ||||
390 | return 0 if defined $this->{$k}; | ||||
391 | } | ||||
392 | elsif ( !defined $this->{$k} || $this->{$k} ne $e ) { | ||||
393 | return 0; | ||||
394 | } | ||||
395 | } | ||||
396 | return 1; | ||||
397 | } | ||||
398 | |||||
399 | =begin TML | ||||
400 | |||||
401 | ---++ ObjectMethod find(\%match) -> @nodes | ||||
402 | |||||
403 | Get a list of nodes that match the given search template. The template | ||||
404 | is a node structure with a subset of fields filled in that must be | ||||
405 | matched in a node for it to be returned. | ||||
406 | |||||
407 | Any fields can be used in searches and will match using eq, for example: | ||||
408 | * =headline= - title of a section, | ||||
409 | * =typename= - type of a leaf spec entry, | ||||
410 | * =keys= - keys of a spec entry, | ||||
411 | * =desc= - descriptive text of a section or entry. | ||||
412 | * =depth= - matches the depth of a node under the root | ||||
413 | (which is depth 0) | ||||
414 | Fields starting with _ are assumed to refer to another Foswiki::Configure::Item | ||||
415 | * =parent= - a structure that will be used to match a parent (the value | ||||
416 | should be another match hash that will match the parent), | ||||
417 | |||||
418 | =cut | ||||
419 | |||||
420 | sub find { | ||||
421 | my $this = shift; | ||||
422 | my %search = @_; | ||||
423 | |||||
424 | my $match = $this->_matches(%search); | ||||
425 | |||||
426 | if ($match) { | ||||
427 | return ($this); | ||||
428 | } | ||||
429 | return (); | ||||
430 | } | ||||
431 | |||||
432 | =begin TML | ||||
433 | |||||
434 | ---++ ObjectMethod search($re) -> @nodes | ||||
435 | |||||
436 | Get a list of nodes that match the given RE. Sections match on the headline, | ||||
437 | Values on the keys. | ||||
438 | |||||
439 | =cut | ||||
440 | |||||
441 | sub search { | ||||
442 | my ( $this, $re ) = @_; | ||||
443 | return (); | ||||
444 | } | ||||
445 | |||||
446 | =begin TML | ||||
447 | |||||
448 | ---++ ObjectMethod promoteSetting($setting) -> $boolean | ||||
449 | If all children of this node are tagged with the boolean attribute, | ||||
450 | then tag me too. Return true if the attribute is on us, false | ||||
451 | otherwise. | ||||
452 | |||||
453 | =cut | ||||
454 | |||||
455 | # Default impl assumes a leaf node | ||||
456 | sub promoteSetting { | ||||
457 | my ( $this, $setting ) = @_; | ||||
458 | return $this->{$setting}; | ||||
459 | } | ||||
460 | |||||
461 | =begin TML | ||||
462 | |||||
463 | ---++ ObjectMethod getValueObject($keys) -> $value | ||||
464 | Get the first Foswiki::Configure::Value object (leaf configuration item) | ||||
465 | associated with this Item. If this Item is a Value object, it will | ||||
466 | just return 'this'. if it is a Section, it will search the section | ||||
467 | (and it's subsections) for the value object with matching keys. | ||||
468 | |||||
469 | Subclasses must define this method. | ||||
470 | |||||
471 | =cut | ||||
472 | |||||
473 | sub getValueObject { | ||||
474 | die 'Subclasses must define this method'; | ||||
475 | } | ||||
476 | |||||
477 | =begin TML | ||||
478 | |||||
479 | ---++ ObjectMethod visit($visitor) -> $boolean | ||||
480 | Start a visit over this item. | ||||
481 | * $visitor - an object that implements Foswiki::Configure::Visitor | ||||
482 | |||||
483 | The default implementation just visits this item, and returns 1 if | ||||
484 | both the startVisit and the endVisit returned true. | ||||
485 | |||||
486 | =cut | ||||
487 | |||||
488 | sub visit { | ||||
489 | my ( $this, $visitor ) = @_; | ||||
490 | return 0 unless $visitor->startVisit($this); | ||||
491 | return 0 unless $visitor->endVisit($this); | ||||
492 | return 1; | ||||
493 | } | ||||
494 | |||||
495 | =begin TML | ||||
496 | |||||
497 | ---++ ObjectMethod TO_JSON | ||||
498 | |||||
499 | Provided so the JSON module can serialise blessed objects. Creates | ||||
500 | a copy of the object without internal pointers that is suitable for | ||||
501 | serialisation. Subclasses that add fields that need to be serialised | ||||
502 | *MUST* implement this method (by modifying the object returned by | ||||
503 | SUPER::TO_JSON to remove internal fields). | ||||
504 | |||||
505 | =cut | ||||
506 | |||||
507 | sub TO_JSON { | ||||
508 | my $this = shift; | ||||
509 | my $struct = { | ||||
510 | class => ref($this), | ||||
511 | |||||
512 | # Don't serialise anything with a leading __ | ||||
513 | map { $_ => $this->{$_} } grep { !/^_/ } keys %$this | ||||
514 | }; | ||||
515 | return $struct; | ||||
516 | } | ||||
517 | |||||
518 | 1 | 2µs | 1; | ||
519 | __END__ |