/[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.7 - (hide annotations) (download)
Sat Dec 2 12:46:25 2006 UTC (17 years, 11 months ago) by wakaba
Branch: MAIN
CVS Tags: manakai-200612
Changes since 1.6: +5 -3 lines
++ manakai/t/ChangeLog	2 Dec 2006 12:46:13 -0000
2006-12-02  Wakaba  <wakaba@suika.fam.cx>

	* Makefile (dom-DOMString.t): New test.

++ manakai/bin/ChangeLog	2 Dec 2006 12:35:25 -0000
2006-12-02  Wakaba  <wakaba@suika.fam.cx>

	* daf.pl: Call |get_dom_implementation|
	instead of obsolete |get_implementation|.

	* grep-dis.pl: |lib/manakai/*.pl| is added.

++ manakai/lib/Message/Util/ChangeLog	2 Dec 2006 12:45:49 -0000
2006-12-02  Wakaba  <wakaba@suika.fam.cx>

	* Makefile: |lib/Message/DOM/DOMString.pm| is added.

++ manakai/lib/Message/DOM/ChangeLog	2 Dec 2006 12:45:20 -0000
2006-12-02  Wakaba  <wakaba@suika.fam.cx>

	* DOMString.dis: New module.

	* DOMString.pm: New file.

	* DOMCore.dis (min): Moved from |DOMFeature.dis|.
	(ImplementationRegistryVariable): Moved from |DOMFeature.dis|.
	Now it references the |DOMImplementationRegistry| object.
	(DOMImplementationRegistryVariable): Moved from |DOMMain.dis|.
	(DOMImplementationRegistry): New interface and
	class, reformed from |ImplementationRegistry| in |DOMFeature.dis|
	and |DOMImplementationRegistry| in |DOMMain.dis|.  Note
	that the class no longer support |get_implementation|
	and |get_implementation_list| methods from
	the |ImplementationRegistry| interface.
	(DOMImplementationList): Class implemented; no
	longer inherits from |ImplementationList|.
	(DOMImplementationSource): Class implemented; no
	longer inherits from |ImplementationSource|.  Note that
	the class no longer support |get_implementation|
	and |get_implementation_list| methods from
	the |ImplementationSource| interface.
	(DOMStringList): Removed.

	* DOMFeature.dis (min, ManakaiDOM:DOMHTMLFeature,
	ManakaiDOM:DOMEventsFeature, ManakaiDOM:DOMXMLFeature,
	ManakaiDOM:DOMXMLFeatureXML11, most part of
	documentation for obsolete DOM Level 3 Minimum Implementation
	module, obsolete property name aliases,
	ImplemenationRegistryVar, ImplementationRegistry,
	DEBUG, MIString, ImplementationList, ImplementationSource,
	ManakaiDOM:implID): Removed.

	* DOMMain.dis (Redefine, RedefinedBy, Redefined): Removed.
	(DOMString): Removed.
	(DOMImplementationRegistryVar, DOMImplementationRegistry): Removed.

	* Makefile: |DOMString.pm| is added.

	* TreeCore.dis (is_default_namespace): |null| was
	returned where a false is expected (|null| is
	a false in Perl, but real |false| is appropriate here).

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24