Permalink
Fetching contributors…
Cannot retrieve contributors at this time
831 lines (702 sloc) 27 KB
module m_common_namespaces
#ifndef DUMMYLIB
use fox_m_fsys_array_str, only: str_vs, vs_str, vs_str_alloc
use fox_m_utils_uri, only: URI, parseURI, destroyURI, hasScheme
use m_common_attrs, only: dictionary_t, get_key, get_value, remove_key, getLength, hasKey
use m_common_attrs, only: set_nsURI, set_localName, get_prefix, add_item_to_dict
use m_common_charset, only: XML1_0, XML1_1
use m_common_error, only: FoX_error, FoX_warning, error_stack, add_error, in_error
use m_common_namecheck, only: checkNCName
use m_common_struct, only: xml_doc_state
implicit none
private
character(len=*), parameter :: invalidNS = '::INVALID::'
! an invalid URI name to indicate a namespace error.
type URIMapping
character, dimension(:), pointer :: URI
integer :: ix ! link back to node depth
end type URIMapping
!This is a single URI, and the node depth under which
!its namespace applies.
type prefixMapping
character, dimension(:), pointer :: prefix
type(URIMapping), dimension(:), pointer :: urilist
end type prefixMapping
!This is the mapping for a single prefix; with the
!list of namespaces which are in force at various
!depths
type namespaceDictionary
private
type(URIMapping), dimension(:), pointer :: defaults
type(prefixMapping), dimension(:), pointer :: prefixes
end type namespaceDictionary
!This is the full namespace dictionary; defaults is
!the list of default namespaces in force; prefix a
!list of all prefixes in force.
public :: invalidNS
public :: initNamespaceDictionary
public :: destroyNamespaceDictionary
public :: namespaceDictionary
public :: checkNamespaces
public :: checkNamespacesWriting
public :: checkEndNamespaces
public :: getnamespaceURI
interface getnamespaceURI
module procedure getURIofDefaultNS, getURIofPrefixedNS
end interface
public :: isPrefixInForce
public :: isDefaultNSInForce
public :: getNumberOfPrefixes
public :: getPrefixByIndex
public :: dumpnsdict !FIXME
public :: addDefaultNS
public :: removeDefaultNS
public :: addPrefixedNS
public :: removePrefixedNS
contains
subroutine initNamespaceDictionary(nsDict)
type(namespaceDictionary), intent(inout) :: nsDict
!We need to properly initialize 0th elements
!(which are never used) in order to provide
!sensible behaviour when trying to manipulate
!an empty dictionary.
allocate(nsDict%defaults(0:0))
allocate(nsDict%defaults(0)%URI(0))
!The 0th element of the defaults NS is the empty namespace
nsDict%defaults(0)%ix = -1
allocate(nsDict%prefixes(0:0))
allocate(nsDict%prefixes(0)%prefix(0))
allocate(nsDict%prefixes(0)%urilist(0:0))
allocate(nsDict%prefixes(0)%urilist(0)%URI(len(invalidNS)))
nsDict%prefixes(0)%urilist(0)%URI = vs_str(invalidNS)
nsDict%prefixes(0)%urilist(0)%ix = -1
end subroutine initNamespaceDictionary
subroutine destroyNamespaceDictionary(nsDict)
type(namespaceDictionary), intent(inout) :: nsDict
integer :: i, j
do i = 0, ubound(nsDict%defaults,1)
deallocate(nsDict%defaults(i)%URI)
enddo
deallocate(nsDict%defaults)
do i = 0, ubound(nsDict%prefixes,1)
do j = 0, ubound(nsDict%prefixes(i)%urilist,1)
deallocate(nsDict%prefixes(i)%urilist(j)%URI)
enddo
deallocate(nsDict%prefixes(i)%prefix)
deallocate(nsDict%prefixes(i)%urilist)
enddo
deallocate(nsDict%prefixes)
end subroutine destroyNamespaceDictionary
subroutine copyURIMapping(urilist1, urilist2, l_m)
type(URIMapping), dimension(0:), intent(inout) :: urilist1
type(URIMapping), dimension(0:), intent(inout) :: urilist2
integer, intent(in):: l_m
integer :: i
if (ubound(urilist1,1) < l_m .or. ubound(urilist2,1) < l_m) then
call FoX_error('Internal error in m_sax_namespaces:copyURIMapping')
endif
! Now copy all defaults across (or rather - add pointers to them)
do i = 0, l_m
urilist2(i)%ix = urilist1(i)%ix
urilist2(i)%URI => urilist1(i)%URI
enddo
end subroutine copyURIMapping
subroutine addDefaultNS(nsDict, uri, ix, es)
type(namespaceDictionary), intent(inout) :: nsDict
character(len=*), intent(in) :: uri
integer, intent(in) :: ix
type(error_stack), intent(inout), optional :: es
type(URIMapping), dimension(:), allocatable :: tempMap
integer :: l_m, l_s
if (uri=="http://www.w3.org/XML/1998/namespace") then
if (present(es)) then
call add_error(es, "Attempt to assign incorrect URI to prefix 'xml'")
else
call FoX_error("Attempt to assign incorrect URI to prefix 'xml'")
endif
elseif (uri=="http://www.w3.org/2000/xmlns/") then
if (present(es)) then
call add_error(es, "Attempt to assign prefix to xmlns namespace")
else
call FoX_error("Attempt to assign prefix to xmlns namespace")
endif
endif
! FIXME check URI is valid ...
l_m = ubound(nsDict%defaults,1)
allocate(tempMap(0:l_m))
! Now copy all defaults across ...
call copyURIMapping(nsDict%defaults, tempMap, l_m)
deallocate(nsDict%defaults)
l_m = l_m + 1
allocate(nsDict%defaults(0:l_m))
!Now copy everything back ...
call copyURIMapping(tempMap, nsDict%defaults, l_m-1)
deallocate(tempMap)
! And finally, add the new default NS
nsDict%defaults(l_m)%ix = ix
l_s = len(uri)
allocate(nsDict%defaults(l_m)%URI(l_s))
nsDict%defaults(l_m)%URI = vs_str(uri)
end subroutine addDefaultNS
subroutine addPrefixedURI(nsPrefix, uri, ix)
type(PrefixMapping), intent(inout) :: nsPrefix
character, dimension(:), intent(in) :: uri
integer, intent(in) :: ix
type(URIMapping), dimension(:), allocatable :: tempMap
integer :: l_m, l_s
l_m = ubound(nsPrefix%urilist,1)
allocate(tempMap(0:l_m))
! Now copy all across ...
call copyURIMapping(nsPrefix%urilist, tempMap, l_m)
deallocate(nsPrefix%urilist)
l_m = l_m + 1
allocate(nsPrefix%urilist(0:l_m))
!Now copy everything back ...
call copyURIMapping(tempMap, nsPrefix%urilist, l_m-1)
deallocate(tempMap)
! And finally, add the new default NS
nsPrefix%urilist(l_m)%ix = ix
l_s = size(uri)
allocate(nsPrefix%urilist(l_m)%URI(l_s))
nsPrefix%urilist(l_m)%URI = uri
end subroutine addPrefixedURI
subroutine removeDefaultNS(nsDict)
type(namespaceDictionary), intent(inout) :: nsDict
type(URIMapping), dimension(:), allocatable :: tempMap
integer :: l_m
l_m = ubound(nsDict%defaults,1)
allocate(tempMap(0:l_m-1))
! Now copy all defaults across ...
call copyURIMapping(nsDict%defaults, tempMap, l_m-1)
!And remove tail-end charlie
deallocate(nsDict%defaults(l_m)%URI)
deallocate(nsDict%defaults)
l_m = l_m - 1
allocate(nsDict%defaults(0:l_m))
!Now copy everything back ...
call copyURIMapping(tempMap, nsDict%defaults, l_m)
deallocate(tempMap)
end subroutine removeDefaultNS
subroutine removePrefixedURI(nsPrefix)
type(PrefixMapping), intent(inout) :: nsPrefix
type(URIMapping), dimension(:), allocatable :: tempMap
integer :: l_m
l_m = ubound(nsPrefix%urilist,1)
allocate(tempMap(0:l_m-1))
! Now copy all defaults across ...
call copyURIMapping(nsPrefix%urilist, tempMap, l_m-1)
!And remove tail-end charlie
deallocate(nsPrefix%urilist(l_m)%URI)
deallocate(nsPrefix%urilist)
l_m = l_m - 1
allocate(nsPrefix%urilist(0:l_m))
!Now copy everything back ...
call copyURIMapping(tempMap, nsPrefix%urilist, l_m)
deallocate(tempMap)
end subroutine removePrefixedURI
subroutine addPrefixedNS(nsDict, prefix, URI, ix, xds, xml, es)
type(namespaceDictionary), intent(inout) :: nsDict
character(len=*), intent(in) :: prefix
character(len=*), intent(in) :: uri
integer, intent(in) :: ix
type(xml_doc_state), intent(in) :: xds
logical, intent(in), optional :: xml
type(error_stack), intent(inout), optional :: es
integer :: l_p, p_i, i
logical :: xml_
if (present(xml)) then
xml_ = xml
else
xml_ = .false.
endif
if (prefix=='xml' .and. &
URI/='http://www.w3.org/XML/1998/namespace') then
if (present(es)) then
call add_error(es, "Attempt to assign incorrect URI to prefix 'xml'")
else
call FoX_error("Attempt to assign incorrect URI to prefix 'xml'")
endif
elseif (prefix/='xml' .and. &
URI=='http://www.w3.org/XML/1998/namespace') then
if (present(es)) then
call add_error(es, "Attempt to assign incorrect prefix to XML namespace")
else
call FoX_error("Attempt to assign incorrect prefix to XML namespace")
endif
elseif (prefix == 'xmlns') then
if (present(es)) then
call add_error(es, "Attempt to declare 'xmlns' prefix")
else
call FoX_error("Attempt to declare 'xmlns' prefix")
endif
elseif (URI=="http://www.w3.org/2000/xmlns/") then
if (present(es)) then
call add_error(es, "Attempt to assign prefix to xmlns namespace")
else
call FoX_error("Attempt to assign prefix to xmlns namespace")
endif
elseif (len(prefix) > 2) then
if ((verify(prefix(1:1), 'xX') == 0) &
.and. (verify(prefix(2:2), 'mM') == 0) &
.and. (verify(prefix(3:3), 'lL') == 0)) then
if (.not.xml_) then
! FIXME need working warning infrastructure
!if (present(es)) then
! call add_error(es, "Attempt to declare reserved prefix: "//prefix)
!else
call FoX_warning("Attempt to declare reserved prefix: "//prefix)
!endif
endif
endif
endif
if (.not.checkNCName(prefix, xds%xml_version)) &
call FoX_error("Attempt to declare invalid prefix: "//prefix)
! FIXME check URI is valid
l_p = ubound(nsDict%prefixes, 1)
p_i = 0
do i = 1, l_p
if (str_vs(nsDict%prefixes(i)%prefix) == prefix) then
p_i = i
exit
endif
enddo
if (p_i == 0) then
call addPrefix(nsDict, vs_str(prefix))
p_i = l_p + 1
endif
call addPrefixedURI(nsDict%prefixes(p_i), vs_str(URI), ix)
end subroutine addPrefixedNS
subroutine removePrefixedNS(nsDict, prefix)
type(namespaceDictionary), intent(inout) :: nsDict
character, dimension(:), intent(in) :: prefix
integer :: l_p, p_i, i
l_p = ubound(nsDict%prefixes, 1)
p_i = 0
do i = 1, l_p
if (str_vs(nsDict%prefixes(i)%prefix) == str_vs(prefix)) then
p_i = i
exit
endif
enddo
if (p_i /= 0) then
call removePrefixedURI(nsDict%prefixes(p_i))
if (ubound(nsDict%prefixes(p_i)%urilist,1) == 0) then
!that was the last mapping for that prefix
call removePrefix(nsDict, p_i)
endif
else
call FoX_error('Internal error in m_sax_namespaces:removePrefixedNS')
endif
end subroutine removePrefixedNS
subroutine addPrefix(nsDict, prefix)
type(namespaceDictionary), intent(inout) :: nsDict
character, dimension(:), intent(in) :: prefix
integer :: l_p
type(prefixMapping), dimension(:), pointer :: tempPrefixMap
integer :: i
!Add a new prefix to the namespace dictionary.
!Unfortunately this involves copying the entire
!prefixes dictionary to a temporary structure, then
!reallocating the prefixes dictionary to be one
!longer, then copying everything back:
l_p = ubound(nsDict%prefixes, 1)
allocate(tempPrefixMap(0:l_p))
!for each current prefix, append everything to temporary structure
do i = 0, l_p
tempPrefixMap(i)%prefix => nsDict%prefixes(i)%prefix
tempPrefixMap(i)%urilist => nsDict%prefixes(i)%urilist
enddo
deallocate(nsDict%prefixes)
!extend prefix dictionary by one ...
l_p = l_p + 1
allocate(nsDict%prefixes(0:l_p))
!and copy back ...
do i = 0, l_p-1
nsDict%prefixes(i)%prefix => tempPrefixMap(i)%prefix
nsDict%prefixes(i)%urilist => tempPrefixMap(i)%urilist
enddo
deallocate(tempPrefixMap)
allocate(nsDict%prefixes(l_p)%prefix(size(prefix)))
nsDict%prefixes(l_p)%prefix = prefix
allocate(nsDict%prefixes(l_p)%urilist(0:0))
allocate(nsDict%prefixes(l_p)%urilist(0)%URI(len(invalidNS)))
nsDict%prefixes(l_p)%urilist(0)%URI = vs_str(invalidNS)
nsDict%prefixes(l_p)%urilist(0)%ix = -1
end subroutine addPrefix
subroutine removePrefix(nsDict, i_p)
type(namespaceDictionary), intent(inout) :: nsDict
integer, intent(in) :: i_p
integer :: l_p
type(prefixMapping), dimension(:), pointer :: tempPrefixMap
integer :: i
!Remove a prefix from the namespace dictionary.
!Unfortunately this involves copying the entire
!prefixes dictionary to a temporary structure, then
!reallocating the prefixes dictionary to be one
!shorter, then copying everything back:
l_p = ubound(nsDict%prefixes, 1)
allocate(tempPrefixMap(0:l_p-1))
!for each current prefix, append everything to temporary structure
do i = 0, i_p-1
tempPrefixMap(i)%prefix => nsDict%prefixes(i)%prefix
tempPrefixMap(i)%urilist => nsDict%prefixes(i)%urilist
enddo
deallocate(nsDict%prefixes(i_p)%urilist(0)%URI)
deallocate(nsDict%prefixes(i_p)%urilist)
deallocate(nsDict%prefixes(i_p)%prefix)
!this subroutine will only get called if the urilist is already
!empty, so no need to deallocate it.
do i = i_p+1, l_p
tempPrefixMap(i-1)%prefix => nsDict%prefixes(i)%prefix
tempPrefixMap(i-1)%urilist => nsDict%prefixes(i)%urilist
enddo
deallocate(nsDict%prefixes)
!shorten prefix dictionary by one ...
l_p = l_p - 1
allocate(nsDict%prefixes(0:l_p))
!and copy back ...
do i = 0, l_p
nsDict%prefixes(i)%prefix => tempPrefixMap(i)%prefix
nsDict%prefixes(i)%urilist => tempPrefixMap(i)%urilist
enddo
deallocate(tempPrefixMap)
end subroutine removePrefix
subroutine checkNamespaces(atts, nsDict, ix, xds, namespace_prefixes, xmlns_uris, es, &
partial, start_prefix_handler, end_prefix_handler)
type(dictionary_t), intent(inout) :: atts
type(namespaceDictionary), intent(inout) :: nsDict
integer, intent(in) :: ix ! depth of nesting of current element.
type(xml_doc_state), intent(in) :: xds
logical, intent(in) :: namespace_prefixes, xmlns_uris
type(error_stack), intent(inout) :: es
logical, intent(in) :: partial ! if so, don't try and resolve anything except xml & xmlns
optional :: start_prefix_handler, end_prefix_handler
interface
subroutine start_prefix_handler(namespaceURI, prefix)
character(len=*), intent(in) :: namespaceURI
character(len=*), intent(in) :: prefix
end subroutine start_prefix_handler
subroutine end_prefix_handler(prefix)
character(len=*), intent(in) :: prefix
end subroutine end_prefix_handler
end interface
character(len=6) :: xmlns
character, dimension(:), pointer :: QName, URIstring
integer :: i, n
type(URI), pointer :: URIref
!Check for namespaces; *and* remove xmlns references from
!the attributes dictionary.
! we can't do a simple loop across the attributes,
! because we need to remove some as we go along ...
i = 1
do while (i <= getLength(atts))
xmlns = get_key(atts, i)
if (xmlns == 'xmlns ') then
!Default namespace is being set
URIstring => vs_str_alloc(get_value(atts, i))
if (str_vs(URIstring)=="") then
! Empty nsURI on default namespace has same effect in 1.0 and 1.1
if (present(end_prefix_handler)) &
call end_prefix_handler("")
call addDefaultNS(nsDict, invalidNS, ix)
deallocate(URIstring)
else
URIref => parseURI(str_vs(URIstring))
if (.not.associated(URIref)) then
call add_error(es, "Invalid URI: "//str_vs(URIstring))
deallocate(URIstring)
return
elseif (.not.hasScheme(URIref)) then
call add_error(es, "Relative namespace in URI deprecated: "//str_vs(URIstring))
deallocate(URIstring)
call destroyURI(URIref)
return
endif
call destroyURI(URIref)
if (present(start_prefix_handler)) &
call start_prefix_handler(str_vs(URIstring), "")
call addDefaultNS(nsDict, str_vs(URIstring), ix)
deallocate(URIstring)
endif
if (namespace_prefixes) then
i = i + 1
else
call remove_key(atts, i)
endif
elseif (xmlns == 'xmlns:') then
!Prefixed namespace is being set
QName => vs_str_alloc(get_key(atts, i))
URIstring => vs_str_alloc(get_value(atts, i))
if (str_vs(URIstring)=="") then
if (xds%xml_version==XML1_0) then
call add_error(es, "Empty nsURI is invalid in XML 1.0")
deallocate(URIstring)
deallocate(QName)
return
elseif (xds%xml_version==XML1_1) then
call addPrefixedNS(nsDict, str_vs(QName(7:)), invalidNS, ix, xds, es=es)
if (in_error(es)) then
deallocate(URIstring)
deallocate(QName)
return
elseif (present(end_prefix_handler)) then
call end_prefix_handler(str_vs(QName(7:)))
endif
deallocate(URIstring)
deallocate(QName)
endif
else
URIref => parseURI(str_vs(URIstring))
if (.not.associated(URIref)) then
call add_error(es, "Invalid URI: "//str_vs(URIstring))
deallocate(URIstring)
deallocate(QName)
return
elseif (.not.hasScheme(URIref)) then
call add_error(es, "Relative namespace in URI deprecated: "//str_vs(URIstring))
deallocate(URIstring)
deallocate(QName)
call destroyURI(URIref)
return
endif
call destroyURI(URIref)
call addPrefixedNS(nsDict, str_vs(QName(7:)), str_vs(URIstring), ix, xds, es=es)
if (in_error(es)) then
deallocate(URIstring)
deallocate(QName)
return
elseif (present(start_prefix_handler)) then
call start_prefix_handler(str_vs(URIstring), str_vs(QName(7:)))
endif
deallocate(URIstring)
deallocate(QName)
endif
if (namespace_prefixes) then
i = i + 1
else
call remove_key(atts, i)
endif
else
! we only increment if we haven't removed a key
i = i + 1
endif
enddo
! having done that, now resolve all attribute namespaces:
do i = 1, getLength(atts)
QName => vs_str_alloc(get_key(atts,i))
n = index(str_vs(QName), ":")
if (n > 0) then
if (str_vs(QName(1:n-1))=="xmlns") then
! FIXME but this can be controlled by SAX configuration xmlns-uris
if (xmlns_uris) then
call set_nsURI(atts, i, "http://www.w3.org/2000/xmlns/")
else
call set_nsURI(atts, i, "")
endif
else
if (str_vs(QName(1:n-1))=="xml") then
call set_nsURI(atts, i, "http://www.w3.org/XML/1998/namespace")
elseif (getnamespaceURI(nsDict, str_vs(QName(1:n-1)))==invalidNS) then
! Sometimes we don't want to worry about unbound prefixes,
! eg if we are in the middle of parsing an entity.
if (.not.partial) then
call add_error(es, "Unbound namespace prefix")
deallocate(QName)
return
else
call set_nsURI(atts, i, "")
endif
else
call set_nsURI(atts, i, getnamespaceURI(nsDict, str_vs(QName(1:n-1))))
endif
endif
else
if (xmlns_uris.and.str_vs(QName)=="xmlns") then
call set_nsURI(atts, i, "http://www.w3.org/2000/xmlns/")
else
call set_nsURI(atts, i, "") ! no such thing as a default namespace on attributes
endif
endif
! Check for duplicates
if (hasKey(atts, getnamespaceURI(nsDict, str_vs(QName(1:n-1))), str_vs(QName(n+1:)))) then
call add_error(es, "Duplicate attribute names after namespace processing")
deallocate(QName)
return
endif
call set_localName(atts, i, QName(n+1:))
deallocate(QName)
enddo
end subroutine checkNamespaces
subroutine checkNamespacesWriting(atts, nsdict, ix)
type(dictionary_t), intent(inout) :: atts
type(namespaceDictionary), intent(inout) :: nsDict
integer, intent(in) :: ix
! Read through a list of attributes, check with currently
! active namespaces & add any necessary declarations
integer :: i, i_p, l_d, l_ps, n
n = getLength(atts) ! we need the length before we fiddle with it
!Does the default NS need added?
l_d = ubound(nsDict%defaults,1)
if (nsDict%defaults(l_d)%ix == ix) then
!It's not been registered yet:
call add_item_to_dict(atts, "xmlns", &
str_vs(nsDict%defaults(l_d)%URI), type="CDATA")
endif
!next, add any overdue prefixed NS's in the same way:
! there should only ever be one. More would be an error,
! but the check should have been done earlier.
do i_p = 0, ubound(nsDict%prefixes, 1)
l_ps = ubound(nsDict%prefixes(i_p)%urilist,1)
if (nsDict%prefixes(i_p)%urilist(l_ps)%ix == ix) then
call add_item_to_dict(atts, &
"xmlns:"//str_vs(nsDict%prefixes(i_p)%prefix), &
str_vs(nsDict%prefixes(i_p)%urilist(l_ps)%URI), &
type="CDATA")
endif
enddo
!Finally, we may have some we've added for attribute QNames
! have to get those too:
do i = 1, getLength(atts)
! get prefix, and identify the relevant NS mapping
i_p = getPrefixIndex(nsDict, get_prefix(atts, i))
l_ps = ubound(nsDict%prefixes(i_p)%urilist,1)
!If the index is greater than what it should be:
if (nsDict%prefixes(i_p)%urilist(l_ps)%ix > ix) then
!we only just added this, so we need to declare it
call add_item_to_dict(atts, "xmlns:"//get_prefix(atts, i), &
str_vs(nsDict%prefixes(i_p)%urilist(l_ps)%URI), &
type="CDATA")
!Reset the index to the right value:
nsDict%prefixes(i_p)%urilist(l_ps)%ix = ix
endif
enddo
end subroutine checkNamespacesWriting
subroutine checkEndNamespaces(nsDict, ix, end_prefix_handler)
type(namespaceDictionary), intent(inout) :: nsDict
integer, intent(in) :: ix
optional :: end_prefix_handler
interface
subroutine end_prefix_handler(prefix)
character(len=*), intent(in) :: prefix
end subroutine end_prefix_handler
end interface
integer :: l_d, l_p, l_ps, i
character, pointer :: prefix(:)
!It will only ever be the final elements in the list which
! might have expired.
l_d = ubound(nsDict%defaults,1)
do while (nsDict%defaults(l_d)%ix == ix)
if (present(end_prefix_handler)) &
call end_prefix_handler("")
call removeDefaultNS(nsDict)
l_d = ubound(nsDict%defaults,1)
enddo
l_p = ubound(nsDict%prefixes, 1)
i = 1
do while (i <= l_p)
l_ps = ubound(nsDict%prefixes(l_p)%urilist,1)
if (nsDict%prefixes(i)%urilist(l_ps)%ix == ix) then
if (present(end_prefix_handler)) &
call end_prefix_handler(str_vs(nsDict%prefixes(i)%prefix))
! We have to assign this pointer explicitly, otherwise the next call
! aliases its arguments illegally.
prefix => nsDict%prefixes(i)%prefix
call removePrefixedNS(nsDict, prefix)
if (l_p > ubound(nsDict%prefixes, 1)) then
! we just removed the last reference to that prefix,
! so our list of prefixes has shrunk - update the running total.
! and go to the next prefix, which is at the same index
l_p = l_p - 1
cycle
endif
endif
i = i + 1
enddo
end subroutine checkEndNamespaces
subroutine dumpnsdict(nsdict)
type(namespaceDictionary), intent(in) :: nsdict
integer :: i, j
write(*,'(a)')'* default namespaces *'
do i = 1, ubound(nsdict%defaults, 1)
write(*,'(i0,a)') nsdict%defaults(i)%ix, str_vs(nsdict%defaults(i)%URI)
enddo
write(*,'(a)') '* Prefixed namespaces *'
do i = 1, ubound(nsdict%prefixes, 1)
write(*,'(2a)') '* prefix: ', str_vs(nsdict%prefixes(i)%prefix)
do j = 1, ubound(nsdict%prefixes(i)%urilist, 1)
write(*,'(i0,a)') nsdict%prefixes(i)%urilist(j)%ix, str_vs(nsdict%prefixes(i)%urilist(j)%URI)
enddo
enddo
end subroutine dumpnsdict
pure function getURIofDefaultNS(nsDict) result(uri)
type(namespaceDictionary), intent(in) :: nsDict
character(len=size(nsDict%defaults(ubound(nsDict%defaults,1))%URI)) :: URI
integer :: l_d
l_d = ubound(nsDict%defaults,1)
uri = str_vs(nsDict%defaults(l_d)%URI)
end function getURIofDefaultNS
pure function isPrefixInForce(nsDict, prefix) result(force)
type(namespaceDictionary), intent(in) :: nsDict
character(len=*), intent(in) :: prefix
logical :: force
integer :: i, l_s
force = .false.
do i = 1, ubound(nsDict%prefixes, 1)
if (str_vs(nsDict%prefixes(i)%prefix) == prefix) then
l_s = ubound(nsDict%prefixes(i)%urilist, 1)
force = (size(nsdict%prefixes(i)%urilist(l_s)%URI) > 0)
exit
endif
enddo
end function isPrefixInForce
pure function isDefaultNSInForce(nsDict) result(force)
type(namespaceDictionary), intent(in) :: nsDict
logical :: force
integer :: l_s
force = .false.
l_s = ubound(nsDict%defaults, 1)
if (l_s > 0) &
force = (size(nsdict%defaults(l_s)%URI) > 0)
end function isDefaultNSInForce
pure function getPrefixIndex(nsDict, prefix) result(p)
type(namespaceDictionary), intent(in) :: nsDict
character(len=*), intent(in) :: prefix
integer :: p
integer :: i
p = 0
do i = 1, ubound(nsDict%prefixes, 1)
if (str_vs(nsDict%prefixes(i)%prefix) == prefix) then
p = i
exit
endif
enddo
end function getPrefixIndex
function getNumberOfPrefixes(nsDict) result(n)
type(namespaceDictionary), intent(in) :: nsDict
integer :: n
n = ubound(nsDict%prefixes, 1)
end function getNumberOfPrefixes
function getPrefixByIndex(nsDict, i) result(c)
type(namespaceDictionary), intent(in) :: nsDict
integer, intent(in) :: i
character(len=size(nsDict%prefixes(i)%prefix)) :: c
c = str_vs(nsDict%prefixes(i)%prefix)
end function getPrefixByIndex
pure function getURIofPrefixedNS(nsDict, prefix) result(uri)
type(namespaceDictionary), intent(in) :: nsDict
character(len=*), intent(in) :: prefix
character(len=size( &
nsDict%prefixes( &
getPrefixIndex(nsDict,prefix) &
) &
%urilist( &
ubound(nsDict%prefixes(getPrefixIndex(nsDict,prefix))%urilist, 1) &
) &
%uri)) :: URI
integer :: p_i, l_m
p_i = getPrefixIndex(nsDict, prefix)
l_m = ubound(nsDict%prefixes(p_i)%urilist, 1)
uri = str_vs(nsDict%prefixes(p_i)%urilist(l_m)%URI)
end function getURIofPrefixedNS
#endif
end module m_common_namespaces