← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/local/src/github.com/foswiki/core/bin/view
  Run on Sun Dec 4 17:17:59 2011
Reported on Sun Dec 4 17:27:15 2011

Filename/usr/local/src/github.com/foswiki/core/lib/Foswiki/Address.pm
StatementsExecuted 21 statements in 9.42ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11124µs31µsFoswiki::Address::::BEGIN@63Foswiki::Address::BEGIN@63
11124µs45µsFoswiki::Address::::BEGIN@64Foswiki::Address::BEGIN@64
11121µs111µsFoswiki::Address::::BEGIN@73Foswiki::Address::BEGIN@73
11116µs52µsFoswiki::Address::::BEGIN@66Foswiki::Address::BEGIN@66
11116µs109µsFoswiki::Address::::BEGIN@72Foswiki::Address::BEGIN@72
11116µs113µsFoswiki::Address::::BEGIN@71Foswiki::Address::BEGIN@71
1119µs9µsFoswiki::Address::::BEGIN@67Foswiki::Address::BEGIN@67
1119µs9µsFoswiki::Address::::BEGIN@68Foswiki::Address::BEGIN@68
0000s0sFoswiki::Address::::_atomiseAsAttachmentFoswiki::Address::_atomiseAsAttachment
0000s0sFoswiki::Address::::_atomiseAsRootFoswiki::Address::_atomiseAsRoot
0000s0sFoswiki::Address::::_atomiseAsTOMFoswiki::Address::_atomiseAsTOM
0000s0sFoswiki::Address::::_atomiseAsTopicFoswiki::Address::_atomiseAsTopic
0000s0sFoswiki::Address::::_atomiseAsWebFoswiki::Address::_atomiseAsWeb
0000s0sFoswiki::Address::::_eqFoswiki::Address::_eq
0000s0sFoswiki::Address::::_existScoreFoswiki::Address::_existScore
0000s0sFoswiki::Address::::_invalidateFoswiki::Address::_invalidate
0000s0sFoswiki::Address::::attachmentFoswiki::Address::attachment
0000s0sFoswiki::Address::::equivFoswiki::Address::equiv
0000s0sFoswiki::Address::::finishFoswiki::Address::finish
0000s0sFoswiki::Address::::isAFoswiki::Address::isA
0000s0sFoswiki::Address::::isValidFoswiki::Address::isValid
0000s0sFoswiki::Address::::newFoswiki::Address::new
0000s0sFoswiki::Address::::parseFoswiki::Address::parse
0000s0sFoswiki::Address::::revFoswiki::Address::rev
0000s0sFoswiki::Address::::rootFoswiki::Address::root
0000s0sFoswiki::Address::::stringifyFoswiki::Address::stringify
0000s0sFoswiki::Address::::tompathFoswiki::Address::tompath
0000s0sFoswiki::Address::::topicFoswiki::Address::topic
0000s0sFoswiki::Address::::typeFoswiki::Address::type
0000s0sFoswiki::Address::::webFoswiki::Address::web
0000s0sFoswiki::Address::::webpathFoswiki::Address::webpath
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
2
3package Foswiki::Address;
4
5=begin TML
6
7---+ package Foswiki::Address
8
9This class is used to handle pointers to Foswiki 'resources', which might be
10webs, topics or parts of topics (such as attachments or metadata), optionally
11of a specific revision.
12
13The primary goal is to end the tyranny of arbitrary
14=(web, topic, attachment, rev...)= tuples. Users of =Foswiki::Address= should
15be able to enjoy programmatically updating, stringifying, parsing, validating,
16comparing and passing around of _address objects_ that might eventually be
17understood by the wider Foswiki universe, without having to maintain proprietary
18parse/stringify/validate/comparison handling code that must always be
19considerate of the recipient for such tuples.
20
21This class does not offer any interaction with resources themselves; rather,
22functionality is provided to create, hold, manipulate, test
23__and de/serialise addresses__
24
25Fundamentally, =Foswiki::Address= can be thought of as an interface to a hash of
26the components necessary to address a specific Foswiki resource.
27
28<verbatim>
29my $addr = {
30 web => 'Web/SubWeb',
31 topic => 'Topic',
32 attachment => 'Attachment.pdf',
33 rev => 3
34};
35</verbatim>
36
37<blockquote class="foswikiHelp">%X% __Unresolved issues__
38 * Is this class necessary, or should we make a cleaner, lighter
39 =Foswiki::Meta2= - where 'unloaded' objects are no heavier than
40 =Foswiki::Address= and provide the same functionality?
41 * Should the physical file attachment be treated separately to the metadata
42 view of the file attachment(s)? Desirables:
43 * ability to unambiguously create pointers to an attachment's data (file)
44 * ability for Foswiki core to calculate an http URL for it
45 * ability to create pointers to properties (metadata) of the attachment
46 * _These questions are slightly loaded in favour of distinguishing
47 between the datastream and metadata about the attachment. In an ideal
48 world a file attachment would be a first-class citizen to topics: rather
49 than topic text, we have the iostream; attachments would have their own
50 user metadata, dataforms..._
51 * Duplicating %SYSTEMWEB%.QuerySearch parser functionality. 80% of the code
52 in this class is related to parsing "string forms" of addresses of Foswiki
53 resources... querysearch parser needs some refactoring so we can delete the
54 parser code here.
55 * API usability - can we stop passing around (web, topic, attachment, rev)
56 tuples - will the =->new()= constructor make sense to plugin authors, core
57 hackers? __FEEDBACK WELCOME__, please comment at
58 Foswiki:Development.TopicAddressing
59</blockquote>
60
61=cut
62
63248µs238µs
# spent 31µs (24+7) within Foswiki::Address::BEGIN@63 which was called: # once (24µs+7µs) by Foswiki::Access::TopicACLAccess::BEGIN@22 at line 63
use strict;
# spent 31µs making 1 call to Foswiki::Address::BEGIN@63 # spent 7µs making 1 call to strict::import
64247µs267µs
# spent 45µs (24+22) within Foswiki::Address::BEGIN@64 which was called: # once (24µs+22µs) by Foswiki::Access::TopicACLAccess::BEGIN@22 at line 64
use warnings;
# spent 45µs making 1 call to Foswiki::Address::BEGIN@64 # spent 22µs making 1 call to warnings::import
65
66241µs289µs
# spent 52µs (16+36) within Foswiki::Address::BEGIN@66 which was called: # once (16µs+36µs) by Foswiki::Access::TopicACLAccess::BEGIN@22 at line 66
use Assert;
# spent 52µs making 1 call to Foswiki::Address::BEGIN@66 # spent 36µs making 1 call to Assert::import
67237µs19µs
# spent 9µs within Foswiki::Address::BEGIN@67 which was called: # once (9µs+0s) by Foswiki::Access::TopicACLAccess::BEGIN@22 at line 67
use Foswiki::Func();
# spent 9µs making 1 call to Foswiki::Address::BEGIN@67
68243µs19µs
# spent 9µs within Foswiki::Address::BEGIN@68 which was called: # once (9µs+0s) by Foswiki::Access::TopicACLAccess::BEGIN@22 at line 68
use Foswiki::Meta();
# spent 9µs making 1 call to Foswiki::Address::BEGIN@68
69
70#use Data::Dumper;
71247µs2211µs
# spent 113µs (16+98) within Foswiki::Address::BEGIN@71 which was called: # once (16µs+98µs) by Foswiki::Access::TopicACLAccess::BEGIN@22 at line 71
use constant TRACE => 0; # Don't forget to uncomment dumper
# spent 113µs making 1 call to Foswiki::Address::BEGIN@71 # spent 98µs making 1 call to constant::import
72245µs2202µs
# spent 109µs (16+93) within Foswiki::Address::BEGIN@72 which was called: # once (16µs+93µs) by Foswiki::Access::TopicACLAccess::BEGIN@22 at line 72
use constant TRACE2 => 0;
# spent 109µs making 1 call to Foswiki::Address::BEGIN@72 # spent 94µs making 1 call to constant::import
7329.00ms2201µs
# spent 111µs (21+90) within Foswiki::Address::BEGIN@73 which was called: # once (21µs+90µs) by Foswiki::Access::TopicACLAccess::BEGIN@22 at line 73
use constant TRACEATTACH => 0;
# spent 111µs making 1 call to Foswiki::Address::BEGIN@73 # spent 90µs making 1 call to constant::import
74
75112µsmy %atomiseAs = (
76 root => \&_atomiseAsRoot,
77 web => \&_atomiseAsWeb,
78 topic => \&_atomiseAsTopic,
79 attachment => \&_atomiseAsAttachment,
80 META => \&_atomiseAsTOM,
81 meta => \&_atomiseAsTOM,
82 SECTION => \&_atomiseAsTOM,
83 text => \&_atomiseAsTOM,
84 '*' => \&_atomiseAsTOM
85);
86
87# The question is: what do we have? The hash is accessed as follows:
88# $pathtypes{ $tompath[0] }->{ scalar(@tompath) }
89114µsmy %pathtypes = (
90 attachment => { 1 => 'attachments', 2 => 'attachment' },
91 META => { 1 => 'meta', 2 => 'metatype', 3 => 'metamember', 4 => 'metakey' },
92 SECTION => { 1 => 'sections', 2 => 'section' },
93 text => { 1 => 'text' }
94);
95
96# I tried to create a logical parser, but it kept ending up as spaghetti.
97# So we use a lookup table instead... (probably?) easier to follow, faster.
98139µsmy %plausibletable = (
99
100 # root keys represent the path separator signature of the form:
101 # combinations of s, S, d, D - where:
102 # s = <part>/<part> - sequence of two parts separated by '/'
103 # d = <part>.<part> - sequence of two parts separated by '.'
104 # S = <part>/<part>/<part>[/]... - sequence > 2 parts separated by '/'
105 # D = <part>.<part>.<part>[.]... - sequence > 2 parts separated by '.'
106 #
107 # sub keys are the type considered; values of the sub keys indicate
108 # the plausibility that the given form could be the type indicated:
109 # 0/undef - not plausible
110 # 1 - plausible without using any context
111 # 2 - normal ("unambiguous") form
112 # 'webpath' - plausible if given webpath context
113 # 'topic' - plausible if given webpath & topic context
114 #
115 # Foo
116 '' => { webpath => 1, topic => 'webpath', attachment => 'topic' },
117
118 # Foo.Bar
119 'd' => { webpath => 1, topic => 2, attachment => 'topic' },
120
121 # Foo/Bar
122 's' => { webpath => 1, topic => 1, attachment => 'webpath' },
123
124 # Foo/Bar.Dog
125 'sd' => { webpath => 0, topic => 2, attachment => 'webpath' },
126
127 # Foo.Bar/Dog
128 'ds' => { webpath => 0, topic => 1, attachment => 2 },
129
130 # Foo/Bar/Dog
131 'S' => { webpath => 1, topic => 1, attachment => 1 },
132
133 # Foo.Bar.Dog
134 'D' => { webpath => 1, topic => 1, attachment => 'topic' },
135
136 # Foo.Bar/Cat/Dog
137 'dS' => { webpath => 0, topic => 1, attachment => 1 },
138
139 # Foo/Bar.Cat.Dog
140 'sD' => { webpath => 0, topic => 0, attachment => 'webpath' },
141
142 # Foo/Bar/Dog.Cat
143 'Sd' => { webpath => 0, topic => 2, attachment => 1 },
144
145 # Foo.Bar.Dog/Cat
146 'Ds' => { webpath => 0, topic => 1, attachment => 1 },
147
148 # Foo.Bar.Dog/Cat/Bat
149 'DS' => { webpath => 0, topic => 0, attachment => 1 },
150
151 # Foo/Bar/Dog.Cat.Bat
152 'SD' => { webpath => 0, topic => 0, attachment => 1 },
153
154 # Foo/Bar.Dog/Cat
155 'sds' => { webpath => 0, topic => 0, attachment => 2 },
156
157 # Foo/Bar/Dog.Cat/Bat
158 'Sds' => { webpath => 0, topic => 0, attachment => 2 },
159
160 # Foo.Bar/Dog.Cat
161 'dsd' => { webpath => 0, topic => 0, attachment => 2 },
162
163 # Foo.Bar.Dog/Cat.Bat
164 'Dsd' => { webpath => 0, topic => 0, attachment => 1 },
165
166 # Foo.Bar/Dog.Cat.Bat
167 'dsD' => { webpath => 0, topic => 0, attachment => 2 },
168
169 # Foo/Bar.Dog/Cat.Bat
170 'sdsd' => { webpath => 0, topic => 0, attachment => 2 },
171
172 # Foo/Bar.Dog/Cat.B.a.t
173 'sdsD' => { webpath => 0, topic => 0, attachment => 2 },
174
175 # Foo/Bar/Dog.Cat/B.at
176 'Sdsd' => { webpath => 0, topic => 0, attachment => 2 },
177
178 # Foo/Bar/Dog.Cat/B.a.t
179 'SdsD' => { webpath => 0, topic => 0, attachment => 2 }
180);
18117µsmy %sepidentchars =
182 ( 0 => { '.' => 'd', '/' => 's' }, 1 => { '.' => 'D', '/' => 'S' } );
183
184=begin TML
185
186---++ ClassMethod new( %constructor ) => $addrObj
187
188Create a =Foswiki::Address= instance
189
190The constructor takes two main forms:
191
192---+++ Explicit form
193*Example:*
194<verbatim>
195my $addrObj = Foswiki::Address->new(
196 web => 'Web/SubWeb',
197 topic => 'Topic',
198 attachment => 'Attachment.pdf',
199 rev => 3
200);</verbatim>
201
202*Options:*
203| *Param* | *Description* | *Notes* |
204| =web= | =$string= of web path, %BR% used if =webpath= is empty/null | |
205| =webpath= | =\@arrayref= of web path, root web first | |
206| =topic= | =$string= topic name | |
207| =rev= | =$integer= revision number. | If the tompath is to a =attachment= datastream, rev applies to that file; topic rev otherwise |
208| =tompath= | =\@arrayref= of a "TOM" path, one of:%BR% =META=, =text=, =SECTION=, =attachment=. | See table below |
209| =string= | string representation of an object | eg. 'Web/SubWeb.Topic/Attachment.pdf@3' |
210
211*path forms:*
212| *tompath* | *Description* |
213| =['attachment']= | All datastreams attached to a topic |
214| =['attachment', 'Attachment.pdf']= | Datastream of the file attachment named 'Attachment.pdf' |
215| =['META']= | All =META= on a topic |
216| =['META', 'FIELD']= | All =META:FIELD= members on a topic |
217| =['META', 'FIELD', { name => 'Colour' }]= | The =META:FIELD= member whose =name='Colour'= |
218| =['META', 'FIELD', 3]= | The fourth =META:FIELD= member |
219| =['META', 'FIELD', { name => 'Colour' }, 'title']= | The ='title'= attribute on the =META:FIELD= member whose =name='Colour'= |
220| =['META', 'FIELD', 3, 'title']= | The ='title'= attribute on the fourth =META:FIELD= member |
221| =['text']= | The topic text |
222| =['SECTION']= | All topic sections as defined by %SYSTEMWEB%.VarSTARTSECTION |
223| =['SECTION', {name => 'foo'}]= | The topic section named 'foo' |
224| =['SECTION', {name => 'foo', type => 'include'}]= | The topic section named 'foo' of =type='include'= |
225
226*Example:* Point to the value of a formfield =LastName= in =Web/SubWeb.Topic=,
227<verbatim>
228my $addrObj = Foswiki::Address->new(
229 web => 'Web/SubWeb',
230 topic => 'Topic',
231 tompath => ['META', 'FIELD', {name => LastName}, 'value']
232);</verbatim>
233
234*Equivalent:* %JQREQUIRE{"chili"}%<verbatim class="tml">
235%QUERY{"'Web/SubWeb.Topic'/META:FIELD[name='LastName'].value"}%
236or
237%QUERY{"'Web/SubWeb.Topic'/LastName"}%
238</verbatim>
239
240---+++ String form
241*Example:*
242<verbatim>
243my $addrObj = Foswiki::Address->new(
244 string => 'Web/SubWeb.Topic/Attachment.pdf@3',
245 %opts
246);</verbatim>
247
248<blockquote class="foswikiHelp">%X% String form instantiation requires parsing
249of the address string which comes with many options and caveats - refer to the
250documentation for =parse()=.</blockquote>
251
252=cut
253
254sub new {
255 my ( $class, %opts ) = @_;
256 my $this;
257
258 if ( $opts{string} ) {
259 ASSERT( not $opts{topic} or ( $opts{webpath} and $opts{topic} ) )
260 if DEBUG;
261
262 # $this->{parseopts} = {
263 # web => $opts{web},
264 # webpath => $opts{webpath},
265 # topic => $opts{topic},
266 # rev => $opts{rev},
267 # isA => $opts{isA},
268 # existAs => undef,
269 # catchAs => $opts{catchAs},
270 # existHints => $opts{existHints},
271 # string => $opts{string}
272 # };
273 # 15% faster if we do it like this...
274 $this->{parseopts} = \%opts;
275
276 if ( not $opts{isA} ) {
277
278 # transpose the existAs array into hash keys
279 if ( $opts{existAs} ) {
280 ASSERT( ref( $opts{existAs} ) eq 'ARRAY' ) if DEBUG;
281 ASSERT( scalar( @{ $opts{existAs} } ) ) if DEBUG;
282 $this->{parseopts}->{existAsList} = $opts{existAs};
283 $this->{parseopts}->{existAs} =
284 { map { $_ => 1 } @{ $opts{existAs} } };
285 }
286 else {
287 $this->{parseopts}->{existAsList} = [qw(attachment topic)];
288 $this->{parseopts}->{existAs} = { attachment => 1, topic => 1 };
289 }
290 }
291 $this = bless( $this, $class );
292 $this->parse( $opts{string} );
293 }
294 else {
295
296 # 'Web/SubWeb' vs [qw(Web SubWeb)] (supplied as web vs webpath): if the latter
297 # is absent, derive it from the former (supplied as web vs webpath)
298 if ( not $opts{webpath} and $opts{web} ) {
299 $opts{webpath} = [ split( /[\/\.]/, $opts{web} ) ];
300 }
301
302 # $this = {
303 # webpath => $opts{webpath},
304 # topic => $opts{topic},
305 # tompath => $opts{tompath},
306 # rev => $opts{rev},
307 # };
308 print STDERR "\$this: " . Dumper( \%opts ) if TRACEATTACH;
309 if ( $opts{attachment} and not $opts{tompath} ) {
310 print STDERR "Assigning {tompath} from {attachment}\n"
311 if TRACEATTACH;
312 $opts{tompath} = [ 'attachment', $opts{attachment} ];
313 }
314 elsif ( not $opts{attachment}
315 and $opts{tompath}
316 and ref( $opts{tompath} ) eq 'ARRAY'
317 and $opts{tompath}->[0] eq 'attachment'
318 and $opts{tompath}->[1] )
319 {
320 print STDERR "Assigning {attachment} from {tompath}\n"
321 if TRACEATTACH;
322 $opts{attachment} = $opts{tompath}->[1];
323 }
324 if ( DEBUG and $opts{attachment} and $opts{tompath} ) {
325 ASSERT(
326 ref( $opts{tompath} ) eq 'ARRAY'
327 and $opts{tompath}->[0] ne 'attachment'
328 or ( $opts{tompath}->[1]
329 and $opts{tompath}->[1] eq $opts{attachment} )
330 ) if DEBUG;
331 }
332
333 #$this->parse( $_[0]->{string} );
334 $this = bless( \%opts, $class );
335 }
336
337 return $this;
338}
339
340=begin TML
341
342---++ ClassMethod finish( )
343
344Clean up the object, releasing any memory stored in it.
345
346=cut
347
348sub finish {
349 my ($this) = @_;
350
351 $this->{root} = undef;
352 $this->{web} = undef;
353 $this->{webpath} = undef;
354 $this->{topic} = undef;
355 $this->{rev} = undef;
356 $this->{tompath} = undef;
357 $this->{attachment} = undef;
358 $this->{isA} = undef;
359 $this->{type} = undef;
360 $this->{parseopts} = undef;
361 $this->{stringified} = undef;
362 $this->{stringifiedwebsep} = undef;
363 $this->{stringifiedtopicsep} = undef;
364
365 return;
366}
367
368=begin TML
369
370---++ ClassMethod parse( $string, %opts ) -> $success
371
372Parse the given string (using options provided at instantiation, unless =%opts=
373overrides them) and update the instance with the resulting address.
374
375Examples of valid path strings include:
376
377 * =Web/=
378 * =Web/SubWeb/=
379 * =Web/SubWeb.Topic= or =Web/SubWeb/Topic= or =Web.SubWeb.Topic=
380 * =Web/SubWeb.Topic@2= or =Web/SubWeb/Topic@2= or =Web.SubWeb.Topic@2=
381 * =Web/SubWeb.Topic/Attachment.pdf= or =Web/SubWeb/Topic/Attachment.pdf= or
382 =Web.SubWeb.Topic/Attachment.pdf=
383 * =Web/SubWeb.Topic/Attachment.pdf@3= or =Web/SubWeb/Topic/Attachment.pdf@3=
384 or =Web.SubWeb.Topic/Attachment.pdf@3=
385
386"String" addresses are notoriously ambiguous: Foswiki traditionally allows web
387& topic separators '.' & '/' to be used interchangably. For example, the
388following strings could be topics or attachments (or even webs):
389 * =Foo.Bar=
390 * =Foo.Bar.Cat.Dog=
391 * =Foo/Bar=
392 * =Foo/Bar/Cat/Dog=
393
394To resolve the ambiguity, components of ambiguous strings are tested for
395existence as webs, topics or attachments and used as hints to help resolve them,
396so it follows that:
397<blockquote class="foswikiHelp">%X% Ambiguous address strings cannot be
398considered stable; exactly which resource they resolve to depends on the
399hinting algorithm, the parameters and hints supplied to it, and the existence
400(or non-existence) of other resources</blockquote>
401
402*Options:*
403| *Param* | *Description* | *Values* | *Notes* |
404| =webpath= or =web= %BR% =topic= | context hints | refer to explicit form |\
405 if =string= is ambiguous (and possibly not fully qualified, Eg. topic-only or\
406 attachment-only), the hinting algorithm tests =string= against them |
407| =isA= | resource type specification | =$type= - 'web', 'topic',\
408 'attachment' | parse =string= to resolve to the specified type; exist hinting\
409 is skipped |
410| =catchAs= | default resource type | =$type= - 'web', 'topic', 'attachment', 'none' |\
411 if =string= is ambiguous AND (exist hinting fails OR is disabled), THEN\
412 assume =string= to be (web, topic, file attachment or unparseable) |
413| =existAs= | resource types to test | =\@typelist= containing one\
414 or more of 'web', 'topic', 'attachment' | if =string= is ambiguous, test (in\
415 order) as each of the specified types. Default: =[qw(attachment topic)]= |
416| =existHints= | exist hinting enable/disable | =$boolean= |\
417 enable/disable hinting through web/topic/attachment existence checks.\
418 =string= *is assumed to be using the 'unambiguous' conventions below*; if it\
419 isn't, =catchAs= is used |
420
421#UnambiguousStrings
422---+++ Unambiguous strings
423
424To build less ambiguous address strings, use the following conventions:
425 * Terminate web addresses with '/'
426 * Separate subwebs in the web path with '/'
427 * Separate topic from web path with '.'
428 * Separate file attachments from topics with '/'
429Examples:
430 * =Web/SubWeb/=, =Web/=
431 * =Web/SubWeb.Topic=
432 * =Web.Topic/Attachment.pdf=
433 * =Web/SubWeb.Topic/Attachment.pdf=
434
435Many strings commonly used in Foswiki will always be ambiguous (such as =Foo=,
436=Foo/Bar=, =Foo/Bar/Cat=, =Foo.Bar.Cat=). Supplying an =isA= specification will
437prevent the parser from using the (somewhat expensive) exist hinting heuristics.
438
439<blockquote class="foswikiHelp">%I% In order to simplify the algorithm, a
440string may only parse out as a web if:
441 * It is of the form =Foo/=, or
442 * =isA => 'web'= is specified, or
443 * No other type is possible, and =catchAs => 'web'= is specified
444</blockquote>
445
446The exist hinting algorithm is skipped if:
447 * =isA= specified
448 * =string= not ambiguous
449
450If =string= is ambiguous, the hinting algorithm works roughly as follows:
451 * if exist hinting is disabled
452 * and =catchAs= is specified (parse as the =catchAs= type), otherwise
453 * the string cannot be parsed
454 * if exist hinting is enabled, the string is checked for existence as each of
455 the =existAs= types (default is 'attachment', 'topic')
456 * if there is an exact match against one of the =existAs= types (finish), otherwise
457 * if there were partial matches (select the combination which scores
458 highest), otherwise
459 * if =catchAs= was specified (parse as that type), otherwise
460 * the string cannot be parsed
461The following table attempts to explain how ambiguous forms can be interpreted
462and resolved.
463| *String form* | *existHints* | *ambiguous* | *web[s]* | *topic* | *possible types* |
464| =Foo/= | | | | | web |
465| =Foo= | | %X% | | | web %BR% needs =isA => 'web'= or =catchAs => 'web'=,%BR% error otherwise |
466| =Foo= | | | set | | topic |
467| =Foo= | | 1 | set | set | topic, attachment |
468| =Foo/Bar/= | | | | | web |
469| =Foo/Bar= | | | | | topic |
470| =Foo/Bar= | | 1 | set | | topic, attachment |
471| =Foo.Bar= | | | | | topic |
472| =Foo.Bar= | | 1 | set | set | topic, attachment |
473| =Foo/Bar/Dog/= | | | | | web |
474| =Foo/Bar/Dog= | | 1 | | | topic, attachment |
475| =Foo.Bar/Dog= | 0 | | | | attachment |
476| =Foo.Bar/Dog= | | 1 | | | topic, attachment |
477| =Foo.Bar/D.g= | | | | | attachment |
478| =Foo/Bar.Dog= | | | | | topic |
479| =Foo/Bar.Dog= | | 1 | set | | topic, attachment |
480| =Foo.Bar.Dog= | | | | | topic |
481| =Foo.Bar.Dog= | | 1 | set | set | topic, attachment |
482| =Foo/Bar/Dog/Cat/= | | | | | web |
483| =Foo/Bar.Dog.Cat= | | | | | topic |
484| =Foo/Bar.Dog.Cat= | | 1 | set | | topic, attachment |
485| =Foo/Bar.Dog/Cat= | | | | | attachment |
486| =Foo/Bar.Dog/C.t= | | | | | attachment |
487| =Foo/Bar/Dog.Cat= | 0 | | | | topic |
488| =Foo/Bar/Dog.Cat= | | 1 | | | topic, attachment |
489| =Foo/Bar/Dog/Cat= | | 1 | | | topic, attachment |
490| =Foo/Bar/Dog/C.t= | | 1 | | | topic, attachment |
491| =Foo.Bar.Dog/Cat= | 0 | | | | attachment |
492| =Foo.Bar.Dog/Cat= | | 1 | | | topic, attachment |
493| =Foo.Bar.Dog/C.t= | | | | | attachment |
494
495=cut
496
497sub parse {
498 my ( $this, $path, %opts ) = @_;
499
500 $this->_invalidate();
501 if ( not $this->{parseopts} ) {
502 $this->{parseopts} = {
503 web => $opts{web},
504 webpath => $opts{webpath},
505 topic => $opts{topic},
506 rev => $opts{rev},
507 existAsList => [qw(attachment topic)],
508 existAs => { attachment => 1, topic => 1 }
509 };
510 }
511 %opts = ( %{ $this->{parseopts} }, %opts );
512 ASSERT( $opts{isA} or defined $opts{existAs} ) if DEBUG;
513 $path =~ s/(\@([-\+]?\d+))$//;
514 $this->{rev} = $2;
515
516 # if necessary, populate webpath from web parameter
517 if ( not $opts{webpath} and $opts{web} ) {
518 $opts{webpath} = [ split( /[\/\.]/, $opts{web} ) ];
519 }
520
521 ASSERT( not $opts{webpath} or ref( $opts{webpath} ) eq 'ARRAY' ) if DEBUG;
522
523 # Because of the way we split, 'Foo/' causes final element to be empty
524 if ( $opts{webpath} and not $opts{webpath}->[-1] ) {
525 pop( @{ $opts{webpath} } );
526 }
527
528 # pre-compute web's string form (avoid unnecessary join()s)
529 if ( not $opts{web} and $opts{webpath} ) {
530 $opts{web} = join( '/', @{ $opts{webpath} } );
531 }
532
533 # Is the path explicit?
534 if ( not $opts{isA} ) {
535 if ( substr( $path, -1, 1 ) eq '/' ) {
536 if ( length($path) > 1 ) {
537 $opts{isA} = 'web';
538 }
539 else {
540
541 # $path eq '/' - the mythical "root" path
542 $opts{isA} = 'root';
543 }
544 }
545 elsif ( substr( $path, 0, 1 ) eq '\'' or $path =~ /\[/ ) {
546 $opts{isA} = '*';
547 }
548 }
549
550 # Here we go... short-circuit testing if we already have an isA spec
551 if ( $opts{isA} ) {
552
553 print STDERR "parse(): isA: $opts{isA}\n" if TRACE2;
554 ASSERT( $atomiseAs{ $opts{isA} } ) if DEBUG;
555 $atomiseAs{ $opts{isA} }->( $this, $this, $path, \%opts );
556 }
557 else {
558 my @separators = ( $path =~ m/([\.\/])/g );
559 my $sepboost = 0;
560 my $sepident = '';
561 my $lastsep;
562 my $plaus;
563 my @trylist;
564 my $normalform;
565 my %typeatoms;
566 my %typescores;
567 my $parsed;
568
569 ASSERT( ref( $opts{existAsList} ) eq 'ARRAY' ) if DEBUG;
570
571 if ( scalar(@separators) ) {
572
573 # build the separator-based identity of the path string, Eg.
574 # Foo/Bar/Dog.Cat/B.a.t = 'SdsD'
575 # TemporaryAddressTestsTestWeb/SubWeb/SubSubWeb.Topic/Atta.hme.t
576 foreach my $sep (@separators) {
577 if ( defined $lastsep ) {
578 if ( $lastsep ne $sep ) {
579 $sepident .= $sepidentchars{$sepboost}->{$lastsep};
580 $lastsep = $sep;
581 $sepboost = 0;
582 }
583 else {
584 $sepboost = 1;
585 }
586 }
587 else {
588 $lastsep = $sep;
589 }
590 }
591 $sepident .= $sepidentchars{$sepboost}->{$lastsep};
592 }
593 $plaus = $plausibletable{$sepident};
594 print STDERR "Identity\t$sepident calculated for $path, plaustable: "
595 . Dumper($plaus)
596 if TRACE;
597
598 # Is the identity known?
599 if ($plaus) {
600
601 # Default to exist hinting enabled
602 if ( not defined $opts{existHints} ) {
603 $opts{existHints} = 1;
604 }
605
606 # (ab)using %opts to match values from the plausible table
607 $opts{1} = 1;
608 $opts{2} = 1;
609
610 # @trylist is the intersection of existAs list and the plausible
611 # list. existAs ordering is used unless string is "unambiguous"
612 # form, in which case that type is positioned first.
613 foreach my $type ( @{ $opts{existAsList} } ) {
614
615 # If the type is plausible, and the options support it
616 if ( $plaus->{$type} and $opts{ $plaus->{$type} } ) {
617
618 # If an "unambiguous" form, put it first in the @trylist.
619 if ( $plaus->{$type} eq 2 ) {
620 unshift( @trylist, $type );
621 $normalform = $type;
622
623 # If existHints are allowed, add the plausible type to list
624 }
625 elsif ( $opts{existHints} ) {
626 push( @trylist, $type );
627 }
628 }
629 }
630
631 # Exist hinting. The first complete hit, or the hit which matches
632 # the most (out of the existAsList, Eg.: attachment, topic, web)
633 # wins. The former should naturally fall out of the latter, unless
634 # the existAs list is not ordered smallestthing-first
635 if ( $opts{existHints} ) {
636 my $i = 0;
637 my $ntrylist = scalar(@trylist);
638 my $besttype;
639 my $bestscore;
640 my $bestscoredtype;
641
642 # If a complete hit is detected, we set $besttype & exit early
643 while ( $ntrylist > $i and not $besttype ) {
644 my $score;
645 my $type = $trylist[$i];
646
647 $i += 1;
648 print STDERR "Trying to atomise $path as $type...\n"
649 if TRACE;
650 ASSERT( $atomiseAs{$type} ) if DEBUG;
651 $typeatoms{$type} =
652 $atomiseAs{$type}->( $this, {}, $path, \%opts );
653 print STDERR "Atomised $path as $type, result: "
654 . Dumper( $typeatoms{$type} )
655 if TRACE;
656 ( $besttype, $score ) =
657 $this->_existScore( $typeatoms{$type}, $type );
658
659 if (TRACE) {
660 print STDERR 'existScore: '
661 . ( $score || '' )
662 . ' besttype: '
663 . ( $besttype || '' ) . "\n";
664 }
665
666 if ( $score
667 and ( not defined $bestscore or $bestscore < $score ) )
668 {
669 $bestscoredtype = $type;
670 $bestscore = $score;
671 }
672 }
673
674 # Unless we already got a perfect hit; find the type for this
675 # path that gives the highest score
676 if ( not $besttype ) {
677 $besttype = $bestscoredtype;
678 }
679
680 # Copy the atoms from the best hit into our instance.
681 if ($besttype) {
682 $this->{web} = $typeatoms{$besttype}->{web};
683 $this->{webpath} = $typeatoms{$besttype}->{webpath};
684 $this->{topic} = $typeatoms{$besttype}->{topic};
685 $this->{tompath} = $typeatoms{$besttype}->{tompath};
686 $this->{attachment} = $typeatoms{$besttype}->{attachment};
687 $parsed = 1;
688 }
689 }
690 }
691 if ( not $parsed ) {
692 my $type = $normalform || $opts{catchAs};
693
694 if ($type) {
695 ASSERT( $atomiseAs{$type} ) if DEBUG;
696 $typeatoms{$type} =
697 $atomiseAs{$type}->( $this, $this, $path, \%opts );
698 }
699 }
700 }
701
702 return $this->isValid();
703}
704
705#sub _atomiseAs {
706# my ( $this, $that, $path, $type, $opts ) = @_;
707#
708# ASSERT($path) if DEBUG;
709# ASSERT($type) if DEBUG;
710# ASSERT( $atomiseAs{$type} ) if DEBUG;
711# $atomiseAs{$type}->( $this, $that, $path, $opts );
712#
713# return $that;
714#}
715
716sub _atomiseAsRoot {
717 my ( $this, $that, $path, $opts ) = @_;
718
719 print STDERR "_atomiseAsRoot():\n" if TRACE2;
720 ASSERT( $path eq '/' ) if DEBUG;
721 $that->{root} = 1;
722 $that->{web} = undef;
723 $that->{webpath} = undef;
724 $that->{topic} = undef;
725 $that->{tompath} = undef;
726 $that->{attachment} = undef;
727
728 return $that;
729}
730
731sub _atomiseAsWeb {
732 my ( $this, $that, $path, $opts ) = @_;
733
734 print STDERR "_atomiseAsWeb():\n" if TRACE2;
735 $that->{web} = $path;
736 $that->{webpath} = [ split( /[\.\/]/, $path ) ];
737 ASSERT( $that->{web} and ref( $that->{webpath} ) eq 'ARRAY' ) if DEBUG;
738
739 # If we had a path that looks like 'Foo/'
740 if ( not $that->{webpath}->[-1] ) {
741 pop( @{ $that->{webpath} } );
742 chop( $that->{web} );
743 }
744 $that->{topic} = undef;
745 $that->{tompath} = undef;
746 $that->{attachment} = undef;
747
748 return $that;
749}
750
751sub _atomiseAsTopic {
752 my ( $this, $that, $path, $opts ) = @_;
753 my @parts = split( /[\.\/]/, $path );
754 my $nparts = scalar(@parts);
755
756 print STDERR "_atomiseAsTopic(): path: $path, nparts: $nparts\n" if TRACE2;
757 ASSERT($path) if DEBUG;
758 if ( $nparts == 1 ) {
759 if ( $opts->{webpath}
760 and ref( $opts->{webpath} ) eq 'ARRAY'
761 and scalar( @{ $opts->{webpath} } ) )
762 {
763 $that->{web} = $opts->{web};
764 $that->{webpath} = $opts->{webpath};
765 $that->{topic} = $path;
766 }
767 }
768 else {
769 $that->{webpath} = [ @parts[ 0 .. ( $nparts - 2 ) ] ];
770 $that->{web} = undef;
771
772 # $that->{web} = join( '/', @{ $that->{webpath} } );
773 $that->{topic} = $parts[-1];
774 }
775 $that->{tompath} = undef;
776 $that->{attachment} = undef;
777 ASSERT( $that->{webpath} or not $that->{topic} ) if DEBUG;
778
779 # ASSERT( $that->{web} ) if DEBUG;
780
781 return $that;
782}
783
784sub _atomiseAsAttachment {
785 my ( $this, $that, $path, $opts ) = @_;
786
787 print STDERR "_atomiseAsAttachment():\n" if TRACE2;
788 ASSERT($path) if DEBUG;
789 if ( my ( $lhs, $file ) = ( $path =~ /^(.*?)\/([^\/]+)$/ ) ) {
790 $that = $this->_atomiseAsTopic( $that, $lhs, $opts );
791 $that->{tompath} = [ 'attachment', $file ];
792 $that->{attachment} = $file;
793 }
794 else {
795 if ( $opts->{webpath} and $opts->{topic} ) {
796 $that->{webpath} = $opts->{webpath};
797 $that->{web} = $opts->{web};
798 $that->{topic} = $opts->{topic};
799 $that->{tompath} = [ 'attachment', $path ];
800 $that->{attachment} = $path;
801 }
802 }
803
804 return $that;
805}
806
807=begin TML
808
809---++ PRIVATE ClassMethod _atomiseAsTOM ( $that, $path, $opts ) => $that
810
811Parse a small subset ('static' meta path forms) of QuerySearch (VarQUERY)
812compatible expressions.
813
814=$opts= is a hashref holding default context
815
816'topic'/ ref part is optional; =_atomiseAsTOM()= falls-back to default topic
817context supplied in =$opts= otherwise. In other words, both of these forms are
818supported:
819 * ='Web/SubWeb.Topic@3'/META:FIELD[name='Colour'].value=
820 * =META:FIELD[name='Colour'].value=
821
822| *Form* | *tompath* | *type* |
823| =META= | =['META']= | meta |
824| =META:FIELD= | =['META', 'FIELD']= | metatype |
825| =META:FIELD[name='Colour']= | =['META', 'FIELD', {name => 'Colour'}]= | metamember |
826| =META:FIELD[3]= | =['META', 'FIELD', 3]= | metamember |
827| =META:FIELD[name='Colour'].value= | =['META', 'FIELD', {name => 'Colour'}, 'value']= | metakey |
828| =META:FIELD[3].value= | =['META', 'FIELD', 3, 'value']= | metakey |
829| =fields= | =['META', 'FIELD']= | metatype |
830| =fields[name='Colour']= | =['META', 'FIELD', {name => 'Colour'}]= | metamember |
831| =fields[3]= | =['META', 'FIELD', 3]= | metamember |
832| =fields[name='Colour'].value= | =['META', 'FIELD', 3, 'value']= | metakey |
833| =MyForm= | =['META', 'FIELD', {form => 'MyForm'}]= | metatype |
834| =MyForm[name='Colour']= | =['META', 'FIELD', {form => 'MyForm', name => 'Colour'}]= | metamember |
835| =MyForm[name='Colour'].value= | =['META', 'FIELD', {form => 'MyForm', name => 'Colour'}, 'value']= | metakey |
836| =MyForm.Colour= | =['META', 'FIELD', {form => 'MyForm', name => 'Colour'}, 'value']= | metakey |
837| =Colour= | =['META', 'FIELD', {name => 'Colour'}, 'value']= | metakey |
838=cut
839
840sub _atomiseAsTOM {
841 my ( $this, $that, $path, $opts ) = @_;
842
843 print STDERR "_atomiseAsTOM():\n" if TRACE2;
844
845 # QuerySearch meta path?
846 # SMELL: This should be done in the query parser...
847 # ... or at least use Regexp::Grammars
848 # TODO: member selectors may only be on 1 or 2 keys, or array index
849 if (
850 $path =~ /^
851 ( # 1
852 '([^']+)' # 2 'Web.Topic@123'
853 \s* \/ \s*
854 )?
855 (META:)? # 3 META:
856 ([^\[\s\.]+) # 4 PART, FIELD, alias, MyForm, FieldName
857 (\s* \[ \s* # 5 [............]
858 ( # 6 n (or)
859 [-\+]?\d+
860 |( # 7 name='foo'[ AND bar='cat' [ AND dog='bat' ...]]
861 ([^=\s]+) # 8 name
862 \s* = \s* # =
863 '([^']+)' # 9 'foo'
864 ( # 10 multi-key selector?
865 \s* AND \s*
866 ([^=\s]+) # 11 bar
867 \s* = \s* # =
868 '([^']+)' # 12 'cat'
869 )?
870 )
871 )
872 \s* \])?
873 (\s* \. \s* # 13 .
874 (\w+?) # 14 value
875 )?
876 $/x
877 )
878 {
879 my $topic = $2;
880 my @tompath;
881 my $doneselector;
882 my $doneaccessor;
883
884 if ($3) { # META:
885 @tompath = ('META');
886 push( @tompath, $4 );
887 if ( not $5 and $14 ) { # Eg. META:TOPICINFO.author
888 push( @tompath, undef, $14 );
889 $doneselector = 1;
890 $doneaccessor = 1;
891 }
892 }
893 elsif ( $pathtypes{$4} ) { # META, attachment, SECTION, text
894 @tompath = ($4);
895 }
896 elsif ( $Foswiki::Meta::aliases{$4} ) { # fields, attachments, info
897 @tompath = ('META');
898
899 # strip off the 'META:' part
900 push( @tompath, substr( $Foswiki::Meta::aliases{$4}, 5 ) );
901 if ( not $5 and $14 ) { # Eg. info.author
902 push( @tompath, undef, $14 );
903 $doneselector = 1;
904 $doneaccessor = 1;
905 }
906 }
907 elsif ($4) { # SomeFormField or SomethingForm
908 @tompath = ('META');
909 push( @tompath, 'FIELD' );
910 if ( not( $14 or $6 ) ) { # SomeFormField
911 # SMELL: This catches "'Web.Topic@123'/MyForm" & "MyForm"
912 push( @tompath, { name => $4 }, 'value' );
913 $doneselector = 1;
914 $doneaccessor = 1;
915 }
916 elsif ( substr( $4, -4, 4 ) eq 'Form' ) { # SomethingForm
917 push( @tompath, { form => $4 } );
918 if ($8) { # SomethingForm[a=b
919 ASSERT( defined $9 ) if DEBUG;
920 $tompath[-1]->{$8} = $9;
921 if ($11) { # SomethingForm[a=b AND c=d]
922 ASSERT( defined $12 ) if DEBUG;
923 $tompath[-1]->{$11} = $12;
924 }
925 $doneselector = 1;
926 }
927 elsif ($6) { # SomethingForm[n]
928 push( @tompath, $6 );
929 $doneselector = 1;
930 ASSERT( $6 =~ /^\d+$/ ) if DEBUG;
931 }
932 elsif ($14) {
933 $tompath[-1]->{name} = $14;
934 push( @tompath, 'value' );
935 $doneaccessor = 1;
936 }
937 }
938 elsif (DEBUG) { # form not /Form$/ or alias from disabled plugin
939 ASSERT(0);
940 }
941 }
942 elsif (DEBUG) { # Shouldn't get here
943 ASSERT(0);
944 }
945 if ( not $doneselector and $6 ) { # SOMETHING[...]
946 if ($8) { # SOMETHING[a=b
947 ASSERT( defined $9 ) if DEBUG;
948 push( @tompath, { $8 => $9 } );
949 if ($11) { # SOMETHING[a=b AND c=d]
950 ASSERT( defined $12 ) if DEBUG;
951 $tompath[-1]->{$11} = $12;
952 }
953 }
954 else { # SOMETHING[n]
955 ASSERT($6) if DEBUG;
956 push( @tompath, $6 );
957 ASSERT( $6 =~ /^\d+$/ ) if DEBUG;
958 }
959 $doneselector = 1;
960 }
961 if ( not $doneaccessor and $14 ) {
962 push( @tompath, $14 );
963 }
964 $that->{tompath} = \@tompath;
965 if ($topic) {
966 my $refAddr = Foswiki::Address->new(
967 string => $topic,
968 isA => 'topic',
969 webpath => $opts->{webpath},
970 web => $opts->{web}
971 );
972
973 $that->{web} = $refAddr->{web};
974 $that->{webpath} = $refAddr->{webpath};
975 $that->{topic} = $refAddr->{topic};
976 $that->{rev} = $refAddr->{rev};
977 }
978 else {
979 $that->{webpath} = $opts->{webpath};
980 $that->{topic} = $opts->{topic};
981 $that->{rev} = undef;
982 ASSERT( $that->{webpath} ) if DEBUG;
983 ASSERT( $that->{topic} ) if DEBUG;
984 }
985 }
986
987 return $that;
988}
989
990sub _existScore {
991 my ( $this, $atoms, $type ) = @_;
992 my $score;
993 my $perfecttype;
994
995 ASSERT( not $atoms->{tompath} or ref( $atoms->{tompath} ) eq 'ARRAY' )
996 if DEBUG;
997 ASSERT( $atoms->{web} or ref( $atoms->{webpath} ) eq 'ARRAY' ) if DEBUG;
998 if (
999 $atoms->{tompath}
1000 and scalar( @{ $atoms->{tompath} } ) == 2
1001 and ( $atoms->{tompath}->[0] eq 'attachment' )
1002 and Foswiki::Func::attachmentExists(
1003 $atoms->{web}, $atoms->{topic}, $atoms->{tompath}->[1]
1004 )
1005 )
1006 {
1007 ASSERT( $atoms->{attachment}
1008 and $atoms->{attachment} eq $atoms->{tompath}->[1] )
1009 if DEBUG;
1010 $perfecttype = $type;
1011 $score = 2 + scalar( @{ $atoms->{webpath} } );
1012 }
1013 elsif ( $atoms->{topic}
1014 and Foswiki::Func::topicExists( $atoms->{web}, $atoms->{topic} ) )
1015 {
1016 if ( $type eq 'topic' ) {
1017 $perfecttype = $type;
1018 }
1019 $score = 1 + scalar( @{ $atoms->{webpath} } );
1020 }
1021 elsif ( $atoms->{web} and Foswiki::Func::webExists( $atoms->{web} ) ) {
1022 if ( $type eq 'web' ) {
1023 $perfecttype = $type;
1024 }
1025 $score = scalar( @{ $atoms->{webpath} } );
1026 }
1027 elsif ( $atoms->{webpath} ) {
1028 ASSERT( scalar( @{ $atoms->{webpath} } ) ) if DEBUG;
1029 ASSERT( ref( $atoms->{webpath} ) eq 'ARRAY' ) if DEBUG;
1030 my $i = scalar( @{ $atoms->{webpath} } );
1031 my $nAtoms = scalar( @{ $atoms->{webpath} } );
1032
1033 while ( $i > 0 and not $score ) {
1034 $i -= 1;
1035 if (
1036 Foswiki::Func::webExists(
1037 join( '/', @{ $atoms->{webpath} }[ 0 .. $i ] )
1038 )
1039 )
1040 {
1041 $score = $i + 1;
1042 }
1043 }
1044 }
1045
1046 return ( $perfecttype, $score );
1047}
1048
1049=begin TML
1050
1051---++ ClassMethod stringify ( %opts ) => $string
1052
1053Return a string representation of the address.
1054
1055=%opts=:
1056 * =webseparator= - '/' or '.'; default: '/'
1057 * =topicseparator= - '/' or '.'; default: '.'
1058
1059The output of =stringify()= is understood by =parse()=, and vice versa.
1060
1061=cut
1062
1063sub stringify {
1064 my ( $this, %opts ) = @_;
1065
1066 ASSERT( $this->{web} or ref( $this->{webpath} ) eq 'ARRAY' ) if DEBUG;
1067
1068 # If there's a valid address; and check that we haven't already computed
1069 # the stringification before with the same opts
1070 if (
1071 $this->isValid()
1072 and (
1073 not $this->{stringified}
1074 or ( $opts{webseparator}
1075 and $opts{webseparator} ne $this->{stringifiedwebsep} )
1076 or ( $opts{topicseparator}
1077 and $opts{topicseparator} ne $this->{stringifiedtopicsep} )
1078 )
1079 )
1080 {
1081 $this->{stringifiedwebsep} = $opts{webseparator}
1082 || '/';
1083 $this->{stringifiedtopicsep} = $opts{topicseparator}
1084 || '.';
1085 $this->{stringified} =
1086 join( $this->{stringifiedwebsep}, @{ $this->{webpath} } );
1087 if ( $this->{topic} ) {
1088 $this->{stringified} .=
1089 $this->{stringifiedtopicsep} . $this->{topic};
1090 if ( $this->{tompath} ) {
1091 ASSERT( ref( $this->{tompath} ) eq 'ARRAY'
1092 and scalar( @{ $this->{tompath} } ) )
1093 if DEBUG;
1094 print STDERR 'tompath: ' . Dumper( $this->{tompath} )
1095 if TRACEATTACH;
1096 print STDERR 'attachment: ' . Dumper( $this->{attachment} )
1097 if TRACEATTACH;
1098 ASSERT(
1099 $this->{tompath}->[0] ne 'attachment'
1100 or not $this->{tompath}->[1]
1101 or ( $this->{attachment}
1102 and $this->{attachment} eq $this->{tompath}->[1] )
1103 ) if DEBUG;
1104 if ( $this->{tompath}->[0] eq 'attachment'
1105 and scalar( @{ $this->{tompath} } ) == 2 )
1106 {
1107 $this->{stringified} .= '/' . $this->{tompath}->[1];
1108 if ( defined $this->{rev} ) {
1109 $this->{stringified} .= '@' . $this->{rev};
1110 }
1111 }
1112 else {
1113 if ( defined $this->{rev} ) {
1114 $this->{stringified} .= '@' . $this->{rev};
1115 }
1116 $this->{stringified} = '\''
1117 . $this->{stringified} . '\'/'
1118 . $this->{tompath}->[0];
1119 if ( $this->{tompath}->[1] ) {
1120 my @path = @{ $this->{tompath} };
1121 my $root = shift(@path);
1122
1123 if ( $root eq 'META' and scalar(@path) ) {
1124 $this->{stringified} .= ':' . shift(@path);
1125 }
1126 if ( scalar(@path) ) {
1127 if ( defined $path[0] ) {
1128 $this->{stringified} .= '[';
1129 if ( ref( $path[0] ) eq 'HASH' ) {
1130 my @selectorparts;
1131 while ( my ( $key, $value ) =
1132 each %{ $path[0] } )
1133 {
1134 push( @selectorparts,
1135 $key . '=\'' . $value . '\'' );
1136 }
1137 $this->{stringified} .=
1138 join( ' AND ', @selectorparts );
1139 shift(@path);
1140 }
1141 else {
1142 ASSERT( $path[0] =~ /^\d+$/ ) if DEBUG;
1143 $this->{stringified} .= shift(@path);
1144 }
1145 $this->{stringified} .= ']';
1146 }
1147 else {
1148 shift @path;
1149 }
1150 if ( scalar(@path) ) {
1151 ASSERT( scalar(@path) == 1 ) if DEBUG;
1152 $this->{stringified} .= '.' . shift(@path);
1153 }
1154 }
1155 ASSERT( not scalar(@path) ) if DEBUG;
1156 }
1157 }
1158 }
1159 elsif ( defined $this->{rev} ) {
1160 $this->{stringified} .= '@' . $this->{rev};
1161 }
1162 }
1163 else {
1164 ASSERT( $this->{webpath} );
1165 $this->{stringified} .= $this->{stringifiedwebsep};
1166 }
1167 }
1168 print STDERR "stringify(): $this->{stringified}\n"
1169 if TRACE2 and $this->{stringified};
1170
1171 return $this->{stringified};
1172}
1173
1174=begin TML
1175
1176---++ EXPERIMENTAL ClassMethod root( [$boolean] ) => $boolean
1177
1178 * =$boolean= - optional, set the hypothetical Foswiki 'root'. Since all
1179 Foswiki resources must exist under the root, a false value here basically
1180 means the address object is an undefined/invalid state.
1181
1182Get/set root
1183
1184<blockquote class="tml">%X% This method (and the =root= attribute generally)
1185may be removed before we release Foswiki 1.2/2.0. We would rather use web => '/'
1186</blockquote>
1187
1188=cut
1189
1190sub root {
1191 my ( $this, $root ) = @_;
1192
1193 if ( scalar(@_) == 2 ) {
1194 $this->{root} = $root;
1195 $this->_invalidate();
1196 }
1197 else {
1198 $this->isValid();
1199 }
1200
1201 return $this->{root};
1202}
1203
1204=begin TML
1205
1206---++ ClassMethod web( [$name] ) => $name
1207
1208 * =$name= - optional, set a new web name
1209
1210Get/set by web string
1211
1212=cut
1213
1214sub web {
1215 my ( $this, $web ) = @_;
1216
1217 ASSERT(
1218 scalar(@_) == 2
1219 or
1220 ( defined( $this->{webpath} ) and ref( $this->{webpath} ) eq 'ARRAY' )
1221 ) if DEBUG;
1222 if ( scalar(@_) == 2 ) {
1223 $this->webpath( [ split( /[\/\.]/, $web ) ] );
1224 }
1225 if ( not $this->{web} and defined( $this->{webpath} ) ) {
1226 $this->{web} = join( '/', @{ $this->{webpath} } );
1227 }
1228 print STDERR "web(): no web part!\n" if TRACE and not $this->{web};
1229
1230 return $this->{web};
1231}
1232
1233=begin TML
1234
1235---++ ClassMethod webpath( [\@webpath] ) => \@webpath
1236
1237 * =\@webpath= - optional, set a new webpath arrayref
1238
1239Get/set the webpath arrayref
1240
1241=cut
1242
1243sub webpath {
1244 my ( $this, $webpath ) = @_;
1245
1246 if ( scalar(@_) == 2 ) {
1247 $this->{webpath} = $webpath;
1248 $this->_invalidate();
1249 }
1250
1251 return $this->{webpath};
1252}
1253
1254=begin TML
1255
1256---++ ClassMethod topic( [$name] ) => $name
1257
1258 * =$name= - optional, set a new topic name
1259
1260Get/set the topic name
1261
1262=cut
1263
1264sub topic {
1265 my ( $this, $topic ) = @_;
1266
1267 if ( scalar(@_) == 2 ) {
1268 $this->{topic} = $topic;
1269 $this->_invalidate();
1270 ASSERT( $this->isValid() ) if DEBUG;
1271 }
1272 else {
1273 $this->isValid();
1274 }
1275
1276 return $this->{topic};
1277}
1278
1279=begin TML
1280
1281---++ ClassMethod attachment( [$file] ) => $file
1282
1283 * =$file= - optional, set a new file attachment name
1284
1285Get/set the file attachment name
1286
1287=cut
1288
1289sub attachment {
1290 my ( $this, $attachment ) = @_;
1291
1292 if ( scalar(@_) == 2 ) {
1293 $this->{attachment} = $attachment;
1294 $this->{tompath} = [ 'attachment', $attachment ];
1295 $this->_invalidate();
1296 ASSERT( $this->isValid() ) if DEBUG;
1297 }
1298 else {
1299 $this->isValid();
1300 }
1301
1302 return $this->{attachment};
1303}
1304
1305=begin TML
1306
1307---++ ClassMethod rev( [$rev] ) => $rev
1308
1309 * =$rev= - optional, set rev number
1310
1311Get/set the rev
1312
1313=cut
1314
1315sub rev {
1316 my ( $this, $rev ) = @_;
1317
1318 if ( scalar(@_) == 2 ) {
1319 $this->{rev} = $rev;
1320 $this->_invalidate();
1321 ASSERT( $this->isValid() ) if DEBUG;
1322 }
1323 else {
1324 $this->isValid();
1325 }
1326
1327 return $this->{rev};
1328}
1329
1330=begin TML
1331
1332---++ ClassMethod tompath( [\@tompath] ) => \@tompath
1333
1334 * =\@tompath= - optional, =tompath= specification into the containing topic.
1335 The first =$tompath->[0]= element in the array should be one of the following
1336 * ='attachment'=: =$tompath->[1]= should be a string, Eg. ='Attachment.pdf'=.
1337 * ='META'=: =$tompath->[1..3]= identify which =META:&lt;type&gt;= or member
1338 or member key is being addressed:
1339 * =$tompath->[1]= contains the =META:&lt;type&gt;=, Eg. ='FIELD'=
1340 * =$tompath->[2]= contains a selector to identify a member of the type:
1341 * =undef=, for singleton types (such as ='TOPICINFO'=)
1342 * integer array index
1343 * hashref =key => 'value'= pairs, Eg. ={name => 'Colour'}=.
1344 ={name => 'Colour', form => 'MyForm'}= is also supported.
1345 * =$tompath->[3]= contains the name of a key on the selected member,
1346 Eg. ='value'=
1347 * ='SECTION'=: =$tompath->[1]= should be a hashref, Eg.
1348 ={name => 'mysection', type => 'include'}=
1349 * ='text'=: addresses the topic text
1350
1351Get/set the tompath into a topic
1352
1353=cut
1354
1355sub tompath {
1356 my ( $this, $tompath ) = @_;
1357
1358 if ( scalar(@_) == 2 ) {
1359 $this->{tompath} = $tompath;
1360 $this->_invalidate();
1361 ASSERT(
1362 not defined $tompath
1363 or ( defined $tompath
1364 and ref($tompath) eq 'ARRAY'
1365 and scalar( @{$tompath} ) )
1366 ) if DEBUG;
1367 }
1368 else {
1369 $this->isValid();
1370 }
1371
1372 return $this->{tompath};
1373}
1374
1375=begin TML
1376
1377---++ ClassMethod type() => $resourcetype
1378
1379Returns the resource type name.
1380
1381=cut
1382
1383sub type {
1384 my ($this) = @_;
1385
1386 return $this->isValid();
1387}
1388
1389=begin TML
1390
1391---++ ClassMethod isA([$resourcetype]) => $boolean
1392
1393Returns true if the address points to a resource of the specified type.
1394
1395=cut
1396
1397sub isA {
1398 my ( $this, $resourcetype ) = @_;
1399 my $result;
1400
1401 if ( $resourcetype and $this->isValid() ) {
1402 $result = $this->{isA}->{$resourcetype};
1403 }
1404
1405 return $result;
1406}
1407
1408=begin TML
1409
1410---++ ClassMethod isValid() => $resourcetype
1411
1412Returns true if the instance addresses a resource which is one of the following
1413types:
1414 * webpath, Eg. =Web/SubWeb/=
1415 * topic, Eg. =Web/SubWeb.Topic=
1416 * attachment, Eg. =Web/SubWeb.Topic/Attachment.pdf=
1417 * attachments , Eg. ='Web/SubWeb.Topic/attachment'=
1418 * meta, Eg. ='Web/SubWeb.Topic'/META=
1419 * metatype, Eg. ='Web/SubWeb.Topic'/META:FIELD=
1420 * metamember, Eg. ='Web/SubWeb.Topic'/META:FIELD[name='Colour']= or ='Web/SubWeb.Topic'/META:FIELD[0]=
1421 * metakey, Eg. ='Web/SubWeb.Topic'/META:FIELD[name='Colour'].value= or ='Web/SubWeb.Topic'/META:FIELD[0].value=
1422 * section, Eg. ='Web/SubWeb.Topic'/SECTION[name='something']=
1423 * sections, Eg. ='Web/SubWeb.Topic'/SECTION=
1424 * text, Eg. ='Web/SubWeb.Topic'/text=
1425
1426=cut
1427
1428sub isValid {
1429 my ($this) = @_;
1430
1431 if ( not defined $this->{isA} ) {
1432 if ( $this->{topic} ) {
1433 if ( $this->{webpath} ) {
1434 if ( $this->{attachment} ) {
1435 $this->{type} = 'attachment';
1436 }
1437 elsif ( $this->{tompath} ) {
1438 ASSERT( ref( $this->{tompath} ) eq 'ARRAY'
1439 and scalar( @{ $this->{tompath} } ) )
1440 if DEBUG;
1441 ASSERT(
1442 not( $this->{topmath}->[0]
1443 and $this->{topmath}->[0] eq 'attachment' )
1444 ) if DEBUG;
1445 ASSERT( $pathtypes{ $this->{tompath}->[0] } ) if DEBUG;
1446 $this->{type} =
1447 $pathtypes{ $this->{tompath}->[0] }
1448 ->{ scalar( @{ $this->{tompath} } ) };
1449 }
1450 else {
1451 ASSERT( not defined $this->{tompath} ) if DEBUG;
1452 $this->{type} = 'topic';
1453 }
1454 }
1455 }
1456 elsif ( $this->{webpath}
1457 and not defined $this->{tompath} )
1458 {
1459 $this->{type} = 'webpath';
1460 }
1461 elsif ( $this->{root} ) {
1462 $this->{type} = 'root';
1463 }
1464 else {
1465 $this->{type} = undef;
1466 }
1467 if ( $this->{type} ) {
1468 $this->{isA} = { $this->{type} => 1 };
1469 $this->{root} = 1;
1470 }
1471 else {
1472 $this->{isA} = {};
1473 }
1474 }
1475
1476 return $this->{type};
1477}
1478
1479# Internally, this is called so that the next isValid() call will re-evaluate
1480# identity and validity of the instance; also, if any of the setters are used,
1481# invalidates the cached stringify value
1482sub _invalidate {
1483 my ($this) = @_;
1484
1485 $this->{stringified} = undef;
1486 $this->{isA} = undef;
1487
1488 return;
1489}
1490
1491=begin TML
1492
1493---++ ClassMethod equiv ( $otherAddr ) => $boolean
1494
1495Return true if this address resolves to the same resource as =$otherAddr=
1496
1497=cut
1498
1499sub equiv {
1500 my ( $this, $other ) = @_;
1501 my $nwebpath;
1502 my $equal = 0;
1503 my $thistype = $this->type();
1504 my $othertype = $other->type();
1505
1506 # Same type?
1507 if ( $thistype and $othertype and $thistype eq $othertype ) {
1508
1509 # Confirm the ->type() is sane
1510 ASSERT(
1511 ( not defined $this->{tompath} and not defined $other->{tompath} )
1512 or ( defined $this->{tompath}
1513 and defined $other->{tompath}
1514 and ref( $this->{tompath} ) eq 'ARRAY'
1515 and ref( $other->{tompath} ) eq 'ARRAY'
1516 and scalar( @{ $this->{tompath} } )
1517 and scalar( @{ $other->{tompath} } )
1518 and scalar( @{ $this->{tompath} } ) ==
1519 scalar( @{ $other->{tompath} } ) )
1520 ) if DEBUG;
1521 ASSERT(
1522 ( not defined $this->{tompath} and not defined $other->{tompath} )
1523 or ( defined $this->{tompath}
1524 and defined $other->{tompath}
1525 and $this->{tompath}->[0] eq $other->{tompath}->[0] )
1526 ) if DEBUG;
1527 if ( $this->{webpath} ) {
1528 if ( $this->_eq( $this->{webpath}, $other->{webpath} ) ) {
1529 if ( $this->_eq( $this->{topic}, $other->{topic} ) ) {
1530 if ( $this->_eq( $this->{tompath}, $other->{tompath} ) ) {
1531 $equal = 1;
1532 }
1533 elsif (TRACE) {
1534 print STDERR "equiv(): tompaths weren't equal\n";
1535 }
1536 }
1537 elsif (TRACE) {
1538 print STDERR "equiv(): topics weren't equal\n";
1539 }
1540 }
1541 elsif (TRACE) {
1542 print STDERR "equiv(): webpath wasn't equal\n";
1543 }
1544 }
1545 elsif ( $this->{root} ) {
1546 if ( $other->{root} ) {
1547 $equal = 1;
1548 }
1549 elsif (TRACE) {
1550 print STDERR "equiv(): roots weren't equal\n";
1551 }
1552 }
1553 }
1554 elsif (TRACE) {
1555 print STDERR "equiv(): types weren't equal\n";
1556 }
1557 if ( not $equal ) {
1558 print STDERR "equiv(): NOT equal "
1559 . Dumper($this) . " vs "
1560 . Dumper($other) . "\n"
1561 if TRACE;
1562 }
1563
1564 return $equal;
1565}
1566
1567sub _eq {
1568 my ( $this, $a, $b ) = @_;
1569 my $equal = 1;
1570 my $refA = ref($a);
1571 my $refB = ref($b);
1572
1573 if ($refA) {
1574 if ( $refB and $refA eq $refB ) {
1575 if ( $refA eq 'ARRAY' ) {
1576 my $n = scalar( @{$a} );
1577
1578 if ( $n == scalar( @{$b} ) ) {
1579 my $i = 0;
1580
1581 while ( $equal and $i < $n ) {
1582 $equal = $this->_eq( $a->[$i], $b->[$i] );
1583 $i += 1;
1584 }
1585 }
1586 else {
1587 $equal = 0;
1588 }
1589 }
1590 elsif ( $refB eq 'HASH' ) {
1591 my @keys = keys %{$a};
1592 my $n = scalar(@keys);
1593
1594 if ( $n == scalar( keys %{$b} ) ) {
1595 my $i = 0;
1596
1597 while ( $equal and $i < $n ) {
1598 if ( exists $b->{ $keys[$i] } ) {
1599 $equal =
1600 $this->_eq( $a->{ $keys[$i] },
1601 $b->{ $keys[$i] } );
1602 $i += 1;
1603 }
1604 else {
1605 $equal = 0;
1606 }
1607 }
1608 }
1609 }
1610 }
1611 }
1612 elsif ($refB
1613 or ( defined $a and not defined $b or not defined $a and defined $b )
1614 or ( defined $a and defined $b and $a ne $b ) )
1615 {
1616 $equal = 0;
1617 }
1618
1619 return $equal;
1620}
1621
1622140µs1;
1623__END__