/[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.6 - (show annotations) (download)
Sat Nov 4 17:25:09 2006 UTC (18 years ago) by wakaba
Branch: MAIN
Changes since 1.5: +2 -2 lines 
++ manakai/lib/Message/Util/DIS/ChangeLog	4 Nov 2006 17:22:49 -0000
2006-11-05  Wakaba  <wakaba@suika.fam.cx>

	* DNLite.dis (DISImplementationDNLite): Inheritance
	was incorrect.

	* Test.dis (DTImplementation): Inheritance was incorrect.

++ manakai/lib/Message/DOM/ChangeLog	4 Nov 2006 17:21:44 -0000
2006-11-05  Wakaba  <wakaba@suika.fam.cx>

	* Element.dis (___get_node_ref): |eval|ed |require|
	statement was broken.

	* DOMFeature.dis (getImplementationList): Argument
	is not passed to the |getImplementation| method.

	* TreeStore.dis (DOMImplementationTreeStore): It
	did not |f:implements| the |TSFeature30| feature.

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