generate fcs-resource-scan from mapping; limit to the size of analyzed data chunk

module namespace crday  = "http://aac.ac.at/content_repository/data-ay";

import module namespace repo-utils =  "http://aac.ac.at/content_repository/utils" at  "repo-utils.xqm";
import module namespace diag =  "http://www.loc.gov/zing/srw/diagnostic/" at  "modules/diagnostics/diagnostics.xqm";

import module namespace xdb="http://exist-db.org/xquery/xmldb";
(:import module namespace diag =  "http://www.loc.gov/zing/srw/diagnostic/" at  "modules/diagnostics/diagnostics.xqm";
import module namespace util="http://exist-db.org/xquery/util";
import module namespace kwic="http://exist-db.org/xquery/kwic";
:)
declare namespace sru = "http://www.loc.gov/zing/srw/";
declare namespace fcs = "http://clarin.eu/fcs/1.0";
declare namespace cmd = "http://www.clarin.eu/cmd/";
(:declare namespace tei = "http://www.tei-c.org/ns/1.0";:)

declare variable $crday:docTypeTerms := "Terms";
declare variable $crday:defaultMaxDepth:= 8;
(: just analyze a subsequence of: :)
declare variable $crday:maxAyRecords:= 1000;
declare variable $crday:restrictAyRecordsSize:= true();

(:~ overload function with default format-param = htmlpage:)
declare function crday:display-overview($config-path as xs:string) as item()* {
 crday:display-overview($config-path, 'htmlpage')
};

(:~ creates a html-overview of the datasets based on the defined mappings (as linked to from config)

@param config-path path to the confing-file
@param format [raw, htmlpage, html] - raw: return only the produced table, html* : serialize as html
@returns a html-table with overview of the datasets
:)
declare function crday:display-overview($config-path as xs:string, $format as xs:string ) as item()* {

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

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

let $overview :=

collection	path	size	base-elem	indexes	tests	struct

           { for $map in $mappings//map[@key]
                    let $map-key := $map/xs:string(@key),
                        $map-dbcoll-path := $map/xs:string(@path),
(:                        $map-dbcoll:= if ($map-dbcoll-path ne '' and xmldb:collection-available (($map-dbcoll-path,"")[1])) then collection($map-dbcoll-path) else (),                      :)
                          $map-dbcoll:= repo-utils:context-to-collection($map-key, $config),

                        $queries-doc-name := crday:check-queries-doc-name($config, $map-key),
                        $sturct-doc-name := repo-utils:gen-cache-id("structure", ($map-key,""), xs:string($crday:defaultMaxDepth)),
                        $invoke-href := concat($baseadminurl,'?x-context=', $map-key ,'&config=', $config-path, '&operation=' ),
                        $queries := if (repo-utils:is-in-cache($queries-doc-name, $config)) then
                                                view
                                              else (),
                        $structure := if (repo-utils:is-in-cache($sturct-doc-name, $config)) then
                                                view
                                              else ()
                    return

                        {$map-key}
                        {$map-dbcoll-path}
                        {count($map-dbcoll)}
                        {$map/xs:string(@base_elem)}
                        {count($map/index)}
                        {$queries} [run]
                        {$structure} [run]

                        }

            (: ns	root-elem
            $root-elems := for $elem in distinct-values($map-dbcoll/*/name()) return $elem,
            $ns-uris := for $ns in distinct-values($map-dbcoll/namespace-uri(*)) return $ns,
                        {$ns-uris}
                        {$root-elems}	:)

       return if ($format eq 'raw') then
                   $overview
                else
                   repo-utils:serialise-as($overview, $format, 'html', $config, ())
};

declare function crday:get-fcs-resource-scan($config-path as xs:string, $run-flag as xs:boolean, $format as xs:string ) as item()* {

  let $config := doc($config-path),
    $name := repo-utils:gen-cache-id("index", ('', 'fcs.resource', 'text'), xs:string(1)),
    $result :=
    if (repo-utils:is-in-cache($name, $config) and not($run-flag)) then
        repo-utils:get-from-cache($name, $config)
    else
        let $data := crday:gen-fcs-resource-scan($config)
        return repo-utils:store-in-cache($name, $data,$config)

  return if ($format eq 'raw') then
            $result
         else
          repo-utils:serialise-as($result, $format, 'scan', $config, ())
};

(:~ gen fcs-resource scan out of mappings :)
declare function crday:gen-fcs-resource-scan($config as node()) as item()* {

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

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

let $map2terms := for $map in $mappings//map[@key]
                    let $context-key := $map/xs:string(@key),
                        $context-label := if ($map/@label) then $map/xs:string(@label) else $map/xs:string(@key),
                        $map-dbcoll-path := $map/xs:string(@path),
(:                        $map-dbcoll:= if ($map-dbcoll-path ne '' and xmldb:collection-available (($map-dbcoll-path,"")[1])) then collection($map-dbcoll-path) else (),                      :)
                         $map-dbcoll:= repo-utils:context-to-collection($context-key, $config)
                     return <sru:term>
                            <sru:value>{ $context-key }</sru:value>
                            <sru:numberOfRecords>{count($map-dbcoll)}</sru:numberOfRecords>
                            <sru:displayTerm>{$context-label}</sru:displayTerm>
                          </sru:term>

    let $count-all := count($map2terms)
    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>
                {$map2terms }
               </sru:terms>
               <sru:extraResponseData>
                     <fcs:countTerms>{$count-all}</fcs:countTerms>
                 </sru:extraResponseData>
                 <sru:echoedScanRequest>
                      <sru:scanClause>fcs.resource</sru:scanClause>
                  </sru:echoedScanRequest>
           </sru:scanResponse>

};

(:~ run or view (if available) internal check queries

@param format [raw, htmlpage, html] - raw: return only the produced table, html* : serialize as html
:)
declare function crday:get-query-internal($config as node(), $x-context as xs:string, $run-flag as xs:boolean, $format as xs:string ) as item()* {

    let $testset := doc(repo-utils:config-value($config, 'tests.path')),

        $cache-path := repo-utils:config-value($config, 'cache.path'),
        $queries-doc-name := crday:check-queries-doc-name($config, $x-context),

  (: get the the results from cache, or create :)
  $result := if (exists($testset)) then
                if (repo-utils:is-in-cache($queries-doc-name, $config) and not($run-flag)) then
                    repo-utils:get-from-cache($queries-doc-name, $config)
                  else
                    let $context := repo-utils:context-to-collection($x-context, $config)
                    return if (exists($context)) then
                            crday:gen-query-internal($testset, $context, $x-context, $cache-path, $queries-doc-name)
                            (: no need to store, because already continuously stored during querying
                                 return repo-utils:store-in-cache($index-doc-name , $data, $config) :)
                           else
                            diag:diagnostics("general-error", concat("run-check-queries: no context: ", $x-context))
               else
                diag:diagnostics("general-error", concat("run-check-queries: no testset available: ", repo-utils:config-value($config, 'tests.path')))

(:  return $result:)
   return if ($format eq 'raw') then
            $result
         else
            repo-utils:serialise-as($result, $format, 'table', $config, ())
};

(:~ evaluates queries against given context and stores the result in aresult-file

@param $queries list of <xpath>-elements
@param $context nodeset to evaluate the queries against ($context shall be used in the queries)
@param $x-context string-key identifying the context
:)
declare function crday:gen-query-internal($queries, $context as node()*, $x-context as xs:string+, $result-path as xs:string, $result-filename as xs:string ) as item()* {

    (: collect the xpaths from the queries-list before fiddling with the namespace :)
    let $xpaths := $queries//xpath
    (:    let $context := repo-utils:context-to-collection($x-context, $config)
	   $context:= collection("/db/mdrepo-data/cmdi-providers"),	   :)

    let $result-store := xmldb:store($result-path ,  $result-filename, <result test="{$queries//test/xs:string(@id)}" context="{$x-context}" ></result>),
        $result-doc:= doc($result-store)

    let $ns-uri := namespace-uri($context[1]/*)
      (: dynamically declare a default namespace for the xpath-evaluation, if one is defined in current context
      WATCHME: this is not very reliable, mainly meant to handle default-ns: cmd :)
(:      $dummy := if (exists($ns-uri)) then util:declare-namespace("",$ns-uri) else () :)
    let $dummy := util:declare-namespace("",xs:anyURI($ns-uri))

    let $start-time := util:system-dateTime()
    let $upd-dummy :=
        for $xpath in $xpaths
            let $start-time := util:system-dateTime()
            let $answer := util:eval($xpath/text())
            let $duration := util:system-dateTime() - $start-time
           return update insert <xpath key="{$xpath/@key}" label="{$xpath/@label}" dur="{$duration}">{$answer}</xpath> into $result-doc/result

    return $result-doc
};

(:~ wrapper for the ay-xml function cares for storing the result or fetching a stored one

@param format [raw, htmlpage, html] - raw: return only the produced table, html* : serialize as html
:)
declare function crday:get-ay-xml($config as node(), $x-context as xs:string+, $init-xpath as xs:string, $max-depth as xs:integer, $run-flag as xs:boolean, $format as xs:string ) as item()? {

  let $name := repo-utils:gen-cache-id("structure", ($x-context, $init-xpath), xs:string($max-depth)),
    $result :=
    if (repo-utils:is-in-cache($name, $config) and not($run-flag)) then
        repo-utils:get-from-cache($name, $config)
    else

      let $context := repo-utils:context-to-collection($x-context, $config)
             (: prevent running on whole default collection - rather do it context by context :)
      return if (exists($context) and $x-context ne '') then
                    let $data := crday:gen-ay-xml($context, $init-xpath, $max-depth)
                    return repo-utils:store-in-cache($name, $data,$config)
                  else
                    diag:diagnostics("general-error", concat("run-ay-xml: no context: ", $x-context))

   return if ($format eq 'raw') then
            $result
         else
          repo-utils:serialise-as($result, $format, 'terms', $config, ())
};

(:~ analyzes the xml-structure - sub-elements and text-nodes
in the context of given collection, starting from given xpath

@param $context nodeset to analyze
@param $path if starts-with '/' or = '' start directly at the $context, else eval on f 'descendants-or-self'-axis
            if $path empty - diagnostics
calls elem-r for recursive processing

@returns xml-with paths and numbers
:)
declare function crday:gen-ay-xml($context as item()*, $path as xs:string, $depth as xs:integer ) as element() {

  (:let $collection := collection($cr:dataPath),
  if ($collections[1] eq $cr:collectionRoot) then
  util:eval(fn:concat("$collection/descendant::IsPartOf[ft:query(., <query><term>", xdb:decode($coll), "</term></query>)]/ancestor-or-self::CMD/descendant-or-self::", $path))
  :)
  if (not(exists($path))) then
        diag:diagnostics("general-error", "ay-xml: no starting path provided")
    else

        let $ns-uri := namespace-uri($context[1]/*),
            $local-name := $context[1]/*/local-name(),
(:            $prefix := if (exists(prefix-from-QName($qname))) then prefix-from-QName($qname) else "",:)
            $dummy := if (exists($ns-uri)) then util:declare-namespace("",$ns-uri) else ()

        let $full-path := if (starts-with($path,'/') or $path = '') then
                             fn:concat("$context", $path)
                            else     fn:concat("$context/descendant-or-self::", $path)

       let $path-nodes := if ($crday:restrictAyRecordsSize) then
                               subsequence(util:eval($full-path), 1, $crday:maxAyRecords)
                            else
                               util:eval($full-path)

       let $entries := crday:elem-r($path-nodes, $path, $ns-uri, $depth, $depth),
     (:      $coll-names-value := if (fn:empty($collections)) then () else attribute colls {fn:string-join($collections, ",")},:)
             $dummy-undeclare-ns := util:declare-namespace("",xs:anyURI("")),
     	  $result := element {$crday:docTypeTerms} {
     (:      		  $coll-names-value,:)
           		  attribute depth {$depth},
           		  attribute created {fn:current-dateTime()},
           		  $entries
     		}
         return $result

};

(:~ goes down the xml-structure recursively and creates a summary about it along the way

namespace aware (handles namespace: none, default, explicit)
:)
declare function crday:elem-r($path-nodes as node()*, $path as xs:string, $ns as xs:anyURI?, $max-depth as xs:integer, $depth as xs:integer) as element() {
      let $path-count := count($path-nodes),
	$child-elements := $path-nodes/child::element(),
	$child-ns-qnames := if (exists($child-elements)) then distinct-values($child-elements/concat(namespace-uri(), '|', local-name())) else (),
	$nodes-child-terminal := if (empty($child-elements)) then $path-nodes else () (: Maybe some selected elements $child-elements[not(element())] later on :),
	$text-nodes := $nodes-child-terminal/text(),
	$text-count := count($text-nodes),
	$text-count-distinct := count(distinct-values($text-nodes)),
	$dummy-undeclare-ns := util:declare-namespace("",xs:anyURI(""))
	return
(:	<Term path="{fn:concat("//", $path)}" name="{text:groups($path, "/([^/]+)$")[last()]}" count="{$path-count}" count_text="{$text-count}"  count_distinct_text="{$text-count-distinct}">{ :)
	<Term path="{fn:concat("", translate($path,'/','.'))}" name="{(text:groups($path, "/([^/]+)$")[last()],$path)[1] }" count="{$path-count}" count_text="{$text-count}"  count_distinct_text="{$text-count-distinct}">{
	   (attribute ns {$ns},
	  if ($depth > 0) then
	    for $ns-qname in $child-ns-qnames[. != '']
	       let $ns-uri := substring-before($ns-qname, '|'),
	           $local-name := substring-after($ns-qname, '|'),
(:	           $prefix := if (exists(prefix-from-QName($qname))) then prefix-from-QName($qname) else "",:)
	           (: 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 ()
	           return
	           crday:elem-r(util:eval(concat("$path-nodes/", $local-name)), concat($path, '/', $local-name), $ns-uri, $max-depth, $depth - 1)
	  (:
	    for $ns-qname in $child-ns-qnames[. != '']
	       let $ns-uri := substring-before($ns-qname, '|'),
	           $qname := substring-after($ns-qname, '|'),
	           $prefix := if (exists(prefix-from-QName($qname))) then prefix-from-QName($qname) else "",
	           (\: dynamically declare a namespace for the next step, if one is defined in current context :\)
	           $dummy := if (exists($ns-uri)) then util:declare-namespace($prefix,$ns-uri) else ()
	           return
	           crday:elem-r(util:eval(concat("$path-nodes/", $qname)), concat($path, '/', $qname), $ns-uri, $max-depth, $depth - 1):)
	  else 'maxdepth'
	)}</Term>
};

(:~ return doc-name out of context and testset (from config) or empty string if testset does not exist :)
declare function crday:check-queries-doc-name($config as node(), $x-context as xs:string) as xs:string {
let $testset := doc(repo-utils:config-value($config, 'tests.path')),
    $testset-name := if (exists($testset)) then util:document-name($testset) else (),
    $sanitized-xcontext := repo-utils:sanitize-name($x-context)
 return if (exists($testset)) then repo-utils:gen-cache-id("queries", ($sanitized-xcontext, $testset-name),"") else ""

};

module namespace crday  = "http://aac.ac.at/content_repository/data-ay";

import module namespace repo-utils =  "http://aac.ac.at/content_repository/utils" at  "repo-utils.xqm";
import module namespace diag =  "http://www.loc.gov/zing/srw/diagnostic/" at  "modules/diagnostics/diagnostics.xqm";

import module namespace xdb="http://exist-db.org/xquery/xmldb";
(:import module namespace diag =  "http://www.loc.gov/zing/srw/diagnostic/" at  "modules/diagnostics/diagnostics.xqm";
import module namespace util="http://exist-db.org/xquery/util";
import module namespace kwic="http://exist-db.org/xquery/kwic";
:)
declare namespace sru = "http://www.loc.gov/zing/srw/";
declare namespace fcs = "http://clarin.eu/fcs/1.0";
declare namespace cmd = "http://www.clarin.eu/cmd/";
(:declare namespace tei = "http://www.tei-c.org/ns/1.0";:)

declare variable $crday:docTypeTerms := "Terms";
declare variable $crday:defaultMaxDepth:= 8;

(:~ overload function with default format-param = htmlpage:)
declare function crday:display-overview($config-path as xs:string) as item()* {
 crday:display-overview($config-path, 'htmlpage')
};

(:~ creates a html-overview of the datasets based on the defined mappings (as linked to from config)

@param config-path path to the confing-file
@param format [raw, htmlpage, html] - raw: return only the produced table, html* : serialize as html
@returns a html-table with overview of the datasets
:)
declare function crday:display-overview($config-path as xs:string, $format as xs:string ) as item()* {

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

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

(:    {for $target in $config//target return {xs:string($target/@key)}	}
:)
let $overview :=

collection	path	size	base-elem	indexes	tests	struct

           { for $map in $mappings//map[@key]
                    let $map-key := $map/xs:string(@key),
                        $map-dbcoll-path := $map/xs:string(@path),
(:                        $map-dbcoll:= if ($map-dbcoll-path ne '' and xmldb:collection-available (($map-dbcoll-path,"")[1])) then collection($map-dbcoll-path) else (),                      :)
                          $map-dbcoll:= repo-utils:context-to-collection($map-key, $config),

                        $queries-doc-name := crday:check-queries-doc-name($config, $map-key),
                        $sturct-doc-name := repo-utils:gen-cache-id("structure", ($map-key,""), xs:string($crday:defaultMaxDepth)),
                        $invoke-href := concat($baseadminurl,'?x-context=', $map-key ,'&config=', $config-path, '&operation=' ),
                        $queries := if (repo-utils:is-in-cache($queries-doc-name, $config)) then
                                                view
                                              else (),
                        $structure := if (repo-utils:is-in-cache($sturct-doc-name, $config)) then
                                                view
                                              else ()
                    return

                        {$map-key}
                        {$map-dbcoll-path}
                        {count($map-dbcoll)}
                        {$map/xs:string(@base_elem)}
                        {count($map/index)}
                        {$queries} [run]
                        {$structure} [run]

                        }

            (: ns	root-elem
            $root-elems := for $elem in distinct-values($map-dbcoll/*/name()) return $elem,
            $ns-uris := for $ns in distinct-values($map-dbcoll/namespace-uri(*)) return $ns,
                        {$ns-uris}
                        {$root-elems}	:)

       return if ($format eq 'raw') then
                   $overview
                else
                   repo-utils:serialise-as($overview, $format, 'html', $config, ())
};

(:~ run or view (if available) internal check queries

@param format [raw, htmlpage, html] - raw: return only the produced table, html* : serialize as html
:)
declare function crday:get-query-internal($config as node(), $x-context as xs:string, $run-flag as xs:boolean, $format as xs:string ) as item()* {

    let $testset := doc(repo-utils:config-value($config, 'tests.path')),

        $cache-path := repo-utils:config-value($config, 'cache.path'),
        $queries-doc-name := crday:check-queries-doc-name($config, $x-context),

  (: get the the results from cache, or create :)
  $result := if (exists($testset)) then
                if (repo-utils:is-in-cache($queries-doc-name, $config) and not($run-flag)) then
                    repo-utils:get-from-cache($queries-doc-name, $config)
                  else
                    let $context := repo-utils:context-to-collection($x-context, $config)
                    return if (exists($context)) then
                            crday:gen-query-internal($testset, $context, $x-context, $cache-path, $queries-doc-name)
                            (: no need to store, because already continuously stored during querying
                                 return repo-utils:store-in-cache($index-doc-name , $data, $config) :)
                           else
                            diag:diagnostics("general-error", concat("run-check-queries: no context: ", $x-context))
               else
                diag:diagnostics("general-error", concat("run-check-queries: no testset available: ", repo-utils:config-value($config, 'tests.path')))

(:  return $result:)
   return if ($format eq 'raw') then
            $result
         else
            repo-utils:serialise-as($result, $format, 'table', $config, ())
};

(:~ evaluates queries against given context and stores the result in aresult-file

@param $queries list of <xpath>-elements
@param $context nodeset to evaluate the queries against ($context shall be used in the queries)
@param $x-context string-key identifying the context
:)
declare function crday:gen-query-internal($queries, $context as node()*, $x-context as xs:string+, $result-path as xs:string, $result-filename as xs:string ) as item()* {

    (: collect the xpaths from the queries-list before fiddling with the namespace :)
    let $xpaths := $queries//xpath
    (:    let $context := repo-utils:context-to-collection($x-context, $config)
	   $context:= collection("/db/mdrepo-data/cmdi-providers"),	   :)

    let $result-store := xmldb:store($result-path ,  $result-filename, <result test="{$queries//test/xs:string(@id)}" context="{$x-context}" ></result>),
        $result-doc:= doc($result-store)

    let $ns-uri := namespace-uri($context[1]/*)
      (: dynamically declare a default namespace for the xpath-evaluation, if one is defined in current context
      WATCHME: this is not very reliable, mainly meant to handle default-ns: cmd :)
(:      $dummy := if (exists($ns-uri)) then util:declare-namespace("",$ns-uri) else () :)
    let $dummy := util:declare-namespace("",xs:anyURI($ns-uri))

    let $start-time := util:system-dateTime()
    let $upd-dummy :=
        for $xpath in $xpaths
            let $start-time := util:system-dateTime()
            let $answer := util:eval($xpath/text())
            let $duration := util:system-dateTime() - $start-time
           return update insert <xpath key="{$xpath/@key}" label="{$xpath/@label}" dur="{$duration}">{$answer}</xpath> into $result-doc/result

    return $result-doc
};

(:~ wrapper for the ay-xml function cares for storing the result or fetching a stored one

@param format [raw, htmlpage, html] - raw: return only the produced table, html* : serialize as html
:)
declare function crday:get-ay-xml($config as node(), $x-context as xs:string+, $init-xpath as xs:string, $max-depth as xs:integer, $run-flag as xs:boolean, $format as xs:string ) as item()? {

  let $name := repo-utils:gen-cache-id("structure", ($x-context, $init-xpath), xs:string($max-depth)),
    $result :=
    if (repo-utils:is-in-cache($name, $config) and not($run-flag)) then
        repo-utils:get-from-cache($name, $config)
    else
      let $context := repo-utils:context-to-collection($x-context, $config)
      return if (exists($context)) then
                    let $data := crday:gen-ay-xml($context, $init-xpath, $max-depth)
                    return repo-utils:store-in-cache($name, $data,$config)
                  else
                    diag:diagnostics("general-error", concat("run-ay-xml: no context: ", $x-context))

   return if ($format eq 'raw') then
            $result
         else
          repo-utils:serialise-as($result, $format, 'terms', $config, ())
};

(:~ analyzes the xml-structure - sub-elements and text-nodes
in the context of given collection, starting from given xpath

@param $context nodeset to analyze
@param $path if starts-with '/' or = '' start directly at the $context, else eval on f 'descendants-or-self'-axis
            if $path empty - diagnostics
calls elem-r for recursive processing

@returns xml-with paths and numbers
:)
declare function crday:gen-ay-xml($context as item()*, $path as xs:string, $depth as xs:integer ) as element() {

  (:let $collection := collection($cr:dataPath),
  if ($collections[1] eq $cr:collectionRoot) then
  util:eval(fn:concat("$collection/descendant::IsPartOf[ft:query(., <query><term>", xdb:decode($coll), "</term></query>)]/ancestor-or-self::CMD/descendant-or-self::", $path))
  :)
  if (not(exists($path))) then
        diag:diagnostics("general-error", "ay-xml: no starting path provided")
    else
        let $ns-uri := namespace-uri($context[1]/*),
            $qname := $context[1]/*/name(),
            $prefix := if (exists(prefix-from-QName($qname))) then prefix-from-QName($qname) else "",
            $dummy := if (exists($ns-uri)) then util:declare-namespace($prefix,$ns-uri) else ()

        let $full-path := if (starts-with($path,'/') or $path = '') then
                             fn:concat("$context", $path)
                            else     fn:concat("$context/descendant-or-self::", $path)

       let $path-nodes := util:eval($full-path )

       let $entries := crday:elem-r($path-nodes, $path, $ns-uri, $depth, $depth),
     (:      $coll-names-value := if (fn:empty($collections)) then () else attribute colls {fn:string-join($collections, ",")},:)
             $dummy-undeclare-ns := util:declare-namespace("",xs:anyURI("")),
     	  $result := element {$crday:docTypeTerms} {
     (:      		  $coll-names-value,:)
           		  attribute depth {$depth},
           		  attribute created {fn:current-dateTime()},
           		  $entries
     		}
         return $result

};

(:~ goes down the xml-structure recursively and creates a summary about it along the way

namespace aware (handles namespace: none, default, explicit)
:)
declare function crday:elem-r($path-nodes as node()*, $path as xs:string, $ns as xs:anyURI?, $max-depth as xs:integer, $depth as xs:integer) as element() {
      let $path-count := count($path-nodes),
	$child-elements := $path-nodes/child::element(),
	$child-ns-qnames := if (exists($child-elements)) then distinct-values($child-elements/concat(namespace-uri(), '|', local-name())) else (),
	$nodes-child-terminal := if (empty($child-elements)) then $path-nodes else () (: Maybe some selected elements $child-elements[not(element())] later on :),
	$text-nodes := $nodes-child-terminal/text(),
	$text-count := count($text-nodes),
	$text-count-distinct := count(distinct-values($text-nodes)),
	$dummy-undeclare-ns := util:declare-namespace("",xs:anyURI(""))
	return
(:	<Term path="{fn:concat("//", $path)}" name="{text:groups($path, "/([^/]+)$")[last()]}" count="{$path-count}" count_text="{$text-count}"  count_distinct_text="{$text-count-distinct}">{ :)
	<Term path="{fn:concat("", translate($path,'/','.'))}" name="{(text:groups($path, "/([^/]+)$")[last()],$path)[1] }" count="{$path-count}" count_text="{$text-count}"  count_distinct_text="{$text-count-distinct}">{
	   (attribute ns {$ns},
	  if ($depth > 0) then
	    for $ns-qname in $child-ns-qnames[. != '']
	       let $ns-uri := substring-before($ns-qname, '|'),
	           $local-name := substring-after($ns-qname, '|'),
(:	           $prefix := if (exists(prefix-from-QName($qname))) then prefix-from-QName($qname) else "",:)
	           (: 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 ()
	           return
	           crday:elem-r(util:eval(concat("$path-nodes/", $local-name)), concat($path, '/', $local-name), $ns-uri, $max-depth, $depth - 1)
	  (:
	    for $ns-qname in $child-ns-qnames[. != '']
	       let $ns-uri := substring-before($ns-qname, '|'),
	           $qname := substring-after($ns-qname, '|'),
	           $prefix := if (exists(prefix-from-QName($qname))) then prefix-from-QName($qname) else "",
	           (\: dynamically declare a namespace for the next step, if one is defined in current context :\)
	           $dummy := if (exists($ns-uri)) then util:declare-namespace($prefix,$ns-uri) else ()
	           return
	           crday:elem-r(util:eval(concat("$path-nodes/", $qname)), concat($path, '/', $qname), $ns-uri, $max-depth, $depth - 1):)
	  else 'maxdepth'
	)}</Term>
};

(:~ return doc-name out of context and testset (from config) or empty string if testset does not exist :)
declare function crday:check-queries-doc-name($config as node(), $x-context as xs:string) as xs:string {
let $testset := doc(repo-utils:config-value($config, 'tests.path')),
    $testset-name := if (exists($testset)) then util:document-name($testset) else (),
    $sanitized-xcontext := repo-utils:sanitize-name($x-context)
 return if (exists($testset)) then repo-utils:gen-cache-id("queries", ($sanitized-xcontext, $testset-name),"") else ""

};


DHFPROD-3068: fix namespace whoops

DHFPROD-3068: fix namespace whoops

(:
  Copyright 2012-2019 MarkLogic Corporation

  Licensed under the Apache License, Version 2.0 (the "License");
  you may not use this file except in compliance with the License.
  You may obtain a copy of the License at

     http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.
:)
xquery version "1.0-ml";

module namespace inputFlow = "http://marklogic.com/rest-api/transform/ml:inputFlow";

import module namespace consts = "http://marklogic.com/data-hub/consts"
at "/data-hub/4/impl/consts.xqy";

import module namespace debug = "http://marklogic.com/data-hub/debug"
at "/data-hub/4/impl/debug-lib.xqy";

import module namespace flow = "http://marklogic.com/data-hub/flow-lib"
at "/data-hub/4/impl/flow-lib.xqy";

import module namespace trace = "http://marklogic.com/data-hub/trace"
at "/data-hub/4/impl/trace-lib.xqy";

import module namespace perf = "http://marklogic.com/data-hub/perflog-lib"
at "/data-hub/4/impl/perflog-lib.xqy";

declare namespace hub = "http://marklogic.com/data-hub";

declare namespace rapi = "http://marklogic.com/rest-api";

declare %rapi:transaction-mode("query") function inputFlow:transform(
  $context as map:map,
  $params as map:map,
  $content as document-node()
) as document-node()
{
  debug:dump-env("input-flow:transform"),

  perf:log('/transforms/input-flow:transform', function() {
    let $job-id := (map:get($params, "job-id"), sem:uuid-string())[1]
    let $entity-name := map:get($params, 'entity-name')
    let $flow-name := map:get($params, 'flow-name')
    let $uri := map:get($context, 'uri')
    let $flow := flow:get-flow($entity-name, $flow-name, $consts:INPUT_FLOW)
    let $_ :=
      if ($flow) then ()
      else
        fn:error((),"RESTAPI-SRVEXERR", ("404","MISSING_FLOW", "The specified flow " || $entity-name || ":" || $flow-name || " is missing."))

    (: configure the options :)
    let $options as map:map := (
      map:get($params, "options") ! xdmp:unquote(.)/object-node(),
      map:map()
    )[1]
    let $_ := flow:set-default-options($options, $flow)

    let $mainFunc := flow:get-main($flow/hub:main)
    (: this can throw, but we want the REST API to know about problems, so let it :)
    let $envelope := flow:run-flow(
      $job-id, $flow, $uri, $content, $options, $mainFunc
    )

    (: write the trace for the current identifier :)
    let $item-context := map:get($flow:context-queue, $uri)
    let $_ := trace:write-trace($item-context)
    return
      document { $envelope }
  })
};

(:
  Copyright 2012-2019 MarkLogic Corporation

  Licensed under the Apache License, Version 2.0 (the "License");
  you may not use this file except in compliance with the License.
  You may obtain a copy of the License at

     http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.
:)
xquery version "1.0-ml";

module namespace runFlow = "http://marklogic.com/rest-api/transform/ml:inputFlow";

import module namespace consts = "http://marklogic.com/data-hub/consts"
at "/data-hub/4/impl/consts.xqy";

import module namespace debug = "http://marklogic.com/data-hub/debug"
at "/data-hub/4/impl/debug-lib.xqy";

import module namespace flow = "http://marklogic.com/data-hub/flow-lib"
at "/data-hub/4/impl/flow-lib.xqy";

import module namespace trace = "http://marklogic.com/data-hub/trace"
at "/data-hub/4/impl/trace-lib.xqy";

import module namespace perf = "http://marklogic.com/data-hub/perflog-lib"
at "/data-hub/4/impl/perflog-lib.xqy";

declare namespace hub = "http://marklogic.com/data-hub";

declare namespace rapi = "http://marklogic.com/rest-api";

declare %rapi:transaction-mode("query") function inputFlow:transform(
  $context as map:map,
  $params as map:map,
  $content as document-node()
) as document-node()
{
  debug:dump-env("input-flow:transform"),

  perf:log('/transforms/input-flow:transform', function() {
    let $job-id := (map:get($params, "job-id"), sem:uuid-string())[1]
    let $entity-name := map:get($params, 'entity-name')
    let $flow-name := map:get($params, 'flow-name')
    let $uri := map:get($context, 'uri')
    let $flow := flow:get-flow($entity-name, $flow-name, $consts:INPUT_FLOW)
    let $_ :=
      if ($flow) then ()
      else
        fn:error((),"RESTAPI-SRVEXERR", ("404","MISSING_FLOW", "The specified flow " || $entity-name || ":" || $flow-name || " is missing."))

    (: configure the options :)
    let $options as map:map := (
      map:get($params, "options") ! xdmp:unquote(.)/object-node(),
      map:map()
    )[1]
    let $_ := flow:set-default-options($options, $flow)

    let $mainFunc := flow:get-main($flow/hub:main)
    (: this can throw, but we want the REST API to know about problems, so let it :)
    let $envelope := flow:run-flow(
      $job-id, $flow, $uri, $content, $options, $mainFunc
    )

    (: write the trace for the current identifier :)
    let $item-context := map:get($flow:context-queue, $uri)
    let $_ := trace:write-trace($item-context)
    return
      document { $envelope }
  })
};


[bugfix] prevent login html admin client if 1st time username is mistyped (copy of parameters) port of rev14995

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

xquery version "3.0";
(:
    $Id$

    Main module of the database administration interface.
:)

declare namespace admin = "http://exist-db.org/xquery/admin-interface";

declare namespace request = "http://exist-db.org/xquery/request";
declare namespace session = "http://exist-db.org/xquery/session";
declare namespace util = "http://exist-db.org/xquery/util";
declare namespace xdb = "http://exist-db.org/xquery/xmldb";

import module namespace status = "http://exist-db.org/xquery/admin-interface/status" at "status.xqm";
import module namespace browse = "http://exist-db.org/xquery/admin-interface/browse" at "browse.xqm";
import module namespace users = "http://exist-db.org/xquery/admin-interface/users" at "users.xqm";
import module namespace xqueries = "http://exist-db.org/xquery/admin-interface/xqueries" at "xqueries.xqm";
import module namespace shut = "http://exist-db.org/xquery/admin-interface/shutdown" at "shutdown.xqm";
import module namespace setup = "http://exist-db.org/xquery/admin-interface/setup" at "setup.xqm";
import module namespace rev="http://exist-db.org/xquery/admin-interface/revisions" at "versions.xqm";
import module namespace backup="http://exist-db.org/xquery/admin-interface/backup" at "backup.xqm";
import module namespace prof="http://exist-db.org/xquery/profiling" at "trace.xqm";
import module namespace grammar="http://exist-db.org/xquery/admin-interface/grammar" at "grammar.xqm";
import module namespace install="http://exist-db.org/xquery/install-tools" at "install.xqm";
import module namespace fundocs="http://exist-db.org/xquery/admin/fundocs" at "fundocs.xqm";
import module namespace repomanager="http://exist-db.org/xquery/admin-interface/repo" at "repo.xqm";
import module namespace indexes="http://exist-db.org/xquery/admin-interface/indexes" at "indexes.xqm";

declare option exist:serialize "method=xhtml media-type=text/html";

(:
    Display the version, SVN revision and user info in the top right corner
:)
declare function admin:info-header() as element()
{

Version: { util:system-property( "product-version" ) }

SVN Revision: { util:system-property( "svn-revision" ) }

Build: {util:system-property("product-build")}

User: { xdb:get-current-user() }

};

(:
    Display the menu on left side
:)
declare function admin:menu-panel() as element()
{
    let $link := session:encode-url(request:get-uri())
    return

Select a Page

Browse

Collections

Indexes

Install

Documentation

Examples

System

Shutdown

Status

Tooling

Backups

Package Repository

Query Profiling

User Management

View

Grammar cache

Running Jobs

Home

Logout

};

(:
    Select the page to show. Every page is defined in its own module
:)
declare function admin:panel() as element()
{
    let $panel := request:get-parameter("panel", "status")[1] return
        switch ($panel)
            case "browse"    return  browse:main()
            case "users"     return  users:main()
            case "xqueries"  return  xqueries:main()
            case "shutdown"  return  shut:main()
            case "setup"     return  setup:main()
            case "fundocs"   return  fundocs:main()
    		case "repo"      return  repomanager:main()
    		case "revisions" return  rev:main()
    		case "backup"    return  backup:main()
    	    case "trace"     return  prof:main()
            case "grammar"   return  grammar:main()
            case "install"   return  install:main()
            case "indexes"   return  indexes:main()
            default          return  status:main()
};

declare function admin:panel-header() {
    let $panel := request:get-parameter("panel", "status")[1]
    return
        if ($panel[1] eq "install") then
            install:header()
        else()
};

(:~
    Display the login form.
:)
declare function admin:display-login-form() as element()
{

Login

This is a protected resource. Only registered database users can log
        in. If you have not set up any users, login as "admin" and leave the
        password field empty. Note that the "guest" user is not permitted access.

        <form action="{session:encode-url(request:get-uri())}" method="post">

                    Please Login

                    Username:
                    <input name="user" type="text" size="20"/>

                    Password:
                    <input name="pass" type="password" size="20"/>

                    <input type="submit" value="Login"/>

            {
                for $param in request:get-parameter-names()
                return
                    if ( $param = ("user","pass") ) then
                        ()
                    else
                        <input type="hidden" name="{$param}" value="{request:get-parameter($param, ())}"/>

            }
        </form>

};

(: main entry point :)
let $userParam := request:get-parameter("user", ())
let $passwdParam := request:get-parameter("pass", ())
let $isLoggedIn :=  if(xdb:get-current-user() eq "guest") then
    (
        (: is this a login attempt? :)
        if($userParam and not(empty($passwdParam)))then
        (
            if($userParam = ("", "guest") )then
            (
                (: prevent the guest user from accessing the admin webapp :)
                false()
            )
            else
            (
                (: try and log the user in :)
                xdb:login( "/db", $userParam, $passwdParam, true() )
            )
        )
        else
        (
            (: prevent the guest user from accessing the admin webapp :)
            false()
        )
    )
    else
    (
        (: if we are already logged in, are we logging out - i.e. set permissions back to guest :)
        if(request:get-parameter("logout",()))then
        (
        	let $null  := xdb:login("/db", "guest", "guest")
            let $inval := session:invalidate()

            return false()
        )
        else
        (
             (: we are already logged in and we are not the guest user :)
            true()
        )
    )
return (
    <?css-conversion no?>,

            <title>eXist Database Administration</title>
            <link type="text/css" href="admin.css" rel="stylesheet"/>
			<link type="text/css" href="styles/prettify.css" rel="stylesheet"/>
			<link type="text/css" href="../scripts/yui/yui-skin.css" rel="stylesheet"/>
            <link rel="shortcut icon" href="../resources/exist_icon_16x16.ico"/>
			<link rel="icon" href="../resources/exist_icon_16x16.png" type="image/png"/>

			{ admin:panel-header() }

                { admin:info-header() }

                    {
                        if($isLoggedIn) then
                            admin:menu-panel()
                        else
                        ()
                    }

                        Logged in as: {xdb:get-current-user()}

                {
                    if($isLoggedIn)then
                    (
                        admin:panel()
                    )
                    else
                    (
                        admin:display-login-form()
                    )
                }

)

xquery version "3.0";
(:
    $Id$

    Main module of the database administration interface.
:)

declare namespace admin = "http://exist-db.org/xquery/admin-interface";

declare namespace request = "http://exist-db.org/xquery/request";
declare namespace session = "http://exist-db.org/xquery/session";
declare namespace util = "http://exist-db.org/xquery/util";
declare namespace xdb = "http://exist-db.org/xquery/xmldb";

import module namespace status = "http://exist-db.org/xquery/admin-interface/status" at "status.xqm";
import module namespace browse = "http://exist-db.org/xquery/admin-interface/browse" at "browse.xqm";
import module namespace users = "http://exist-db.org/xquery/admin-interface/users" at "users.xqm";
import module namespace xqueries = "http://exist-db.org/xquery/admin-interface/xqueries" at "xqueries.xqm";
import module namespace shut = "http://exist-db.org/xquery/admin-interface/shutdown" at "shutdown.xqm";
import module namespace setup = "http://exist-db.org/xquery/admin-interface/setup" at "setup.xqm";
import module namespace rev="http://exist-db.org/xquery/admin-interface/revisions" at "versions.xqm";
import module namespace backup="http://exist-db.org/xquery/admin-interface/backup" at "backup.xqm";
import module namespace prof="http://exist-db.org/xquery/profiling" at "trace.xqm";
import module namespace grammar="http://exist-db.org/xquery/admin-interface/grammar" at "grammar.xqm";
import module namespace install="http://exist-db.org/xquery/install-tools" at "install.xqm";
import module namespace fundocs="http://exist-db.org/xquery/admin/fundocs" at "fundocs.xqm";
import module namespace repomanager="http://exist-db.org/xquery/admin-interface/repo" at "repo.xqm";
import module namespace indexes="http://exist-db.org/xquery/admin-interface/indexes" at "indexes.xqm";

declare option exist:serialize "method=xhtml media-type=text/html";

(:
    Display the version, SVN revision and user info in the top right corner
:)
declare function admin:info-header() as element()
{

Version: { util:system-property( "product-version" ) }

SVN Revision: { util:system-property( "svn-revision" ) }

Build: {util:system-property("product-build")}

User: { xdb:get-current-user() }

};

(:
    Display the menu on left side
:)
declare function admin:menu-panel() as element()
{
    let $link := session:encode-url(request:get-uri())
    return

Select a Page

Browse

Collections

Indexes

Install

Documentation

Examples

System

Shutdown

Status

Tooling

Backups

Package Repository

Query Profiling

User Management

View

Grammar cache

Running Jobs

Home

Logout

};

(:
    Select the page to show. Every page is defined in its own module
:)
declare function admin:panel() as element()
{
    let $panel := request:get-parameter("panel", "status")[1] return
        switch ($panel)
            case "browse"    return  browse:main()
            case "users"     return  users:main()
            case "xqueries"  return  xqueries:main()
            case "shutdown"  return  shut:main()
            case "setup"     return  setup:main()
            case "fundocs"   return  fundocs:main()
    		case "repo"      return  repomanager:main()
    		case "revisions" return  rev:main()
    		case "backup"    return  backup:main()
    	    case "trace"     return  prof:main()
            case "grammar"   return  grammar:main()
            case "install"   return  install:main()
            case "indexes"   return  indexes:main()
            default          return  status:main()
};

declare function admin:panel-header() {
    let $panel := request:get-parameter("panel", "status")[1]
    return
        if ($panel[1] eq "install") then
            install:header()
        else()
};

(:~
    Display the login form.
:)
declare function admin:display-login-form() as element()
{

Login

This is a protected resource. Only registered database users can log
        in. If you have not set up any users, login as "admin" and leave the
        password field empty. Note that the "guest" user is not permitted access.

        <form action="{session:encode-url(request:get-uri())}" method="post">

                    Please Login

                    Username:
                    <input name="user" type="text" size="20"/>

                    Password:
                    <input name="pass" type="password" size="20"/>

                    <input type="submit" value="Login"/>

            {
                for $param in request:get-parameter-names()
                return
                    <input type="hidden" name="{$param}"
                        value="{request:get-parameter($param, ())}"/>
            }
        </form>

};

(: main entry point :)
let $userParam := request:get-parameter("user", ())[1]
let $passwdParam := request:get-parameter("pass", ())[1]
let $isLoggedIn :=  if(xdb:get-current-user() eq "guest") then
    (
        (: is this a login attempt? :)
        if($userParam and not(empty($passwdParam)))then
        (
            if($userParam = ("", "guest") )then
            (
                (: prevent the guest user from accessing the admin webapp :)
                false()
            )
            else
            (
                (: try and log the user in :)
                xdb:login( "/db", $userParam, $passwdParam, true() )
            )
        )
        else
        (
            (: prevent the guest user from accessing the admin webapp :)
            false()
        )
    )
    else
    (
        (: if we are already logged in, are we logging out - i.e. set permissions back to guest :)
        if(request:get-parameter("logout",()))then
        (
        	let $null  := xdb:login("/db", "guest", "guest")
            let $inval := session:invalidate()

            return false()
        )
        else
        (
             (: we are already logged in and we are not the guest user :)
            true()
        )
    )
return (
    <?css-conversion no?>,

            <title>eXist Database Administration</title>
            <link type="text/css" href="admin.css" rel="stylesheet"/>
			<link type="text/css" href="styles/prettify.css" rel="stylesheet"/>
			<link type="text/css" href="../scripts/yui/yui-skin.css" rel="stylesheet"/>
            <link rel="shortcut icon" href="../resources/exist_icon_16x16.ico"/>
			<link rel="icon" href="../resources/exist_icon_16x16.png" type="image/png"/>

			{ admin:panel-header() }

                { admin:info-header() }

                    {
                        if($isLoggedIn) then
                            admin:menu-panel()
                        else
                        ()
                    }

                        Logged in as: {xdb:get-current-user()}

                {
                    if($isLoggedIn)then
                    (
                        admin:panel()
                    )
                    else
                    (
                        admin:display-login-form()
                    )
                }

)


SVS -  add support to insert from not a file

(:~
: This is the Care Services Discovery stored query registry
: @version 1.0
: @see https://github.com/openhie/openinfoman
:
:)
module namespace svs_lsvs = "https://github.com/openhie/openinfoman/svs_lsvs";
import module namespace file = "http://expath.org/ns/file";
import module namespace functx = "http://www.functx.com";
declare namespace svs = "urn:ihe:iti:svs:2008";

(:WARNING: ValueSet have @id while DesribedValueSet has @ID:)

declare variable $svs_lsvs:vers := "1.1";
declare variable $svs_lsvs:base_path := concat(file:current-dir() ,'../resources/shared_value_sets/');
declare variable $svs_lsvs:valuesets_doc := "DescribedSharedValueSets.xml";
declare variable $svs_lsvs:sample_value_set_list := svs_lsvs:get_sample_value_set_list();
declare variable $svs_lsvs:blank_valuesets :=  <DescribedValueSets version="{$svs_lsvs:vers}"/>;

declare updating function svs_lsvs:init_store($db) {
  if (not(db:is-xml($db,$svs_lsvs:valuesets_doc))) then
    db:add($db, $svs_lsvs:blank_valuesets,$svs_lsvs:valuesets_doc)
  else
    ()
};

declare function svs_lsvs:store_exists($db) {
  db:is-xml($db,$svs_lsvs:valuesets_doc)
};

declare function svs_lsvs:sample_sets() {
  for $file in file:list($svs_lsvs:base_path,true(),'*.xml')
  return file:resolve-path(concat($svs_lsvs:base_path,"/",$file))
};

declare function svs_lsvs:get_sample_value_set_list() {
<DescribedValueSets version="{$svs_lsvs:vers}">
  {
  for $file in svs_lsvs:sample_sets()
  let $value_set_doc := doc($file)
  let $id :=text{$value_set_doc/svs:ValueSet/@id} (:ValueSet have @id while DesribedValueSet has @ID:)
  let $displayName :=text{$value_set_doc/svs:ValueSet/@displayName}
  let $version :=text{$value_set_doc/svs:ValueSet/@version}
  return
    if ($id)
      then
      <svs:DescribedValueSet ID="{$id}" file="{$file}" displayName="{$displayName}" version="{$version}"/>
    else (<noID>{$file}</noID>)
  }
</DescribedValueSets>
};

declare function svs_lsvs:get_all_value_set_list($db) {
  let $vsets := db:open($db,$svs_lsvs:valuesets_doc)
  let $existing_ids := distinct-values($vsets//svs:DescribedValueSet/@ID)
  let $available_ids := $svs_lsvs:sample_value_set_list//svs:DescribedValueSet/@ID
  return <DescribedValueSets version="{$svs_lsvs:vers}">
  {
    (
      for $id in $existing_ids
      return if ($id = $available_ids)
	then   $svs_lsvs:sample_value_set_list/svs:DescribedValueSet[@ID=$id]
      else  <svs:DescribedValueSet
	ID="{$id}"
	displayName="{$vsets//svs:DescribedValueSet[@ID = $id]/@displayName}"
	version="{$vsets//svs:DescribedValueSet[@ID = $id]/@version}"/>
      ,
      for $id in $available_ids
      where not($id = $existing_ids)
      return    $svs_lsvs:sample_value_set_list/svs:DescribedValueSet[@ID=$id]
      )
  }
  </DescribedValueSets>
};

declare function svs_lsvs:get_document_source($id) {
  text{$svs_lsvs:sample_value_set_list/svs:DescribedValueSet[@ID=$id]/@file}
};

declare function svs_lsvs:exists($db,$id) {
  svs_lsvs:store_exists($db)
  and
  exists(db:open($db,$svs_lsvs:valuesets_doc)//svs:DescribedValueSet[@ID = $id])
};

declare updating function svs_lsvs:load($db,$id) {
  if (not(svs_lsvs:exists($db,$id)))  then
    let $doc_source := svs_lsvs:get_document_source($id)
    return if (not($doc_source))
      then  ()
    else
      let $svs_sets := db:open($db,$svs_lsvs:valuesets_doc)/DescribedValueSets
      let $svs := parse-xml(file:read-text($doc_source))
      for $value_set in $svs//svs:ValueSet
      return svs_lsvs:insert($db,$value_set)
  else
    ()
};

declare updating function svs_lsvs:insert($db,$value_set) {
  let $vsets := db:open($db,$svs_lsvs:valuesets_doc)
  let $id := $value_set/@id
  let $version := $value_set/@version
  let $existing :=  $vsets//svs:DescribedValueSet[@ID = $id and @version = $version]
  let $described_val_set :=
    <svs:DescribedValueSet ID="{$id}" displayName="{$value_set/@displayName}" version="{$version}">
      {$value_set/*}
    </svs:DescribedValueSet>
  return
        if (exists($existing)) then
	  (
	    for $node in $existing return  delete node $node,
	    insert node $described_val_set into $vsets
	  )
      else
	insert node $described_val_set into $vsets
};

declare updating function svs_lsvs:reload($db,$id) {
  svs_lsvs:load($db,$id)
};

declare function svs_lsvs:get_multiple_described_value_sets($db,$filter) {
  let $dvs0 := db:open($db,$svs_lsvs:valuesets_doc)//svs:DescribedValueSet
  let $dvs1 := if (not($filter/@ID = '')) then $dvs0[@ID = $filter/@ID] else $dvs0
  let $dvs2 := if (not($filter/@DisplayNameContains = '')) then $dvs1[contains(@displayName,$filter/@DisplayNameContains)] else $dvs1
  let $dvs3 := if (not($filter/@SourceContains = '')) then $dvs2[contains(./svs:Source,$filter/@SourceContains)] else $dvs2
  let $dvs4 := if (not($filter/@PurposeContains = '')) then $dvs3[contains(./svs:Purpose,$filter/@PurposeContains)] else $dvs3
  let $dvs5 := if (not($filter/@DefinitionContains = '')) then $dvs4[contains(./svs:Definition,$filter/@DefinitionContains)] else $dvs4
  let $dvs6 := if (not($filter/@GroupContains = '')) then $dvs5[contains(./svs:Group,$filter/@GroupContains)] else $dvs5
  let $dvs7 := if (not($filter/@GroupOID = '')) then $dvs6[./svs:Group = $filter/@GroupOID] else $dvs6
  let $dvs8 := if (not($filter/@EffectiveDateBefore = '')) then $dvs7[./svs:EffectiveDate < @EffectiveDateBefore] else $dvs7
  let $dvs9 := if (not($filter/@EffectiveDateAfter = '')) then $dvs8[./svs:EffectiveDate > @EffectiveDateAfter] else $dvs8
  let $dvs10 := if (not($filter/@ExpirationDateBefore = '')) then $dvs9[./svs:ExpirationDate < @ExpirationDateBefore] else $dvs9
  let $dvs11 := if (not($filter/@ExpirationDateAfter = '')) then $dvs10[./svs:ExpirationDate > @ExpirationDateAfter] else $dvs10
  let $dvs12 := if (not($filter/@CreationDateBefore = '')) then $dvs11[./svs:CreationDate < @CreationDateBefore] else $dvs11
  let $dvs13 := if (not($filter/@CreationDateAfter = '')) then $dvs12[./svs:CreationDate > @CreationDateAfter] else $dvs12
  let $dvs14 := if (not($filter/@RevisionDateBefore = '')) then $dvs13[./svs:RevisionDate < @RevisionDateBefore] else $dvs13
  let $dvs15 := if (not($filter/@RevisionDateAfter = '')) then $dvs14[./svs:RevisionDate > @RevisionDateAfter] else $dvs14

  return  <svs:RetrieveMultipleValueSetsResponse >{$dvs15} </svs:RetrieveMultipleValueSetsResponse>

};

declare function svs_lsvs:get_single_version_value_set($db,$id) {
  svs_lsvs:get_single_version_value_set($db,$id,false())
};

declare function svs_lsvs:get_single_version_value_set($db,$id,$version) {
  svs_lsvs:get_single_version_value_set($db,$id,$version,false)
};

declare function svs_lsvs:get_single_version_value_set($db,$id, $version,$lang) {
  let $vs0 := db:open($db,$svs_lsvs:valuesets_doc)//svs:DescribedValueSet[@ID=$id]
  let $vers := if ($version)
     then $version
     else   functx:max-string ($vs0/@version)  (:NEEDS TO CHANGE:)
  let $vs1:= $vs0[@version = $vers]

  let $concept_lists :=
    if ($lang )
      then
      $vs1/svs:ConceptList[@xml:lang = $lang]
    else
      $vs1/svs:ConceptList

  return
  <svs:RetrieveValueSetResponse version="{$vers}" id="{$id}">
    {
      for $concept_list in $concept_lists
      let $val_set := $concept_list/..
      return
	(:ValueSet have @id while DesribedValueSet has @ID:)
	<svs:ValueSet id="{$val_set/@ID}" displayName="{$val_set/@displayName}" version="{$val_set/@version}">
	  {$concept_list}
	</svs:ValueSet>

    }
  </svs:RetrieveValueSetResponse>
};

declare function svs_lsvs:lookup_code($db,$code,$codeSystem) {
  svs_lsvs:lookup_code($db,$code,$codeSystem, false)
};

declare function svs_lsvs:lookup_code($db,$code,$codeSystem, $lang) {
  let $vs0 := db:open($db,$svs_lsvs:valuesets_doc)//svs:DescribedValueSet

  let $concept_lists :=
    if ($lang)
      then
      $vs0/svs:ConceptList[@xml:lang = $lang]
    else
      $vs0/svs:ConceptList

  let $concept :=  ($concept_lists/svs:Concept[@code = $code and @codeSystem = $codeSystem])[1]
  return string($concept/@displayName)

};

declare function svs_lsvs:get_single_version_code($db,$code,$id) {
  svs_lsvs:get_single_version_code($db,$code,$id, false())
};

declare function svs_lsvs:get_single_version_code($db,$code,$id, $version) {
  svs_lsvs:get_single_version_code($db,$code,$id, $version,false())
};

declare function svs_lsvs:get_single_version_code($db,$code,$id, $version,$lang) {
  let $vs0 := db:open($db,$svs_lsvs:valuesets_doc)//svs:DescribedValueSet[@ID=$id]
  let $vers := if (not($version = '')) then $version else max(xs:int($vs0/@version))
  let $vs1:= $vs0[@version = $vers]

  let $concept_lists :=
    if ($lang)
      then
      $vs1/svs:ConceptList[@xml:lang = $lang]
    else
      $vs1/svs:ConceptList

  let $concepts :=  $concept_lists/svs:Concept[@code = $code]

  return <RetrieveValueSetCodeResponse> (:Not to SVS standard :)
  {
    for $concept in $concepts
    let $concept_list := $concept/..
    let $val_set := $concept_list/..
    return
      (:ValueSet have @id while DesribedValueSet has @ID:)
    <svs:ValueSet id="{$val_set/@ID}" displayName="{$val_set/@displayName}" version="{$val_set/@version}">
      <svs:ConceptList xml:lang="$concept_list/@xml:lang">
	{$concept}
      </svs:ConceptList>
    </svs:ValueSet>
  }
  </RetrieveValueSetCodeResponse>
};

(:~
: This is the Care Services Discovery stored query registry
: @version 1.0
: @see https://github.com/openhie/openinfoman
:
:)
module namespace svs_lsvs = "https://github.com/openhie/openinfoman/svs_lsvs";
import module namespace file = "http://expath.org/ns/file";
declare namespace svs = "urn:ihe:iti:svs:2008";

(:WARNING: ValueSet have @id while DesribedValueSet has @ID:)

declare variable $svs_lsvs:vers := "1.1";
declare variable $svs_lsvs:base_path := concat(file:current-dir() ,'../resources/shared_value_sets/');
declare variable $svs_lsvs:valuesets_doc := "DescribedSharedValueSets.xml";
declare variable $svs_lsvs:sample_value_set_list := svs_lsvs:get_sample_value_set_list();
declare variable $svs_lsvs:blank_valuesets :=  <DescribedValueSets version="{$svs_lsvs:vers}"/>;

declare updating function svs_lsvs:init_store($db) {
  if (not(db:is-xml($db,$svs_lsvs:valuesets_doc))) then
    db:add($db, $svs_lsvs:blank_valuesets,$svs_lsvs:valuesets_doc)
  else
    ()
};

declare function svs_lsvs:store_exists($db) {
  db:is-xml($db,$svs_lsvs:valuesets_doc)
};

declare function svs_lsvs:sample_sets() {
  for $file in file:list($svs_lsvs:base_path,true(),'*.xml')
  return file:resolve-path(concat($svs_lsvs:base_path,"/",$file))
};

declare function svs_lsvs:get_sample_value_set_list() {
<DescribedValueSets version="{$svs_lsvs:vers}">
  {
  for $file in svs_lsvs:sample_sets()
  let $value_set_doc := doc($file)
  let $id :=text{$value_set_doc/svs:ValueSet/@id} (:ValueSet have @id while DesribedValueSet has @ID:)
  let $displayName :=text{$value_set_doc/svs:ValueSet/@displayName}
  let $version :=text{$value_set_doc/svs:ValueSet/@version}
  return
    if ($id)
      then
      <svs:DescribedValueSet ID="{$id}" file="{$file}" displayName="{$displayName}" version="{$version}"/>
    else (<noID>{$file}</noID>)
  }
</DescribedValueSets>
};

declare function svs_lsvs:get_all_value_set_list($db) {
  let $vsets := db:open($db,$svs_lsvs:valuesets_doc)
  let $existing_ids := $vsets//svs:DescribedValueSet/@ID
  let $available_ids := $svs_lsvs:sample_value_set_list//svs:DescribedValueSet/@ID
  return <DescribedValueSets version="{$svs_lsvs:vers}">
  {
    (
      for $id in $existing_ids
      return if ($id = $available_ids)
	then   $svs_lsvs:sample_value_set_list/svs:DescribedValueSet[@ID=$id]
      else  <svs:DescribedValueSet
	ID="{$id}"
	displayName="{$vsets//svs:DescribedValueSet[@ID = $id]/@displayName}"
	version="{$vsets//svs:DescribedValueSet[@ID = $id]/@version}"/>
      ,
      for $id in $available_ids
      where not($id = $existing_ids)
      return    $svs_lsvs:sample_value_set_list/svs:DescribedValueSet[@ID=$id]
      )
  }
  </DescribedValueSets>
};

declare function svs_lsvs:get_document_source($id) {
  text{$svs_lsvs:sample_value_set_list/svs:DescribedValueSet[@ID=$id]/@file}
};

declare function svs_lsvs:exists($db,$id) {
  svs_lsvs:store_exists($db)
  and
  exists(db:open($db,$svs_lsvs:valuesets_doc)//svs:DescribedValueSet[@ID = $id])
};

declare updating function svs_lsvs:load($db,$id) {
  if (not(svs_lsvs:exists($db,$id)))  then
    let $doc_source := svs_lsvs:get_document_source($id)
    return if (not($doc_source))
      then  ()
    else
      let $svs_sets := db:open($db,$svs_lsvs:valuesets_doc)/DescribedValueSets
      let $svs := parse-xml(file:read-text($doc_source))
      for $val_set in $svs//svs:ValueSet
      let $described_val_set :=
      <svs:DescribedValueSet ID="{$val_set/@id}" displayName="{$val_set/@displayName}" version="{$val_set/@version}">
	{$val_set/*}
      </svs:DescribedValueSet>
      return insert node $described_val_set into $svs_sets
  else
    ()
};

declare updating function svs_lsvs:reload($db,$id) {
  let $vsets := db:open($db,$svs_lsvs:valuesets_doc)
  let $existing := $vsets//svs:DescribedValueSet[@ID = $id]
  return
    if (exists($existing))
      then
        (delete node $existing,
	svs_lsvs:load($db,$id))
      else
	svs_lsvs:load($db,$id)
};

declare function svs_lsvs:get_multiple_described_value_sets($db,$filter) {
  let $dvs0 := db:open($db,$svs_lsvs:valuesets_doc)//svs:DescribedValueSet
  let $dvs1 := if (not($filter/@ID = '')) then $dvs0[@ID = $filter/@ID] else $dvs0
  let $dvs2 := if (not($filter/@DisplayNameContains = '')) then $dvs1[contains(@displayName,$filter/@DisplayNameContains)] else $dvs1
  let $dvs3 := if (not($filter/@SourceContains = '')) then $dvs2[contains(./svs:Source,$filter/@SourceContains)] else $dvs2
  let $dvs4 := if (not($filter/@PurposeContains = '')) then $dvs3[contains(./svs:Purpose,$filter/@PurposeContains)] else $dvs3
  let $dvs5 := if (not($filter/@DefinitionContains = '')) then $dvs4[contains(./svs:Definition,$filter/@DefinitionContains)] else $dvs4
  let $dvs6 := if (not($filter/@GroupContains = '')) then $dvs5[contains(./svs:Group,$filter/@GroupContains)] else $dvs5
  let $dvs7 := if (not($filter/@GroupOID = '')) then $dvs6[./svs:Group = $filter/@GroupOID] else $dvs6
  let $dvs8 := if (not($filter/@EffectiveDateBefore = '')) then $dvs7[./svs:EffectiveDate < @EffectiveDateBefore] else $dvs7
  let $dvs9 := if (not($filter/@EffectiveDateAfter = '')) then $dvs8[./svs:EffectiveDate > @EffectiveDateAfter] else $dvs8
  let $dvs10 := if (not($filter/@ExpirationDateBefore = '')) then $dvs9[./svs:ExpirationDate < @ExpirationDateBefore] else $dvs9
  let $dvs11 := if (not($filter/@ExpirationDateAfter = '')) then $dvs10[./svs:ExpirationDate > @ExpirationDateAfter] else $dvs10
  let $dvs12 := if (not($filter/@CreationDateBefore = '')) then $dvs11[./svs:CreationDate < @CreationDateBefore] else $dvs11
  let $dvs13 := if (not($filter/@CreationDateAfter = '')) then $dvs12[./svs:CreationDate > @CreationDateAfter] else $dvs12
  let $dvs14 := if (not($filter/@RevisionDateBefore = '')) then $dvs13[./svs:RevisionDate < @RevisionDateBefore] else $dvs13
  let $dvs15 := if (not($filter/@RevisionDateAfter = '')) then $dvs14[./svs:RevisionDate > @RevisionDateAfter] else $dvs14

  return  <svs:RetrieveMultipleValueSetsResponse >{$dvs15} </svs:RetrieveMultipleValueSetsResponse>

};

declare function svs_lsvs:get_single_version_value_set($db,$id) {
  svs_lsvs:get_single_version_value_set($db,$id,'')
};

declare function svs_lsvs:get_single_version_value_set($db,$id,$version) {
  svs_lsvs:get_single_version_value_set($db,$id,$version,'')
};

declare function svs_lsvs:get_single_version_value_set($db,$id, $version,$lang) {
  let $vs0 := db:open($db,$svs_lsvs:valuesets_doc)//svs:DescribedValueSet[@ID=$id]
  let $vers := if (not($version = '')) then $version else max(xs:int($vs0/@version))
  let $vs1:= $vs0[@version = $vers]

  let $concept_lists :=
    if (not($lang = ''))
      then
      $vs1/svs:ConceptList[@xml:lang = $lang]
    else
      $vs1/svs:ConceptList

  return
  <svs:RetrieveValueSetResponse version="{$vers}" id="{$id}">
    {
      for $concept_list in $concept_lists
      let $val_set := $concept_list/..
      return
	(:ValueSet have @id while DesribedValueSet has @ID:)
	<svs:ValueSet id="{$val_set/@ID}" displayName="{$val_set/@displayName}" version="{$val_set/@version}">
	  {$concept_list}
	</svs:ValueSet>

    }
  </svs:RetrieveValueSetResponse>
};

declare function svs_lsvs:lookup_code($db,$code,$codeSystem) {
  svs_lsvs:lookup_code($db,$code,$codeSystem, '')
};

declare function svs_lsvs:lookup_code($db,$code,$codeSystem, $lang) {
  let $vs0 := db:open($db,$svs_lsvs:valuesets_doc)//svs:DescribedValueSet

  let $concept_lists :=
    if (not($lang = ''))
      then
      $vs0/svs:ConceptList[@xml:lang = $lang]
    else
      $vs0/svs:ConceptList

  let $concept :=  ($concept_lists/svs:Concept[@code = $code and @codeSystem = $codeSystem])[1]
  return string($concept/@displayName)

};

declare function svs_lsvs:get_single_version_code($db,$code,$id) {
  svs_lsvs:get_single_version_code($db,$code,$id, '')
};

declare function svs_lsvs:get_single_version_code($db,$code,$id, $version) {
  svs_lsvs:get_single_version_code($db,$code,$id, $version,'')
};

declare function svs_lsvs:get_single_version_code($db,$code,$id, $version,$lang) {
  let $vs0 := db:open($db,$svs_lsvs:valuesets_doc)//svs:DescribedValueSet[@ID=$id]
  let $vers := if (not($version = '')) then $version else max(xs:int($vs0/@version))
  let $vs1:= $vs0[@version = $vers]

  let $concept_lists :=
    if (not($lang = ''))
      then
      $vs1/svs:ConceptList[@xml:lang = $lang]
    else
      $vs1/svs:ConceptList

  let $concepts :=  $concept_lists/svs:Concept[@code = $code]

  return <RetrieveValueSetCodeResponse> (:Not to SVS standard :)
  {
    for $concept in $concepts
    let $concept_list := $concept/..
    let $val_set := $concept_list/..
    return
      (:ValueSet have @id while DesribedValueSet has @ID:)
    <svs:ValueSet id="{$val_set/@ID}" displayName="{$val_set/@displayName}" version="{$val_set/@version}">
      <svs:ConceptList xml:lang="$concept_list/@xml:lang">
	{$concept}
      </svs:ConceptList>
    </svs:ValueSet>
  }
  </RetrieveValueSetCodeResponse>
};


replaced utf8 chars from module because XQDT can't handle it properly (e.g. when doing auto completion of functions)

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

(:~
 : This module contains all the functions part of the
 : W3C XPath and XQuery Functions and Operators 3.0
 : section "4.7 Trigonometric and exponential functions".
 :
 :
 : @author www.w3c.org
 : @see http://www.w3.org/TR/xpath-functions-30/#trigonometry
 : @project www.w3.org/2005
 :
 :)
module namespace math = "http://www.w3.org/2005/xpath-functions/math";

(:~
 : @see for semantics please check math:pi
 :)
declare function math:pi() as xs:double external;

(:~
 : @see for semantics please check math:exp
 :)
declare function math:exp($arg as xs:double?) as xs:double? external;

(:~
 : @see for semantics please check math:exp10
 :)
declare function math:exp10($arg as xs:double?) as xs:double? external;

(:~
 : @see for semantics please check math:log
 :)
declare function math:log($arg as xs:double?) as xs:double? external;

(:~
 : @see for semantics please check math:log10
 :)
declare function math:log10($arg as xs:double?) as xs:double? external;

(:~
 : @see for semantics please check math:pow
 :)
declare function math:pow($x as xs:double?, $y as numeric) as xs:double? external;

(:~
 : @see for semantics please check math:sqrt
 :)
declare function math:sqrt($arg as xs:double?) as xs:double? external;

(:~
 : @see for semantics please check math:sin
 :)
declare function math:sin($theta as xs:double?) as xs:double? external;

(:~
 : @see for semantics please check math:cos
 :)
declare function math:cos($theta as xs:double?) as xs:double? external;

(:~
 : @see for semantics please check math:tan
 :)
declare function math:tan($theta as xs:double?) as xs:double? external;

(:~
 : @see for semantics please check math:asin
 :)
declare function math:asin($arg as xs:double?) as xs:double? external;

(:~
 : @see for semantics please check math:acos
 :)
declare function math:acos($arg as xs:double?) as xs:double? external;

(:~
 : @see for semantics please check math:atan
 :)
declare function math:atan($arg as xs:double?) as xs:double? external;

(:~
 : @see for semantics please check math:atan2
 :)
declare function math:atan2($y as xs:double, $x as xs:double) as xs:double external;

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

(:~
 : This module contains all the functions part of the
 : W3C XPath and XQuery Functions and Operators 3.0
 : section "4.7 Trigonometric and exponential functions".
 :
 :
 : @author www.w3c.org
 : @see http://www.w3.org/TR/xpath-functions-30/#trigonometry
 : @project www.w3.org/2005
 :
 :)
module namespace math = "http://www.w3.org/2005/xpath-functions/math";

(:~
 : @see for semantics please check math:pi
 :)
declare function math:pi() as xs:double external;

(:~
 : @see for semantics please check math:exp
 :)
declare function math:exp($arg as xs:double?) as xs:double? external;

(:~
 : @see for semantics please check math:exp10
 :)
declare function math:exp10($arg as xs:double?) as xs:double? external;

(:~
 : @see for semantics please check math:log
 :)
declare function math:log($arg as xs:double?) as xs:double? external;

(:~
 : @see for semantics please check math:log10
 :)
declare function math:log10($arg as xs:double?) as xs:double? external;

(:~
 : @see for semantics please check math:pow
 :)
declare function math:pow($x as xs:double?, $y as numeric) as xs:double? external;

(:~
 : @see for semantics please check math:sqrt
 :)
declare function math:sqrt($arg as xs:double?) as xs:double? external;

(:~
 : @see for semantics please check math:sin
 :)
declare function math:sin($θ as xs:double?) as xs:double? external;

(:~
 : @see for semantics please check math:cos
 :)
declare function math:cos($θ as xs:double?) as xs:double? external;

(:~
 : @see for semantics please check math:tan
 :)
declare function math:tan($θ as xs:double?) as xs:double? external;

(:~
 : @see for semantics please check math:asin
 :)
declare function math:asin($arg as xs:double?) as xs:double? external;

(:~
 : @see for semantics please check math:acos
 :)
declare function math:acos($arg as xs:double?) as xs:double? external;

(:~
 : @see for semantics please check math:atan
 :)
declare function math:atan($arg as xs:double?) as xs:double? external;

(:~
 : @see for semantics please check math:atan2
 :)
declare function math:atan2($y as xs:double, $x as xs:double) as xs:double external;


Prevent division by 0 in percentage.
Display actual result when an error is expected

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

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";

(:~ ----------------------------------------------------------------------------------------
     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:CONFIG/basedir/text() };

declare function xqts:initialize() as element() {
    let $collection := xdb:create-collection("/db", "XQTS")
    let $config := doc("/db/XQTS")/config
    return
        if ($config) then
            $config
        else
            let $home := util:system-property("exist.home")
            let $path := concat($home, "/tools/XQTS")
            let $stored := xdb:store-files-from-pattern("/db/XQTS", $path, "*.xml", "text/xml")
            return
                doc("/db/XQTS/config.xml")/config
};

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)
   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($result, " ")
    return
        (: Remove leading and trailing whitespace :)
        replace(replace($str, "^\s+", ""), "\s+$", "")
};

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">
            	<result>{$result}</result>,
                <expected-error>{$case/catalog:expected-error/text()}</expected-error>
				<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()))
            let $test := xqts:normalize-text($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)
                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>
            )
        (: Don't know how to compare :)
        else
            <error test="{$case/@name}">Unknown comparison method: {$output/@compare}.</error>
};

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

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
    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: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)}"/>
};

(: xqts:test-single("op-subtract-dateTimes-yielding-DTD-1"), :)
xqts:test-group("Expressions"),
collection("/db/XQTS")/test-result,
xqts:overall-result()

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";

(:~ ----------------------------------------------------------------------------------------
     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:CONFIG/basedir/text() };

declare function xqts:initialize() as element() {
    let $collection := xdb:create-collection("/db", "XQTS")
    let $config := doc("/db/XQTS")/config
    return
        if ($config) then
            $config
        else
            let $home := util:system-property("exist.home")
            let $path := concat($home, "/tools/XQTS")
            let $stored := xdb:store-files-from-pattern("/db/XQTS", $path, "*.xml", "text/xml")
            return
                doc("/db/XQTS/config.xml")/config
};

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)
   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($result, " ")
    return
        (: Remove leading and trailing whitespace :)
        replace(replace($str, "^\s+", ""), "\s+$", "")
};

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>{$case/catalog:expected-error/text()}</expected-error>
                   <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()))
            let $test := xqts:normalize-text($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)
                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>
            )
        (: Don't know how to compare :)
        else
            <error test="{$case/@name}">Unknown comparison method: {$output/@compare}.</error>
};

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

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
    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: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)}"/>
};

(: xqts:test-single("op-subtract-dateTimes-yielding-DTD-1"), :)
xqts:test-group("Expressions"),
collection("/db/XQTS")/test-result,
xqts:overall-result()