/[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.2 - (hide annotations) (download)
Wed Mar 1 13:03:57 2006 UTC (18 years, 8 months ago) by wakaba
Branch: MAIN
Changes since 1.1: +281 -263 lines
++ manakai/lib/Message/URI/ChangeLog	1 Mar 2006 12:54:19 -0000
	* Generic.dis: Most of codes are rewritten using public domain example
	implementation <http://www.gbiv.com/protocols/uri/rev-2002/uri_test.pl>.

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

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24