/[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.1 - (hide annotations) (download)
Wed Mar 1 08:42:34 2006 UTC (18 years, 8 months ago) by wakaba
Branch: MAIN
++ manakai/t/ChangeLog	1 Mar 2006 08:42:23 -0000
2006-03-01  Wakaba  <wakaba@suika.fam.cx>

	* Makefile (util-Generic.t): New test.

++ manakai/lib/manakai/ChangeLog	1 Mar 2006 08:42:05 -0000
2006-02-27  Wakaba  <wakaba@suika.fam.cx>

	* dis-catalog: New |Message::URI| namespace is added.

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24