/[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.8 - (hide annotations) (download)
Sat Dec 30 04:42:55 2006 UTC (17 years, 10 months ago) by wakaba
Branch: MAIN
Changes since 1.7: +2 -7 lines
++ manakai/lib/Message/Markup/ChangeLog	30 Dec 2006 04:39:04 -0000
2006-12-30  Wakaba  <wakaba@suika.fam.cx>

	* Atom.dis, SuikaWiki.dis: References
	to the |ManakaiDOM:ManakaiDOM| mode are removed.

++ manakai/lib/Message/Util/ChangeLog	30 Dec 2006 04:39:32 -0000
	* DIS.dis, PerlCode.dis: References to the |ManakaiDOM:ManakaiDOM|
	mode are removed.

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

++ manakai/lib/Message/Util/DIS/ChangeLog	30 Dec 2006 04:42:43 -0000
	* DPG.dis, Perl.dis, Value.dis, Test.dis: References
	to |ManakaiDOM:ManakaiDOM| modes are removed.

	* Perl.dis (plCodeFragment): |local|ize
	the |DIS:plCodeFragment| cache to avoid
	ancestor nodes of the cached fragment
	are destroyed so that the cached nodes
	become invalid.

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

++ manakai/lib/Message/DOM/ChangeLog	30 Dec 2006 04:37:29 -0000
	* 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,
	SimpleLS.dis, DOMMain.dis: References
	to the |ManakaiDOM:ManakaiDOM|, |ManakaiDOM:ManakaiDOM1|,
	|ManakaiDOM:ManakaiDOM2|, and |ManakaiDOM:ManakaiDOM3|
	modes are removed.

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

++ manakai/lib/Message/URI/ChangeLog	30 Dec 2006 04:35:39 -0000
2006-12-30  Wakaba  <wakaba@suika.fam.cx>

	* Generic.dis (Require): Reference to the |ManakaiDOM:ManakaiDOM|
	mode is removed.

++ manakai/lib/Message/Charset/ChangeLog	30 Dec 2006 04:35:23 -0000
2006-12-30  Wakaba  <wakaba@suika.fam.cx>

	* Encode.dis (Require): Reference to the |ManakaiDOM:ManakaiDOM|
	mode is removed.

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24