Filename | /usr/local/src/github.com/foswiki/core/lib/Foswiki/Address.pm |
Statements | Executed 21 statements in 9.42ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 24µs | 31µs | BEGIN@63 | Foswiki::Address::
1 | 1 | 1 | 24µs | 45µs | BEGIN@64 | Foswiki::Address::
1 | 1 | 1 | 21µs | 111µs | BEGIN@73 | Foswiki::Address::
1 | 1 | 1 | 16µs | 52µs | BEGIN@66 | Foswiki::Address::
1 | 1 | 1 | 16µs | 109µs | BEGIN@72 | Foswiki::Address::
1 | 1 | 1 | 16µs | 113µs | BEGIN@71 | Foswiki::Address::
1 | 1 | 1 | 9µs | 9µs | BEGIN@67 | Foswiki::Address::
1 | 1 | 1 | 9µs | 9µs | BEGIN@68 | Foswiki::Address::
0 | 0 | 0 | 0s | 0s | _atomiseAsAttachment | Foswiki::Address::
0 | 0 | 0 | 0s | 0s | _atomiseAsRoot | Foswiki::Address::
0 | 0 | 0 | 0s | 0s | _atomiseAsTOM | Foswiki::Address::
0 | 0 | 0 | 0s | 0s | _atomiseAsTopic | Foswiki::Address::
0 | 0 | 0 | 0s | 0s | _atomiseAsWeb | Foswiki::Address::
0 | 0 | 0 | 0s | 0s | _eq | Foswiki::Address::
0 | 0 | 0 | 0s | 0s | _existScore | Foswiki::Address::
0 | 0 | 0 | 0s | 0s | _invalidate | Foswiki::Address::
0 | 0 | 0 | 0s | 0s | attachment | Foswiki::Address::
0 | 0 | 0 | 0s | 0s | equiv | Foswiki::Address::
0 | 0 | 0 | 0s | 0s | finish | Foswiki::Address::
0 | 0 | 0 | 0s | 0s | isA | Foswiki::Address::
0 | 0 | 0 | 0s | 0s | isValid | Foswiki::Address::
0 | 0 | 0 | 0s | 0s | new | Foswiki::Address::
0 | 0 | 0 | 0s | 0s | parse | Foswiki::Address::
0 | 0 | 0 | 0s | 0s | rev | Foswiki::Address::
0 | 0 | 0 | 0s | 0s | root | Foswiki::Address::
0 | 0 | 0 | 0s | 0s | stringify | Foswiki::Address::
0 | 0 | 0 | 0s | 0s | tompath | Foswiki::Address::
0 | 0 | 0 | 0s | 0s | topic | Foswiki::Address::
0 | 0 | 0 | 0s | 0s | type | Foswiki::Address::
0 | 0 | 0 | 0s | 0s | web | Foswiki::Address::
0 | 0 | 0 | 0s | 0s | webpath | Foswiki::Address::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | # See bottom of file for license and copyright information | ||||
2 | |||||
3 | package Foswiki::Address; | ||||
4 | |||||
5 | =begin TML | ||||
6 | |||||
7 | ---+ package Foswiki::Address | ||||
8 | |||||
9 | This class is used to handle pointers to Foswiki 'resources', which might be | ||||
10 | webs, topics or parts of topics (such as attachments or metadata), optionally | ||||
11 | of a specific revision. | ||||
12 | |||||
13 | The primary goal is to end the tyranny of arbitrary | ||||
14 | =(web, topic, attachment, rev...)= tuples. Users of =Foswiki::Address= should | ||||
15 | be able to enjoy programmatically updating, stringifying, parsing, validating, | ||||
16 | comparing and passing around of _address objects_ that might eventually be | ||||
17 | understood by the wider Foswiki universe, without having to maintain proprietary | ||||
18 | parse/stringify/validate/comparison handling code that must always be | ||||
19 | considerate of the recipient for such tuples. | ||||
20 | |||||
21 | This class does not offer any interaction with resources themselves; rather, | ||||
22 | functionality is provided to create, hold, manipulate, test | ||||
23 | __and de/serialise addresses__ | ||||
24 | |||||
25 | Fundamentally, =Foswiki::Address= can be thought of as an interface to a hash of | ||||
26 | the components necessary to address a specific Foswiki resource. | ||||
27 | |||||
28 | <verbatim> | ||||
29 | my $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 | |||||
63 | 2 | 48µs | 2 | 38µ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 # spent 31µs making 1 call to Foswiki::Address::BEGIN@63
# spent 7µs making 1 call to strict::import |
64 | 2 | 47µs | 2 | 67µ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 # spent 45µs making 1 call to Foswiki::Address::BEGIN@64
# spent 22µs making 1 call to warnings::import |
65 | |||||
66 | 2 | 41µs | 2 | 89µ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 # spent 52µs making 1 call to Foswiki::Address::BEGIN@66
# spent 36µs making 1 call to Assert::import |
67 | 2 | 37µs | 1 | 9µ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 # spent 9µs making 1 call to Foswiki::Address::BEGIN@67 |
68 | 2 | 43µs | 1 | 9µ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 # spent 9µs making 1 call to Foswiki::Address::BEGIN@68 |
69 | |||||
70 | #use Data::Dumper; | ||||
71 | 2 | 47µs | 2 | 211µ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 # spent 113µs making 1 call to Foswiki::Address::BEGIN@71
# spent 98µs making 1 call to constant::import |
72 | 2 | 45µs | 2 | 202µ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 # spent 109µs making 1 call to Foswiki::Address::BEGIN@72
# spent 94µs making 1 call to constant::import |
73 | 2 | 9.00ms | 2 | 201µ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 # spent 111µs making 1 call to Foswiki::Address::BEGIN@73
# spent 90µs making 1 call to constant::import |
74 | |||||
75 | 1 | 12µs | my %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) } | ||||
89 | 1 | 14µs | my %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. | ||||
98 | 1 | 39µs | my %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 | ); | ||||
181 | 1 | 7µs | my %sepidentchars = | ||
182 | ( 0 => { '.' => 'd', '/' => 's' }, 1 => { '.' => 'D', '/' => 'S' } ); | ||||
183 | |||||
184 | =begin TML | ||||
185 | |||||
186 | ---++ ClassMethod new( %constructor ) => $addrObj | ||||
187 | |||||
188 | Create a =Foswiki::Address= instance | ||||
189 | |||||
190 | The constructor takes two main forms: | ||||
191 | |||||
192 | ---+++ Explicit form | ||||
193 | *Example:* | ||||
194 | <verbatim> | ||||
195 | my $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> | ||||
228 | my $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"}% | ||||
236 | or | ||||
237 | %QUERY{"'Web/SubWeb.Topic'/LastName"}% | ||||
238 | </verbatim> | ||||
239 | |||||
240 | ---+++ String form | ||||
241 | *Example:* | ||||
242 | <verbatim> | ||||
243 | my $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 | ||||
249 | of the address string which comes with many options and caveats - refer to the | ||||
250 | documentation for =parse()=.</blockquote> | ||||
251 | |||||
252 | =cut | ||||
253 | |||||
254 | sub 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 | |||||
344 | Clean up the object, releasing any memory stored in it. | ||||
345 | |||||
346 | =cut | ||||
347 | |||||
348 | sub 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 | |||||
372 | Parse the given string (using options provided at instantiation, unless =%opts= | ||||
373 | overrides them) and update the instance with the resulting address. | ||||
374 | |||||
375 | Examples 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 | ||||
388 | following 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 | |||||
394 | To resolve the ambiguity, components of ambiguous strings are tested for | ||||
395 | existence as webs, topics or attachments and used as hints to help resolve them, | ||||
396 | so it follows that: | ||||
397 | <blockquote class="foswikiHelp">%X% Ambiguous address strings cannot be | ||||
398 | considered stable; exactly which resource they resolve to depends on the | ||||
399 | hinting 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 | |||||
424 | To 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 '/' | ||||
429 | Examples: | ||||
430 | * =Web/SubWeb/=, =Web/= | ||||
431 | * =Web/SubWeb.Topic= | ||||
432 | * =Web.Topic/Attachment.pdf= | ||||
433 | * =Web/SubWeb.Topic/Attachment.pdf= | ||||
434 | |||||
435 | Many 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 | ||||
437 | prevent the parser from using the (somewhat expensive) exist hinting heuristics. | ||||
438 | |||||
439 | <blockquote class="foswikiHelp">%I% In order to simplify the algorithm, a | ||||
440 | string 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 | |||||
446 | The exist hinting algorithm is skipped if: | ||||
447 | * =isA= specified | ||||
448 | * =string= not ambiguous | ||||
449 | |||||
450 | If =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 | ||||
461 | The following table attempts to explain how ambiguous forms can be interpreted | ||||
462 | and 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 | |||||
497 | sub 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 | |||||
716 | sub _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 | |||||
731 | sub _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 | |||||
751 | sub _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 | |||||
784 | sub _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 | |||||
811 | Parse a small subset ('static' meta path forms) of QuerySearch (VarQUERY) | ||||
812 | compatible expressions. | ||||
813 | |||||
814 | =$opts= is a hashref holding default context | ||||
815 | |||||
816 | 'topic'/ ref part is optional; =_atomiseAsTOM()= falls-back to default topic | ||||
817 | context supplied in =$opts= otherwise. In other words, both of these forms are | ||||
818 | supported: | ||||
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 | |||||
840 | sub _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 | |||||
990 | sub _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 | |||||
1053 | Return a string representation of the address. | ||||
1054 | |||||
1055 | =%opts=: | ||||
1056 | * =webseparator= - '/' or '.'; default: '/' | ||||
1057 | * =topicseparator= - '/' or '.'; default: '.' | ||||
1058 | |||||
1059 | The output of =stringify()= is understood by =parse()=, and vice versa. | ||||
1060 | |||||
1061 | =cut | ||||
1062 | |||||
1063 | sub 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 | |||||
1182 | Get/set root | ||||
1183 | |||||
1184 | <blockquote class="tml">%X% This method (and the =root= attribute generally) | ||||
1185 | may be removed before we release Foswiki 1.2/2.0. We would rather use web => '/' | ||||
1186 | </blockquote> | ||||
1187 | |||||
1188 | =cut | ||||
1189 | |||||
1190 | sub 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 | |||||
1210 | Get/set by web string | ||||
1211 | |||||
1212 | =cut | ||||
1213 | |||||
1214 | sub 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 | |||||
1239 | Get/set the webpath arrayref | ||||
1240 | |||||
1241 | =cut | ||||
1242 | |||||
1243 | sub 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 | |||||
1260 | Get/set the topic name | ||||
1261 | |||||
1262 | =cut | ||||
1263 | |||||
1264 | sub 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 | |||||
1285 | Get/set the file attachment name | ||||
1286 | |||||
1287 | =cut | ||||
1288 | |||||
1289 | sub 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 | |||||
1311 | Get/set the rev | ||||
1312 | |||||
1313 | =cut | ||||
1314 | |||||
1315 | sub 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:<type>= or member | ||||
1338 | or member key is being addressed: | ||||
1339 | * =$tompath->[1]= contains the =META:<type>=, 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 | |||||
1351 | Get/set the tompath into a topic | ||||
1352 | |||||
1353 | =cut | ||||
1354 | |||||
1355 | sub 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 | |||||
1379 | Returns the resource type name. | ||||
1380 | |||||
1381 | =cut | ||||
1382 | |||||
1383 | sub type { | ||||
1384 | my ($this) = @_; | ||||
1385 | |||||
1386 | return $this->isValid(); | ||||
1387 | } | ||||
1388 | |||||
1389 | =begin TML | ||||
1390 | |||||
1391 | ---++ ClassMethod isA([$resourcetype]) => $boolean | ||||
1392 | |||||
1393 | Returns true if the address points to a resource of the specified type. | ||||
1394 | |||||
1395 | =cut | ||||
1396 | |||||
1397 | sub 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 | |||||
1412 | Returns true if the instance addresses a resource which is one of the following | ||||
1413 | types: | ||||
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 | |||||
1428 | sub 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 | ||||
1482 | sub _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 | |||||
1495 | Return true if this address resolves to the same resource as =$otherAddr= | ||||
1496 | |||||
1497 | =cut | ||||
1498 | |||||
1499 | sub 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 | |||||
1567 | sub _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 | |||||
1622 | 1 | 40µs | 1; | ||
1623 | __END__ |