/[suikacvs]/messaging/manakai/lib/Message/URI/Generic.dis
Suika

Contents of /messaging/manakai/lib/Message/URI/Generic.dis

Parent Directory Parent Directory | Revision Log Revision Log

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

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

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

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