/[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.6 - (hide annotations) (download)
Sat Nov 4 17:25:09 2006 UTC (18 years ago) by wakaba
Branch: MAIN
Changes since 1.5: +2 -2 lines
++ manakai/lib/Message/Util/DIS/ChangeLog	4 Nov 2006 17:22:49 -0000
2006-11-05  Wakaba  <wakaba@suika.fam.cx>

	* DNLite.dis (DISImplementationDNLite): Inheritance
	was incorrect.

	* Test.dis (DTImplementation): Inheritance was incorrect.

++ manakai/lib/Message/DOM/ChangeLog	4 Nov 2006 17:21:44 -0000
2006-11-05  Wakaba  <wakaba@suika.fam.cx>

	* Element.dis (___get_node_ref): |eval|ed |require|
	statement was broken.

	* DOMFeature.dis (getImplementationList): Argument
	is not passed to the |getImplementation| method.

	* TreeStore.dis (DOMImplementationTreeStore): It
	did not |f:implements| the |TSFeature30| feature.

	* XMLParser.dis: Use |create_uri_reference|
	method instead of internal |_new| method
	to create a URI reference object.

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24