/[suikacvs]/messaging/manakai/lib/Message/URI/Generic.dis
Suika

Contents of /messaging/manakai/lib/Message/URI/Generic.dis

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1.9 - (show annotations) (download)
Sat Dec 30 08:27:50 2006 UTC (17 years, 10 months ago) by wakaba
Branch: MAIN
Changes since 1.8: +6 -30 lines 
++ manakai/bin/ChangeLog	30 Dec 2006 06:47:17 -0000
2006-12-30  Wakaba  <wakaba@suika.fam.cx>

	* idl2dis.pl: Removed.

++ manakai/lib/Message/Markup/ChangeLog	30 Dec 2006 08:26:03 -0000
	* Atom.dis, SuikaWiki.dis, H2H.dis: |WithFor|
	and |DefaultFor| properties are removed.

2006-12-30  Wakaba  <wakaba@suika.fam.cx>

++ manakai/lib/Message/Util/ChangeLog	30 Dec 2006 08:26:59 -0000
	* PerlCode.dis: |WithFor| and |DefaultFor| are removed.

2006-12-30  Wakaba  <wakaba@suika.fam.cx>

++ manakai/lib/Message/DOM/ChangeLog	30 Dec 2006 08:25:38 -0000
        GenericLS.dis, TreeCore.dis, DOMString.dis,
        XML.dis, Element.dis, Document.dis, TreeStore,dis,
        Traversal.dis, XDoctype.dis, XMLParser.dis, DOMLS.dis,
        SimpleLS.dis, DOMMain.dis, XDP.dis: |WithFor| specifications
	and |DefaultFor|s are removed.

2006-12-30  Wakaba  <wakaba@suika.fam.cx>

	* CharacterData.dis, DOMCore.dis, DOMFeature.dis,
++ manakai/lib/Message/URI/ChangeLog	30 Dec 2006 08:26:32 -0000
	* Generic.dis: |WithFor| and |DefaultFor| are removed.

2006-12-30  Wakaba  <wakaba@suika.fam.cx>

++ manakai/lib/Message/Charset/ChangeLog	30 Dec 2006 08:24:04 -0000
	* Encode.dis (Require): |WithFor| specifications are removed.
	(DefaultFor): Removed.

2006-12-30  Wakaba  <wakaba@suika.fam.cx>

++ manakai/lib/manakai/ChangeLog	30 Dec 2006 07:46:56 -0000
2006-12-30  Wakaba  <wakaba@suika.fam.cx>

	* dis.pl: Removed.
1 Module:
2 @QName: MURI|Generic
3 @FullName:
4 @@lang: en
5 @@@: Manakai URI Generic Module
6 @Namespace:
7 http://suika.fam.cx/~wakaba/archive/2005/manakai/URI/Generic/
8
9 @enDesc:
10 The <DFN::manakai URI Generic Module> provides a set of interfaces
11 to extract components of URIs.
12
13 @enDesc:
14 @@ddid:src
15 @@@:
16 Portions of the Perl implementation contained in the module
17 are derived from the example parser (April 7, 2004) available at
18 <URI::http://www.gbiv.com/protocols/uri/rev-2002/uri_test.pl>
19 that is placed in the Public Domain by Roy T. Fielding
20 and Day Software, Inc.
21
22 @DISCore:author: DISCore|Wakaba
23 @License: license|Perl+MPL
24 @Date:
25 $Date: 2006/12/30 04:42:55 $
26
27 @Require:
28 @@Module:
29 @@@QName: MDOM|DOMFeature
30 @@Module:
31 @@@QName: MDOM|DOMCore
32
33 Namespace:
34 @c:
35 http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#
36 @dis:
37 http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--
38 @DISlib:
39 http://suika.fam.cx/~wakaba/archive/2004/dis/
40 @domperl:
41 http://suika.fam.cx/~wakaba/archive/2006/dom/perl/
42 @dx:
43 http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#
44 @f:
45 http://suika.fam.cx/~wakaba/archive/2004/dom/feature#
46 @fe:
47 http://suika.fam.cx/www/2006/feature/
48 @idl:
49 http://suika.fam.cx/~wakaba/archive/2004/dis/IDL#
50 @kwd:
51 http://suika.fam.cx/~wakaba/archive/2005/rfc2119/
52 @lang:
53 http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#
54 @license:
55 http://suika.fam.cx/~wakaba/archive/2004/8/18/license#
56 @ManakaiDOM:
57 http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#
58 @MDOM:
59 http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#ManakaiDOM.
60 @mn:
61 http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/ManakaiNode#
62 @MURI:
63 http://suika.fam.cx/~wakaba/archive/2005/manakai/URI/
64 @rdf:
65 http://www.w3.org/1999/02/22-rdf-syntax-ns#
66 @rdfs:
67 http://www.w3.org/2000/01/rdf-schema#
68 @str:
69 http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/DOMString/
70 @test:
71 http://suika.fam.cx/~wakaba/archive/2004/dis/Test#
72
73 ResourceDef:
74 @QName: MURI|
75 @rdf:type: dis|ModuleGroup
76 @FullName:
77 @@lang:en
78 @@@:
79 The manakai URI modules
80 @DISPerl:packageName:
81 Message::URI::
82 @DISPerl:interfacePackageName:
83 Message::URI::IF::
84
85 ## -- Features
86
87 FeatureDef:
88 @QName: URIFeature
89 @featureQName: fe|URI
90 @FeatureVerDef:
91 @@QName: URIFeature40
92 @@f:instanceOf: URIFeature
93 @@Version: 4.0
94 @@enDesc:
95 The manakai DOM URI Module, version 4.0
96
97 ElementTypeBinding:
98 @Name: FeatureDef
99 @ElementType:
100 dis:ResourceDef
101 @ShadowContent:
102 @@rdf:type: f|Feature
103 @@For: =ManakaiDOM|all
104
105 ElementTypeBinding:
106 @Name: FeatureVerDef
107 @ElementType:
108 dis:ResourceDef
109 @ShadowContent:
110 @@rdf:type: f|Feature
111
112 ElementTypeBinding:
113 @Name: featureQName
114 @ElementType:
115 f:name
116 @ShadowContent:
117 @@ContentType: DISCore|QName
118
119 ElementTypeBinding:
120 @Name: IFQName
121 @ElementType:
122 dis:QName
123 @ShadowContent:
124 @@ForCheck: ManakaiDOM|ForIF
125
126 ElementTypeBinding:
127 @Name: ClsQName
128 @ElementType:
129 dis:QName
130 @ShadowContent:
131 @@ForCheck: ManakaiDOM|ForClass
132
133 ElementTypeBinding:
134 @Name: IFISA
135 @ElementType:
136 dis:ISA
137 @ShadowContent:
138 @@ForCheck: ManakaiDOM|ForIF
139
140 ElementTypeBinding:
141 @Name: ClsISA
142 @ElementType:
143 dis:ISA
144 @ShadowContent:
145 @@ForCheck: ManakaiDOM|ForClass
146
147 ElementTypeBinding:
148 @Name: IFClsDef
149 @ElementType:
150 dis:ResourceDef
151 @ShadowContent:
152 @@rdf:type:
153 @@@@: dis|MultipleResource
154 @@@ForCheck: !ManakaiDOM|ForIF !ManakaiDOM|ForClass
155 @@resourceFor: ManakaiDOM|ForIF
156 @@resourceFor:
157 @@@@: ManakaiDOM|ForClass
158
159 @@rdf:type:
160 @@@@: DISLang|Interface
161 @@@ForCheck: ManakaiDOM|ForIF
162
163 @@rdf:type:
164 @@@@: DISLang|Class
165 @@@ForCheck: ManakaiDOM|ForClass
166
167 @@Implement:
168 @@@@: ||+||ManakaiDOM|ForIF
169 @@@ContentType: DISCore|TFPQNames
170 @@@ForCheck: ManakaiDOM|ForClass
171
172 @@f:implements:
173 @@@@: URIFeature40
174
175 ElementTypeBinding:
176 @Name: Method
177 @ElementType:
178 dis:ResourceDef
179 @ShadowContent:
180 @@rdf:type: DISLang|Method
181
182 ElementTypeBinding:
183 @Name: IntMethod
184 @ElementType:
185 dis:ResourceDef
186 @ShadowContent:
187 @@rdf:type: DISLang|Method
188 @@ForCheck: ManakaiDOM|ForClass
189 @@ManakaiDOM:isForInternal: 1
190
191 ElementTypeBinding:
192 @Name: Param
193 @ElementType:
194 dis:ResourceDef
195 @ShadowContent:
196 @@DISCore:resourceType: DISLang|MethodParameter
197
198 ElementTypeBinding:
199 @Name: NamedParam
200 @ElementType:
201 dis:ResourceDef
202 @ShadowContent:
203 @@DISCore:resourceType: DISLang|MethodParameter
204 @@DISPerl:isNamedParameter: 1
205
206 ElementTypeBinding:
207 @Name: Return
208 @ElementType:
209 dis:ResourceDef
210 @ShadowContent:
211 @@DISCore:resourceType: DISLang|MethodReturn
212
213 ElementTypeBinding:
214 @Name: Attr
215 @ElementType:
216 dis:ResourceDef
217 @ShadowContent:
218 @@DISCore:resourceType: DISLang|Attribute
219
220 ElementTypeBinding:
221 @Name: Get
222 @ElementType:
223 dis:ResourceDef
224 @ShadowContent:
225 @@DISCore:resourceType: DISLang|AttributeGet
226
227 ElementTypeBinding:
228 @Name: Set
229 @ElementType:
230 dis:ResourceDef
231 @ShadowContent:
232 @@DISCore:resourceType: DISLang|AttributeSet
233
234 ElementTypeBinding:
235 @Name: InCase
236 @ElementType:
237 dis:ResourceDef
238 @ShadowContent:
239 @@DISCore:resourceType: ManakaiDOM|InCase
240
241 ElementTypeBinding:
242 @Name: PerlDef
243 @ElementType:
244 dis:Def
245 @ShadowContent:
246 @@ContentType:
247 lang:Perl
248 @@ForCheck: ManakaiDOM|ForClass
249
250 ElementTypeBinding:
251 @Name: Test
252 @ElementType:
253 dis:ResourceDef
254 @ShadowContent:
255 @@rdf:type: test|StandaloneTest
256 @@ForCheck: ManakaiDOM|ForClass
257
258 ## -- Implementation
259
260 IFClsDef:
261 @IFQName: URIImplementation
262 @ClsQName: ManakaiURIImplementation
263
264 @domperl:implementedByObjectsOf: c|DOMImplementation
265 @domperl:classImplementedByObjectsOf: c|ManakaiDOMImplementation
266
267 @enDesc:
268 The <IF::URIImplementation> interface provides
269 factory methods to create <IF::URIReference> objects.
270
271 @f:provides: URIFeature40
272
273 @Test:
274 @@enDesc:
275 The implementation registry should know this class when the
276 module is loaded.
277 @@PerlDef:
278 I: {
279 for my $impl (@{$Message::DOM::ImplementationRegistry
280 ->get_dom_implementation_list
281 ({<Q::fe|URI> => '4.0'})}) {
282 if ($impl->isa (<IFName::URIImplementation>)) {
283 last I;
284 }
285 }
286 $test->assert_never;
287 } # I
288
289 @Method:
290 @@Name: createURIReference
291 @@enDesc:
292 Creates a <IF::URIReference> object with a DOM URI.
293 @@Param:
294 @@@Name: uri
295 @@@Type: String
296 @@@enDesc:
297 A DOM URI.
298 @@@InCase:
299 @@@@Type: String
300 @@@@enDesc:
301 A new <IF::URIReference> object with its
302 <A::URIReference.uriReference> set to the parameter value.
303 @@@InCase:
304 @@@@Type: DISPerl|SCALAR||ManakaiDOM|all
305 @@@@enDesc:
306 In Perl binding:
307 A new <IF::URIReference> object with its
308 <A::URIReference.uriReference> set to the value referenced
309 by the parameter value. Any modification to the <IF::URIReference>
310 object will change the value referenced by the parameter value.
311 @@@InCase:
312 @@@@Type: URIReference
313 @@@@enDesc:
314 The method <kwd:MUST> return a new <IF::URIReference>
315 object that would be returned by the method
316 <M::URIReference.cloneURIReference> of the parameter value.
317 @@Return:
318 @@@Type: URIReference
319 @@@enDesc:
320 The newly created <IF::URIReference> object.
321 @@@PerlDef:
322 if (UNIVERSAL::isa ($uri, <IFName::URIReference>)) {
323 __DEEP{
324 $r = $uri-><M::URIReference.cloneURIReference>;
325 }__;
326 } elsif (ref $uri eq 'SCALAR') {
327 $r = bless $uri, <ClassName::ManakaiURIReference>;
328 } else {
329 my $v = "$uri";
330 $r = bless \$v, <ClassName::ManakaiURIReference>;
331 }
332
333 @@Test:
334 @@@QName: URIImpl.createURIRef.1.test
335 @@@PerlDef:
336 my $impl;
337 __CODE{createURIImplForTest:: $impl => $impl}__;
338
339 my $value = 'http://example.com/';
340
341 $test->id ('interface');
342 my $uri1 = $impl-><M::URIImplementation.createURIReference>
343 ($value);
344 $test->assert_isa ($uri1, <IFName::URIReference>);
345
346 $test->id ('uriReference');
347 $test->assert_equals ($uri1-><AG::URIReference.uriReference>,
348 'http://example.com/');
349
350 $test->id ('modification');
351 $uri1-><AS::URIReference.uriFragment> ('abcdefg');
352 $test->assert_equals ($value, 'http://example.com/');
353 @@Test:
354 @@@QName: URIImpl.createURIRef.2.test
355 @@@PerlDef:
356 my $impl;
357 __CODE{createURIImplForTest:: $impl => $impl}__;
358
359 my $value = 'http://example.com/';
360
361 $test->id ('interface');
362 my $uri1 = $impl-><M::URIImplementation.createURIReference>
363 (\$value);
364 $test->assert_isa ($uri1, <IFName::URIReference>);
365
366 $test->id ('uriReference');
367 $test->assert_equals ($uri1-><AG::URIReference.uriReference>,
368 'http://example.com/');
369
370 $test->id ('modification');
371 $uri1-><AS::URIReference.uriFragment> ('abcdefg');
372 $test->assert_equals ($value, 'http://example.com/#abcdefg');
373 @@Test:
374 @@@QName: URIImpl.createURIRef.3.test
375 @@@PerlDef:
376 my $impl;
377 __CODE{createURIImplForTest:: $impl => $impl}__;
378
379 my $value = $impl-><M::URIImplementation.createURIReference>
380 ('http://example.com/');
381
382 $test->id ('interface');
383 my $uri1 = $impl-><M::URIImplementation.createURIReference>
384 ($value);
385 $test->assert_isa ($uri1, <IFName::URIReference>);
386
387 $test->id ('uriReference');
388 $test->assert_equals ($uri1-><AG::URIReference.uriReference>,
389 'http://example.com/');
390
391 $test->id ('modification');
392 $uri1-><AS::URIReference.uriFragment> ('abcdefg');
393 $test->assert_equals ($value-><AG::URIReference.uriReference>,
394 'http://example.com/');
395
396 @CODE:
397 @@QName: createURIImplForTest
398 @@PerlDef:
399 $impl = <Class::c|ManakaiDOMImplementation>->_new;
400 ##URIImplementation
401
402 ElementTypeBinding:
403 @Name: CODE
404 @ElementType:
405 dis:ResourceDef
406 @ShadowContent:
407 @@DISCore:resourceType: DISPerl|BlockCode
408 @@ForCheck: ManakaiDOM|ForClass
409
410 IFClsDef:
411 @IFQName: URIReference
412 @ClsQName: ManakaiURIReference
413
414 @enDesc:
415 A <IF::URIReference> object represents a DOM URI.
416
417 A <IF::URIReference> object <kwd:MAY> also implement
418 scheme-specific interfaces.
419
420 {NOTE::
421 Modifications to the object, via the <A::URIReference.uriScheme>
422 attribute for example, might or might not result in
423 mutations of the interfaces implemented by the object,
424 since dynamic rebinding of classes might not be supported
425 in the programming language or the DOM binding in use.
426
427 If a method or attribute that is inappropriate for
428 the underlying DOM URI represented by the <IF::URIReference>
429 object is invoked, the result is undefined, unless
430 the specification of the interface defines any error
431 handling behavior. However, implementators are advised
432 to make the method or attribute implementations torelant
433 and harmless as far as possible.
434 }
435
436 @IntMethod:
437 @@Name: new
438 @@enDesc:
439 Creates a new <IF::URIReference> object. For internal use.
440 @@Param:
441 @@@Name: uri
442 @@@Type: String
443 @@@enDesc:
444 The DOM URI.
445 @@@InCase:
446 @@@@Type: DISPerl|SCALAR||ManakaiDOM|all
447 @@@InCase:
448 @@@@Type: URIReference
449 @@Return:
450 @@@Type: URIReference
451 @@@PerlDef:
452 my $v;
453 if (ref $uri) {
454 if (UNIVERSAL::isa ($uri, <IFName::URIReference>)) {
455 my $w = $$uri;
456 $v = \$w;
457 } elsif (ref $uri eq 'SCALAR') {
458 $v = $uri;
459 } else {
460 $v = \$uri;
461 }
462 } else {
463 $v = \$uri;
464 }
465 $r = bless $v, <ClassName::ManakaiURIReference>;
466
467 @@Test:
468 @@@QName: URIRef.new.test
469 @@@PerlDef:
470 $test->id ('str');
471 my $u1 = <ClassM::ManakaiURIReference.new> (q<http://www.example/>);
472 $test->assert_isa ($u1, <IFName::URIReference>);
473 $test->assert_equals
474 ($u1-><AG::URIReference.uriReference>, q<http://www.example/>);
475
476 $test->id ('strref');
477 my $u = q<http://www.example/>;
478 my $u2 = <ClassM::ManakaiURIReference.new> (\$u);
479 $test->assert_isa ($u2, <IFName::URIReference>);
480 $test->assert_equals
481 ($u2-><AG::URIReference.uriReference>, q<http://www.example/>);
482
483 $test->id ('uri');
484 my $u3 = <ClassM::ManakaiURIReference.new> ($u1);
485 $test->assert_isa ($u3, <IFName::URIReference>);
486 $test->assert_equals
487 ($u3-><AG::URIReference.uriReference>, q<http://www.example/>);
488
489 $test->id ('uri.mod');
490 $u3-><AS::URIReference.uriScheme> ('ftp');
491 $test->assert_equals
492 ($u1-><AG::URIReference.uriReference>, q<http://www.example/>);
493 $test->assert_equals
494 ($u3-><AG::URIReference.uriReference>, q<ftp://www.example/>);
495
496 @Attr:
497 @@Name: uriReference
498 @@Operator:
499 @@@: ""
500 @@ContentType: DISPerl|Perl
501 @@enDesc:
502 A string representation of the DOM URI.
503 @@Type: String
504 @@Get:
505 @@@PerlDef:
506 $r = $$self;
507 @@Set:
508 @@@enDesc:
509 Sets the DOM URI, with no lexical or semantical check
510 and normalization performed. Implementations <kwd:MUST>
511 allow and set the specified value even if it is not a
512 legal RFC 3986 URI reference or RFC 3987 IRI reference.
513 @@@PerlDef:
514 $$self = $given;
515 __DEEP{
516 $self-><M::ManakaiURIReference.onSchemeChanged>;
517 }__;
518
519 @@Test:
520 @@@QName: URIRef.uriRef.test
521 @@@PerlDef:
522 my $impl;
523 __CODE{createURIImplForTest:: $impl => $impl}__;
524
525 for (
526 [q<http://www.example/>],
527 [q<about:blank>],
528 [qq<\x{3001}\x{3002}>],
529 [q<%23>],
530 ) {
531 my $uri1 = $impl-><M::URIImplementation.createURIReference> ($_->[0]);
532
533 $test->id ('get');
534 $test->assert_equals
535 ($uri1-><AG::URIReference.uriReference>,
536 $_->[0]);
537
538 $test->id ('set.same');
539 $uri1-><AS::URIReference.uriReference> ($_->[0]);
540 $test->assert_equals
541 ($uri1-><AG::URIReference.uriReference>,
542 $_->[0]);
543
544 $test->id ('set.diff');
545 $uri1-><AS::URIReference.uriReference> (q<about:>);
546 $test->assert_equals
547 ($uri1-><AG::URIReference.uriReference>,
548 q<about:>);
549 }
550
551 @IntMethod:
552 @@Operator: DISPerl|AsStringMethod
553 @@Return:
554 @@@Type: String
555 @@@PerlDef:
556 $r = $$self;
557
558 @@Test:
559 @@@QName: URIRef.stringify.test
560 @@@PerlDef:
561 my $impl;
562 __CODE{createURIImplForTest:: $impl => $impl}__;
563
564 $test->id ('method');
565 $test->assert_equals
566 ($impl-><M::URIImplementation.createURIReference> (q<a>)
567 ->stringify,
568 q<a>);
569
570 $test->id ('str');
571 $test->assert_equals
572 ($impl-><M::URIImplementation.createURIReference> (q<a>).'',
573 q<a>);
574
575 @IntMethod:
576 @@Name: onSchemeChanged
577 @@enDesc:
578 This method is invoked when the scheme component
579 of the DOM URI has been changed. Other component might
580 also be changed.
581 @@Return:
582 @@@PerlDef:
583 @@@enImplNote:
584 {TODO::
585 Class re<Perl::bless>ing.
586 }
587
588 @IntMethod:
589 @@Name: onAuthorityChanged
590 @@enDesc:
591 This method is invoked when the authority component
592 of the DOM URI has been changed. Other component might
593 also be changed.
594 @@Return:
595 @@@PerlDef:
596
597 @IntMethod:
598 @@Name: onPathChanged
599 @@enDesc:
600 This method is invoked when the path component
601 of the DOM URI has been changed. Other component might
602 also be changed.
603 @@Return:
604 @@@PerlDef:
605
606 @IntMethod:
607 @@Name: onQueryChanged
608 @@enDesc:
609 This method is invoked when the query component
610 of the DOM URI has been changed. Other component might
611 also be changed.
612 @@Return:
613 @@@PerlDef:
614
615 @IntMethod:
616 @@Name: onFragmentChanged
617 @@enDesc:
618 This method is invoked when the fragment component
619 of the DOM URI has been changed. Other component might
620 also be changed.
621 @@Return:
622 @@@PerlDef:
623
624 @Attr:
625 @@Name: uriScheme
626 @@enDesc:
627 The scheme component of the DOM URI.
628 @@Type: String
629 @@Get:
630 @@@enDesc:
631 The scheme component of the DOM URI is returned.
632
633 {P:: The <DFN::scheme component> can be obtained by the algorithm:
634
635 = Copy the DOM URI to the variable <VAR::U>.
636
637 = If <VAR::U> does not contain any <CHAR::COLON>,
638 there is no scheme component.
639
640 = Remove <CHAR::COLON> and any characters following it from <VAR::U>.
641
642 = If <VAR::U> contains <CHAR::SOLIDUS>, <CHAR::QUESTION MARK>,
643 and / or <CHAR::NUMBER SIGN>, then there is no scheme component.
644
645 = If <VAR::U> is empty, then there is no scheme component.
646
647 = Otherwise, <VAR::U> is the scheme component.
648
649 }
650
651 {NOTE::
652 {P::
653 This algorithm is so designed that:
654
655 - when it is performed on an RFC 3986 URI or RFC 3987 IRI,
656 the substring matching to the <ABNF::scheme> production
657 <SRC::RFC 3986 3.1> is returned as the scheme component.
658
659 - when it is performed on an RFC 3986 relative reference or
660 RFC 3987 relative IRI reference, it reports that
661 there is no scheme component.
662
663 }
664 }
665 @@@nullCase:
666 @@@@enDesc:
667 If there is no scheme component.
668 @@@PerlDef:
669 if ($$self =~ m!^([^/?#:]+):!) {
670 $r = $1;
671 } else {
672 $r = null;
673 }
674 @@Set:
675 @@@enDesc:
676 Replaces the scheme component of the DOM URI by the new value.
677 If the new value contains <CHAR::SOLIDUS>, <CHAR::QUESTION MARK>,
678 <CHAR::NUMBER SIGN>, and / or <CHAR::COLON>, then
679 the result is undefined. If the new value is empty,
680 then the result is undefined.
681
682 If the original DOM URI has no scheme component, then
683 the string obtained by concatenating the new scheme component
684 value, <CHAR::COLON>, and the original DOM URI is set
685 as the new DOM URI.
686 @@@nullCase:
687 If there is the scheme component, the scheme component
688 and a <CHAR::COLON> following it are removed from the DOM URI.
689 @@@PerlDef:
690 if (defined $given) {
691 if (length $given and $given !~ m![/?#:]!) {
692 unless ($$self =~ s!^[^/?#:]+:!$given:!) {
693 $$self = $given . ':' . $$self;
694 __DEEP{
695 $self-><M::ManakaiURIReference.onSchemeChanged>;
696 }__;
697 }
698 }
699 } else {
700 $$self =~ s!^[^/?#:]+:!!;
701 __DEEP{
702 $self-><M::ManakaiURIReference.onSchemeChanged>;
703 }__;
704 }
705
706 @@Test:
707 @@@QName: URIRef.uriScheme.1.test
708 @@@PerlDef:
709 my $impl;
710 __CODE{createURIImplForTest:: $impl => $impl}__;
711
712 for (
713 [q<http://example/>, 'http', q<http://example/>, q<//example/>],
714 [q<hTTp://example/>, 'hTTp', q<http://example/>, q<//example/>],
715 [q<//example/>, null, q<http://example/>, q<//example/>],
716 [q</a:b/>, null, q<http:/a:b/>, q</a:b/>],
717 [q<?aa:b>, null, q<http:?aa:b>, q<?aa:b>],
718 [q<aaaa#bb:cc>, null, q<http:aaaa#bb:cc>, q<aaaa#bb:cc>],
719 [q<%D9%82%D9%87%D9%88%D8%A9://coffee.example/>,
720 '%D9%82%D9%87%D9%88%D8%A9',
721 q<http://coffee.example/>, q<//coffee.example/>],
722 [q<%D9%82%D9%87%D9%88%D8%a9://coffee.example/>,
723 '%D9%82%D9%87%D9%88%D8%a9',
724 q<http://coffee.example/>, q<//coffee.example/>],
725 [q<:aa>, null, q<http::aa>, q<:aa>], # ilegal
726 ) {
727 $test->id ('get.'.$_->[0]);
728 my $uri1 = $impl-><M::URIImplementation.createURIReference>
729 ($_->[0]);
730 $test->assert_equals
731 ($uri1-><AG::URIReference.uriScheme>,
732 $_->[1]);
733
734 $test->id ('set.'.$_->[0]);
735 my $uri2 = $impl-><M::URIImplementation.createURIReference> ($uri1);
736 $uri2-><AS::URIReference.uriScheme> ('http');
737 $test->assert_equals
738 ($uri2-><AG::URIReference.uriReference>,
739 $_->[2]);
740
741 $test->id ('reset.'.$_->[0]);
742 my $uri4 = $impl-><M::URIImplementation.createURIReference> ($uri1);
743 $uri4-><AS::URIReference.uriScheme> (null);
744 $test->assert_equals
745 ($uri4-><AG::URIReference.uriReference>,
746 $_->[3]);
747 }
748
749 @Attr:
750 @@Name: uriAuthority
751 @@enDesc:
752 The authority component of the DOM URI.
753 @@Type: String
754 @@Get:
755 @@@enDesc:
756 The authority component of the DOM URI is returned.
757
758 {P:: The <DFN::authority component> can be obtained by the algorithm:
759
760 = Copy the DOM URI to the variable <VAR::U>.
761
762 = Removes the scheme component and the <CHAR::COLON>
763 following it, if any, from <VAR::U>.
764
765 = If <VAR::U> contains a <CHAR::NUMBER SIGN>,
766 remove the character and any characters following it
767 from <VAR::U>.
768
769 = If <VAR::U> contains a <CHAR::QUESTION MARK>,
770 remove the character and any characters following it
771 from <VAR::U>.
772
773 = If <VAR::U> begins with two <CHAR::SOLIDUS> characters,
774 remove them from <VAR::U>. <EM::Otherwise>,
775 <VAR::U> has no authority component.
776
777 = Remove any <CHAR::SOLIDUS> and any characters following
778 it from <VAR::U>.
779
780 = Then, <VAR::U> is the authority component.
781
782 }
783
784 {NOTE::
785 {P::
786 This algorithm is so designed that:
787
788 - when it is performed on an RFC 3986 URI reference,
789 the substring matching to the <ABNF::authority> production
790 <SRC::RFC 3986 3.2>, if any, is returned as the authority
791 component.
792
793 - when it is performed on an RFC 3987 IRI reference,
794 the substring matching to the <ABNF::iauthority> production
795 <SRC::RFC 3987 2.2>, if any, is returned as the authority
796 component.
797
798 - when it is performed on an RFC 3986 relative reference or
799 RFC 3987 relative IRI reference that does <EM::not>
800 contains authority component as defined in
801 RFC 3986 or RFC 3987, it reports that
802 there is no authority component.
803
804 }
805 }
806 @@@nullCase:
807 @@@@enDesc:
808 If there is no authority component.
809 @@@PerlDef:
810 if ($$self =~ m!^(?:[^:/?#]+:)?(?://([^/?#]*))?!) {
811 $r = $1;
812 } else {
813 $r = null;
814 }
815 @@Set:
816 @@@enDesc:
817 Replaces the authority component of the DOM URI by the new value.
818 If the new value contains <CHAR::SOLIDUS>, <CHAR::QUESTION MARK>,
819 and / or <CHAR::NUMBER SIGN>, then the result is undefined.
820 If the <A::URIReference.uriPath> is empty and
821 does not begin with a <CHAR::SOLIDUS>,
822 then result is undefined.
823
824 If the original DOM URI has no authority component, then
825 the string obtained by concatenating the scheme component
826 with following <CHAR::COLON> character of the original DOM URI
827 if any, two <CHAR::SOLIDUS> characters, the new authority
828 component value, and the path, query, and fragment
829 components of the original DOM URI, with their preceding
830 delimiters, if any, is set as the new DOM URI.
831 @@@nullCase:
832 If there is the authority component, the authority component
833 and two <CHAR::SOLIDUS> characters preceding it are removed
834 from the DOM URI.
835 @@@PerlDef:
836 if (defined $given) {
837 unless ($given =~ m![/?#]!) {
838 unless ($$self =~ s!^((?:[^:/?#]+:)?)(?://[^/?#]*)?!$1//$given!) {
839 $$self = '//' . $given;
840 __DEEP{
841 $self-><M::ManakaiURIReference.onAuthorityChanged>;
842 }__;
843 }
844 }
845 } else {
846 if ($$self =~ s!^((?:[^:/?#]+:)?)(?://[^/?#]*)?!$1!) {
847 __DEEP{
848 $self-><M::ManakaiURIReference.onAuthorityChanged>;
849 }__;
850 }
851 }
852
853 @@Test:
854 @@@QName: URIRef.uriAuth.1.test
855 @@@PerlDef:
856 my $impl;
857 __CODE{createURIImplForTest:: $impl => $impl}__;
858
859 for (
860 [q<http://example/>, 'example', q<http://example/>,
861 q<http:///>, q<http:/>],
862 [q<http://eXAmple/>, 'eXAmple', q<http://example/>,
863 q<http:///>, q<http:/>],
864 [q<//example/>, 'example', q<//example/>, q<///>, q</>],
865 [q</a:b/>, null, q<//example/a:b/>, q<///a:b/>, q</a:b/>],
866 [q<?aa:b>, null, q<//example?aa:b>, q<//?aa:b>, q<?aa:b>],
867 [q</aaaa#bb:cc>, null, q<//example/aaaa#bb:cc>,
868 q<///aaaa#bb:cc>, q</aaaa#bb:cc>],
869 [q<http://%D9%82%D9%87%D9%88%D8%A9/>,
870 '%D9%82%D9%87%D9%88%D8%A9',
871 q<http://example/>, q<http:///>, q<http:/>],
872 [q<http://%D9%82%D9%87%D9%88%D8%a9/>,
873 '%D9%82%D9%87%D9%88%D8%a9',
874 q<http://example/>, q<http:///>, q<http:/>],
875 ['about:', null, q<about://example>, q<about://>, q<about:>],
876 ['http://a:b@c/', 'a:b@c', q<http://example/>,
877 q<http:///>, q<http:/>],
878 ) {
879 $test->id ('get.'.$_->[0]);
880 my $uri1 = $impl-><M::URIImplementation.createURIReference>
881 ($_->[0]);
882 $test->assert_equals
883 ($uri1-><AG::URIReference.uriAuthority>,
884 $_->[1]);
885
886 $test->id ('set.'.$_->[0]);
887 my $uri2 = $impl-><M::URIImplementation.createURIReference> ($uri1);
888 $uri2-><AS::URIReference.uriAuthority> ('example');
889 $test->assert_equals
890 ($uri2-><AG::URIReference.uriReference>,
891 $_->[2]);
892
893 $test->id ('empty.'.$_->[0]);
894 my $uri3 = $impl-><M::URIImplementation.createURIReference> ($uri1);
895 $uri3-><AS::URIReference.uriAuthority> ('');
896 $test->assert_equals
897 ($uri3-><AG::URIReference.uriReference>,
898 $_->[3]);
899
900 $test->id ('reset.'.$_->[0]);
901 my $uri4 = $impl-><M::URIImplementation.createURIReference> ($uri1);
902 $uri4-><AS::URIReference.uriAuthority> (null);
903 $test->assert_equals
904 ($uri4-><AG::URIReference.uriReference>,
905 $_->[4]);
906 }
907
908 @Attr:
909 @@Name: uriUserinfo
910 @@enDesc:
911 The userinfo component of the DOM URI.
912 @@Type: String
913 @@Get:
914 @@@enDesc:
915 The userinfo component of the DOM URI is returned.
916
917 {P:: The <DFN::userinfo component> can be obtained by the algorithm:
918
919 = Set <A::URIReference.uriAuthority> value
920 to the variable <VAR::U>.
921
922 = If <VAR::U> is <DOM::null>, then there is no userinfo
923 component.
924
925 = If <VAR::U> contains a <CHAR::COMMERCIAL AT> preceded
926 by no <CHAR::LEFT SQUARE BRACKET>, <CHAR::RIGHT SQUARE BRACKET>,
927 or <CHAR::COLON> character,
928 remove the character and any characters following it
929 from <VAR::U>. <EM::Otherwise>, there is no userinfo
930 component.
931
932 = Then, <VAR::U> is the userinfo component.
933
934 }
935
936 {NOTE::
937 {P::
938 This algorithm is so designed that:
939
940 - when it is performed on an RFC 3986 URI reference,
941 the substring matching to the <ABNF::userinfo> production
942 <SRC::RFC 3986 3.2.1>, if any, is returned as the userinfo
943 component.
944
945 - when it is performed on an RFC 3987 IRI reference,
946 the substring matching to the <ABNF::iuserinfo> production
947 <SRC::RFC 3987 2.2>, if any, is returned as the userinfo component.
948
949 - when it is performed on an RFC 3986 relative reference or
950 RFC 3987 relative IRI reference that does <EM::not>
951 contains userinfo component as defined in
952 RFC 3986 or RFC 3987, it reports that
953 there is no userinfo component.
954
955 }
956 }
957 @@@nullCase:
958 @@@@enDesc:
959 If there is no userinfo component.
960 @@@PerlDef:
961 __DEEP{
962 my $v = $self-><AG::URIReference.uriAuthority>;
963 if (defined $v and $v =~ /^([^@\[\]]*)\@/) {
964 $r = $1;
965 } else {
966 $r = null;
967 }
968 }__;
969 @@Set:
970 @@@enDesc:
971 Replaces the userinfo component of the DOM URI by the new value.
972 If the new value contains <CHAR::SOLIDUS>, <CHAR::QUESTION MARK>,
973 <CHAR::NUMBER SIGN>, <CHAR::LEFT SQUARE BRACKET>,
974 <CHAR::RIGHT SQUARE BRACKET>, and / or <CHAR::COMMERCIAL AT>,
975 then the result is undefined.
976
977 If there is the authority component but no userinfo component,
978 then the authority component is replaced by the
979 concatenation of the new userinfo value, a <CHAR::COMMERCIAL AT>,
980 and the original authority component.
981
982 If there is no authority component, then
983 the string obtained by concatenating the scheme component
984 with following <CHAR::COLON> character of the original DOM URI
985 if any, two <CHAR::SOLIDUS> characters, the new userinfo
986 component value, a <CHAR::COMMERCIAL AT> character,
987 and the path, query, and fragment
988 components of the original DOM URI, with their preceding
989 delimiters, if any, is set as the new DOM URI.
990 If the <A::URIReference.uriPath> is empty and
991 does not begin with a <CHAR::SOLIDUS>, then result is undefined.
992 @@@nullCase:
993 If there is the userinfo component, the userinfo component
994 and a <CHAR::COMMERCIAL AT> characters following it are removed
995 from the DOM URI.
996 @@@PerlDef:
997 __DEEP{
998 my $auth = $self-><AG::URIReference.uriAuthority>;
999 if (defined $auth) {
1000 if (defined $given) {
1001 unless ($auth =~ s/^[^\@\[\]]*\@/$given\@/) {
1002 $auth = $given . '@' . $auth;
1003 }
1004 } else {
1005 $auth =~ s/^[^\@\[\]]*\@//;
1006 }
1007 $self-><AS::URIReference.uriAuthority> ($auth);
1008 } else {
1009 if (defined $given and $given !~ /[\/#?\@\[\]]/) {
1010 $self-><AS::URIReference.uriAuthority> ($given.'@');
1011 }
1012 }
1013 }__;
1014
1015 @@Test:
1016 @@@QName: URIRef.uriUserinfo.1.test
1017 @@@PerlDef:
1018 my $impl;
1019 __CODE{createURIImplForTest:: $impl => $impl}__;
1020
1021 for (
1022 [q<http://example/>, null, q<http://user@example/>,
1023 q<http://@example/>, q<http://example/>],
1024 [q<http://User@example/>, 'User', q<http://user@example/>,
1025 q<http://@example/>, q<http://example/>],
1026 [q<//example/>, null, q<//user@example/>,
1027 q<//@example/>, q<//example/>],
1028 [q<//u@example/>, 'u', q<//user@example/>,
1029 q<//@example/>, q<//example/>],
1030 [q</a:b/>, null, q<//user@/a:b/>, q<//@/a:b/>, q</a:b/>],
1031 [q<?aa:b>, null, q<//user@?aa:b>, q<//@?aa:b>, q<?aa:b>],
1032 [q</aaaa#bb:cc>, null, q<//user@/aaaa#bb:cc>,
1033 q<//@/aaaa#bb:cc>, q</aaaa#bb:cc>],
1034 [q<http://%D9%82%D9%87%D9%88%D8%A9@example/>,
1035 '%D9%82%D9%87%D9%88%D8%A9',
1036 q<http://user@example/>, q<http://@example/>, q<http://example/>],
1037 [q<http://%D9%82%D9%87%D9%88%D8%a9@example/>,
1038 '%D9%82%D9%87%D9%88%D8%a9',
1039 q<http://user@example/>, q<http://@example/>, q<http://example/>],
1040 ['about:', null, q<about://user@>, q<about://@>, q<about:>],
1041 ['http://a:b@c/', 'a:b', q<http://user@c/>,
1042 q<http://@c/>, q<http://c/>],
1043 ['http://[c@d]/', null, q<http://user@[c@d]/>,
1044 q<http://@[c@d]/>, q<http://[c@d]/>],
1045 ) {
1046 $test->id ('get.'.$_->[0]);
1047 my $uri1 = $impl-><M::URIImplementation.createURIReference>
1048 ($_->[0]);
1049 $test->assert_equals
1050 ($uri1-><AG::URIReference.uriUserinfo>,
1051 $_->[1]);
1052
1053 $test->id ('set.'.$_->[0]);
1054 my $uri2 = $impl-><M::URIImplementation.createURIReference> ($uri1);
1055 $uri2-><AS::URIReference.uriUserinfo> ('user');
1056 $test->assert_equals
1057 ($uri2-><AG::URIReference.uriReference>,
1058 $_->[2]);
1059
1060 $test->id ('empty.'.$_->[0]);
1061 my $uri3 = $impl-><M::URIImplementation.createURIReference> ($uri1);
1062 $uri3-><AS::URIReference.uriUserinfo> ('');
1063 $test->assert_equals
1064 ($uri3-><AG::URIReference.uriReference>,
1065 $_->[3]);
1066
1067 $test->id ('reset.'.$_->[0]);
1068 my $uri4 = $impl-><M::URIImplementation.createURIReference> ($uri1);
1069 $uri4-><AS::URIReference.uriUserinfo> (null);
1070 $test->assert_equals
1071 ($uri4-><AG::URIReference.uriReference>,
1072 $_->[4]);
1073 }
1074
1075 @Attr:
1076 @@Name: uriHost
1077 @@enDesc:
1078 The host component of the DOM URI.
1079 @@Type: String
1080 @@Get:
1081 @@@enDesc:
1082 The host component of the DOM URI is returned.
1083
1084 {P:: The <DFN::host component> can be obtained by the algorithm:
1085
1086 = Set <A::URIReference.uriAuthority> value
1087 to the variable <VAR::U>.
1088
1089 = If <VAR::U> is <DOM::null>, then there is no host
1090 component.
1091
1092 = If <VAR::U> contains a <CHAR::COMMERCIAL AT>,
1093 remove the character and any characters preceding it
1094 from <VAR::U>.
1095
1096 = If <VAR::U> contains a <CHAR::COLON> followed by
1097 zero or more digits (i.e. <CHAR::DIGIT ZERO>
1098 to <CHAR::DIGIT NINE>), then remove the <CHAR::COLON>
1099 and any characters following it.
1100
1101 = Then, <VAR::U> is the userinfo component.
1102
1103 }
1104
1105 {NOTE::
1106 {P::
1107 This algorithm is so designed that:
1108
1109 - when it is performed on an RFC 3986 URI reference,
1110 the substring matching to the <ABNF::host> production
1111 <SRC::RFC 3986 3.2.2> is returned as the host component.
1112
1113 - when it is performed on an RFC 3987 IRI reference,
1114 the substring matching to the <ABNF::ihost> production
1115 <SRC::RFC 3987 2.2> is returned as the host component.
1116
1117 - when it is performed on an RFC 3986 relative reference or
1118 RFC 3987 relative IRI reference that does <EM::not>
1119 contains host component as defined in
1120 RFC 3986 or RFC 3987, it reports that
1121 there is no host component.
1122
1123 }
1124 }
1125 @@@nullCase:
1126 @@@@enDesc:
1127 If there is no host component.
1128
1129 {NOTE::
1130 If the <A::URIReference.uriAuthority> attribute contains
1131 a non-<DOM::null> value, then <A::URIReference.uriHost> has
1132 never been <DOM::null>.
1133 }
1134 @@@PerlDef:
1135 __DEEP{
1136 my $v = $self-><AG::URIReference.uriAuthority>;
1137 if (defined $v) {
1138 $v =~ s/^[^@\[\]]*\@//;
1139 $v =~ s/:[0-9]*\z//;
1140 $r = $v;
1141 } else {
1142 $r = null;
1143 }
1144 }__;
1145 @@Set:
1146 @@@enDesc:
1147 Replaces the host component of the DOM URI by the new value.
1148 If the new value contains <CHAR::SOLIDUS>, <CHAR::QUESTION MARK>,
1149 <CHAR::NUMBER SIGN>, <CHAR::LEFT SQUARE BRACKET>,
1150 <CHAR::RIGHT SQUARE BRACKET>, and / or <CHAR::COLON>,
1151 then the result is undefined.
1152
1153 If there is no authority component, then
1154 the string obtained by concatenating the scheme component
1155 with following <CHAR::COLON> character of the original DOM URI
1156 if any, two <CHAR::SOLIDUS> characters,
1157 the new host component, and the path, query, and fragment
1158 components of the original DOM URI, with their preceding
1159 delimiters, if any, is set as the new DOM URI.
1160 If the <A::URIReference.uriPath> is empty and
1161 does not begin with a <CHAR::SOLIDUS>, then result is undefined.
1162 @@@PerlDef:
1163 __DEEP{
1164 my $auth = $self-><AG::URIReference.uriAuthority>;
1165 if (defined $auth) {
1166 my $v = '';
1167 if ($auth =~ /^([^\@\[\]]*\@)/) {
1168 $v .= $1;
1169 }
1170 $v .= $given;
1171 if ($auth =~ /(:[0-9]*)\z/) {
1172 $v .= $1;
1173 }
1174 $self-><AS::URIReference.uriAuthority> ($v);
1175 } elsif ($given !~ /[\/\@:#?]/) {
1176 $self-><AS::URIReference.uriAuthority> ($given);
1177 }
1178 }__;
1179
1180 @@Test:
1181 @@@QName: URIRef.uriHost.1.test
1182 @@@PerlDef:
1183 my $impl;
1184 __CODE{createURIImplForTest:: $impl => $impl}__;
1185
1186 for (
1187 [q<http://example/>, 'example', q<http://example/>, q<http:///>],
1188 [q<http://User@example/>, 'example', q<http://User@example/>,
1189 q<http://User@/>],
1190 [q<//example/>, 'example', q<//example/>, q<///>],
1191 [q<//u@example/>, 'example', q<//u@example/>, q<//u@/>],
1192 [q</a:b/>, null, q<//example/a:b/>, q<///a:b/>],
1193 [q<?aa:b>, null, q<//example?aa:b>, q<//?aa:b>],
1194 [q</aaaa#bb:cc>, null, q<//example/aaaa#bb:cc>,
1195 q<///aaaa#bb:cc>],
1196 [q<http://%D9%82%D9%87%D9%88%D8%A9/>,
1197 '%D9%82%D9%87%D9%88%D8%A9', q<http://example/>, q<http:///>],
1198 [q<http://%D9%82%D9%87%D9%88%D8%a9/>,
1199 '%D9%82%D9%87%D9%88%D8%a9', q<http://example/>, q<http:///>],
1200 ['about:', null, q<about://example>, q<about://>],
1201 ['http://a:b@c:3/', 'c', q<http://a:b@example:3/>,
1202 q<http://a:b@:3/>],
1203 ['http://a:b@[c@d:4]:3/', '[c@d:4]', q<http://a:b@example:3/>,
1204 q<http://a:b@:3/>],
1205 ) {
1206 $test->id ('get.'.$_->[0]);
1207 my $uri1 = $impl-><M::URIImplementation.createURIReference>
1208 ($_->[0]);
1209 $test->assert_equals
1210 ($uri1-><AG::URIReference.uriHost>,
1211 $_->[1]);
1212
1213 $test->id ('set.'.$_->[0]);
1214 my $uri2 = $impl-><M::URIImplementation.createURIReference> ($uri1);
1215 $uri2-><AS::URIReference.uriHost> ('example');
1216 $test->assert_equals
1217 ($uri2-><AG::URIReference.uriReference>,
1218 $_->[2]);
1219
1220 $test->id ('empty.'.$_->[0]);
1221 my $uri3 = $impl-><M::URIImplementation.createURIReference> ($uri1);
1222 $uri3-><AS::URIReference.uriHost> ('');
1223 $test->assert_equals
1224 ($uri3-><AG::URIReference.uriReference>,
1225 $_->[3]);
1226 }
1227
1228 @Attr:
1229 @@Name: uriPort
1230 @@enDesc:
1231 The port component of the DOM URI.
1232 @@Type: String
1233 @@Get:
1234 @@@enDesc:
1235 The port component of the DOM URI is returned.
1236
1237 {P:: The <DFN::port component> can be obtained by the algorithm:
1238
1239 = Set <A::URIReference.uriAuthority> value
1240 to the variable <VAR::U>.
1241
1242 = If <VAR::U> is <DOM::null>, then there is no port
1243 component.
1244
1245 = If <VAR::U> contains a <CHAR::COLON> followed
1246 by zero or more digits (<CHAR::DIGIT ZERO> to
1247 <CHAR::DIGIT NINE>),
1248 remove the character and any characters following it
1249 from <VAR::U>. <EM::Otherwise>, there is no port
1250 component.
1251
1252 = Then, <VAR::U> is the port component.
1253
1254 }
1255
1256 {NOTE::
1257 {P::
1258 This algorithm is so designed that:
1259
1260 - when it is performed on an RFC 3986 URI reference
1261 or RFC 3987 IRI reference,
1262 the substring matching to the <ABNF::port> production
1263 <SRC::RFC 3986 3.2.3>, if any, is returned as the port component.
1264
1265 - when it is performed on an RFC 3986 relative reference or
1266 RFC 3987 relative IRI reference that does <EM::not>
1267 contains port component as defined in
1268 RFC 3986 or RFC 3987, it reports that
1269 there is no port component.
1270
1271 }
1272 }
1273 @@@nullCase:
1274 @@@@enDesc:
1275 If there is no port component.
1276 @@@PerlDef:
1277 __DEEP{
1278 my $v = $self-><AG::URIReference.uriAuthority>;
1279 if (defined $v and $v =~ /:([0-9]*)\z/) {
1280 $r = $1;
1281 } else {
1282 $r = null;
1283 }
1284 }__;
1285 @@Set:
1286 @@@enDesc:
1287 Replaces the port component of the DOM URI by the new value.
1288 If the new value contains characters other than
1289 digits (<CHAR::DIGIT ZERO> to <CHAR::DIGIT NINE>),
1290 then the result is undefined.
1291
1292 If there is the authority component but no port component,
1293 then the authority component is replaced by the
1294 concatenation of the original authority component,
1295 a <CHAR::COLON>, and the new port value.
1296
1297 If there is no authority component, then
1298 the string obtained by concatenating the scheme component
1299 with following <CHAR::COLON> character of the original DOM URI
1300 if any, two <CHAR::SOLIDUS> characters, a <CHAR::COLON>
1301 character, the new port component value,
1302 and the path, query, and fragment
1303 components of the original DOM URI, with their preceding
1304 delimiters, if any, is set as the new DOM URI.
1305 If the <A::URIReference.uriPath> is empty and
1306 does not begin with a <CHAR::SOLIDUS>, then result is undefined.
1307 @@@nullCase:
1308 If there is the port component, the port component
1309 and a <CHAR::COLON> characters preceding it are removed
1310 from the DOM URI.
1311 @@@PerlDef:
1312 __DEEP{
1313 my $auth = $self-><AG::URIReference.uriAuthority>;
1314 if (defined $auth) {
1315 if (defined $given) {
1316 unless ($auth =~ s/:[0-9]*\z/:$given/) {
1317 $auth = $auth . ':' . $given;
1318 }
1319 } else {
1320 $auth =~ s/:[0-9]*\z//;
1321 }
1322 $self-><AS::URIReference.uriAuthority> ($auth);
1323 } else {
1324 if (defined $given and $given =~ /\A[0-9]*\z/) {
1325 $self-><AS::URIReference.uriAuthority> (':'.$given);
1326 }
1327 }
1328 }__;
1329
1330 @@Test:
1331 @@@QName: URIRef.uriPort.1.test
1332 @@@PerlDef:
1333 my $impl;
1334 __CODE{createURIImplForTest:: $impl => $impl}__;
1335
1336 for (
1337 [q<http://example/>, null, q<http://example:2/>,
1338 q<http://example:/>, q<http://example/>],
1339 [q<http://User@example:3/>, '3', q<http://User@example:2/>,
1340 q<http://User@example:/>, q<http://User@example/>],
1341 [q<//example/>, null, q<//example:2/>,
1342 q<//example:/>, q<//example/>],
1343 [q<//u@example:3/>, '3', q<//u@example:2/>,
1344 q<//u@example:/>, q<//u@example/>],
1345 [q</a:b/>, null, q<//:2/a:b/>, q<//:/a:b/>, q</a:b/>],
1346 [q<?aa:b>, null, q<//:2?aa:b>, q<//:?aa:b>, q<?aa:b>],
1347 [q</aaaa#bb:cc>, null, q<//:2/aaaa#bb:cc>,
1348 q<//:/aaaa#bb:cc>, q</aaaa#bb:cc>],
1349 ['about:', null, q<about://:2>, q<about://:>, q<about:>],
1350 ['http://a:b@c:3/', '3', q<http://a:b@c:2/>,
1351 q<http://a:b@c:/>, q<http://a:b@c/>],
1352 ['http://[c@d:3]/', null, q<http://[c@d:3]:2/>,
1353 q<http://[c@d:3]:/>, q<http://[c@d:3]/>],
1354 ) {
1355 $test->id ('get.'.$_->[0]);
1356 my $uri1 = $impl-><M::URIImplementation.createURIReference>
1357 ($_->[0]);
1358 $test->assert_equals
1359 ($uri1-><AG::URIReference.uriPort>,
1360 $_->[1]);
1361
1362 $test->id ('set.'.$_->[0]);
1363 my $uri2 = $impl-><M::URIImplementation.createURIReference> ($uri1);
1364 $uri2-><AS::URIReference.uriPort> ('2');
1365 $test->assert_equals
1366 ($uri2-><AG::URIReference.uriReference>,
1367 $_->[2]);
1368
1369 $test->id ('empty.'.$_->[0]);
1370 my $uri3 = $impl-><M::URIImplementation.createURIReference> ($uri1);
1371 $uri3-><AS::URIReference.uriPort> ('');
1372 $test->assert_equals
1373 ($uri3-><AG::URIReference.uriReference>,
1374 $_->[3]);
1375
1376 $test->id ('reset.'.$_->[0]);
1377 my $uri4 = $impl-><M::URIImplementation.createURIReference> ($uri1);
1378 $uri4-><AS::URIReference.uriPort> (null);
1379 $test->assert_equals
1380 ($uri4-><AG::URIReference.uriReference>,
1381 $_->[4]);
1382 }
1383
1384 @Attr:
1385 @@Name: uriPath
1386 @@enDesc:
1387 The path component of the DOM URI.
1388 @@Type: String
1389 @@Get:
1390 @@@enDesc:
1391 The path component of the DOM URI is returned.
1392
1393 {P:: The <DFN::path component> can be obtained by the algorithm:
1394
1395 = Copy the DOM URI to the variable <VAR::U>.
1396
1397 = If <VAR::U> contains a <CHAR::NUMBER SIGN>, remove
1398 the character and any characters following it.
1399
1400 = If <VAR::U> contains a <CHAR::QUESTION MARK>, remove
1401 the character and any characters following it.
1402
1403 = If <VAR::U> contains the scheme component and
1404 the <CHAR::COLON> character fllowing it, remove
1405 them from <VAR::U>.
1406
1407 = If <VAR::U> contains the authority component and
1408 the <CHAR::SOLIDUS> characters preceding it, remove
1409 them from <VAR::U>.
1410
1411 = Then, <VAR::U> is the path component.
1412
1413 }
1414
1415 {NOTE::
1416 {P::
1417 This algorithm is so designed that:
1418
1419 - when it is performed on an RFC 3986 URI reference,
1420 the substring matching to the <ABNF::path> production
1421 <SRC::RFC 3986 3.3> is returned as the path component.
1422
1423 - when it is performed on an RFC 3987 IRI reference,
1424 the substring matching to the <ABNF::ipath> production
1425 <SRC::RFC 3987 2.2> is returned as the path component.
1426
1427 }
1428 }
1429 @@@PerlDef:
1430 if ($$self =~ m!\A(?:[^:/?#]+:)?(?://[^/?#]*)?([^?#]*)!) {
1431 $r = $1;
1432 }
1433 @@Set:
1434 @@@enDesc:
1435 Replaces the path component of the DOM URI by the new value.
1436
1437 If the DOM URI <EM::does> contain the authority component
1438 and the new path value's first character, if any,
1439 is <EM::different> from <CHAR::SOLIDUS>, the result is
1440 undefined.
1441
1442 If the DOM URI does <EM::not> contains scheme and authority
1443 components and the new path value contains <CHAR::COLON>
1444 that is not preceded by <CHAR::SOLIDUS> or the first
1445 two characters are both <CHAR::SOLIDUS>, the result is
1446 undefined.
1447
1448 If the new value contains <CHAR::QUESTION MARK> or
1449 <CHAR::NUMBER SIGN>, the result is undefined.
1450 @@@PerlDef:
1451 if ($given !~ /[?#]/ and
1452 $$self =~ m!^((?:[^:/?#]+:)?(?://[^/?#]*)?)[^?#]*((?:\?[^#]*)?(?:#.*)?)!s) {
1453 $$self = $1.$given.$2;
1454 __DEEP{
1455 $self-><M::ManakaiURIReference.onPathChanged>;
1456 }__;
1457 }
1458
1459 @@Test:
1460 @@@QName: URIRef.uriPath.1.test
1461 @@@PerlDef:
1462 my $impl;
1463 __CODE{createURIImplForTest:: $impl => $impl}__;
1464
1465 for (
1466 [q<http://example/>, '/', q<http://example/path>, q<http://example>],
1467 [q<http://example/path>, '/path', q<http://example/path>,
1468 q<http://example>],
1469 [q<//example/>, '/', q<//example/path>, q<//example>],
1470 [q<//example/path>, '/path', q<//example/path>, q<//example>],
1471 [q</path?query>, '/path', q</path?query>, q<?query>],
1472 [q<?query>, '', q</path?query>, q<?query>],
1473 [q</aaaa#bb:cc>, '/aaaa', q</path#bb:cc>, q<#bb:cc>],
1474 [q<http://example/%D9%82%D9%87%D9%88%D8%A9/>,
1475 '/%D9%82%D9%87%D9%88%D8%A9/', q<http://example/path>,
1476 q<http://example>],
1477 [q<http://example/%D9%82%D9%87%D9%88%D8%a9/>,
1478 '/%D9%82%D9%87%D9%88%D8%a9/', q<http://example/path>,
1479 q<http://example>],
1480 ['about:', '', q<about:/path>, q<about:>],
1481 ['http://a:b@c:3/', '/', q<http://a:b@c:3/path>,
1482 q<http://a:b@c:3>],
1483 ['http://a:b@[c@d:4]:3/', '/', q<http://a:b@[c@d:4]:3/path>,
1484 q<http://a:b@[c@d:4]:3>],
1485 ) {
1486 $test->id ('get.'.$_->[0]);
1487 my $uri1 = $impl-><M::URIImplementation.createURIReference>
1488 ($_->[0]);
1489 $test->assert_equals
1490 ($uri1-><AG::URIReference.uriPath>,
1491 $_->[1]);
1492
1493 $test->id ('set.'.$_->[0]);
1494 my $uri2 = $impl-><M::URIImplementation.createURIReference> ($uri1);
1495 $uri2-><AS::URIReference.uriPath> ('/path');
1496 $test->assert_equals
1497 ($uri2-><AG::URIReference.uriReference>,
1498 $_->[2]);
1499
1500 $test->id ('set.'.$_->[0]);
1501 my $uri3 = $impl-><M::URIImplementation.createURIReference> ($uri1);
1502 $uri3-><AS::URIReference.uriPath> ('');
1503 $test->assert_equals
1504 ($uri3-><AG::URIReference.uriReference>,
1505 $_->[3]);
1506 }
1507
1508 @Attr:
1509 @@Name: uriQuery
1510 @@enDesc:
1511 The query component of the DOM URI.
1512 @@Type: String
1513 @@Get:
1514 @@@enDesc:
1515 The query component of the DOM URI is returned.
1516
1517 {P:: The <DFN::query component> can be obtained by the algorithm:
1518
1519 = Copy the DOM URI to the variable <VAR::U>.
1520
1521 = If <VAR::U> contains a <CHAR::NUMBER SIGN>,
1522 remove it and any characters following it from <VAR::U>.
1523
1524 = If <VAR::U> contains a <CHAR::QUESTION MARK>,
1525 remove it and any character preceding it from <VAR::U>.
1526 <EM::Otherwise>, there is no query component.
1527
1528 = Then, <VAR::U> is the query component.
1529
1530 }
1531
1532 {NOTE::
1533 {P::
1534 This algorithm is so designed that:
1535
1536 - when it is performed on an RFC 3986 URI reference,
1537 the substring matching to the <ABNF::query> production
1538 <SRC::RFC 3986 3.4>, if any, is returned as the query component.
1539
1540 - when it is performed on an RFC 3987 IRI reference,
1541 the substring matching to the <ABNF::iquery> production
1542 <SRC::RFC 3987 2.2>, if any, is returned as the query component.
1543
1544 - when it is performed on an RFC 3986 relative reference or
1545 RFC 3987 relative IRI reference that does <EM::not>
1546 contains query component as defined in
1547 RFC 3986 or RFC 3987, it reports that
1548 there is no query component.
1549
1550 }
1551 }
1552 @@@nullCase:
1553 @@@@enDesc:
1554 If there is no query component.
1555 @@@PerlDef:
1556 if ($$self =~ m!^(?:[^:/?#]+:)?(?://[^/?#]*)?[^?#]*(?:\?([^#]*))?!s) {
1557 $r = $1;
1558 } else {
1559 $r = null;
1560 }
1561 @@Set:
1562 @@@enDesc:
1563 Replaces the query component of the DOM URI by the new value.
1564 If the new value contains a <CHAR::NUMVER SIGN>,
1565 then the result is undefined.
1566
1567 If there is no query component, a <CHAR::QUESTION MARK>
1568 followed by the new value is inserted before the first
1569 <CHAR::NUMBER SIGN>, if any, or at the end of the DOM URI.
1570 @@@nullCase:
1571 If there is the query component, the query component
1572 and a <CHAR::QUESTION MARK> character preceding it are removed
1573 from the DOM URI.
1574 @@@PerlDef:
1575 if ((not defined $given or $given !~ /#/) and
1576 $$self =~ m!^((?:[^:/?#]+:)?(?://[^/?#]*)?[^?#]*)(?:\?[^#]*)?((?:#.*)?)!s) {
1577 $$self = defined $given ? $1.'?'.$given.$2 : $1.$2;
1578 __DEEP{
1579 $self-><M::ManakaiURIReference.onQueryChanged>;
1580 }__;
1581 }
1582 @@Test:
1583 @@@QName: URIRef.uriQuery.1.test
1584 @@@PerlDef:
1585 my $impl;
1586 __CODE{createURIImplForTest:: $impl => $impl}__;
1587
1588 for (
1589 [q<http://example/>, null, q<http://example/?query>,
1590 q<http://example/?>, q<http://example/>],
1591 [q<//example/>, null, q<//example/?query>,
1592 q<//example/?>, q<//example/>],
1593 [q</a:b/>, null, q</a:b/?query>, q</a:b/?>, q</a:b/>],
1594 [q<?aa:b>, 'aa:b', q<?query>, q<?>, q<>],
1595 [q</aaaa#bb:cc>, null, q</aaaa?query#bb:cc>,
1596 q</aaaa?#bb:cc>, q</aaaa#bb:cc>],
1597 [q</aaaa?query#bb:cc>, 'query', q</aaaa?query#bb:cc>,
1598 q</aaaa?#bb:cc>, q</aaaa#bb:cc>],
1599 [q<http://example/?%D9%82%D9%87%D9%88%D8%A9/>,
1600 '%D9%82%D9%87%D9%88%D8%A9/',
1601 q<http://example/?query>, q<http://example/?>, q<http://example/>],
1602 [q<http://example/?%D9%82%D9%87%D9%88%D8%a9/>,
1603 '%D9%82%D9%87%D9%88%D8%a9/',
1604 q<http://example/?query>, q<http://example/?>, q<http://example/>],
1605 ['about:', null, q<about:?query>, q<about:?>, q<about:>],
1606 ['about:a?b', 'b', q<about:a?query>, q<about:a?>, q<about:a>],
1607 ['about:#a?b', null, q<about:?query#a?b>, q<about:?#a?b>,
1608 q<about:#a?b>],
1609 ) {
1610 $test->id ('get.'.$_->[0]);
1611 my $uri1 = $impl-><M::URIImplementation.createURIReference>
1612 ($_->[0]);
1613 $test->assert_equals
1614 ($uri1-><AG::URIReference.uriQuery>,
1615 $_->[1]);
1616
1617 $test->id ('set.'.$_->[0]);
1618 my $uri2 = $impl-><M::URIImplementation.createURIReference> ($uri1);
1619 $uri2-><AS::URIReference.uriQuery> ('query');
1620 $test->assert_equals
1621 ($uri2-><AG::URIReference.uriReference>,
1622 $_->[2]);
1623
1624 $test->id ('set.empty.'.$_->[0]);
1625 my $uri3 = $impl-><M::URIImplementation.createURIReference> ($uri1);
1626 $uri3-><AS::URIReference.uriQuery> ('');
1627 $test->assert_equals
1628 ($uri3-><AG::URIReference.uriReference>,
1629 $_->[3]);
1630
1631 $test->id ('reset.'.$_->[0]);
1632 my $uri4 = $impl-><M::URIImplementation.createURIReference> ($uri1);
1633 $uri4-><AS::URIReference.uriQuery> (null);
1634 $test->assert_equals
1635 ($uri4-><AG::URIReference.uriReference>,
1636 $_->[4]);
1637 }
1638
1639 @Attr:
1640 @@Name: uriFragment
1641 @@enDesc:
1642 The fragment component of the DOM URI.
1643 @@Type: String
1644 @@Get:
1645 @@@enDesc:
1646 The fragment component of the DOM URI is returned.
1647
1648 {P:: The <DFN::fragment component> can be obtained by the algorithm:
1649
1650 = Copy the DOM URI to the variable <VAR::U>.
1651
1652 = If <VAR::U> contains a <CHAR::NUMBER SIGN>,
1653 remove it and any characters preceding it from <VAR::U>.
1654 <EM::Otherwise>, there is no fragment component.
1655
1656 = Then, <VAR::U> contains the fragment component.
1657
1658 }
1659
1660 {NOTE::
1661 {P::
1662 This algorithm is so designed that:
1663
1664 - when it is performed on an RFC 3986 URI reference,
1665 the substring matching to the <ABNF::fragment> production
1666 <SRC::RFC 3986 3.5>, if any, is returned as the fragment component.
1667
1668 - when it is performed on an RFC 3987 IRI reference,
1669 the substring matching to the <ABNF::ifragment> production
1670 <SRC::RFC 3987 2.2>, if any, is returned as the fragment component.
1671
1672 - when it is performed on an RFC 3986 relative reference or
1673 RFC 3987 relative IRI reference that does <EM::not>
1674 contains fragment component as defined in
1675 RFC 3986 or RFC 3987, it reports that
1676 there is no fragment component.
1677
1678 }
1679 }
1680 @@@nullCase:
1681 @@@@enDesc:
1682 If there is no fragment component.
1683 @@@PerlDef:
1684 if ($$self =~ m!^(?:[^:/?#]+:)?(?://[^/?#]*)?[^?#]*(?:\?[^#]*)?(?:#(.*))?!s) {
1685 $r = $1;
1686 } else {
1687 $r = null;
1688 }
1689 @@Set:
1690 @@@enDesc:
1691 Replaces the fragment component of the DOM URI by the new value.
1692
1693 If there is no fragment component, a <CHAR::NUMBER SIGN>
1694 followed by the new value is appended to the DOM URI.
1695 @@@nullCase:
1696 If there is the fragment component, the fragment component
1697 and a <CHAR::NUMBER SIGN> character preceding it are removed
1698 from the DOM URI.
1699 @@@PerlDef:
1700 if ($$self =~ m!^((?:[^:/?#]+:)?(?://[^/?#]*)?[^?#]*(?:\?[^#]*)?)(?:#.*)?!s) {
1701 $$self = defined $given ? $1 . '#' . $given : $1;
1702 __DEEP{
1703 $self-><M::ManakaiURIReference.onFragmentChanged>;
1704 }__;
1705 }
1706
1707 @@Test:
1708 @@@QName: URIRef.uriFragment.1.test
1709 @@@PerlDef:
1710 my $impl;
1711 __CODE{createURIImplForTest:: $impl => $impl}__;
1712
1713 for (
1714 [q<http://example/>, null, q<http://example/#fragment>,
1715 q<http://example/#>, q<http://example/>],
1716 [q<//example/>, null, q<//example/#fragment>,
1717 q<//example/#>, q<//example/>],
1718 [q</a:b/>, null, q</a:b/#fragment>, q</a:b/#>, q</a:b/>],
1719 [q<?aa:b>, null, q<?aa:b#fragment>, q<?aa:b#>, q<?aa:b>],
1720 [q</aaaa#bb:cc>, 'bb:cc', q</aaaa#fragment>, q</aaaa#>, q</aaaa>],
1721 [q</aaaa?q#bb:cc>, 'bb:cc', q</aaaa?q#fragment>, q</aaaa?q#>,
1722 q</aaaa?q>],
1723 [q</aaaa?q#bb?cc>, 'bb?cc', q</aaaa?q#fragment>, q</aaaa?q#>,
1724 q</aaaa?q>],
1725 [q<http://example#%D9%82%D9%87%D9%88%D8%A9/>,
1726 '%D9%82%D9%87%D9%88%D8%A9/',
1727 q<http://example#fragment>, q<http://example#>, q<http://example>],
1728 [q<http://example#%D9%82%D9%87%D9%88%D8%a9/>,
1729 '%D9%82%D9%87%D9%88%D8%a9/',
1730 q<http://example#fragment>, q<http://example#>, q<http://example>],
1731 ['about:', null, q<about:#fragment>, q<about:#>, q<about:>],
1732 ['about:a?b', null, q<about:a?b#fragment>, q<about:a?b#>,
1733 q<about:a?b>],
1734 ['about:#a?b', 'a?b', q<about:#fragment>, q<about:#>, q<about:>],
1735 ) {
1736 $test->id ('get.'.$_->[0]);
1737 my $uri1 = $impl-><M::URIImplementation.createURIReference>
1738 ($_->[0]);
1739 $test->assert_equals
1740 ($uri1-><AG::URIReference.uriFragment>,
1741 $_->[1]);
1742
1743 $test->id ('set.'.$_->[0]);
1744 my $uri2 = $impl-><M::URIImplementation.createURIReference> ($uri1);
1745 $uri2-><AS::URIReference.uriFragment> ('fragment');
1746 $test->assert_equals
1747 ($uri2-><AG::URIReference.uriReference>,
1748 $_->[2]);
1749
1750 $test->id ('set.empty.'.$_->[0]);
1751 my $uri3 = $impl-><M::URIImplementation.createURIReference> ($uri1);
1752 $uri3-><AS::URIReference.uriFragment> ('');
1753 $test->assert_equals
1754 ($uri3-><AG::URIReference.uriReference>,
1755 $_->[3]);
1756
1757 $test->id ('reset.'.$_->[0]);
1758 my $uri4 = $impl-><M::URIImplementation.createURIReference> ($uri1);
1759 $uri4-><AS::URIReference.uriFragment> (null);
1760 $test->assert_equals
1761 ($uri4-><AG::URIReference.uriReference>,
1762 $_->[4]);
1763 }
1764
1765 @Method:
1766 @@Name: getURIPathSegment
1767 @@enDesc:
1768 Returns a path segment in the DOM URI.
1769 @@Param:
1770 @@@Name: index
1771 @@@Type: idl|unsignedLong||ManakaiDOM|all
1772 @@@enDesc:
1773 The ordinal index of the path segment, starting from zero.
1774 @@@enDesc:
1775 @@@@ddid: a
1776 @@@@@:
1777 For Perl binding, if the <P::index> is negative, then
1778 the method <kwd:MUST> act as if <MATH::<VAR::N> - <P::index>>
1779 (where <VAR::N> is the number of the path segments in
1780 the DOM URI) is set to the <P::index> parameter, except
1781 when <MATH::<VAR::N> - <P::index>> is negative, in that
1782 case the result is undefined. If the <P::index> is
1783 greater than or equal to <VAR::N>, the method <kwd:MUST>
1784 act as if <MATH::<VAR::N> - 1> is set to the <P::index>
1785 parameter. For example, if <P::index>
1786 is set to <Perl::-1>, then the method replaces the last
1787 path segment in the DOM URI.
1788 @@Return:
1789 @@@Type: String
1790 @@@enDesc:
1791 The <P::index>th path segment in the DOM URI.
1792
1793 {P::
1794 The <P::index>th <DFN::path segment> can be retrived
1795 by:
1796
1797 = Copy <A::URIReference.uriPath> value to the variable
1798 <VAR::U>.
1799
1800 = Insert a <CHAR::SOLIDUS> at the begining of <VAR::U>.
1801 Insert a <CHAR::SOLIDUS> at the end of <VAR::U>.
1802
1803 = Remove <MATH::(<P::index> + 1)>th <CHAR::SOLIDUS>
1804 and any character before it from <VAR::U>. If there
1805 is no such <CHAR::SOLIDUS>, there is no <P::index>th
1806 path segment.
1807
1808 = Remove <CHAR::SOLIDUS> and any character following
1809 it from <VAR::U>, if any.
1810
1811 = Then, the variable <VAR::U> contains the <P::index>th
1812 path segment.
1813 }
1814 @@@nullCase:
1815 @@@@enDesc:
1816 If there is no <P::index>th path segment.
1817 @@@PerlDef:
1818 __DEEP{
1819 $r = [split m!/!, $self-><AG::URIReference.uriPath>, -1]->[$index];
1820 $r = '' if not defined $r and
1821 ($index == 0 or $index == -1); # If path is empty
1822 }__;
1823
1824 @@Test:
1825 @@@QName: URIRef.getURIPathSegment.test
1826 @@@PerlDef:
1827 my $impl;
1828 __CODE{createURIImplForTest:: $impl => $impl}__;
1829
1830 for (
1831 [q<http://www.example/1/3/4?b#c>, ['', '1', '3', '4']],
1832 [q<http://www.example/1/2/>, ['', '1', '2', '']],
1833 [q<http://www.example/>, ['', '']],
1834 [q<http://www.example>, ['']],
1835 [q<mailto:foo@example>, ['foo@example']],
1836 [q<about:>, ['']],
1837 [q<data:text/plain,abcdefg/ef>, ['text', 'plain,abcdefg', 'ef']],
1838 [q<./a/c/..d/e/..>, ['.', 'a', 'c', '..d', 'e', '..']],
1839 [q<a>, ['a']],
1840 [q</a/b/>, ['', 'a', 'b', '']],
1841 [q<//a/b/c>, ['', 'b', 'c']],
1842 [q<?a>, ['']],
1843 ) {
1844 my $uri1 = $impl-><M::URIImplementation.createURIReference> ($_->[0]);
1845 for my $i (0..@{$_->[1]}) { # 0..n-1+1
1846 $test->id ($_->[0].'.'.$i);
1847 $test->assert_equals
1848 ($uri1-><M::URIReference.getURIPathSegment> ($i),
1849 $_->[1]->[$i]);
1850 }
1851 for my $i (1..@{$_->[1]}) {
1852 $test->id ($_->[0].'.-'.$i);
1853 $test->assert_equals
1854 ($uri1-><M::URIReference.getURIPathSegment> (-$i),
1855 $_->[1]->[-$i]);
1856 }
1857 }
1858
1859 @Method:
1860 @@Name: setURIPathSegment
1861 @@enDesc:
1862 Replaces or removes a path segment in the DOM URI.
1863
1864 If there is the <P::index>th path segment and the <P::newValue>
1865 is not <DOM::null>, then replace the <P::index>th path
1866 segment by <P::newValue>.
1867
1868 If there is the <P::index>th path segment and the <P::newValue>
1869 is <DOM::null>, then the <P::index>th path segment and
1870 a <CHAR::SOLIDUS> character following it, if any, are removed.
1871
1872 If there is no <P::index>th path segment, then the result
1873 is undefined, except when <P::index> is equal to the
1874 number of the segments, in that case a <CHAR::SOLIDUS> and
1875 the <P::newValue> is appended to the path component.
1876
1877 {ISSUE::
1878 <CODE::INDEX_SIZE_ERR>? No effect?
1879 }
1880
1881 If the method would make the only path segment removed,
1882 then it <kwd:MUST> make the path component an empty string.
1883
1884 If there is the authority component and the method would make
1885 the first path segment non-empty string, if there is
1886 no scheme component, there is no authority component,
1887 and the method would make the first path segment containing
1888 a <CHAR::COLON> character, or if there is no authority
1889 component and the method would make the first and the second
1890 path segments empty strings, then the result is undefined.
1891 @@Param:
1892 @@@Name: index
1893 @@@Type: idl|unsignedLong||ManakaiDOM|all
1894 @@@enDesc:
1895 The ordinal index of the path segment to replace.
1896 @@@enDesc:
1897 @@@@ddid: a
1898 @@@@@:
1899 For Perl binding, if the <P::index> is negative, then
1900 the method <kwd:MUST> act as if <MATH::<VAR::N> - <P::index>>
1901 (where <VAR::N> is the number of the path segments in
1902 the DOM URI) is set to the <P::index> parameter, except
1903 when <MATH::<VAR::N> - <P::index>> is negative, in that
1904 case the result is undefined. If the <P::index> is
1905 greater than <VAR::N>, the method <kwd:MUST>
1906 extend the list by inserting zero-length segments so that
1907 the result path component has <MATH::<P::index> + 1> segments.
1908 For example, if <P::index>
1909 is set to <Perl::-1>, then the method replaces the last
1910 path segment in the DOM URI.
1911 @@Param:
1912 @@@Name: newValue
1913 @@@Type: String
1914 @@@enDesc:
1915 The new path segment.
1916 @@@nullCase:
1917 @@@@enDesc:
1918 Removes the <P::index>th path segment.
1919 @@Return:
1920 @@@PerlDef:
1921 __DEEP{
1922 my @p = split m!/!, $self-><AG::URIReference.uriPath>, -1;
1923 if (defined $newValue) {
1924 $p[$index] = $newValue;
1925 } else {
1926 splice @p, $index, 1;
1927 }
1928 no warnings 'uninitialized';
1929 $self-><AS::URIReference.uriPath> (join '/', @p);
1930 }__;
1931
1932 @@Test:
1933 @@@QName: URIRef.setURIPathSegment.test
1934 @@@PerlDef:
1935 my $impl;
1936 __CODE{createURIImplForTest:: $impl => $impl}__;
1937
1938 my $uri1 = $impl-><M::URIImplementation.createURIReference>
1939 (q<http://foo.example/a/b/c>);
1940
1941 $test->id (1);
1942 $uri1-><M::URIReference.setURIPathSegment> (3, 'd');
1943 $test->assert_equals
1944 ($uri1-><AG::URIReference.uriReference>,
1945 q<http://foo.example/a/b/d>);
1946
1947 $test->id (2);
1948 $uri1-><M::URIReference.setURIPathSegment> (2, 'e');
1949 $test->assert_equals
1950 ($uri1-><AG::URIReference.uriReference>,
1951 q<http://foo.example/a/e/d>);
1952
1953 $test->id (3);
1954 $uri1-><M::URIReference.setURIPathSegment> (3, '');
1955 $test->assert_equals
1956 ($uri1-><AG::URIReference.uriReference>,
1957 q<http://foo.example/a/e/>);
1958
1959 $test->id (4);
1960 $uri1-><M::URIReference.setURIPathSegment> (3, null);
1961 $test->assert_equals
1962 ($uri1-><AG::URIReference.uriReference>,
1963 q<http://foo.example/a/e>);
1964
1965 $test->id (5);
1966 $uri1-><M::URIReference.setURIPathSegment> (1, null);
1967 $test->assert_equals
1968 ($uri1-><AG::URIReference.uriReference>,
1969 q<http://foo.example/e>);
1970
1971 $test->id (6);
1972 $uri1-><M::URIReference.setURIPathSegment> (-1, 'd');
1973 $test->assert_equals
1974 ($uri1-><AG::URIReference.uriReference>,
1975 q<http://foo.example/d>);
1976
1977 $test->id (7);
1978 $uri1-><M::URIReference.setURIPathSegment> (-1, null);
1979 $test->assert_equals
1980 ($uri1-><AG::URIReference.uriReference>,
1981 q<http://foo.example>);
1982
1983 $test->id (8);
1984 $uri1-><M::URIReference.setURIPathSegment> (0, null);
1985 $test->assert_equals
1986 ($uri1-><AG::URIReference.uriReference>,
1987 q<http://foo.example>);
1988
1989 $test->id (9);
1990 $uri1-><M::URIReference.setURIPathSegment> (1, 'd');
1991 $test->assert_equals
1992 ($uri1-><AG::URIReference.uriReference>,
1993 q<http://foo.example/d>);
1994
1995 $test->id (10);
1996 $uri1-><M::URIReference.setURIPathSegment> (3, 'd');
1997 $test->assert_equals
1998 ($uri1-><AG::URIReference.uriReference>,
1999 q<http://foo.example/d//d>);
2000
2001 @Attr:
2002 @@Name: isURI
2003 @@enDesc:
2004 Whether the DOM URI is a URI or not according to the latest
2005 version of the URI specification.
2006
2007 {NOTE:: At the time of writing, RFC 3986 is the latest
2008 version and the attribute must contain the value
2009 same as <A::URIReference.isURI3986> attribute of
2010 the same object.
2011 }
2012 @@Type: idl|boolean||ManakaiDOM|all
2013 @@Get:
2014 @@@TrueCase:
2015 @@@@enDesc:
2016 If it is a legal URI.
2017 @@@FalseCase:
2018 @@@@enDesc:
2019 If it is not a legal URI.
2020 @@@PerlDef:
2021 __DEEP{
2022 $r = $self-><AG::URIReference.isURI3986>;
2023 }__;
2024
2025 @Attr:
2026 @@Name: isURI3986
2027 @@DISPerl:methodName: is_uri_3986
2028 @@enDesc:
2029 Whether the DOM URI is an RFC 3986 URI or not.
2030
2031 {NOTE::
2032 Whether the URI is valid according to the scheme-specific
2033 syntax is not checked.
2034 }
2035 @@Type: idl|boolean||ManakaiDOM|all
2036 @@Get:
2037 @@@TrueCase:
2038 @@@@enDesc:
2039 If the DOM URI matches to the production
2040 rule <ABNF::URI> <SRC::RFC 3986 3>.
2041 @@@FalseCase:
2042 @@@@enDesc: Otherwise.
2043 @@@PerlDef:
2044 my $v = $$self;
2045 V: {
2046 ## -- Scheme
2047 unless ($v =~ s/^[A-Za-z][A-Za-z0-9+.-]*://s) {
2048 last V;
2049 }
2050
2051 ## -- Fragment
2052 if ($v =~ s/#(.*)\z//s) {
2053 my $w = $1;
2054 unless ($w =~ m{\A(?>[A-Za-z0-9._~!\$&'()*+,;=:\@/?-]|%[0-9A-Fa-f][0-9A-Fa-f])*\z}) {
2055 last V;
2056 }
2057 }
2058
2059 ## -- Query
2060 if ($v =~ s/\?(.*)\z//s) {
2061 my $w = $1;
2062 unless ($w =~ m{\A(?>[A-Za-z0-9._~!\$&'()*+,;=:\@/?-]|%[0-9A-Fa-f][0-9A-Fa-f])*\z}) {
2063 last V;
2064 }
2065 }
2066
2067 ## -- Authority
2068 if ($v =~ s!^//([^/]*)!!s) {
2069 my $w = $1;
2070 $w =~ s/^(?>[A-Za-z0-9._~!\$&'()*+,;=:-]|%[0-9A-Fa-f][0-9A-Fa-f])*\@//os;
2071 $w =~ s/:[0-9]*\z//;
2072 if ($w =~ /^\[(.*)\]\z/s) {
2073 my $x = $1;
2074 unless ($x =~ /\A[vV][0-9A-Fa-f]+\.[A-Za-z0-9._~!\$&'()*+,;=:-]+\z/) {
2075 ## IPv6address
2076 my $isv6;
2077 __CODE{isIPv6address:: $in => $x, $out => $isv6}__;
2078 last V unless $isv6;
2079 }
2080 } else {
2081 unless ($w =~ /\A(?>[A-Za-z0-9._~!\$&'()*+,;=-]|%[0-9A-Fa-f][0-9A-Fa-f])*\z/) {
2082 last V;
2083 }
2084 }
2085 }
2086
2087 ## -- Path
2088 unless ($v =~ m{\A(?>[A-Za-z0-9._~!\$&'()*+,;=:\@/-]|%[0-9A-Fa-f][0-9A-Fa-f])*\z}s) {
2089 last V;
2090 }
2091
2092 $r = true;
2093 } # V
2094
2095 @Attr:
2096 @@Name: isRelativeReference
2097 @@enDesc:
2098 Whether the DOM URI is a relative reference or not according to the latest
2099 version of the URI specification.
2100
2101 {NOTE:: At the time of writing, RFC 3986 is the latest
2102 version and the attribute must contain the value
2103 same as <A::URIReference.isRelativeReference3986> attribute of
2104 the same object.
2105 }
2106 @@Type: idl|boolean||ManakaiDOM|all
2107 @@Get:
2108 @@@TrueCase:
2109 @@@@enDesc:
2110 If it is a legal relative reference.
2111 @@@FalseCase:
2112 @@@@enDesc:
2113 If it is not a legal relative reference.
2114 @@@PerlDef:
2115 __DEEP{
2116 $r = $self-><AG::URIReference.isRelativeReference3986>;
2117 }__;
2118
2119 @Attr:
2120 @@Name: isRelativeReference3986
2121 @@DISPerl:methodName: is_relative_reference_3986
2122 @@enDesc:
2123 Whether the DOM URI is an RFC 3986 relative reference or not.
2124 @@Type: idl|boolean||ManakaiDOM|all
2125 @@Get:
2126 @@@TrueCase:
2127 @@@@enDesc:
2128 If the DOM URI matches to the production
2129 rule <ABNF::relative-ref> <SRC::RFC 3986 4.2>.
2130 @@@FalseCase:
2131 @@@@enDesc: Otherwise.
2132 @@@PerlDef:
2133 my $v = $$self;
2134 V: {
2135 ## -- No scheme
2136 if ($v =~ s!^[^/?#]*:!!s) {
2137 last V;
2138 }
2139
2140 ## -- Fragment
2141 if ($v =~ s/#(.*)\z//s) {
2142 my $w = $1;
2143 unless ($w =~ m{\A(?>[A-Za-z0-9._~!\$&'()*+,;=:\@/?-]|%[0-9A-Fa-f][0-9A-Fa-f])*\z}) {
2144 last V;
2145 }
2146 }
2147
2148 ## -- Query
2149 if ($v =~ s/\?(.*)\z//s) {
2150 my $w = $1;
2151 unless ($w =~ m{\A(?>[A-Za-z0-9._~!\$&'()*+,;=:\@/?-]|%[0-9A-Fa-f][0-9A-Fa-f])*\z}) {
2152 last V;
2153 }
2154 }
2155
2156 ## -- Authority
2157 if ($v =~ s!^//([^/]*)!!s) {
2158 my $w = $1;
2159 $w =~ s/^(?>[A-Za-z0-9._~!\$&'()*+,;=:-]|%[0-9A-Fa-f][0-9A-Fa-f])*\@//os;
2160 $w =~ s/:[0-9]*\z//;
2161 if ($w =~ /^\[(.*)\]\z/s) {
2162 my $x = $1;
2163 unless ($x =~ /\A[vV][0-9A-Fa-f]+\.[A-Za-z0-9._~!\$&'()*+,;=:-]+\z/) {
2164 ## IPv6address
2165 my $isv6;
2166 __CODE{isIPv6address:: $in => $x, $out => $isv6}__;
2167 last V unless $isv6;
2168 }
2169 } else {
2170 unless ($w =~ /\A(?>[A-Za-z0-9._~!\$&'()*+,;=-]|%[0-9A-Fa-f][0-9A-Fa-f])*\z/) {
2171 last V;
2172 }
2173 }
2174 }
2175
2176 ## -- Path
2177 unless ($v =~ m{\A(?>[A-Za-z0-9._~!\$&'()*+,;=:\@/-]|%[0-9A-Fa-f][0-9A-Fa-f])*\z}s) {
2178 last V;
2179 }
2180
2181 $r = true;
2182 } # V
2183
2184 @Attr:
2185 @@Name: isURIReference
2186 @@enDesc:
2187 Whether the DOM URI is a URI reference or not according to the latest
2188 version of the URI specification.
2189
2190 {NOTE:: At the time of writing, RFC 3986 is the latest
2191 version and the attribute must contain the value
2192 same as <A::URIReference.isURIReference3986> attribute of
2193 the same object.
2194 }
2195 @@Type: idl|boolean||ManakaiDOM|all
2196 @@Get:
2197 @@@TrueCase:
2198 @@@@enDesc:
2199 If it is a legal URI reference.
2200 @@@FalseCase:
2201 @@@@enDesc:
2202 If it is not a legal URI reference.
2203 @@@PerlDef:
2204 __DEEP{
2205 $r = $self-><AG::URIReference.isURIReference3986>;
2206 }__;
2207
2208 @Attr:
2209 @@Name: isURIReference3986
2210 @@DISPerl:methodName: is_uri_reference_3986
2211 @@enDesc:
2212 Whether the DOM URI is an RFC 3986 URI reference or not.
2213 @@Type: idl|boolean||ManakaiDOM|all
2214 @@Get:
2215 @@@TrueCase:
2216 @@@@enDesc:
2217 If the DOM URI matches to the production
2218 rule <ABNF::URI-reference> <SRC::RFC 3986 4.1>.
2219 @@@FalseCase:
2220 @@@@enDesc: Otherwise.
2221 @@@PerlDef:
2222 __DEEP{
2223 $r = $self-><AG::URIReference.isURI3986> ||
2224 $self-><AG::URIReference.isRelativeReference3986>;
2225 }__;
2226
2227 @Attr:
2228 @@Name: isAbsoluteURI
2229 @@enDesc:
2230 Whether the DOM URI is an absolute URI or not according to the latest
2231 version of the URI specification.
2232
2233 {NOTE:: At the time of writing, RFC 3986 is the latest
2234 version and the attribute must contain the value
2235 same as <A::URIReference.isAbsoluteURI3986> attribute of
2236 the same object.
2237 }
2238 @@Type: idl|boolean||ManakaiDOM|all
2239 @@Get:
2240 @@@TrueCase:
2241 @@@@enDesc:
2242 If it is a legal absolute URI.
2243 @@@FalseCase:
2244 @@@@enDesc:
2245 If it is not a legal absolute URI.
2246 @@@PerlDef:
2247 __DEEP{
2248 $r = $self-><AG::URIReference.isAbsoluteURI3986>;
2249 }__;
2250
2251 @Attr:
2252 @@Name: isAbsoluteURI3986
2253 @@DISPerl:methodName: is_absolute_uri_3986
2254 @@enDesc:
2255 Whether the DOM URI is an RFC 3986 absolute URI or not.
2256 @@Type: idl|boolean||ManakaiDOM|all
2257 @@Get:
2258 @@@TrueCase:
2259 @@@@enDesc:
2260 If the DOM URI matches to the production
2261 rule <ABNF::absolute-URI> <SRC::RFC 3986 4.3>.
2262 @@@FalseCase:
2263 @@@@enDesc: Otherwise.
2264 @@@PerlDef:
2265 __DEEP{
2266 $r = $$self !~ /#/ && $self-><AG::URIReference.isURI3986>;
2267 }__;
2268
2269 @Attr:
2270 @@Name: isEmptyReference
2271 @@enDesc:
2272 Whether the DOM URI is an empty string or not.
2273 @@Type: idl|boolean||ManakaiDOM|all
2274 @@Get:
2275 @@@TrueCase:
2276 @@@@enDesc:
2277 If the DOM URI is an empty string.
2278 @@@FalseCase:
2279 @@@@enDesc:
2280 Otherwise.
2281 @@@PerlDef:
2282 $r = ($$self eq '');
2283
2284 @Attr:
2285 @@Name: isIRI
2286 @@enDesc:
2287 Whether the DOM URI is an IRI or not according to the latest
2288 version of the IRI specification.
2289
2290 {NOTE:: At the time of writing, RFC 3987 is the latest
2291 version and the attribute must contain the value
2292 same as <A::URIReference.isIRI3987> attribute of
2293 the same object.
2294 }
2295 @@Type: idl|boolean||ManakaiDOM|all
2296 @@Get:
2297 @@@TrueCase:
2298 @@@@enDesc:
2299 If it is a legal IRI.
2300 @@@FalseCase:
2301 @@@@enDesc:
2302 If it is not a legal IRI.
2303 @@@PerlDef:
2304 __DEEP{
2305 $r = $self-><AG::URIReference.isIRI3987>;
2306 }__;
2307
2308 @Attr:
2309 @@Name: isIRI3987
2310 @@DISPerl:methodName: is_iri_3987
2311 @@enDesc:
2312 Whether the DOM URI is an RFC 3987 IRI or not.
2313
2314 {NOTE::
2315 Whether the IRI is valid according to the scheme-specific
2316 syntax is not checked.
2317 }
2318 @@Type: idl|boolean||ManakaiDOM|all
2319 @@Get:
2320 @@@TrueCase:
2321 @@@@enDesc:
2322 If the DOM URI matches to the production
2323 rule <ABNF::IRI> <SRC::RFC 3987 2.2>.
2324 @@@FalseCase:
2325 @@@@enDesc: Otherwise.
2326 @@@PerlDef:
2327 my $v = $$self;
2328 V: {
2329 ## LRM, RLM, LRE, RLE, LRO, RLO, PDF
2330 ## U+200E, U+200F, U+202A - U+202E
2331 my $ucschar = q{\x{00A0}-\x{200D}\x{2010}-\x{2029}\x{202F}-\x{D7FF}\x{F900}-\x{FDCF}\x{FDF0}-\x{FFEF}\x{10000}-\x{1FFFD}\x{20000}-\x{2FFFD}\x{30000}-\x{3FFFD}\x{40000}-\x{4FFFD}\x{50000}-\x{5FFFD}\x{60000}-\x{6FFFD}\x{70000}-\x{7FFFD}\x{80000}-\x{8FFFD}\x{90000}-\x{9FFFD}\x{A0000}-\x{AFFFD}\x{B0000}-\x{BFFFD}\x{C0000}-\x{CFFFD}\x{D0000}-\x{DFFFD}\x{E1000}-\x{EFFFD}};
2332
2333 ## -- Scheme
2334 unless ($v =~ s/^[A-Za-z][A-Za-z0-9+.-]*://s) {
2335 last V;
2336 }
2337
2338 ## -- Fragment
2339 if ($v =~ s/#(.*)\z//s) {
2340 my $w = $1;
2341 unless ($w =~ m{\A(?>[A-Za-z0-9._~!\$&'()*+,;=:\@/?$ucschar-]|%[0-9A-Fa-f][0-9A-Fa-f])*\z}o) {
2342 last V;
2343 }
2344 }
2345
2346 ## -- Query
2347 if ($v =~ s/\?(.*)\z//s) {
2348 my $w = $1;
2349 unless ($w =~ m{\A(?>[A-Za-z0-9._~!\$&'()*+,;=:\@/?$ucschar\x{E000}-\x{F8FF}\x{F0000}-\x{FFFFD}\x{100000}-\x{10FFFD}-]|%[0-9A-Fa-f][0-9A-Fa-f])*\z}o) {
2350 last V;
2351 }
2352 }
2353
2354 ## -- Authority
2355 if ($v =~ s!^//([^/]*)!!s) {
2356 my $w = $1;
2357 $w =~ s/^(?>[A-Za-z0-9._~!\$&'()*+,;=:$ucschar-]|%[0-9A-Fa-f][0-9A-Fa-f])*\@//os;
2358 $w =~ s/:[0-9]*\z//;
2359 if ($w =~ /^\[(.*)\]\z/s) {
2360 my $x = $1;
2361 unless ($x =~ /\A[vV][0-9A-Fa-f]+\.[A-Za-z0-9._~!\$&'()*+,;=:-]+\z/) {
2362 ## IPv6address
2363 my $isv6;
2364 __CODE{isIPv6address:: $in => $x, $out => $isv6}__;
2365 last V unless $isv6;
2366 }
2367 } else {
2368 unless ($w =~ /\A(?>[A-Za-z0-9._~!\$&'()*+,;=$ucschar-]|%[0-9A-Fa-f][0-9A-Fa-f])*\z/o) {
2369 last V;
2370 }
2371 }
2372 }
2373
2374 ## -- Path
2375 unless ($v =~ m{\A(?>[A-Za-z0-9._~!\$&'()*+,;=:\@/$ucschar-]|%[0-9A-Fa-f][0-9A-Fa-f])*\z}os) {
2376 last V;
2377 }
2378
2379 $r = true;
2380 } # V
2381
2382 @Attr:
2383 @@Name: isRelativeIRIReference
2384 @@enDesc:
2385 Whether the DOM IRI is a relative IRI reference or not according
2386 to the latest version of the IRI specification.
2387
2388 {NOTE:: At the time of writing, RFC 3987 is the latest
2389 version and the attribute must contain the value
2390 same as <A::URIReference.isRelativeIRIReference3987> attribute of
2391 the same object.
2392 }
2393 @@Type: idl|boolean||ManakaiDOM|all
2394 @@Get:
2395 @@@TrueCase:
2396 @@@@enDesc:
2397 If it is a legal relative IRI reference.
2398 @@@FalseCase:
2399 @@@@enDesc:
2400 If it is not a legal relative IRI reference.
2401 @@@PerlDef:
2402 __DEEP{
2403 $r = $self-><AG::URIReference.isRelativeIRIReference3987>;
2404 }__;
2405
2406 @Attr:
2407 @@Name: isRelativeIRIReference3987
2408 @@DISPerl:methodName: is_relative_iri_reference_3987
2409 @@enDesc:
2410 Whether the DOM URI is an RFC 3987 relative IRI reference or not.
2411 @@Type: idl|boolean||ManakaiDOM|all
2412 @@Get:
2413 @@@TrueCase:
2414 @@@@enDesc:
2415 If the DOM URI matches to the production
2416 rule <ABNF::irelative-ref> <SRC::RFC 3987 2.2, 4.1>.
2417 @@@FalseCase:
2418 @@@@enDesc: Otherwise.
2419 @@@PerlDef:
2420 my $v = $$self;
2421 V: {
2422 ## LRM, RLM, LRE, RLE, LRO, RLO, PDF
2423 ## U+200E, U+200F, U+202A - U+202E
2424 my $ucschar = q{\x{00A0}-\x{200D}\x{2010}-\x{2029}\x{202F}-\x{D7FF}\x{F900}-\x{FDCF}\x{FDF0}-\x{FFEF}\x{10000}-\x{1FFFD}\x{20000}-\x{2FFFD}\x{30000}-\x{3FFFD}\x{40000}-\x{4FFFD}\x{50000}-\x{5FFFD}\x{60000}-\x{6FFFD}\x{70000}-\x{7FFFD}\x{80000}-\x{8FFFD}\x{90000}-\x{9FFFD}\x{A0000}-\x{AFFFD}\x{B0000}-\x{BFFFD}\x{C0000}-\x{CFFFD}\x{D0000}-\x{DFFFD}\x{E1000}-\x{EFFFD}};
2425
2426 ## -- No scheme
2427 if ($v =~ s!^[^/?#]*:!!s) {
2428 last V;
2429 }
2430
2431 ## -- Fragment
2432 if ($v =~ s/#(.*)\z//s) {
2433 my $w = $1;
2434 unless ($w =~ m{\A(?>[A-Za-z0-9._~!\$&'()*+,;=:\@/?$ucschar-]|%[0-9A-Fa-f][0-9A-Fa-f])*\z}o) {
2435 last V;
2436 }
2437 }
2438
2439 ## -- Query
2440 if ($v =~ s/\?(.*)\z//s) {
2441 my $w = $1;
2442 unless ($w =~ m{\A(?>[A-Za-z0-9._~!\$&'()*+,;=:\@/?$ucschar\x{E000}-\x{F8FF}\x{F0000}-\x{FFFFD}\x{100000}-\x{10FFFD}-]|%[0-9A-Fa-f][0-9A-Fa-f])*\z}o) {
2443 last V;
2444 }
2445 }
2446
2447 ## -- Authority
2448 if ($v =~ s!^//([^/]*)!!s) {
2449 my $w = $1;
2450 $w =~ s/^(?>[A-Za-z0-9._~!\$&'()*+,;=:$ucschar-]|%[0-9A-Fa-f][0-9A-Fa-f])*\@//os;
2451 $w =~ s/:[0-9]*\z//;
2452 if ($w =~ /^\[(.*)\]\z/s) {
2453 my $x = $1;
2454 unless ($x =~ /\A[vV][0-9A-Fa-f]+\.[A-Za-z0-9._~!\$&'()*+,;=:-]+\z/) {
2455 ## IPv6address
2456 my $isv6;
2457 __CODE{isIPv6address:: $in => $x, $out => $isv6}__;
2458 last V unless $isv6;
2459 }
2460 } else {
2461 unless ($w =~ /\A(?>[A-Za-z0-9._~!\$&'()*+,;=$ucschar-]|%[0-9A-Fa-f][0-9A-Fa-f])*\z/o) {
2462 last V;
2463 }
2464 }
2465 }
2466
2467 ## -- Path
2468 unless ($v =~ m{\A(?>[A-Za-z0-9._~!\$&'()*+,;=:\@/$ucschar-]|%[0-9A-Fa-f][0-9A-Fa-f])*\z}os) {
2469 last V;
2470 }
2471
2472 $r = true;
2473 } # V
2474
2475 @Attr:
2476 @@Name: isIRIReference
2477 @@enDesc:
2478 Whether the DOM URI is an IRI reference or not according to the latest
2479 version of the IRI specification.
2480
2481 {NOTE:: At the time of writing, RFC 3987 is the latest
2482 version and the attribute must contain the value
2483 same as <A::URIReference.isIRIReference3987> attribute of
2484 the same object.
2485 }
2486 @@Type: idl|boolean||ManakaiDOM|all
2487 @@Get:
2488 @@@TrueCase:
2489 @@@@enDesc:
2490 If it is a legal IRI reference.
2491 @@@FalseCase:
2492 @@@@enDesc:
2493 If it is not a legal IRI reference.
2494 @@@PerlDef:
2495 __DEEP{
2496 $r = $self-><AG::URIReference.isIRIReference3987>;
2497 }__;
2498
2499 @Attr:
2500 @@Name: isIRIReference3987
2501 @@DISPerl:methodName: is_iri_reference_3987
2502 @@enDesc:
2503 Whether the DOM URI is an RFC 3987 IRI reference or not.
2504 @@Type: idl|boolean||ManakaiDOM|all
2505 @@Get:
2506 @@@TrueCase:
2507 @@@@enDesc:
2508 If the DOM URI matches to the production
2509 rule <ABNF::IRI-reference> <SRC::RFC 3987 2.2, 4.1>.
2510 @@@FalseCase:
2511 @@@@enDesc: Otherwise.
2512 @@@PerlDef:
2513 __DEEP{
2514 $r = $self-><AG::URIReference.isIRI3987> ||
2515 $self-><AG::URIReference.isRelativeIRIReference3987>;
2516 }__;
2517
2518 @Attr:
2519 @@Name: isAbsoluteIRI
2520 @@enDesc:
2521 Whether the DOM URI is an absolute IRI or not according to the latest
2522 version of the IRI specification.
2523
2524 {NOTE:: At the time of writing, RFC 3987 is the latest
2525 version and the attribute must contain the value
2526 same as <A::URIReference.isAbsoluteIRI3987> attribute of
2527 the same object.
2528 }
2529 @@Type: idl|boolean||ManakaiDOM|all
2530 @@Get:
2531 @@@TrueCase:
2532 @@@@enDesc:
2533 If it is a legal absolute IRI.
2534 @@@FalseCase:
2535 @@@@enDesc:
2536 If it is not a legal absolute IRI.
2537 @@@PerlDef:
2538 __DEEP{
2539 $r = $self-><AG::URIReference.isAbsoluteIRI3987>;
2540 }__;
2541
2542 @Attr:
2543 @@Name: isAbsoluteIRI3987
2544 @@DISPerl:methodName: is_absolute_iri_3987
2545 @@enDesc:
2546 Whether the DOM URI is an RFC 3987 absolute IRI or not.
2547 @@Type: idl|boolean||ManakaiDOM|all
2548 @@Get:
2549 @@@TrueCase:
2550 @@@@enDesc:
2551 If the DOM URI matches to the production
2552 rule <ABNF::absolute-IRI> <SRC::RFC 3987 2.2, 4.1>.
2553 @@@FalseCase:
2554 @@@@enDesc: Otherwise.
2555 @@@PerlDef:
2556 __DEEP{
2557 $r = $$self !~ /#/ && $self-><AG::URIReference.isIRI3987>;
2558 }__;
2559
2560 @CODE:
2561 @@QName: isIPv6address
2562 @@enDesc:
2563 <Perl::$in>, <Perl::$out>
2564 @@PerlDef:
2565 my $ipv4 = qr/(?>0|1[0-9]{0,2}|2(?>[0-4][0-9]?|5[0-5]?|[6-9])?|[3-9][0-9]?)(?>\.(?>0|1[0-9]{0,2}|2(?>[0-4][0-9]?|5[0-5]?|[6-9])?|[3-9][0-9]?)){3}/;
2566 my $h16 = qr/[0-9A-Fa-f]{1,4}/;
2567 if ($in =~ s/(?:$ipv4|$h16)\z//o) {
2568 if ($in =~ /\A(?>$h16:){6}\z/o or
2569 $in =~ /\A::(?>$h16:){0,5}\z/o or
2570 $in =~ /\A${h16}::(?>$h16:){4}\z/o or
2571 $in =~ /\A$h16(?::$h16)?::(?>$h16:){3}\z/o or
2572 $in =~ /\A$h16(?::$h16){0,2}::(?>$h16:){2}\z/o or
2573 $in =~ /\A$h16(?::$h16){0,3}::$h16:\z/o or
2574 $in =~ /\A$h16(?::$h16){0,4}::\z/o) {
2575 $out = true;
2576 }
2577 } elsif ($in =~ s/$h16\z//o) {
2578 if ($in eq '' or $in =~ /\A$h16(?>:$h16){0,5}\z/o) {
2579 $out = true;
2580 }
2581 } elsif ($in =~ s/::\z//o) {
2582 if ($in eq '' or $in =~ /\A$h16(?>:$h16){0,6}\z/o) {
2583 $out = true;
2584 }
2585 }
2586
2587 @Method:
2588 @@Name: getURIReference
2589 @@enDesc:
2590 Creates a clone of the DOM URI object, in which
2591 any character not allowed in URI references are percent-encoded
2592 as per the latest version of the URI specification.
2593
2594 {NOTE:: At the time of writing, RFC 3986 is the latest
2595 version and the method must return the same
2596 result as <M::URIReference.getURIReference3986> method.
2597 }
2598 @@Return:
2599 @@@Type: URIReference
2600 @@@enDesc:
2601 The newly created <IF::URIReference> object.
2602 @@@PerlDef:
2603 __DEEP{
2604 $r = $self-><M::URIReference.getURIReference3986>;
2605 }__;
2606
2607 @Method:
2608 @@Name: getURIReference3986
2609 @@DISPerl:methodName: get_uri_reference_3986
2610 @@enDesc:
2611 Creates a clone of the DOM URI object, in which
2612 any character not allowed in RFC 3986 URI references are percent-encoded.
2613
2614 {P:: The method <kwd:MUST> perform the algorithm specified
2615 in the section 3.1 of the RFC 3987 on a copy of the DOM URI
2616 contained by the object, as amended as:
2617
2618 {LI:: it <kwd:MUST-NOT> convert the authority component
2619 using the IDNA rule.
2620
2621 {ISSUE::
2622 Define a separate method to convert IDN to Punycoded name.
2623 }
2624 }
2625
2626 - it <kwd:MUST> also deal with the characters not allowed
2627 in URIs in step 2 of the RFC 3987 algorithm.
2628 }
2629
2630 {NOTE::
2631 The result DOM URI might not be a conformant RFC 3986
2632 URI reference.
2633 }
2634 @@Return:
2635 @@@Type: URIReference
2636 @@@enDesc:
2637 The newly created <IF::URIReference> object.
2638 @@@PerlDef:
2639 __DEEP{
2640 require Encode;
2641 my $v = Encode::encode ('utf8', $$self);
2642 $v =~ s/([<>"{}|\\\^`\x00-\x20\x7E-\xFF])/sprintf '%%%02X', ord $1/ge;
2643 $r = bless \$v, <ClassName::ManakaiURIReference>;
2644 }__;
2645
2646 @Method:
2647 @@Name: getIRIReference
2648 @@enDesc:
2649 Creates a clone of the DOM URI object, in which percent-encodings
2650 are decoded as far as possible
2651 as per the latest version of the IRI specification.
2652
2653 {NOTE:: At the time of writing, RFC 3987 is the latest
2654 version and the method must return the same
2655 result as <M::URIReference.getIRIReference3987> method.
2656 }
2657 @@Return:
2658 @@@Type: URIReference
2659 @@@enDesc:
2660 The newly created <IF::URIReference> object.
2661 @@@PerlDef:
2662 __DEEP{
2663 $r = $self-><M::URIReference.getIRIReference3987>;
2664 }__;
2665
2666 @Method:
2667 @@Name: getIRIReference3987
2668 @@DISPerl:methodName: get_iri_reference_3987
2669 @@enDesc:
2670 Creates a clone of the DOM URI object, in which
2671 percent-encodings are decoded as far as possible
2672 as defined in RFC 3987 IRI references.
2673
2674 {P:: The method <kwd:MUST> perform a variant of the algorithm specified
2675 in the section 3.2 of RFC 3987 on a copy of the DOM URI
2676 contained by the object, as amended by replacing step 4 as:
2677
2678 {LI::
2679 Re-percent-encode all octets produced in step 3 that in
2680 UTF-8 represent characters that:
2681
2682 - are US-ASCII characters not allowed in RFC 3986 URI
2683 references,
2684
2685 - are not contained in <ABNF::ucschar>
2686 character range and are not US-ASCII printable characters, or
2687
2688 - are contained in the list of forbidden characters
2689 in the section 4.1 of RFC 3987.
2690 }
2691 }
2692
2693 {NOTE::
2694 The result DOM URI might not be a conformant RFC 3987
2695 IRI reference.
2696 }
2697 @@Return:
2698 @@@Type: URIReference
2699 @@@enDesc:
2700 The newly created <IF::URIReference> object.
2701 @@@PerlDef:
2702 __DEEP{
2703 require Encode;
2704 my $v = Encode::encode ('utf8', $$self);
2705 $v =~ s{%([2-9A-Fa-f][0-9A-Fa-f])}
2706 {
2707 my $ch = hex $1;
2708 if ([
2709 # 0x0 0x1 0x2 0x3 0x4 0x5 0x6 0x7
2710 # 0x8 0x9 0xA 0xB 0xC 0xD 0xE 0xF
2711 true, true, true, true, true, true, true, true, # 0x00
2712 true, true, true, true, true, true, true, true, # 0x08
2713 true, true, true, true, true, true, true, true, # 0x10
2714 true, true, true, true, true, true, true, true, # 0x18
2715 true, true, true, true, true, true, true, true, # 0x20
2716 true, true, true, true, true, false, false, true, # 0x28
2717 false, false, false, false, false, false, false, false, # 0x30
2718 false, false, true, true, true, true, true, true, # 0x38
2719 true, false, false, false, false, false, false, false, # 0x40
2720 false, false, false, false, false, false, false, false, # 0x48
2721 false, false, false, false, false, false, false, false, # 0x50
2722 false, false, false, true, true, true, true, false, # 0x58
2723 true, false, false, false, false, false, false, false, # 0x60
2724 false, false, false, false, false, false, false, false, # 0x68
2725 false, false, false, false, false, false, false, false, # 0x70
2726 false, false, false, true, true, true, false, true, # 0x78
2727 # 0x0 0x1 0x2 0x3 0x4 0x5 0x6 0x7
2728 # 0x8 0x9 0xA 0xB 0xC 0xD 0xE 0xF
2729 ]->[$ch]) {
2730 # PERCENT SIGN, reserved, not-allowed in ASCII
2731 '%'.$1;
2732 } else {
2733 chr $ch;
2734 }
2735 }ge;
2736 $v =~ s{(
2737 [\xC2-\xDF][\x80-\xBF] | # UTF8-2
2738 [\xE0][\xA0-\xBF][\x80-\xBF] |
2739 [\xE1-\xEC][\x80-\xBF][\x80-\xBF] |
2740 [\xED][\x80-\x9F][\x80-\xBF] |
2741 [\xEE\xEF][\x80-\xBF][\x80-\xBF] | # UTF8-3
2742 [\xF0][\x90-\xBF][\x80-\xBF][\x80-\xBF] |
2743 [\xF1-\xF3][\x80-\xBF][\x80-\xBF][\x80-\xBF] |
2744 [\xF4][\x80-\x8F][\x80-\xBF][\x80-\xBF] | # UTF8-4
2745 [\x80-\xFF]
2746 )}{
2747 my $c = $1;
2748 if (length ($c) == 1) {
2749 $c =~ s/(.)/sprintf '%%%02X', ord $1/ge;
2750 $c;
2751 } else {
2752 my $ch = Encode::decode ('utf8', $c);
2753 if ($ch =~ /^[\x{00A0}-\x{200D}\x{2010}-\x{2029}\x{202F}-\x{D7FF}\x{F900}-\x{FDCF}\x{FDF0}-\x{FFEF}\x{10000}-\x{1FFFD}\x{20000}-\x{2FFFD}\x{30000}-\x{3FFFD}\x{40000}-\x{4FFFD}\x{50000}-\x{5FFFD}\x{60000}-\x{6FFFD}\x{70000}-\x{7FFFD}\x{80000}-\x{8FFFD}\x{90000}-\x{9FFFD}\x{A0000}-\x{AFFFD}\x{B0000}-\x{BFFFD}\x{C0000}-\x{CFFFD}\x{D0000}-\x{DFFFD}\x{E1000}-\x{EFFFD}]/) {
2754 $c;
2755 } else {
2756 $c =~ s/([\x80-\xFF])/sprintf '%%%02X', ord $1/ge;
2757 $c;
2758 }
2759 }
2760 }gex;
2761 $v =~ s/([<>"{}|\\\^`\x00-\x20\x7F])/sprintf '%%%02X', ord $1/ge;
2762 $v = Encode::decode ('utf8', $v);
2763 $r = bless \$v, <ClassName::ManakaiURIReference>;
2764 }__;
2765
2766 @Test:
2767 @@QName: URIRef.validity.test
2768 @@PerlDef:
2769 my $impl;
2770 __CODE{createURIImplForTest:: $impl => $impl}__;
2771
2772 for (
2773 {
2774 in => q<http://foo.example/>,
2775 get_uri_reference => q<http://foo.example/>,
2776 get_uri_reference_3986 => q<http://foo.example/>,
2777 get_iri_reference => q<http://foo.example/>,
2778 get_iri_reference_3987 => q<http://foo.example/>,
2779 is_uri_reference => true, is_iri_reference => true,
2780 is_uri_reference_3986 => true, is_iri_reference_3987 => true,
2781 is_uri => true, is_iri => true,
2782 is_uri_3986 => true, is_iri_3987 => true,
2783 is_relative_reference => false, is_relative_iri_reference => false,
2784 is_relative_reference_3986 => false,
2785 is_relative_iri_reference_3987 => false,
2786 is_absolute_uri => true, is_absolute_iri => true,
2787 is_absolute_uri_3986 => true, is_absolute_iri_3987 => true,
2788 is_empty_reference => false,
2789 },
2790 {
2791 in => q<http://foo.example/#fragment>,
2792 get_uri_reference => q<http://foo.example/#fragment>,
2793 get_uri_reference_3986 => q<http://foo.example/#fragment>,
2794 get_iri_reference => q<http://foo.example/#fragment>,
2795 get_iri_reference_3987 => q<http://foo.example/#fragment>,
2796 is_uri_reference => true, is_iri_reference => true,
2797 is_uri_reference_3986 => true, is_iri_reference_3987 => true,
2798 is_uri => true, is_iri => true,
2799 is_uri_3986 => true, is_iri_3987 => true,
2800 is_relative_reference => false, is_relative_iri_reference => false,
2801 is_relative_reference_3986 => false,
2802 is_relative_iri_reference_3987 => false,
2803 is_absolute_uri => false, is_absolute_iri => false,
2804 is_absolute_uri_3986 => false, is_absolute_iri_3987 => false,
2805 is_empty_reference => false,
2806 },
2807 {
2808 in => q<http://foo.example/">,
2809 get_uri_reference => q<http://foo.example/%22>,
2810 get_uri_reference_3986 => q<http://foo.example/%22>,
2811 get_iri_reference => q<http://foo.example/%22>,
2812 get_iri_reference_3987 => q<http://foo.example/%22>,
2813 is_uri_reference => false, is_iri_reference => false,
2814 is_uri_reference_3986 => false, is_iri_reference_3987 => false,
2815 is_uri => false, is_iri => false,
2816 is_uri_3986 => false, is_iri_3987 => false,
2817 is_relative_reference => false, is_relative_iri_reference => false,
2818 is_relative_reference_3986 => false,
2819 is_relative_iri_reference_3987 => false,
2820 is_absolute_uri => false, is_absolute_iri => false,
2821 is_absolute_uri_3986 => false, is_absolute_iri_3987 => false,
2822 is_empty_reference => false,
2823 },
2824 {
2825 in => q<http://foo.example/[a]>,
2826 get_uri_reference => q<http://foo.example/[a]>,
2827 get_uri_reference_3986 => q<http://foo.example/[a]>,
2828 get_iri_reference => q<http://foo.example/[a]>,
2829 get_iri_reference_3987 => q<http://foo.example/[a]>,
2830 is_uri_reference => false, is_iri_reference => false,
2831 is_uri_reference_3986 => false, is_iri_reference_3987 => false,
2832 is_uri => false, is_iri => false,
2833 is_uri_3986 => false, is_iri_3987 => false,
2834 is_relative_reference => false, is_relative_iri_reference => false,
2835 is_relative_reference_3986 => false,
2836 is_relative_iri_reference_3987 => false,
2837 is_absolute_uri => false, is_absolute_iri => false,
2838 is_absolute_uri_3986 => false, is_absolute_iri_3987 => false,
2839 is_empty_reference => false,
2840 },
2841 {
2842 in => q<http://[::]/>,
2843 get_uri_reference => q<http://[::]/>,
2844 get_uri_reference_3986 => q<http://[::]/>,
2845 get_iri_reference => q<http://[::]/>,
2846 get_iri_reference_3987 => q<http://[::]/>,
2847 is_uri_reference => true, is_iri_reference => true,
2848 is_uri_reference_3986 => true, is_iri_reference_3987 => true,
2849 is_uri => true, is_iri => true,
2850 is_uri_3986 => true, is_iri_3987 => true,
2851 is_relative_reference => false, is_relative_iri_reference => false,
2852 is_relative_reference_3986 => false,
2853 is_relative_iri_reference_3987 => false,
2854 is_absolute_uri => true, is_absolute_iri => true,
2855 is_absolute_uri_3986 => true, is_absolute_iri_3987 => true,
2856 is_empty_reference => false,
2857 },
2858 {
2859 in => q<//foo.example/>,
2860 get_uri_reference => q<//foo.example/>,
2861 get_uri_reference_3986 => q<//foo.example/>,
2862 get_iri_reference => q<//foo.example/>,
2863 get_iri_reference_3987 => q<//foo.example/>,
2864 is_uri_reference => true, is_iri_reference => true,
2865 is_uri_reference_3986 => true, is_iri_reference_3987 => true,
2866 is_uri => false, is_iri => false,
2867 is_uri_3986 => false, is_iri_3987 => false,
2868 is_relative_reference => true, is_relative_iri_reference => true,
2869 is_relative_reference_3986 => true,
2870 is_relative_iri_reference_3987 => true,
2871 is_absolute_uri => false, is_absolute_iri => false,
2872 is_absolute_uri_3986 => false, is_absolute_iri_3987 => false,
2873 is_empty_reference => false,
2874 },
2875 {
2876 in => q<>,
2877 get_uri_reference => q<>,
2878 get_uri_reference_3986 => q<>,
2879 get_iri_reference => q<>,
2880 get_iri_reference_3987 => q<>,
2881 is_uri_reference => true, is_iri_reference => true,
2882 is_uri_reference_3986 => true, is_iri_reference_3987 => true,
2883 is_uri => false, is_iri => false,
2884 is_uri_3986 => false, is_iri_3987 => false,
2885 is_relative_reference => true, is_relative_iri_reference => true,
2886 is_relative_reference_3986 => true,
2887 is_relative_iri_reference_3987 => true,
2888 is_absolute_uri => false, is_absolute_iri => false,
2889 is_absolute_uri_3986 => false, is_absolute_iri_3987 => false,
2890 is_empty_reference => true,
2891 },
2892 {
2893 in => qq<http://foo.example/\x{4E00}>,
2894 get_uri_reference => qq<http://foo.example/%E4%B8%80>,
2895 get_uri_reference_3986 => qq<http://foo.example/%E4%B8%80>,
2896 get_iri_reference => qq<http://foo.example/\x{4E00}>,
2897 get_iri_reference_3987 => qq<http://foo.example/\x{4E00}>,
2898 is_uri_reference => false, is_iri_reference => true,
2899 is_uri_reference_3986 => false, is_iri_reference_3987 => true,
2900 is_uri => false, is_iri => true,
2901 is_uri_3986 => false, is_iri_3987 => true,
2902 is_relative_reference => false, is_relative_iri_reference => false,
2903 is_relative_reference_3986 => false,
2904 is_relative_iri_reference_3987 => false,
2905 is_absolute_uri => false, is_absolute_iri => true,
2906 is_absolute_uri_3986 => false, is_absolute_iri_3987 => true,
2907 is_empty_reference => false,
2908 },
2909 {
2910 in => q<http://foo.example/%E4%B8%80>,
2911 get_uri_reference => q<http://foo.example/%E4%B8%80>,
2912 get_uri_reference_3986 => q<http://foo.example/%E4%B8%80>,
2913 get_iri_reference => qq<http://foo.example/\x{4E00}>,
2914 get_iri_reference_3987 => qq<http://foo.example/\x{4E00}>,
2915 is_uri_reference => true, is_iri_reference => true,
2916 is_uri_reference_3986 => true, is_iri_reference_3987 => true,
2917 is_uri => true, is_iri => true,
2918 is_uri_3986 => true, is_iri_3987 => true,
2919 is_relative_reference => false, is_relative_iri_reference => false,
2920 is_relative_reference_3986 => false,
2921 is_relative_iri_reference_3987 => false,
2922 is_absolute_uri => true, is_absolute_iri => true,
2923 is_absolute_uri_3986 => true, is_absolute_iri_3987 => true,
2924 is_empty_reference => false,
2925 },
2926 {
2927 in => q<ftp://ftp.is.co.za/rfc/rfc1808.txt>,
2928 get_uri_reference => q<ftp://ftp.is.co.za/rfc/rfc1808.txt>,
2929 get_uri_reference_3986 => q<ftp://ftp.is.co.za/rfc/rfc1808.txt>,
2930 get_iri_reference => q<ftp://ftp.is.co.za/rfc/rfc1808.txt>,
2931 get_iri_reference_3987 => q<ftp://ftp.is.co.za/rfc/rfc1808.txt>,
2932 is_uri_reference => true, is_iri_reference => true,
2933 is_uri_reference_3986 => true, is_iri_reference_3987 => true,
2934 is_uri => true, is_iri => true,
2935 is_uri_3986 => true, is_iri_3987 => true,
2936 is_relative_reference => false, is_relative_iri_reference => false,
2937 is_relative_reference_3986 => false,
2938 is_relative_iri_reference_3987 => false,
2939 is_absolute_uri => true, is_absolute_iri => true,
2940 is_absolute_uri_3986 => true, is_absolute_iri_3987 => true,
2941 is_empty_reference => false,
2942 },
2943 {
2944 in => q<http://www.ietf.org/rfc/rfc2396.txt>,
2945 get_uri_reference => q<http://www.ietf.org/rfc/rfc2396.txt>,
2946 get_uri_reference_3986 => q<http://www.ietf.org/rfc/rfc2396.txt>,
2947 get_iri_reference => q<http://www.ietf.org/rfc/rfc2396.txt>,
2948 get_iri_reference_3987 => q<http://www.ietf.org/rfc/rfc2396.txt>,
2949 is_uri_reference => true, is_iri_reference => true,
2950 is_uri_reference_3986 => true, is_iri_reference_3987 => true,
2951 is_uri => true, is_iri => true,
2952 is_uri_3986 => true, is_iri_3987 => true,
2953 is_relative_reference => false, is_relative_iri_reference => false,
2954 is_relative_reference_3986 => false,
2955 is_relative_iri_reference_3987 => false,
2956 is_absolute_uri => true, is_absolute_iri => true,
2957 is_absolute_uri_3986 => true, is_absolute_iri_3987 => true,
2958 is_empty_reference => false,
2959 },
2960 {
2961 in => q<ldap://[2001:db8::7]/c=GB?objectClass?one>,
2962 get_uri_reference => q<ldap://[2001:db8::7]/c=GB?objectClass?one>,
2963 get_uri_reference_3986 => q<ldap://[2001:db8::7]/c=GB?objectClass?one>,
2964 get_iri_reference => q<ldap://[2001:db8::7]/c=GB?objectClass?one>,
2965 get_iri_reference_3987 => q<ldap://[2001:db8::7]/c=GB?objectClass?one>,
2966 is_uri_reference => true, is_iri_reference => true,
2967 is_uri_reference_3986 => true, is_iri_reference_3987 => true,
2968 is_uri => true, is_iri => true,
2969 is_uri_3986 => true, is_iri_3987 => true,
2970 is_relative_reference => false, is_relative_iri_reference => false,
2971 is_relative_reference_3986 => false,
2972 is_relative_iri_reference_3987 => false,
2973 is_absolute_uri => true, is_absolute_iri => true,
2974 is_absolute_uri_3986 => true, is_absolute_iri_3987 => true,
2975 is_empty_reference => false,
2976 },
2977 {
2978 in => q<mailto:John.Doe@example.com>,
2979 get_uri_reference => q<mailto:John.Doe@example.com>,
2980 get_uri_reference_3986 => q<mailto:John.Doe@example.com>,
2981 get_iri_reference => q<mailto:John.Doe@example.com>,
2982 get_iri_reference_3987 => q<mailto:John.Doe@example.com>,
2983 is_uri_reference => true, is_iri_reference => true,
2984 is_uri_reference_3986 => true, is_iri_reference_3987 => true,
2985 is_uri => true, is_iri => true,
2986 is_uri_3986 => true, is_iri_3987 => true,
2987 is_relative_reference => false, is_relative_iri_reference => false,
2988 is_relative_reference_3986 => false,
2989 is_relative_iri_reference_3987 => false,
2990 is_absolute_uri => true, is_absolute_iri => true,
2991 is_absolute_uri_3986 => true, is_absolute_iri_3987 => true,
2992 is_empty_reference => false,
2993 },
2994 {
2995 in => q<news:comp.infosystems.www.servers.unix>,
2996 get_uri_reference => q<news:comp.infosystems.www.servers.unix>,
2997 get_uri_reference_3986 => q<news:comp.infosystems.www.servers.unix>,
2998 get_iri_reference => q<news:comp.infosystems.www.servers.unix>,
2999 get_iri_reference_3987 => q<news:comp.infosystems.www.servers.unix>,
3000 is_uri_reference => true, is_iri_reference => true,
3001 is_uri_reference_3986 => true, is_iri_reference_3987 => true,
3002 is_uri => true, is_iri => true,
3003 is_uri_3986 => true, is_iri_3987 => true,
3004 is_relative_reference => false, is_relative_iri_reference => false,
3005 is_relative_reference_3986 => false,
3006 is_relative_iri_reference_3987 => false,
3007 is_absolute_uri => true, is_absolute_iri => true,
3008 is_absolute_uri_3986 => true, is_absolute_iri_3987 => true,
3009 is_empty_reference => false,
3010 },
3011 {
3012 in => q<tel:+1-816-555-1212>,
3013 get_uri_reference => q<tel:+1-816-555-1212>,
3014 get_uri_reference_3986 => q<tel:+1-816-555-1212>,
3015 get_iri_reference => q<tel:+1-816-555-1212>,
3016 get_iri_reference_3987 => q<tel:+1-816-555-1212>,
3017 is_uri_reference => true, is_iri_reference => true,
3018 is_uri_reference_3986 => true, is_iri_reference_3987 => true,
3019 is_uri => true, is_iri => true,
3020 is_uri_3986 => true, is_iri_3987 => true,
3021 is_relative_reference => false, is_relative_iri_reference => false,
3022 is_relative_reference_3986 => false,
3023 is_relative_iri_reference_3987 => false,
3024 is_absolute_uri => true, is_absolute_iri => true,
3025 is_absolute_uri_3986 => true, is_absolute_iri_3987 => true,
3026 is_empty_reference => false,
3027 },
3028 {
3029 in => q<urn:oasis:names:specification:docbook:dtd:xml:4.1.2>,
3030 get_uri_reference => q<urn:oasis:names:specification:docbook:dtd:xml:4.1.2>,
3031 get_uri_reference_3986 => q<urn:oasis:names:specification:docbook:dtd:xml:4.1.2>,
3032 get_iri_reference => q<urn:oasis:names:specification:docbook:dtd:xml:4.1.2>,
3033 get_iri_reference_3987 => q<urn:oasis:names:specification:docbook:dtd:xml:4.1.2>,
3034 is_uri_reference => true, is_iri_reference => true,
3035 is_uri_reference_3986 => true, is_iri_reference_3987 => true,
3036 is_uri => true, is_iri => true,
3037 is_uri_3986 => true, is_iri_3987 => true,
3038 is_relative_reference => false, is_relative_iri_reference => false,
3039 is_relative_reference_3986 => false,
3040 is_relative_iri_reference_3987 => false,
3041 is_absolute_uri => true, is_absolute_iri => true,
3042 is_absolute_uri_3986 => true, is_absolute_iri_3987 => true,
3043 is_empty_reference => false,
3044 },
3045 {
3046 in => q<mid:a%b@foo.example>,
3047 get_uri_reference => q<mid:a%b@foo.example>,
3048 get_uri_reference_3986 => q<mid:a%b@foo.example>,
3049 get_iri_reference => q<mid:a%b@foo.example>,
3050 get_iri_reference_3987 => q<mid:a%b@foo.example>,
3051 is_uri_reference => false, is_iri_reference => false,
3052 is_uri_reference_3986 => false, is_iri_reference_3987 => false,
3053 is_uri => false, is_iri => false,
3054 is_uri_3986 => false, is_iri_3987 => false,
3055 is_relative_reference => false, is_relative_iri_reference => false,
3056 is_relative_reference_3986 => false,
3057 is_relative_iri_reference_3987 => false,
3058 is_absolute_uri => false, is_absolute_iri => false,
3059 is_absolute_uri_3986 => false, is_absolute_iri_3987 => false,
3060 is_empty_reference => false,
3061 },
3062 {
3063 in => q<foo://example.com:8042/over/there?name=ferret#nose>,
3064 get_uri_reference => q<foo://example.com:8042/over/there?name=ferret#nose>,
3065 get_uri_reference_3986 => q<foo://example.com:8042/over/there?name=ferret#nose>,
3066 get_iri_reference => q<foo://example.com:8042/over/there?name=ferret#nose>,
3067 get_iri_reference_3987 => q<foo://example.com:8042/over/there?name=ferret#nose>,
3068 is_uri_reference => true, is_iri_reference => true,
3069 is_uri_reference_3986 => true, is_iri_reference_3987 => true,
3070 is_uri => true, is_iri => true,
3071 is_uri_3986 => true, is_iri_3987 => true,
3072 is_relative_reference => false, is_relative_iri_reference => false,
3073 is_relative_reference_3986 => false,
3074 is_relative_iri_reference_3987 => false,
3075 is_absolute_uri => false, is_absolute_iri => false,
3076 is_absolute_uri_3986 => false, is_absolute_iri_3987 => false,
3077 is_empty_reference => false,
3078 },
3079 {
3080 in => q<www.w3.org/Addressing/>,
3081 get_uri_reference => q<www.w3.org/Addressing/>,
3082 get_uri_reference_3986 => q<www.w3.org/Addressing/>,
3083 get_iri_reference => q<www.w3.org/Addressing/>,
3084 get_iri_reference_3987 => q<www.w3.org/Addressing/>,
3085 is_uri_reference => true, is_iri_reference => true,
3086 is_uri_reference_3986 => true, is_iri_reference_3987 => true,
3087 is_uri => false, is_iri => false,
3088 is_uri_3986 => false, is_iri_3987 => false,
3089 is_relative_reference => true, is_relative_iri_reference => true,
3090 is_relative_reference_3986 => true,
3091 is_relative_iri_reference_3987 => true,
3092 is_absolute_uri => false, is_absolute_iri => false,
3093 is_absolute_uri_3986 => false, is_absolute_iri_3987 => false,
3094 is_empty_reference => false,
3095 },
3096 {
3097 in => q<g;x=1/../y>,
3098 get_uri_reference => q<g;x=1/../y>,
3099 get_uri_reference_3986 => q<g;x=1/../y>,
3100 get_iri_reference => q<g;x=1/../y>,
3101 get_iri_reference_3987 => q<g;x=1/../y>,
3102 is_uri_reference => true, is_iri_reference => true,
3103 is_uri_reference_3986 => true, is_iri_reference_3987 => true,
3104 is_uri => false, is_iri => false,
3105 is_uri_3986 => false, is_iri_3987 => false,
3106 is_relative_reference => true, is_relative_iri_reference => true,
3107 is_relative_reference_3986 => true,
3108 is_relative_iri_reference_3987 => true,
3109 is_absolute_uri => false, is_absolute_iri => false,
3110 is_absolute_uri_3986 => false, is_absolute_iri_3987 => false,
3111 is_empty_reference => false,
3112 },
3113 {
3114 in => q<eXAMPLE://a/./b/../b/%63/%7bfoo%7d>,
3115 get_uri_reference => q<eXAMPLE://a/./b/../b/%63/%7bfoo%7d>,
3116 get_uri_reference_3986 => q<eXAMPLE://a/./b/../b/%63/%7bfoo%7d>,
3117 get_iri_reference => q<eXAMPLE://a/./b/../b/c/%7bfoo%7d>,
3118 get_iri_reference_3987 => q<eXAMPLE://a/./b/../b/c/%7bfoo%7d>,
3119 is_uri_reference => true, is_iri_reference => true,
3120 is_uri_reference_3986 => true, is_iri_reference_3987 => true,
3121 is_uri => true, is_iri => true,
3122 is_uri_3986 => true, is_iri_3987 => true,
3123 is_relative_reference => false, is_relative_iri_reference => false,
3124 is_relative_reference_3986 => false,
3125 is_relative_iri_reference_3987 => false,
3126 is_absolute_uri => true, is_absolute_iri => true,
3127 is_absolute_uri_3986 => true, is_absolute_iri_3987 => true,
3128 is_empty_reference => false,
3129 },
3130 {
3131 in => q<ftp://cnn.example.com&story=breaking_news@10.0.0.1/top_story.htm>,
3132 get_uri_reference => q<ftp://cnn.example.com&story=breaking_news@10.0.0.1/top_story.htm>,
3133 get_uri_reference_3986 => q<ftp://cnn.example.com&story=breaking_news@10.0.0.1/top_story.htm>,
3134 get_iri_reference => q<ftp://cnn.example.com&story=breaking_news@10.0.0.1/top_story.htm>,
3135 get_iri_reference_3987 => q<ftp://cnn.example.com&story=breaking_news@10.0.0.1/top_story.htm>,
3136 is_uri_reference => true, is_iri_reference => true,
3137 is_uri_reference_3986 => true, is_iri_reference_3987 => true,
3138 is_uri => true, is_iri => true,
3139 is_uri_3986 => true, is_iri_3987 => true,
3140 is_relative_reference => false, is_relative_iri_reference => false,
3141 is_relative_reference_3986 => false,
3142 is_relative_iri_reference_3987 => false,
3143 is_absolute_uri => true, is_absolute_iri => true,
3144 is_absolute_uri_3986 => true, is_absolute_iri_3987 => true,
3145 is_empty_reference => false,
3146 },
3147 {
3148 in => qq<http://r\xE9sum\xE9.example.org>,
3149 get_uri_reference => qq<http://r%C3%A9sum%C3%A9.example.org>,
3150 get_uri_reference_3986 => qq<http://r%C3%A9sum%C3%A9.example.org>,
3151 get_iri_reference => qq<http://r\xE9sum\xE9.example.org>,
3152 get_iri_reference_3987 => qq<http://r\xE9sum\xE9.example.org>,
3153 is_uri_reference => false, is_iri_reference => true,
3154 is_uri_reference_3986 => false, is_iri_reference_3987 => true,
3155 is_uri => false, is_iri => true,
3156 is_uri_3986 => false, is_iri_3987 => true,
3157 is_relative_reference => false, is_relative_iri_reference => false,
3158 is_relative_reference_3986 => false,
3159 is_relative_iri_reference_3987 => false,
3160 is_absolute_uri => false, is_absolute_iri => true,
3161 is_absolute_uri_3986 => false, is_absolute_iri_3987 => true,
3162 is_empty_reference => false,
3163 },
3164 {
3165 in => qq<http://r%C3%A9sum%C3%A9.example.org>,
3166 get_uri_reference => qq<http://r%C3%A9sum%C3%A9.example.org>,
3167 get_uri_reference_3986 => qq<http://r%C3%A9sum%C3%A9.example.org>,
3168 get_iri_reference => qq<http://r\xE9sum\xE9.example.org>,
3169 get_iri_reference_3987 => qq<http://r\xE9sum\xE9.example.org>,
3170 is_uri_reference => true, is_iri_reference => true,
3171 is_uri_reference_3986 => true, is_iri_reference_3987 => true,
3172 is_uri => true, is_iri => true,
3173 is_uri_3986 => true, is_iri_3987 => true,
3174 is_relative_reference => false, is_relative_iri_reference => false,
3175 is_relative_reference_3986 => false,
3176 is_relative_iri_reference_3987 => false,
3177 is_absolute_uri => true, is_absolute_iri => true,
3178 is_absolute_uri_3986 => true, is_absolute_iri_3987 => true,
3179 is_empty_reference => false,
3180 },
3181 {
3182 in => qq<http://www.example.org/red%09ros\xE9#red>,
3183 get_uri_reference => qq<http://www.example.org/red%09ros%C3%A9#red>,
3184 get_uri_reference_3986 => qq<http://www.example.org/red%09ros%C3%A9#red>,
3185 get_iri_reference => qq<http://www.example.org/red%09ros\xE9#red>,
3186 get_iri_reference_3987 => qq<http://www.example.org/red%09ros\xE9#red>,
3187 is_uri_reference => false, is_iri_reference => true,
3188 is_uri_reference_3986 => false, is_iri_reference_3987 => true,
3189 is_uri => false, is_iri => true,
3190 is_uri_3986 => false, is_iri_3987 => true,
3191 is_relative_reference => false, is_relative_iri_reference => false,
3192 is_relative_reference_3986 => false,
3193 is_relative_iri_reference_3987 => false,
3194 is_absolute_uri => false, is_absolute_iri => false,
3195 is_absolute_uri_3986 => false, is_absolute_iri_3987 => false,
3196 is_empty_reference => false,
3197 },
3198 {
3199 in => qq<http://www.example.org/red%09ros%c3%a9#red>,
3200 get_uri_reference => qq<http://www.example.org/red%09ros%c3%a9#red>,
3201 get_uri_reference_3986 => qq<http://www.example.org/red%09ros%c3%a9#red>,
3202 get_iri_reference => qq<http://www.example.org/red%09ros\xE9#red>,
3203 get_iri_reference_3987 => qq<http://www.example.org/red%09ros\xE9#red>,
3204 is_uri_reference => true, is_iri_reference => true,
3205 is_uri_reference_3986 => true, is_iri_reference_3987 => true,
3206 is_uri => true, is_iri => true,
3207 is_uri_3986 => true, is_iri_3987 => true,
3208 is_relative_reference => false, is_relative_iri_reference => false,
3209 is_relative_reference_3986 => false,
3210 is_relative_iri_reference_3987 => false,
3211 is_absolute_uri => false, is_absolute_iri => false,
3212 is_absolute_uri_3986 => false, is_absolute_iri_3987 => false,
3213 is_empty_reference => false,
3214 },
3215 {
3216 in => qq<http://example.com/\x{10300}\x{10301}\x{10302}>,
3217 get_uri_reference => qq<http://example.com/%F0%90%8C%80%F0%90%8C%81%F0%90%8C%82>,
3218 get_uri_reference_3986 => qq<http://example.com/%F0%90%8C%80%F0%90%8C%81%F0%90%8C%82>,
3219 get_iri_reference => qq<http://example.com/\x{10300}\x{10301}\x{10302}>,
3220 get_iri_reference_3987 => qq<http://example.com/\x{10300}\x{10301}\x{10302}>,
3221 is_uri_reference => false, is_iri_reference => true,
3222 is_uri_reference_3986 => false, is_iri_reference_3987 => true,
3223 is_uri => false, is_iri => true,
3224 is_uri_3986 => false, is_iri_3987 => true,
3225 is_relative_reference => false, is_relative_iri_reference => false,
3226 is_relative_reference_3986 => false,
3227 is_relative_iri_reference_3987 => false,
3228 is_absolute_uri => false, is_absolute_iri => true,
3229 is_absolute_uri_3986 => false, is_absolute_iri_3987 => true,
3230 is_empty_reference => false,
3231 },
3232 {
3233 in => qq<http://example.com/%F0%90%8C%80%F0%90%8C%81%F0%90%8C%82>,
3234 get_uri_reference => qq<http://example.com/%F0%90%8C%80%F0%90%8C%81%F0%90%8C%82>,
3235 get_uri_reference_3986 => qq<http://example.com/%F0%90%8C%80%F0%90%8C%81%F0%90%8C%82>,
3236 get_iri_reference => qq<http://example.com/\x{10300}\x{10301}\x{10302}>,
3237 get_iri_reference_3987 => qq<http://example.com/\x{10300}\x{10301}\x{10302}>,
3238 is_uri_reference => true, is_iri_reference => true,
3239 is_uri_reference_3986 => true, is_iri_reference_3987 => true,
3240 is_uri => true, is_iri => true,
3241 is_uri_3986 => true, is_iri_3987 => true,
3242 is_relative_reference => false, is_relative_iri_reference => false,
3243 is_relative_reference_3986 => false,
3244 is_relative_iri_reference_3987 => false,
3245 is_absolute_uri => true, is_absolute_iri => true,
3246 is_absolute_uri_3986 => true, is_absolute_iri_3987 => true,
3247 is_empty_reference => false,
3248 },
3249 {
3250 in => qq<http://www.example.org/r%E9sum%E9.html>,
3251 get_uri_reference => qq<http://www.example.org/r%E9sum%E9.html>,
3252 get_uri_reference_3986 => qq<http://www.example.org/r%E9sum%E9.html>,
3253 get_iri_reference => qq<http://www.example.org/r%E9sum%E9.html>,
3254 get_iri_reference_3987 => qq<http://www.example.org/r%E9sum%E9.html>,
3255 is_uri_reference => true, is_iri_reference => true,
3256 is_uri_reference_3986 => true, is_iri_reference_3987 => true,
3257 is_uri => true, is_iri => true,
3258 is_uri_3986 => true, is_iri_3987 => true,
3259 is_relative_reference => false, is_relative_iri_reference => false,
3260 is_relative_reference_3986 => false,
3261 is_relative_iri_reference_3987 => false,
3262 is_absolute_uri => true, is_absolute_iri => true,
3263 is_absolute_uri_3986 => true, is_absolute_iri_3987 => true,
3264 is_empty_reference => false,
3265 },
3266 {
3267 in => qq<http://www.example.org/r%E9sum%e9.html>,
3268 get_uri_reference => qq<http://www.example.org/r%E9sum%e9.html>,
3269 get_uri_reference_3986 => qq<http://www.example.org/r%E9sum%e9.html>,
3270 get_iri_reference => qq<http://www.example.org/r%E9sum%E9.html>,
3271 get_iri_reference_3987 => qq<http://www.example.org/r%E9sum%E9.html>,
3272 is_uri_reference => true, is_iri_reference => true,
3273 is_uri_reference_3986 => true, is_iri_reference_3987 => true,
3274 is_uri => true, is_iri => true,
3275 is_uri_3986 => true, is_iri_3987 => true,
3276 is_relative_reference => false, is_relative_iri_reference => false,
3277 is_relative_reference_3986 => false,
3278 is_relative_iri_reference_3987 => false,
3279 is_absolute_uri => true, is_absolute_iri => true,
3280 is_absolute_uri_3986 => true, is_absolute_iri_3987 => true,
3281 is_empty_reference => false,
3282 },
3283 {
3284 in => qq<http://xn--99zt52a.example.org/%e2%80%ae>,
3285 get_uri_reference => qq<http://xn--99zt52a.example.org/%e2%80%ae>,
3286 get_uri_reference_3986 => qq<http://xn--99zt52a.example.org/%e2%80%ae>,
3287 get_iri_reference => qq<http://xn--99zt52a.example.org/%E2%80%AE>,
3288 get_iri_reference_3987 => qq<http://xn--99zt52a.example.org/%E2%80%AE>,
3289 is_uri_reference => true, is_iri_reference => true,
3290 is_uri_reference_3986 => true, is_iri_reference_3987 => true,
3291 is_uri => true, is_iri => true,
3292 is_uri_3986 => true, is_iri_3987 => true,
3293 is_relative_reference => false, is_relative_iri_reference => false,
3294 is_relative_reference_3986 => false,
3295 is_relative_iri_reference_3987 => false,
3296 is_absolute_uri => true, is_absolute_iri => true,
3297 is_absolute_uri_3986 => true, is_absolute_iri_3987 => true,
3298 is_empty_reference => false,
3299 },
3300 {
3301 in => qq<http://example.org/%7Euser>,
3302 get_uri_reference => qq<http://example.org/%7Euser>,
3303 get_uri_reference_3986 => qq<http://example.org/%7Euser>,
3304 get_iri_reference => qq<http://example.org/~user>,
3305 get_iri_reference_3987 => qq<http://example.org/~user>,
3306 is_uri_reference => true, is_iri_reference => true,
3307 is_uri_reference_3986 => true, is_iri_reference_3987 => true,
3308 is_uri => true, is_iri => true,
3309 is_uri_3986 => true, is_iri_3987 => true,
3310 is_relative_reference => false, is_relative_iri_reference => false,
3311 is_relative_reference_3986 => false,
3312 is_relative_iri_reference_3987 => false,
3313 is_absolute_uri => true, is_absolute_iri => true,
3314 is_absolute_uri_3986 => true, is_absolute_iri_3987 => true,
3315 is_empty_reference => false,
3316 },
3317 ) {
3318 my $uri1 = $impl-><M::URIImplementation.createURIReference> ($_->{in});
3319
3320 for my $method (qw/get_uri_reference get_uri_reference_3986
3321 get_iri_reference get_iri_reference_3987/) {
3322 $test->id ($_->{in}.'.'.$method);
3323 $test->assert_equals ($uri1->$method-><AG::URIReference.uriReference>,
3324 $_->{$method});
3325 }
3326
3327 for my $method (qw/is_uri is_iri is_uri_3986 is_iri_3987
3328 is_uri_reference is_iri_reference
3329 is_uri_reference_3986 is_iri_reference_3987
3330 is_relative_reference is_relative_iri_reference
3331 is_relative_reference_3986
3332 is_relative_iri_reference_3987
3333 is_absolute_uri is_absolute_iri
3334 is_absolute_uri_3986 is_absolute_iri_3987
3335 is_empty_reference/) {
3336 $test->id ($_->{in}.'.'.$method);
3337 my $tm = $_->{$method} ? 'assert_true' : 'assert_false';
3338 $test->$tm ($uri1->$method);
3339 }
3340 }
3341
3342 @Method:
3343 @@Name: getAbsoluteReference
3344 @@enDesc:
3345 Returns the target DOM URI for the DOM URI resolved as per
3346 the latest version of the URI specification.
3347
3348 {NOTE::
3349 At the time of writing, RFC 3986 is the latest version
3350 of the URI specification. RFC 3987 shares the same
3351 resolution algorithm as RFC 3986. The method must
3352 return the same result as <M::URIReference.getAbsoluteReference3986>
3353 or <M::URIReference.getAbsoluteReference3987> would do.
3354 }
3355 @@Param:
3356 @@@Name: base
3357 @@@Type: URIReference
3358 @@@enDesc:
3359 The base DOM URI against which the DOM URI is resolved.
3360 @@@enDesc:
3361 @@@@ddid:perl
3362 @@@@@:
3363 For Perl binding, any value that can be specified
3364 as the parameter to the <M::URIImplementation.createURIReference>
3365 method can be set to the <P::base> parameter.
3366 @@NamedParam:
3367 @@@Name: nonStrict
3368 @@@Type: idl|boolean||ManakaiDOM|all
3369 @@@enDesc:
3370 Whether the resolution is done in the strict mode or not.
3371 @@Return:
3372 @@@Type: URIReference
3373 @@@enDesc:
3374 The target DOM URI.
3375 @@@PerlDef:
3376 __DEEP{
3377 $r = $self-><M::URIReference.getAbsoluteReference3986>
3378 ($base, non_strict => $nonStrict);
3379 }__;
3380
3381 @Method:
3382 @@Name: getAbsoluteReference3986
3383 @@DISPerl:methodName: get_absolute_reference_3986
3384 @@enDesc:
3385 Returns the target DOM URI for the DOM URI resolved as per RFC 3986.
3386
3387 The resolution is done according to the algorithm shown in
3388 RFC 3986 section 5.2 and a new <IF::URIReference>
3389 object containing the result target DOM URI is returned by the method.
3390
3391 The method <kwd:MUST> parse DOM URIs into five components
3392 as described in the RFC 3986 algorithm by the definition
3393 of attributes <A::URIReference.uriScheme>, <A::URIReference.uriAuthority>,
3394 <A::URIReference.uriPath>, <A::URIReference.uriQuery>, and
3395 <A::URIReference.uriFragment>. It is intended that for
3396 conforming RFC 3986 URI references they returns the identical
3397 set of components as described in RFC 3986.
3398
3399 The method <kwd:MUST-NOT> perform any normalization to DOM URIs
3400 <SRC::RFC 3986 5.2.1>. Applications can invoke appropriate
3401 methods before or after the relative reference resolution if desired.
3402 @@Param:
3403 @@@Name: base
3404 @@@Type: URIReference
3405 @@@enDesc:
3406 The base DOM URI against which the DOM URI is resolved.
3407
3408 If the scheme component of the <P::base> is missing, then
3409 the result is undefined.
3410 @@@enDesc:
3411 @@@@ddid:perl
3412 @@@@@:
3413 For Perl binding, any value that can be specified
3414 as the parameter to the <M::URIImplementation.createURIReference>
3415 method can be set to the <P::base> parameter.
3416 @@NamedParam:
3417 @@@Name: nonStrict
3418 @@@Type: idl|boolean||ManakaiDOM|all
3419 @@@enDesc:
3420 Whether the resolution is done in the strict mode or not.
3421 @@@TrueCase:
3422 @@@@enDesc:
3423 The <CODE::strict> flag in the algorithm in RFC 3986 section
3424 5.2.2 is set to <EM::<DOM::false>>.
3425 @@@TrueCase:
3426 @@@@enDesc:
3427 The <CODE::strict> flag in the algorithm in RFC 3986 section
3428 5.2.2 is set to <EM::<DOM::true>>.
3429 @@Return:
3430 @@@Type: URIReference
3431 @@@enDesc:
3432 The target DOM URI.
3433
3434 {NOTE::
3435 The result DOM URI might not be a conforming RFC 3986
3436 URI if the original DOM URI is not a conforming RFC 3986
3437 URI reference and / or the <P::base> DOM URI is not a
3438 conforming URI.
3439
3440 The result DOM URI might not be a conforming RFC 3987
3441 IRI if the original DOM URI is not a conforming RFC 3987
3442 IRI reference and / or the <P::base> DOM URI is not a
3443 conforming IRI.
3444 }
3445 @@@PerlDef:
3446 __DEEP{
3447 ## -- Decomposition
3448 my ($b_scheme, $b_auth, $b_path, $b_query, $b_frag);
3449 my ($r_scheme, $r_auth, $r_path, $r_query, $r_frag);
3450
3451 if ($$self =~ m!\A(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?\z!s) {
3452 ($r_scheme, $r_auth, $r_path, $r_query, $r_frag)
3453 = ($1, $2, $3, $4, $5);
3454 } else { # unlikely happen
3455 ($r_scheme, $r_auth, $r_path, $r_query, $r_frag)
3456 = (null, null, '', null, null);
3457 }
3458 my $ba = ref $base eq 'SCALAR'
3459 ? $base
3460 : ref $base eq <ClassName::ManakaiURIReference>
3461 ? $base
3462 : ref $base
3463 ? \"$base"
3464 : \$base;
3465 if ($$ba =~ m!\A(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?\z!s) {
3466 ($b_scheme, $b_auth, $b_path, $b_query, $b_frag)
3467 = (defined $1 ? $1 : '', $2, $3, $4, $5);
3468 } else { # unlikely happen
3469 ($b_scheme, $b_auth, $b_path, $b_query, $b_frag)
3470 = ('', null, '', null, null);
3471 }
3472
3473 ## -- Merge
3474 my $path_merge = sub ($$) {
3475 my ($bpath, $rpath) = @_;
3476 if ($bpath eq '') {
3477 return '/'.$rpath;
3478 }
3479 $bpath =~ s/[^\/]*\z//;
3480 return $bpath . $rpath;
3481 }; # merge
3482
3483 ## -- Removing Dot Segments
3484 my $remove_dot_segments = sub ($) {
3485 local $_ = shift;
3486 my $buf = '';
3487 L: while (length $_) {
3488 next L if s/^\.\.?\///;
3489 next L if s/^\/\.(?:\/|\z)/\//;
3490 if (s/^\/\.\.(\/|\z)/\//) {
3491 $buf =~ s/\/?[^\/]*$//;
3492 next L;
3493 }
3494 last Z if s/^\.\.?\z//;
3495 s/^(\/?[^\/]*)//;
3496 $buf .= $1;
3497 }
3498 return $buf;
3499 }; # remove_dot_segments
3500
3501 ## -- Transformation
3502 my ($t_scheme, $t_auth, $t_path, $t_query, $t_frag);
3503
3504 if ($nonStrict and $r_scheme eq $b_scheme) {
3505 undef $r_scheme;
3506 }
3507
3508 if (defined $r_scheme) {
3509 $t_scheme = $r_scheme;
3510 $t_auth = $r_auth;
3511 $t_path = $remove_dot_segments->($r_path);
3512 $t_query = $r_query;
3513 } else {
3514 if (defined $r_auth) {
3515 $t_auth = $r_auth;
3516 $t_path = $remove_dot_segments->($r_path);
3517 $t_query = $r_query;
3518 } else {
3519 if ($r_path =~ /\A\z/) {
3520 $t_path = $b_path;
3521 if (defined $r_query) {
3522 $t_query = $r_query;
3523 } else {
3524 $t_query = $b_query;
3525 }
3526 } elsif ($r_path =~ /^\//) {
3527 $t_path = $remove_dot_segments->($r_path);
3528 $t_query = $r_query;
3529 } else {
3530 $t_path = $path_merge->($b_path, $r_path);
3531 $t_path = $remove_dot_segments->($t_path);
3532 $t_query = $r_query;
3533 }
3534 $t_auth = $b_auth;
3535 }
3536 $t_scheme = $b_scheme;
3537 }
3538 $t_frag = $r_frag;
3539
3540 ## -- Recomposition
3541 my $result = '' ;
3542 $result .= $t_scheme . ':' if defined $t_scheme;
3543 $result .= '//' . $t_auth if defined $t_auth ;
3544 $result .= $t_path ;
3545 $result .= '?' . $t_query if defined $t_query ;
3546 $result .= '#' . $t_frag if defined $t_frag ;
3547
3548 $r = bless \$result, <ClassName::ManakaiURIReference>;
3549 }__;
3550
3551 @@Test:
3552 @@@QName: URIRef.getAbsRef.input.test
3553 @@@PerlDef:
3554 my $impl;
3555 __CODE{createURIImplForTest:: $impl => $impl}__;
3556
3557 my $ref = $impl-><M::URIImplementation.createURIReference> ('../foo');
3558
3559 $test->id ('string');
3560 my $t1 = $ref-><M::URIReference.getAbsoluteReference>
3561 (q<http://foo.example/bar/baz>);
3562 $test->assert_equals ($t1-><AG::URIReference.uriReference>,
3563 q<http://foo.example/foo>);
3564
3565 $test->id ('stringref');
3566 my $t2 = $ref-><M::URIReference.getAbsoluteReference>
3567 (\q<http://foo.example/bar/baz>);
3568 $test->assert_equals ($t2-><AG::URIReference.uriReference>,
3569 q<http://foo.example/foo>);
3570
3571 $test->id ('uriref');
3572 my $t3 = $ref-><M::URIReference.getAbsoluteReference>
3573 ($impl-><M::URIImplementation.createURIReference>
3574 (q<http://foo.example/bar/baz>));
3575 $test->assert_equals ($t3-><AG::URIReference.uriReference>,
3576 q<http://foo.example/foo>);
3577
3578 @@Test:
3579 @@@QName: URIRef.getAbsRef.test
3580 @@@PerlDef:
3581 my $impl;
3582 __CODE{createURIImplForTest:: $impl => $impl}__;
3583
3584 for (
3585 ## From RFC 3986
3586 ["g:h" => "g:h"],
3587 ["g" => "http://a/b/c/g"],
3588 ["./g" => "http://a/b/c/g"],
3589 ["g/" => "http://a/b/c/g/"],
3590 ["/g" => "http://a/g"],
3591 ["//g" => "http://g"],
3592 ["?y" => "http://a/b/c/d;p?y"],
3593 ["g?y" => "http://a/b/c/g?y"],
3594 ["#s" => "http://a/b/c/d;p?q#s"],
3595 ["g#s" => "http://a/b/c/g#s"],
3596 ["g?y#s" => "http://a/b/c/g?y#s"],
3597 [";x" => "http://a/b/c/;x"],
3598 ["g;x" => "http://a/b/c/g;x"],
3599 ["g;x?y#s" => "http://a/b/c/g;x?y#s"],
3600 ["" => "http://a/b/c/d;p?q"],
3601 ["." => "http://a/b/c/"],
3602 ["./" => "http://a/b/c/"],
3603 [".." => "http://a/b/"],
3604 ["../" => "http://a/b/"],
3605 ["../g" => "http://a/b/g"],
3606 ["../.." => "http://a/"],
3607 ["../../" => "http://a/"],
3608 ["../../g" => "http://a/g"],
3609 ["../../../g" => "http://a/g"],
3610 ["../../../../g" => "http://a/g"],
3611 ["/./g" => "http://a/g"],
3612 ["/../g" => "http://a/g"],
3613 ["g." => "http://a/b/c/g."],
3614 [".g" => "http://a/b/c/.g"],
3615 ["g.." => "http://a/b/c/g.."],
3616 ["..g" => "http://a/b/c/..g"],
3617 ["./../g" => "http://a/b/g"],
3618 ["./g/." => "http://a/b/c/g/"],
3619 ["g/./h" => "http://a/b/c/g/h"],
3620 ["g/../h" => "http://a/b/c/h"],
3621 ["g;x=1/./y" => "http://a/b/c/g;x=1/y"],
3622 ["g;x=1/../y" => "http://a/b/c/y"],
3623 ["g?y/./x" => "http://a/b/c/g?y/./x"],
3624 ["g?y/../x" => "http://a/b/c/g?y/../x"],
3625 ["g#s/./x" => "http://a/b/c/g#s/./x"],
3626 ["g#s/../x" => "http://a/b/c/g#s/../x"],
3627 ["http:g" => "http:g"],
3628 ## From "http://www.gbiv.com/protocols/uri/test/rel_examples1.html"
3629 ["http:" => "http:"],
3630 ## From "http://www.w3.org/2004/04/uri-rel-test.html"
3631 ["./g:h" => "http://a/b/c/g:h"],
3632 ) {
3633 my $ref = $impl-><M::URIImplementation.createURIReference> ($_->[0]);
3634
3635 $test->id ($_->[0]);
3636 my $t = $ref-><M::URIReference.getAbsoluteReference>
3637 (q<http://a/b/c/d;p?q>);
3638 $test->assert_equals ($t-><AG::URIReference.uriReference>,
3639 $_->[1]);
3640
3641 $test->id ($_->[0].'.3986');
3642 my $t1 = $ref-><M::URIReference.getAbsoluteReference3986>
3643 (q<http://a/b/c/d;p?q>);
3644 $test->assert_equals ($t1-><AG::URIReference.uriReference>,
3645 $_->[1]);
3646
3647 $test->id ($_->[0].'.3987');
3648 my $t2 = $ref-><M::URIReference.getAbsoluteReference3987>
3649 (q<http://a/b/c/d;p?q>);
3650 $test->assert_equals ($t2-><AG::URIReference.uriReference>,
3651 $_->[1]);
3652 }
3653
3654 @@Test:
3655 @@@QName: URIRef.getAbsRef.nonStrict.test
3656 @@@PerlDef:
3657 my $impl;
3658 __CODE{createURIImplForTest:: $impl => $impl}__;
3659
3660 ## From "http://www.gbiv.com/protocols/uri/test/rel_examples1.html"
3661
3662 $test->id (1);
3663 my $ref = $impl-><M::URIImplementation.createURIReference>
3664 (q<http:g>);
3665 my $t1 = $ref-><M::URIReference.getAbsoluteReference>
3666 (q<http://a/b/c/d;p?q>, non_strict => true);
3667 $test->assert_equals ($t1-><AG::URIReference.uriReference>,
3668 q<http://a/b/c/g>);
3669
3670 $test->id (2);
3671 my $ref2 = $impl-><M::URIImplementation.createURIReference>
3672 (q<http:>);
3673 my $t2 = $ref2-><M::URIReference.getAbsoluteReference>
3674 (q<http://a/b/c/d;p?q>, non_strict => true);
3675 $test->assert_equals ($t2-><AG::URIReference.uriReference>,
3676 q<http://a/b/c/d;p?q>);
3677
3678 @Method:
3679 @@Name: getAbsoluteReference3987
3680 @@DISPerl:methodName: get_absolute_reference_3987
3681 @@enDesc:
3682 Returns the target DOM URI for the DOM URI resolved as per RFC 3987.
3683 Since RFC 3987 references RFC 3986 for the resolution algorithm,
3684 the method <kwd:MUST> act as <M::URIReference.getAbsoluteReference3986>
3685 would do.
3686 @@Param:
3687 @@@Name: base
3688 @@@Type: URIReference
3689 @@@enDesc:
3690 The base DOM URI against which the DOM URI is resolved.
3691 @@@enDesc:
3692 @@@@ddid:perl
3693 @@@@@:
3694 For Perl binding, any value that can be specified
3695 as the parameter to the <M::URIImplementation.createURIReference>
3696 method can be set to the <P::base> parameter.
3697 @@NamedParam:
3698 @@@Name: nonStrict
3699 @@@Type: idl|boolean||ManakaiDOM|all
3700 @@@enDesc:
3701 Whether the resolution is done in the strict mode or not.
3702 @@Return:
3703 @@@Type: URIReference
3704 @@@enDesc:
3705 The target DOM URI.
3706
3707 {NOTE::
3708 The result DOM URI might not be a conforming RFC 3987
3709 IRI if the original DOM URI is not a conforming RFC 3987
3710 IRI reference and / or the <P::base> DOM URI is not a
3711 conforming IRI.
3712 }
3713 @@@PerlDef:
3714 __DEEP{
3715 $r = $self-><M::URIReference.getAbsoluteReference3986>
3716 ($base, non_strict => $nonStrict);
3717 }__;
3718
3719 @Method:
3720 @@Name: isSameDocumentReference
3721 @@enDesc:
3722 Whether the DOM URI is a same-document reference or not as per
3723 the latest version of the URI specification.
3724
3725 {NOTE::
3726 At the time of writing, RFC 3986 is the latest version
3727 of the URI specification and the method must return
3728 the same result as the <M::URIReference.isSameDocumentReference>
3729 would return.
3730 }
3731 @@Param:
3732 @@@Name: base
3733 @@@Type: URIReference
3734 @@@enDesc:
3735 The base DOM URI against which the sameness is tested.
3736 @@Return:
3737 @@@Type: idl|boolean||ManakaiDOM|all
3738 @@@TrueCase:
3739 @@@@enDesc:
3740 The DOM URI is a same-document reference.
3741 @@@FalseCase:
3742 @@@@enDesc:
3743 It is <EM::not> sure that the DOM URI is a same-document
3744 reference.
3745 @@@PerlDef:
3746 __DEEP{
3747 $r = $self-><M::URIReference.isSameDocumentReference3986> ($base);
3748 }__;
3749
3750 @Method:
3751 @@Name: isSameDocumentReference3986
3752 @@DISPerl:methodName: is_same_document_reference_3986
3753 @@enDesc:
3754 Whether the DOM URI is a same-document reference or not as per
3755 RFC 3986 section 4.4.
3756 @@Param:
3757 @@@Name: base
3758 @@@Type: URIReference
3759 @@@enDesc:
3760 The base DOM URI against which the sameness is tested.
3761 If it does not contain the scheme component, then the result
3762 is undefined.
3763 @@@enDesc:
3764 @@@@ddid:perl
3765 @@@@@:
3766 For Perl binding, any value that can be specified
3767 as the parameter to the <M::URIImplementation.createURIReference>
3768 method can be set to the <P::base> parameter.
3769 @@NamedParam:
3770 @@@Name: nonStrict
3771 @@@Type: idl|boolean||ManakaiDOM|all
3772 @@@enDesc:
3773 Whether the resolution is done in the strict mode or not.
3774 @@Return:
3775 @@@Type: idl|boolean||ManakaiDOM|all
3776 @@@TrueCase:
3777 @@@@enDesc:
3778 If the target DOM URI that the
3779 <M::URIReference.getAbsoluteReference3986>
3780 method with the same <P::base> parameter would return
3781 shares the same substring without fragment components and
3782 the <CHAR::NUMBER SIGN> preceding it if any with the <P::base>
3783 DOM URI.
3784 @@@FalseCase:
3785 @@@@enDesc: Otherwise.
3786 @@@PerlDef:
3787 __DEEP{
3788 if (substr ($$self, 0, 1) eq '#') {
3789 $r = true;
3790 } else {
3791 my $target = $self-><M::URIReference.getAbsoluteReference3986>
3792 ($base, non_strict => $nonStrict)
3793 -><AG::URIReference.uriReference>;
3794 $target =~ s/#.*\z//;
3795 my $ba = ref $base eq 'SCALAR'
3796 ? $$base
3797 : ref $base eq <ClassName::ManakaiURIReference>
3798 ? $$base
3799 : ref $base
3800 ? "$base"
3801 : $base;
3802 $ba =~ s/#.*\z//;
3803 $r = ($target eq $ba);
3804 }
3805 }__;
3806
3807 @@Test:
3808 @@@QName: URIRef.isSameDocRef.test
3809 @@@PerlDef:
3810 my $impl;
3811 __CODE{createURIImplForTest:: $impl => $impl}__;
3812
3813 my $base = q<http://www/a/b/c#def>;
3814
3815 for (
3816 [q<http://www.example/>, false],
3817 [q<#fragment>, true],
3818 [q<c#def>, true],
3819 [q<http://www/a/b/c#def>, true],
3820 [q</a/b/c/>, false],
3821 [q<>, true],
3822 [q<//www/a/b/c>, true],
3823 ) {
3824 my $ref = $impl-><M::URIImplementation.createURIReference> ($_->[0]);
3825 my $method = $_->[1] ? 'assert_true' : 'assert_false';
3826 $test->id ($_->[0]);
3827 $test->$method
3828 ($ref-><M::URIReference.isSameDocumentReference> ($base));
3829 $test->id ($_->[0].'.3986');
3830 $test->$method
3831 ($ref-><M::URIReference.isSameDocumentReference3986>
3832 ($base));
3833 }
3834
3835 @Method:
3836 @@Name: getRelativeReference
3837 @@enDesc:
3838 Returns a DOM URI that references the same target URI
3839 as the DOM URI according to the latest version of
3840 the URI specification. The method <kwd:SHOULD> return as simple
3841 DOM URI as possible.
3842
3843 {P:: How it computes the relative reference
3844 is implementation dependent. However, it at least meets the conditions
3845 below:
3846
3847 - If the DOM URI is a legal RFC 3986 URI reference, then
3848 the result DOM URI <kwd:MUST> be a legal RFC 3986 URI reference
3849 that references the target URI of the original URI.
3850
3851 - If the DOM URI is a legal RFC 3987 IRI, then
3852 the result DOM URI <kwd:MUST> be a legal RFC 3987 IRI reference
3853 that references either the a IRI
3854 that is literally equivalent to the target IRI of the original IRI
3855 when zero or more URI-to-IRI or IRI-to-URI convertion
3856 <SRC::RFC 3987> is performed.
3857 }
3858
3859 {ISSUE::
3860 Should <CODE::getRelativeReference3986> be introduced?
3861 Should <CODE::getRelativeIRIReference3987>
3862 and <CODE::getRelativeIRIReference> also be?
3863 }
3864 @@Param:
3865 @@@Name: base
3866 @@@Type: URIReference
3867 @@@enDesc:
3868 The base DOM URI when against which the result
3869 DOM URI is resolved then it must be the same DOM
3870 URI as the target DOM URI of the DOM URI.
3871 @@Return:
3872 @@@Type: URIReference
3873 @@@enDesc:
3874 The result DOM URI.
3875 @@@PerlDef:
3876 __DEEP{
3877 my @base;
3878 my $ba = ref $base eq 'SCALAR'
3879 ? $base
3880 : ref $base eq <ClassName::ManakaiURIReference>
3881 ? $base
3882 : ref $base
3883 ? \"$base"
3884 : \$base;
3885 if ($$ba =~ m!\A(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?\z!) {
3886 (@base) = (defined $1 ? $1 : '', $2, $3, $4, $5);
3887 } else { # unlikeley happen
3888 (@base) = ('', null, '', null, null);
3889 }
3890 my @t;
3891 my $t = $self-><M::URIReference.getAbsoluteReference> ($base);
3892 if ("$t" =~ m!\A(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?\z!) {
3893 (@t) = (defined $1 ? $1 : '', $2, $3, $4, $5);
3894 } else { # unlikeley happen
3895 (@t) = ('', null, '', null, null);
3896 }
3897
3898 my @ref;
3899 R: {
3900 ## Scheme
3901 if ($base[0] ne $t[0]) {
3902 (@ref) = @t;
3903 last R;
3904 }
3905
3906 ## Authority
3907 if (not defined $base[1] and not defined $t[1]) {
3908 (@ref) = @t;
3909 last R;
3910 } elsif (not defined $t[1]) {
3911 (@ref) = @t;
3912 last R;
3913 } elsif (not defined $base[1]) {
3914 (@ref) = @t;
3915 last R;
3916 } elsif ($base[1] ne $t[1]) {
3917 (@ref) = @t;
3918 last R;
3919 }
3920 ## NOTE: Avoid uncommon references.
3921
3922 if (defined $t[4] and # fragment
3923 $t[2] eq $base[2] and # path
3924 ((not defined $t[3] and not defined $base[3]) or # query
3925 (defined $t[3] and defined $base[3] and $t[3] eq $base[3]))) {
3926 (@ref) = (null, null, '', null, $t[4]);
3927 last R;
3928 }
3929
3930 ## Path
3931 my @tpath = split m!/!, $t[2], -1;
3932 my @bpath = split m!/!, $base[2], -1;
3933 if (@tpath < 1 or @bpath < 1) { ## No |/|
3934 (@ref) = @t;
3935 last R;
3936 }
3937 my $bpl;
3938
3939 ## Removes common segments
3940 while (@tpath and @bpath and $tpath[0] eq $bpath[0]) {
3941 shift @tpath;
3942 $bpl = shift @bpath;
3943 }
3944
3945 if (@tpath == 0) {
3946 if (@bpath == 0) { ## Avoid empty path for backward compatibility
3947 unshift @tpath, $bpl;
3948 } else {
3949 unshift @tpath, '..', $bpl;
3950 }
3951 } elsif (@bpath == 0) {
3952 unshift @tpath, $bpl;
3953 }
3954
3955 unshift @tpath, ('..') x (@bpath - 1) if @bpath > 1;
3956
3957 unshift @tpath, '.' if $tpath[0] eq '' or
3958 $tpath[0] =~ /:/;
3959
3960 (@ref) = (null, null, (join '/', @tpath), $t[3], $t[4]);
3961 } # R
3962
3963 ## -- Recomposition
3964 my $result = '' ;
3965 $result .= $ref[0] . ':' if defined $ref[0]; # scheme;
3966 $result .= '//' . $ref[1] if defined $ref[1]; # authority
3967 $result .= $ref[2] ; # path
3968 $result .= '?' . $ref[3] if defined $ref[3]; # query
3969 $result .= '#' . $ref[4] if defined $ref[4]; # fragment
3970
3971 $r = bless \$result, <ClassName::ManakaiURIReference>;
3972 }__;
3973
3974 @@Test:
3975 @@@QName: URIRef.getRelRef.input.test
3976 @@@PerlDef:
3977 my $impl;
3978 __CODE{createURIImplForTest:: $impl => $impl}__;
3979
3980 my $ref = $impl-><M::URIImplementation.createURIReference>
3981 (q<http://www.example/a>);
3982
3983 $test->id ('string');
3984 my $rel1 = $ref-><M::URIReference.getRelativeReference>
3985 (q<http://www.example/>);
3986 $test->assert_equals ($rel1-><AG::URIReference.uriReference>,
3987 'a');
3988
3989 $test->id ('stringref');
3990 my $rel2 = $ref-><M::URIReference.getRelativeReference>
3991 (\q<http://www.example/>);
3992 $test->assert_equals ($rel2-><AG::URIReference.uriReference>,
3993 'a');
3994
3995 $test->id ('string');
3996 my $rel3 = $ref-><M::URIReference.getRelativeReference>
3997 ($impl-><M::URIImplementation.createURIReference>
3998 (q<http://www.example/>));
3999 $test->assert_equals ($rel3-><AG::URIReference.uriReference>,
4000 'a');
4001
4002 @@Test:
4003 @@@QName: URIRef.getRelRef.test
4004 @@@PerlDef:
4005 my $impl;
4006 __CODE{createURIImplForTest:: $impl => $impl}__;
4007
4008 for (
4009 [q<http://www.example/>, q<http://www.example/>, q<./>],
4010 [q<http://www.example/>, q<http://www2.example/>, q<http://www.example/>],
4011 [q<http://a/b/c/e/f>, q<http://a/b/c/e>, q<e/f>],
4012 [q<http://a/b/c/e>, q<http://a/b/c/e>, q<e>],
4013 [q<http://a/b/c/e/>, q<http://a/b/c/e>, q<e/>],
4014 [q<http://a/b/c/d>, q<http://a/b/c/e>, q<d>],
4015 [q<http://a/b/c/d/>, q<http://a/b/c/e>, q<d/>],
4016 [q<http://a/b/c>, q<http://a/b/c/e>, q<../c>],
4017 [q<http://a/b/c/>, q<http://a/b/c/e>, q<./>],
4018 [q<http://a/b/>, q<http://a/b/c/e>, q<../>],
4019 [q<http://a/b>, q<http://a/b/c/e>, q<../../b>],
4020 [q<http://a/>, q<http://a/b/c/e>, q<../../>],
4021 [q<http://a>, q<http://a/b/c/e>, q<http://a>],
4022 [q<http://a/b/d/f>, q<http://a/b/c/e>, q<../d/f>],
4023 [q<about:blank>, q<http://a/>, q<about:blank>],
4024 [q<http://a/about:blank>, q<http://a/b>, q<./about:blank>],
4025 [q<http://a//>, q<http://a/>, q<.//>],
4026 [q<a>, q<http://a/b/>, q<a>],
4027 [q<http://a/b#a>, q<http://a/b#b>, q<#a>],
4028 [q<http://a/c#a>, q<http://a/b#a>, q<c#a>],
4029 [q<http://a/b/?c>, q<http://a/b/>, q<./?c>],
4030 ) {
4031 $test->id ($_->[0].'.'.$_->[1]);
4032 my $ref = $impl-><M::URIImplementation.createURIReference> ($_->[0]);
4033 my $rel = $ref-><M::URIReference.getRelativeReference> ($_->[1]);
4034 $test->assert_equals
4035 ($rel-><AG::URIReference.uriReference>,
4036 $_->[2]);
4037 }
4038
4039 @enImplNote:
4040 @@ddid: norm
4041 @@@:
4042 Normalization
4043
4044 [RFC 3986 6.2.2], [RFC 3987 5.3.2]
4045 - Use uppercase letters for any hexadecimal digit
4046 in percent-encodings [RFC 3986 2.1, 6.2.2.1, RFC 3987 5.3.2.1].
4047 - Use lowercase letters in |scheme| and |host|
4048 [RFC 3986 6.2.2.1, RFC 3987 5.3.2.1].
4049 - Decode any percent-encoded unreserved characters
4050 [RFC 3986 2.3, 6.2.2.2, RFC 3987 5.3.2.3].
4051 - dot-segment [RFC 3986 6.2.2.3, RFC 3987 5.3.2.4].
4052
4053 In addition to |normalize|, scheme-specific normalization.
4054 [RFC 3986 6.2.3, RFC 3987 5.3.3]
4055
4056 equivalence property URI
4057
4058 @enImplNote:
4059 @@ddid: equiv
4060 @@@:
4061 Equivalence
4062
4063 [RFC 3986 6, RFC 3987 5]
4064
4065 equivalence property URI
4066
4067 @IntMethod:
4068 @@Operator:
4069 @@@@: eq
4070 @@@ContentType: DISPerl|Perl
4071 @@enDesc:
4072 For Perl binding, the <Perl::eq> operator <kwd:MUST> be
4073 overloaded so that it returnjs equality as strings.
4074 @@Param:
4075 @@@Name: v
4076 @@@Type: idl|any||ManakaiDOM|all
4077 @@@enDesc:
4078 Another value to compare.
4079 @@Return:
4080 @@@Type: idl|boolean||ManakaiDOM|all
4081 @@@enDesc:
4082 The equality.
4083 @@@PerlDef:
4084 if (defined $v) {
4085 __DEEP{
4086 $r = $v eq $$self;
4087 }__;
4088 }
4089
4090 @@Test:
4091 @@@QName: URIRef.eq.test
4092 @@@PerlDef:
4093 my $impl;
4094 __CODE{createURIImplForTest:: $impl => $impl}__;
4095
4096 $test->id ('u=u');
4097 $test->assert_equals
4098 ($impl-><M::URIImplementation.createURIReference> (q<a>),
4099 $impl-><M::URIImplementation.createURIReference> (q<a>));
4100
4101 $test->id ('u!=u');
4102 $test->assert_not_equals
4103 ($impl-><M::URIImplementation.createURIReference> (q<a>),
4104 $impl-><M::URIImplementation.createURIReference> (q<b>));
4105
4106 $test->id ('u=s');
4107 $test->assert_equals
4108 ($impl-><M::URIImplementation.createURIReference> (q<a>),
4109 q<a>);
4110
4111 $test->id ('u!=s');
4112 $test->assert_not_equals
4113 ($impl-><M::URIImplementation.createURIReference> (q<a>),
4114 q<b>);
4115
4116 $test->id ('s=u');
4117 $test->assert_equals
4118 (q<a>,
4119 $impl-><M::URIImplementation.createURIReference> (q<a>));
4120
4121 $test->id ('s!=u');
4122 $test->assert_not_equals
4123 (q<b>,
4124 $impl-><M::URIImplementation.createURIReference> (q<a>));
4125
4126 $test->id ('u!=undef');
4127 $test->assert_not_equals
4128 ($impl-><M::URIImplementation.createURIReference> (q<a>),
4129 null);
4130
4131 $test->id ('undef!=u');
4132 $test->assert_not_equals
4133 (null,
4134 $impl-><M::URIImplementation.createURIReference> (q<a>));
4135
4136 @Method:
4137 @@Name: cloneURIReference
4138 @@Operator: DISPerl|CloneMethod
4139 @@enDesc:
4140 Creates a new independent <IF::URIReference> object with the same
4141 <A::URIReference.uriReference> value.
4142 @@enDesc:
4143 @@@ddid: p
4144 @@@@:
4145 For Perl binding, the <Perl::clone> method <kwd:MUST>
4146 act as the <M::URIReference.cloneURIReference> would do.
4147 @@Return:
4148 @@@Type: URIReference
4149 @@@enDesc:
4150 The newly created DOM URI object.
4151 @@@PerlDef:
4152 my $v = $$self;
4153 $r = bless \$v, <ClassName::ManakaiURIReference>;
4154
4155 @@Test:
4156 @@@QName: URIRef.clone.Test
4157 @@@PerlDef:
4158 my $impl;
4159 __CODE{createURIImplForTest:: $impl => $impl}__;
4160
4161 my $ref = $impl-><M::URIImplementation.createURIReference> (q<a>);
4162
4163 $test->id ('cloneURIRef');
4164 my $ref2 = $ref-><M::URIReference.cloneURIReference>;
4165 $test->assert_equals ($ref2-><AG::URIReference.uriReference>, q<a>);
4166
4167 $test->id ('cloneURIRef.diff');
4168 $ref2-><AS::URIReference.uriReference> (q<b>);
4169 $test->assert_equals ($ref-><AG::URIReference.uriReference>, q<a>);
4170
4171 $test->id ('clone');
4172 my $ref3 = $ref->clone;
4173 $test->assert_equals ($ref3-><AG::URIReference.uriReference>, q<a>);
4174
4175 $test->id ('clone.diff');
4176 $ref3-><AS::URIReference.uriReference> (q<b>);
4177 $test->assert_equals ($ref-><AG::URIReference.uriReference>, q<a>);
4178 ##URIReference
4179
4180 ResourceDef:
4181 @QName: String
4182 @AliasFor: str|DOMString
4183
4184 ElementTypeBinding:
4185 @Name: enDesc
4186 @ElementType:
4187 dis:Description
4188 @ShadowContent:
4189 @@lang:en
4190
4191 ElementTypeBinding:
4192 @Name: enImplNote
4193 @ElementType:
4194 dis:Description
4195 @ShadowContent:
4196 @@lang:en
4197
4198 ElementTypeBinding:
4199 @Name: nullCase
4200 @ElementType:
4201 dis:ResourceDef
4202 @ShadowContent:
4203 @@DISCore:resourceType: ManakaiDOM|InCase
4204 @@Value:
4205 @@@is-null:1
4206 @@@ContentType: DISCore|String
4207
4208 ElementTypeBinding:
4209 @Name: TrueCase
4210 @ElementType:
4211 dis:ResourceDef
4212 @ShadowContent:
4213 @@DISCore:resourceType: ManakaiDOM|InCase
4214 @@Value:
4215 @@@@: 1
4216 @@@ContentType: DISCore|Boolean
4217 @@Type: idl|boolean||ManakaiDOM|all
4218
4219 ElementTypeBinding:
4220 @Name: FalseCase
4221 @ElementType:
4222 dis:ResourceDef
4223 @ShadowContent:
4224 @@DISCore:resourceType: ManakaiDOM|InCase
4225 @@Value:
4226 @@@@: 0
4227 @@@ContentType: DISCore|Boolean
4228 @@Type: idl|boolean||ManakaiDOM|all
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24