Development checkpoint: compiles but incomplete. Prep for unit test dev

(: =====================================================

   DITA Utilities

   Provides XQuery functions for working with DITA documents,
   including resolving keys and key references, hrefs,
   getting topic navigation titles, etc.

   Author: W. Eliot Kimber

   Copyright (c) 2014, 2015 DITA For Small Teams
   Licensed under Apache License 2

   ===================================================== :)

module namespace df="http://dita-for-small-teams.org/xquery/modules/dita-utils";

import module namespace relpath="http://dita-for-small-teams.org/xquery/modules/relpath-utils";
import module namespace bxutil="http://dita-for-small-teams.org/xquery/modules/basex-utils";

(: Returns true if the specified element is of the specified DITA class.

   Handles the case of a failure to include the trailing space in the @class
   value (this was a bug in MarkLogic 3 in that it did not preserve trailing
   space in #CDATA attributes, corrected in MarkLogic 4).

   elem      - The element to test the class of.
   classSpec - A module/tagname pair, without spaces, e.g. "topic/p"

:)
declare function df:class($elem as element(), $classSpec as xs:string) as xs:boolean {
  (: Refinement from Bob Thomas :)
  let $result := matches($elem/@class, concat(' ', normalize-space($classSpec), ' |\$'))
  return $result
};

(: Gets the base class name of the context element, e.g. "topic/p" :)
 declare function df:getBaseClass($context as element()) as xs:string {
    (: @class value is always "- foo/bar fred/baz " or "+ foo/bar fred/baz " :)
    let $result as xs:string :=
      normalize-space(tokenize($context/@class, ' ')[2])
    return $result
};

declare function df:getHtmlClass($context as element()) as xs:string {
  let $result := if ($context/@outputclass)
                    then string($context/@outputclass)
                    else name($context)
  return $result
};

(: Gets the navigation title for a topic. If there is a navtitle title alternative,
   returns it, otherwise returns the topic's title.

 :)
declare function df:getNavtitleForTopic($topic as element()) as node()* {
   let $navtitle := if ($topic/*[df:class(., 'topic/titlealts')]/*[df:class(., 'topic/navtitle')])
                       then $topic/*[df:class(., 'topic/titlealts')]/*[df:class(., 'topic/navtitle')]/node()
                       else $topic/*[df:class(., 'topic/title')]/node()
   return $navtitle
};

(: Get all the DITA maps in the specified collection :)
declare function df:getMaps($collectionSpec as xs:string) as document-node()* {
  for $doc in collection($collectionSpec) where $doc[contains(/*/@class, ' map/map ')]
      return $doc
};

(: Get all the DITA topic documents in the specified collection, that is,
 : documents whose root element is of type topic/topic or <dita>
 :)
declare function df:getTopicDocs($collectionSpec as xs:string) as document-node()* {
  for $doc in collection($collectionSpec) where $doc[contains(/*/@class, ' topic/topic ') or /*/self::dita]
      return $doc
};

(: Get the title text for the specified element where the element is expected to have topic/title direct child
   Simply returns the text nodes of the title, filtering out elements that don't normally show up in output
   (<data>, <indexterm>, etc.)
:)
declare function df:getTitleText($elem as element()) as xs:string {
   let $title := df:getTitleElement($elem)
   (: FIXME: Implement the filtering, which needs to be a general function :)
   return string($title)
};

(: Get the title element for the specified element where the element is expected to have topic/title direct child :)
declare function df:getTitleElement($elem as element()) as element()? {
   ($elem/*[df:class(., 'topic/title')])[1]
};

(:~
 : Gets the effective value of the attribute, applying DITA-defined default
 : value rules when the attribute does not have a value.
 :
 :)
declare function df:getEffectiveAttributeValue($elem as element(), $attName as xs:string) as xs:string {
   let $att := $elem/@*[name(.) = $attName]
   return
     if ($att)
        then string($att)
        else (: Determined the implicit default, if any :)
         switch ($attName)
          case 'scope' return 'local'
          case 'format' return 'dita'
          default return ''

};

(:~
 : Resolve a topicref to its target topic or map element.
 :
 : Topicref must be a peer or local-scope topicref to a topic
 : or map.
 :
 : Returns the reference element or a <df:error> element if there
 : was some error.
 :
 : Returns empty sequence if the @scope is not
 : peer or local or @format is not dita or ditamap.
 :)
declare function df:resolveTopicRef($topicref as element()) as element()? {
   let $map as document-node() := root($topicref)
   let $format  as xs:string?  := df:getEffectiveAttributeValue($topicref, 'format')
   let $href  as xs:string?    := string($topicref/@href)
   let $keyref as xs:string?   := string($topicref/@keyref)
   let $scope as xs:string?    := df:getEffectiveAttributeValue($topicref, 'scope')

   return if (not(df:class($topicref, 'map/topicref')))
      then <df:error type="not-topicref" xmlns:df="http://dita-for-small-teams.org/xquery/modules/dita-utils">resolveTopicRef(): Element {name($topicref)} is not of class 'map/topicref', class is "{string($topicref/@class)}"</df:error>
      else (: It's a topicref, check the @format value:)
        if (not($format = ('dita', 'ditamap')) or
            ($scope != '' and (not($scope = ('local', 'peer')))))
           then <df:warn>Not format of 'dita' or 'ditamap' or not local or peer scope </df:warn>
           else
             let $targetUri as xs:string := df:getEffectiveTargetUri($topicref)
             let $targetFragId as xs:string :=
                 if (contains($topicref/@href, '#'))
                    then substring-after($topicref/@href, '#')
                    else ''
             return if ($targetUri = '' and $targetFragId = '')
                then ()
                else df:resolveTopicOrMapUri($topicref, $targetUri)

};

declare function df:resolveTopicOrMapUri($topicref as element(), $targetUri as xs:string)
   as element()? {
   let $targetResourcePart as xs:string :=
     if (contains($targetUri, '#'))
        then substring-before($targetUri, '#')
        else $targetUri
   let $topicFragId as xs:string :=
     if (contains($targetUri, '#'))
        then substring-after($targetUri, '#')
        else ''
   let $targetDoc :=
      if ($targetResourcePart != '')
         then
           let $baseUri := base-uri($topicref)
           let $resolvedUri :=
               if (not(starts-with($baseUri, '/')))
                  then (: Handle BaseX way of managing document URLs :)
                     let $parentUri := relpath:getParent($baseUri)
                     return relpath:newFile($parentUri, $targetResourcePart)
                  else resolve-uri($targetResourcePart, $baseUri)
           return doc($resolvedUri)
         else root($topicref)
   return
     if ($targetDoc/*[df:class(., 'topic/topic') or df:class(., 'topic/topic')] )
        then $targetDoc/*[1]
        else if ($targetDoc/*/*[df:class(., 'topic/topic')])
          then $targetDoc/*/*[df:class(., 'topic/topic')][1]
          else $targetDoc/*
 };

(: Give a topicref, return the effective URI of the ultimate target
 : of the topicref.
 :)
declare function df:getEffectiveTargetUri($refElem as element()) as xs:string {
  df:getEffectiveTargetUri(root($refElem)/*, $refElem)
};

(: Give a topicref, return the effective URI of the ultimate target
 : of the topicref.
 :)
declare function df:getEffectiveTargetUri($rootMap, $refElem as element()) as xs:string {
   let $effectiveUri :=
       if ($refElem/@keyref != '')
          then df:getEffectiveUriForKeyref($rootMap, $refElem)
          else string($refElem/@href)
   let $baseUri := relpath:getResourcePartOfUri($effectiveUri)
   let $fragId := relpath:getFragmentId($effectiveUri)
   let $resultBase :=
      if (string($refElem/@copy-to) != '' and not(df:inChunk($refElem)))
         then (: Copy-to in effect, not in a chunk :)
            let $copyTo as xs:string := $refElem/@copy-to
            let $fullUri as xs:string := string(resolve-uri($copyTo, base-uri($refElem)))
            return relpath:getRelativePath(relpath:getParent(base-uri($refElem)), $fullUri)
         else $baseUri
   return $resultBase

};

(:~
 : Given an element with a @keyref attribute, returns
 : the URI of the ultimate resource bound to the referenced
 : key, as defined in the specified root map (note, the map
 : needs to be a resolved map).
 :)
declare function df:getEffectiveUriForKeyref($rootMap, $refElem) as xs:string? {
   let $keyref as xs:string := string($refElem/@keyref)
   let $keyname as xs:string := if (contains($keyref, '/'))
        then tokenize($keyref, '/')[1]
        else $keyref
   (: At this point, need to look up the key reference in the
      the appropriate key space.

    :)
   return "key resolution not yet implemented"
};

(:
 : Returns true if the topicref element points to something and
 : has a @format value of 'ditamap'
 :
 :)
declare function df:isMapRef($topicref as element()) as xs:boolean {
  df:isTopicRef($topicref) and $topicref/@format = 'ditamap'
};

declare function df:isTopicRef($topicref as element()) as xs:boolean {
  df:class($topicref, 'map/topicref') and
      (($topicref/@href and $topicref/@href != '') or
       ($topicref/@keyref and $topicref/@keyref != ''))
};

(:~
 : Gets the map tree rooted at the input map. The result tree
 : always includes the specified map.
 :
 : Returns a single <mapTree> element containing tree items
 : for the complete map tree.
 :)
declare function df:getMapTree($map as document-node()) as element(mapTree)* {
  (: The map Uri is the object ID of the map tree, meaning every map tree
     is identified by the map from which it is constructed.

   :)
  <mapTree
     mapUri="{document-uri($map)}"
     timeStamp="{fn:current-dateTime()}"
     database="{tokenize(document-uri($map), '/')[1]}"
  >
    { df:getMapTreeItem($map/*) }
  </mapTree>
};

(:~
 : Gets the map tree item for the input map. The result tree
 : always includes the specified map.
 :
 : Returns a single <treeItem> element representing the input map
 : and containing any subordinate maps.
 :)
declare function df:getMapTreeItem($mapElem as element()) as element(treeItem)* {
   let $label := if ($mapElem) then df:getTitleText($mapElem)
                           else "Failed to resolve reference to map "
   return <treeItem>
            <label>{$label}</label>
            <properties>
              <property name="maptype">{name($mapElem)}</property>
              <property name="uri">{document-uri(root($mapElem))}</property>
            </properties>
            <children>
              {df:getMapTreeItems($mapElem)}
            </children>
          </treeItem>
};

(:~
 : Get the tree of maps descending from a root map
 :
 : The result is returned a sequence of treeItem elements.
 :)
declare function df:getMapTreeItems($map as element()) as element(treeItem)* {
   let $maprefs := $map//*[df:isMapRef(.)]
   for $mapref in $maprefs
       let $mapElem := df:resolveTopicRef($mapref)
       return df:getMapTreeItem($mapElem)
};

(:~
 : Returns true if the context topicref is within
 : the context of a topicref that generates a new content
 : chunk (e.g., chunk="to-content select-branch").
 :)
 declare function df:inChunk($context) as xs:boolean {
   let $nearestChunkSpecifier as element()? := $context/ancestor::*[@chunk != ''][1]
   let $chunkSpec as xs:string := $nearestChunkSpecifier/@chunk
   let $result :=
       contains($chunkSpec, 'to-content') and
              (contains($chunkSpec, 'select-branch') or
               contains($chunkSpec, 'select-document'))
   return $result
};

declare function df:getMapDocForTreeItem($treeItem as element(treeItem)) as document-node()? {
   let $mapUri := string($treeItem/properties/property[@name = 'uri'])
   return document { <map/> }
   (:
   let $map := doc($mapUri)
   return $map
   :)
};

(:~
 : Constructs the key spaces root at the specified map document.
 :
 : Returns a single <keySpaceSet> element containing the key
 : spaces defined by the map.
 :)
declare function df:constructKeySpaces($map as document-node()) as element(keySpaceSet) {
  (: The map Uri is the object ID of the key space, meaning every key space
     is identified by the map from which it is constructed and the fully-qualified
     key scope.

   :)
   let $mapTree := df:getMapTree($map)
   let $keySpaces := df:constructKeySpacesForMapTree($mapTree)
   let $keySpaceSet := <keySpaceSet
       mapUri="{document-uri($map)}"
       timeStamp="{current-dateTime()}">
       {
         df:serializeKeySpacesMap($keySpaces)
       }
   </keySpaceSet>
   return $keySpaceSet
};

declare function df:serializeKeySpacesMap($keySpaces) as element(keySpace)* {
  (: The key spaces map is a map of scope names to key spaces.
     Each key space is a map of key names to key bindings.
     Each key bindings is a sequence of key definitions for a given
     key name.
     :)

  for $keyScopeName in map:keys($keySpaces)
      let $keySpace := map:get($keySpaces, $keyScopeName)
      return <keySpace scopeName="{$keyScopeName}">{
        for $keyName in map:keys($keySpace)
            return df:serializeKeyBindings($keyName, map:get($keySpace, $keyName))
            }</keySpace>
};

declare function df:serializeKeyBindings($keyName as xs:string, $keyBindings) as element()* {
  (:
     A key bindings is a sequence of key definitions,
     where each key definition is a map of property names to values:
     - key name: the key name
     - resource URI: The URI of the resource the key is bound to (if any)
     - key-definition element: the topicref element
         that is the data source for the key definition.
  :)
  <keyBindings keyName="{$keyName}">{
    for $keyBinding in $keyBindings
        return df:serializeKeyBinding($keyBinding)
  }</keyBindings>
};

declare function df:serializeKeyBinding($keyBinding) as element()* {
(: Each key binding is:
     - key name: the key name
     - resource URI: The URI of the resource the key is bound to (if any)
     - key-definition element: the topicref element
         that is the data source for the key definition.
     - Note that for resources of format "dita" and "ditamap"
       the resource will be a topic or map respectively.
       All other formats are non-DITA resources.
:)
  <keyBinding
    keyName="{map:get($keyBinding, 'keyName')}"
    resourceURI="{map:get($keyBinding, 'resourceURI')}"
    format="{map:get($keyBinding, 'format')}"
  >
    <topicref>{map:get($keyBinding, 'topicref')}</topicref>
  </keyBinding>
};

(:~
 : Constructs the key spaces for a map tree
 :
 : Returns a sequence of key spaces maps, one for the root (anonymous) key space,
 : one for each key scope defined in the map.
 :)
declare function df:constructKeySpacesForMapTree($mapTree as element(mapTree)) {
  (: Walk the map tree, using a breadth-first traveral per the DITA key space construction
     rules. Build up the key spaces from each map. There is a always a root key space anchored
     at the root map.

   :)
  let $rootMapItem := $mapTree/* (: The root map of the tree :)
  let $mapDoc := df:getMapDocForTreeItem($rootMapItem)

  (: There is always an anonymous root key space, represented
     by the scope name "#root" in this implementation.

     Thus every map tree has at least one, possibly empty,
     key space.

     Any key space may be empty: declaring a key scope on any
     map or topicref establishes the space independent of there
     being any keys defined within the scope.

     Finally, the identify of a key space is the root map
     and fully-qualified key scope name.

     Per the DITA spec, scope names are separated by "." (period)
     to construct qualified scope names.

     Note also that a key name may itself contain "." characters:
     there is no syntactic distinction between a scope-qualified
     key name and a key name that happens to include a ".". This
     allows higher-level key spaces to override keys from descendant
     key scopes.
     :)

  (: FIXME: actually walk the map tree :)
  let $keySpaces := df:constructKeySpacesForMap(
                     $mapDoc,
                     (map { '#root' : map {} }))
  return $keySpaces
};

(:~
 : Constructs the key spaces for a single map
 :
 : Returns a sequence of key spaces reflecting
 : the key spaces descending from this map and
 : updates to any ancestor key spaces.
 :)
declare function df:constructKeySpacesForMap(
                      $mapDoc as document-node(), (: Map document to get key scopes and definitions from :)
                      $keySpaces (: Array of ancestor key spaces, where each member of the array is
                                    a sequence of key space maps, one for each key space defined at
                                    that level in the key space hierarchy. The array is ordered from
                                    hightest (item 1 is always the root key spaces) to nearest.
                                    :)
                    ) {

   (: Walk the map's element tree in depth-first order and
      process those topicrefs that define new key scopes or
      define key bindings, or both.

    :)

   (: If the map element specifies @keyscope then those key scope names are added to the
      list of active key scopes. In particular a topicref to a map that specifies a key
      scope and the map's key scopes are treated as though all the key scope names had
      been specified on either the topicref alone.
    :)
    let $activeKeyScopes := ($keySpaces,
         for $scopeName in tokenize($mapDoc/*/@keyscope, ' ')
             return map { $scopeName :
                          () (: FIXME: Fill this in :)
                        })
(:
    let $resultKeySpaceSet :=
        for $topicRef in $mapDoc/*/*[df:class(., 'map/topicref')]
            return df:constructKeySpacesForTopicref(
                       $topicRef,
                       $keySpaceSet,
                       $activeKeyScopes)
    return $resultKeySpaceSet
    :)
           (: Result map for a key space with no scopes other than the root scope:
           :)
      return
           map { '#root' :
                 map { 'key01' :
                        (map { 'keyName' : 'key01',
                               'topicref' : <topicref keys="key01"/>,
                               'resourceURI' : '',
                               'format' : '#undefined'
                             },
                         map { 'keyName' : 'key01',
                               'topicref' : <topicref keys="key01 keyxxx"/>,
                               'resourceURI' : 'foo/bar',
                               'format' : 'jpg'
                             }
                         ),
                         'key02' :
                         (map { 'keyName' : 'key02',
                               'topicref' : <topicref keys="key02"/>,
                               'resourceURI' : 'docs/topics/topic-01.dita',
                               'format' : 'dita'
                         })}}
            (: :)
};

(:~
 : Constructs the key spaces for a topicref.
 :
 : A topicref can define zero more key scopes and zero or more key names bound to the
 : topicref's resource or subelements (or both).
 :
 : topicRef    : A topicref
 : keySpaceSet : A map of key scope names to key spaces.
 : keyScopes   : List of names of the currently-active key scopes of which the topicrefs are members.
 :
 : Returns : An updated keySpaceSet reflecting the new key spaces and key definitions.
 :)
declare function df:constructKeySpacesForTopicref(
             $topicRef as element(),
             $keySpaceSet,
             $keyScopes as xs:string+) {

   let $activeKeyScopes := ($keyScopes, tokenize($topicRef/@keyscope, ' '))
   let $keyNames := tokenize($topicRef/@keys, ' ')
   (: If there are any key names, construct the key bindings for them:

      A key binding is the mapping between a key name and the key definition
      and resource addressed by the key definition (if any).

      The DITA spec says that each ancestor key space of a given key space includes
      scope-qualified copies of each descendant space's key definitions. This copying
      is done either literally or abstractly later when the key space is stored
      in a way that optmizes key resolution or when the key space set is serialized
      for presentation to humans.

      Note that the key definitions will be added to each active key scope.

      A key definition is a map of a key name to a set of key bindings.
   :)
   let $keyDefinitions :=
       for $keyName in $keyNames
           return map { $keyName : df:constructKeyBinding($topicRef, $keyName)}
   let $resultKeySpaceSet :=
       for $keyScopeName in $keyScopes
           return df:addKeyDefinitionsToKeySpaces(
                      $keyDefinitions,
                      $keySpaceSet,
                      $keyScopes)
   return $resultKeySpaceSet

};

(:~
 : Takes a set of key definition maps and adds them to each of the active key
 : spaces.
 :
 : Returns a new key space set reflecting the updated key scopes.
 :)
declare function df:addKeyDefinitionsToKeySpaces(
           $keyDefinitions, (: Sequence of key definition maps :)
           $keySpaceSet, (: Key space set map :)
           $keyScopes as xs:string+) {
(: Each key space is a map of a key space name to
   a sequence of key definition maps.
 :)
     let $keyDefinitions :=
       for $keyScopeName in $keyScopes
           let $keyScope := map:get($keySpaceSet, $keyScopeName)
           return () (: FIXME: Implement :)
     return $keyDefinitions
};

(:~
 : Constructs a single key-name-to-topicref-and-resource binding map.
 :
 : map { 'keyName' : 'key01',
 :       'topicref' : <topicref keys="key01"/>,
 :       'resourceURI' : '',
 :       'format' : '#undefined',
 :       'scope'  : 'local',
 :       'targetResource' : {topicref or map element}, Ultimately-addressed resource
 :       'resolutionStatus' : 'pending' | 'resolved' | 'failed: {reason}'
 :     }
 :
 :)
declare function df:constructKeyBinding($topicRef as element(), $keyName as xs:string) {

  let $format := df:getEffectiveAttributeValue($topicRef, 'format')
  let $scope := df:getEffectiveAttributeValue($topicRef, 'scope')
  let $targetResource :=
      if (not($topicRef/@keyref))
         then df:resolveTopicRef($topicRef)
         else ()
  let $resolutionStatus :=
      if ($topicRef/@keyref)
         then 'pending'
         else if ($targetResource)
                 then 'resolved'
                 else 'failed: URI not resolved'
   return map { 'keyName' : $keyName,
                 'topicref' : $topicRef,
                 'resourceURI' : string(@href),
                 'format' : $format,
                 'scope'  : $scope,
                 'targetResource' : $targetResource,
                 'resolutionStatus' : $resolutionStatus
              }
};

(: ============== End of Module =================== :)

(: =====================================================

   DITA Utilities

   Provides XQuery functions for working with DITA documents,
   including resolving keys and key references, hrefs,
   getting topic navigation titles, etc.

   Author: W. Eliot Kimber

   Copyright (c) 2014, 2015 DITA For Small Teams
   Licensed under Apache License 2

   ===================================================== :)

module namespace df="http://dita-for-small-teams.org/xquery/modules/dita-utils";

import module namespace relpath="http://dita-for-small-teams.org/xquery/modules/relpath-utils";
import module namespace bxutil="http://dita-for-small-teams.org/xquery/modules/basex-utils";

(: Returns true if the specified element is of the specified DITA class.

   Handles the case of a failure to include the trailing space in the @class
   value (this was a bug in MarkLogic 3 in that it did not preserve trailing
   space in #CDATA attributes, corrected in MarkLogic 4).

   elem      - The element to test the class of.
   classSpec - A module/tagname pair, without spaces, e.g. "topic/p"

:)
declare function df:class($elem as element(), $classSpec as xs:string) as xs:boolean {
  (: Refinement from Bob Thomas :)
  let $result := matches($elem/@class, concat(' ', normalize-space($classSpec), ' |\$'))
  return $result
};

(: Gets the base class name of the context element, e.g. "topic/p" :)
 declare function df:getBaseClass($context as element()) as xs:string {
    (: @class value is always "- foo/bar fred/baz " or "+ foo/bar fred/baz " :)
    let $result as xs:string :=
      normalize-space(tokenize($context/@class, ' ')[2])
    return $result
};

declare function df:getHtmlClass($context as element()) as xs:string {
  let $result := if ($context/@outputclass)
                    then string($context/@outputclass)
                    else name($context)
  return $result
};

(: Gets the navigation title for a topic. If there is a navtitle title alternative,
   returns it, otherwise returns the topic's title.

 :)
declare function df:getNavtitleForTopic($topic as element()) as node()* {
   let $navtitle := if ($topic/*[df:class(., 'topic/titlealts')]/*[df:class(., 'topic/navtitle')])
                       then $topic/*[df:class(., 'topic/titlealts')]/*[df:class(., 'topic/navtitle')]/node()
                       else $topic/*[df:class(., 'topic/title')]/node()
   return $navtitle
};

(: Get all the DITA maps in the specified collection :)
declare function df:getMaps($collectionSpec as xs:string) as document-node()* {
  for $doc in collection($collectionSpec) where $doc[contains(/*/@class, ' map/map ')]
      return $doc
};

(: Get all the DITA topic documents in the specified collection, that is,
 : documents whose root element is of type topic/topic or <dita>
 :)
declare function df:getTopicDocs($collectionSpec as xs:string) as document-node()* {
  for $doc in collection($collectionSpec) where $doc[contains(/*/@class, ' topic/topic ') or /*/self::dita]
      return $doc
};

(: Get the title text for the specified element where the element is expected to have topic/title direct child
   Simply returns the text nodes of the title, filtering out elements that don't normally show up in output
   (<data>, <indexterm>, etc.)
:)
declare function df:getTitleText($elem as element()) as xs:string {
   let $title := df:getTitleElement($elem)
   (: FIXME: Implement the filtering, which needs to be a general function :)
   return string($title)
};

(: Get the title element for the specified element where the element is expected to have topic/title direct child :)
declare function df:getTitleElement($elem as element()) as element()? {
   ($elem/*[df:class(., 'topic/title')])[1]
};

(:~
 : Gets the effective value of the attribute, applying DITA-defined default
 : value rules when the attribute does not have a value.
 :
 :)
declare function df:getEffectiveAttributeValue($elem as element(), $attName as xs:string) as xs:string {
   let $att := $elem/@*[name(.) = $attName]
   return
     if ($att)
        then string($att)
        else (: Determined the implicit default, if any :)
         switch ($attName)
          case 'scope' return 'local'
          case 'format' return 'dita'
          default return ''

};

(:~
 : Resolve a topicref to its target topic or map element.
 :
 : Topicref must be a peer or local-scope topicref to a topic
 : or map.
 :
 : Returns the reference element or a <df:error> element if there
 : was some error.
 :
 : Returns empty sequence if the @scope is not
 : peer or local or @format is not dita or ditamap.
 :)
declare function df:resolveTopicRef($topicref as element()) as element()? {
   let $map as document-node() := root($topicref)
   let $format  as xs:string?  := df:getEffectiveAttributeValue($topicref, 'format')
   let $href  as xs:string?    := string($topicref/@href)
   let $keyref as xs:string?   := string($topicref/@keyref)
   let $scope as xs:string?    := df:getEffectiveAttributeValue($topicref, 'scope')

   return if (not(df:class($topicref, 'map/topicref')))
      then <df:error type="not-topicref" xmlns:df="http://dita-for-small-teams.org/xquery/modules/dita-utils">resolveTopicRef(): Element {name($topicref)} is not of class 'map/topicref', class is "{string($topicref/@class)}"</df:error>
      else (: It's a topicref, check the @format value:)
        if (not($format = ('dita', 'ditamap')) or
            ($scope != '' and (not($scope = ('local', 'peer')))))
           then <df:warn>Not format of 'dita' or 'ditamap' or not local or peer scope </df:warn>
           else
             let $targetUri as xs:string := df:getEffectiveTargetUri($topicref)
             let $targetFragId as xs:string :=
                 if (contains($topicref/@href, '#'))
                    then substring-after($topicref/@href, '#')
                    else ''
             return if ($targetUri = '' and $targetFragId = '')
                then ()
                else df:resolveTopicOrMapUri($topicref, $targetUri)

};

declare function df:resolveTopicOrMapUri($topicref as element(), $targetUri as xs:string)
   as element()? {
   let $targetResourcePart as xs:string :=
     if (contains($targetUri, '#'))
        then substring-before($targetUri, '#')
        else $targetUri
   let $topicFragId as xs:string :=
     if (contains($targetUri, '#'))
        then substring-after($targetUri, '#')
        else ''
   let $targetDoc :=
      if ($targetResourcePart != '')
         then
           let $baseUri := base-uri($topicref)
           let $resolvedUri :=
               if (not(starts-with($baseUri, '/')))
                  then (: Handle BaseX way of managing document URLs :)
                     let $parentUri := relpath:getParent($baseUri)
                     return relpath:newFile($parentUri, $targetResourcePart)
                  else resolve-uri($targetResourcePart, $baseUri)
           return doc($resolvedUri)
         else root($topicref)
   return
     if ($targetDoc/*[df:class(., 'topic/topic') or df:class(., 'topic/topic')] )
        then $targetDoc/*[1]
        else if ($targetDoc/*/*[df:class(., 'topic/topic')])
          then $targetDoc/*/*[df:class(., 'topic/topic')][1]
          else $targetDoc/*
 };

(: Give a topicref, return the effective URI of the ultimate target
 : of the topicref.
 :)
declare function df:getEffectiveTargetUri($refElem as element()) as xs:string {
  df:getEffectiveTargetUri(root($refElem)/*, $refElem)
};

(: Give a topicref, return the effective URI of the ultimate target
 : of the topicref.
 :)
declare function df:getEffectiveTargetUri($rootMap, $refElem as element()) as xs:string {
   let $effectiveUri :=
       if ($refElem/@keyref != '')
          then df:getEffectiveUriForKeyref($rootMap, $refElem)
          else string($refElem/@href)
   let $baseUri := relpath:getResourcePartOfUri($effectiveUri)
   let $fragId := relpath:getFragmentId($effectiveUri)
   let $resultBase :=
      if (string($refElem/@copy-to) != '' and not(df:inChunk($refElem)))
         then (: Copy-to in effect, not in a chunk :)
            let $copyTo as xs:string := $refElem/@copy-to
            let $fullUri as xs:string := string(resolve-uri($copyTo, base-uri($refElem)))
            return relpath:getRelativePath(relpath:getParent(base-uri($refElem)), $fullUri)
         else $baseUri
   return $resultBase

};

(:~
 : Given an element with a @keyref attribute, returns
 : the URI of the ultimate resource bound to the referenced
 : key, as defined in the specified root map (note, the map
 : needs to be a resolved map).
 :)
declare function df:getEffectiveUriForKeyref($rootMap, $refElem) as xs:string? {
   let $keyref as xs:string := string($refElem/@keyref)
   let $keyname as xs:string := if (contains($keyref, '/'))
        then tokenize($keyref, '/')[1]
        else $keyref
   (: At this point, need to look up the key reference in the
      the appropriate key space.

    :)
   return "key resolution not yet implemented"
};

(:
 : Returns true if the topicref element points to something and
 : has a @format value of 'ditamap'
 :
 :)
declare function df:isMapRef($topicref as element()) as xs:boolean {
  df:isTopicRef($topicref) and $topicref/@format = 'ditamap'
};

declare function df:isTopicRef($topicref as element()) as xs:boolean {
  df:class($topicref, 'map/topicref') and
      (($topicref/@href and $topicref/@href != '') or
       ($topicref/@keyref and $topicref/@keyref != ''))
};

(:~
 : Gets the map tree rooted at the input map. The result tree
 : always includes the specified map.
 :
 : Returns a single <mapTree> element containing tree items
 : for the complete map tree.
 :)
declare function df:getMapTree($map as document-node()) as element(mapTree)* {
  (: The map Uri is the object ID of the map tree, meaning every map tree
     is identified by the map from which it is constructed.

   :)
  <mapTree
     mapUri="{document-uri($map)}"
     timeStamp="{fn:current-dateTime()}"
     database="{tokenize(document-uri($map), '/')[1]}"
  >
    { df:getMapTreeItem($map/*) }
  </mapTree>
};

(:~
 : Gets the map tree item for the input map. The result tree
 : always includes the specified map.
 :
 : Returns a single <treeItem> element representing the input map
 : and containing any subordinate maps.
 :)
declare function df:getMapTreeItem($mapElem as element()) as element(treeItem)* {
   let $label := if ($mapElem) then df:getTitleText($mapElem)
                           else "Failed to resolve reference to map "
   return <treeItem>
            <label>{$label}</label>
            <properties>
              <property name="maptype">{name($mapElem)}</property>
              <property name="uri">{document-uri(root($mapElem))}</property>
            </properties>
            <children>
              {df:getMapTreeItems($mapElem)}
            </children>
          </treeItem>
};

(:~
 : Get the tree of maps descending from a root map
 :
 : The result is returned a sequence of treeItem elements.
 :)
declare function df:getMapTreeItems($map as element()) as element(treeItem)* {
   let $maprefs := $map//*[df:isMapRef(.)]
   for $mapref in $maprefs
       let $mapElem := df:resolveTopicRef($mapref)
       return df:getMapTreeItem($mapElem)
};

(:~
 : Returns true if the context topicref is within
 : the context of a topicref that generates a new content
 : chunk (e.g., chunk="to-content select-branch").
 :)
 declare function df:inChunk($context) as xs:boolean {
   let $nearestChunkSpecifier as element()? := $context/ancestor::*[@chunk != ''][1]
   let $chunkSpec as xs:string := $nearestChunkSpecifier/@chunk
   let $result :=
       contains($chunkSpec, 'to-content') and
              (contains($chunkSpec, 'select-branch') or
               contains($chunkSpec, 'select-document'))
   return $result
};

declare function df:getMapDocForTreeItem($treeItem as element(treeItem)) as document-node()? {
   let $mapUri := string($treeItem/properties/property[@name = 'uri'])
   return document { <map/> }
   (:
   let $map := doc($mapUri)
   return $map
   :)
};

(:~
 : Constructs the key spaces root at the specified map document.
 :
 : Returns a single <keySpaceSet> element containing the key
 : spaces defined by the map.
 :)
declare function df:constructKeySpaces($map as document-node()) as element(keySpaceSet) {
  (: The map Uri is the object ID of the key space, meaning every key space
     is identified by the map from which it is constructed and the fully-qualified
     key scope.

   :)
   let $mapTree := df:getMapTree($map)
   let $keySpaces := df:constructKeySpacesForMapTree($mapTree)
   let $keySpaceSet := <keySpaceSet
       mapUri="{document-uri($map)}"
       timeStamp="{current-dateTime()}">
       {
         df:serializeKeySpacesMap($keySpaces)
       }
   </keySpaceSet>
   return $keySpaceSet
};

declare function df:serializeKeySpacesMap($keySpaces) as element(keySpace)* {
  (: The key spaces map is a map of scope names to key spaces.
     Each key space is a map of key names to key bindings.
     Each key bindings is a sequence of key definitions for a given
     key name.
     :)

  for $keyScopeName in map:keys($keySpaces)
      let $keySpace := map:get($keySpaces, $keyScopeName)
      return <keySpace scopeName="{$keyScopeName}">{
        for $keyName in map:keys($keySpace)
            return df:serializeKeyBindings($keyName, map:get($keySpace, $keyName))
            }</keySpace>
};

declare function df:serializeKeyBindings($keyName as xs:string, $keyBindings) as element()* {
  (:
     A key bindings is a sequence of key definitions,
     where each key definition is a map of property names to values:
     - key name: the key name
     - resource URI: The URI of the resource the key is bound to (if any)
     - key-definition element: the topicref element
         that is the data source for the key definition.
  :)
  <keyBindings keyName="{$keyName}">{
    for $keyBinding in $keyBindings
        return df:serializeKeyBinding($keyBinding)
  }</keyBindings>
};

declare function df:serializeKeyBinding($keyBinding) as element()* {
(: Each key binding is:
     - key name: the key name
     - resource URI: The URI of the resource the key is bound to (if any)
     - key-definition element: the topicref element
         that is the data source for the key definition.
     - Note that for resources of format "dita" and "ditamap"
       the resource will be a topic or map respectively.
       All other formats are non-DITA resources.
:)
  <keyBinding
    keyName="{map:get($keyBinding, 'keyName')}"
    resourceURI="{map:get($keyBinding, 'resourceURI')}"
    format="{map:get($keyBinding, 'format')}"
  >
    <topicref>{map:get($keyBinding, 'topicref')}</topicref>
  </keyBinding>
};

(:~
 : Constructs the key spaces for a map tree
 :
 : Returns a key space, one for the root (anonymous) key space,
 : one for each key scope defined in the map.
 :)
declare function df:constructKeySpacesForMapTree($mapTree as element(mapTree)) {
  (: Walk the map tree, using a breadth-first traveral per the DITA key space construction
     rules. Build up the key spaces from each map. There is a always a root key space anchored
     at the root map.

   :)
  let $rootMapItem := $mapTree/* (: The root map of the tree :)
  let $map := df:getMapDocForTreeItem($rootMapItem)
  let $keySpaceSet := df:constructKeySpacesForMap(
                     $map,
                     map { },
                     ('#root'))
  return $keySpaceSet
};

(:~
 : Constructs the key spaces for a single map
 :
 :
 :)
declare function df:constructKeySpacesForMap(
                    $map as document-node(),
                    $keySpaceSet,
                    $keyScopes as xs:string+) {

   (: Find the key-scope-defining elements and
      the key definitions and construct or add to the
      cooresponding key space maps.

      This might be easiest to do by simply walking
      the map element tree and accumulating scope
      context.
      :)

   let $keySpaces :=
       for $keyScope in $keyScopes
           return
           map { $keyScope :
                 map { 'key01' :
                        (map { 'keyName' : 'key01',
                               'topicref' : <topicref keys="key01"/>,
                               'resourceURI' : '',
                               'format' : '#undefined'
                             },
                         map { 'keyName' : 'key01',
                               'topicref' : <topicref keys="key01 keyxxx"/>,
                               'resourceURI' : 'foo/bar',
                               'format' : 'jpg'
                             }
                         ),
                         'key02' :
                         (map { 'keyName' : 'key02',
                               'topicref' : <topicref keys="key02"/>,
                               'resourceURI' : 'docs/topics/topic-01.dita',
                               'format' : 'dita'
                         })}}

   return $keySpaces
};

(: ============== End of Module =================== :)


[xproc] amend xquery script that process .xproc files

svn path=/trunk/eXist/; revision=12248

xquery version "1.0";

import module namespace xproc = "http://xproc.net/xproc";

declare variable $pipeline external;
declare variable $stdin    external;
declare variable $debug    external;
declare variable $bindings external;
declare variable $options  external;
declare variable $autobind  external;

let $requestparams :=
if($autobind eq '1') then
for $binding in request:get-parameter-names()
return
   if($binding eq 'stdin' or $binding eq 'debug' or $binding eq 'autobind') then
     ()
   else
  <binding port="{$binding}">
     {util:parse(request:get-parameter($binding,''))}
  </binding>

else
 ()
let $xprocbindings := <bindings>
                        {$requestparams}
                        {util:parse($bindings)//binding}
                    </bindings>

return
    xproc:run( doc($pipeline), doc($stdin), $debug, "0", $xprocbindings, util:parse($options))

xquery version "1.0";

import module namespace const = "http://xproc.net/xproc/const";
import module namespace xproc = "http://xproc.net/xproc";

declare variable $pipeline external;
declare variable $stdin    external;
declare variable $debug    external;
declare variable $bindings external;
declare variable $options  external;
declare variable $autobind  external;

let $requestparams :=
if($autobind eq '1') then
for $binding in request:get-parameter-names()
return
   if($binding eq 'stdin' or $binding eq 'debug' or $binding eq 'autobind') then
     ()
   else
  <binding port="{$binding}">
     {util:parse(request:get-parameter($binding,''))}
  </binding>

else
 ()
let $xprocbindings := <bindings>
                        {$requestparams}
                        {util:parse($bindings)//binding}
                    </bindings>

return
    xproc:run( doc($pipeline), doc($stdin), $debug, "0", $xprocbindings, util:parse($options))


Fixed bug in xf:select#1

Fixed bug in xf:select#1

xquery version "3.0";

(:~
 : Origami transformers.
 :
 : @version 0.3
 : @author Marc van Grootel
 : @see https://github.com/xokomola/origami
 :)

module namespace xf = 'http://xokomola.com/xquery/origami/xform';

(:~
 : Transforms input, using the specified templates.
 :)
declare function xf:transform($templates as map(*)*, $input as node()) as node() {
    xf:transform($templates)($input)
};

(:~
 : Returns a node transformation function.
 :)
declare function xf:transform($templates as map(*)*) as function(*) {
    function ($nodes as item()*) as item()* {
        xf:apply($nodes, $templates)
    }
};

(:~
 : Identity transformer.
 :)
declare function xf:transform() { xf:transform(()) };

(:~
 : Extracts nodes from input, using the specified selectors.
 :)
declare function xf:extract($selectors as map(*)*, $input as node()) as node() {
    xf:extract($selectors)($input)
};

(:~
 : Returns an extractor function that only returns selected nodes.
 :)
declare function xf:extract($selectors as map(*)*) as function(*) {
    function ($nodes as item()*) as item()* {
        xf:select($nodes, $selectors)
    }
};

(:~
 : Defines a template.
 :
 : A template takes a selector string or function and
 : a node transformation function or the items to return as
 : the template body.
 : Providing invalid matcher returns empty sequence.
 :)
declare function xf:template($match, $body) as map(*)? {
    let $match :=
        typeswitch ($match)
        case xs:string return xf:css-matches(?, xf:css-matcher($match))
        case function(item()) as xs:boolean return $match
        default return ()
    let $body :=
        typeswitch ($body)
        case empty-sequence() return function($node) { () }
        case function(item()) as item()* return $body
        case function(*)* return ()
        default return function($node) { $body }
    where $match instance of function(*) and $body instance of function(*)
    return
        map {
            'match': $match,
            'fn': $body
        }
};

declare function xf:select($match) as map(*)? {
    let $match :=
        typeswitch ($match)
        case xs:string return xf:css-matches(?, xf:css-matcher($match))
        case function(item()) as xs:boolean return $match
        default return ()
    where $match instance of function(*)
    return
        map {
            'match': $match,
            'fn': function($node) { $node }
        }
};

(:~
 : Copies nodes to output, and calls apply for
 : nodes that are wrapped inside <xf:apply>.
 :)
declare %private function xf:copy($nodes as item()*, $xform as map(*)*)
    as item()* {
    for $node in $nodes
    return
        if ($node/self::xf:apply) then
            xf:apply(($node/@*,$node/node()), $xform)
        else if ($node instance of element()) then
            element { node-name($node) } {
                $node/@*,
                xf:copy($node/node(), $xform)
            }
        else if ($node instance of document-node()) then
            document {
                xf:copy($node/node(), $xform)
            }
        else
            $node
};

(:~
 : Applies node transformations to nodes.
 :)
declare %private function xf:apply($nodes as item()*, $xform as map(*)*)
    as item()* {
    for $node in $nodes
    let $fn := xf:match($node, $xform)
    return
        if ($fn instance of function(*)) then
            xf:copy($fn($node), $xform)
        else if ($node instance of element()) then
            element { node-name($node) } {
                xf:apply($node/@*, $xform),
                xf:apply($node/node(), $xform)
            }
        else if ($node instance of document-node()) then
            document {
                xf:apply($node/node(), $xform)
            }
        else
            $node
};

(:~
 : Apply to be used from within templates.
 :)
declare function xf:apply($nodes as item()*)
    as element(xf:apply) {
    <xf:apply>{ $nodes }</xf:apply>
};

(:~
 : Look for nodes that match
 :)
declare %private function xf:select($nodes as item()*, $selectors as map(*)*)
    as item()* {
    for $node in $nodes
    let $fn := xf:match($node, $selectors)
    return
        if ($fn instance of function(*)) then
            xf:copy($fn($node), $selectors)
        else if ($node instance of element()) then
            xf:select($node/node(), $selectors)
        else if ($node instance of document-node()) then
            document {
                xf:select($node/node(), $selectors)
            }
        else
            ()
};

(:~
 : Find the first matching template for a node and return
 : it's node transformation function.
 :)
declare %private function xf:match($node as item(), $xform as map(*)*)
    as function(*)? {
    hof:until(
        function($templates as map(*)*) {
            let $is-match := head($templates)
            return
                empty($is-match) or
                not($is-match instance of map(*))
        },
        function($templates as map(*)*) {
            let $template := head($templates)
            return
                (
                    if ($template('match')($node)) then
                        $template('fn')
                    else
                        ()
                    ,
                    tail($templates)
                )
        },
        $xform
    )[1]
};

(:~
 : Returns true if the string expression matches the $node.
 :)
declare function xf:matches($node as item(), $expr as xs:string) as xs:boolean {
    typeswitch ($node)
    case element() return not($node/self::xf:*) and $expr = (name($node),'*')
    case attribute() return substring-after($expr, '@') = (name($node), '*')
    default return false()
};

(:~
 : Returns true if the css matcher matches the $node.
 : TODO: add class matching
 :)
declare function xf:css-matches($node as item(), $css-matcher as map(*)) as xs:boolean {
    typeswitch ($node)
    case element()
    return
        not($node/self::xf:*) and
        $css-matcher('el') = (name($node),'*') and
        ( not($css-matcher('id')) or $css-matcher('id') = $node/@id ) and
        ( not($css-matcher('att')) or $css-matcher('att') = $node/@*/name() ) and
        ( not($css-matcher('class') or $node/@class) or
            ( every $cls in $css-matcher('class')
            satisfies contains(concat(' ',$node/@class,' '), concat(' ',$cls,' ')) ))
    case attribute()
    return
        not($css-matcher('att')) or $css-matcher('att') = (name($node),'*')
    default return false()
};

(:~
 : Build a CSS style matcher map.
 : TODO: fine-tune regexp
 : TODO: make it work for multiple expressions
 :)
declare function xf:css-matcher($expr) as map(*)* {
    for $expr in tokenize($expr,'\s+')[1]
    let $parsed :=
        for $token in analyze-string($expr, '[@#.]?[^@#.]+')/fn:match
        return
            string($token)
    return
         map {
            'att': for $att in $parsed[starts-with(.,'@')][1] return substring-after($att,'@'),
            'el': $parsed[not(starts-with(.,'.') or starts-with(.,'#') or starts-with(.,'@'))],
            'class': for $cls in $parsed[starts-with(.,'.')] return substring-after($cls,'.'),
            'id': for $id in $parsed[starts-with(.,'#')][1] return substring-after($id,'#')
        }
};

xquery version "3.0";

(:~
 : Origami transformers.
 :
 : @version 0.3
 : @author Marc van Grootel
 : @see https://github.com/xokomola/origami
 :)

module namespace xf = 'http://xokomola.com/xquery/origami/xform';

(:~
 : Transforms input, using the specified templates.
 :)
declare function xf:transform($templates as map(*)*, $input as node()) as node() {
    xf:transform($templates)($input)
};

(:~
 : Returns a node transformation function.
 :)
declare function xf:transform($templates as map(*)*) as function(*) {
    function ($nodes as item()*) as item()* {
        xf:apply($nodes, $templates)
    }
};

(:~
 : Identity transformer.
 :)
declare function xf:transform() { xf:transform(()) };

(:~
 : Extracts nodes from input, using the specified selectors.
 :)
declare function xf:extract($selectors as map(*)*, $input as node()) as node() {
    xf:extract($selectors)($input)
};

(:~
 : Returns an extractor function that only returns selected nodes.
 :)
declare function xf:extract($selectors as map(*)*) as function(*) {
    function ($nodes as item()*) as item()* {
        xf:select($nodes, $selectors)
    }
};

(:~
 : Defines a template.
 :
 : A template takes a selector string or function and
 : a node transformation function or the items to return as
 : the template body.
 : Providing invalid matcher returns empty sequence.
 :)
declare function xf:template($match, $body) as map(*)? {
    let $match :=
        typeswitch ($match)
        case xs:string return xf:css-matches(?, xf:css-matcher($match))
        case function(item()) as xs:boolean return $match
        default return ()
    let $body :=
        typeswitch ($body)
        case empty-sequence() return function($node) { () }
        case function(item()) as item()* return $body
        case function(*)* return ()
        default return function($node) { $body }
    where $match instance of function(*) and $body instance of function(*)
    return
        map {
            'match': $match,
            'fn': $body
        }
};

declare function xf:select($match) as map(*)? {
    let $match :=
        typeswitch ($match)
        case xs:string return xf:css-matches(?, $match)
        case function(item()) as xs:boolean return $match
        default return ()
    where $match instance of function(*)
    return
        map {
            'match': $match,
            'fn': function($node) { $node }
        }
};

(:~
 : Copies nodes to output, and calls apply for
 : nodes that are wrapped inside <xf:apply>.
 :)
declare %private function xf:copy($nodes as item()*, $xform as map(*)*)
    as item()* {
    for $node in $nodes
    return
        if ($node/self::xf:apply) then
            xf:apply(($node/@*,$node/node()), $xform)
        else if ($node instance of element()) then
            element { node-name($node) } {
                $node/@*,
                xf:copy($node/node(), $xform)
            }
        else if ($node instance of document-node()) then
            document {
                xf:copy($node/node(), $xform)
            }
        else
            $node
};

(:~
 : Applies node transformations to nodes.
 :)
declare %private function xf:apply($nodes as item()*, $xform as map(*)*)
    as item()* {
    for $node in $nodes
    let $fn := xf:match($node, $xform)
    return
        if ($fn instance of function(*)) then
            xf:copy($fn($node), $xform)
        else if ($node instance of element()) then
            element { node-name($node) } {
                xf:apply($node/@*, $xform),
                xf:apply($node/node(), $xform)
            }
        else if ($node instance of document-node()) then
            document {
                xf:apply($node/node(), $xform)
            }
        else
            $node
};

(:~
 : Apply to be used from within templates.
 :)
declare function xf:apply($nodes as item()*)
    as element(xf:apply) {
    <xf:apply>{ $nodes }</xf:apply>
};

(:~
 : Look for nodes that match
 :)
declare %private function xf:select($nodes as item()*, $selectors as map(*)*)
    as item()* {
    for $node in $nodes
    let $fn := xf:match($node, $selectors)
    return
        if ($fn instance of function(*)) then
            xf:copy($fn($node), $selectors)
        else if ($node instance of element()) then
            xf:select($node/node(), $selectors)
        else if ($node instance of document-node()) then
            document {
                xf:select($node/node(), $selectors)
            }
        else
            ()
};

(:~
 : Find the first matching template for a node and return
 : it's node transformation function.
 :)
declare %private function xf:match($node as item(), $xform as map(*)*)
    as function(*)? {
    hof:until(
        function($templates as map(*)*) {
            let $is-match := head($templates)
            return
                empty($is-match) or
                not($is-match instance of map(*))
        },
        function($templates as map(*)*) {
            let $template := head($templates)
            return
                (
                    if ($template('match')($node)) then
                        $template('fn')
                    else
                        ()
                    ,
                    tail($templates)
                )
        },
        $xform
    )[1]
};

(:~
 : Returns true if the string expression matches the $node.
 :)
declare function xf:matches($node as item(), $expr as xs:string) as xs:boolean {
    typeswitch ($node)
    case element() return not($node/self::xf:*) and $expr = (name($node),'*')
    case attribute() return substring-after($expr, '@') = (name($node), '*')
    default return false()
};

(:~
 : Returns true if the css matcher matches the $node.
 : TODO: add class matching
 :)
declare function xf:css-matches($node as item(), $css-matcher as map(*)) as xs:boolean {
    typeswitch ($node)
    case element()
    return
        not($node/self::xf:*) and
        $css-matcher('el') = (name($node),'*') and
        ( not($css-matcher('id')) or $css-matcher('id') = $node/@id ) and
        ( not($css-matcher('att')) or $css-matcher('att') = $node/@*/name() ) and
        ( not($css-matcher('class') or $node/@class) or
            ( every $cls in $css-matcher('class')
            satisfies contains(concat(' ',$node/@class,' '), concat(' ',$cls,' ')) ))
    case attribute()
    return
        not($css-matcher('att')) or $css-matcher('att') = (name($node),'*')
    default return false()
};

(:~
 : Build a CSS style matcher map.
 : TODO: fine-tune regexp
 : TODO: make it work for multiple expressions
 :)
declare function xf:css-matcher($expr) as map(*)* {
    for $expr in tokenize($expr,'\s+')[1]
    let $parsed :=
        for $token in analyze-string($expr, '[@#.]?[^@#.]+')/fn:match
        return
            string($token)
    return
         map {
            'att': for $att in $parsed[starts-with(.,'@')][1] return substring-after($att,'@'),
            'el': $parsed[not(starts-with(.,'.') or starts-with(.,'#') or starts-with(.,'@'))],
            'class': for $cls in $parsed[starts-with(.,'.')] return substring-after($cls,'.'),
            'id': for $id in $parsed[starts-with(.,'#')][1] return substring-after($id,'#')
        }
};


Improvement in evaluation.

Improvement in evaluation.

(:
 : Copyright 2006-2011 The FLWOR Foundation.
 :
 : Licensed under the Apache License, Version 2.0 (the "License");
 : you may not use this file except in compliance with the License.
 : You may obtain a copy of the License at
 :
 : http://www.apache.org/licenses/LICENSE-2.0
 :
 : Unless required by applicable law or agreed to in writing, software
 : distributed under the License is distributed on an "AS IS" BASIS,
 : WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 : See the License for the specific language governing permissions and
 : limitations under the License.
 :)

(:~
 : Zorba FOTS driver environment
 : @author Sorin Nasoi
 :)

module namespace env =
  "http://www.zorba-xquery.com/fots-driver/environment";

import module namespace xqxq =
  "http://www.zorba-xquery.com/modules/xqxq";

import module namespace util =
  "http://www.zorba-xquery.com/fots-driver/util" at "util.xq";

declare namespace fots =
  "http://www.w3.org/2010/09/qt-fots-catalog";

declare namespace ann =
  "http://www.zorba-xquery.com/annotations";

declare namespace op = "http://www.zorba-xquery.com/options/features";
declare namespace f = "http://www.zorba-xquery.com/features";
declare option op:disable "f:trace";

declare variable $env:hof as xs:string :=
  string-join(
    ( "declare namespace op = 'http://www.zorba-xquery.com/options/features';",
      "declare namespace f = 'http://www.zorba-xquery.com/features';",
      "declare option op:enable 'f:hof';"),
    "
");

(:~
 : If there is a dependency on the HOF feature, return the text for enabling
 : the HOF feature within a query.
 :
 : @param $deps the dependencies of the test set and test case
 : @param $test the raw query text.
 : @return the text for enabling the HOF feature
 :)
declare function env:enable-HOF-feature(
  $deps as element(fots:dependency)*,
  $test as xs:string
) as xs:string?
{
  let $check :=
    some $dep in $deps
    satisfies $dep[@type eq "feature" and contains(@value, "higherOrderFunctions")]
  return
    if ($check)
    then $env:hof
    else ()
};

(:~
 : Create the text for an XQuery version declaration that must be added
 : to a test-case query.
 :
 : @param $deps the dependencies of the test set and test case.
 : @param $test the raw query text.
 : @return the text for the XQuery version declaration, if necessary; otherwise,
 :         the empty sequence.
 :)
declare function env:add-xquery-version-decl(
  $deps as element(fots:dependency)*,
  $test as xs:string
) as xs:string?
{
  let $deps := $deps[@type eq "spec"]

  let $v30 :=
    some $dep in $deps
    satisfies $dep[contains(@value, "XQ30") or contains(@value, "XP30")]

  return
    if ($v30 and not(contains($test, "xquery version")))
    then
    {
      'xquery version "3.0";'
    }
    else
    {
      let $v10 :=
        some $dep in $deps
        satisfies $dep[contains(@value, "XQ10")]
      return
        if ($v10 and not(contains($test, "xquery version ")))
        then 'xquery version "1.0";'
        else ()
    }
};

(:~
 : Retruns the text for the static-base-uri declaration that must be added
 : to a test-case query.
 :
 : NOTE: at least one of $end and $envCase is the empty sequence.
 :
 : @param $env the non-local environment of the test-case, if any. It is an
 :        enviroment specified either at the test-set level or at the catalog
 :        level and is referenced by the test-case.
 : @param $envCase the local environment of the test-case, if any.
 : @return the declare base-uri prolog statement.
 :)
declare function env:decl-base-uri(
  $env      as element(fots:environment)?,
  $envCase  as element(fots:environment)?
) as xs:string?
{
  for $baseURI in ($env/fots:static-base-uri, $envCase/fots:static-base-uri)
  return concat("declare base-uri '", $baseURI/@uri, "';")
};

(:~
 : Create the text for the default-element-namespace declaration that must be
 : added to a test-case query.
 :
 : NOTE: at least one of $end and $envCase is the empty sequence.
 :
 : @param $env the non-local environment of the test-case, if any. It is an
 :        enviroment specified either at the test-set level or at the catalog
 :        level and is referenced by the test-case.
 : @param $envCase the local environment of the test-case, if any.
 : @return the text for the default element namespace declaration.
 :)
declare function env:decl-def-elem-namespace(
  $env      as element(fots:environment)?,
  $envCase  as element(fots:environment)?
) as xs:string?
{
  for $ns in ($env/fots:namespace, $envCase/fots:namespace)
  where $ns[@prefix eq ""]
  return concat('declare default element namespace "', $ns/@uri, '";')
};

(:~
 : Create the text for the necessary namespace declarations that must be added
 : to a test-case query.
 :
 : NOTE: at least one of $end and $envCase is the empty sequence.
 :
 : @param $env the non-local environment of the test-case, if any. It is an
 :        enviroment specified either at the test-set level or at the catalog
 :        level and is referenced by the test-case.
 : @param $envCase the local environment of the test-case, if any.
 : @param $test the raw query text
 : @return the text for the namespace declarations.
 :)
declare %ann:nondeterministic function env:decl-namespaces(
  $env     as element(fots:environment)?,
  $envCase as element(fots:environment)?,
  $test    as xs:string
) as xs:string?
{
  if (($env/fots:namespace, $envCase/fots:namespace))
  then
    string-join
    (
      for $ns in ($env/fots:namespace, $envCase/fots:namespace)
      where not($ns[@prefix eq ""]) and
            not(env:is-schema-prefix-bound($ns/@prefix, $test))
      return concat('declare namespace ', $ns/@prefix, ' = "', $ns/@uri, '";')
    ,
    "
"
    )
  else
    ()
};

(:~
 : Return true if the prefix will be bound to a schema in the Query
 : It's a bug in the FOTS if this function returns true: TODO report to W3C
 :)
declare %private %ann:nondeterministic function env:is-schema-prefix-bound(
  $prefix as xs:string,
  $test   as xs:string
) as xs:boolean
{
  contains($test, concat("import schema namespace ", $prefix))
};

(:~
 : Create the text for the decimal format declarations that must be added
 : to a test-case query.
 :
 : @param $decimal-formats decimal formats.
 : @return the decimal formats declarations.
 :)
declare function env:decl-decimal-formats(
  $decimal-formats as element(fots:decimal-format)*
) as xs:string*
{
  if (empty($decimal-formats))
  then
    ()
  else
    for $tmp in $decimal-formats
    let $default := if ($tmp/@name)
                    then ()
                    else "default"
    let $name := if ($tmp/@name)
                 then data($tmp/@name)
                 else ()
    return
      string-join
      (
      (
        "declare",
        $default,
        "decimal-format",
        $name,
        env:set-properties($tmp),
        ";"
      ),
      ' '
      )
};

declare %private function env:set-properties(
  $decimal-format as element(fots:decimal-format)
) as xs:string*
{
  for $att in $decimal-format/attribute::*
  let $name := node-name($att)
  let $value := data($att)
  return
    if (exists(index-of(("decimal-separator", "grouping-separator", "infinity",
                         "minus-sign", "NaN", "percent", "per-mille",
                         "zero-digit", "digit", "pattern-separator"),
                         xs:string($name))))
    then concat($name, '="' , $value, '"')
    else ()
};

(:~
 : Create the text for all of the variable declarations that must be added to
 : the text of a test-case query. The required declarations are specified by
 : the <param> and <source> subelements of the applicable <environment>.
 :
 : NOTE: at least one of $end and $envCase is the empty sequence.
 :
 : @param $env the non-local environment of the test-case, if any. It is an
 :        enviroment specified either at the test-set level or at the catalog
 :        level and is referenced by the test-case.
 : @param $envCase the local environment of the test-case, if any.
 : @param $envBaseURI The absolute pathname of the directory containing the
 :        file that defines the non-local environment.
 : @param $testSetBaseURI The absolute pathname of the directory containing the
 :        test-set file.
 : @return the text for the variable declarations.
 :)
declare %ann:nondeterministic function env:add-var-decl(
  $env            as element(fots:environment)?,
  $envCase        as element(fots:environment)?,
  $envBaseURI     as xs:anyURI,
  $testSetBaseURI as xs:anyURI
) as xs:string?
{
  if ($env)
  then env:add-var-decls($env, $envBaseURI)
  else env:add-var-decls($envCase, $testSetBaseURI)
};

declare %private function env:add-var-decls(
  $env         as element(fots:environment)?,
  $envBaseURI  as xs:anyURI
) as xs:string?
{
  let $result :=
    string-join
    (
    (
    for $param in $env/fots:param
    where empty($param[@declared eq "true"])
    return
    {
      let $type := $param/@as
      let $select := $param/@select
      return
      {
        if ($select)
        then
        {
          let $file := $env/fots:source[@uri = translate($select, "'", "")]/@file

          let $varValue := if (starts-with($select, "'") and
                               ends-with($select, "'") and
                               exists($file))
                           then
                             concat('"', resolve-uri($file, $envBaseURI), '"')
                           else
                             $select
          return
            concat("declare variable $",
                   $param/@name,
                   if ($type)
                   then concat(" as ", $type)
                   else (),
                   " := ",
                   $varValue,
                   ";")
        }
        else
        {
          concat("declare variable $",
                 $param/@name,
                 if ($type)
                 then concat(" as ", $type)
                 else (),
                 " external;")
        }
      }
    }
    ,
    for $source in $env/fots:source
    let $role := $source/@role
    where starts-with($role,"$")
    return concat("declare variable ", $role, " external;")
    )
    ,
    " "
    )
  return
    if ($result eq "")
    then ()
    else $result
};

(:~
 : If a test-case query TQ references a source doc via the context item, this
 : function creates and returns the xquery code for computing a value for the
 : context item and binding this value inside TQ. The result of this function
 : is added to the query FQ that will be evaluated via XQXQ by the fots test
 : driver. The function assumes that TQ will appear as a nested XQXQ query
 : within FQ, and that $queryID is the FQ variable storing the XQXQ query id
 : of TQ.
 :
 : If the source doc needs to be validated, the code created by this function
 : looks like this:
 :
 :  variable $contextItemQuery := xqxq:prepare-main-module
 :  (
 :  '
 :  import schema some-prefix = "some-URI";
 :
 :  validate { doc("some-xml-file") }
 :  ',
 :  (), mapper:uri-mapper#2
 :  );
 :
 : variable $contextItem := xqxq:evaluate($contextItemQuery);
 :
 : xqxq:bind-context-item($queryID, $contextItem);
 :
 : If no validation is required, the code created by this function looks like
 : this:
 :
 : variable $contextItem := doc("some-xml-file");
 :
 : xqxq:bind-context-item($queryID, $contextItem);
 :
 : @param $env The environment (local or non-local) that applies to the current
 :             test case.
 : @param $envBaseURI The absolute pathname of the directory containing the
 :        file that defines the environment.
 : @return the string for setting the context item if needed.
 :)
declare function env:set-context-item(
  $env        as element(fots:environment)?,
  $envBaseURI as xs:anyURI?
) as xs:string?
{
  if (exists($env/fots:source[@role = "."]))
  then
    string-join
    (
    (
    env:compute-context-item($env, $envBaseURI),
    "",
    'xqxq:bind-context-item($queryID, $contextItem);'
    )
    ,
    "
"
    )
  else
    ()
};

declare %private function env:compute-context-item(
  $env        as element(fots:environment)?,
  $envBaseURI as xs:anyURI?
) as xs:string
{
  let $ciURI := resolve-uri($env/fots:source[@role = "."]/@file, $envBaseURI)
  return
  if (empty($env/fots:source[@validation = "strict"]))
  then
    concat('variable $contextItem := doc("', $ciURI, '");')
  else
    string-join
    (
    (
    "
",

    "variable $contextItemQuery := xqxq:prepare-main-module",
    "(",
    "'",
    env:get-schema-import($env),
    concat('validate { doc("', $ciURI, '")', " }"),
    "',",
    "(), mapper:uri-mapper#2",
    ");",
    "",
    "variable $contextItem := xqxq:evaluate($contextItemQuery);"
    )
    ,
    "
"
    )
};

declare %private function env:get-schema-import(
  $env  as element(fots:environment)?
) as xs:string
{
  if (empty($env))
  then
    ""
  else
    let $namespace := $env/fots:namespace[@uri eq $env/fots:schema/@uri]
    let $prefix as xs:string := if (exists($namespace))
                                then xs:string($namespace/@prefix)
                                else ""
    return
      if ($prefix ne "")
      then concat('import schema namespace ',
                  $prefix,
                  ' = "',
                  $env/fots:schema/@uri,
                  '";
')
      else concat('import schema default element namespace "',
                  $env/fots:schema/@uri,
                  '";
')
};

(:~
 : Creates the xquery code for assigning values to the external variables of
 : a nested XQXQ query. The nested XQXQ query is a test-case query TQ, and the
 : result of this function is added to the query FQ that will be evaluated via
 : XQXQ by the fots test driver. The function assumes that TQ will appear as a
 : nested XQXQ query within FQ, and that $queryID is the FQ variable storing
 : the XQXQ query id of TQ.
 :
 : @param $env The environment (local or non-local) that applies to the current
 :        test case
 : @param $envBaseURI The absolute pathname of the directory containing the
 :        file that defines the environment.
 : @return the strings for variable binding in XQXQ.
 :)
declare function env:set-variables(
  $env        as element(fots:environment)?,
  $envBaseURI as xs:anyURI
) as xs:string?
{
  if (empty($env))
  then
    ()
  else
    string-join
    (
    (
      for $src in $env/fots:source[starts-with(@role, "$")]
      return
        concat('xqxq:bind-variable($queryID, xs:QName("',
               substring-after($src/@role, "$"),
               '"), ',
               'doc("',
               resolve-uri($src/@file, $envBaseURI),
               '"));')
      ,
      for $param in $env/fots:param
      let $select:= $param/@select
      let $file := $env/fots:source[@uri eq translate($select, "'", "")]/@file
      let $varValue := if (starts-with($select, "'") and
                           ends-with($select, "'") and
                           exists($file))
                       then  concat('"', resolve-uri($file, $envBaseURI), '"')
                       else $select
      let $varName := $param/@name
      where (exists($select) and exists($param[@declared eq "true"]))
      return
        concat('xqxq:bind-variable( $queryID, xs:QName("',
               $param/@name,
               '"), ',
               $varValue,
               ');')
    )
    ,
    "
"
    )
};

(:~
 : Returns the XQXQ URL resolver declaration.
 :
 : @param $case the test case.
 : @param $env the environment.
 : @param $envBaseURI URI of the environment.
 : @param $testSetBaseURI URI to the test set that defines the test case.
 : @return the XQXQ URL resolver declaration.
 :)
declare function env:resolver(
  $case           as element(fots:test-case),
  $env            as element(fots:environment)?,
  $envBaseURI     as xs:anyURI?,
  $testSetBaseURI as xs:anyURI
) as xs:string?
{
  let $modules := $case/fots:module
  let $resources := $env/fots:resource
  return
    if (empty($modules) and empty($resources))
    then
    {
      ()
    }
    else
    {
      string-join
      (
      (
      "declare function resolver:url-resolver($namespace as xs:string, $entity as xs:string)",
      "{",
      "switch($entity)",

      if (exists($modules))
      then
      {
        string-join
        (
        (
        "case 'module'",
        "  return switch($namespace)",

        for $module in $modules
        return concat("    case '",
                      data($module/@uri),
                      "' return unparsed-text('",
                      resolve-uri($module/@file, $testSetBaseURI),
                      "') "),

        "    default return ()"
        )
        ,"
"
        )
      }
      else
      {
        ()
      },

      if (exists($resources))
      then
      {
        string-join
        (
        (
        "case ''",
        "  return switch($namespace)",

        for $resource in $resources
        return concat("    case '",
                      data($resource/@uri),
                      "' return unparsed-text('",
                      resolve-uri($resource/@file, $envBaseURI),
                      "'",
                      if (exists($resource/@encoding))
                      then concat (",'", data($resource/@encoding), "'")
                      else (),
                      ") "),

        "         default return ()"
        )
        ,"
"
        )
      }
      else
      {
        ()
      },

      "default return ()","};"
      )
      ,"
"
      )
    }
};

(:~
 : Returns the XQXQ URL mapper declaration.
 : @param $case the test case.
 : @param $env the environment.
 : @param $envBaseURI URI of the environment.
 : @param $testSetBaseURI URI to the test set that defines the test case.
 : @return the XQXQ URL mapper declaration.
 :)
declare function env:mapper(
  $case           as element(fots:test-case),
  $env            as element(fots:environment)?,
  $envBaseURI     as xs:anyURI?,
  $testSetBaseURI as xs:anyURI
) as xs:string?
{
  let $envSchema := $env/fots:schema,
      $tcSchema := $case/fots:environment/fots:schema,
      $schemas := ($envSchema, $tcSchema)
  return
    if (empty($schemas))
    then ()
    else string-join(
            ("declare function mapper:uri-mapper($namespace as xs:string, $entity as xs:string) {",
            "switch($entity)",
    if (exists($schemas))
    then string-join(("case 'schema'",
                     "  return switch($namespace)",
                    (for $schema in $envSchema
                     return concat("    case '",
                                   data($schema/@uri),
                                   "' return '",
                                   resolve-uri($schema/@file, $envBaseURI),
                                   "'"),
                      for $schema in $tcSchema
                      return concat("    case '",
                                   data($schema/@uri),
                                   "' return '",
                                   resolve-uri($schema/@file, $testSetBaseURI),
                                   "'"),
                      "    default return ()")),
                      "
")
    else (),
    "default return ()","};"),
    "
")
};

(:~
 : Checks that a set of dependencies (associated with some test-set or test-case)
 : are met by Zorba's capabilities and implementation-defined features (as
 : specified in the Zorba manifest).
 :
 : @param $deps the dependencies of the test set or test case
 : @param $zorbaManifest Zorba manifest document.
 : @return a sequence of strings containing one string for each dependency
 :         that was not met, describing the dependency. If all dependencies
 :         are met, the empty sequence is returned.
 :)
declare function env:check-dependencies(
  $deps           as element(fots:dependency)*,
  $zorbaManifest  as node()
) as xs:string*
{
  if (empty($deps))
  then
  {
    ()
  }
  else
  {
    for $dep in $deps

    let $satisfied := if ($dep/@satisfied)
                      then data($dep/@satisfied)
                      else "true"

    let $zorbaDep := $zorbaManifest//fots:dependency[@type eq $dep/@type and
                                                     @value eq $dep/@value and
                                                     @satisfied eq $satisfied]
    return
      if (empty($zorbaDep))
      then
        concat("Dependency (type=", $dep/@type, ", value=", $dep/@value,
               ", satisfied=", $satisfied, ") was not met. ")
      else ()
  }
};

(:
 : Copyright 2006-2011 The FLWOR Foundation.
 :
 : Licensed under the Apache License, Version 2.0 (the "License");
 : you may not use this file except in compliance with the License.
 : You may obtain a copy of the License at
 :
 : http://www.apache.org/licenses/LICENSE-2.0
 :
 : Unless required by applicable law or agreed to in writing, software
 : distributed under the License is distributed on an "AS IS" BASIS,
 : WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 : See the License for the specific language governing permissions and
 : limitations under the License.
 :)

(:~
 : Zorba FOTS driver environment
 : @author Sorin Nasoi
 :)

module namespace env =
  "http://www.zorba-xquery.com/fots-driver/environment";

import module namespace xqxq =
  "http://www.zorba-xquery.com/modules/xqxq";

import module namespace util =
  "http://www.zorba-xquery.com/fots-driver/util" at "util.xq";

declare namespace fots =
  "http://www.w3.org/2010/09/qt-fots-catalog";

declare namespace ann =
  "http://www.zorba-xquery.com/annotations";

declare namespace op = "http://www.zorba-xquery.com/options/features";
declare namespace f = "http://www.zorba-xquery.com/features";
declare option op:disable "f:trace";

declare variable $env:hof as xs:string :=
  string-join(
    ( "declare namespace op = 'http://www.zorba-xquery.com/options/features';",
      "declare namespace f = 'http://www.zorba-xquery.com/features';",
      "declare option op:enable 'f:hof';"),
    "
");

(:~
 : If there is a dependency on the HOF feature, return the text for enabling
 : the HOF feature within a query.
 :
 : @param $deps the dependencies of the test set and test case
 : @param $test the raw query text.
 : @return the text for enabling the HOF feature
 :)
declare function env:enable-HOF-feature(
  $deps as element(fots:dependency)*,
  $test as xs:string
) as xs:string?
{
  let $check :=
    some $dep in $deps
    satisfies $dep[@type eq "feature" and contains(@value, "higherOrderFunctions")]
  return
    if ($check)
    then $env:hof
    else ()
};

(:~
 : Create the text for an XQuery version declaration that must be added
 : to a test-case query.
 :
 : @param $deps the dependencies of the test set and test case.
 : @param $test the raw query text.
 : @return the text for the XQuery version declaration, if necessary; otherwise,
 :         the empty sequence.
 :)
declare function env:add-xquery-version-decl(
  $deps as element(fots:dependency)*,
  $test as xs:string
) as xs:string?
{
  let $deps := $deps[@type eq "spec"]

  let $v30 :=
    some $dep in $deps
    satisfies $dep[contains(@value, "XQ30") or contains(@value, "XP30")]

  return
    if ($v30 and not(contains($test, "xquery version")))
    then
    {
      'xquery version "3.0";'
    }
    else
    {
      let $v10 :=
        some $dep in $deps
        satisfies $dep[contains(@value, "XQ10")]
      return
        if ($v10 and not(contains($test, "xquery version ")))
        then 'xquery version "1.0";'
        else ()
    }
};

(:~
 : Retruns the text for the static-base-uri declaration that must be added
 : to a test-case query.
 :
 : NOTE: at least one of $end and $envCase is the empty sequence.
 :
 : @param $env the non-local environment of the test-case, if any. It is an
 :        enviroment specified either at the test-set level or at the catalog
 :        level and is referenced by the test-case.
 : @param $envCase the local environment of the test-case, if any.
 : @return the declare base-uri prolog statement.
 :)
declare function env:decl-base-uri(
  $env      as element(fots:environment)?,
  $envCase  as element(fots:environment)?
) as xs:string?
{
  for $baseURI in ($env/fots:static-base-uri, $envCase/fots:static-base-uri)
  return concat("declare base-uri '", $baseURI/@uri, "';")
};

(:~
 : Create the text for the default-element-namespace declaration that must be
 : added to a test-case query.
 :
 : NOTE: at least one of $end and $envCase is the empty sequence.
 :
 : @param $env the non-local environment of the test-case, if any. It is an
 :        enviroment specified either at the test-set level or at the catalog
 :        level and is referenced by the test-case.
 : @param $envCase the local environment of the test-case, if any.
 : @return the text for the default element namespace declaration.
 :)
declare function env:decl-def-elem-namespace(
  $env      as element(fots:environment)?,
  $envCase  as element(fots:environment)?
) as xs:string?
{
  for $ns in ($env/fots:namespace, $envCase/fots:namespace)
  where $ns[@prefix eq ""]
  return concat('declare default element namespace "', $ns/@uri, '";')
};

(:~
 : Create the text for the necessary namespace declarations that must be added
 : to a test-case query.
 :
 : NOTE: at least one of $end and $envCase is the empty sequence.
 :
 : @param $env the non-local environment of the test-case, if any. It is an
 :        enviroment specified either at the test-set level or at the catalog
 :        level and is referenced by the test-case.
 : @param $envCase the local environment of the test-case, if any.
 : @param $test the raw query text
 : @return the text for the namespace declarations.
 :)
declare %ann:nondeterministic function env:decl-namespaces(
  $env     as element(fots:environment)?,
  $envCase as element(fots:environment)?,
  $test    as xs:string
) as xs:string?
{
  if (($env/fots:namespace, $envCase/fots:namespace))
  then
    string-join
    (
      for $ns in ($env/fots:namespace, $envCase/fots:namespace)
      where not($ns[@prefix eq ""]) and
            not(env:is-schema-prefix-bound($ns/@prefix, $test))
      return concat('declare namespace ', $ns/@prefix, ' = "', $ns/@uri, '";')
    ,
    "
"
    )
  else
    ()
};

(:~
 : Return true if the prefix will be bound to a schema in the Query
 : It's a bug in the FOTS if this function returns true: TODO report to W3C
 :)
declare %private %ann:nondeterministic function env:is-schema-prefix-bound(
  $prefix as xs:string,
  $test   as xs:string
) as xs:boolean
{
  contains($test, concat("import schema namespace ", $prefix))
};

(:~
 : Create the text for the decimal format declarations that must be added
 : to a test-case query.
 :
 : @param $decimal-formats decimal formats.
 : @return the decimal formats declarations.
 :)
declare function env:decl-decimal-formats(
  $decimal-formats as element(fots:decimal-format)*
) as xs:string*
{
  if (empty($decimal-formats))
  then
    ()
  else
    for $tmp in $decimal-formats
    let $default := if ($tmp/@name)
                    then ()
                    else "default"
    let $name := if ($tmp/@name)
                 then data($tmp/@name)
                 else ()
    return
      string-join
      (
      (
        "declare",
        $default,
        "decimal-format",
        $name,
        env:set-properties($tmp),
        ";"
      ),
      ' '
      )
};

declare %private function env:set-properties(
  $decimal-format as element(fots:decimal-format)
) as xs:string*
{
  for $att in $decimal-format/attribute::*
  let $name := node-name($att)
  let $value := data($att)
  return
    if (exists(index-of(("decimal-separator", "grouping-separator", "infinity",
                         "minus-sign", "NaN", "percent", "per-mille",
                         "zero-digit", "digit", "pattern-separator"),
                         xs:string($name))))
    then concat($name, '="' , $value, '"')
    else ()
};

(:~
 : Create the text for all of the variable declarations that must be added to
 : the text of a test-case query. The required declarations are specified by
 : the <param> and <source> subelements of the applicable <environment>.
 :
 : NOTE: at least one of $end and $envCase is the empty sequence.
 :
 : @param $env the non-local environment of the test-case, if any. It is an
 :        enviroment specified either at the test-set level or at the catalog
 :        level and is referenced by the test-case.
 : @param $envCase the local environment of the test-case, if any.
 : @param $envBaseURI The absolute pathname of the directory containing the
 :        file that defines the non-local environment.
 : @param $testSetBaseURI The absolute pathname of the directory containing the
 :        test-set file.
 : @return the text for the variable declarations.
 :)
declare %ann:nondeterministic function env:add-var-decl(
  $env            as element(fots:environment)?,
  $envCase        as element(fots:environment)?,
  $envBaseURI     as xs:anyURI,
  $testSetBaseURI as xs:anyURI
) as xs:string?
{
  if ($env)
  then env:add-var-decls($env, $envBaseURI)
  else env:add-var-decls($envCase, $testSetBaseURI)
};

declare %private function env:add-var-decls(
  $env         as element(fots:environment)?,
  $envBaseURI  as xs:anyURI
) as xs:string?
{
  let $result :=
    string-join
    (
    (
    for $param in $env/fots:param
    where empty($param[@declared eq "true"])
    return
    {
      let $type := $param/@as
      let $select := $param/@select
      return
      {
        if ($select)
        then
        {
          let $file := $env/fots:source[@uri = translate($select, "'", "")]/@file

          let $varValue := if (starts-with($select, "'") and
                               ends-with($select, "'") and
                               exists($file))
                           then
                             concat('"', resolve-uri($file, $envBaseURI), '"')
                           else
                             $select
          return
            concat("declare variable $",
                   $param/@name,
                   if ($type)
                   then concat(" as ", $type)
                   else (),
                   " := ",
                   $varValue,
                   ";")
        }
        else
        {
          concat("declare variable $",
                 $param/@name,
                 if ($type)
                 then concat(" as ", $type)
                 else (),
                 " external;")
        }
      }
    }
    ,
    for $source in $env/fots:source
    let $role := $source/@role
    where starts-with($role,"$")
    return concat("declare variable ", $role, " external;")
    )
    ,
    " "
    )
  return
    if ($result eq "")
    then ()
    else $result
};

(:~
 : If a test-case query TQ references a source doc via the context item, this
 : function creates and returns the xquery code for computing a value for the
 : context item and binding this value inside TQ. The result of this function
 : is added to the query FQ that will be evaluated via XQXQ by the fots test
 : driver. The function assumes that TQ will appear as a nested XQXQ query
 : within FQ, and that $queryID is the FQ variable storing the XQXQ query id
 : of TQ.
 :
 : If the source doc needs to be validated, the code created by this function
 : looks like this:
 :
 :  variable $contextItemQuery := xqxq:prepare-main-module
 :  (
 :  '
 :  import schema some-prefix = "some-URI";
 :
 :  validate { doc("some-xml-file") }
 :  ',
 :  (), mapper:uri-mapper#2
 :  );
 :
 : variable $contextItem := xqxq:evaluate($contextItemQuery);
 :
 : xqxq:bind-context-item($queryID, $contextItem);
 :
 : If no validation is required, the code created by this function looks like
 : this:
 :
 : variable $contextItem := doc("some-xml-file");
 :
 : xqxq:bind-context-item($queryID, $contextItem);
 :
 : @param $env The environment (local or non-local) that applies to the current
 :             test case.
 : @param $envBaseURI The absolute pathname of the directory containing the
 :        file that defines the environment.
 : @return the string for setting the context item if needed.
 :)
declare function env:set-context-item(
  $env        as element(fots:environment)?,
  $envBaseURI as xs:anyURI?
) as xs:string?
{
  if (exists($env/fots:source[@role = "."]))
  then
    string-join
    (
    (
    env:compute-context-item($env, $envBaseURI),
    "",
    'xqxq:bind-context-item($queryID, $contextItem);'
    )
    ,
    "
"
    )
  else
    ()
};

declare %private function env:compute-context-item(
  $env        as element(fots:environment)?,
  $envBaseURI as xs:anyURI?
) as xs:string
{
  let $ciURI := resolve-uri($env/fots:source[@role = "."]/@file, $envBaseURI)
  return
  if (empty($env/fots:source[@validation = "strict"]))
  then
    concat('variable $contextItem := doc("', $ciURI, '");')
  else
    string-join
    (
    (
    "
",

    "variable $contextItemQuery := xqxq:prepare-main-module",
    "(",
    "'",
    env:get-schema-import($env),
    concat('validate { doc("', $ciURI, '")', " }"),
    "',",
    "(), mapper:uri-mapper#2",
    ");",
    "",
    "variable $contextItem := xqxq:evaluate($contextItemQuery);"
    )
    ,
    "
"
    )
};

declare %private function env:get-schema-import(
  $env  as element(fots:environment)?
) as xs:string
{
  if (empty($env))
  then
    ""
  else
    let $namespace := $env/fots:namespace[@uri eq $env/fots:schema/@uri]
    let $prefix as xs:string := if (exists($namespace))
                                then xs:string($namespace/@prefix)
                                else "p"
    return
      if (empty($env/fots:schema/@uri))
      then 'import schema default element namespace "";'
      else
      {
        if ($prefix eq "")
        then concat('import schema default element namespace "',
                    $env/fots:schema/@uri,
                    '";
')
        else concat('import schema namespace ',
                    $prefix,
                    ' = "',
                    $env/fots:schema/@uri,
                    '";
')
      }
};

(:~
 : Creates the xquery code for assigning values to the external variables of
 : a nested XQXQ query. The nested XQXQ query is a test-case query TQ, and the
 : result of this function is added to the query FQ that will be evaluated via
 : XQXQ by the fots test driver. The function assumes that TQ will appear as a
 : nested XQXQ query within FQ, and that $queryID is the FQ variable storing
 : the XQXQ query id of TQ.
 :
 : @param $env The environment (local or non-local) that applies to the current
 :        test case
 : @param $envBaseURI The absolute pathname of the directory containing the
 :        file that defines the environment.
 : @return the strings for variable binding in XQXQ.
 :)
declare function env:set-variables(
  $env        as element(fots:environment)?,
  $envBaseURI as xs:anyURI
) as xs:string?
{
  if (empty($env))
  then
    ()
  else
    string-join
    (
    (
      for $src in $env/fots:source[starts-with(@role, "$")]
      return
        concat('xqxq:bind-variable($queryID, xs:QName("',
               substring-after($src/@role, "$"),
               '"), ',
               'doc("',
               resolve-uri($src/@file, $envBaseURI),
               '"));')
      ,
      for $param in $env/fots:param
      let $select:= $param/@select
      let $file := $env/fots:source[@uri eq translate($select, "'", "")]/@file
      let $varValue := if (starts-with($select, "'") and
                           ends-with($select, "'") and
                           exists($file))
                       then  concat('"', resolve-uri($file, $envBaseURI), '"')
                       else $select
      let $varName := $param/@name
      where (exists($select) and exists($param[@declared eq "true"]))
      return
        concat('xqxq:bind-variable( $queryID, xs:QName("',
               $param/@name,
               '"), ',
               $varValue,
               ');')
    )
    ,
    "
"
    )
};

(:~
 : Returns the XQXQ URL resolver declaration.
 :
 : @param $case the test case.
 : @param $env the environment.
 : @param $envBaseURI URI of the environment.
 : @param $testSetBaseURI URI to the test set that defines the test case.
 : @return the XQXQ URL resolver declaration.
 :)
declare function env:resolver(
  $case           as element(fots:test-case),
  $env            as element(fots:environment)?,
  $envBaseURI     as xs:anyURI?,
  $testSetBaseURI as xs:anyURI
) as xs:string?
{
  let $modules := $case/fots:module
  let $resources := $env/fots:resource
  return
    if (empty($modules) and empty($resources))
    then
    {
      ()
    }
    else
    {
      string-join
      (
      (
      "declare function resolver:url-resolver($namespace as xs:string, $entity as xs:string)",
      "{",
      "switch($entity)",

      if (exists($modules))
      then
      {
        string-join
        (
        (
        "case 'module'",
        "  return switch($namespace)",

        for $module in $modules
        return concat("    case '",
                      data($module/@uri),
                      "' return unparsed-text('",
                      resolve-uri($module/@file, $testSetBaseURI),
                      "') "),

        "    default return ()"
        )
        ,"
"
        )
      }
      else
      {
        ()
      },

      if (exists($resources))
      then
      {
        string-join
        (
        (
        "case ''",
        "  return switch($namespace)",

        for $resource in $resources
        return concat("    case '",
                      data($resource/@uri),
                      "' return unparsed-text('",
                      resolve-uri($resource/@file, $envBaseURI),
                      "'",
                      if (exists($resource/@encoding))
                      then concat (",'", data($resource/@encoding), "'")
                      else (),
                      ") "),

        "         default return ()"
        )
        ,"
"
        )
      }
      else
      {
        ()
      },

      "default return ()","};"
      )
      ,"
"
      )
    }
};

(:~
 : Returns the XQXQ URL mapper declaration.
 : @param $case the test case.
 : @param $env the environment.
 : @param $envBaseURI URI of the environment.
 : @param $testSetBaseURI URI to the test set that defines the test case.
 : @return the XQXQ URL mapper declaration.
 :)
declare function env:mapper(
  $case           as element(fots:test-case),
  $env            as element(fots:environment)?,
  $envBaseURI     as xs:anyURI?,
  $testSetBaseURI as xs:anyURI
) as xs:string?
{
  let $envSchema := $env/fots:schema,
      $tcSchema := $case/fots:environment/fots:schema,
      $schemas := ($envSchema, $tcSchema)
  return
    if (empty($schemas))
    then ()
    else string-join(
            ("declare function mapper:uri-mapper($namespace as xs:string, $entity as xs:string) {",
            "switch($entity)",
    if (exists($schemas))
    then string-join(("case 'schema'",
                     "  return switch($namespace)",
                    (for $schema in $envSchema
                     return concat("    case '",
                                   data($schema/@uri),
                                   "' return '",
                                   resolve-uri($schema/@file, $envBaseURI),
                                   "'"),
                      for $schema in $tcSchema
                      return concat("    case '",
                                   data($schema/@uri),
                                   "' return '",
                                   resolve-uri($schema/@file, $testSetBaseURI),
                                   "'"),
                      "    default return ()")),
                      "
")
    else (),
    "default return ()","};"),
    "
")
};

(:~
 : Checks that a set of dependencies (associated with some test-set or test-case)
 : are met by Zorba's capabilities and implementation-defined features (as
 : specified in the Zorba manifest).
 :
 : @param $deps the dependencies of the test set or test case
 : @param $zorbaManifest Zorba manifest document.
 : @return a sequence of strings containing one string for each dependency
 :         that was not met, describing the dependency. If all dependencies
 :         are met, the empty sequence is returned.
 :)
declare function env:check-dependencies(
  $deps           as element(fots:dependency)*,
  $zorbaManifest  as node()
) as xs:string*
{
  if (empty($deps))
  then
  {
    ()
  }
  else
  {
    for $dep in $deps

    let $satisfied := if ($dep/@satisfied)
                      then data($dep/@satisfied)
                      else "true"

    let $zorbaDep := $zorbaManifest//fots:dependency[@type eq $dep/@type and
                                                     @value eq $dep/@value and
                                                     @satisfied eq $satisfied]
    return
      if (empty($zorbaDep))
      then
        concat("Dependency (type=", $dep/@type, ", value=", $dep/@value,
               ", satisfied=", $satisfied, ") was not met. ")
      else ()
  }
};