Start of map resolution working

Start of map resolution working

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

   DITA Link Manager Model

   Model component of Model/View/Controller. Maintains
   the link management data.

   Provides queries to create and update resource use records,
   dependency indexes, etc.

   These queries are called whenever new content is added to
   given database.

   Author: W. Eliot Kimber

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

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

module namespace lmm="http://dita-for-small-teams.org/xquery/modules/linkmgr-model";

declare namespace dfst="http://dita-for-small-teams.org";

import module namespace df="http://dita-for-small-teams.org/xquery/modules/dita-utils";
import module namespace bxutil="http://dita-for-small-teams.org/xquery/modules/basex-utils";
import module namespace lmutil="http://dita-for-small-teams.org/xquery/modules/linkmgmt-utils";
import module namespace dfstcnst="http://dita-for-small-teams.org/xquery/modules/dfst-constants";
import module namespace relpath="http://dita-for-small-teams.org/xquery/modules/relpath-utils";

(: Given an element with an @id value, construct the unique resource key for it.
   For a given element the resource ID is guaranteed to be unique within
   a snapshot (git commit).

   @param elem Element to get resource ID for.
   @returns Resource key string.

   The resource key is a combination of the absolute URI of the containing
   document and the element's tree position within the document, producing
   a unique key for any element in any document on a given snapshot (version
   in time). Resource keys are not reliably unique across snapshots as the position of
   the element within its containing document could change from version to
   version.

   The resource key is used to look up the element in where-used records, either
   as the element used or the element doing the use (links).

 :)
declare function lmm:constructResourceKeyForElement($elem as element()) as xs:string {
  let $targetDocHash := hash:md5(document-uri(root($elem)))
  let $treepos := for $anc in ($elem/ancestor-or-self::*)
                      return string(count($anc | $anc/preceding-sibling::*))
  let $key := string-join($treepos, '.')
  return $targetDocHash || '^' || $key

};

(:~
 : Create or update the link management indexes for the specified repository
 :
 :)
declare %updating function lmm:updateLinkManagementIndexes(
                               $contentDbName as xs:string,
                               $metadataDbName as xs:string) {
   (: Query the database to find all links and for each link, record a resource use
      record in the database.

      Every addressible element has a "resource key" which combines the URI of
      the containing document and the element's @id value (only elements with
      @id attributes are addressible.

      The link management indexes are stored in a separate database from
      the content database: every branch-specific database has a corresponding
      metadata database that contains the where-used records, resolved maps,
      key space information, and any other metadata you might want to store.

      For each document used there is a directory whose name is the hash
      of the document's URI (which will be unique within a branch). Within
      that directory are the use records for elements within that document.
      This arrangement has the effect of providing a reference count for
      for each document, making it quick to determine if a given document
      is used by any links. It also allows for narrowing the scope of
      where-used queries to just the entries for the document.

    :)

    (: Need to handle both context-free links (direct URI references) and
       context-specific links (key references).

       For context-specific links have to process all the maps and construct
       resolved maps to serve as the resolution context. This could also
       be modeled as updating the key spaces but I think it makes more
       sense to have the maps be the focus, from which key spaces are derived,
       rather than making the key spaces the primary focus.

     :)

    let $logID := 'linkMgmtIndex' (: ID of the log to log messages to :)

    let $directLinks := lmutil:findAllDirectLinks($contentDbName)

    return (
      try {
          db:delete($metadataDbName, $dfstcnst:where-used-dir)
      } catch * {
          (: FIXME: Log to log doc :)
          db:output(<error>Exception deleting where-used directory "{$dfstcnst:where-used-dir}": {$err:description}</error>)
      },

      (: Now create new resource use records for direct links :)

      lmm:createDirectLinkResourceRecords($metadataDbName, $directLinks, $logID),

      (: Now create resolved maps and key space documents for each of the root maps.
       :)
      lmm:constructKeySpaces(
         $contentDbName,
         $metadataDbName,
         $logID),

      (: Now create resource use records for all the indirect links: :)
      lmm:createIndirectLinkResourceRecords(
                  $metadataDbName,
                  lmutil:findAllIndirectLinks($contentDbName),
                  $logID)
    )

};

declare %updating function lmm:createDirectLinkResourceRecords(
        $metadataDbName as xs:string,
        $directLinks as map(*)*,
        $logID as xs:string) {
    for $linkItem in $directLinks
       let $resolveResult := lmutil:resolveDirectLink($linkItem)
       return lmm:createOrUpdateResourceUseRecord(
                   $metadataDbName,
                   $linkItem,
                   $resolveResult,
                   $logID)

};

declare %updating function lmm:createIndirectLinkResourceRecords(
                               $metadataDbName as xs:string,
                               $indirectLinks,
                               $logID as xs:string) {
    for $linkItem in $indirectLinks
        let $resolveResult as map(*) := lmutil:resolveIndirectLink($linkItem)
        return lmm:createOrUpdateResourceUseRecord(
                   $metadataDbName,
                   $linkItem,
                   $resolveResult,
                   $logID)
};

(: Given a link and the resolved result, creates a resource use record for each
   target the link resolved to.

 :)
declare %updating function lmm:createOrUpdateResourceUseRecord(
                              $metadataDbName,
                              $linkItem as map(*),
                              $resolveResult as map(*),
                              $logID as xs:string) {
   let $resolveResult as map(*) := lmutil:resolveDirectLink($linkItem)
   let $targets := $resolveResult('target')
   for $target in $targets
       return lmm:createOrUpdateResourceUseRecordForLinkTarget(
                    $metadataDbName,
                    $linkItem,
                    $target,
                    $logID)
};

(:
 : Creates a use record reflecting the use of the target element by the document
 : that contains the link.
 :
 : The use records are organized into directories, one directory per used document,
 : where the directory name is the MD5 hash of the document URI (just to make a
 : shorter name that won't have any problematic characters).
 :
 : Each use record document's filename is the MD5 hash of the linking document's
 : URI plus the MD5 hash of the linking element.
 :
 : Potential problem: the same element could, in theory, link to the same target in
 : two different ways: as a link and as a conref, although this case is extremely
 : unlikely. Really need a way to distinguish each abstract link represented by
 : a given DITA link-establishing element but the current implementation doesn't
 : provide that abstraction. It could through a refactor. Keeping it simple for now.
 :)
declare %updating function lmm:createOrUpdateResourceUseRecordForLinkTarget(
           $metadataDbName as xs:string,
           $linkItem as map(*),
           $target as element(),
           $logID as xs:string) {
   let $targetDoc := root($target)
   let $link := $linkItem('link')
   let $containingDir := concat($dfstcnst:where-used-dir, '/',
                                lmm:constructResourceKeyForElement($target),
                                '/')
   let $reskey := lmm:constructResourceKeyForElement($link)
   let $recordFilename := concat('use-record_', $reskey, '.xml')
   let $format := if ($link/@format)
                     then string($link/@format)
                     else 'dita'
   let $scope := if ($link/@scope)
                     then string($link/@scope)
                     else 'local'
   let $linkContext := $linkItem('linkContext')

   (: df:getTitleForLinkElementContainer($link) :)
   let $useRecord :=
     <dfst:useRecord resourceKey="{$reskey}"
                     targetDoc="{document-uri($targetDoc)}"
                     usingDoc="{document-uri(root($link))}"
                     linkType="{df:getBaseLinkType($link)}"
                     linkClass="{string($link/@class)}"
                     linkContext="{$linkContext}"
                     format="{$format}"
                     scope="{$scope}"
     >
       <title>{if (df:class($link, 'map/topicref'))
                  then string((root($link)/*/*[df:class(., 'topic/title')] |
                        root($link)/*/@title)[1])
                  else string($link/ancestor::*[df:class(., 'topic/topic')][1]/*[df:class(., 'topic/title')])}</title>
     </dfst:useRecord>
    let $useRecordUri := relpath:newFile($containingDir, $recordFilename)
    return try {
       (
       if (db:exists($metadataDbName, $useRecordUri))
          then db:delete($metadataDbName, $useRecordUri)
          else(),
       db:replace($metadataDbName,
                  $useRecordUri,
                  $useRecord),
       (: FIXME: Write record to log doc :)
       db:output(<info>Stored use record "{$useRecordUri}"</info>)
       )
    } catch * {
       (: FIXME: Write record to log doc :)
       db:output(<error>Error storing use record to "{$useRecordUri}": {$err:description}</error>)
    }
};

(:~
 : Construct key spaces from root maps.
 :
 : @param contentDbName Name of datbase that contains the content to construct key spaces from
 : @param metadataDbName Name of metadata database to store construct key spaces in.
 :
 : Finds all the root maps (requires that all direct-link use records are up to date).
 :
 : For each root map, constructs and stored the resolved map and then constructs
 : and stores the keyspace document for that root map.
 :
 :)
declare %updating function lmm:constructKeySpaces(
        $contentDbName as xs:string,
        $metadataDbName as xs:string,
        $logID as xs:string) {

  (: General process:

     1. Find all DITA maps

     2. For each map, construct a resolved map that preserves submap
        boundaries and original source map details.

     The resolved maps can then be used to determine the effective
     binding for any key without the need to separately construct
     key spaces. This technique was pioneered and suggested by
     Chris Nitchie, designer of the DITA 1.3 scoped keys mechanism.

     Note that there's no point in trying to determine if a given
     map is a "root map" as any map can, in theory, be used as a root
     map. Likewise, a map that happens to have no local-scope
     topicrefs to it may not be intended to be the root of a publication.

     One alternative to this approach is to only consider maps that have
     peer-scope topicrefs to them to be root maps (per the DITA 1.3
     meaning for peer-scope topicrefs to dita maps). In this case, there needs
     to be a "master map" that serves to simply identify the "top level
     root maps", that is, the maps that are considered by the document
     authors to be The root maps, that is, the maps they consider to
     be the roots of publications. Given this master map the system can
     then consider only peer-scope map references in order to determine
     the root maps and thus the maps for which key space construction
     is relevant.

   :)

   let $maps := collection($contentDbName)/*[df:class(., 'map/map')]
   return for $map in $maps
              return lmm:constructResolvedMap(
                                              $map,
                                              $metadataDbName,
                                              $logID)

};

(:~
 : Construct a resolved map suiteable for doing key resolution. The map
 : is stored in the metadata database.
 :
 : @param map DITA map that is the root of the resolved map.
 : @param metadataDbName Name of the metadata database to store the
 :        resolved map in
 :)
declare %updating function lmm:constructResolvedMap(
                                    $map as element(),
                                    $metadataDbName as xs:string,
                                    $logID as xs:string) {
  let $contentDbName := db:name($map)
  let $resolvedMap := lmm:resolveMap($map, $logID)
  let $resolvedMapURI := lmm:getResolvedMapURIForMap($map)
  return (db:replace($metadataDbName, $resolvedMapURI, $resolvedMap),
          db:output(<info>Stored resolved map "{$resolvedMapURI}"</info>))

};

(:~
 : Takes a root map and returns the resolved version of the map.
 :
 : The resolution process preserves the original structure and
 : adds <topicgroup> elements to record submap boundaries.
 :
 : The resulting resolved map reflects all directly-referenced submaps.
 : Because the resolved map is used for constructing key spaces it is
 : not useful or necessary to resolve key-based map references as those
 : maps cannot contribute to the final set of effective key spaces.
 :)
declare function lmm:resolveMap(
                     $map as element(),
                     $logID as xs:string) as element() {

    let $resolvedMap :=
          element {name($map)}
            {
              attribute origMapURI { document-uri(root($map)) },
              attribute origMapDB { db:name($map) },
              $map/@*,
              for $node in $map/node()
                  return lmm:resolveMapHandleNode($node, $logID)
            }
    return $resolvedMap
};

(:~
 : Simple identity transform dispatch handler for nodes of any type.
 :)
declare function lmm:resolveMapHandleNode($node as node(), $logID as xs:string) as node()* {
  typeswitch ($node)
    case element() return lmm:resolveMapHandleElement($node, $logID)
    default return $node
};

(:~
 : Apply identity transform to elements of any type.
 :)
declare function lmm:resolveMapHandleElement($elem as element(), $logID as xs:string) as element()* {
   if (df:class($elem, 'map/topicref'))
      then lmm:resolveMapHandleTopicref($elem, $logID)
      else lmm:resolveMapCopy($elem, $logID)
};

(:~
 : Copy an element as for xsl:copy instruction.
 :)
declare function lmm:resolveMapCopy($elem as element(), $logID as xs:string) as element()* {
   let $result :=
     element {name($elem)} {
        for $node in ($elem/@*, $elem/node())
            return lmm:resolveMapHandleNode($node, $logID)
     }
   return $result
};

(:~
 : Handle topicrefs. If the topicref is to local-scope map, then resolve the topicref
 : to the map and include the map in the resolved result, otherwise apply normal
 : copy processing.
 :)
declare function lmm:resolveMapHandleTopicref($elem as element(), $logID as xs:string) as element()* {
   if ($elem/@format = ('ditamap') and $elem/@scope = ('local'))
      then lmm:resolveMapHandleMapRef($elem, $logID)
      else lmm:resolveMapCopy($elem, $logID)
};

(:~
 : Handle local-scope map references.
 :
 : Constructs a <topicgroup> element that captures the details about the original
 : submap and then applies the identity tranform to the topicref and reltable
 : children of the submap.
 :)
declare function lmm:resolveMapHandleMapRef($elem as element(), $logID as xs:string) as element()* {
  let $resolutionMap as map(*) := df:resolveTopicRef($elem)
  let $submap := $resolutionMap('target')
  (: FIXME: add resolution messages to log once we get logging infrastructure in place :)
  return
    <topicgroup origMapURI="{document-uri(root($submap))}"
      origMapClass="{string($submap/@class)}"
    >
      <topicmeta>{comment {'submap metadata goes here '}}</topicmeta>,
      {for $e in $submap/*[df:class(., 'map/topicref') or df:class(., 'map/reltable')]
          return lmm:resolveMapHandleElement($e, $logID)
      }
    </topicgroup>
};

declare function lmm:getResolvedMapURIForMap(
                        $map as element()) {
  let $mapDocHash := hash:md5(document-uri(root($map)))
  return $dfstcnst:resolved-map-dir ||
         "/" || $mapDocHash || ".ditamap"
};

(: End of Module :)

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

   DITA Link Manager Model

   Model component of Model/View/Controller. Maintains
   the link management data.

   Provides queries to create and update resource use records,
   dependency indexes, etc.

   These queries are called whenever new content is added to
   given database.

   Author: W. Eliot Kimber

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

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

module namespace lmm="http://dita-for-small-teams.org/xquery/modules/linkmgr-model";

declare namespace dfst="http://dita-for-small-teams.org";

import module namespace df="http://dita-for-small-teams.org/xquery/modules/dita-utils";
import module namespace bxutil="http://dita-for-small-teams.org/xquery/modules/basex-utils";
import module namespace lmutil="http://dita-for-small-teams.org/xquery/modules/linkmgmt-utils";
import module namespace dfstcnst="http://dita-for-small-teams.org/xquery/modules/dfst-constants";
import module namespace relpath="http://dita-for-small-teams.org/xquery/modules/relpath-utils";

(: Given an element with an @id value, construct the unique resource key for it.
   For a given element the resource ID is guaranteed to be unique within
   a snapshot (git commit).

   @param elem Element to get resource ID for.
   @returns Resource key string.

   The resource key is a combination of the absolute URI of the containing
   document and the element's tree position within the document, producing
   a unique key for any element in any document on a given snapshot (version
   in time). Resource keys are not reliably unique across snapshots as the position of
   the element within its containing document could change from version to
   version.

   The resource key is used to look up the element in where-used records, either
   as the element used or the element doing the use (links).

 :)
declare function lmm:constructResourceKeyForElement($elem as element()) as xs:string {
  let $targetDocHash := hash:md5(document-uri(root($elem)))
  let $treepos := for $anc in ($elem/ancestor-or-self::*)
                      return string(count($anc | $anc/preceding-sibling::*))
  let $key := string-join($treepos, '.')
  return $targetDocHash || '^' || $key

};

(:~
 : Create or update the link management indexes for the specified repository
 :
 :)
declare %updating function lmm:updateLinkManagementIndexes(
                               $contentDbName as xs:string,
                               $metadataDbName as xs:string) {
   (: Query the database to find all links and for each link, record a resource use
      record in the database.

      Every addressible element has a "resource key" which combines the URI of
      the containing document and the element's @id value (only elements with
      @id attributes are addressible.

      The link management indexes are stored in a separate database from
      the content database: every branch-specific database has a corresponding
      metadata database that contains the where-used records, resolved maps,
      key space information, and any other metadata you might want to store.

      For each document used there is a directory whose name is the hash
      of the document's URI (which will be unique within a branch). Within
      that directory are the use records for elements within that document.
      This arrangement has the effect of providing a reference count for
      for each document, making it quick to determine if a given document
      is used by any links. It also allows for narrowing the scope of
      where-used queries to just the entries for the document.

    :)

    (: Need to handle both context-free links (direct URI references) and
       context-specific links (key references).

       For context-specific links have to process all the maps and construct
       resolved maps to serve as the resolution context. This could also
       be modeled as updating the key spaces but I think it makes more
       sense to have the maps be the focus, from which key spaces are derived,
       rather than making the key spaces the primary focus.

     :)

    let $logID := 'linkMgmtIndex' (: ID of the log to log messages to :)

    let $directLinks := lmutil:findAllDirectLinks($contentDbName)

    return (
      try {
          db:delete($metadataDbName, $dfstcnst:where-used-dir)
      } catch * {
          (: FIXME: Log to log doc :)
          db:output(<error>Exception deleting where-used directory "{$dfstcnst:where-used-dir}": {$err:description}</error>)
      },

      (: Now create new resource use records for direct links :)

      lmm:createDirectLinkResourceRecords($metadataDbName, $directLinks, $logID),

      (: Now create resolved maps and key space documents for each of the root maps.
       :)
      lmm:constructKeySpaces(
         $contentDbName,
         $metadataDbName,
         $logID),

      (: Now create resource use records for all the indirect links: :)
      lmm:createIndirectLinkResourceRecords(
                  $metadataDbName,
                  lmutil:findAllIndirectLinks($contentDbName),
                  $logID)
    )

};

declare %updating function lmm:createDirectLinkResourceRecords(
        $metadataDbName as xs:string,
        $directLinks as map(*)*,
        $logID as xs:string) {
    for $linkItem in $directLinks
       let $resolveResult := lmutil:resolveDirectLink($linkItem)
       return lmm:createOrUpdateResourceUseRecord(
                   $metadataDbName,
                   $linkItem,
                   $resolveResult,
                   $logID)

};

declare %updating function lmm:createIndirectLinkResourceRecords(
                               $metadataDbName as xs:string,
                               $indirectLinks,
                               $logID as xs:string) {
    for $linkItem in $indirectLinks
        let $resolveResult as map(*) := lmutil:resolveIndirectLink($linkItem)
        return lmm:createOrUpdateResourceUseRecord(
                   $metadataDbName,
                   $linkItem,
                   $resolveResult,
                   $logID)
};

(: Given a link and the resolved result, creates a resource use record for each
   target the link resolved to.

 :)
declare %updating function lmm:createOrUpdateResourceUseRecord(
                              $metadataDbName,
                              $linkItem as map(*),
                              $resolveResult as map(*),
                              $logID as xs:string) {
   let $resolveResult as map(*) := lmutil:resolveDirectLink($linkItem)
   let $targets := $resolveResult('target')
   for $target in $targets
       return lmm:createOrUpdateResourceUseRecordForLinkTarget(
                    $metadataDbName,
                    $linkItem,
                    $target,
                    $logID)
};

(:
 : Creates a use record reflecting the use of the target element by the document
 : that contains the link.
 :
 : The use records are organized into directories, one directory per used document,
 : where the directory name is the MD5 hash of the document URI (just to make a
 : shorter name that won't have any problematic characters).
 :
 : Each use record document's filename is the MD5 hash of the linking document's
 : URI plus the MD5 hash of the linking element.
 :
 : Potential problem: the same element could, in theory, link to the same target in
 : two different ways: as a link and as a conref, although this case is extremely
 : unlikely. Really need a way to distinguish each abstract link represented by
 : a given DITA link-establishing element but the current implementation doesn't
 : provide that abstraction. It could through a refactor. Keeping it simple for now.
 :)
declare %updating function lmm:createOrUpdateResourceUseRecordForLinkTarget(
           $metadataDbName as xs:string,
           $linkItem as map(*),
           $target as element(),
           $logID as xs:string) {
   let $targetDoc := root($target)
   let $link := $linkItem('link')
   let $containingDir := concat($dfstcnst:where-used-dir, '/',
                                lmm:constructResourceKeyForElement($target),
                                '/')
   let $reskey := lmm:constructResourceKeyForElement($link)
   let $recordFilename := concat('use-record_', $reskey, '.xml')
   let $format := if ($link/@format)
                     then string($link/@format)
                     else 'dita'
   let $scope := if ($link/@scope)
                     then string($link/@scope)
                     else 'local'
   let $linkContext := $linkItem('linkContext')

   (: df:getTitleForLinkElementContainer($link) :)
   let $useRecord :=
     <dfst:useRecord resourceKey="{$reskey}"
                     targetDoc="{document-uri($targetDoc)}"
                     usingDoc="{document-uri(root($link))}"
                     linkType="{df:getBaseLinkType($link)}"
                     linkClass="{string($link/@class)}"
                     linkContext="{$linkContext}"
                     format="{$format}"
                     scope="{$scope}"
     >
       <title>{if (df:class($link, 'map/topicref'))
                  then string((root($link)/*/*[df:class(., 'topic/title')] |
                        root($link)/*/@title)[1])
                  else string($link/ancestor::*[df:class(., 'topic/topic')][1]/*[df:class(., 'topic/title')])}</title>
     </dfst:useRecord>
    let $useRecordUri := relpath:newFile($containingDir, $recordFilename)
    return try {
       (
       if (db:exists($metadataDbName, $useRecordUri))
          then db:delete($metadataDbName, $useRecordUri)
          else(),
       db:replace($metadataDbName,
                  $useRecordUri,
                  $useRecord),
       (: FIXME: Write record to log doc :)
       db:output(<info>Stored use record "{$useRecordUri}"</info>)
       )
    } catch * {
       (: FIXME: Write record to log doc :)
       db:output(<error>Error storing use record to "{$useRecordUri}": {$err:description}</error>)
    }
};

(:~
 : Construct key spaces from root maps.
 :
 : @param contentDbName Name of datbase that contains the content to construct key spaces from
 : @param metadataDbName Name of metadata database to store construct key spaces in.
 :
 : Finds all the root maps (requires that all direct-link use records are up to date).
 :
 : For each root map, constructs and stored the resolved map and then constructs
 : and stores the keyspace document for that root map.
 :
 :)
declare %updating function lmm:constructKeySpaces(
        $contentDbName as xs:string,
        $metadataDbName as xs:string,
        $logID as xs:string) {

  (: General process:

     1. Find all DITA maps

     2. For each map, construct a resolved map that preserves submap
        boundaries and original source map details.

     The resolved maps can then be used to determine the effective
     binding for any key without the need to separately construct
     key spaces. This technique was pioneered and suggested by
     Chris Nitchie, designer of the DITA 1.3 scoped keys mechanism.

     Note that there's no point in trying to determine if a given
     map is a "root map" as any map can, in theory, be used as a root
     map. Likewise, a map that happens to have no local-scope
     topicrefs to it may not be intended to be the root of a publication.

     One alternative to this approach is to only consider maps that have
     peer-scope topicrefs to them to be root maps (per the DITA 1.3
     meaning for peer-scope topicrefs to dita maps). In this case, there needs
     to be a "master map" that serves to simply identify the "top level
     root maps", that is, the maps that are considered by the document
     authors to be The root maps, that is, the maps they consider to
     be the roots of publications. Given this master map the system can
     then consider only peer-scope map references in order to determine
     the root maps and thus the maps for which key space construction
     is relevant.

   :)

   let $maps := collection($contentDbName)/*[df:class(., 'map/map')]
   return for $map in $maps
              return lmm:constructResolvedMap(
                                              $map,
                                              $metadataDbName,
                                              $logID)

};

(:~
 : Construct a resolved map suiteable for doing key resolution. The map
 : is stored in the metadata database.
 :
 : @param map DITA map that is the root of the resolved map.
 : @param metadataDbName Name of the metadata database to store the
 :        resolved map in
 :)
declare %updating function lmm:constructResolvedMap(
                                    $map as element(),
                                    $metadataDbName as xs:string,
                                    $logID as xs:string) {
  let $contentDbName := db:name($map)
  let $resolvedMap := lmm:resolveMap($map, $logID)
  let $resolvedMapURI := lmm:getResolvedMapURIForMap($map)
  return (db:replace($metadataDbName, $resolvedMapURI, $resolvedMap),
          db:output(<info>Stored resolved map "{$resolvedMapURI}"</info>))

};

declare function lmm:resolveMap(
                     $map as element(),
                     $logID as xs:string) as element() {

    let $resolvedMap :=
          element {name($map)}
            {
              attribute origMapURI { document-uri(root($map)) },
              attribute origMapDB { db:name($map) }
            }
    return $resolvedMap
};

declare function lmm:getResolvedMapURIForMap(
                        $map as element()) {
  let $mapDocHash := hash:md5(document-uri(root($map)))
  return $dfstcnst:resolved-map-dir ||
         "/" || $mapDocHash || ".ditamap"
};

(: End of Module :)


Final attempt to add at least a small testcase

xquery version "3.0";

module namespace m = "http://foo.org/xquery/jms/messaging";

declare namespace test = "http://exist-db.org/xquery/xqsuite";

import module namespace messaging = "http://exist-db.org/xquery/messaging" at "java:org.exist.jms.xquery.MessagingModule";
import module namespace jms = "http://exist-db.org/xquery/jms" at "java:org.exist.jms.xquery.JmsModule";

declare variable $m:jmsConfiguration := map {
"java.naming.factory.initial" : "org.apache.activemq.jndi.ActiveMQInitialContextFactory",
"java.naming.provider.url" : "tcp://localhost:61616",
"destination" : "dynamicQueues/messagingTest",
"connection-factory" : "ConnectionFactory"
};

declare variable $m:messageProperties := map {
"Su" : "Sunday",
"Mo" : xs:integer(1)
};

declare
%test:assertEquals("tcp://localhost:61616", "dynamicQueues/messagingTest")
function m:message()  {

(: Send message to the JMS broker :)
    let $send :=   messaging:send( <data>{util:uuid()}</data> , $m:messageProperties, $m:jmsConfiguration )

    return ($send//java.naming.provider.url/string(), $send//destination/string() )
};

xquery version "3.0";

module namespace m = "http://foo.org/xquery/jms/messaging";

declare namespace test = "http://exist-db.org/xquery/xqsuite";

import module namespace messaging = "http://exist-db.org/xquery/messaging" at "java:org.exist.jms.xquery.MessagingModule";
import module namespace jms = "http://exist-db.org/xquery/jms" at "java:org.exist.jms.xquery.JmsModule";

declare variable $m:jmsConfiguration := map {
"java.naming.factory.initial" : "org.apache.activemq.jndi.ActiveMQInitialContextFactory",
"java.naming.provider.url" : "tcp://localhost:61616",
"destination" : "dynamicQueues/messagingTest",
"connection-factory" : "ConnectionFactory"
};

declare variable $m:messageProperties := map {
"Su" : "Sunday",
"Mo" : xs:integer(1)
};

declare
function m:pause()  {
    for $i in (1 to 100000) return jms:list()
};

declare
%test:assertEquals(0)
function m:message()  {

(: Send message to the JMS broker :)
let $send :=   messaging:send( <data>{util:uuid()}</data> , $m:messageProperties, $m:jmsConfiguration )

let $pause2 :=  m:pause()

return (0)
};


fix to cater and dont break on weird cmd-data having more than one MdProfile

xquery version "1.0";
module namespace cmdcheck = "http://clarin.eu/cmd/check";
(: checking (trying to ensure) consistency of the IDs in CMD-records (MdSelfLink vs. ResourceProxies vs. IsPartOf)

TODO: check (and/or generate) the inverse links in IsPartOf (vs. ResourceProxies)
:)

(:import module namespace cmd  = "http://clarin.eu/cmd/collections" at "cmd-collections.xqm";:)
import module namespace repo-utils = "http://aac.ac.at/content_repository/utils" at  "/db/cr/repo-utils.xqm";
import module namespace fcs = "http://clarin.eu/fcs/1.0" at "/db/cr/fcs.xqm";
import module namespace crday  = "http://aac.ac.at/content_repository/data-ay" at "/db/cr/crday.xqm";
import module namespace diag =  "http://www.loc.gov/zing/srw/diagnostic/" at  "modules/diagnostics/diagnostics.xqm";

declare namespace sru = "http://www.loc.gov/zing/srw/";
declare namespace cmd = "http://www.clarin.eu/cmd/";

(:~ default namespace: cmd - declared statically, because dynamic ns-declaration did not work
cmd is the default namespace in (not) all the CMD records
:)
declare default element namespace "http://www.clarin.eu/cmd/";
(:~ default namespace - not declared explicitely, it is declared dynamically where necessary (function: addIsPartOf() :)
declare variable $cmdcheck:default-ns := "http://www.clarin.eu/cmd/";
declare variable $cmdcheck:root-coll := "root";

(:~ runs cmd.profile-scan for all contexts defined in the mappings :)

declare function cmdcheck:run-stats($config-path as xs:string) as item()* {

       let $config := doc($config-path),
           $mappings := doc(repo-utils:config-value($config, 'mappings'))

        let $opt := util:declare-option("exist:serialize", "media-type=text/html method=xhtml")

      for $map in $mappings//map[@key]
                let $map-key := $map/xs:string(@key),
                    $map-dbcoll-path := $map/xs:string(@path),
                    $scan-cmd-profile := fcs:scan('cmd.profile', $map-key, 1, 50, 1, 1, "text", $config)
                return $scan-cmd-profile
};

(:~ currently not used -> DEPRECATE?
init-function meant to call individual functions actually doing something.
at least it resolves x-context to a nodeset
:)
declare function cmdcheck:check($x-context as xs:string+, $config as node() ) as item()* {

    let $log-file-name := concat('log_checks_', repo-utils:sanitize-name($x-context), '.xml')
    let $log-path := repo-utils:config-value($config, 'log.path')

    let $start-time := util:system-dateTime()

    let $stat-profiles := cmdcheck:scan-profiles($x-context, $config),
(:        $check-linking := cmdcheck:check-linking($data-collection),:)
        $duration := util:system-dateTime() - $start-time

    let $result-data := <checks context="{$x-context}" on="{$start-time}" duration="{$duration}" >
                    <profiles>{$stat-profiles}</profiles>
                    <check-linking>{$check-linking}</check-linking>
                  </checks>
     let $store := xmldb:store($log-path ,  $log-file-name, $result-data)
    return $store
};

(:~ extracts CMD-Profiles from given nodeset

TODO: match with cmd-terms and diagnostics
:)
declare function cmdcheck:scan-profiles($x-context as xs:string, $config) as item()* {
      (: try- to handle namespace problem - primitively :)

    let $context := repo-utils:context-to-collection($x-context, $config),
        $ns-uri := namespace-uri($context[1]/*)
            (: dynamically declare a namespace for the next step, if one is defined in current context
       $dummy := if (exists($ns-uri)) then util:declare-namespace("",$ns-uri) else () :)
       (: this is now trying to overcome the default-ns issue, by accepting with and without ns :)

let $profiles-summary :=
        if (not(exists($context))) then
            diag:diagnostics("general-error", concat("scan-profiles: no context: ", $x-context))
         else
            (:        $dummy := util:declare-namespace("",xs:anyURI(""))       :)
            (:    let $profiles := util:eval("$context//(MdProfile|cmd:MdProfile)/text()"):)
                    let $is-ns-cmd := ($ns-uri = xs:anyURI("http://www.clarin.eu/cmd/") )
                let $profiles :=
                                      if ($is-ns-cmd) then
                                            $context//cmd:CMD/concat((cmd:Header/cmd:MdProfile/text())[1], '#', if (exists(cmd:Components/*[1])) then cmd:Components/*[1]/local-name() else 'ERROR' )
                                      else
                                            let $dummy := util:declare-namespace("",xs:anyURI($ns-uri))
                                            return util:eval("$context//CMD/concat((Header/MdProfile/text())[1], '#', Components/*[1]/local-name())")

            let $distinct-profiles := distinct-values($profiles)
           return for $profile in $distinct-profiles
(:                                let $profile-name := util:eval("$context[.//(MdProfile|cmd:MdProfile)/text() = $profile][1]//(Components|cmd:Components)/*/name()"):)
                                let $profile-name := substring-after($profile, '#')
                                let $profile-id := substring-before($profile, '#')
                                let $cnt := count($profiles[. eq $profile])
                                return <sru:term>
                                           <sru:value>{if ($profile-id ne '') then $profile-id else $profile-name}</sru:value>
                                           <sru:numberOfRecords>{$cnt }</sru:numberOfRecords>
                                           <sru:displayTerm>{$profile-name}</sru:displayTerm>
                                           { if ($profile-id eq '') then
                                                    <sru:extraTermData>
                                                        { (diag:diagnostics("profile-missing", $profile-name),
                                                           if (not($is-ns-cmd)) then diag:diagnostics("unknown-namespace", $ns-uri)
                                                                        else ()
                                                        )}
                                                    </sru:extraTermData>
                                                  else ()
                                                  }
                                         </sru:term>
    let $count-all := count($profiles-summary)
    return
                    <sru:scanResponse xmlns:sru="http://www.loc.gov/zing/srw/" xmlns:fcs="http://clarin.eu/fcs/1.0">
                          <sru:version>1.2</sru:version>
                          <sru:terms>
                            {$profiles-summary }
                           </sru:terms>
                           <sru:extraResponseData>
                                 <fcs:countTerms>{$count-all}</fcs:countTerms>
                             </sru:extraResponseData>
                             <sru:echoedScanRequest>
                                  <sru:scanClause>cmd.profile</sru:scanClause>
                              </sru:echoedScanRequest>
                       </sru:scanResponse>
};

declare function cmdcheck:display-overview($config-path as xs:string) as item()* {

   let $config := doc($config-path),
       $dummy := util:declare-namespace("",xs:anyURI("")),
       $mappings := doc(repo-utils:config-value($config, 'mappings'))
(:       $baseurl := repo-utils:config-value($config, 'base.url'),:)

   let $opt := util:declare-option("exist:serialize", "media-type=text/html method=xhtml")

   let $overview :=  crday:display-overview($config-path, 'raw')

   let $profiles-overview :=

collection	profiles

           { for $map in util:eval("$mappings//map[@key]")
                    let $map-key := $map/xs:string(@key),
                        $map-dbcoll-path := $map/xs:string(@path),
                        $scan-cmd-profile := fcs:scan('cmd.profile', $map-key, 1, 50, 1, 1, "text", $config),
                        $scan-formatted := repo-utils:serialise-as( $scan-cmd-profile, 'htmldetail', 'scan', $config, ())
                    return

                        {$map-key}
                        { $scan-formatted }

                        }

            (: { for $profile in $scan-cmd-profile//sru:term
                            return ($profile/sru:value, $profile/sru:displayTerm, $profile/sru:numberOfRecords)
                        }:)

        return repo-utils:serialise-as(
{($overview, $profiles-overview)}
, 'htmlpage', 'html', $config, ())

};

(:~	WARNING - CHANGES DATA! adds IsPartOf to the CMDrecords (contained in the db-coll)
- expects CMD-records for collections in specific db-coll (with name of the db-coll matching the name of the collectionfile):
    ./_corpusstructure/collection_{db-coll-name}.cmdi
- logs the progress of the processing in a separate file
- can be applied repeatedly - deletes(!) old IsPartOfList, before inserting new

@param $x-context an identifier of a collection (as defined in mappings)
@param $config config-node - used to get log.path and collection-path

TODO: could also generate the CMD-records for collections (assuming db-colls as collections)
      (now done by the python script: dir2cmdicollection.py)
TODO: currently a hack: the collection-records also are marked as root elements - this has to be optional at least,
      and may even be dangerous (count(IsPartOf[@level=1])>1)!
TODO: not recursive yet!
:)
declare function cmdcheck:addIsPartOf-colls($x-context as xs:string, $config as node()*) as item()* {

let $log-file-name := concat('log_addIsPartOf_', $x-context, '.xml')
    let $log-path := repo-utils:config-value($config, 'log.path')
    let $log-doc-path := xmldb:store($log-path ,  $log-file-name, <result></result>)
    let $log-doc := doc($log-doc-path)

    (:let $root-dbcoll := repo-utils:context-to-collection($x-context, $config),:)
    let $root-dbcoll-path := repo-utils:context-to-collection-path($x-context, $config)

    let $coll-dbcoll := '_corpusstructure'

    (: beware empty path!! would return first-level collections and run over whole database :)
    let $colls := if ($root-dbcoll-path ne "") then xmldb:get-child-collections($root-dbcoll-path) else ()
    let $start_time := fn:current-dateTime()

    (: dynamic ns-declaration does not work for xpath
    let $declare-dummy := util:declare-namespace("",xs:anyURI($cmdcheck:default-ns))
    :)
    let $log-dummy := update insert <edit x-context="{$x-context}" root-dbcoll="{$root-dbcoll-path}"
                        coll-dbcoll="{$coll-dbcoll}" count-colls="{count($colls)}" time="{$start_time}" /> into $log-doc/result
    (:if (exists($colls)) then:)
    for $coll_name in $colls[not(.=$coll-dbcoll)]
    (: let $coll_name := 'HomeFamilyManagement' :)
    let $files := collection(concat($root-dbcoll-path,$coll_name))
    (: let $files := xmldb:xcollection($root_coll) :)
	let $coll_file := concat($root-dbcoll-path, $coll-dbcoll, '/collection_', $coll_name, '.cmdi')
	let $coll_doc := doc($coll_file)
	let $coll_id := $coll_doc//MdSelfLink/text()

(:	let $cmdi_files := $files[ends-with(util:document-name(.),".cmdi")]:)

    let $pre_time := util:system-dateTime()
	let $duration := $pre_time - $start_time
 return	( update insert <edit coll="{$coll_name}" collid="{$coll_id}" coll_file="{$coll_file}" count="{count($files)}" time="{$pre_time}" /> into $log-doc/result,
			update delete $files//IsPartOfList,
			update delete $coll_doc//IsPartOfList,
			update insert <IsPartOfList>
								<IsPartOf level="1">{$x-context}</IsPartOf>
								<IsPartOf level="1">{$cmdcheck:root-coll}</IsPartOf>
						  </IsPartOfList>
			  	into $coll_doc//Resources,
			update insert <IsPartOfList>
							<IsPartOf level="2">{$x-context}</IsPartOf>
							<IsPartOf level="1">{$coll_id}</IsPartOf>
						  </IsPartOfList>
				into $files//Resources,
		update value $log-doc/result/edit[last()] with (util:system-dateTime() - $pre_time)
        )
    (:
    return	($coll_name, count($cmdi_files), $coll_file,  update insert <IsPartOfList>
							<IsPartOf level="1">{$coll_id}</IsPartOf>
						  </IsPartOfList> into $cmdi_files//Resources ):)
};

(:~ recursive addIsPartOf
starts by finding "orphaned" mdrecords = expecting that to be the root records.
and continues  ?
:)
declare function cmdcheck:addIsPartOf($x-context as xs:string, $config as node()*) as item()* {

let $log-file-name := concat('log_addIsPartOf_', $x-context, '.xml')
    let $log-path := repo-utils:config-value($config, 'log.path')
    let $log-doc-path := xmldb:store($log-path ,  $log-file-name, <result></result>)
    let $log-doc := doc($log-doc-path)

    let $root-dbcoll := repo-utils:context-to-collection($x-context, $config),
        $root-dbcoll-path := repo-utils:context-to-collection-path($x-context, $config)

(:    let $coll-dbcoll := '_corpusstructure':)

    (: beware empty path!! would return first-level collections and run over whole database :)
    let $colls := if ($root-dbcoll-path ne "") then xmldb:get-child-collections($root-dbcoll-path) else ()
    let $start_time := fn:current-dateTime()

    let $log-dummy := update insert <edit x-context="{$x-context}" root-dbcoll="{$root-dbcoll-path}"
                         count-colls="{count($colls)}" time="{$start_time}" /> into $log-doc/result

    let $root := cmdcheck:addIsPartOf-root($root-dbcoll, $log-doc)
    let $updated := cmdcheck:addIsPartOf-r($root-dbcoll, $root, 1, $log-doc)

    return $log-doc
 };

 (:~ consider those, whose MdSelfLink isn't referenced anywhere (orphans) as the root-cmd-collections
 @returns the edited records :)
 declare function cmdcheck:addIsPartOf-root($context as node()*, $log-doc as node()*) as item()* {

    let $pre_time := util:system-dateTime()

    let $orphaned := $context//CMD[not(Header/MdSelfLink = $context//ResourceProxy[ResourceType eq 'Metadata']/ResourceRef)]

    let $update := ( update insert <edit collid="root" count="{count($orphaned)}" time="{$pre_time}" /> into $log-doc/result,
			update delete $orphaned//IsPartOfList,
			update insert <IsPartOfList>
			                 <IsPartOf>{$cmdcheck:root-coll}</IsPartOf>
						  </IsPartOfList>
				into $orphaned//Resources,
		  update value $log-doc/result/edit[last()] with (util:system-dateTime() - $pre_time)
        )

    return $orphaned

 };

 declare function cmdcheck:addIsPartOf-r($context as node()*, $parents as node()*, $level as xs:integer, $log-doc as node()*) as item()* {

    let $start_time := util:system-dateTime()
    let $log-dummy := update insert <edit level="{$level}"
                        count-colls="{count($parents)}" time="{$start_time}" /> into $log-doc/result

  let $update := for $cmd-record in $parents
                    let $parent-id := $cmd-record//MdSelfLink/text()
                    let $children := $context//CMD[Header/MdSelfLink = $cmd-record//ResourceRef]
                	let $ispartoflist := <IsPartOfList>{($cmd-record//IsPartOfList/IsPartOf[not(text()=$cmdcheck:root-coll)],
                								<IsPartOf >{$parent-id}</IsPartOf>) }
                						  </IsPartOfList>

                    let $pre_time := util:system-dateTime()
                	let $duration := $pre_time - $start_time
                    return	( update insert <edit collid="{$parent-id}" count="{count($children)}" time="{$pre_time}" /> into $log-doc/result,
                			update delete $children//IsPartOfList,
                			update insert $ispartoflist
                				into $children//Resources,
                		  update value $log-doc/result/edit[last()] with (util:system-dateTime() - $pre_time)
                        )

    (: go next level - we dont have to recurse in the update-loop,
     but we can do whole next level in one call :)
    let $next-level := $context//CMD[Header/MdSelfLink = $parents//ResourceRef]
    let $updated := if (exists($next-level)) then  cmdcheck:addIsPartOf-r($context, $next-level ,($level+1),$log-doc)
                        else ()
    return $update
};

xquery version "1.0";
module namespace cmdcheck = "http://clarin.eu/cmd/check";
(: checking (trying to ensure) consistency of the IDs in CMD-records (MdSelfLink vs. ResourceProxies vs. IsPartOf)

TODO: check (and/or generate) the inverse links in IsPartOf (vs. ResourceProxies)
:)

(:import module namespace cmd  = "http://clarin.eu/cmd/collections" at "cmd-collections.xqm";:)
import module namespace repo-utils = "http://aac.ac.at/content_repository/utils" at  "/db/cr/repo-utils.xqm";
import module namespace fcs = "http://clarin.eu/fcs/1.0" at "/db/cr/fcs.xqm";
import module namespace crday  = "http://aac.ac.at/content_repository/data-ay" at "/db/cr/crday.xqm";
import module namespace diag =  "http://www.loc.gov/zing/srw/diagnostic/" at  "modules/diagnostics/diagnostics.xqm";

declare namespace sru = "http://www.loc.gov/zing/srw/";
declare namespace cmd = "http://www.clarin.eu/cmd/";

(:~ default namespace: cmd - declared statically, because dynamic ns-declaration did not work
cmd is the default namespace in (not) all the CMD records
:)
declare default element namespace "http://www.clarin.eu/cmd/";
(:~ default namespace - not declared explicitely, it is declared dynamically where necessary (function: addIsPartOf() :)
declare variable $cmdcheck:default-ns := "http://www.clarin.eu/cmd/";
declare variable $cmdcheck:root-coll := "root";

(:~ runs cmd.profile-scan for all contexts defined in the mappings :)

declare function cmdcheck:run-stats($config-path as xs:string) as item()* {

       let $config := doc($config-path),
           $mappings := doc(repo-utils:config-value($config, 'mappings'))

        let $opt := util:declare-option("exist:serialize", "media-type=text/html method=xhtml")

      for $map in $mappings//map[@key]
                let $map-key := $map/xs:string(@key),
                    $map-dbcoll-path := $map/xs:string(@path),
                    $scan-cmd-profile := fcs:scan('cmd.profile', $map-key, 1, 50, 1, 1, "text", $config)
                return $scan-cmd-profile
};

(:~ currently not used -> DEPRECATE?
init-function meant to call individual functions actually doing something.
at least it resolves x-context to a nodeset
:)
declare function cmdcheck:check($x-context as xs:string+, $config as node() ) as item()* {

    let $log-file-name := concat('log_checks_', repo-utils:sanitize-name($x-context), '.xml')
    let $log-path := repo-utils:config-value($config, 'log.path')

    let $start-time := util:system-dateTime()

    let $stat-profiles := cmdcheck:scan-profiles($x-context, $config),
(:        $check-linking := cmdcheck:check-linking($data-collection),:)
        $duration := util:system-dateTime() - $start-time

    let $result-data := <checks context="{$x-context}" on="{$start-time}" duration="{$duration}" >
                    <profiles>{$stat-profiles}</profiles>
                    <check-linking>{$check-linking}</check-linking>
                  </checks>
     let $store := xmldb:store($log-path ,  $log-file-name, $result-data)
    return $store
};

(:~ extracts CMD-Profiles from given nodeset

TODO: match with cmd-terms and diagnostics
:)
declare function cmdcheck:scan-profiles($x-context as xs:string, $config as node()) as item()* {
      (: try- to handle namespace problem - primitively :)

    let $context := repo-utils:context-to-collection($x-context, $config),
        $ns-uri := namespace-uri($context[1]/*)
            (: dynamically declare a namespace for the next step, if one is defined in current context
       $dummy := if (exists($ns-uri)) then util:declare-namespace("",$ns-uri) else () :)
       (: this is now trying to overcome the default-ns issue, by accepting with and without ns :)

let $profiles-summary :=
        if (not(exists($context))) then
            diag:diagnostics("general-error", concat("scan-profiles: no context: ", $x-context))
         else
            (:        $dummy := util:declare-namespace("",xs:anyURI(""))       :)
            (:    let $profiles := util:eval("$context//(MdProfile|cmd:MdProfile)/text()"):)
                    let $is-ns-cmd := ($ns-uri = xs:anyURI("http://www.clarin.eu/cmd/") )
                let $profiles :=
                                      if ($is-ns-cmd) then
                                            $context//cmd:CMD/concat(cmd:Header/cmd:MdProfile/text(), '#', cmd:Components/*[1]/local-name())
                                      else
                                            let $dummy := util:declare-namespace("",xs:anyURI($ns-uri))
                                            return util:eval("$context//CMD/concat(Header/MdProfile/text(), '#', Components/*[1]/local-name())")

            let $distinct-profiles := distinct-values($profiles)
           return for $profile in $distinct-profiles
(:                                let $profile-name := util:eval("$context[.//(MdProfile|cmd:MdProfile)/text() = $profile][1]//(Components|cmd:Components)/*/name()"):)
                                let $profile-name := substring-after($profile, '#')
                                let $profile-id := substring-before($profile, '#')
                                let $cnt := count($profiles[. eq $profile])
                                return <sru:term>
                                           <sru:value>{if ($profile-id ne '') then $profile-id else $profile-name}</sru:value>
                                           <sru:numberOfRecords>{$cnt }</sru:numberOfRecords>
                                           <sru:displayTerm>{$profile-name}</sru:displayTerm>
                                           { if ($profile-id eq '') then
                                                    <sru:extraTermData>
                                                        { (diag:diagnostics("profile-missing", $profile-name),
                                                           if (not($is-ns-cmd)) then diag:diagnostics("unknown-namespace", $ns-uri)
                                                                        else ()
                                                        )}
                                                    </sru:extraTermData>
                                                  else ()
                                                  }
                                         </sru:term>
    let $count-all := count($profiles-summary)
    return
                    <sru:scanResponse xmlns:sru="http://www.loc.gov/zing/srw/" xmlns:fcs="http://clarin.eu/fcs/1.0">
                          <sru:version>1.2</sru:version>
                          <sru:terms>
                            {$profiles-summary }
                           </sru:terms>
                           <sru:extraResponseData>
                                 <fcs:countTerms>{$count-all}</fcs:countTerms>
                             </sru:extraResponseData>
                             <sru:echoedScanRequest>
                                  <sru:scanClause>cmd.profile</sru:scanClause>
                              </sru:echoedScanRequest>
                       </sru:scanResponse>
};

declare function cmdcheck:display-overview($config-path as xs:string) as item()* {

   let $config := doc($config-path),
       $dummy := util:declare-namespace("",xs:anyURI("")),
       $mappings := doc(repo-utils:config-value($config, 'mappings'))
(:       $baseurl := repo-utils:config-value($config, 'base.url'),:)

   let $opt := util:declare-option("exist:serialize", "media-type=text/html method=xhtml")

   let $overview :=  crday:display-overview($config-path, 'raw')

   let $profiles-overview :=

collection	profiles

           { for $map in util:eval("$mappings//map[@key]")
                    let $map-key := $map/xs:string(@key),
                        $map-dbcoll-path := $map/xs:string(@path),
                        $scan-cmd-profile := fcs:scan('cmd.profile', $map-key, 1, 50, 1, 1, "text", $config),
                        $scan-formatted := repo-utils:serialise-as( $scan-cmd-profile, 'htmldetail', 'scan', $config, ())
                    return

                        {$map-key}
                        { $scan-formatted }

                        }

            (: { for $profile in $scan-cmd-profile//sru:term
                            return ($profile/sru:value, $profile/sru:displayTerm, $profile/sru:numberOfRecords)
                        }:)

        return repo-utils:serialise-as(
{($overview, $profiles-overview)}
, 'htmlpage', 'html', $config, ())

};

(:~	WARNING - CHANGES DATA! adds IsPartOf to the CMDrecords (contained in the db-coll)
- expects CMD-records for collections in specific db-coll (with name of the db-coll matching the name of the collectionfile):
    ./_corpusstructure/collection_{db-coll-name}.cmdi
- logs the progress of the processing in a separate file
- can be applied repeatedly - deletes(!) old IsPartOfList, before inserting new

@param $x-context an identifier of a collection (as defined in mappings)
@param $config config-node - used to get log.path and collection-path

TODO: could also generate the CMD-records for collections (assuming db-colls as collections)
      (now done by the python script: dir2cmdicollection.py)
TODO: currently a hack: the collection-records also are marked as root elements - this has to be optional at least,
      and may even be dangerous (count(IsPartOf[@level=1])>1)!
TODO: not recursive yet!
:)
declare function cmdcheck:addIsPartOf-colls($x-context as xs:string, $config as node()*) as item()* {

let $log-file-name := concat('log_addIsPartOf_', $x-context, '.xml')
    let $log-path := repo-utils:config-value($config, 'log.path')
    let $log-doc-path := xmldb:store($log-path ,  $log-file-name, <result></result>)
    let $log-doc := doc($log-doc-path)

    (:let $root-dbcoll := repo-utils:context-to-collection($x-context, $config),:)
    let $root-dbcoll-path := repo-utils:context-to-collection-path($x-context, $config)

    let $coll-dbcoll := '_corpusstructure'

    (: beware empty path!! would return first-level collections and run over whole database :)
    let $colls := if ($root-dbcoll-path ne "") then xmldb:get-child-collections($root-dbcoll-path) else ()
    let $start_time := fn:current-dateTime()

    (: dynamic ns-declaration does not work for xpath
    let $declare-dummy := util:declare-namespace("",xs:anyURI($cmdcheck:default-ns))
    :)
    let $log-dummy := update insert <edit x-context="{$x-context}" root-dbcoll="{$root-dbcoll-path}"
                        coll-dbcoll="{$coll-dbcoll}" count-colls="{count($colls)}" time="{$start_time}" /> into $log-doc/result
    (:if (exists($colls)) then:)
    for $coll_name in $colls[not(.=$coll-dbcoll)]
    (: let $coll_name := 'HomeFamilyManagement' :)
    let $files := collection(concat($root-dbcoll-path,$coll_name))
    (: let $files := xmldb:xcollection($root_coll) :)
	let $coll_file := concat($root-dbcoll-path, $coll-dbcoll, '/collection_', $coll_name, '.cmdi')
	let $coll_doc := doc($coll_file)
	let $coll_id := $coll_doc//MdSelfLink/text()

(:	let $cmdi_files := $files[ends-with(util:document-name(.),".cmdi")]:)

    let $pre_time := util:system-dateTime()
	let $duration := $pre_time - $start_time
 return	( update insert <edit coll="{$coll_name}" collid="{$coll_id}" coll_file="{$coll_file}" count="{count($files)}" time="{$pre_time}" /> into $log-doc/result,
			update delete $files//IsPartOfList,
			update delete $coll_doc//IsPartOfList,
			update insert <IsPartOfList>
								<IsPartOf level="1">{$x-context}</IsPartOf>
								<IsPartOf level="1">{$cmdcheck:root-coll}</IsPartOf>
						  </IsPartOfList>
			  	into $coll_doc//Resources,
			update insert <IsPartOfList>
							<IsPartOf level="2">{$x-context}</IsPartOf>
							<IsPartOf level="1">{$coll_id}</IsPartOf>
						  </IsPartOfList>
				into $files//Resources,
		update value $log-doc/result/edit[last()] with (util:system-dateTime() - $pre_time)
        )
    (:
    return	($coll_name, count($cmdi_files), $coll_file,  update insert <IsPartOfList>
							<IsPartOf level="1">{$coll_id}</IsPartOf>
						  </IsPartOfList> into $cmdi_files//Resources ):)
};

(:~ recursive addIsPartOf
starts by finding "orphaned" mdrecords = expecting that to be the root records.
and continues  ?
:)
declare function cmdcheck:addIsPartOf($x-context as xs:string, $config as node()*) as item()* {

let $log-file-name := concat('log_addIsPartOf_', $x-context, '.xml')
    let $log-path := repo-utils:config-value($config, 'log.path')
    let $log-doc-path := xmldb:store($log-path ,  $log-file-name, <result></result>)
    let $log-doc := doc($log-doc-path)

    let $root-dbcoll := repo-utils:context-to-collection($x-context, $config),
        $root-dbcoll-path := repo-utils:context-to-collection-path($x-context, $config)

(:    let $coll-dbcoll := '_corpusstructure':)

    (: beware empty path!! would return first-level collections and run over whole database :)
    let $colls := if ($root-dbcoll-path ne "") then xmldb:get-child-collections($root-dbcoll-path) else ()
    let $start_time := fn:current-dateTime()

    let $log-dummy := update insert <edit x-context="{$x-context}" root-dbcoll="{$root-dbcoll-path}"
                         count-colls="{count($colls)}" time="{$start_time}" /> into $log-doc/result

    let $root := cmdcheck:addIsPartOf-root($root-dbcoll, $log-doc)
    let $updated := cmdcheck:addIsPartOf-r($root-dbcoll, $root, 1, $log-doc)

    return $log-doc
 };

 (:~ consider those, whose MdSelfLink isn't referenced anywhere (orphans) as the root-cmd-collections
 @returns the edited records :)
 declare function cmdcheck:addIsPartOf-root($context as node()*, $log-doc as node()*) as item()* {

    let $pre_time := util:system-dateTime()

    let $orphaned := $context//CMD[not(Header/MdSelfLink = $context//ResourceProxy[ResourceType eq 'Metadata']/ResourceRef)]

    let $update := ( update insert <edit collid="root" count="{count($orphaned)}" time="{$pre_time}" /> into $log-doc/result,
			update delete $orphaned//IsPartOfList,
			update insert <IsPartOfList>
			                 <IsPartOf>{$cmdcheck:root-coll}</IsPartOf>
						  </IsPartOfList>
				into $orphaned//Resources,
		  update value $log-doc/result/edit[last()] with (util:system-dateTime() - $pre_time)
        )

    return $orphaned

 };

 declare function cmdcheck:addIsPartOf-r($context as node()*, $parents as node()*, $level as xs:integer, $log-doc as node()*) as item()* {

    let $start_time := util:system-dateTime()
    let $log-dummy := update insert <edit level="{$level}"
                        count-colls="{count($parents)}" time="{$start_time}" /> into $log-doc/result

  let $update := for $cmd-record in $parents
                    let $parent-id := $cmd-record//MdSelfLink/text()
                    let $children := $context//CMD[Header/MdSelfLink = $cmd-record//ResourceRef]
                	let $ispartoflist := <IsPartOfList>{($cmd-record//IsPartOfList/IsPartOf[not(text()=$cmdcheck:root-coll)],
                								<IsPartOf >{$parent-id}</IsPartOf>) }
                						  </IsPartOfList>

                    let $pre_time := util:system-dateTime()
                	let $duration := $pre_time - $start_time
                    return	( update insert <edit collid="{$parent-id}" count="{count($children)}" time="{$pre_time}" /> into $log-doc/result,
                			update delete $children//IsPartOfList,
                			update insert $ispartoflist
                				into $children//Resources,
                		  update value $log-doc/result/edit[last()] with (util:system-dateTime() - $pre_time)
                        )

    (: go next level - we dont have to recurse in the update-loop,
     but we can do whole next level in one call :)
    let $next-level := $context//CMD[Header/MdSelfLink = $parents//ResourceRef]
    let $updated := if (exists($next-level)) then  cmdcheck:addIsPartOf-r($context, $next-level ,($level+1),$log-doc)
                        else ()
    return $update
};


Added a few more controls to the string passed to a xs:base64Binary constructor

svn path=/trunk/eXist-1.0/; revision=4533

declare namespace xqts="http://exist-db.org/xquery/xqts";
declare namespace catalog="http://www.w3.org/2005/02/query-test-XQTSCatalog";

declare namespace props="java:java.io.File";

import module namespace util="http://exist-db.org/xquery/util";
import module namespace xdb="http://exist-db.org/xquery/xmldb";
import module namespace xdiff="http://exist-db.org/xquery/xmldiff"
at "java:org.exist.xquery.modules.xmldiff.XmlDiffModule";
import module namespace request="http://exist-db.org/xquery/request";
declare namespace system="http://exist-db.org/xquery/system";

(:~ ----------------------------------------------------------------------------------------
     W3C XQuery Test Suite

     This is the main module for running the XQTS on eXist. You can either
     run the whole test suite, a specific test group or a single test case.

     Setup:

     * Make sure the XmlDiff module is registered in conf.xml

     * Edit config.xml and change basedir to point to the directory into
     which you unzipped the XQTS sources. Note: it needs to be an URI.

     * Create a collection /db/XQTS in the database.

     * From the XQTS directory, upload XQTSCatalog.xml into the created
     collection.

     * Upload the "TestSources" directory so the source docs can be found
     in /db/XQTS/TestSources.

     * Run this script with the client.
     ------------------------------------------------------------------------------------------- :)
declare variable $xqts:CONFIG { xqts:initialize() };
declare variable $xqts:XQTS_HOME { xqts:path-to-uri($xqts:CONFIG/basedir/text()) };

declare function xqts:initialize() as element() {
    let $home := system:get-exist-home()
    let $path := concat($home, "/webapp/xqts")
    let $collection := xdb:create-collection("/db", "XQTS")
    let $config0 := doc("/db/XQTS")/config
    let $config :=
        if ($config0) then
            $config0
        else
            let $stored := xdb:store-files-from-pattern("/db/XQTS", $path, "*.xml", "text/xml")
            return
                doc("/db/XQTS/config.xml")/config
    let $xqtsHome := $config/basedir/text()
    let $catalog0 := doc("/db/XQTS/XQTSCatalog.xml")
    let $catalog :=
        if ($catalog0) then $catalog0
        else
            xdb:store($collection, "XQTSCatalog.xml",
                xs:anyURI(xqts:path-to-uri(concat($xqtsHome, "XQTSCatalog.xml"))))
    let $sources0 := collection("/db/XQTS/TestSources")
    let $sources :=
        if ($sources0) then
            $sources0
        else
            let $sourceCol := xdb:create-collection("/db/XQTS", "TestSources")
            return
                xdb:store-files-from-pattern($sourceCol, concat($xqtsHome, "TestSources"), "*.xml", "text/xml")
    return
        $config
};

declare function xqts:path-to-uri($path as xs:string) as xs:string {
        if (starts-with($path, "/")) then
            concat("file://", $path)
        else
            concat("file:///", $path)
};

declare function xqts:create-progress-file($testCount as xs:int) as empty() {
    let $results := xdb:store("/db/XQTS", "progress.xml",
        <progress total="{$testCount}" done="0" failed="0" passed="0"/>)
    return ()
};

declare function xqts:report-progress($test-case as element()) as empty() {
    let $result := string($test-case/@result)
    let $progress := doc("/db/XQTS/progress.xml")/progress
    let $counter := $progress/@done
    return (
        update value $counter with xs:int($counter + 1),
        if ($result eq 'fail') then
            update value $progress/@failed with xs:int($progress/@failed + 1)
        else
            update value $progress/@passed with xs:int($progress/@passed + 1)
    )
};

declare function xqts:create-collections($group as element(catalog:test-group)) as node() {
    let $rootColl := xdb:create-collection("/db/XQTS", "test-results")
    let $ancestors := reverse(($group/ancestor::catalog:test-group, $group))
    let $collection := xqts:create-collections($rootColl, $ancestors, "/db/XQTS/test-results")
    let $results := xdb:store($collection, "results.xml", <test-result failed="0" passed="0"/>)
    return
        doc($results)
};

declare function xqts:create-collections($parent as object,
    $pathElements as element()+, $currentPath as xs:string)
as object {
    let $next := $pathElements[last()]
    let $remainder := subsequence($pathElements, 1, count($pathElements) - 1)
    let $newColl := xdb:create-collection($parent, $next/@name)
    return
        if ($remainder) then
            xqts:create-collections($newColl, $remainder, concat($currentPath, "/", $next/@name))
        else
            $newColl
};

declare function xqts:get-query($case as element(catalog:test-case)) {
   let $query-name := $case//catalog:query/@name
   let $path := concat( $xqts:XQTS_HOME, "Queries/XQuery/", $case/@FilePath, $query-name, ".xq" )
   let $xq-string := util:file-read($path, "UTF-8")
   return $xq-string
};

declare function xqts:print-result($test-name as xs:string, $passed as xs:boolean, $query as xs:string,
    $result as item()*, $expected as item()*, $case as element(catalog:test-case)) as element() {
    <test-case name="{$test-name}" result="{if ($passed) then 'pass' else 'fail'}">
    {
        if (not($passed)) then (
            <result>{$result}</result>,
            if ($expected instance of element() and count($expected/*) > 10) then
            	<expected truncated="">{$expected/*[position() < 10]}</expected>
            else
                <expected>{$expected}</expected>,
            (: element {$case/catalog:input-file/@variable} { xqts:getInputValue($case) }, :)
            <query>{$query}</query>
        ) else ()
    }
    </test-case>
};

declare function xqts:normalize-text($result as item()*) as xs:string {
    let $str := string-join(for $i in $result return string($i), " ")
    return
        (: Remove leading and trailing whitespace :)
        replace(replace($str, "^\s+", ""), "\s+$", "")
};

declare function xqts:normalize-and-expand($text as item()*) as xs:string {
	replace(replace(replace(xqts:normalize-text($text), "&amp;", "&", "m"), "&lt;", "<"),
		"&gt;", ">")
};

declare function xqts:check-output($query as xs:string, $result as item()*, $case as element(catalog:test-case)) {
    let $output := $case/catalog:output-file[last()]
    return
        (: Expected an error, but got a result :)
        if (exists($case/catalog:expected-error)) then
            <test-case name="{$case/@name}" result="fail">
                   <expected-error>{string-join($case/catalog:expected-error/text(), ";")}</expected-error>
                   <result>{$result}</result>
                   <query>{$query}</query>
            </test-case>
        (: Comparison method: "Text" :)
        else if ($output/@compare eq "Text") then
            let $text := util:file-read(concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath,
                "/", $output/text()), "UTF-8")
            let $test := xqts:normalize-and-expand($text) eq xqts:normalize-text($result)
            return
                xqts:print-result($case/@name, $test, $query, $result, $text, $case)
        (: Comparison method: "XML" :)
        else if ($output/@compare eq "XML") then
            util:catch("java.lang.Exception",
                let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath,
                    $output/text())
                let $expected := doc(xdb:store("/db", "temp.xml", xs:anyURI($filePath), "text/xml"))
                let $test := xdiff:compare($expected, $result)
                return
                    xqts:print-result($case/@name, $test, $query, $result, $expected, $case),
                (: Handle unexpected exceptions :)
                <test-case name="{$case/@name}" result="fail">
                   <exception>Exception while loading expected result: {$util:exception-message}</exception>
                   <query>{$query}</query>
                </test-case>
            )
        (: Comparison method: "Fragment" :)
        else if ($output/@compare eq "Fragment") then
            util:catch("java.lang.Exception",
                let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath, $output/text())
                let $expectedFrag := util:file-read($filePath, "UTF-8")
                let $xmlFrag := concat("<f>", $expectedFrag, "</f>")
                let $log := util:log("DEBUG", ("Frag stored: ", $xmlFrag))
                let $expected := doc(xdb:store("/db", "temp.xml", $xmlFrag, "text/xml"))
                let $test := xdiff:compare($expected, <f>{$result}</f>)
                return
                    xqts:print-result($case/@name, $test, $query, $result, $expected, $case),
                (: Handle unexpected exceptions :)
                <test-case name="{$case/@name}" result="fail">
                   <exception>Exception while loading expected result fragment: {$util:exception-message}</exception>
                   <query>{$query}</query>
                </test-case>
            )
        (: Comparison method: "Inspect" :)
        (: A text compare is sufficient in many test cases :)
        else if ($output/@compare eq "Inspect") then
            let $text := util:file-read(concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath,
                "/", $output/text()), "UTF-8")
            let $test := xqts:normalize-text($text) eq xqts:normalize-text($result)
            return
                xqts:print-result($case/@name, $test, $query, $result, $text, $case)

        (: Don't know how to compare :)
        else
            <error test="{$case/@name}">Unknown comparison method: {$output/@compare}.</error>
};

declare function xqts:get-variable($case as element(catalog:test-case),
	$name as xs:string) as item()* {
	let $path := concat( $xqts:XQTS_HOME, "Queries/XQuery/", $case/@FilePath, $name, ".xq" )
	let $xq-string := util:file-read($path, "UTF-8")
	return
		if (empty($xq-string)) then
			()
		else
			util:eval($xq-string)
};

declare function xqts:run-test-case( $case as element(catalog:test-case)) as item()* {
   let $query := xqts:get-query($case)
   let $result :=
       util:catch("java.lang.Exception",
			let $context :=
				<static-context>
       			{
           			for $input in $case/catalog:input-file
           			return
               			<variable name="{$input/@variable}">{xqts:get-input-value($input)}</variable>,
            		for $var in $case/catalog:input-query
            		return
                		<variable name="{$var/@variable}">
                    		{xqts:get-variable($case, $var/@name)}
                		</variable>
       			}
       			</static-context>
           let $result :=
               util:eval-with-context($query, $context, false())
           return
               xqts:check-output($query, $result, $case),
           if ($case//catalog:expected-error) then
               <test-case name="{$case/@name}" result="pass">
                   <exception>{$util:exception-message}</exception>
                   <expected-error>{string-join($case//catalog:expected-error/text(),";")}</expected-error>
                   <query>{$query}</query>
               </test-case>
           else
               <test-case name="{$case/@name}" result="fail">
                   <exception>{$util:exception-message}</exception>
					(: TODO : insert expected result here :)
                   <query>{$query}</query>
               </test-case>
       )
   return $result
};

declare function xqts:finish($result as element()) as empty() {
    let $passed := count($result//test-case[@result = 'pass'])
    let $failed := count($result//test-case[@result = 'fail'])
    return (
        update value $result/@passed with xs:int($passed),
        update value $result/@failed with xs:int($failed)
    )
};

declare function xqts:run-single-test-case($case as element(catalog:test-case),
    $resultRoot as element()?) as empty() {
    let $result := xqts:run-test-case($case)
    return (
        update insert $result into $resultRoot,
        let $added := $resultRoot/test-case[@name = $case/@name]
        return
            if ($added) then xqts:report-progress($added)
            else ()
    )
};

declare function xqts:run-test-group($group as element(catalog:test-group)) as empty() {
    (: Create the collection hierarchy for this group and get the results.xml doc to
        append to. :)
    let $resultsDoc := xqts:create-collections($group)
    let $tests := $group/catalog:test-case
(:
[
    	not(starts-with(@name, 'Constr-inscope-10')) and
    	not(starts-with(@name, 'Constr-inscope-12')) and
    	not(starts-with(@name, 'Constr-namespace-22'))
]
:)
    return (
        (: Execute the test cases :)
        for $test in $tests
        let $log := util:log("DEBUG", ("Running test case: ", string($test/@name)))
        return
            xqts:run-single-test-case($test, $resultsDoc/test-result),
        if ($tests) then
            xqts:finish($resultsDoc/test-result)
        else
            xdb:remove(util:collection-name($resultsDoc), util:document-name($resultsDoc)),
        (: Execute tests in child groups :)
        for $childGroup in $group/catalog:test-group
        let $log := util:log("DEBUG", ("Entering group: ", string($childGroup/@name)))
        return
            xqts:run-test-group($childGroup)
    )
};

declare function xqts:test-single($name as xs:string) as element() {
    let $test := //catalog:test-case[@name = $name]
    return
        if ($test) then
            let $resultsDoc := xqts:create-collections($test/parent::catalog:test-group)
            let $dummy := xqts:run-single-test-case($test, $resultsDoc/test-result)
            return
                $resultsDoc/test-result
        else
            <error>Test case not found: {$name}.</error>
};

declare function xqts:test-group($groupName as xs:string) as empty() {
    let $group := //catalog:test-group[@name = $groupName]
    return (
        xqts:create-progress-file(count($group//catalog:test-case)),
        xqts:run-test-group($group)
    )
};

declare function xqts:test-all() as empty() {
    for $test in /catalog:test-suite/catalog:test-group
    return
        xqts:test-group($test/@name)
};

declare function xqts:get-input-value($input as element(catalog:input-file)) as item()* {
   if ($input eq "emptydoc") then
       ()
   else (
       let $source := root($input)//catalog:source[@ID = $input/text()]
       return
           if (empty($source)) then
               concat("no input found: ", $input/text())
           else
               doc(concat("/db/XQTS/", $source/@FileName))
   )
};

declare function xqts:overall-result() {
    let $passed := count(//test-case[@result = "pass"])
    let $failed := count(//test-case[@result = "fail"])
    return
        <test-result failed="{$failed}" passed="{$passed}"
            percentage="{$passed div ($passed + $failed)}"/>
};

let $group := request:get-parameter('group', ())
return
    if ($group) then
        xqts:test-group($group)
    else
        ()

declare namespace xqts="http://exist-db.org/xquery/xqts";
declare namespace catalog="http://www.w3.org/2005/02/query-test-XQTSCatalog";

declare namespace props="java:java.io.File";

import module namespace util="http://exist-db.org/xquery/util";
import module namespace xdb="http://exist-db.org/xquery/xmldb";
import module namespace xdiff="http://exist-db.org/xquery/xmldiff"
at "java:org.exist.xquery.modules.xmldiff.XmlDiffModule";
import module namespace request="http://exist-db.org/xquery/request";
declare namespace system="http://exist-db.org/xquery/system";

(:~ ----------------------------------------------------------------------------------------
     W3C XQuery Test Suite

     This is the main module for running the XQTS on eXist. You can either
     run the whole test suite, a specific test group or a single test case.

     Setup:

     * Make sure the XmlDiff module is registered in conf.xml

     * Edit config.xml and change basedir to point to the directory into
     which you unzipped the XQTS sources. Note: it needs to be an URI.

     * Create a collection /db/XQTS in the database.

     * From the XQTS directory, upload XQTSCatalog.xml into the created
     collection.

     * Upload the "TestSources" directory so the source docs can be found
     in /db/XQTS/TestSources.

     * Run this script with the client.
     ------------------------------------------------------------------------------------------- :)
declare variable $xqts:CONFIG { xqts:initialize() };
declare variable $xqts:XQTS_HOME { xqts:path-to-uri($xqts:CONFIG/basedir/text()) };

declare function xqts:initialize() as element() {
    let $home := system:get-exist-home()
    let $path := concat($home, "/webapp/xqts")
    let $collection := xdb:create-collection("/db", "XQTS")
    let $config0 := doc("/db/XQTS")/config
    let $config :=
        if ($config0) then
            $config0
        else
            let $stored := xdb:store-files-from-pattern("/db/XQTS", $path, "*.xml", "text/xml")
            return
                doc("/db/XQTS/config.xml")/config
    let $xqtsHome := $config/basedir/text()
    let $catalog0 := doc("/db/XQTS/XQTSCatalog.xml")
    let $catalog :=
        if ($catalog0) then $catalog0
        else
            xdb:store($collection, "XQTSCatalog.xml",
                xs:anyURI(xqts:path-to-uri(concat($xqtsHome, "XQTSCatalog.xml"))))
    let $sources0 := collection("/db/XQTS/TestSources")
    let $sources :=
        if ($sources0) then
            $sources0
        else
            let $sourceCol := xdb:create-collection("/db/XQTS", "TestSources")
            return
                xdb:store-files-from-pattern($sourceCol, concat($xqtsHome, "TestSources"), "*.xml", "text/xml")
    return
        $config
};

declare function xqts:path-to-uri($path as xs:string) as xs:string {
        if (starts-with($path, "/")) then
            concat("file://", $path)
        else
            concat("file:///", $path)
};

declare function xqts:create-progress-file($testCount as xs:int) as empty() {
    let $results := xdb:store("/db/XQTS", "progress.xml",
        <progress total="{$testCount}" done="0" failed="0" passed="0"/>)
    return ()
};

declare function xqts:report-progress($test-case as element()) as empty() {
    let $result := string($test-case/@result)
    let $progress := doc("/db/XQTS/progress.xml")/progress
    let $counter := $progress/@done
    return (
        update value $counter with xs:int($counter + 1),
        if ($result eq 'fail') then
            update value $progress/@failed with xs:int($progress/@failed + 1)
        else
            update value $progress/@passed with xs:int($progress/@passed + 1)
    )
};

declare function xqts:create-collections($group as element(catalog:test-group)) as node() {
    let $rootColl := xdb:create-collection("/db/XQTS", "test-results")
    let $ancestors := reverse(($group/ancestor::catalog:test-group, $group))
    let $collection := xqts:create-collections($rootColl, $ancestors, "/db/XQTS/test-results")
    let $results := xdb:store($collection, "results.xml", <test-result failed="0" passed="0"/>)
    return
        doc($results)
};

declare function xqts:create-collections($parent as object,
    $pathElements as element()+, $currentPath as xs:string)
as object {
    let $next := $pathElements[last()]
    let $remainder := subsequence($pathElements, 1, count($pathElements) - 1)
    let $newColl := xdb:create-collection($parent, $next/@name)
    return
        if ($remainder) then
            xqts:create-collections($newColl, $remainder, concat($currentPath, "/", $next/@name))
        else
            $newColl
};

declare function xqts:get-query($case as element(catalog:test-case)) {
   let $query-name := $case//catalog:query/@name
   let $path := concat( $xqts:XQTS_HOME, "Queries/XQuery/", $case/@FilePath, $query-name, ".xq" )
   let $xq-string := util:file-read($path, "UTF-8")
   return $xq-string
};

declare function xqts:print-result($test-name as xs:string, $passed as xs:boolean, $query as xs:string,
    $result as item()*, $expected as item()*, $case as element(catalog:test-case)) as element() {
    <test-case name="{$test-name}" result="{if ($passed) then 'pass' else 'fail'}">
    {
        if (not($passed)) then (
            <result>{$result}</result>,
            if ($expected instance of element() and count($expected/*) > 10) then
            	<expected truncated="">{$expected/*[position() < 10]}</expected>
            else
                <expected>{$expected}</expected>,
            (: element {$case/catalog:input-file/@variable} { xqts:getInputValue($case) }, :)
            <query>{$query}</query>
        ) else ()
    }
    </test-case>
};

declare function xqts:normalize-text($result as item()*) as xs:string {
    let $str := string-join(for $i in $result return string($i), " ")
    return
        (: Remove leading and trailing whitespace :)
        replace(replace($str, "^\s+", ""), "\s+$", "")
};

declare function xqts:normalize-and-expand($text as item()*) as xs:string {
	replace(replace(replace(xqts:normalize-text($text), "&amp;", "&", "m"), "&lt;", "<"),
		"&gt;", ">")
};

declare function xqts:check-output($query as xs:string, $result as item()*, $case as element(catalog:test-case)) {
    let $output := $case/catalog:output-file[last()]
    return
        (: Expected an error, but got a result :)
        if (exists($case/catalog:expected-error)) then
            <test-case name="{$case/@name}" result="fail">
                   <expected-error>{string-join($case/catalog:expected-error/text(), ";")}</expected-error>
                   <result>{$result}</result>
                   <query>{$query}</query>
            </test-case>
        (: Comparison method: "Text" :)
        else if ($output/@compare eq "Text") then
            let $text := util:file-read(concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath,
                "/", $output/text()), "UTF-8")
            let $test := xqts:normalize-and-expand($text) eq xqts:normalize-text($result)
            return
                xqts:print-result($case/@name, $test, $query, $result, $text, $case)
        (: Comparison method: "XML" :)
        else if ($output/@compare eq "XML") then
            util:catch("java.lang.Exception",
                let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath,
                    $output/text())
                let $expected := doc(xdb:store("/db", "temp.xml", xs:anyURI($filePath), "text/xml"))
                let $test := xdiff:compare($expected, $result)
                return
                    xqts:print-result($case/@name, $test, $query, $result, $expected, $case),
                (: Handle unexpected exceptions :)
                <test-case name="{$case/@name}" result="fail">
                   <exception>Exception while loading expected result: {$util:exception-message}</exception>
                   <query>{$query}</query>
                </test-case>
            )
        (: Comparison method: "Fragment" :)
        else if ($output/@compare eq "Fragment") then
            util:catch("java.lang.Exception",
                let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath, $output/text())
                let $expectedFrag := util:file-read($filePath, "UTF-8")
                let $xmlFrag := concat("<f>", $expectedFrag, "</f>")
                let $log := util:log("DEBUG", ("Frag stored: ", $xmlFrag))
                let $expected := doc(xdb:store("/db", "temp.xml", $xmlFrag, "text/xml"))
                let $test := xdiff:compare($expected, <f>{$result}</f>)
                return
                    xqts:print-result($case/@name, $test, $query, $result, $expected, $case),
                (: Handle unexpected exceptions :)
                <test-case name="{$case/@name}" result="fail">
                   <exception>Exception while loading expected result fragment: {$util:exception-message}</exception>
                   <query>{$query}</query>
                </test-case>
            )
        (: Comparison method: "Inspect" :)
        (: A text compare is sufficient in many test cases :)
        else if ($output/@compare eq "Inspect") then
            let $text := util:file-read(concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath,
                "/", $output/text()), "UTF-8")
            let $test := xqts:normalize-text($text) eq xqts:normalize-text($result)
            return
                xqts:print-result($case/@name, $test, $query, $result, $text, $case)

        (: Don't know how to compare :)
        else
            <error test="{$case/@name}">Unknown comparison method: {$output/@compare}.</error>
};

declare function xqts:get-variable($case as element(catalog:test-case),
	$name as xs:string) as item()* {
	let $path := concat( $xqts:XQTS_HOME, "Queries/XQuery/", $case/@FilePath, $name, ".xq" )
	let $xq-string := util:file-read($path, "UTF-8")
	return
		if (empty($xq-string)) then
			()
		else
			util:eval($xq-string)
};

declare function xqts:run-test-case( $case as element(catalog:test-case)) as item()* {
   let $query := xqts:get-query($case)
   let $result :=
       util:catch("java.lang.Exception",
			let $context :=
				<static-context>
       			{
           			for $input in $case/catalog:input-file
           			return
               			<variable name="{$input/@variable}">{xqts:get-input-value($input)}</variable>,
            		for $var in $case/catalog:input-query
            		return
                		<variable name="{$var/@variable}">
                    		{xqts:get-variable($case, $var/@name)}
                		</variable>
       			}
       			</static-context>
           let $result :=
               util:eval-with-context($query, $context, false())
           return
               xqts:check-output($query, $result, $case),
           if ($case//catalog:expected-error) then
               <test-case name="{$case/@name}" result="pass">
                   <exception>{$util:exception-message}</exception>
                   <expected-error>{string-join($case//catalog:expected-error/text(),";")}</expected-error>
                   <query>{$query}</query>
               </test-case>
           else
               <test-case name="{$case/@name}" result="fail">
                   <exception>{$util:exception-message}</exception>
                   <query>{$query}</query>
               </test-case>
       )
   return $result
};

declare function xqts:finish($result as element()) as empty() {
    let $passed := count($result//test-case[@result = 'pass'])
    let $failed := count($result//test-case[@result = 'fail'])
    return (
        update value $result/@passed with xs:int($passed),
        update value $result/@failed with xs:int($failed)
    )
};

declare function xqts:run-single-test-case($case as element(catalog:test-case),
    $resultRoot as element()?) as empty() {
    let $result := xqts:run-test-case($case)
    return (
        update insert $result into $resultRoot,
        let $added := $resultRoot/test-case[@name = $case/@name]
        return
            if ($added) then xqts:report-progress($added)
            else ()
    )
};

declare function xqts:run-test-group($group as element(catalog:test-group)) as empty() {
    (: Create the collection hierarchy for this group and get the results.xml doc to
        append to. :)
    let $resultsDoc := xqts:create-collections($group)
    let $tests := $group/catalog:test-case
(:
[
    	not(starts-with(@name, 'Constr-inscope-10')) and
    	not(starts-with(@name, 'Constr-inscope-12')) and
    	not(starts-with(@name, 'Constr-namespace-22'))
]
:)
    return (
        (: Execute the test cases :)
        for $test in $tests
        let $log := util:log("DEBUG", ("Running test case: ", string($test/@name)))
        return
            xqts:run-single-test-case($test, $resultsDoc/test-result),
        if ($tests) then
            xqts:finish($resultsDoc/test-result)
        else
            xdb:remove(util:collection-name($resultsDoc), util:document-name($resultsDoc)),
        (: Execute tests in child groups :)
        for $childGroup in $group/catalog:test-group
        let $log := util:log("DEBUG", ("Entering group: ", string($childGroup/@name)))
        return
            xqts:run-test-group($childGroup)
    )
};

declare function xqts:test-single($name as xs:string) as element() {
    let $test := //catalog:test-case[@name = $name]
    return
        if ($test) then
            let $resultsDoc := xqts:create-collections($test/parent::catalog:test-group)
            let $dummy := xqts:run-single-test-case($test, $resultsDoc/test-result)
            return
                $resultsDoc/test-result
        else
            <error>Test case not found: {$name}.</error>
};

declare function xqts:test-group($groupName as xs:string) as empty() {
    let $group := //catalog:test-group[@name = $groupName]
    return (
        xqts:create-progress-file(count($group//catalog:test-case)),
        xqts:run-test-group($group)
    )
};

declare function xqts:test-all() as empty() {
    for $test in /catalog:test-suite/catalog:test-group
    return
        xqts:test-group($test/@name)
};

declare function xqts:get-input-value($input as element(catalog:input-file)) as item()* {
   if ($input eq "emptydoc") then
       ()
   else (
       let $source := root($input)//catalog:source[@ID = $input/text()]
       return
           if (empty($source)) then
               concat("no input found: ", $input/text())
           else
               doc(concat("/db/XQTS/", $source/@FileName))
   )
};

declare function xqts:overall-result() {
    let $passed := count(//test-case[@result = "pass"])
    let $failed := count(//test-case[@result = "fail"])
    return
        <test-result failed="{$failed}" passed="{$passed}"
            percentage="{$passed div ($passed + $failed)}"/>
};

let $group := request:get-parameter('group', ())
return
    if ($group) then
        xqts:test-group($group)
    else
        ()