/[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.11 - (show annotations) (download)
Sat Dec 30 13:25:34 2006 UTC (17 years, 10 months ago) by wakaba
Branch: MAIN
CVS Tags: manakai-release-0-4-0, HEAD
Changes since 1.10: +2 -4 lines
Error occurred while calculating annotation data. 
++ manakai/lib/Message/Util/DIS/ChangeLog	30 Dec 2006 13:23:58 -0000
	* Perl.dis (plCodeFragment): Support for |f:provides|
	is removed.

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

++ manakai/lib/Message/DOM/ChangeLog	30 Dec 2006 13:22:55 -0000
	* DOMFeature.dis (ForDef): Removed.
	(f:provides, f:through): Removed.
	(Version): Removed.
	(implementFeature): Removed.

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

++ manakai/lib/manakai/ChangeLog	30 Dec 2006 13:25:24 -0000
	* DISIDL.dis, Java.dis, ECMAScript.dis,
	Document.dis, DISPerl.dis, XML.dis (ForDef): Removed.

	* DISMarkup.dis (ForET): Removed.

	* |DefaultFor| properties are removed.

	* DISCore.dis (DefaultFor): Removed.

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