Module: @QName: MURI|Generic @FullName: @@lang: en @@@: Manakai URI Generic Module @Namespace: http://suika.fam.cx/~wakaba/archive/2005/manakai/URI/Generic/ @enDesc: The provides a set of interfaces to extract components of URIs. @enDesc: @@ddid:src @@@: Portions of the Perl implementation contained in the module are derived from the example parser (April 7, 2004) available at that is placed in the Public Domain by Roy T. Fielding and Day Software, Inc. @DISCore:author: DISCore|Wakaba @License: license|Perl+MPL @Date: $Date: 2006/12/30 13:25:34 $ @Require: @@Module: @@@QName: MDOM|DOMFeature @@Module: @@@QName: MDOM|DOMCore Namespace: @c: http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core# @dis: http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis-- @DISlib: http://suika.fam.cx/~wakaba/archive/2004/dis/ @domperl: http://suika.fam.cx/~wakaba/archive/2006/dom/perl/ @dx: http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException# @f: http://suika.fam.cx/~wakaba/archive/2004/dom/feature# @fe: http://suika.fam.cx/www/2006/feature/ @idl: http://suika.fam.cx/~wakaba/archive/2004/dis/IDL# @kwd: http://suika.fam.cx/~wakaba/archive/2005/rfc2119/ @lang: http://suika.fam.cx/~wakaba/archive/2004/8/18/lang# @license: http://suika.fam.cx/~wakaba/archive/2004/8/18/license# @ManakaiDOM: http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom# @MDOM: http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#ManakaiDOM. @mn: http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/ManakaiNode# @MURI: http://suika.fam.cx/~wakaba/archive/2005/manakai/URI/ @rdf: http://www.w3.org/1999/02/22-rdf-syntax-ns# @rdfs: http://www.w3.org/2000/01/rdf-schema# @str: http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/DOMString/ @test: http://suika.fam.cx/~wakaba/archive/2004/dis/Test# ResourceDef: @QName: MURI| @rdf:type: dis|ModuleGroup @FullName: @@lang:en @@@: The manakai URI modules @DISPerl:packageName: Message::URI:: @DISPerl:interfacePackageName: Message::URI::IF:: ## -- Features FeatureDef: @QName: URIFeature @featureQName: fe|URI @FeatureVerDef: @@QName: URIFeature40 @@f:instanceOf: URIFeature @@f:version: 4.0 @@enDesc: The manakai DOM URI Module, version 4.0 ElementTypeBinding: @Name: FeatureDef @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: f|Feature ElementTypeBinding: @Name: FeatureVerDef @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: f|Feature ElementTypeBinding: @Name: featureQName @ElementType: f:name @ShadowContent: @@ContentType: DISCore|QName ElementTypeBinding: @Name: IFQName @ElementType: dis:QName @ShadowContent: @@ForCheck: ManakaiDOM|ForIF ElementTypeBinding: @Name: ClsQName @ElementType: dis:QName @ShadowContent: @@ForCheck: ManakaiDOM|ForClass ElementTypeBinding: @Name: IFISA @ElementType: dis:ISA @ShadowContent: @@ForCheck: ManakaiDOM|ForIF ElementTypeBinding: @Name: ClsISA @ElementType: dis:ISA @ShadowContent: @@ForCheck: ManakaiDOM|ForClass ElementTypeBinding: @Name: IFClsDef @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: @@@@: dis|MultipleResource @@@ForCheck: !ManakaiDOM|ForIF !ManakaiDOM|ForClass @@resourceFor: ManakaiDOM|ForIF @@resourceFor: @@@@: ManakaiDOM|ForClass @@rdf:type: @@@@: DISLang|Interface @@@ForCheck: ManakaiDOM|ForIF @@rdf:type: @@@@: DISLang|Class @@@ForCheck: ManakaiDOM|ForClass @@Implement: @@@@: ||+||ManakaiDOM|ForIF @@@ContentType: DISCore|TFPQNames @@@ForCheck: ManakaiDOM|ForClass @@f:implements: @@@@: URIFeature40 ElementTypeBinding: @Name: Method @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: DISLang|Method ElementTypeBinding: @Name: IntMethod @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: DISLang|Method @@ForCheck: ManakaiDOM|ForClass @@ManakaiDOM:isForInternal: 1 ElementTypeBinding: @Name: Param @ElementType: dis:ResourceDef @ShadowContent: @@DISCore:resourceType: DISLang|MethodParameter ElementTypeBinding: @Name: NamedParam @ElementType: dis:ResourceDef @ShadowContent: @@DISCore:resourceType: DISLang|MethodParameter @@DISPerl:isNamedParameter: 1 ElementTypeBinding: @Name: Return @ElementType: dis:ResourceDef @ShadowContent: @@DISCore:resourceType: DISLang|MethodReturn ElementTypeBinding: @Name: Attr @ElementType: dis:ResourceDef @ShadowContent: @@DISCore:resourceType: DISLang|Attribute ElementTypeBinding: @Name: Get @ElementType: dis:ResourceDef @ShadowContent: @@DISCore:resourceType: DISLang|AttributeGet ElementTypeBinding: @Name: Set @ElementType: dis:ResourceDef @ShadowContent: @@DISCore:resourceType: DISLang|AttributeSet ElementTypeBinding: @Name: InCase @ElementType: dis:ResourceDef @ShadowContent: @@DISCore:resourceType: ManakaiDOM|InCase ElementTypeBinding: @Name: PerlDef @ElementType: dis:Def @ShadowContent: @@ContentType: lang:Perl @@ForCheck: ManakaiDOM|ForClass ElementTypeBinding: @Name: Test @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: test|StandaloneTest @@ForCheck: ManakaiDOM|ForClass ## -- Implementation IFClsDef: @IFQName: URIImplementation @ClsQName: ManakaiURIImplementation @domperl:implementedByObjectsOf: c|DOMImplementation @domperl:classImplementedByObjectsOf: c|ManakaiDOMImplementation @enDesc: The interface provides factory methods to create objects. @Test: @@enDesc: The implementation registry should know this class when the module is loaded. @@PerlDef: I: { for my $impl (@{$Message::DOM::ImplementationRegistry ->get_dom_implementation_list ({ => '4.0'})}) { if ($impl->isa ()) { last I; } } $test->assert_never; } # I @Method: @@Name: createURIReference @@enDesc: Creates a object with a DOM URI. @@Param: @@@Name: uri @@@Type: String @@@enDesc: A DOM URI. @@@InCase: @@@@Type: String @@@@enDesc: A new object with its set to the parameter value. @@@InCase: @@@@Type: DISPerl|SCALAR||ManakaiDOM|all @@@@enDesc: In Perl binding: A new object with its set to the value referenced by the parameter value. Any modification to the object will change the value referenced by the parameter value. @@@InCase: @@@@Type: URIReference @@@@enDesc: The method return a new object that would be returned by the method of the parameter value. @@Return: @@@Type: URIReference @@@enDesc: The newly created object. @@@PerlDef: if (UNIVERSAL::isa ($uri, )) { __DEEP{ $r = $uri->; }__; } elsif (ref $uri eq 'SCALAR') { $r = bless $uri, ; } else { my $v = "$uri"; $r = bless \$v, ; } @@Test: @@@QName: URIImpl.createURIRef.1.test @@@PerlDef: my $impl; __CODE{createURIImplForTest:: $impl => $impl}__; my $value = 'http://example.com/'; $test->id ('interface'); my $uri1 = $impl-> ($value); $test->assert_isa ($uri1, ); $test->id ('uriReference'); $test->assert_equals ($uri1->, 'http://example.com/'); $test->id ('modification'); $uri1-> ('abcdefg'); $test->assert_equals ($value, 'http://example.com/'); @@Test: @@@QName: URIImpl.createURIRef.2.test @@@PerlDef: my $impl; __CODE{createURIImplForTest:: $impl => $impl}__; my $value = 'http://example.com/'; $test->id ('interface'); my $uri1 = $impl-> (\$value); $test->assert_isa ($uri1, ); $test->id ('uriReference'); $test->assert_equals ($uri1->, 'http://example.com/'); $test->id ('modification'); $uri1-> ('abcdefg'); $test->assert_equals ($value, 'http://example.com/#abcdefg'); @@Test: @@@QName: URIImpl.createURIRef.3.test @@@PerlDef: my $impl; __CODE{createURIImplForTest:: $impl => $impl}__; my $value = $impl-> ('http://example.com/'); $test->id ('interface'); my $uri1 = $impl-> ($value); $test->assert_isa ($uri1, ); $test->id ('uriReference'); $test->assert_equals ($uri1->, 'http://example.com/'); $test->id ('modification'); $uri1-> ('abcdefg'); $test->assert_equals ($value->, 'http://example.com/'); @CODE: @@QName: createURIImplForTest @@PerlDef: $impl = ->_new; ##URIImplementation ElementTypeBinding: @Name: CODE @ElementType: dis:ResourceDef @ShadowContent: @@DISCore:resourceType: DISPerl|BlockCode @@ForCheck: ManakaiDOM|ForClass IFClsDef: @IFQName: URIReference @ClsQName: ManakaiURIReference @enDesc: A object represents a DOM URI. A object also implement scheme-specific interfaces. {NOTE:: Modifications to the object, via the attribute for example, might or might not result in mutations of the interfaces implemented by the object, since dynamic rebinding of classes might not be supported in the programming language or the DOM binding in use. If a method or attribute that is inappropriate for the underlying DOM URI represented by the object is invoked, the result is undefined, unless the specification of the interface defines any error handling behavior. However, implementators are advised to make the method or attribute implementations torelant and harmless as far as possible. } @IntMethod: @@Name: new @@enDesc: Creates a new object. For internal use. @@Param: @@@Name: uri @@@Type: String @@@enDesc: The DOM URI. @@@InCase: @@@@Type: DISPerl|SCALAR||ManakaiDOM|all @@@InCase: @@@@Type: URIReference @@Return: @@@Type: URIReference @@@PerlDef: my $v; if (ref $uri) { if (UNIVERSAL::isa ($uri, )) { my $w = $$uri; $v = \$w; } elsif (ref $uri eq 'SCALAR') { $v = $uri; } else { $v = \$uri; } } else { $v = \$uri; } $r = bless $v, ; @@Test: @@@QName: URIRef.new.test @@@PerlDef: $test->id ('str'); my $u1 = (q); $test->assert_isa ($u1, ); $test->assert_equals ($u1->, q); $test->id ('strref'); my $u = q; my $u2 = (\$u); $test->assert_isa ($u2, ); $test->assert_equals ($u2->, q); $test->id ('uri'); my $u3 = ($u1); $test->assert_isa ($u3, ); $test->assert_equals ($u3->, q); $test->id ('uri.mod'); $u3-> ('ftp'); $test->assert_equals ($u1->, q); $test->assert_equals ($u3->, q); @Attr: @@Name: uriReference @@Operator: @@@: "" @@ContentType: DISPerl|Perl @@enDesc: A string representation of the DOM URI. @@Type: String @@Get: @@@PerlDef: $r = $$self; @@Set: @@@enDesc: Sets the DOM URI, with no lexical or semantical check and normalization performed. Implementations allow and set the specified value even if it is not a legal RFC 3986 URI reference or RFC 3987 IRI reference. @@@PerlDef: $$self = $given; __DEEP{ $self->; }__; @@Test: @@@QName: URIRef.uriRef.test @@@PerlDef: my $impl; __CODE{createURIImplForTest:: $impl => $impl}__; for ( [q], [q], [qq<\x{3001}\x{3002}>], [q<%23>], ) { my $uri1 = $impl-> ($_->[0]); $test->id ('get'); $test->assert_equals ($uri1->, $_->[0]); $test->id ('set.same'); $uri1-> ($_->[0]); $test->assert_equals ($uri1->, $_->[0]); $test->id ('set.diff'); $uri1-> (q); $test->assert_equals ($uri1->, q); } @IntMethod: @@Operator: DISPerl|AsStringMethod @@Return: @@@Type: String @@@PerlDef: $r = $$self; @@Test: @@@QName: URIRef.stringify.test @@@PerlDef: my $impl; __CODE{createURIImplForTest:: $impl => $impl}__; $test->id ('method'); $test->assert_equals ($impl-> (q) ->stringify, q); $test->id ('str'); $test->assert_equals ($impl-> (q).'', q); @IntMethod: @@Name: onSchemeChanged @@enDesc: This method is invoked when the scheme component of the DOM URI has been changed. Other component might also be changed. @@Return: @@@PerlDef: @@@enImplNote: {TODO:: Class reing. } @IntMethod: @@Name: onAuthorityChanged @@enDesc: This method is invoked when the authority component of the DOM URI has been changed. Other component might also be changed. @@Return: @@@PerlDef: @IntMethod: @@Name: onPathChanged @@enDesc: This method is invoked when the path component of the DOM URI has been changed. Other component might also be changed. @@Return: @@@PerlDef: @IntMethod: @@Name: onQueryChanged @@enDesc: This method is invoked when the query component of the DOM URI has been changed. Other component might also be changed. @@Return: @@@PerlDef: @IntMethod: @@Name: onFragmentChanged @@enDesc: This method is invoked when the fragment component of the DOM URI has been changed. Other component might also be changed. @@Return: @@@PerlDef: @Attr: @@Name: uriScheme @@enDesc: The scheme component of the DOM URI. @@Type: String @@Get: @@@enDesc: The scheme component of the DOM URI is returned. {P:: The can be obtained by the algorithm: = Copy the DOM URI to the variable . = If does not contain any , there is no scheme component. = Remove and any characters following it from . = If contains , , and / or , then there is no scheme component. = If is empty, then there is no scheme component. = Otherwise, is the scheme component. } {NOTE:: {P:: This algorithm is so designed that: - when it is performed on an RFC 3986 URI or RFC 3987 IRI, the substring matching to the production is returned as the scheme component. - when it is performed on an RFC 3986 relative reference or RFC 3987 relative IRI reference, it reports that there is no scheme component. } } @@@nullCase: @@@@enDesc: If there is no scheme component. @@@PerlDef: if ($$self =~ m!^([^/?#:]+):!) { $r = $1; } else { $r = null; } @@Set: @@@enDesc: Replaces the scheme component of the DOM URI by the new value. If the new value contains , , , and / or , then the result is undefined. If the new value is empty, then the result is undefined. If the original DOM URI has no scheme component, then the string obtained by concatenating the new scheme component value, , and the original DOM URI is set as the new DOM URI. @@@nullCase: If there is the scheme component, the scheme component and a following it are removed from the DOM URI. @@@PerlDef: if (defined $given) { if (length $given and $given !~ m![/?#:]!) { unless ($$self =~ s!^[^/?#:]+:!$given:!) { $$self = $given . ':' . $$self; __DEEP{ $self->; }__; } } } else { $$self =~ s!^[^/?#:]+:!!; __DEEP{ $self->; }__; } @@Test: @@@QName: URIRef.uriScheme.1.test @@@PerlDef: my $impl; __CODE{createURIImplForTest:: $impl => $impl}__; for ( [q, 'http', q, q], [q, 'hTTp', q, q], [q, null, q, q], [q, null, q, q], [q, null, q, q], [q, null, q, q], [q<%D9%82%D9%87%D9%88%D8%A9://coffee.example/>, '%D9%82%D9%87%D9%88%D8%A9', q, q], [q<%D9%82%D9%87%D9%88%D8%a9://coffee.example/>, '%D9%82%D9%87%D9%88%D8%a9', q, q], [q<:aa>, null, q, q<:aa>], # ilegal ) { $test->id ('get.'.$_->[0]); my $uri1 = $impl-> ($_->[0]); $test->assert_equals ($uri1->, $_->[1]); $test->id ('set.'.$_->[0]); my $uri2 = $impl-> ($uri1); $uri2-> ('http'); $test->assert_equals ($uri2->, $_->[2]); $test->id ('reset.'.$_->[0]); my $uri4 = $impl-> ($uri1); $uri4-> (null); $test->assert_equals ($uri4->, $_->[3]); } @Attr: @@Name: uriAuthority @@enDesc: The authority component of the DOM URI. @@Type: String @@Get: @@@enDesc: The authority component of the DOM URI is returned. {P:: The can be obtained by the algorithm: = Copy the DOM URI to the variable . = Removes the scheme component and the following it, if any, from . = If contains a , remove the character and any characters following it from . = If contains a , remove the character and any characters following it from . = If begins with two characters, remove them from . , has no authority component. = Remove any and any characters following it from . = Then, is the authority component. } {NOTE:: {P:: This algorithm is so designed that: - when it is performed on an RFC 3986 URI reference, the substring matching to the production , if any, is returned as the authority component. - when it is performed on an RFC 3987 IRI reference, the substring matching to the production , if any, is returned as the authority component. - when it is performed on an RFC 3986 relative reference or RFC 3987 relative IRI reference that does contains authority component as defined in RFC 3986 or RFC 3987, it reports that there is no authority component. } } @@@nullCase: @@@@enDesc: If there is no authority component. @@@PerlDef: if ($$self =~ m!^(?:[^:/?#]+:)?(?://([^/?#]*))?!) { $r = $1; } else { $r = null; } @@Set: @@@enDesc: Replaces the authority component of the DOM URI by the new value. If the new value contains , , and / or , then the result is undefined. If the is empty and does not begin with a , then result is undefined. If the original DOM URI has no authority component, then the string obtained by concatenating the scheme component with following character of the original DOM URI if any, two characters, the new authority component value, and the path, query, and fragment components of the original DOM URI, with their preceding delimiters, if any, is set as the new DOM URI. @@@nullCase: If there is the authority component, the authority component and two characters preceding it are removed from the DOM URI. @@@PerlDef: if (defined $given) { unless ($given =~ m![/?#]!) { unless ($$self =~ s!^((?:[^:/?#]+:)?)(?://[^/?#]*)?!$1//$given!) { $$self = '//' . $given; __DEEP{ $self->; }__; } } } else { if ($$self =~ s!^((?:[^:/?#]+:)?)(?://[^/?#]*)?!$1!) { __DEEP{ $self->; }__; } } @@Test: @@@QName: URIRef.uriAuth.1.test @@@PerlDef: my $impl; __CODE{createURIImplForTest:: $impl => $impl}__; for ( [q, 'example', q, q, q], [q, 'eXAmple', q, q, q], [q, 'example', q, q, q], [q, null, q, q, q], [q, null, q, q, q], [q, null, q, q, q], [q, '%D9%82%D9%87%D9%88%D8%A9', q, q, q], [q, '%D9%82%D9%87%D9%88%D8%a9', q, q, q], ['about:', null, q, q, q], ['http://a:b@c/', 'a:b@c', q, q, q], ) { $test->id ('get.'.$_->[0]); my $uri1 = $impl-> ($_->[0]); $test->assert_equals ($uri1->, $_->[1]); $test->id ('set.'.$_->[0]); my $uri2 = $impl-> ($uri1); $uri2-> ('example'); $test->assert_equals ($uri2->, $_->[2]); $test->id ('empty.'.$_->[0]); my $uri3 = $impl-> ($uri1); $uri3-> (''); $test->assert_equals ($uri3->, $_->[3]); $test->id ('reset.'.$_->[0]); my $uri4 = $impl-> ($uri1); $uri4-> (null); $test->assert_equals ($uri4->, $_->[4]); } @Attr: @@Name: uriUserinfo @@enDesc: The userinfo component of the DOM URI. @@Type: String @@Get: @@@enDesc: The userinfo component of the DOM URI is returned. {P:: The can be obtained by the algorithm: = Set value to the variable . = If is , then there is no userinfo component. = If contains a preceded by no , , or character, remove the character and any characters following it from . , there is no userinfo component. = Then, is the userinfo component. } {NOTE:: {P:: This algorithm is so designed that: - when it is performed on an RFC 3986 URI reference, the substring matching to the production , if any, is returned as the userinfo component. - when it is performed on an RFC 3987 IRI reference, the substring matching to the production , if any, is returned as the userinfo component. - when it is performed on an RFC 3986 relative reference or RFC 3987 relative IRI reference that does contains userinfo component as defined in RFC 3986 or RFC 3987, it reports that there is no userinfo component. } } @@@nullCase: @@@@enDesc: If there is no userinfo component. @@@PerlDef: __DEEP{ my $v = $self->; if (defined $v and $v =~ /^([^@\[\]]*)\@/) { $r = $1; } else { $r = null; } }__; @@Set: @@@enDesc: Replaces the userinfo component of the DOM URI by the new value. If the new value contains , , , , , and / or , then the result is undefined. If there is the authority component but no userinfo component, then the authority component is replaced by the concatenation of the new userinfo value, a , and the original authority component. If there is no authority component, then the string obtained by concatenating the scheme component with following character of the original DOM URI if any, two characters, the new userinfo component value, a character, and the path, query, and fragment components of the original DOM URI, with their preceding delimiters, if any, is set as the new DOM URI. If the is empty and does not begin with a , then result is undefined. @@@nullCase: If there is the userinfo component, the userinfo component and a characters following it are removed from the DOM URI. @@@PerlDef: __DEEP{ my $auth = $self->; if (defined $auth) { if (defined $given) { unless ($auth =~ s/^[^\@\[\]]*\@/$given\@/) { $auth = $given . '@' . $auth; } } else { $auth =~ s/^[^\@\[\]]*\@//; } $self-> ($auth); } else { if (defined $given and $given !~ /[\/#?\@\[\]]/) { $self-> ($given.'@'); } } }__; @@Test: @@@QName: URIRef.uriUserinfo.1.test @@@PerlDef: my $impl; __CODE{createURIImplForTest:: $impl => $impl}__; for ( [q, null, q, q, q], [q, 'User', q, q, q], [q, null, q, q, q], [q, 'u', q, q, q], [q, null, q, q, q], [q, null, q, q, q], [q, null, q, q, q], [q, '%D9%82%D9%87%D9%88%D8%A9', q, q, q], [q, '%D9%82%D9%87%D9%88%D8%a9', q, q, q], ['about:', null, q, q, q], ['http://a:b@c/', 'a:b', q, q, q], ['http://[c@d]/', null, q, q, q], ) { $test->id ('get.'.$_->[0]); my $uri1 = $impl-> ($_->[0]); $test->assert_equals ($uri1->, $_->[1]); $test->id ('set.'.$_->[0]); my $uri2 = $impl-> ($uri1); $uri2-> ('user'); $test->assert_equals ($uri2->, $_->[2]); $test->id ('empty.'.$_->[0]); my $uri3 = $impl-> ($uri1); $uri3-> (''); $test->assert_equals ($uri3->, $_->[3]); $test->id ('reset.'.$_->[0]); my $uri4 = $impl-> ($uri1); $uri4-> (null); $test->assert_equals ($uri4->, $_->[4]); } @Attr: @@Name: uriHost @@enDesc: The host component of the DOM URI. @@Type: String @@Get: @@@enDesc: The host component of the DOM URI is returned. {P:: The can be obtained by the algorithm: = Set value to the variable . = If is , then there is no host component. = If contains a , remove the character and any characters preceding it from . = If contains a followed by zero or more digits (i.e. to ), then remove the and any characters following it. = Then, is the userinfo component. } {NOTE:: {P:: This algorithm is so designed that: - when it is performed on an RFC 3986 URI reference, the substring matching to the production is returned as the host component. - when it is performed on an RFC 3987 IRI reference, the substring matching to the production is returned as the host component. - when it is performed on an RFC 3986 relative reference or RFC 3987 relative IRI reference that does contains host component as defined in RFC 3986 or RFC 3987, it reports that there is no host component. } } @@@nullCase: @@@@enDesc: If there is no host component. {NOTE:: If the attribute contains a non- value, then has never been . } @@@PerlDef: __DEEP{ my $v = $self->; if (defined $v) { $v =~ s/^[^@\[\]]*\@//; $v =~ s/:[0-9]*\z//; $r = $v; } else { $r = null; } }__; @@Set: @@@enDesc: Replaces the host component of the DOM URI by the new value. If the new value contains , , , , , and / or , then the result is undefined. If there is no authority component, then the string obtained by concatenating the scheme component with following character of the original DOM URI if any, two characters, the new host component, and the path, query, and fragment components of the original DOM URI, with their preceding delimiters, if any, is set as the new DOM URI. If the is empty and does not begin with a , then result is undefined. @@@PerlDef: __DEEP{ my $auth = $self->; if (defined $auth) { my $v = ''; if ($auth =~ /^([^\@\[\]]*\@)/) { $v .= $1; } $v .= $given; if ($auth =~ /(:[0-9]*)\z/) { $v .= $1; } $self-> ($v); } elsif ($given !~ /[\/\@:#?]/) { $self-> ($given); } }__; @@Test: @@@QName: URIRef.uriHost.1.test @@@PerlDef: my $impl; __CODE{createURIImplForTest:: $impl => $impl}__; for ( [q, 'example', q, q], [q, 'example', q, q], [q, 'example', q, q], [q, 'example', q, q], [q, null, q, q], [q, null, q, q], [q, null, q, q], [q, '%D9%82%D9%87%D9%88%D8%A9', q, q], [q, '%D9%82%D9%87%D9%88%D8%a9', q, q], ['about:', null, q, q], ['http://a:b@c:3/', 'c', q, q], ['http://a:b@[c@d:4]:3/', '[c@d:4]', q, q], ) { $test->id ('get.'.$_->[0]); my $uri1 = $impl-> ($_->[0]); $test->assert_equals ($uri1->, $_->[1]); $test->id ('set.'.$_->[0]); my $uri2 = $impl-> ($uri1); $uri2-> ('example'); $test->assert_equals ($uri2->, $_->[2]); $test->id ('empty.'.$_->[0]); my $uri3 = $impl-> ($uri1); $uri3-> (''); $test->assert_equals ($uri3->, $_->[3]); } @Attr: @@Name: uriPort @@enDesc: The port component of the DOM URI. @@Type: String @@Get: @@@enDesc: The port component of the DOM URI is returned. {P:: The can be obtained by the algorithm: = Set value to the variable . = If is , then there is no port component. = If contains a followed by zero or more digits ( to ), remove the character and any characters following it from . , there is no port component. = Then, is the port component. } {NOTE:: {P:: This algorithm is so designed that: - when it is performed on an RFC 3986 URI reference or RFC 3987 IRI reference, the substring matching to the production , if any, is returned as the port component. - when it is performed on an RFC 3986 relative reference or RFC 3987 relative IRI reference that does contains port component as defined in RFC 3986 or RFC 3987, it reports that there is no port component. } } @@@nullCase: @@@@enDesc: If there is no port component. @@@PerlDef: __DEEP{ my $v = $self->; if (defined $v and $v =~ /:([0-9]*)\z/) { $r = $1; } else { $r = null; } }__; @@Set: @@@enDesc: Replaces the port component of the DOM URI by the new value. If the new value contains characters other than digits ( to ), then the result is undefined. If there is the authority component but no port component, then the authority component is replaced by the concatenation of the original authority component, a , and the new port value. If there is no authority component, then the string obtained by concatenating the scheme component with following character of the original DOM URI if any, two characters, a character, the new port component value, and the path, query, and fragment components of the original DOM URI, with their preceding delimiters, if any, is set as the new DOM URI. If the is empty and does not begin with a , then result is undefined. @@@nullCase: If there is the port component, the port component and a characters preceding it are removed from the DOM URI. @@@PerlDef: __DEEP{ my $auth = $self->; if (defined $auth) { if (defined $given) { unless ($auth =~ s/:[0-9]*\z/:$given/) { $auth = $auth . ':' . $given; } } else { $auth =~ s/:[0-9]*\z//; } $self-> ($auth); } else { if (defined $given and $given =~ /\A[0-9]*\z/) { $self-> (':'.$given); } } }__; @@Test: @@@QName: URIRef.uriPort.1.test @@@PerlDef: my $impl; __CODE{createURIImplForTest:: $impl => $impl}__; for ( [q, null, q, q, q], [q, '3', q, q, q], [q, null, q, q, q], [q, '3', q, q, q], [q, null, q, q, q], [q, null, q, q, q], [q, null, q, q, q], ['about:', null, q, q, q], ['http://a:b@c:3/', '3', q, q, q], ['http://[c@d:3]/', null, q, q, q], ) { $test->id ('get.'.$_->[0]); my $uri1 = $impl-> ($_->[0]); $test->assert_equals ($uri1->, $_->[1]); $test->id ('set.'.$_->[0]); my $uri2 = $impl-> ($uri1); $uri2-> ('2'); $test->assert_equals ($uri2->, $_->[2]); $test->id ('empty.'.$_->[0]); my $uri3 = $impl-> ($uri1); $uri3-> (''); $test->assert_equals ($uri3->, $_->[3]); $test->id ('reset.'.$_->[0]); my $uri4 = $impl-> ($uri1); $uri4-> (null); $test->assert_equals ($uri4->, $_->[4]); } @Attr: @@Name: uriPath @@enDesc: The path component of the DOM URI. @@Type: String @@Get: @@@enDesc: The path component of the DOM URI is returned. {P:: The can be obtained by the algorithm: = Copy the DOM URI to the variable . = If contains a , remove the character and any characters following it. = If contains a , remove the character and any characters following it. = If contains the scheme component and the character fllowing it, remove them from . = If contains the authority component and the characters preceding it, remove them from . = Then, is the path component. } {NOTE:: {P:: This algorithm is so designed that: - when it is performed on an RFC 3986 URI reference, the substring matching to the production is returned as the path component. - when it is performed on an RFC 3987 IRI reference, the substring matching to the production is returned as the path component. } } @@@PerlDef: if ($$self =~ m!\A(?:[^:/?#]+:)?(?://[^/?#]*)?([^?#]*)!) { $r = $1; } @@Set: @@@enDesc: Replaces the path component of the DOM URI by the new value. If the DOM URI contain the authority component and the new path value's first character, if any, is from , the result is undefined. If the DOM URI does contains scheme and authority components and the new path value contains that is not preceded by or the first two characters are both , the result is undefined. If the new value contains or , the result is undefined. @@@PerlDef: if ($given !~ /[?#]/ and $$self =~ m!^((?:[^:/?#]+:)?(?://[^/?#]*)?)[^?#]*((?:\?[^#]*)?(?:#.*)?)!s) { $$self = $1.$given.$2; __DEEP{ $self->; }__; } @@Test: @@@QName: URIRef.uriPath.1.test @@@PerlDef: my $impl; __CODE{createURIImplForTest:: $impl => $impl}__; for ( [q, '/', q, q], [q, '/path', q, q], [q, '/', q, q], [q, '/path', q, q], [q, '/path', q, q], [q, '', q, q], [q, '/aaaa', q, q<#bb:cc>], [q, '/%D9%82%D9%87%D9%88%D8%A9/', q, q], [q, '/%D9%82%D9%87%D9%88%D8%a9/', q, q], ['about:', '', q, q], ['http://a:b@c:3/', '/', q, q], ['http://a:b@[c@d:4]:3/', '/', q, q], ) { $test->id ('get.'.$_->[0]); my $uri1 = $impl-> ($_->[0]); $test->assert_equals ($uri1->, $_->[1]); $test->id ('set.'.$_->[0]); my $uri2 = $impl-> ($uri1); $uri2-> ('/path'); $test->assert_equals ($uri2->, $_->[2]); $test->id ('set.'.$_->[0]); my $uri3 = $impl-> ($uri1); $uri3-> (''); $test->assert_equals ($uri3->, $_->[3]); } @Attr: @@Name: uriQuery @@enDesc: The query component of the DOM URI. @@Type: String @@Get: @@@enDesc: The query component of the DOM URI is returned. {P:: The can be obtained by the algorithm: = Copy the DOM URI to the variable . = If contains a , remove it and any characters following it from . = If contains a , remove it and any character preceding it from . , there is no query component. = Then, is the query component. } {NOTE:: {P:: This algorithm is so designed that: - when it is performed on an RFC 3986 URI reference, the substring matching to the production , if any, is returned as the query component. - when it is performed on an RFC 3987 IRI reference, the substring matching to the production , if any, is returned as the query component. - when it is performed on an RFC 3986 relative reference or RFC 3987 relative IRI reference that does contains query component as defined in RFC 3986 or RFC 3987, it reports that there is no query component. } } @@@nullCase: @@@@enDesc: If there is no query component. @@@PerlDef: if ($$self =~ m!^(?:[^:/?#]+:)?(?://[^/?#]*)?[^?#]*(?:\?([^#]*))?!s) { $r = $1; } else { $r = null; } @@Set: @@@enDesc: Replaces the query component of the DOM URI by the new value. If the new value contains a , then the result is undefined. If there is no query component, a followed by the new value is inserted before the first , if any, or at the end of the DOM URI. @@@nullCase: If there is the query component, the query component and a character preceding it are removed from the DOM URI. @@@PerlDef: if ((not defined $given or $given !~ /#/) and $$self =~ m!^((?:[^:/?#]+:)?(?://[^/?#]*)?[^?#]*)(?:\?[^#]*)?((?:#.*)?)!s) { $$self = defined $given ? $1.'?'.$given.$2 : $1.$2; __DEEP{ $self->; }__; } @@Test: @@@QName: URIRef.uriQuery.1.test @@@PerlDef: my $impl; __CODE{createURIImplForTest:: $impl => $impl}__; for ( [q, null, q, q, q], [q, null, q, q, q], [q, null, q, q, q], [q, 'aa:b', q, q, q<>], [q, null, q, q, q], [q, 'query', q, q, q], [q, '%D9%82%D9%87%D9%88%D8%A9/', q, q, q], [q, '%D9%82%D9%87%D9%88%D8%a9/', q, q, q], ['about:', null, q, q, q], ['about:a?b', 'b', q, q, q], ['about:#a?b', null, q, q, q], ) { $test->id ('get.'.$_->[0]); my $uri1 = $impl-> ($_->[0]); $test->assert_equals ($uri1->, $_->[1]); $test->id ('set.'.$_->[0]); my $uri2 = $impl-> ($uri1); $uri2-> ('query'); $test->assert_equals ($uri2->, $_->[2]); $test->id ('set.empty.'.$_->[0]); my $uri3 = $impl-> ($uri1); $uri3-> (''); $test->assert_equals ($uri3->, $_->[3]); $test->id ('reset.'.$_->[0]); my $uri4 = $impl-> ($uri1); $uri4-> (null); $test->assert_equals ($uri4->, $_->[4]); } @Attr: @@Name: uriFragment @@enDesc: The fragment component of the DOM URI. @@Type: String @@Get: @@@enDesc: The fragment component of the DOM URI is returned. {P:: The can be obtained by the algorithm: = Copy the DOM URI to the variable . = If contains a , remove it and any characters preceding it from . , there is no fragment component. = Then, contains the fragment component. } {NOTE:: {P:: This algorithm is so designed that: - when it is performed on an RFC 3986 URI reference, the substring matching to the production , if any, is returned as the fragment component. - when it is performed on an RFC 3987 IRI reference, the substring matching to the production , if any, is returned as the fragment component. - when it is performed on an RFC 3986 relative reference or RFC 3987 relative IRI reference that does contains fragment component as defined in RFC 3986 or RFC 3987, it reports that there is no fragment component. } } @@@nullCase: @@@@enDesc: If there is no fragment component. @@@PerlDef: if ($$self =~ m!^(?:[^:/?#]+:)?(?://[^/?#]*)?[^?#]*(?:\?[^#]*)?(?:#(.*))?!s) { $r = $1; } else { $r = null; } @@Set: @@@enDesc: Replaces the fragment component of the DOM URI by the new value. If there is no fragment component, a followed by the new value is appended to the DOM URI. @@@nullCase: If there is the fragment component, the fragment component and a character preceding it are removed from the DOM URI. @@@PerlDef: if ($$self =~ m!^((?:[^:/?#]+:)?(?://[^/?#]*)?[^?#]*(?:\?[^#]*)?)(?:#.*)?!s) { $$self = defined $given ? $1 . '#' . $given : $1; __DEEP{ $self->; }__; } @@Test: @@@QName: URIRef.uriFragment.1.test @@@PerlDef: my $impl; __CODE{createURIImplForTest:: $impl => $impl}__; for ( [q, null, q, q, q], [q, null, q, q, q], [q, null, q, q, q], [q, null, q, q, q], [q, 'bb:cc', q, q, q], [q, 'bb:cc', q, q, q], [q, 'bb?cc', q, q, q], [q, '%D9%82%D9%87%D9%88%D8%A9/', q, q, q], [q, '%D9%82%D9%87%D9%88%D8%a9/', q, q, q], ['about:', null, q, q, q], ['about:a?b', null, q, q, q], ['about:#a?b', 'a?b', q, q, q], ) { $test->id ('get.'.$_->[0]); my $uri1 = $impl-> ($_->[0]); $test->assert_equals ($uri1->, $_->[1]); $test->id ('set.'.$_->[0]); my $uri2 = $impl-> ($uri1); $uri2-> ('fragment'); $test->assert_equals ($uri2->, $_->[2]); $test->id ('set.empty.'.$_->[0]); my $uri3 = $impl-> ($uri1); $uri3-> (''); $test->assert_equals ($uri3->, $_->[3]); $test->id ('reset.'.$_->[0]); my $uri4 = $impl-> ($uri1); $uri4-> (null); $test->assert_equals ($uri4->, $_->[4]); } @Method: @@Name: getURIPathSegment @@enDesc: Returns a path segment in the DOM URI. @@Param: @@@Name: index @@@Type: idl|unsignedLong||ManakaiDOM|all @@@enDesc: The ordinal index of the path segment, starting from zero. @@@enDesc: @@@@ddid: a @@@@@: For Perl binding, if the is negative, then the method act as if - > (where is the number of the path segments in the DOM URI) is set to the parameter, except when - > is negative, in that case the result is undefined. If the is greater than or equal to , the method act as if - 1> is set to the parameter. For example, if is set to , then the method replaces the last path segment in the DOM URI. @@Return: @@@Type: String @@@enDesc: The th path segment in the DOM URI. {P:: The th can be retrived by: = Copy value to the variable . = Insert a at the begining of . Insert a at the end of . = Remove + 1)>th and any character before it from . If there is no such , there is no th path segment. = Remove and any character following it from , if any. = Then, the variable contains the th path segment. } @@@nullCase: @@@@enDesc: If there is no th path segment. @@@PerlDef: __DEEP{ $r = [split m!/!, $self->, -1]->[$index]; $r = '' if not defined $r and ($index == 0 or $index == -1); # If path is empty }__; @@Test: @@@QName: URIRef.getURIPathSegment.test @@@PerlDef: my $impl; __CODE{createURIImplForTest:: $impl => $impl}__; for ( [q, ['', '1', '3', '4']], [q, ['', '1', '2', '']], [q, ['', '']], [q, ['']], [q, ['foo@example']], [q, ['']], [q, ['text', 'plain,abcdefg', 'ef']], [q<./a/c/..d/e/..>, ['.', 'a', 'c', '..d', 'e', '..']], [q, ['a']], [q, ['', 'a', 'b', '']], [q, ['', 'b', 'c']], [q, ['']], ) { my $uri1 = $impl-> ($_->[0]); for my $i (0..@{$_->[1]}) { # 0..n-1+1 $test->id ($_->[0].'.'.$i); $test->assert_equals ($uri1-> ($i), $_->[1]->[$i]); } for my $i (1..@{$_->[1]}) { $test->id ($_->[0].'.-'.$i); $test->assert_equals ($uri1-> (-$i), $_->[1]->[-$i]); } } @Method: @@Name: setURIPathSegment @@enDesc: Replaces or removes a path segment in the DOM URI. If there is the th path segment and the is not , then replace the th path segment by . If there is the th path segment and the is , then the th path segment and a character following it, if any, are removed. If there is no th path segment, then the result is undefined, except when is equal to the number of the segments, in that case a and the is appended to the path component. {ISSUE:: ? No effect? } If the method would make the only path segment removed, then it make the path component an empty string. If there is the authority component and the method would make the first path segment non-empty string, if there is no scheme component, there is no authority component, and the method would make the first path segment containing a character, or if there is no authority component and the method would make the first and the second path segments empty strings, then the result is undefined. @@Param: @@@Name: index @@@Type: idl|unsignedLong||ManakaiDOM|all @@@enDesc: The ordinal index of the path segment to replace. @@@enDesc: @@@@ddid: a @@@@@: For Perl binding, if the is negative, then the method act as if - > (where is the number of the path segments in the DOM URI) is set to the parameter, except when - > is negative, in that case the result is undefined. If the is greater than , the method extend the list by inserting zero-length segments so that the result path component has + 1> segments. For example, if is set to , then the method replaces the last path segment in the DOM URI. @@Param: @@@Name: newValue @@@Type: String @@@enDesc: The new path segment. @@@nullCase: @@@@enDesc: Removes the th path segment. @@Return: @@@PerlDef: __DEEP{ my @p = split m!/!, $self->, -1; if (defined $newValue) { $p[$index] = $newValue; } else { splice @p, $index, 1; } no warnings 'uninitialized'; $self-> (join '/', @p); }__; @@Test: @@@QName: URIRef.setURIPathSegment.test @@@PerlDef: my $impl; __CODE{createURIImplForTest:: $impl => $impl}__; my $uri1 = $impl-> (q); $test->id (1); $uri1-> (3, 'd'); $test->assert_equals ($uri1->, q); $test->id (2); $uri1-> (2, 'e'); $test->assert_equals ($uri1->, q); $test->id (3); $uri1-> (3, ''); $test->assert_equals ($uri1->, q); $test->id (4); $uri1-> (3, null); $test->assert_equals ($uri1->, q); $test->id (5); $uri1-> (1, null); $test->assert_equals ($uri1->, q); $test->id (6); $uri1-> (-1, 'd'); $test->assert_equals ($uri1->, q); $test->id (7); $uri1-> (-1, null); $test->assert_equals ($uri1->, q); $test->id (8); $uri1-> (0, null); $test->assert_equals ($uri1->, q); $test->id (9); $uri1-> (1, 'd'); $test->assert_equals ($uri1->, q); $test->id (10); $uri1-> (3, 'd'); $test->assert_equals ($uri1->, q); @Attr: @@Name: isURI @@enDesc: Whether the DOM URI is a URI or not according to the latest version of the URI specification. {NOTE:: At the time of writing, RFC 3986 is the latest version and the attribute must contain the value same as attribute of the same object. } @@Type: idl|boolean||ManakaiDOM|all @@Get: @@@TrueCase: @@@@enDesc: If it is a legal URI. @@@FalseCase: @@@@enDesc: If it is not a legal URI. @@@PerlDef: __DEEP{ $r = $self->; }__; @Attr: @@Name: isURI3986 @@DISPerl:methodName: is_uri_3986 @@enDesc: Whether the DOM URI is an RFC 3986 URI or not. {NOTE:: Whether the URI is valid according to the scheme-specific syntax is not checked. } @@Type: idl|boolean||ManakaiDOM|all @@Get: @@@TrueCase: @@@@enDesc: If the DOM URI matches to the production rule . @@@FalseCase: @@@@enDesc: Otherwise. @@@PerlDef: my $v = $$self; V: { ## -- Scheme unless ($v =~ s/^[A-Za-z][A-Za-z0-9+.-]*://s) { last V; } ## -- Fragment if ($v =~ s/#(.*)\z//s) { my $w = $1; unless ($w =~ m{\A(?>[A-Za-z0-9._~!\$&'()*+,;=:\@/?-]|%[0-9A-Fa-f][0-9A-Fa-f])*\z}) { last V; } } ## -- Query if ($v =~ s/\?(.*)\z//s) { my $w = $1; unless ($w =~ m{\A(?>[A-Za-z0-9._~!\$&'()*+,;=:\@/?-]|%[0-9A-Fa-f][0-9A-Fa-f])*\z}) { last V; } } ## -- Authority if ($v =~ s!^//([^/]*)!!s) { my $w = $1; $w =~ s/^(?>[A-Za-z0-9._~!\$&'()*+,;=:-]|%[0-9A-Fa-f][0-9A-Fa-f])*\@//os; $w =~ s/:[0-9]*\z//; if ($w =~ /^\[(.*)\]\z/s) { my $x = $1; unless ($x =~ /\A[vV][0-9A-Fa-f]+\.[A-Za-z0-9._~!\$&'()*+,;=:-]+\z/) { ## IPv6address my $isv6; __CODE{isIPv6address:: $in => $x, $out => $isv6}__; last V unless $isv6; } } else { unless ($w =~ /\A(?>[A-Za-z0-9._~!\$&'()*+,;=-]|%[0-9A-Fa-f][0-9A-Fa-f])*\z/) { last V; } } } ## -- Path unless ($v =~ m{\A(?>[A-Za-z0-9._~!\$&'()*+,;=:\@/-]|%[0-9A-Fa-f][0-9A-Fa-f])*\z}s) { last V; } $r = true; } # V @Attr: @@Name: isRelativeReference @@enDesc: Whether the DOM URI is a relative reference or not according to the latest version of the URI specification. {NOTE:: At the time of writing, RFC 3986 is the latest version and the attribute must contain the value same as attribute of the same object. } @@Type: idl|boolean||ManakaiDOM|all @@Get: @@@TrueCase: @@@@enDesc: If it is a legal relative reference. @@@FalseCase: @@@@enDesc: If it is not a legal relative reference. @@@PerlDef: __DEEP{ $r = $self->; }__; @Attr: @@Name: isRelativeReference3986 @@DISPerl:methodName: is_relative_reference_3986 @@enDesc: Whether the DOM URI is an RFC 3986 relative reference or not. @@Type: idl|boolean||ManakaiDOM|all @@Get: @@@TrueCase: @@@@enDesc: If the DOM URI matches to the production rule . @@@FalseCase: @@@@enDesc: Otherwise. @@@PerlDef: my $v = $$self; V: { ## -- No scheme if ($v =~ s!^[^/?#]*:!!s) { last V; } ## -- Fragment if ($v =~ s/#(.*)\z//s) { my $w = $1; unless ($w =~ m{\A(?>[A-Za-z0-9._~!\$&'()*+,;=:\@/?-]|%[0-9A-Fa-f][0-9A-Fa-f])*\z}) { last V; } } ## -- Query if ($v =~ s/\?(.*)\z//s) { my $w = $1; unless ($w =~ m{\A(?>[A-Za-z0-9._~!\$&'()*+,;=:\@/?-]|%[0-9A-Fa-f][0-9A-Fa-f])*\z}) { last V; } } ## -- Authority if ($v =~ s!^//([^/]*)!!s) { my $w = $1; $w =~ s/^(?>[A-Za-z0-9._~!\$&'()*+,;=:-]|%[0-9A-Fa-f][0-9A-Fa-f])*\@//os; $w =~ s/:[0-9]*\z//; if ($w =~ /^\[(.*)\]\z/s) { my $x = $1; unless ($x =~ /\A[vV][0-9A-Fa-f]+\.[A-Za-z0-9._~!\$&'()*+,;=:-]+\z/) { ## IPv6address my $isv6; __CODE{isIPv6address:: $in => $x, $out => $isv6}__; last V unless $isv6; } } else { unless ($w =~ /\A(?>[A-Za-z0-9._~!\$&'()*+,;=-]|%[0-9A-Fa-f][0-9A-Fa-f])*\z/) { last V; } } } ## -- Path unless ($v =~ m{\A(?>[A-Za-z0-9._~!\$&'()*+,;=:\@/-]|%[0-9A-Fa-f][0-9A-Fa-f])*\z}s) { last V; } $r = true; } # V @Attr: @@Name: isURIReference @@enDesc: Whether the DOM URI is a URI reference or not according to the latest version of the URI specification. {NOTE:: At the time of writing, RFC 3986 is the latest version and the attribute must contain the value same as attribute of the same object. } @@Type: idl|boolean||ManakaiDOM|all @@Get: @@@TrueCase: @@@@enDesc: If it is a legal URI reference. @@@FalseCase: @@@@enDesc: If it is not a legal URI reference. @@@PerlDef: __DEEP{ $r = $self->; }__; @Attr: @@Name: isURIReference3986 @@DISPerl:methodName: is_uri_reference_3986 @@enDesc: Whether the DOM URI is an RFC 3986 URI reference or not. @@Type: idl|boolean||ManakaiDOM|all @@Get: @@@TrueCase: @@@@enDesc: If the DOM URI matches to the production rule . @@@FalseCase: @@@@enDesc: Otherwise. @@@PerlDef: __DEEP{ $r = $self-> || $self->; }__; @Attr: @@Name: isAbsoluteURI @@enDesc: Whether the DOM URI is an absolute URI or not according to the latest version of the URI specification. {NOTE:: At the time of writing, RFC 3986 is the latest version and the attribute must contain the value same as attribute of the same object. } @@Type: idl|boolean||ManakaiDOM|all @@Get: @@@TrueCase: @@@@enDesc: If it is a legal absolute URI. @@@FalseCase: @@@@enDesc: If it is not a legal absolute URI. @@@PerlDef: __DEEP{ $r = $self->; }__; @Attr: @@Name: isAbsoluteURI3986 @@DISPerl:methodName: is_absolute_uri_3986 @@enDesc: Whether the DOM URI is an RFC 3986 absolute URI or not. @@Type: idl|boolean||ManakaiDOM|all @@Get: @@@TrueCase: @@@@enDesc: If the DOM URI matches to the production rule . @@@FalseCase: @@@@enDesc: Otherwise. @@@PerlDef: __DEEP{ $r = $$self !~ /#/ && $self->; }__; @Attr: @@Name: isEmptyReference @@enDesc: Whether the DOM URI is an empty string or not. @@Type: idl|boolean||ManakaiDOM|all @@Get: @@@TrueCase: @@@@enDesc: If the DOM URI is an empty string. @@@FalseCase: @@@@enDesc: Otherwise. @@@PerlDef: $r = ($$self eq ''); @Attr: @@Name: isIRI @@enDesc: Whether the DOM URI is an IRI or not according to the latest version of the IRI specification. {NOTE:: At the time of writing, RFC 3987 is the latest version and the attribute must contain the value same as attribute of the same object. } @@Type: idl|boolean||ManakaiDOM|all @@Get: @@@TrueCase: @@@@enDesc: If it is a legal IRI. @@@FalseCase: @@@@enDesc: If it is not a legal IRI. @@@PerlDef: __DEEP{ $r = $self->; }__; @Attr: @@Name: isIRI3987 @@DISPerl:methodName: is_iri_3987 @@enDesc: Whether the DOM URI is an RFC 3987 IRI or not. {NOTE:: Whether the IRI is valid according to the scheme-specific syntax is not checked. } @@Type: idl|boolean||ManakaiDOM|all @@Get: @@@TrueCase: @@@@enDesc: If the DOM URI matches to the production rule . @@@FalseCase: @@@@enDesc: Otherwise. @@@PerlDef: my $v = $$self; V: { ## LRM, RLM, LRE, RLE, LRO, RLO, PDF ## U+200E, U+200F, U+202A - U+202E 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}}; ## -- Scheme unless ($v =~ s/^[A-Za-z][A-Za-z0-9+.-]*://s) { last V; } ## -- Fragment if ($v =~ s/#(.*)\z//s) { my $w = $1; unless ($w =~ m{\A(?>[A-Za-z0-9._~!\$&'()*+,;=:\@/?$ucschar-]|%[0-9A-Fa-f][0-9A-Fa-f])*\z}o) { last V; } } ## -- Query if ($v =~ s/\?(.*)\z//s) { my $w = $1; 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) { last V; } } ## -- Authority if ($v =~ s!^//([^/]*)!!s) { my $w = $1; $w =~ s/^(?>[A-Za-z0-9._~!\$&'()*+,;=:$ucschar-]|%[0-9A-Fa-f][0-9A-Fa-f])*\@//os; $w =~ s/:[0-9]*\z//; if ($w =~ /^\[(.*)\]\z/s) { my $x = $1; unless ($x =~ /\A[vV][0-9A-Fa-f]+\.[A-Za-z0-9._~!\$&'()*+,;=:-]+\z/) { ## IPv6address my $isv6; __CODE{isIPv6address:: $in => $x, $out => $isv6}__; last V unless $isv6; } } else { unless ($w =~ /\A(?>[A-Za-z0-9._~!\$&'()*+,;=$ucschar-]|%[0-9A-Fa-f][0-9A-Fa-f])*\z/o) { last V; } } } ## -- Path unless ($v =~ m{\A(?>[A-Za-z0-9._~!\$&'()*+,;=:\@/$ucschar-]|%[0-9A-Fa-f][0-9A-Fa-f])*\z}os) { last V; } $r = true; } # V @Attr: @@Name: isRelativeIRIReference @@enDesc: Whether the DOM IRI is a relative IRI reference or not according to the latest version of the IRI specification. {NOTE:: At the time of writing, RFC 3987 is the latest version and the attribute must contain the value same as attribute of the same object. } @@Type: idl|boolean||ManakaiDOM|all @@Get: @@@TrueCase: @@@@enDesc: If it is a legal relative IRI reference. @@@FalseCase: @@@@enDesc: If it is not a legal relative IRI reference. @@@PerlDef: __DEEP{ $r = $self->; }__; @Attr: @@Name: isRelativeIRIReference3987 @@DISPerl:methodName: is_relative_iri_reference_3987 @@enDesc: Whether the DOM URI is an RFC 3987 relative IRI reference or not. @@Type: idl|boolean||ManakaiDOM|all @@Get: @@@TrueCase: @@@@enDesc: If the DOM URI matches to the production rule . @@@FalseCase: @@@@enDesc: Otherwise. @@@PerlDef: my $v = $$self; V: { ## LRM, RLM, LRE, RLE, LRO, RLO, PDF ## U+200E, U+200F, U+202A - U+202E 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}}; ## -- No scheme if ($v =~ s!^[^/?#]*:!!s) { last V; } ## -- Fragment if ($v =~ s/#(.*)\z//s) { my $w = $1; unless ($w =~ m{\A(?>[A-Za-z0-9._~!\$&'()*+,;=:\@/?$ucschar-]|%[0-9A-Fa-f][0-9A-Fa-f])*\z}o) { last V; } } ## -- Query if ($v =~ s/\?(.*)\z//s) { my $w = $1; 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) { last V; } } ## -- Authority if ($v =~ s!^//([^/]*)!!s) { my $w = $1; $w =~ s/^(?>[A-Za-z0-9._~!\$&'()*+,;=:$ucschar-]|%[0-9A-Fa-f][0-9A-Fa-f])*\@//os; $w =~ s/:[0-9]*\z//; if ($w =~ /^\[(.*)\]\z/s) { my $x = $1; unless ($x =~ /\A[vV][0-9A-Fa-f]+\.[A-Za-z0-9._~!\$&'()*+,;=:-]+\z/) { ## IPv6address my $isv6; __CODE{isIPv6address:: $in => $x, $out => $isv6}__; last V unless $isv6; } } else { unless ($w =~ /\A(?>[A-Za-z0-9._~!\$&'()*+,;=$ucschar-]|%[0-9A-Fa-f][0-9A-Fa-f])*\z/o) { last V; } } } ## -- Path unless ($v =~ m{\A(?>[A-Za-z0-9._~!\$&'()*+,;=:\@/$ucschar-]|%[0-9A-Fa-f][0-9A-Fa-f])*\z}os) { last V; } $r = true; } # V @Attr: @@Name: isIRIReference @@enDesc: Whether the DOM URI is an IRI reference or not according to the latest version of the IRI specification. {NOTE:: At the time of writing, RFC 3987 is the latest version and the attribute must contain the value same as attribute of the same object. } @@Type: idl|boolean||ManakaiDOM|all @@Get: @@@TrueCase: @@@@enDesc: If it is a legal IRI reference. @@@FalseCase: @@@@enDesc: If it is not a legal IRI reference. @@@PerlDef: __DEEP{ $r = $self->; }__; @Attr: @@Name: isIRIReference3987 @@DISPerl:methodName: is_iri_reference_3987 @@enDesc: Whether the DOM URI is an RFC 3987 IRI reference or not. @@Type: idl|boolean||ManakaiDOM|all @@Get: @@@TrueCase: @@@@enDesc: If the DOM URI matches to the production rule . @@@FalseCase: @@@@enDesc: Otherwise. @@@PerlDef: __DEEP{ $r = $self-> || $self->; }__; @Attr: @@Name: isAbsoluteIRI @@enDesc: Whether the DOM URI is an absolute IRI or not according to the latest version of the IRI specification. {NOTE:: At the time of writing, RFC 3987 is the latest version and the attribute must contain the value same as attribute of the same object. } @@Type: idl|boolean||ManakaiDOM|all @@Get: @@@TrueCase: @@@@enDesc: If it is a legal absolute IRI. @@@FalseCase: @@@@enDesc: If it is not a legal absolute IRI. @@@PerlDef: __DEEP{ $r = $self->; }__; @Attr: @@Name: isAbsoluteIRI3987 @@DISPerl:methodName: is_absolute_iri_3987 @@enDesc: Whether the DOM URI is an RFC 3987 absolute IRI or not. @@Type: idl|boolean||ManakaiDOM|all @@Get: @@@TrueCase: @@@@enDesc: If the DOM URI matches to the production rule . @@@FalseCase: @@@@enDesc: Otherwise. @@@PerlDef: __DEEP{ $r = $$self !~ /#/ && $self->; }__; @CODE: @@QName: isIPv6address @@enDesc: , @@PerlDef: 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}/; my $h16 = qr/[0-9A-Fa-f]{1,4}/; if ($in =~ s/(?:$ipv4|$h16)\z//o) { if ($in =~ /\A(?>$h16:){6}\z/o or $in =~ /\A::(?>$h16:){0,5}\z/o or $in =~ /\A${h16}::(?>$h16:){4}\z/o or $in =~ /\A$h16(?::$h16)?::(?>$h16:){3}\z/o or $in =~ /\A$h16(?::$h16){0,2}::(?>$h16:){2}\z/o or $in =~ /\A$h16(?::$h16){0,3}::$h16:\z/o or $in =~ /\A$h16(?::$h16){0,4}::\z/o) { $out = true; } } elsif ($in =~ s/$h16\z//o) { if ($in eq '' or $in =~ /\A$h16(?>:$h16){0,5}\z/o) { $out = true; } } elsif ($in =~ s/::\z//o) { if ($in eq '' or $in =~ /\A$h16(?>:$h16){0,6}\z/o) { $out = true; } } @Method: @@Name: getURIReference @@enDesc: Creates a clone of the DOM URI object, in which any character not allowed in URI references are percent-encoded as per the latest version of the URI specification. {NOTE:: At the time of writing, RFC 3986 is the latest version and the method must return the same result as method. } @@Return: @@@Type: URIReference @@@enDesc: The newly created object. @@@PerlDef: __DEEP{ $r = $self->; }__; @Method: @@Name: getURIReference3986 @@DISPerl:methodName: get_uri_reference_3986 @@enDesc: Creates a clone of the DOM URI object, in which any character not allowed in RFC 3986 URI references are percent-encoded. {P:: The method perform the algorithm specified in the section 3.1 of the RFC 3987 on a copy of the DOM URI contained by the object, as amended as: {LI:: it convert the authority component using the IDNA rule. {ISSUE:: Define a separate method to convert IDN to Punycoded name. } } - it also deal with the characters not allowed in URIs in step 2 of the RFC 3987 algorithm. } {NOTE:: The result DOM URI might not be a conformant RFC 3986 URI reference. } @@Return: @@@Type: URIReference @@@enDesc: The newly created object. @@@PerlDef: __DEEP{ require Encode; my $v = Encode::encode ('utf8', $$self); $v =~ s/([<>"{}|\\\^`\x00-\x20\x7E-\xFF])/sprintf '%%%02X', ord $1/ge; $r = bless \$v, ; }__; @Method: @@Name: getIRIReference @@enDesc: Creates a clone of the DOM URI object, in which percent-encodings are decoded as far as possible as per the latest version of the IRI specification. {NOTE:: At the time of writing, RFC 3987 is the latest version and the method must return the same result as method. } @@Return: @@@Type: URIReference @@@enDesc: The newly created object. @@@PerlDef: __DEEP{ $r = $self->; }__; @Method: @@Name: getIRIReference3987 @@DISPerl:methodName: get_iri_reference_3987 @@enDesc: Creates a clone of the DOM URI object, in which percent-encodings are decoded as far as possible as defined in RFC 3987 IRI references. {P:: The method perform a variant of the algorithm specified in the section 3.2 of RFC 3987 on a copy of the DOM URI contained by the object, as amended by replacing step 4 as: {LI:: Re-percent-encode all octets produced in step 3 that in UTF-8 represent characters that: - are US-ASCII characters not allowed in RFC 3986 URI references, - are not contained in character range and are not US-ASCII printable characters, or - are contained in the list of forbidden characters in the section 4.1 of RFC 3987. } } {NOTE:: The result DOM URI might not be a conformant RFC 3987 IRI reference. } @@Return: @@@Type: URIReference @@@enDesc: The newly created object. @@@PerlDef: __DEEP{ require Encode; my $v = Encode::encode ('utf8', $$self); $v =~ s{%([2-9A-Fa-f][0-9A-Fa-f])} { my $ch = hex $1; if ([ # 0x0 0x1 0x2 0x3 0x4 0x5 0x6 0x7 # 0x8 0x9 0xA 0xB 0xC 0xD 0xE 0xF true, true, true, true, true, true, true, true, # 0x00 true, true, true, true, true, true, true, true, # 0x08 true, true, true, true, true, true, true, true, # 0x10 true, true, true, true, true, true, true, true, # 0x18 true, true, true, true, true, true, true, true, # 0x20 true, true, true, true, true, false, false, true, # 0x28 false, false, false, false, false, false, false, false, # 0x30 false, false, true, true, true, true, true, true, # 0x38 true, false, false, false, false, false, false, false, # 0x40 false, false, false, false, false, false, false, false, # 0x48 false, false, false, false, false, false, false, false, # 0x50 false, false, false, true, true, true, true, false, # 0x58 true, false, false, false, false, false, false, false, # 0x60 false, false, false, false, false, false, false, false, # 0x68 false, false, false, false, false, false, false, false, # 0x70 false, false, false, true, true, true, false, true, # 0x78 # 0x0 0x1 0x2 0x3 0x4 0x5 0x6 0x7 # 0x8 0x9 0xA 0xB 0xC 0xD 0xE 0xF ]->[$ch]) { # PERCENT SIGN, reserved, not-allowed in ASCII '%'.$1; } else { chr $ch; } }ge; $v =~ s{( [\xC2-\xDF][\x80-\xBF] | # UTF8-2 [\xE0][\xA0-\xBF][\x80-\xBF] | [\xE1-\xEC][\x80-\xBF][\x80-\xBF] | [\xED][\x80-\x9F][\x80-\xBF] | [\xEE\xEF][\x80-\xBF][\x80-\xBF] | # UTF8-3 [\xF0][\x90-\xBF][\x80-\xBF][\x80-\xBF] | [\xF1-\xF3][\x80-\xBF][\x80-\xBF][\x80-\xBF] | [\xF4][\x80-\x8F][\x80-\xBF][\x80-\xBF] | # UTF8-4 [\x80-\xFF] )}{ my $c = $1; if (length ($c) == 1) { $c =~ s/(.)/sprintf '%%%02X', ord $1/ge; $c; } else { my $ch = Encode::decode ('utf8', $c); 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}]/) { $c; } else { $c =~ s/([\x80-\xFF])/sprintf '%%%02X', ord $1/ge; $c; } } }gex; $v =~ s/([<>"{}|\\\^`\x00-\x20\x7F])/sprintf '%%%02X', ord $1/ge; $v = Encode::decode ('utf8', $v); $r = bless \$v, ; }__; @Test: @@QName: URIRef.validity.test @@PerlDef: my $impl; __CODE{createURIImplForTest:: $impl => $impl}__; for ( { in => q, get_uri_reference => q, get_uri_reference_3986 => q, get_iri_reference => q, get_iri_reference_3987 => q, is_uri_reference => true, is_iri_reference => true, is_uri_reference_3986 => true, is_iri_reference_3987 => true, is_uri => true, is_iri => true, is_uri_3986 => true, is_iri_3987 => true, is_relative_reference => false, is_relative_iri_reference => false, is_relative_reference_3986 => false, is_relative_iri_reference_3987 => false, is_absolute_uri => true, is_absolute_iri => true, is_absolute_uri_3986 => true, is_absolute_iri_3987 => true, is_empty_reference => false, }, { in => q, get_uri_reference => q, get_uri_reference_3986 => q, get_iri_reference => q, get_iri_reference_3987 => q, is_uri_reference => true, is_iri_reference => true, is_uri_reference_3986 => true, is_iri_reference_3987 => true, is_uri => true, is_iri => true, is_uri_3986 => true, is_iri_3987 => true, is_relative_reference => false, is_relative_iri_reference => false, is_relative_reference_3986 => false, is_relative_iri_reference_3987 => false, is_absolute_uri => false, is_absolute_iri => false, is_absolute_uri_3986 => false, is_absolute_iri_3987 => false, is_empty_reference => false, }, { in => q, get_uri_reference => q, get_uri_reference_3986 => q, get_iri_reference => q, get_iri_reference_3987 => q, is_uri_reference => false, is_iri_reference => false, is_uri_reference_3986 => false, is_iri_reference_3987 => false, is_uri => false, is_iri => false, is_uri_3986 => false, is_iri_3987 => false, is_relative_reference => false, is_relative_iri_reference => false, is_relative_reference_3986 => false, is_relative_iri_reference_3987 => false, is_absolute_uri => false, is_absolute_iri => false, is_absolute_uri_3986 => false, is_absolute_iri_3987 => false, is_empty_reference => false, }, { in => q, get_uri_reference => q, get_uri_reference_3986 => q, get_iri_reference => q, get_iri_reference_3987 => q, is_uri_reference => false, is_iri_reference => false, is_uri_reference_3986 => false, is_iri_reference_3987 => false, is_uri => false, is_iri => false, is_uri_3986 => false, is_iri_3987 => false, is_relative_reference => false, is_relative_iri_reference => false, is_relative_reference_3986 => false, is_relative_iri_reference_3987 => false, is_absolute_uri => false, is_absolute_iri => false, is_absolute_uri_3986 => false, is_absolute_iri_3987 => false, is_empty_reference => false, }, { in => q, get_uri_reference => q, get_uri_reference_3986 => q, get_iri_reference => q, get_iri_reference_3987 => q, is_uri_reference => true, is_iri_reference => true, is_uri_reference_3986 => true, is_iri_reference_3987 => true, is_uri => true, is_iri => true, is_uri_3986 => true, is_iri_3987 => true, is_relative_reference => false, is_relative_iri_reference => false, is_relative_reference_3986 => false, is_relative_iri_reference_3987 => false, is_absolute_uri => true, is_absolute_iri => true, is_absolute_uri_3986 => true, is_absolute_iri_3987 => true, is_empty_reference => false, }, { in => q, get_uri_reference => q, get_uri_reference_3986 => q, get_iri_reference => q, get_iri_reference_3987 => q, is_uri_reference => true, is_iri_reference => true, is_uri_reference_3986 => true, is_iri_reference_3987 => true, is_uri => false, is_iri => false, is_uri_3986 => false, is_iri_3987 => false, is_relative_reference => true, is_relative_iri_reference => true, is_relative_reference_3986 => true, is_relative_iri_reference_3987 => true, is_absolute_uri => false, is_absolute_iri => false, is_absolute_uri_3986 => false, is_absolute_iri_3987 => false, is_empty_reference => false, }, { in => q<>, get_uri_reference => q<>, get_uri_reference_3986 => q<>, get_iri_reference => q<>, get_iri_reference_3987 => q<>, is_uri_reference => true, is_iri_reference => true, is_uri_reference_3986 => true, is_iri_reference_3987 => true, is_uri => false, is_iri => false, is_uri_3986 => false, is_iri_3987 => false, is_relative_reference => true, is_relative_iri_reference => true, is_relative_reference_3986 => true, is_relative_iri_reference_3987 => true, is_absolute_uri => false, is_absolute_iri => false, is_absolute_uri_3986 => false, is_absolute_iri_3987 => false, is_empty_reference => true, }, { in => qq, get_uri_reference => qq, get_uri_reference_3986 => qq, get_iri_reference => qq, get_iri_reference_3987 => qq, is_uri_reference => false, is_iri_reference => true, is_uri_reference_3986 => false, is_iri_reference_3987 => true, is_uri => false, is_iri => true, is_uri_3986 => false, is_iri_3987 => true, is_relative_reference => false, is_relative_iri_reference => false, is_relative_reference_3986 => false, is_relative_iri_reference_3987 => false, is_absolute_uri => false, is_absolute_iri => true, is_absolute_uri_3986 => false, is_absolute_iri_3987 => true, is_empty_reference => false, }, { in => q, get_uri_reference => q, get_uri_reference_3986 => q, get_iri_reference => qq, get_iri_reference_3987 => qq, is_uri_reference => true, is_iri_reference => true, is_uri_reference_3986 => true, is_iri_reference_3987 => true, is_uri => true, is_iri => true, is_uri_3986 => true, is_iri_3987 => true, is_relative_reference => false, is_relative_iri_reference => false, is_relative_reference_3986 => false, is_relative_iri_reference_3987 => false, is_absolute_uri => true, is_absolute_iri => true, is_absolute_uri_3986 => true, is_absolute_iri_3987 => true, is_empty_reference => false, }, { in => q, get_uri_reference => q, get_uri_reference_3986 => q, get_iri_reference => q, get_iri_reference_3987 => q, is_uri_reference => true, is_iri_reference => true, is_uri_reference_3986 => true, is_iri_reference_3987 => true, is_uri => true, is_iri => true, is_uri_3986 => true, is_iri_3987 => true, is_relative_reference => false, is_relative_iri_reference => false, is_relative_reference_3986 => false, is_relative_iri_reference_3987 => false, is_absolute_uri => true, is_absolute_iri => true, is_absolute_uri_3986 => true, is_absolute_iri_3987 => true, is_empty_reference => false, }, { in => q, get_uri_reference => q, get_uri_reference_3986 => q, get_iri_reference => q, get_iri_reference_3987 => q, is_uri_reference => true, is_iri_reference => true, is_uri_reference_3986 => true, is_iri_reference_3987 => true, is_uri => true, is_iri => true, is_uri_3986 => true, is_iri_3987 => true, is_relative_reference => false, is_relative_iri_reference => false, is_relative_reference_3986 => false, is_relative_iri_reference_3987 => false, is_absolute_uri => true, is_absolute_iri => true, is_absolute_uri_3986 => true, is_absolute_iri_3987 => true, is_empty_reference => false, }, { in => q, get_uri_reference => q, get_uri_reference_3986 => q, get_iri_reference => q, get_iri_reference_3987 => q, is_uri_reference => true, is_iri_reference => true, is_uri_reference_3986 => true, is_iri_reference_3987 => true, is_uri => true, is_iri => true, is_uri_3986 => true, is_iri_3987 => true, is_relative_reference => false, is_relative_iri_reference => false, is_relative_reference_3986 => false, is_relative_iri_reference_3987 => false, is_absolute_uri => true, is_absolute_iri => true, is_absolute_uri_3986 => true, is_absolute_iri_3987 => true, is_empty_reference => false, }, { in => q, get_uri_reference => q, get_uri_reference_3986 => q, get_iri_reference => q, get_iri_reference_3987 => q, is_uri_reference => true, is_iri_reference => true, is_uri_reference_3986 => true, is_iri_reference_3987 => true, is_uri => true, is_iri => true, is_uri_3986 => true, is_iri_3987 => true, is_relative_reference => false, is_relative_iri_reference => false, is_relative_reference_3986 => false, is_relative_iri_reference_3987 => false, is_absolute_uri => true, is_absolute_iri => true, is_absolute_uri_3986 => true, is_absolute_iri_3987 => true, is_empty_reference => false, }, { in => q, get_uri_reference => q, get_uri_reference_3986 => q, get_iri_reference => q, get_iri_reference_3987 => q, is_uri_reference => true, is_iri_reference => true, is_uri_reference_3986 => true, is_iri_reference_3987 => true, is_uri => true, is_iri => true, is_uri_3986 => true, is_iri_3987 => true, is_relative_reference => false, is_relative_iri_reference => false, is_relative_reference_3986 => false, is_relative_iri_reference_3987 => false, is_absolute_uri => true, is_absolute_iri => true, is_absolute_uri_3986 => true, is_absolute_iri_3987 => true, is_empty_reference => false, }, { in => q, get_uri_reference => q, get_uri_reference_3986 => q, get_iri_reference => q, get_iri_reference_3987 => q, is_uri_reference => true, is_iri_reference => true, is_uri_reference_3986 => true, is_iri_reference_3987 => true, is_uri => true, is_iri => true, is_uri_3986 => true, is_iri_3987 => true, is_relative_reference => false, is_relative_iri_reference => false, is_relative_reference_3986 => false, is_relative_iri_reference_3987 => false, is_absolute_uri => true, is_absolute_iri => true, is_absolute_uri_3986 => true, is_absolute_iri_3987 => true, is_empty_reference => false, }, { in => q, get_uri_reference => q, get_uri_reference_3986 => q, get_iri_reference => q, get_iri_reference_3987 => q, is_uri_reference => true, is_iri_reference => true, is_uri_reference_3986 => true, is_iri_reference_3987 => true, is_uri => true, is_iri => true, is_uri_3986 => true, is_iri_3987 => true, is_relative_reference => false, is_relative_iri_reference => false, is_relative_reference_3986 => false, is_relative_iri_reference_3987 => false, is_absolute_uri => true, is_absolute_iri => true, is_absolute_uri_3986 => true, is_absolute_iri_3987 => true, is_empty_reference => false, }, { in => q, get_uri_reference => q, get_uri_reference_3986 => q, get_iri_reference => q, get_iri_reference_3987 => q, is_uri_reference => false, is_iri_reference => false, is_uri_reference_3986 => false, is_iri_reference_3987 => false, is_uri => false, is_iri => false, is_uri_3986 => false, is_iri_3987 => false, is_relative_reference => false, is_relative_iri_reference => false, is_relative_reference_3986 => false, is_relative_iri_reference_3987 => false, is_absolute_uri => false, is_absolute_iri => false, is_absolute_uri_3986 => false, is_absolute_iri_3987 => false, is_empty_reference => false, }, { in => q, get_uri_reference => q, get_uri_reference_3986 => q, get_iri_reference => q, get_iri_reference_3987 => q, is_uri_reference => true, is_iri_reference => true, is_uri_reference_3986 => true, is_iri_reference_3987 => true, is_uri => true, is_iri => true, is_uri_3986 => true, is_iri_3987 => true, is_relative_reference => false, is_relative_iri_reference => false, is_relative_reference_3986 => false, is_relative_iri_reference_3987 => false, is_absolute_uri => false, is_absolute_iri => false, is_absolute_uri_3986 => false, is_absolute_iri_3987 => false, is_empty_reference => false, }, { in => q, get_uri_reference => q, get_uri_reference_3986 => q, get_iri_reference => q, get_iri_reference_3987 => q, is_uri_reference => true, is_iri_reference => true, is_uri_reference_3986 => true, is_iri_reference_3987 => true, is_uri => false, is_iri => false, is_uri_3986 => false, is_iri_3987 => false, is_relative_reference => true, is_relative_iri_reference => true, is_relative_reference_3986 => true, is_relative_iri_reference_3987 => true, is_absolute_uri => false, is_absolute_iri => false, is_absolute_uri_3986 => false, is_absolute_iri_3987 => false, is_empty_reference => false, }, { in => q, get_uri_reference => q, get_uri_reference_3986 => q, get_iri_reference => q, get_iri_reference_3987 => q, is_uri_reference => true, is_iri_reference => true, is_uri_reference_3986 => true, is_iri_reference_3987 => true, is_uri => false, is_iri => false, is_uri_3986 => false, is_iri_3987 => false, is_relative_reference => true, is_relative_iri_reference => true, is_relative_reference_3986 => true, is_relative_iri_reference_3987 => true, is_absolute_uri => false, is_absolute_iri => false, is_absolute_uri_3986 => false, is_absolute_iri_3987 => false, is_empty_reference => false, }, { in => q, get_uri_reference => q, get_uri_reference_3986 => q, get_iri_reference => q, get_iri_reference_3987 => q, is_uri_reference => true, is_iri_reference => true, is_uri_reference_3986 => true, is_iri_reference_3987 => true, is_uri => true, is_iri => true, is_uri_3986 => true, is_iri_3987 => true, is_relative_reference => false, is_relative_iri_reference => false, is_relative_reference_3986 => false, is_relative_iri_reference_3987 => false, is_absolute_uri => true, is_absolute_iri => true, is_absolute_uri_3986 => true, is_absolute_iri_3987 => true, is_empty_reference => false, }, { in => q, get_uri_reference => q, get_uri_reference_3986 => q, get_iri_reference => q, get_iri_reference_3987 => q, is_uri_reference => true, is_iri_reference => true, is_uri_reference_3986 => true, is_iri_reference_3987 => true, is_uri => true, is_iri => true, is_uri_3986 => true, is_iri_3987 => true, is_relative_reference => false, is_relative_iri_reference => false, is_relative_reference_3986 => false, is_relative_iri_reference_3987 => false, is_absolute_uri => true, is_absolute_iri => true, is_absolute_uri_3986 => true, is_absolute_iri_3987 => true, is_empty_reference => false, }, { in => qq, get_uri_reference => qq, get_uri_reference_3986 => qq, get_iri_reference => qq, get_iri_reference_3987 => qq, is_uri_reference => false, is_iri_reference => true, is_uri_reference_3986 => false, is_iri_reference_3987 => true, is_uri => false, is_iri => true, is_uri_3986 => false, is_iri_3987 => true, is_relative_reference => false, is_relative_iri_reference => false, is_relative_reference_3986 => false, is_relative_iri_reference_3987 => false, is_absolute_uri => false, is_absolute_iri => true, is_absolute_uri_3986 => false, is_absolute_iri_3987 => true, is_empty_reference => false, }, { in => qq, get_uri_reference => qq, get_uri_reference_3986 => qq, get_iri_reference => qq, get_iri_reference_3987 => qq, is_uri_reference => true, is_iri_reference => true, is_uri_reference_3986 => true, is_iri_reference_3987 => true, is_uri => true, is_iri => true, is_uri_3986 => true, is_iri_3987 => true, is_relative_reference => false, is_relative_iri_reference => false, is_relative_reference_3986 => false, is_relative_iri_reference_3987 => false, is_absolute_uri => true, is_absolute_iri => true, is_absolute_uri_3986 => true, is_absolute_iri_3987 => true, is_empty_reference => false, }, { in => qq, get_uri_reference => qq, get_uri_reference_3986 => qq, get_iri_reference => qq, get_iri_reference_3987 => qq, is_uri_reference => false, is_iri_reference => true, is_uri_reference_3986 => false, is_iri_reference_3987 => true, is_uri => false, is_iri => true, is_uri_3986 => false, is_iri_3987 => true, is_relative_reference => false, is_relative_iri_reference => false, is_relative_reference_3986 => false, is_relative_iri_reference_3987 => false, is_absolute_uri => false, is_absolute_iri => false, is_absolute_uri_3986 => false, is_absolute_iri_3987 => false, is_empty_reference => false, }, { in => qq, get_uri_reference => qq, get_uri_reference_3986 => qq, get_iri_reference => qq, get_iri_reference_3987 => qq, is_uri_reference => true, is_iri_reference => true, is_uri_reference_3986 => true, is_iri_reference_3987 => true, is_uri => true, is_iri => true, is_uri_3986 => true, is_iri_3987 => true, is_relative_reference => false, is_relative_iri_reference => false, is_relative_reference_3986 => false, is_relative_iri_reference_3987 => false, is_absolute_uri => false, is_absolute_iri => false, is_absolute_uri_3986 => false, is_absolute_iri_3987 => false, is_empty_reference => false, }, { in => qq, get_uri_reference => qq, get_uri_reference_3986 => qq, get_iri_reference => qq, get_iri_reference_3987 => qq, is_uri_reference => false, is_iri_reference => true, is_uri_reference_3986 => false, is_iri_reference_3987 => true, is_uri => false, is_iri => true, is_uri_3986 => false, is_iri_3987 => true, is_relative_reference => false, is_relative_iri_reference => false, is_relative_reference_3986 => false, is_relative_iri_reference_3987 => false, is_absolute_uri => false, is_absolute_iri => true, is_absolute_uri_3986 => false, is_absolute_iri_3987 => true, is_empty_reference => false, }, { in => qq, get_uri_reference => qq, get_uri_reference_3986 => qq, get_iri_reference => qq, get_iri_reference_3987 => qq, is_uri_reference => true, is_iri_reference => true, is_uri_reference_3986 => true, is_iri_reference_3987 => true, is_uri => true, is_iri => true, is_uri_3986 => true, is_iri_3987 => true, is_relative_reference => false, is_relative_iri_reference => false, is_relative_reference_3986 => false, is_relative_iri_reference_3987 => false, is_absolute_uri => true, is_absolute_iri => true, is_absolute_uri_3986 => true, is_absolute_iri_3987 => true, is_empty_reference => false, }, { in => qq, get_uri_reference => qq, get_uri_reference_3986 => qq, get_iri_reference => qq, get_iri_reference_3987 => qq, is_uri_reference => true, is_iri_reference => true, is_uri_reference_3986 => true, is_iri_reference_3987 => true, is_uri => true, is_iri => true, is_uri_3986 => true, is_iri_3987 => true, is_relative_reference => false, is_relative_iri_reference => false, is_relative_reference_3986 => false, is_relative_iri_reference_3987 => false, is_absolute_uri => true, is_absolute_iri => true, is_absolute_uri_3986 => true, is_absolute_iri_3987 => true, is_empty_reference => false, }, { in => qq, get_uri_reference => qq, get_uri_reference_3986 => qq, get_iri_reference => qq, get_iri_reference_3987 => qq, is_uri_reference => true, is_iri_reference => true, is_uri_reference_3986 => true, is_iri_reference_3987 => true, is_uri => true, is_iri => true, is_uri_3986 => true, is_iri_3987 => true, is_relative_reference => false, is_relative_iri_reference => false, is_relative_reference_3986 => false, is_relative_iri_reference_3987 => false, is_absolute_uri => true, is_absolute_iri => true, is_absolute_uri_3986 => true, is_absolute_iri_3987 => true, is_empty_reference => false, }, { in => qq, get_uri_reference => qq, get_uri_reference_3986 => qq, get_iri_reference => qq, get_iri_reference_3987 => qq, is_uri_reference => true, is_iri_reference => true, is_uri_reference_3986 => true, is_iri_reference_3987 => true, is_uri => true, is_iri => true, is_uri_3986 => true, is_iri_3987 => true, is_relative_reference => false, is_relative_iri_reference => false, is_relative_reference_3986 => false, is_relative_iri_reference_3987 => false, is_absolute_uri => true, is_absolute_iri => true, is_absolute_uri_3986 => true, is_absolute_iri_3987 => true, is_empty_reference => false, }, { in => qq, get_uri_reference => qq, get_uri_reference_3986 => qq, get_iri_reference => qq, get_iri_reference_3987 => qq, is_uri_reference => true, is_iri_reference => true, is_uri_reference_3986 => true, is_iri_reference_3987 => true, is_uri => true, is_iri => true, is_uri_3986 => true, is_iri_3987 => true, is_relative_reference => false, is_relative_iri_reference => false, is_relative_reference_3986 => false, is_relative_iri_reference_3987 => false, is_absolute_uri => true, is_absolute_iri => true, is_absolute_uri_3986 => true, is_absolute_iri_3987 => true, is_empty_reference => false, }, ) { my $uri1 = $impl-> ($_->{in}); for my $method (qw/get_uri_reference get_uri_reference_3986 get_iri_reference get_iri_reference_3987/) { $test->id ($_->{in}.'.'.$method); $test->assert_equals ($uri1->$method->, $_->{$method}); } for my $method (qw/is_uri is_iri is_uri_3986 is_iri_3987 is_uri_reference is_iri_reference is_uri_reference_3986 is_iri_reference_3987 is_relative_reference is_relative_iri_reference is_relative_reference_3986 is_relative_iri_reference_3987 is_absolute_uri is_absolute_iri is_absolute_uri_3986 is_absolute_iri_3987 is_empty_reference/) { $test->id ($_->{in}.'.'.$method); my $tm = $_->{$method} ? 'assert_true' : 'assert_false'; $test->$tm ($uri1->$method); } } @Method: @@Name: getAbsoluteReference @@enDesc: Returns the target DOM URI for the DOM URI resolved as per the latest version of the URI specification. {NOTE:: At the time of writing, RFC 3986 is the latest version of the URI specification. RFC 3987 shares the same resolution algorithm as RFC 3986. The method must return the same result as or would do. } @@Param: @@@Name: base @@@Type: URIReference @@@enDesc: The base DOM URI against which the DOM URI is resolved. @@@enDesc: @@@@ddid:perl @@@@@: For Perl binding, any value that can be specified as the parameter to the method can be set to the parameter. @@NamedParam: @@@Name: nonStrict @@@Type: idl|boolean||ManakaiDOM|all @@@enDesc: Whether the resolution is done in the strict mode or not. @@Return: @@@Type: URIReference @@@enDesc: The target DOM URI. @@@PerlDef: __DEEP{ $r = $self-> ($base, non_strict => $nonStrict); }__; @Method: @@Name: getAbsoluteReference3986 @@DISPerl:methodName: get_absolute_reference_3986 @@enDesc: Returns the target DOM URI for the DOM URI resolved as per RFC 3986. The resolution is done according to the algorithm shown in RFC 3986 section 5.2 and a new object containing the result target DOM URI is returned by the method. The method parse DOM URIs into five components as described in the RFC 3986 algorithm by the definition of attributes , , , , and . It is intended that for conforming RFC 3986 URI references they returns the identical set of components as described in RFC 3986. The method perform any normalization to DOM URIs . Applications can invoke appropriate methods before or after the relative reference resolution if desired. @@Param: @@@Name: base @@@Type: URIReference @@@enDesc: The base DOM URI against which the DOM URI is resolved. If the scheme component of the is missing, then the result is undefined. @@@enDesc: @@@@ddid:perl @@@@@: For Perl binding, any value that can be specified as the parameter to the method can be set to the parameter. @@NamedParam: @@@Name: nonStrict @@@Type: idl|boolean||ManakaiDOM|all @@@enDesc: Whether the resolution is done in the strict mode or not. @@@TrueCase: @@@@enDesc: The flag in the algorithm in RFC 3986 section 5.2.2 is set to >. @@@TrueCase: @@@@enDesc: The flag in the algorithm in RFC 3986 section 5.2.2 is set to >. @@Return: @@@Type: URIReference @@@enDesc: The target DOM URI. {NOTE:: The result DOM URI might not be a conforming RFC 3986 URI if the original DOM URI is not a conforming RFC 3986 URI reference and / or the DOM URI is not a conforming URI. The result DOM URI might not be a conforming RFC 3987 IRI if the original DOM URI is not a conforming RFC 3987 IRI reference and / or the DOM URI is not a conforming IRI. } @@@PerlDef: __DEEP{ ## -- Decomposition my ($b_scheme, $b_auth, $b_path, $b_query, $b_frag); my ($r_scheme, $r_auth, $r_path, $r_query, $r_frag); if ($$self =~ m!\A(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?\z!s) { ($r_scheme, $r_auth, $r_path, $r_query, $r_frag) = ($1, $2, $3, $4, $5); } else { # unlikely happen ($r_scheme, $r_auth, $r_path, $r_query, $r_frag) = (null, null, '', null, null); } my $ba = ref $base eq 'SCALAR' ? $base : ref $base eq ? $base : ref $base ? \"$base" : \$base; if ($$ba =~ m!\A(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?\z!s) { ($b_scheme, $b_auth, $b_path, $b_query, $b_frag) = (defined $1 ? $1 : '', $2, $3, $4, $5); } else { # unlikely happen ($b_scheme, $b_auth, $b_path, $b_query, $b_frag) = ('', null, '', null, null); } ## -- Merge my $path_merge = sub ($$) { my ($bpath, $rpath) = @_; if ($bpath eq '') { return '/'.$rpath; } $bpath =~ s/[^\/]*\z//; return $bpath . $rpath; }; # merge ## -- Removing Dot Segments my $remove_dot_segments = sub ($) { local $_ = shift; my $buf = ''; L: while (length $_) { next L if s/^\.\.?\///; next L if s/^\/\.(?:\/|\z)/\//; if (s/^\/\.\.(\/|\z)/\//) { $buf =~ s/\/?[^\/]*$//; next L; } last Z if s/^\.\.?\z//; s/^(\/?[^\/]*)//; $buf .= $1; } return $buf; }; # remove_dot_segments ## -- Transformation my ($t_scheme, $t_auth, $t_path, $t_query, $t_frag); if ($nonStrict and $r_scheme eq $b_scheme) { undef $r_scheme; } if (defined $r_scheme) { $t_scheme = $r_scheme; $t_auth = $r_auth; $t_path = $remove_dot_segments->($r_path); $t_query = $r_query; } else { if (defined $r_auth) { $t_auth = $r_auth; $t_path = $remove_dot_segments->($r_path); $t_query = $r_query; } else { if ($r_path =~ /\A\z/) { $t_path = $b_path; if (defined $r_query) { $t_query = $r_query; } else { $t_query = $b_query; } } elsif ($r_path =~ /^\//) { $t_path = $remove_dot_segments->($r_path); $t_query = $r_query; } else { $t_path = $path_merge->($b_path, $r_path); $t_path = $remove_dot_segments->($t_path); $t_query = $r_query; } $t_auth = $b_auth; } $t_scheme = $b_scheme; } $t_frag = $r_frag; ## -- Recomposition my $result = '' ; $result .= $t_scheme . ':' if defined $t_scheme; $result .= '//' . $t_auth if defined $t_auth ; $result .= $t_path ; $result .= '?' . $t_query if defined $t_query ; $result .= '#' . $t_frag if defined $t_frag ; $r = bless \$result, ; }__; @@Test: @@@QName: URIRef.getAbsRef.input.test @@@PerlDef: my $impl; __CODE{createURIImplForTest:: $impl => $impl}__; my $ref = $impl-> ('../foo'); $test->id ('string'); my $t1 = $ref-> (q); $test->assert_equals ($t1->, q); $test->id ('stringref'); my $t2 = $ref-> (\q); $test->assert_equals ($t2->, q); $test->id ('uriref'); my $t3 = $ref-> ($impl-> (q)); $test->assert_equals ($t3->, q); @@Test: @@@QName: URIRef.getAbsRef.test @@@PerlDef: my $impl; __CODE{createURIImplForTest:: $impl => $impl}__; for ( ## From RFC 3986 ["g:h" => "g:h"], ["g" => "http://a/b/c/g"], ["./g" => "http://a/b/c/g"], ["g/" => "http://a/b/c/g/"], ["/g" => "http://a/g"], ["//g" => "http://g"], ["?y" => "http://a/b/c/d;p?y"], ["g?y" => "http://a/b/c/g?y"], ["#s" => "http://a/b/c/d;p?q#s"], ["g#s" => "http://a/b/c/g#s"], ["g?y#s" => "http://a/b/c/g?y#s"], [";x" => "http://a/b/c/;x"], ["g;x" => "http://a/b/c/g;x"], ["g;x?y#s" => "http://a/b/c/g;x?y#s"], ["" => "http://a/b/c/d;p?q"], ["." => "http://a/b/c/"], ["./" => "http://a/b/c/"], [".." => "http://a/b/"], ["../" => "http://a/b/"], ["../g" => "http://a/b/g"], ["../.." => "http://a/"], ["../../" => "http://a/"], ["../../g" => "http://a/g"], ["../../../g" => "http://a/g"], ["../../../../g" => "http://a/g"], ["/./g" => "http://a/g"], ["/../g" => "http://a/g"], ["g." => "http://a/b/c/g."], [".g" => "http://a/b/c/.g"], ["g.." => "http://a/b/c/g.."], ["..g" => "http://a/b/c/..g"], ["./../g" => "http://a/b/g"], ["./g/." => "http://a/b/c/g/"], ["g/./h" => "http://a/b/c/g/h"], ["g/../h" => "http://a/b/c/h"], ["g;x=1/./y" => "http://a/b/c/g;x=1/y"], ["g;x=1/../y" => "http://a/b/c/y"], ["g?y/./x" => "http://a/b/c/g?y/./x"], ["g?y/../x" => "http://a/b/c/g?y/../x"], ["g#s/./x" => "http://a/b/c/g#s/./x"], ["g#s/../x" => "http://a/b/c/g#s/../x"], ["http:g" => "http:g"], ## From "http://www.gbiv.com/protocols/uri/test/rel_examples1.html" ["http:" => "http:"], ## From "http://www.w3.org/2004/04/uri-rel-test.html" ["./g:h" => "http://a/b/c/g:h"], ) { my $ref = $impl-> ($_->[0]); $test->id ($_->[0]); my $t = $ref-> (q); $test->assert_equals ($t->, $_->[1]); $test->id ($_->[0].'.3986'); my $t1 = $ref-> (q); $test->assert_equals ($t1->, $_->[1]); $test->id ($_->[0].'.3987'); my $t2 = $ref-> (q); $test->assert_equals ($t2->, $_->[1]); } @@Test: @@@QName: URIRef.getAbsRef.nonStrict.test @@@PerlDef: my $impl; __CODE{createURIImplForTest:: $impl => $impl}__; ## From "http://www.gbiv.com/protocols/uri/test/rel_examples1.html" $test->id (1); my $ref = $impl-> (q); my $t1 = $ref-> (q, non_strict => true); $test->assert_equals ($t1->, q); $test->id (2); my $ref2 = $impl-> (q); my $t2 = $ref2-> (q, non_strict => true); $test->assert_equals ($t2->, q); @Method: @@Name: getAbsoluteReference3987 @@DISPerl:methodName: get_absolute_reference_3987 @@enDesc: Returns the target DOM URI for the DOM URI resolved as per RFC 3987. Since RFC 3987 references RFC 3986 for the resolution algorithm, the method act as would do. @@Param: @@@Name: base @@@Type: URIReference @@@enDesc: The base DOM URI against which the DOM URI is resolved. @@@enDesc: @@@@ddid:perl @@@@@: For Perl binding, any value that can be specified as the parameter to the method can be set to the parameter. @@NamedParam: @@@Name: nonStrict @@@Type: idl|boolean||ManakaiDOM|all @@@enDesc: Whether the resolution is done in the strict mode or not. @@Return: @@@Type: URIReference @@@enDesc: The target DOM URI. {NOTE:: The result DOM URI might not be a conforming RFC 3987 IRI if the original DOM URI is not a conforming RFC 3987 IRI reference and / or the DOM URI is not a conforming IRI. } @@@PerlDef: __DEEP{ $r = $self-> ($base, non_strict => $nonStrict); }__; @Method: @@Name: isSameDocumentReference @@enDesc: Whether the DOM URI is a same-document reference or not as per the latest version of the URI specification. {NOTE:: At the time of writing, RFC 3986 is the latest version of the URI specification and the method must return the same result as the would return. } @@Param: @@@Name: base @@@Type: URIReference @@@enDesc: The base DOM URI against which the sameness is tested. @@Return: @@@Type: idl|boolean||ManakaiDOM|all @@@TrueCase: @@@@enDesc: The DOM URI is a same-document reference. @@@FalseCase: @@@@enDesc: It is sure that the DOM URI is a same-document reference. @@@PerlDef: __DEEP{ $r = $self-> ($base); }__; @Method: @@Name: isSameDocumentReference3986 @@DISPerl:methodName: is_same_document_reference_3986 @@enDesc: Whether the DOM URI is a same-document reference or not as per RFC 3986 section 4.4. @@Param: @@@Name: base @@@Type: URIReference @@@enDesc: The base DOM URI against which the sameness is tested. If it does not contain the scheme component, then the result is undefined. @@@enDesc: @@@@ddid:perl @@@@@: For Perl binding, any value that can be specified as the parameter to the method can be set to the parameter. @@NamedParam: @@@Name: nonStrict @@@Type: idl|boolean||ManakaiDOM|all @@@enDesc: Whether the resolution is done in the strict mode or not. @@Return: @@@Type: idl|boolean||ManakaiDOM|all @@@TrueCase: @@@@enDesc: If the target DOM URI that the method with the same parameter would return shares the same substring without fragment components and the preceding it if any with the DOM URI. @@@FalseCase: @@@@enDesc: Otherwise. @@@PerlDef: __DEEP{ if (substr ($$self, 0, 1) eq '#') { $r = true; } else { my $target = $self-> ($base, non_strict => $nonStrict) ->; $target =~ s/#.*\z//; my $ba = ref $base eq 'SCALAR' ? $$base : ref $base eq ? $$base : ref $base ? "$base" : $base; $ba =~ s/#.*\z//; $r = ($target eq $ba); } }__; @@Test: @@@QName: URIRef.isSameDocRef.test @@@PerlDef: my $impl; __CODE{createURIImplForTest:: $impl => $impl}__; my $base = q; for ( [q, false], [q<#fragment>, true], [q, true], [q, true], [q, false], [q<>, true], [q, true], ) { my $ref = $impl-> ($_->[0]); my $method = $_->[1] ? 'assert_true' : 'assert_false'; $test->id ($_->[0]); $test->$method ($ref-> ($base)); $test->id ($_->[0].'.3986'); $test->$method ($ref-> ($base)); } @Method: @@Name: getRelativeReference @@enDesc: Returns a DOM URI that references the same target URI as the DOM URI according to the latest version of the URI specification. The method return as simple DOM URI as possible. {P:: How it computes the relative reference is implementation dependent. However, it at least meets the conditions below: - If the DOM URI is a legal RFC 3986 URI reference, then the result DOM URI be a legal RFC 3986 URI reference that references the target URI of the original URI. - If the DOM URI is a legal RFC 3987 IRI, then the result DOM URI be a legal RFC 3987 IRI reference that references either the a IRI that is literally equivalent to the target IRI of the original IRI when zero or more URI-to-IRI or IRI-to-URI convertion is performed. } {ISSUE:: Should be introduced? Should and also be? } @@Param: @@@Name: base @@@Type: URIReference @@@enDesc: The base DOM URI when against which the result DOM URI is resolved then it must be the same DOM URI as the target DOM URI of the DOM URI. @@Return: @@@Type: URIReference @@@enDesc: The result DOM URI. @@@PerlDef: __DEEP{ my @base; my $ba = ref $base eq 'SCALAR' ? $base : ref $base eq ? $base : ref $base ? \"$base" : \$base; if ($$ba =~ m!\A(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?\z!) { (@base) = (defined $1 ? $1 : '', $2, $3, $4, $5); } else { # unlikeley happen (@base) = ('', null, '', null, null); } my @t; my $t = $self-> ($base); if ("$t" =~ m!\A(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?\z!) { (@t) = (defined $1 ? $1 : '', $2, $3, $4, $5); } else { # unlikeley happen (@t) = ('', null, '', null, null); } my @ref; R: { ## Scheme if ($base[0] ne $t[0]) { (@ref) = @t; last R; } ## Authority if (not defined $base[1] and not defined $t[1]) { (@ref) = @t; last R; } elsif (not defined $t[1]) { (@ref) = @t; last R; } elsif (not defined $base[1]) { (@ref) = @t; last R; } elsif ($base[1] ne $t[1]) { (@ref) = @t; last R; } ## NOTE: Avoid uncommon references. if (defined $t[4] and # fragment $t[2] eq $base[2] and # path ((not defined $t[3] and not defined $base[3]) or # query (defined $t[3] and defined $base[3] and $t[3] eq $base[3]))) { (@ref) = (null, null, '', null, $t[4]); last R; } ## Path my @tpath = split m!/!, $t[2], -1; my @bpath = split m!/!, $base[2], -1; if (@tpath < 1 or @bpath < 1) { ## No |/| (@ref) = @t; last R; } my $bpl; ## Removes common segments while (@tpath and @bpath and $tpath[0] eq $bpath[0]) { shift @tpath; $bpl = shift @bpath; } if (@tpath == 0) { if (@bpath == 0) { ## Avoid empty path for backward compatibility unshift @tpath, $bpl; } else { unshift @tpath, '..', $bpl; } } elsif (@bpath == 0) { unshift @tpath, $bpl; } unshift @tpath, ('..') x (@bpath - 1) if @bpath > 1; unshift @tpath, '.' if $tpath[0] eq '' or $tpath[0] =~ /:/; (@ref) = (null, null, (join '/', @tpath), $t[3], $t[4]); } # R ## -- Recomposition my $result = '' ; $result .= $ref[0] . ':' if defined $ref[0]; # scheme; $result .= '//' . $ref[1] if defined $ref[1]; # authority $result .= $ref[2] ; # path $result .= '?' . $ref[3] if defined $ref[3]; # query $result .= '#' . $ref[4] if defined $ref[4]; # fragment $r = bless \$result, ; }__; @@Test: @@@QName: URIRef.getRelRef.input.test @@@PerlDef: my $impl; __CODE{createURIImplForTest:: $impl => $impl}__; my $ref = $impl-> (q); $test->id ('string'); my $rel1 = $ref-> (q); $test->assert_equals ($rel1->, 'a'); $test->id ('stringref'); my $rel2 = $ref-> (\q); $test->assert_equals ($rel2->, 'a'); $test->id ('string'); my $rel3 = $ref-> ($impl-> (q)); $test->assert_equals ($rel3->, 'a'); @@Test: @@@QName: URIRef.getRelRef.test @@@PerlDef: my $impl; __CODE{createURIImplForTest:: $impl => $impl}__; for ( [q, q, q<./>], [q, q, q], [q, q, q], [q, q, q], [q, q, q], [q, q, q], [q, q, q], [q, q, q<../c>], [q, q, q<./>], [q, q, q<../>], [q, q, q<../../b>], [q, q, q<../../>], [q, q, q], [q, q, q<../d/f>], [q, q, q], [q, q, q<./about:blank>], [q, q, q<.//>], [q, q, q], [q, q, q<#a>], [q, q, q], [q, q, q<./?c>], ) { $test->id ($_->[0].'.'.$_->[1]); my $ref = $impl-> ($_->[0]); my $rel = $ref-> ($_->[1]); $test->assert_equals ($rel->, $_->[2]); } @enImplNote: @@ddid: norm @@@: Normalization [RFC 3986 6.2.2], [RFC 3987 5.3.2] - Use uppercase letters for any hexadecimal digit in percent-encodings [RFC 3986 2.1, 6.2.2.1, RFC 3987 5.3.2.1]. - Use lowercase letters in |scheme| and |host| [RFC 3986 6.2.2.1, RFC 3987 5.3.2.1]. - Decode any percent-encoded unreserved characters [RFC 3986 2.3, 6.2.2.2, RFC 3987 5.3.2.3]. - dot-segment [RFC 3986 6.2.2.3, RFC 3987 5.3.2.4]. In addition to |normalize|, scheme-specific normalization. [RFC 3986 6.2.3, RFC 3987 5.3.3] equivalence property URI @enImplNote: @@ddid: equiv @@@: Equivalence [RFC 3986 6, RFC 3987 5] equivalence property URI @IntMethod: @@Operator: @@@@: eq @@@ContentType: DISPerl|Perl @@enDesc: For Perl binding, the operator be overloaded so that it returnjs equality as strings. @@Param: @@@Name: v @@@Type: idl|any||ManakaiDOM|all @@@enDesc: Another value to compare. @@Return: @@@Type: idl|boolean||ManakaiDOM|all @@@enDesc: The equality. @@@PerlDef: if (defined $v) { __DEEP{ $r = $v eq $$self; }__; } @@Test: @@@QName: URIRef.eq.test @@@PerlDef: my $impl; __CODE{createURIImplForTest:: $impl => $impl}__; $test->id ('u=u'); $test->assert_equals ($impl-> (q), $impl-> (q)); $test->id ('u!=u'); $test->assert_not_equals ($impl-> (q), $impl-> (q)); $test->id ('u=s'); $test->assert_equals ($impl-> (q), q); $test->id ('u!=s'); $test->assert_not_equals ($impl-> (q), q); $test->id ('s=u'); $test->assert_equals (q, $impl-> (q)); $test->id ('s!=u'); $test->assert_not_equals (q, $impl-> (q)); $test->id ('u!=undef'); $test->assert_not_equals ($impl-> (q), null); $test->id ('undef!=u'); $test->assert_not_equals (null, $impl-> (q)); @Method: @@Name: cloneURIReference @@Operator: DISPerl|CloneMethod @@enDesc: Creates a new independent object with the same value. @@enDesc: @@@ddid: p @@@@: For Perl binding, the method act as the would do. @@Return: @@@Type: URIReference @@@enDesc: The newly created DOM URI object. @@@PerlDef: my $v = $$self; $r = bless \$v, ; @@Test: @@@QName: URIRef.clone.Test @@@PerlDef: my $impl; __CODE{createURIImplForTest:: $impl => $impl}__; my $ref = $impl-> (q); $test->id ('cloneURIRef'); my $ref2 = $ref->; $test->assert_equals ($ref2->, q); $test->id ('cloneURIRef.diff'); $ref2-> (q); $test->assert_equals ($ref->, q); $test->id ('clone'); my $ref3 = $ref->clone; $test->assert_equals ($ref3->, q); $test->id ('clone.diff'); $ref3-> (q); $test->assert_equals ($ref->, q); ##URIReference ResourceDef: @QName: String @AliasFor: str|DOMString ElementTypeBinding: @Name: enDesc @ElementType: dis:Description @ShadowContent: @@lang:en ElementTypeBinding: @Name: enImplNote @ElementType: dis:Description @ShadowContent: @@lang:en ElementTypeBinding: @Name: nullCase @ElementType: dis:ResourceDef @ShadowContent: @@DISCore:resourceType: ManakaiDOM|InCase @@Value: @@@is-null:1 @@@ContentType: DISCore|String ElementTypeBinding: @Name: TrueCase @ElementType: dis:ResourceDef @ShadowContent: @@DISCore:resourceType: ManakaiDOM|InCase @@Value: @@@@: 1 @@@ContentType: DISCore|Boolean @@Type: idl|boolean||ManakaiDOM|all ElementTypeBinding: @Name: FalseCase @ElementType: dis:ResourceDef @ShadowContent: @@DISCore:resourceType: ManakaiDOM|InCase @@Value: @@@@: 0 @@@ContentType: DISCore|Boolean @@Type: idl|boolean||ManakaiDOM|all