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

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