/[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.10 - (hide annotations) (download)
Sat Dec 30 12:00:42 2006 UTC (17 years, 10 months ago) by wakaba
Branch: MAIN
Changes since 1.9: +1 -2 lines
++ manakai/lib/Message/Markup/ChangeLog	30 Dec 2006 11:55:48 -0000
	* Atom.dis, SuikaWiki.dis, H2H.dis, SuikaWikiConfig21.dis: |For|
	specifications are removed.

	* SuikaWikiConfig21.dis: |WithFor| and |DefaultFor|
	specifications are removed.
	(ForEmpty, ForLatest): Removed.

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

++ manakai/lib/Message/Util/ChangeLog	30 Dec 2006 11:57:42 -0000
	* PerlCode.dis, DIS.dis, ManakaiNode.dis,
	ManakaiNodeTest.dis: |For| specifications are removed.

	* common.dis: New module.

	* DIS.dis, PerlCode.dis, ManakaiNode.dis: |Util:| resource
	definitions are removed (and moved to |common.dis|).

	* DIS.dis (ForEmpty, ForLatest): Removed.

	* DIS.dis: |WithFor| and |DefaultFor| are removed.

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

++ manakai/lib/Message/Util/Error/ChangeLog	30 Dec 2006 11:59:28 -0000
2006-12-30  Wakaba  <wakaba@suika.fam.cx>

	* Core.dis, DOMException.dis: |WithFor|, |DefaultFor|,
	and |For| specificaitons are removed.

++ manakai/lib/Message/Util/Formatter/ChangeLog	30 Dec 2006 11:59:59 -0000
2006-12-30  Wakaba  <wakaba@suika.fam.cx>

	* Muf2003.dis: |WithFor|, |DefaultFor|, and |For|
	specifications are removed.

++ manakai/lib/Message/Util/DIS/ChangeLog	30 Dec 2006 11:58:54 -0000
	* Perl.dis, Value.dis, DNLite.dis,
	DPG.dis, Test.dis: |WithFor|, |For|, and |DefaultFor|
	specifications are removed.

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

++ manakai/lib/Message/DOM/ChangeLog	30 Dec 2006 11:53:43 -0000
        SimpleLS.dis, DOMMain.dis, XDP.dis: |For| specifications
	are removed.

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

	* CharacterData.dis, DOMCore.dis, DOMFeature.dis,
        GenericLS.dis, TreeCore.dis, DOMString.dis,
        XML.dis, Element.dis, Document.dis, TreeStore,dis,
        Traversal.dis, XDoctype.dis, XMLParser.dis, DOMLS.dis,
++ manakai/lib/Message/URI/ChangeLog	30 Dec 2006 11:54:30 -0000
	* Generic.dis: |For| specifications are removed.

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

++ manakai/lib/Message/Charset/ChangeLog	30 Dec 2006 11:54:10 -0000
	* Encode.dis: |For| specifications are removed.

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

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24