/[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 - (hide 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
++ 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 wakaba 1.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 wakaba 1.2 @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 wakaba 1.1 @DISCore:author: DISCore|Wakaba
23     @License: license|Perl+MPL
24     @Date:
25 wakaba 1.11 $Date: 2006/12/30 12:00:42 $
26 wakaba 1.1
27     @Require:
28     @@Module:
29     @@@QName: MDOM|DOMFeature
30     @@Module:
31 wakaba 1.5 @@@QName: MDOM|DOMCore
32 wakaba 1.1
33     Namespace:
34 wakaba 1.5 @c:
35     http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#
36 wakaba 1.1 @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 wakaba 1.5 @domperl:
41     http://suika.fam.cx/~wakaba/archive/2006/dom/perl/
42 wakaba 1.1 @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 wakaba 1.7 @str:
69     http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/DOMString/
70 wakaba 1.1 @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 wakaba 1.9 Message::URI::IF::
84 wakaba 1.1
85     ## -- Features
86    
87     FeatureDef:
88     @QName: URIFeature
89     @featureQName: fe|URI
90     @FeatureVerDef:
91     @@QName: URIFeature40
92     @@f:instanceOf: URIFeature
93 wakaba 1.11 @@f:version: 4.0
94 wakaba 1.1 @@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 wakaba 1.8
166 wakaba 1.1 @@Implement:
167 wakaba 1.9 @@@@: ||+||ManakaiDOM|ForIF
168 wakaba 1.1 @@@ContentType: DISCore|TFPQNames
169 wakaba 1.9 @@@ForCheck: ManakaiDOM|ForClass
170 wakaba 1.1
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 wakaba 1.9 @@ForCheck: ManakaiDOM|ForClass
188 wakaba 1.1 @@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 wakaba 1.5 @domperl:implementedByObjectsOf: c|DOMImplementation
264     @domperl:classImplementedByObjectsOf: c|ManakaiDOMImplementation
265 wakaba 1.1
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 wakaba 1.7 ->get_dom_implementation_list
278 wakaba 1.1 ({<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 wakaba 1.9 In Perl binding:
304 wakaba 1.1 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 wakaba 1.6 $impl = <Class::c|ManakaiDOMImplementation>->_new;
397 wakaba 1.1 ##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 wakaba 1.3
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 wakaba 1.1
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 wakaba 1.2 @IntMethod:
549     @@Operator: DISPerl|AsStringMethod
550     @@Return:
551     @@@Type: String
552     @@@PerlDef:
553     $r = $$self;
554    
555 wakaba 1.1 @@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 wakaba 1.2
642     = If <VAR::U> is empty, then there is no scheme component.
643 wakaba 1.1
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 wakaba 1.2 if ($$self =~ m!^([^/?#:]+):!) {
667 wakaba 1.1 $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 wakaba 1.2 the result is undefined. If the new value is empty,
677     then the result is undefined.
678 wakaba 1.1
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 wakaba 1.2 if (length $given and $given !~ m![/?#:]!) {
689     unless ($$self =~ s!^[^/?#:]+:!$given:!) {
690 wakaba 1.1 $$self = $given . ':' . $$self;
691     __DEEP{
692     $self-><M::ManakaiURIReference.onSchemeChanged>;
693     }__;
694     }
695     }
696     } else {
697 wakaba 1.2 $$self =~ s!^[^/?#:]+:!!;
698 wakaba 1.1 __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 wakaba 1.2 [q<:aa>, null, q<http::aa>, q<:aa>], # ilegal
723 wakaba 1.1 ) {
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 wakaba 1.2 $_->[3]);
744 wakaba 1.1 }
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 wakaba 1.2 = Removes the scheme component and the <CHAR::COLON>
760     following it, if any, from <VAR::U>.
761    
762 wakaba 1.1 = 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 wakaba 1.2 if ($$self =~ m!^(?:[^:/?#]+:)?(?://([^/?#]*))?!) {
808 wakaba 1.1 $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 wakaba 1.2 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 wakaba 1.1 __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 wakaba 1.2 [q<?aa:b>, null, q<//example?aa:b>, q<//?aa:b>, q<?aa:b>],
864 wakaba 1.1 [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 wakaba 1.2 } else {
1006     if (defined $given and $given !~ /[\/#?\@\[\]]/) {
1007     $self-><AS::URIReference.uriAuthority> ($given.'@');
1008     }
1009 wakaba 1.1 }
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 wakaba 1.2 [q<?aa:b>, null, q<//user@?aa:b>, q<//@?aa:b>, q<?aa:b>],
1029 wakaba 1.1 [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 wakaba 1.2 } elsif ($given !~ /[\/\@:#?]/) {
1173 wakaba 1.1 $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 wakaba 1.2 [q<?aa:b>, null, q<//example?aa:b>, q<//?aa:b>],
1191 wakaba 1.1 [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 wakaba 1.2 } else {
1321     if (defined $given and $given =~ /\A[0-9]*\z/) {
1322     $self-><AS::URIReference.uriAuthority> (':'.$given);
1323     }
1324 wakaba 1.1 }
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 wakaba 1.2 [q<?aa:b>, null, q<//:2?aa:b>, q<//:?aa:b>, q<?aa:b>],
1344 wakaba 1.1 [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 wakaba 1.2 = 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 wakaba 1.1
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 wakaba 1.2 if ($$self =~ m!\A(?:[^:/?#]+:)?(?://[^/?#]*)?([^?#]*)!) {
1428     $r = $1;
1429     }
1430 wakaba 1.1 @@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 wakaba 1.2 if ($given !~ /[?#]/ and
1449     $$self =~ m!^((?:[^:/?#]+:)?(?://[^/?#]*)?)[^?#]*((?:\?[^#]*)?(?:#.*)?)!s) {
1450     $$self = $1.$given.$2;
1451     __DEEP{
1452     $self-><M::ManakaiURIReference.onPathChanged>;
1453     }__;
1454     }
1455 wakaba 1.1
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 wakaba 1.2 q<http://example>],
1466     [q<//example/>, '/', q<//example/path>, q<//example>],
1467     [q<//example/path>, '/path', q<//example/path>, q<//example>],
1468 wakaba 1.1 [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 wakaba 1.2 ['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 wakaba 1.1 ) {
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 wakaba 1.2 if ($$self =~ m!^(?:[^:/?#]+:)?(?://[^/?#]*)?[^?#]*(?:\?([^#]*))?!s) {
1554     $r = $1;
1555     } else {
1556     $r = null;
1557     }
1558 wakaba 1.1 @@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 wakaba 1.2 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 wakaba 1.1 @@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 wakaba 1.2 if ($$self =~ m!^(?:[^:/?#]+:)?(?://[^/?#]*)?[^?#]*(?:\?[^#]*)?(?:#(.*))?!s) {
1682     $r = $1;
1683     } else {
1684     $r = null;
1685     }
1686 wakaba 1.1 @@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 wakaba 1.2 if ($$self =~ m!^((?:[^:/?#]+:)?(?://[^/?#]*)?[^?#]*(?:\?[^#]*)?)(?:#.*)?!s) {
1698     $$self = defined $given ? $1 . '#' . $given : $1;
1699     __DEEP{
1700     $self-><M::ManakaiURIReference.onFragmentChanged>;
1701     }__;
1702     }
1703 wakaba 1.1
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 wakaba 1.2 q<http://example#fragment>, q<http://example#>, q<http://example>],
1728 wakaba 1.1 ['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 wakaba 1.2 $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 wakaba 1.1 }__;
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 wakaba 1.2 my @p = split m!/!, $self-><AG::URIReference.uriPath>, -1;
1920 wakaba 1.1 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 wakaba 1.2 q<http://foo.example/a/e>);
1961 wakaba 1.1
1962     $test->id (5);
1963     $uri1-><M::URIReference.setURIPathSegment> (1, null);
1964     $test->assert_equals
1965     ($uri1-><AG::URIReference.uriReference>,
1966 wakaba 1.2 q<http://foo.example/e>);
1967 wakaba 1.1
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 wakaba 1.2 $in =~ /\A${h16}::(?>$h16:){4}\z/o or
2568 wakaba 1.1 $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 wakaba 1.2 require Encode;
2701     my $v = Encode::encode ('utf8', $$self);
2702 wakaba 1.1 $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 wakaba 1.2 [\xE0][\xA0-\xBF][\x80-\xBF] |
2736 wakaba 1.1 [\xE1-\xEC][\x80-\xBF][\x80-\xBF] |
2737 wakaba 1.2 [\xED][\x80-\x9F][\x80-\xBF] |
2738 wakaba 1.1 [\xEE\xEF][\x80-\xBF][\x80-\xBF] | # UTF8-3
2739 wakaba 1.2 [\xF0][\x90-\xBF][\x80-\xBF][\x80-\xBF] |
2740 wakaba 1.1 [\xF1-\xF3][\x80-\xBF][\x80-\xBF][\x80-\xBF] |
2741 wakaba 1.2 [\xF4][\x80-\x8F][\x80-\xBF][\x80-\xBF] | # UTF8-4
2742     [\x80-\xFF]
2743 wakaba 1.1 )}{
2744     my $c = $1;
2745 wakaba 1.2 if (length ($c) == 1) {
2746     $c =~ s/(.)/sprintf '%%%02X', ord $1/ge;
2747 wakaba 1.1 $c;
2748     } else {
2749 wakaba 1.2 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 wakaba 1.1 }
2757     }gex;
2758 wakaba 1.2 $v =~ s/([<>"{}|\\\^`\x00-\x20\x7F])/sprintf '%%%02X', ord $1/ge;
2759     $v = Encode::decode ('utf8', $v);
2760 wakaba 1.1 $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 wakaba 1.2 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 wakaba 1.1 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 wakaba 1.2 my $tm = $_->{$method} ? 'assert_true' : 'assert_false';
3335     $test->$tm ($uri1->$method);
3336 wakaba 1.1 }
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 wakaba 1.2 my ($b_scheme, $b_auth, $b_path, $b_query, $b_frag);
3446     my ($r_scheme, $r_auth, $r_path, $r_query, $r_frag);
3447 wakaba 1.1
3448 wakaba 1.2 if ($$self =~ m!\A(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?\z!s) {
3449     ($r_scheme, $r_auth, $r_path, $r_query, $r_frag)
3450     = ($1, $2, $3, $4, $5);
3451 wakaba 1.1 } else { # unlikely happen
3452 wakaba 1.2 ($r_scheme, $r_auth, $r_path, $r_query, $r_frag)
3453     = (null, null, '', null, null);
3454 wakaba 1.1 }
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 wakaba 1.2 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 wakaba 1.1 } else { # unlikely happen
3466 wakaba 1.2 ($b_scheme, $b_auth, $b_path, $b_query, $b_frag)
3467     = ('', null, '', null, null);
3468 wakaba 1.1 }
3469    
3470     ## -- Merge
3471 wakaba 1.2 my $path_merge = sub ($$) {
3472     my ($bpath, $rpath) = @_;
3473     if ($bpath eq '') {
3474     return '/'.$rpath;
3475 wakaba 1.1 }
3476 wakaba 1.2 $bpath =~ s/[^\/]*\z//;
3477     return $bpath . $rpath;
3478 wakaba 1.1 }; # merge
3479    
3480     ## -- Removing Dot Segments
3481     my $remove_dot_segments = sub ($) {
3482 wakaba 1.2 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 wakaba 1.1 }
3491 wakaba 1.2 last Z if s/^\.\.?\z//;
3492     s/^(\/?[^\/]*)//;
3493     $buf .= $1;
3494 wakaba 1.1 }
3495 wakaba 1.2 return $buf;
3496 wakaba 1.1 }; # remove_dot_segments
3497    
3498 wakaba 1.2 ## -- Transformation
3499     my ($t_scheme, $t_auth, $t_path, $t_query, $t_frag);
3500 wakaba 1.1
3501 wakaba 1.2 if ($nonStrict and $r_scheme eq $b_scheme) {
3502     undef $r_scheme;
3503 wakaba 1.1 }
3504    
3505 wakaba 1.2 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 wakaba 1.1 } else {
3516 wakaba 1.2 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 wakaba 1.1 }
3533 wakaba 1.2 $t_scheme = $b_scheme;
3534 wakaba 1.1 }
3535 wakaba 1.2 $t_frag = $r_frag;
3536 wakaba 1.1
3537     ## -- Recomposition
3538 wakaba 1.2 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 wakaba 1.1
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 wakaba 1.2 ## From RFC 3986
3583 wakaba 1.1 ["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 wakaba 1.2 ## 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 wakaba 1.1 ) {
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 wakaba 1.2 ## From "http://www.gbiv.com/protocols/uri/test/rel_examples1.html"
3658    
3659     $test->id (1);
3660 wakaba 1.1 my $ref = $impl-><M::URIImplementation.createURIReference>
3661 wakaba 1.2 (q<http:g>);
3662 wakaba 1.1 my $t1 = $ref-><M::URIReference.getAbsoluteReference>
3663 wakaba 1.2 (q<http://a/b/c/d;p?q>, non_strict => true);
3664 wakaba 1.1 $test->assert_equals ($t1-><AG::URIReference.uriReference>,
3665 wakaba 1.2 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 wakaba 1.1
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 wakaba 1.2 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 wakaba 1.1 (@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 wakaba 1.2 (@ref) = (null, null, '', null, $t[4]);
3924 wakaba 1.1 last R;
3925     }
3926    
3927     ## Path
3928 wakaba 1.2 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 wakaba 1.1 while (@tpath and @bpath and $tpath[0] eq $bpath[0]) {
3938 wakaba 1.2 shift @tpath;
3939     $bpl = shift @bpath;
3940 wakaba 1.1 }
3941 wakaba 1.2
3942     if (@tpath == 0) {
3943     if (@bpath == 0) { ## Avoid empty path for backward compatibility
3944     unshift @tpath, $bpl;
3945 wakaba 1.1 } else {
3946 wakaba 1.2 unshift @tpath, '..', $bpl;
3947 wakaba 1.1 }
3948 wakaba 1.2 } elsif (@bpath == 0) {
3949     unshift @tpath, $bpl;
3950 wakaba 1.1 }
3951 wakaba 1.2
3952     unshift @tpath, ('..') x (@bpath - 1) if @bpath > 1;
3953    
3954     unshift @tpath, '.' if $tpath[0] eq '' or
3955     $tpath[0] =~ /:/;
3956    
3957 wakaba 1.1 (@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 wakaba 1.2 [q<http://www.example/>, q<http://www.example/>, q<./>],
4007 wakaba 1.1 [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 wakaba 1.2 [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 wakaba 1.1 [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 wakaba 1.2 [q<http://a//>, q<http://a/>, q<.//>],
4023 wakaba 1.1 [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 wakaba 1.2 [q<http://a/b/?c>, q<http://a/b/>, q<./?c>],
4027 wakaba 1.1 ) {
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 wakaba 1.2
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 wakaba 1.1 ##URIReference
4176    
4177     ResourceDef:
4178     @QName: String
4179 wakaba 1.7 @AliasFor: str|DOMString
4180 wakaba 1.1
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