/[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.9 - (hide annotations) (download)
Sat Dec 30 08:27:50 2006 UTC (17 years, 10 months ago) by wakaba
Branch: MAIN
Changes since 1.8: +6 -30 lines
++ manakai/bin/ChangeLog	30 Dec 2006 06:47:17 -0000
2006-12-30  Wakaba  <wakaba@suika.fam.cx>

	* idl2dis.pl: Removed.

++ manakai/lib/Message/Markup/ChangeLog	30 Dec 2006 08:26:03 -0000
	* Atom.dis, SuikaWiki.dis, H2H.dis: |WithFor|
	and |DefaultFor| properties are removed.

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

++ manakai/lib/Message/Util/ChangeLog	30 Dec 2006 08:26:59 -0000
	* PerlCode.dis: |WithFor| and |DefaultFor| are removed.

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

++ manakai/lib/Message/DOM/ChangeLog	30 Dec 2006 08:25:38 -0000
        GenericLS.dis, TreeCore.dis, DOMString.dis,
        XML.dis, Element.dis, Document.dis, TreeStore,dis,
        Traversal.dis, XDoctype.dis, XMLParser.dis, DOMLS.dis,
        SimpleLS.dis, DOMMain.dis, XDP.dis: |WithFor| specifications
	and |DefaultFor|s are removed.

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

	* CharacterData.dis, DOMCore.dis, DOMFeature.dis,
++ manakai/lib/Message/URI/ChangeLog	30 Dec 2006 08:26:32 -0000
	* Generic.dis: |WithFor| and |DefaultFor| are removed.

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

++ manakai/lib/Message/Charset/ChangeLog	30 Dec 2006 08:24:04 -0000
	* Encode.dis (Require): |WithFor| specifications are removed.
	(DefaultFor): Removed.

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

++ manakai/lib/manakai/ChangeLog	30 Dec 2006 07:46:56 -0000
2006-12-30  Wakaba  <wakaba@suika.fam.cx>

	* dis.pl: Removed.

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24