/[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.3 - (hide annotations) (download)
Sun Mar 5 12:42:48 2006 UTC (18 years, 8 months ago) by wakaba
Branch: MAIN
Changes since 1.2: +61 -1 lines
++ manakai/lib/Message/DOM/ChangeLog	5 Mar 2006 12:42:29 -0000
	* XMLParser.dis (parse): Sets |Document.documentURI|
	and |Document.manakaiEntityBaseURI| attributes of the
	document created.
	(_ProcessingInstructionDTD): Sets the |manakaiBaseURI|
	property of the created node.
	(_SystemLiteral): Sets the |manakaiDeclarationBaseURI|
	of the created node.
	(ls-input-to-input-file.default): Sets the resolved
	system identifier to the |documentURI| attribute if available.
	Sets the |baseURI| attribute if available.

2006-03-05  Wakaba  <wakaba@suika.fam.cx>

++ manakai/lib/Message/URI/ChangeLog	5 Mar 2006 12:42:42 -0000
2006-03-05  Wakaba  <wakaba@suika.fam.cx>

	* Generic.dis (new): New method.

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24