removed redundant browse-list-items function

xquery version "3.0";

module namespace app="http://localhost:8080/exist/apps/xq-institute/templates";

import module namespace templates="http://exist-db.org/xquery/templates" ;
import module namespace config="http://localhost:8080/exist/apps/xq-institute/config" at "config.xqm";
declare namespace util="http://exist-db.org/xquery/util";
declare namespace tei="http://www.tei-c.org/ns/1.0";

(:~
 : Browse using sort
 : Using user defined functions to modularize code
:)
declare %templates:wrap function app:browse-list-items($node as node(), $model as map(*)){
    for $play in collection($config:app-root || "/data")
    let $title := $play//tei:titleStmt/tei:title/text()
    (: NOTE: construct a more robust function to run through a list of stop words using tokenize?:)
    let $sort-title := replace(replace($title,'^The ',''),'^A ','')
    let $uri := base-uri($play)
    order by $sort-title
    return
        app:display-title($title,$uri)
};

declare function app:display-title($title as xs:string?,$uri as xs:anyURI?){

            {$title}

            HTML | PDF | XML

};

(:~
 : Retrieve play xml transform with xsl for html output
 : @param $uri passes internal uri for play
 : @param $view view used for output
 :
:)
declare %templates:wrap function app:view-play-html($node as node(), $model as map(*)){
    let $uri := request:get-parameter('uri', '')
    let $rec := xmldb:document($uri)
    return transform:transform($rec, doc('../resources/xsl/teiHTML.xsl'),() )
};

xquery version "3.0";

module namespace app="http://localhost:8080/exist/apps/xq-institute/templates";

import module namespace templates="http://exist-db.org/xquery/templates" ;
import module namespace config="http://localhost:8080/exist/apps/xq-institute/config" at "config.xqm";
declare namespace util="http://exist-db.org/xquery/util";
declare namespace tei="http://www.tei-c.org/ns/1.0";

(:~
 : Build browse function for shakespeare plays
 :
:)
declare %templates:wrap function app:browse-list-items($node as node(), $model as map(*)){
    for $play in collection($config:app-root || "/data")
    let $title := $play//tei:titleStmt/tei:title/text()
    let $uri := base-uri($play)
    return

            {$title}

            HTML | PDF | XML

};

(:~
 : Browse using sort
 : Using user defined functions to modularize code
:)
declare %templates:wrap function app:browse-list-items($node as node(), $model as map(*)){
    for $play in collection($config:app-root || "/data")
    let $title := $play//tei:titleStmt/tei:title/text()
    (: NOTE: construct a more robust function to run through a list of stop words using tokenize?:)
    let $sort-title := replace(replace($title,'^The ',''),'^A ','')
    let $uri := base-uri($play)
    order by $sort-title
    return (:app:title-sort($title, 'The A'):)(:$sort-title:)
        app:display-title($title,$uri)
};

(:
declare function app:title-sort($title as xs:string?, $non-sort-list as xs:string?){
    for $non-sort in tokenize($non-sort-list,'\s')
    return
        if(starts-with($title,$non-sort)) then replace($title,'^$non-sort','')
        else $title
};
:)
declare function app:display-title($title as xs:string?,$uri as xs:anyURI?){

            {$title}

            HTML | PDF | XML

};

(:~
 : Retrieve play xml transform with xsl for html output
 : @param $uri passes internal uri for play
 : @param $view view used for output
 :
:)
declare %templates:wrap function app:view-play-html($node as node(), $model as map(*)){
    let $uri := request:get-parameter('uri', '')
    let $rec := xmldb:document($uri)
    return transform:transform($rec, doc('../resources/xsl/teiHTML.xsl'),() )
};


DHFPROD-653 fix tracing flag in cluster environment

(:
  Copyright 2012-2018 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 trace = "http://marklogic.com/data-hub/trace";

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

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

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

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

import module namespace json="http://marklogic.com/xdmp/json"
  at "/MarkLogic/json/json.xqy";

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

import module namespace search = "http://marklogic.com/appservices/search"
  at "/MarkLogic/appservices/search/search.xqy";

declare option xdmp:mapping "false";

(: new trace-settings are initialized for each transaction :)
declare variable $current-trace-settings := map:map();

declare function trace:new-trace() as map:map
{
  map:new((
    map:entry("traceId", xdmp:random()),
    map:entry("created", fn:current-dateTime())
  ))
};

declare function trace:enable-tracing($enabled as xs:boolean)
{
  xdmp:eval('
    declare namespace trace = "http://marklogic.com/data-hub/trace";
    declare variable $enabled external;
    xdmp:document-insert(
      "/com.marklogic.hub/settings/__tracing_enabled__.xml",
      element trace:is-tracing-enabled { if ($enabled) then 1 else 0 },
      xdmp:default-permissions(),
      "hub-core-module")
    ',
    map:new((map:entry("enabled", $enabled))),
    map:new((map:entry("database", xdmp:modules-database()), map:entry("ignoreAmps", fn:true())))
  ),
  hul:invalidate-field-cache("tracing-enabled")
};

declare function trace:enabled() as xs:boolean
{
  let $key := "tracing-enabled"
  let $flag :=  hul:from-field-cache-or-empty($key, xs:dayTimeDuration("PT0.3S"))
  return
    if (exists($flag)) then
      $flag
    else
      hul:set-field-cache(
        $key,
        xdmp:eval('
          declare namespace trace = "http://marklogic.com/data-hub/trace";
          fn:exists(
            cts:search(
              fn:doc("/com.marklogic.hub/settings/__tracing_enabled__.xml"),
              cts:element-value-query(xs:QName("trace:is-tracing-enabled"), "1", ("exact")),
              ("unfiltered", "score-zero", "unchecked", "unfaceted")
            )
          )
        ',(), map:new(map:entry("database", xdmp:modules-database()))),
        xs:dayTimeDuration("PT0.3S")
      )
};

declare function trace:has-errors() as xs:boolean
{
  (map:get($current-trace-settings, "_has_errors"), fn:false())[1] eq fn:true()
};

declare %private function trace:increment-error-count()
{
  map:put($current-trace-settings, "error-count", trace:get-error-count() + 1)
};

declare function trace:get-error-count()
{
  (map:get($current-trace-settings, "error-count"), 0)[1]
};

declare %private function trace:add-failed-item($item as xs:string)
{
  json:array-push(trace:get-failed-items(), $item)
};

declare %private function trace:add-completed-item($item as xs:string)
{
  json:array-push(trace:get-completed-items(), $item)
};

declare function trace:set-plugin-label(
  $label as xs:string)
{
  trace:set-plugin-label(
    rfc:get-trace($rfc:item-context),
    $label
  )
};

(:
 : Sets the label of the currently running plugin
 :
 : @param $label - the label of the running plugin
 :)
declare function trace:set-plugin-label(
  $current-trace as map:map,
  $label as xs:string)
{
  map:put($current-trace, "plugin-label", $label)
};

declare function trace:get-plugin-label(
  $current-trace as map:map)
as xs:string
{
  map:get($current-trace, "plugin-label")
};

declare function trace:reset-plugin-input()
{
  trace:reset-plugin-input(rfc:get-trace($rfc:item-context))
};

declare function trace:reset-plugin-input(
  $current-trace as map:map)
{
  map:put($current-trace, "plugin-input", json:object())
};

declare %private function trace:get-plugin-input(
  $current-trace as map:map)
{
  let $o := map:get($current-trace, "plugin-input")
  where fn:exists($o)
  return
    if (rfc:is-json()) then
      let $oo := json:object()
      let $_ :=
        for $key in map:keys($o)
        let $value := map:get($o, $key)
        let $value := trace:sanitize-data($value)
        return
         map:put($oo, $key, $value)
      return $oo
    else
      for $key in map:keys($o)
      return
        element { $key } {
          let $value := map:get($o, $key)
          return
            trace:sanitize-data($value)
        }
};

(:
 : Registers an input with the trace library
 :
 : @param $label - the label of the input being registered
 : @param $input - the value of the input being registered
 :)
declare function trace:set-plugin-input(
  $label as xs:string,
  $input)
{
  trace:set-plugin-input(rfc:get-trace($rfc:item-context), $label, $input)
};

declare function trace:set-plugin-input(
  $current-trace as map:map,
  $label as xs:string,
  $input)
{
  let $existing := (map:get($current-trace, "plugin-input"), json:object())[1]
  let $_ := map:put($existing, $label, $input)
  return
    map:put($current-trace, "plugin-input", $existing)
};

declare function trace:get-completed-items()
{
  if (map:contains($current-trace-settings, "completed-items")) then
    map:get($current-trace-settings, "completed-items")
  else
    let $value := json:array()
    let $_ := map:put($current-trace-settings, "completed-items", $value)
    return
      $value
};

declare function trace:get-failed-items()
{
  if (map:contains($current-trace-settings, "failed-items")) then
    map:get($current-trace-settings, "failed-items")
  else
    let $value := json:array()
    let $_ := map:put($current-trace-settings, "failed-items", $value)
    return
      $value
};

declare function trace:write-trace(
  $item-context as map:map)
{
  let $identifier := rfc:get-id($item-context)
  where $identifier instance of xs:string
  return
    trace:add-completed-item($identifier),
  trace:write-error-trace($item-context)
};

declare %private function trace:write-error-trace(
  $item-context as map:map)
{
  let $current-trace := rfc:get-trace($item-context)
  return
    if (trace:enabled() or trace:has-errors()) then (
      let $trace :=
        if (rfc:is-json()) then
          xdmp:to-json((
            map:entry("trace",
              map:new((
                map:entry("jobId", rfc:get-job-id()),
                map:entry("format", rfc:get-data-format()),
                map:entry("traceId", map:get($current-trace, "traceId")),
                map:entry("created", map:get($current-trace, "created")),
                map:entry("identifier", rfc:get-id($item-context)),
                map:entry("flowType", rfc:get-flow-type()),
                map:entry("hasError", trace:has-errors()),
                let $steps := json:array()
                let $_ :=
                  for $step in map:get($current-trace, "traceSteps")
                  return
                    json:array-push($steps, $step)
                return
                  map:entry("steps", $steps)
              ))
            )
          ))
        else
          document {
            element trace {
              element jobId { rfc:get-job-id() },
              element format { rfc:get-data-format() },
              element traceId { map:get($current-trace, "traceId") },
              element created { map:get($current-trace, "created") },
              element identifier { rfc:get-id($item-context) },
              element flowType { rfc:get-flow-type() },
              element hasError { trace:has-errors() },
              element steps {
                for $step in map:get($current-trace, "traceSteps")
                return
                  element step {
                    element label { map:get($step, "label") },
                    element input { map:get($step, "input") },
                    element output { map:get($step, "output") },
                    element error { map:get($step, "error") },
                    element duration { map:get($step, "duration") },
                    element options { map:get($step, "options") }
                  }
              }
            }
          }
      return
        xdmp:eval('
          xquery version "1.0-ml";

          declare option xdmp:mapping "false";

          declare variable $trace external;
          declare variable $extension external;

          xdmp:document-insert(
            "/" || $trace/*:trace/*:traceId || $extension,
            $trace,
            xdmp:default-permissions(),
            ("trace", $trace/*:trace/*:type)
          )
        ',
        map:new((
          map:entry("trace", $trace),
          map:entry("extension", if (rfc:is-json()) then ".json" else ".xml")
        )),
        map:new((
          map:entry("database", xdmp:database($config:TRACE-DATABASE)),
          map:entry("commit", "auto"),
          map:entry("update", "true"),
          map:entry("ignoreAmps", fn:true())
        )))
    )
    else ()
};

declare function trace:sanitize-data($data)
{
  if ($data instance of binary()) then xs:hexBinary($data)
  else if (fn:not(rfc:is-json())) then
    if ($data instance of null-node()) then ()
    else $data
  else $data
};

declare function trace:plugin-trace(
  $output,
  $duration) as empty-sequence()
{
  trace:plugin-trace($rfc:item-context, $output, $duration)
};

declare function trace:plugin-trace(
  $item-context as map:map,
  $output,
  $duration) as empty-sequence()
{
  let $current-trace := rfc:get-trace($item-context)
  let $output := trace:sanitize-data($output)
  return
    if (trace:enabled()) then(
      let $new-step := map:map()
      let $_ := (
        map:put($new-step, "label", get-plugin-label($current-trace)),
        trace:get-plugin-input($current-trace) ! map:put($new-step, "input", .),
        map:put($new-step, "output", $output),
        map:put($new-step, "duration", $duration),
        map:put($new-step, "options", json:object(document { rfc:get-options($item-context) }/node()))
      )
      let $trace-steps := (
        map:get($current-trace, "traceSteps"),
        $new-step
      )
      return
        map:put($current-trace, "traceSteps", $trace-steps)
    )
    else ()
};

declare function trace:error-trace(
  $item-context as map:map,
  $error as element(error:error),
  $duration as xs:dayTimeDuration)
{
  let $current-trace := rfc:get-trace($item-context)
  let $identifier := rfc:get-id($item-context)
  let $_ := trace:increment-error-count()
  let $_ := $identifier ! trace:add-failed-item(.)
  return (
    map:put($current-trace-settings, "_has_errors", fn:true()),
    let $trace-steps := (
      map:get($current-trace, "traceSteps"),
      map:new((
        map:entry("label", get-plugin-label($current-trace)),
        map:entry("input", get-plugin-input($current-trace)),
        map:entry("error",
          if (rfc:is-json()) then
            $error/err:error-to-json(.)
          else
            $error
        ),
        map:entry("duration", $duration),
        map:entry("options", rfc:get-options($item-context))
      ))
    )
    let $_ := map:put($current-trace, "traceSteps", $trace-steps)
    let $_ := trace:write-error-trace($item-context)
    return ()
  )
};

declare function trace:_walk_json($nodes as node()* ,$o)
{
  let $quote-options :=
    <options xmlns="xdmp:quote">
      <indent>yes</indent>
      <indent-untyped>yes</indent-untyped>
      <omit-xml-declaration>yes</omit-xml-declaration>
    </options>

  for $n in $nodes
  return
    typeswitch($n)
      case array-node() return
        let $name as xs:string := fn:string(fn:node-name($n))
        return
          if ($name = "steps") then
            let $a := json:array()
            let $_ :=
              for $value in $n/node()
              let $oo := json:object()
              let $_ := trace:_walk_json($value/node(), $oo)
              return
                json:array-push($a, $oo)
            return
              map:put($o, $name, $a)
          else
            map:put($o, $name, xdmp:quote($n))
      case object-node() return
        let $oo := map:new()
        let $name as xs:string := fn:string(fn:node-name($n))
        return
          if ($name = "input") then
            if ($n/node()) then
              let $_ :=
                for $x in $n/node()
                (: try to unquote xml for formatting :)
                let $unquoted :=
                  if ($x instance of text()) then
                    try {
                      xdmp:quote(xdmp:unquote(fn:string($x)), $quote-options)
                    }
                    catch($ex) {
                      $x
                    }
                  else
                    $x
                let $nn := fn:string(fn:node-name($x))
                return
                  map:put($oo, $nn, $unquoted)
              return
                map:put($o, $name, $oo)
            else
              map:put($o, $name, null-node {})
          else if ($name = "output") then
            (: try to unquote xml for formatting :)
            let $unquoted :=
              if ($n instance of text()) then
                try {
                  xdmp:quote(xdmp:unquote(fn:string($n)), $quote-options)
                }
                catch($ex) {
                  $n
                }
              else
                $n
            return
              map:put($o, $name, $unquoted)
          else if ($name = "error") then
            map:put($o, $name, $n)
          else if ($name = ("collectorPlugin", "contentPlugin", "headersPlugin", "triplesPlugin", "writerPlugin")) then
            ()
          else
            let $_ := trace:_walk_json($n/node(), $oo)
            return
              map:put($o, $name, $oo)
      case number-node() |
           boolean-node() |
           null-node() return
        map:put($o, fn:string(fn:node-name($n)), fn:data($n))
      case text() return
        let $unquoted :=
          try {
            xdmp:quote(xdmp:unquote(fn:string($n)), $quote-options)
          }
          catch($ex) {
            $n
          }
        return
          map:put($o, fn:string(fn:node-name($n)), $unquoted)
      case element(input) return
        let $oo := json:object()
        let $_ :=
          for $x in $n/*
          return
            map:put($oo, fn:local-name($x), xdmp:quote($x/*, $quote-options))
        return
          map:put($o, "input", $oo)
      case element(output) return
        map:put($o, fn:local-name($n), xdmp:quote($n/node(), $quote-options))
      case element(error) return
        map:put($o, fn:local-name($n), $n/error:error/err:error-to-json(.))
      case element(duration) return
        map:put($o, "duration", fn:seconds-from-duration(xs:dayTimeDuration($n)))
      case element(hasError) return
        map:put($o, "hasError", xs:boolean($n))
      case element(steps) return
        let $a := json:array()
        let $_ :=
          for $step in $n/step
          let $oo := json:object()
          let $_ := trace:_walk_json($step/*, $oo)
          return
            json:array-push($a, $oo)
        return
          map:put($o, "steps", $a)
      case element() return
        if ($n/*) then
          let $oo := json:object()
          let $_ := trace:_walk_json($n/*, $oo)
          return
            map:put($o, fn:local-name($n), $oo)
        else
          map:put($o, fn:local-name($n), $n/fn:data(.))
      default return
        $n
};

declare function trace:trace-to-json-legacy($trace)
{
  let $o := json:object()
  let $_ :=
    for $n in $trace/node()
    let $name := fn:string(fn:node-name($n))
    where fn:not($name = ("collectorPlugin", "contentPlugin", "headersPlugin", "triplesPlugin", "writerPlugin"))
    return
      map:put($o, $name, $n/data())
  let $steps := json:array()
  let $_build_steps :=
    for $n in $trace/node()
    let $name := fn:string(fn:node-name($n))
    where $name = ("collectorPlugin", "contentPlugin", "headersPlugin", "triplesPlugin", "writerPlugin")
    return
      let $step := json:object()
      let $_ := map:put($step, "label", fn:replace($name, "Plugin", ""))
      let $_ :=
        trace:_walk_json($n/node(), $step)
      return
        json:array-push($steps, $step)
  let $_ := map:put($o, "steps", $steps)
  return $o
};

declare function trace:trace-to-json($trace)
{
  if (fn:exists($trace/steps) or
      xdmp:node-kind($trace) = "object" and
      fn:exists($trace/trace/steps)) then
    let $o := json:object()
    let $walk-me :=
      let $n := $trace/node()
      return
        if ($n instance of object-node()) then
          $n/node()
        else
          $n
    let $_ := trace:_walk_json($walk-me, $o)
    return
      $o
  else
    trace:trace-to-json-legacy($trace)
};

declare function trace:trace-to-json-slim($trace)
{
  let $o := json:object()
  let $_ := (
    map:put($o, "traceId", $trace/trace/traceId/string()),
    map:put($o, "jobId", $trace/trace/jobId/string()),
    map:put($o, "created", $trace/trace/created/string()),
    map:put($o, "hasError", $trace/trace/hasError/xs:boolean(.)),
    map:put($o, "identifier", $trace/trace/identifier/string()),
    map:put($o, "flowType", $trace/trace/flowType/string()),
    map:put($o, "format", $trace/trace/format/string())
  )
  return
    $o
};

declare function trace:find-traces(
  $q,
  $page as xs:unsignedLong,
  $page-length as xs:unsignedLong)
{
  let $options :=
    <options xmlns="http://marklogic.com/appservices/search">
      <additional-query>{cts:collection-query("trace")}</additional-query>
      <return-results>false</return-results>
      <return-facets>true</return-facets>
      <sort-order type="xs:dateTime"
          direction="descending">
        <path-index>/trace/created</path-index>
      </sort-order>
    </options>
  let $query := search:parse($q)
  let $count := search:estimate($query, $options)
  let $start := ($page - 1) * $page-length + 1
  let $end := fn:min(($start + $page-length - 1, $count))
  let $results :=
    for $result in search:resolve-nodes($query, $options, $start, $page-length)
    return
      trace:trace-to-json-slim($result/node())
  return
    object-node {
      "start": $start,
      "end": $end,
      "total": $count,
      "page": $page,
      "pageCount": $page-length,
      "traces": json:to-array($results)
    }
};

declare function trace:get-traces($page as xs:int, $page-length as xs:int)
{
  let $start := ($page - 1) * $page-length + 1
  let $end := $start + $page-length - 1
  let $count := xdmp:estimate(/trace)
  let $traces :=
    for $trace in cts:search(/trace, cts:true-query(), ("unfiltered", cts:index-order(cts:path-reference("/trace/created"), "descending")))[$start to $end]
    return
      trace:trace-to-json($trace)
  return
    object-node {
      "start": $start,
      "end": $end,
      "total": $count,
      "page": $page,
      "pageCount": $page-length,
      "traces": json:to-array($traces)
    }
};

declare function trace:get-trace($id as xs:string)
{
  let $query :=
    cts:or-query((
      cts:path-range-query("/trace/traceId", "=", $id, ("collation=http://marklogic.com/collation/codepoint"))
    ))
  return
    trace:trace-to-json(cts:search(fn:doc(), $query)[1]/node())
};

declare function trace:get-traceIds($q as xs:string?)
{
  let $query :=
    if ($q) then
      cts:element-value-query(xs:QName("identifier"), fn:lower-case($q) || "*", "wildcarded")
    else ()
  let $results :=
    cts:value-co-occurrences(
      cts:path-reference("/trace/traceId"),
      cts:path-reference("/trace/identifier"),
      (
        "limit=10"
      ),
      $query)
  let $results :=
    for $r in $results
    return
      object-node {
        "traceId": fn:data($r/*:value[1]),
        "identifier": fn:data($r/*:value[2])
      }
  return
    json:to-array($results)
};

(:
  Copyright 2012-2018 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 trace = "http://marklogic.com/data-hub/trace";

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

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

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

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

import module namespace json="http://marklogic.com/xdmp/json"
  at "/MarkLogic/json/json.xqy";

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

import module namespace search = "http://marklogic.com/appservices/search"
  at "/MarkLogic/appservices/search/search.xqy";

declare option xdmp:mapping "false";

(: new trace-settings are initialized for each transaction :)
declare variable $current-trace-settings := map:map();

declare function trace:new-trace() as map:map
{
  map:new((
    map:entry("traceId", xdmp:random()),
    map:entry("created", fn:current-dateTime())
  ))
};

declare function trace:enable-tracing($enabled as xs:boolean)
{
  xdmp:eval('
    declare namespace trace = "http://marklogic.com/data-hub/trace";
    declare variable $enabled external;
    xdmp:document-insert(
      "/com.marklogic.hub/settings/__tracing_enabled__.xml",
      element trace:is-tracing-enabled { if ($enabled) then 1 else 0 },
      xdmp:default-permissions(),
      "hub-core-module")
    ',
    map:new((map:entry("enabled", $enabled))),
    map:new((map:entry("database", xdmp:modules-database()), map:entry("ignoreAmps", fn:true())))
  ),
  hul:invalidate-field-cache("tracing-enabled")
};

declare function trace:enabled() as xs:boolean
{
  let $key := "tracing-enabled"
  let $flag :=  hul:from-field-cache-or-empty($key, ())
  return
    if (exists($flag)) then
      $flag
    else
      hul:set-field-cache(
        $key,
        xdmp:eval('
          declare namespace trace = "http://marklogic.com/data-hub/trace";
          fn:exists(
            cts:search(
              fn:doc("/com.marklogic.hub/settings/__tracing_enabled__.xml"),
              cts:element-value-query(xs:QName("trace:is-tracing-enabled"), "1", ("exact")),
              ("unfiltered", "score-zero", "unchecked", "unfaceted")
            )
          )
        ',(), map:new(map:entry("database", xdmp:modules-database()))),
        xs:dayTimeDuration("PT1M")
      )
};

declare function trace:has-errors() as xs:boolean
{
  (map:get($current-trace-settings, "_has_errors"), fn:false())[1] eq fn:true()
};

declare %private function trace:increment-error-count()
{
  map:put($current-trace-settings, "error-count", trace:get-error-count() + 1)
};

declare function trace:get-error-count()
{
  (map:get($current-trace-settings, "error-count"), 0)[1]
};

declare %private function trace:add-failed-item($item as xs:string)
{
  json:array-push(trace:get-failed-items(), $item)
};

declare %private function trace:add-completed-item($item as xs:string)
{
  json:array-push(trace:get-completed-items(), $item)
};

declare function trace:set-plugin-label(
  $label as xs:string)
{
  trace:set-plugin-label(
    rfc:get-trace($rfc:item-context),
    $label
  )
};

(:
 : Sets the label of the currently running plugin
 :
 : @param $label - the label of the running plugin
 :)
declare function trace:set-plugin-label(
  $current-trace as map:map,
  $label as xs:string)
{
  map:put($current-trace, "plugin-label", $label)
};

declare function trace:get-plugin-label(
  $current-trace as map:map)
as xs:string
{
  map:get($current-trace, "plugin-label")
};

declare function trace:reset-plugin-input()
{
  trace:reset-plugin-input(rfc:get-trace($rfc:item-context))
};

declare function trace:reset-plugin-input(
  $current-trace as map:map)
{
  map:put($current-trace, "plugin-input", json:object())
};

declare %private function trace:get-plugin-input(
  $current-trace as map:map)
{
  let $o := map:get($current-trace, "plugin-input")
  where fn:exists($o)
  return
    if (rfc:is-json()) then
      let $oo := json:object()
      let $_ :=
        for $key in map:keys($o)
        let $value := map:get($o, $key)
        let $value := trace:sanitize-data($value)
        return
         map:put($oo, $key, $value)
      return $oo
    else
      for $key in map:keys($o)
      return
        element { $key } {
          let $value := map:get($o, $key)
          return
            trace:sanitize-data($value)
        }
};

(:
 : Registers an input with the trace library
 :
 : @param $label - the label of the input being registered
 : @param $input - the value of the input being registered
 :)
declare function trace:set-plugin-input(
  $label as xs:string,
  $input)
{
  trace:set-plugin-input(rfc:get-trace($rfc:item-context), $label, $input)
};

declare function trace:set-plugin-input(
  $current-trace as map:map,
  $label as xs:string,
  $input)
{
  let $existing := (map:get($current-trace, "plugin-input"), json:object())[1]
  let $_ := map:put($existing, $label, $input)
  return
    map:put($current-trace, "plugin-input", $existing)
};

declare function trace:get-completed-items()
{
  if (map:contains($current-trace-settings, "completed-items")) then
    map:get($current-trace-settings, "completed-items")
  else
    let $value := json:array()
    let $_ := map:put($current-trace-settings, "completed-items", $value)
    return
      $value
};

declare function trace:get-failed-items()
{
  if (map:contains($current-trace-settings, "failed-items")) then
    map:get($current-trace-settings, "failed-items")
  else
    let $value := json:array()
    let $_ := map:put($current-trace-settings, "failed-items", $value)
    return
      $value
};

declare function trace:write-trace(
  $item-context as map:map)
{
  let $identifier := rfc:get-id($item-context)
  where $identifier instance of xs:string
  return
    trace:add-completed-item($identifier),
  trace:write-error-trace($item-context)
};

declare %private function trace:write-error-trace(
  $item-context as map:map)
{
  let $current-trace := rfc:get-trace($item-context)
  return
    if (trace:enabled() or trace:has-errors()) then (
      let $trace :=
        if (rfc:is-json()) then
          xdmp:to-json((
            map:entry("trace",
              map:new((
                map:entry("jobId", rfc:get-job-id()),
                map:entry("format", rfc:get-data-format()),
                map:entry("traceId", map:get($current-trace, "traceId")),
                map:entry("created", map:get($current-trace, "created")),
                map:entry("identifier", rfc:get-id($item-context)),
                map:entry("flowType", rfc:get-flow-type()),
                map:entry("hasError", trace:has-errors()),
                let $steps := json:array()
                let $_ :=
                  for $step in map:get($current-trace, "traceSteps")
                  return
                    json:array-push($steps, $step)
                return
                  map:entry("steps", $steps)
              ))
            )
          ))
        else
          document {
            element trace {
              element jobId { rfc:get-job-id() },
              element format { rfc:get-data-format() },
              element traceId { map:get($current-trace, "traceId") },
              element created { map:get($current-trace, "created") },
              element identifier { rfc:get-id($item-context) },
              element flowType { rfc:get-flow-type() },
              element hasError { trace:has-errors() },
              element steps {
                for $step in map:get($current-trace, "traceSteps")
                return
                  element step {
                    element label { map:get($step, "label") },
                    element input { map:get($step, "input") },
                    element output { map:get($step, "output") },
                    element error { map:get($step, "error") },
                    element duration { map:get($step, "duration") },
                    element options { map:get($step, "options") }
                  }
              }
            }
          }
      return
        xdmp:eval('
          xquery version "1.0-ml";

          declare option xdmp:mapping "false";

          declare variable $trace external;
          declare variable $extension external;

          xdmp:document-insert(
            "/" || $trace/*:trace/*:traceId || $extension,
            $trace,
            xdmp:default-permissions(),
            ("trace", $trace/*:trace/*:type)
          )
        ',
        map:new((
          map:entry("trace", $trace),
          map:entry("extension", if (rfc:is-json()) then ".json" else ".xml")
        )),
        map:new((
          map:entry("database", xdmp:database($config:TRACE-DATABASE)),
          map:entry("commit", "auto"),
          map:entry("update", "true"),
          map:entry("ignoreAmps", fn:true())
        )))
    )
    else ()
};

declare function trace:sanitize-data($data)
{
  if ($data instance of binary()) then xs:hexBinary($data)
  else if (fn:not(rfc:is-json())) then
    if ($data instance of null-node()) then ()
    else $data
  else $data
};

declare function trace:plugin-trace(
  $output,
  $duration) as empty-sequence()
{
  trace:plugin-trace($rfc:item-context, $output, $duration)
};

declare function trace:plugin-trace(
  $item-context as map:map,
  $output,
  $duration) as empty-sequence()
{
  let $current-trace := rfc:get-trace($item-context)
  let $output := trace:sanitize-data($output)
  return
    if (trace:enabled()) then(
      let $new-step := map:map()
      let $_ := (
        map:put($new-step, "label", get-plugin-label($current-trace)),
        trace:get-plugin-input($current-trace) ! map:put($new-step, "input", .),
        map:put($new-step, "output", $output),
        map:put($new-step, "duration", $duration),
        map:put($new-step, "options", json:object(document { rfc:get-options($item-context) }/node()))
      )
      let $trace-steps := (
        map:get($current-trace, "traceSteps"),
        $new-step
      )
      return
        map:put($current-trace, "traceSteps", $trace-steps)
    )
    else ()
};

declare function trace:error-trace(
  $item-context as map:map,
  $error as element(error:error),
  $duration as xs:dayTimeDuration)
{
  let $current-trace := rfc:get-trace($item-context)
  let $identifier := rfc:get-id($item-context)
  let $_ := trace:increment-error-count()
  let $_ := $identifier ! trace:add-failed-item(.)
  return (
    map:put($current-trace-settings, "_has_errors", fn:true()),
    let $trace-steps := (
      map:get($current-trace, "traceSteps"),
      map:new((
        map:entry("label", get-plugin-label($current-trace)),
        map:entry("input", get-plugin-input($current-trace)),
        map:entry("error",
          if (rfc:is-json()) then
            $error/err:error-to-json(.)
          else
            $error
        ),
        map:entry("duration", $duration),
        map:entry("options", rfc:get-options($item-context))
      ))
    )
    let $_ := map:put($current-trace, "traceSteps", $trace-steps)
    let $_ := trace:write-error-trace($item-context)
    return ()
  )
};

declare function trace:_walk_json($nodes as node()* ,$o)
{
  let $quote-options :=
    <options xmlns="xdmp:quote">
      <indent>yes</indent>
      <indent-untyped>yes</indent-untyped>
      <omit-xml-declaration>yes</omit-xml-declaration>
    </options>

  for $n in $nodes
  return
    typeswitch($n)
      case array-node() return
        let $name as xs:string := fn:string(fn:node-name($n))
        return
          if ($name = "steps") then
            let $a := json:array()
            let $_ :=
              for $value in $n/node()
              let $oo := json:object()
              let $_ := trace:_walk_json($value/node(), $oo)
              return
                json:array-push($a, $oo)
            return
              map:put($o, $name, $a)
          else
            map:put($o, $name, xdmp:quote($n))
      case object-node() return
        let $oo := map:new()
        let $name as xs:string := fn:string(fn:node-name($n))
        return
          if ($name = "input") then
            if ($n/node()) then
              let $_ :=
                for $x in $n/node()
                (: try to unquote xml for formatting :)
                let $unquoted :=
                  if ($x instance of text()) then
                    try {
                      xdmp:quote(xdmp:unquote(fn:string($x)), $quote-options)
                    }
                    catch($ex) {
                      $x
                    }
                  else
                    $x
                let $nn := fn:string(fn:node-name($x))
                return
                  map:put($oo, $nn, $unquoted)
              return
                map:put($o, $name, $oo)
            else
              map:put($o, $name, null-node {})
          else if ($name = "output") then
            (: try to unquote xml for formatting :)
            let $unquoted :=
              if ($n instance of text()) then
                try {
                  xdmp:quote(xdmp:unquote(fn:string($n)), $quote-options)
                }
                catch($ex) {
                  $n
                }
              else
                $n
            return
              map:put($o, $name, $unquoted)
          else if ($name = "error") then
            map:put($o, $name, $n)
          else if ($name = ("collectorPlugin", "contentPlugin", "headersPlugin", "triplesPlugin", "writerPlugin")) then
            ()
          else
            let $_ := trace:_walk_json($n/node(), $oo)
            return
              map:put($o, $name, $oo)
      case number-node() |
           boolean-node() |
           null-node() return
        map:put($o, fn:string(fn:node-name($n)), fn:data($n))
      case text() return
        let $unquoted :=
          try {
            xdmp:quote(xdmp:unquote(fn:string($n)), $quote-options)
          }
          catch($ex) {
            $n
          }
        return
          map:put($o, fn:string(fn:node-name($n)), $unquoted)
      case element(input) return
        let $oo := json:object()
        let $_ :=
          for $x in $n/*
          return
            map:put($oo, fn:local-name($x), xdmp:quote($x/*, $quote-options))
        return
          map:put($o, "input", $oo)
      case element(output) return
        map:put($o, fn:local-name($n), xdmp:quote($n/node(), $quote-options))
      case element(error) return
        map:put($o, fn:local-name($n), $n/error:error/err:error-to-json(.))
      case element(duration) return
        map:put($o, "duration", fn:seconds-from-duration(xs:dayTimeDuration($n)))
      case element(hasError) return
        map:put($o, "hasError", xs:boolean($n))
      case element(steps) return
        let $a := json:array()
        let $_ :=
          for $step in $n/step
          let $oo := json:object()
          let $_ := trace:_walk_json($step/*, $oo)
          return
            json:array-push($a, $oo)
        return
          map:put($o, "steps", $a)
      case element() return
        if ($n/*) then
          let $oo := json:object()
          let $_ := trace:_walk_json($n/*, $oo)
          return
            map:put($o, fn:local-name($n), $oo)
        else
          map:put($o, fn:local-name($n), $n/fn:data(.))
      default return
        $n
};

declare function trace:trace-to-json-legacy($trace)
{
  let $o := json:object()
  let $_ :=
    for $n in $trace/node()
    let $name := fn:string(fn:node-name($n))
    where fn:not($name = ("collectorPlugin", "contentPlugin", "headersPlugin", "triplesPlugin", "writerPlugin"))
    return
      map:put($o, $name, $n/data())
  let $steps := json:array()
  let $_build_steps :=
    for $n in $trace/node()
    let $name := fn:string(fn:node-name($n))
    where $name = ("collectorPlugin", "contentPlugin", "headersPlugin", "triplesPlugin", "writerPlugin")
    return
      let $step := json:object()
      let $_ := map:put($step, "label", fn:replace($name, "Plugin", ""))
      let $_ :=
        trace:_walk_json($n/node(), $step)
      return
        json:array-push($steps, $step)
  let $_ := map:put($o, "steps", $steps)
  return $o
};

declare function trace:trace-to-json($trace)
{
  if (fn:exists($trace/steps) or
      xdmp:node-kind($trace) = "object" and
      fn:exists($trace/trace/steps)) then
    let $o := json:object()
    let $walk-me :=
      let $n := $trace/node()
      return
        if ($n instance of object-node()) then
          $n/node()
        else
          $n
    let $_ := trace:_walk_json($walk-me, $o)
    return
      $o
  else
    trace:trace-to-json-legacy($trace)
};

declare function trace:trace-to-json-slim($trace)
{
  let $o := json:object()
  let $_ := (
    map:put($o, "traceId", $trace/trace/traceId/string()),
    map:put($o, "jobId", $trace/trace/jobId/string()),
    map:put($o, "created", $trace/trace/created/string()),
    map:put($o, "hasError", $trace/trace/hasError/xs:boolean(.)),
    map:put($o, "identifier", $trace/trace/identifier/string()),
    map:put($o, "flowType", $trace/trace/flowType/string()),
    map:put($o, "format", $trace/trace/format/string())
  )
  return
    $o
};

declare function trace:find-traces(
  $q,
  $page as xs:unsignedLong,
  $page-length as xs:unsignedLong)
{
  let $options :=
    <options xmlns="http://marklogic.com/appservices/search">
      <additional-query>{cts:collection-query("trace")}</additional-query>
      <return-results>false</return-results>
      <return-facets>true</return-facets>
      <sort-order type="xs:dateTime"
          direction="descending">
        <path-index>/trace/created</path-index>
      </sort-order>
    </options>
  let $query := search:parse($q)
  let $count := search:estimate($query, $options)
  let $start := ($page - 1) * $page-length + 1
  let $end := fn:min(($start + $page-length - 1, $count))
  let $results :=
    for $result in search:resolve-nodes($query, $options, $start, $page-length)
    return
      trace:trace-to-json-slim($result/node())
  return
    object-node {
      "start": $start,
      "end": $end,
      "total": $count,
      "page": $page,
      "pageCount": $page-length,
      "traces": json:to-array($results)
    }
};

declare function trace:get-traces($page as xs:int, $page-length as xs:int)
{
  let $start := ($page - 1) * $page-length + 1
  let $end := $start + $page-length - 1
  let $count := xdmp:estimate(/trace)
  let $traces :=
    for $trace in cts:search(/trace, cts:true-query(), ("unfiltered", cts:index-order(cts:path-reference("/trace/created"), "descending")))[$start to $end]
    return
      trace:trace-to-json($trace)
  return
    object-node {
      "start": $start,
      "end": $end,
      "total": $count,
      "page": $page,
      "pageCount": $page-length,
      "traces": json:to-array($traces)
    }
};

declare function trace:get-trace($id as xs:string)
{
  let $query :=
    cts:or-query((
      cts:path-range-query("/trace/traceId", "=", $id, ("collation=http://marklogic.com/collation/codepoint"))
    ))
  return
    trace:trace-to-json(cts:search(fn:doc(), $query)[1]/node())
};

declare function trace:get-traceIds($q as xs:string?)
{
  let $query :=
    if ($q) then
      cts:element-value-query(xs:QName("identifier"), fn:lower-case($q) || "*", "wildcarded")
    else ()
  let $results :=
    cts:value-co-occurrences(
      cts:path-reference("/trace/traceId"),
      cts:path-reference("/trace/identifier"),
      (
        "limit=10"
      ),
      $query)
  let $results :=
    for $r in $results
    return
      object-node {
        "traceId": fn:data($r/*:value[1]),
        "identifier": fn:data($r/*:value[2])
      }
  return
    json:to-array($results)
};


[ignore] fix broken xqts

[ignore] fix broken xqts

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

xquery version "1.0";

(: reuse webapp\xqts\xqts.xql :)

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

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

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

declare option exist:output-size-limit "-1";

(: $Id: xqts.xql 7721 2008-05-07 15:36:39Z brihaye $ :)

(:~  ----------------------------------------------------------------------------
     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:

     * Run EXIST_HOME/webapp/xqts/build.xml and follow the instructions.
     -------------------------------------------------------------------------- :)

declare variable $xqts:CONFIG := xqts:initialize();
declare variable $xqts:XQTS_HOME := xqts:path-to-uri(concat(system:get-exist-home(),"/",$xqts:CONFIG/basedir/text()));
declare variable $xqts:IN_MEMORY := ($xqts:CONFIG/mode/text() = "memory");

declare function xqts:initialize() as element() {
    let $home := system:get-exist-home()
    let $path := concat($home, "/webapp/xqts")
    let $collection := xdb:create-collection("/db", "XQTS")
    let $config0 := if (doc-available("/db/XQTS/config.xml")) then doc("/db/XQTS/config.xml")/config else ()
    let $config :=
        if ($config0) then
            $config0
        else
            let $stored := xdb:store-files-from-pattern("/db/XQTS", $path, "*.xml", "text/xml")
            return
                if (doc-available("/db/XQTS/config.xml")) then doc("/db/XQTS/config.xml")/config else ()
    let $xqtsHome := $config/basedir/text()
    let $catalog := doc("/db/XQTS/XQTSCatalog.xml")
    let $sources0 := collection("/db/XQTS/TestSources")
    let $sourceCol := xdb:create-collection("/db/XQTS", "TestSources")
    let $collection1 := xdb:create-collection("/db/XQTS/TestSources", "collection1")
    let $collection2 := xdb:create-collection("/db/XQTS/TestSources", "collection2")
    let $sources :=
        if ($sources0) then
            $sources0
        else
            xdb:store-files-from-pattern($sourceCol, concat($xqtsHome, "TestSources"), "*.xml", "text/xml")
    let $docs :=
        (
            (: since XQTS URIs are resolved against /db/XQTS/TestSources :)
            xdb:copy($sourceCol, "/db/XQTS/TestSources/collection1", "bib.xml"),
            xdb:copy($sourceCol, "/db/XQTS/TestSources/collection1", "reviews.xml"),
            xdb:copy($sourceCol, "/db/XQTS/TestSources/collection2", "bib.xml"),
            xdb:copy($sourceCol, "/db/XQTS/TestSources/collection2", "reviews.xml"),
            xdb:copy($sourceCol, "/db/XQTS/TestSources/collection2", "books.xml"),
            xdb:store($collection, "hacked-tests.xml",
                xs:anyURI(xqts:path-to-uri(
                        concat($home, "/test/src/org/exist/xquery/xqts/hacked-tests.xml")
                    )))
        )
    return
        $config
};

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

declare function xqts:create-collections($group as element(catalog:test-group)) as node() {
    let $rootColl := xdb:create-collection("/db/XQTS", "test-results")
    let $temp := xdb:create-collection("/db/XQTS", "temp")
    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" error="0"/>)
    return
        doc($results)
};

declare function xqts:create-collections($parent as xs:string,
    $pathElements as element()+, $currentPath as xs:string) as xs:string {
    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 $filePath := concat( $xqts:XQTS_HOME, "Queries/XQuery/", $case/@FilePath, $query-name, ".xq" )
    let $xq-string := file:read($filePath, "UTF-8")
    return
        $xq-string
};

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:get-input-value-uri($input as element(catalog:input-file)) as item()* {
    if ($input eq "emptydoc") then
       ()
    else
        let $source := root($input)//catalog:source[@ID = $input/text()]
        return concat( $xqts:XQTS_HOME, "/", $source/@FileName )
};

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

declare function xqts:compute-specific-static-context($testCaseName as xs:string) as element()* {
    (
        <unbind-namespace uri="http://exist.sourceforge.net/NS/exist"/>
    ,
        if ($testCaseName eq "ForExpr013") then
            <output-size-limit value="-1"/>
        else if ($testCaseName eq "fn-current-time-4") then
            (: arbitrary date :)
            <current-dateTime value="2005-12-05T13:38:03.455-05:00"/>
        else if ($testCaseName eq "fn-current-time-6") then
            (: arbitrary date :)
            <current-dateTime value="2005-12-05T13:38:18.059-05:00"/>
        else if ($testCaseName eq "fn-current-time-7") then
            (: arbitrary date :)
            <current-dateTime value="2005-12-05T13:38:18.059-05:00"/>
        else if ($testCaseName eq "fn-current-time-10") then
            (: arbitrary date :)
            <current-dateTime value="2005-12-05T13:38:18.09-05:00"/>
        else if (starts-with($testCaseName, "fn-current-time-")) then
            (: arbitrary date :)
            <current-dateTime value="2005-12-05T10:15:03.408-05:00"/>
        else if ($testCaseName eq "fn-current-dateTime-6") then
            <current-dateTime value="2005-12-05T17:10:00.312-05:00"/>
        (: bloody lower-case ! :)
        else if ($testCaseName eq "fn-current-datetime-7") then
            <current-dateTime value="2005-12-05T17:10:00.312-05:00"/>
        else if ($testCaseName eq "fn-current-dateTime-10") then
            <current-dateTime value="2005-12-05T17:10:00.344-05:00"/>
        else if ($testCaseName eq "fn-current-dateTime-21") then
            <current-dateTime value="2005-12-05T17:10:00.453-05:00"/>
        else if ($testCaseName eq "fn-current-dateTime-24") then
            <current-dateTime value="2005-12-05T17:10:00.469-05:00"/>
        else
            <current-dateTime value="2005-12-05T17:10:00.203-05:00"/>
    ,
        if (starts-with($testCaseName, "modules-") or starts-with($testCaseName, "K-ModuleImport-")) then
            (
            <mapModule namespace="http://www.w3.org/TestModules/test1"
                uri="{xs:anyURI('xmldb:exist:///db/XQTS/TestSources/test1-lib.xq')}"/>,
            <mapModule namespace="http://www.w3.org/TestModules/test2"
                uri="{xs:anyURI('xmldb:exist:///db/XQTS/TestSources/test2-lib.xq')}"/>,
            <mapModule namespace="http://www.w3.org/TestModules/module1"
                uri="{xs:anyURI('xmldb:exist:///db/XQTS/TestSources/module1-lib.xq')}"/>,
            <mapModule namespace="http://www.w3.org/TestModules/module2"
                uri="{xs:anyURI('xmldb:exist:///db/XQTS/TestSources/module2-lib.xq')}"/>,
            <mapModule namespace="http://www.w3.org/TestModules/defs"
                uri="{xs:anyURI('xmldb:exist:///db/XQTS/TestSources/moduleDefs-lib.xq')}"/>,
            <mapModule namespace="http://www.w3.org/TestModules/diffns"
                uri="{xs:anyURI('xmldb:exist:///db/XQTS/TestSources/modulesdiffns-lib.xq')}"/>
            )
        else
            ()
    ,
        if (matches($testCaseName,"^fn-implicit-timezone-.*$") or
            matches($testCaseName,"^K-ContextImplicitTimezoneFunc-.*$")) then
            <implicit-timezone value="-PT5H"/>
        else
            ()
    )
};

declare function xqts:get-context-item($input as element(catalog:contextItem)?) as item()* {
    if (empty($input)) 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:path-to-uri($path as xs:string) as xs:string {
    if (starts-with($path, "file:///")) then
        replace($path, "\\", "/")
    else if (starts-with($path, "/")) then
        concat("file://", replace($path, "\\", "/"))
    else
        concat("file:///", replace($path, "\\", "/"))
};

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

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

declare function xqts:get-expected-results($testCase as element(catalog:test-case), $inMemory as xs:boolean) as element()* {
    let $testName := $testCase/@name
    let $hackedTest := /hack:test-cases/hack:test-case[@name = $testName]
    return
    (
        for $output in $testCase/catalog:output-file
        return
            let $compare :=
                if (exists($hackedTest/@compare)) then
                    $hackedTest/@compare
                else if ($output/@compare eq "Inspect") then
                    (: "Text" by default. OK in most if not all the cases :)
                    "Text"
                else
                    $output/@compare
            let $outputFilePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $testCase/@FilePath,
                $output/text())
            return
                <expected-result compare="{$compare}">
                {
                    if ($compare eq "Text") then
                        xqts:normalize-and-expand(file:read($outputFilePath, "UTF-8"))
                    else if ($compare eq "UnnormalizedText") then
                        xqts:normalize-and-expand(file:read($outputFilePath, "UTF-8"))
                    else if ($compare eq "TextAsXML") then
                        xqts:normalize-and-expand(file:read($outputFilePath, "UTF-8"))
                    else if ($compare eq "XML") then
                        if ($inMemory) then
                            util:parse(file:read($outputFilePath, "UTF-8"))
                        else
                            util:catch(
                                "java.lang.Exception",
                                doc(xdb:store("/db/XQTS/temp", substring-before($output/text(), "."), xs:anyURI($outputFilePath), "text/xml")),
                                (: Handle unexpected exceptions :)
                                util:log("ERROR", concat("Exception while loading expected result: ", $util:exception-message))
                            )
                    else if ($compare eq "Fragment") then
                        let $xmlFrag := concat("<f>", file:read($outputFilePath, "UTF-8"), "</f>")
                        return
                            if ($inMemory) then
                                util:parse($xmlFrag)
                            else
                                util:catch(
                                    "java.lang.Exception",
                                    doc(xdb:store("/db/XQTS/temp", substring-before($output/text(), "."), $xmlFrag, "text/xml")),
                                    (: Handle unexpected exceptions :)
                                    util:log("ERROR", concat("Exception while loading expected result fragment: ", $util:exception-message))
                                )
                    else
                        util:log("ERROR", concat("Unknown comparison method: ", $compare))
                }
                </expected-result>
    ,
        (: due to a possible bug in the MemTreeBuilder, the parent element will be copied ! :)
        if (exists($hackedTest/hack:expected-result)) then
            $hackedTest/hack:expected-result
        else
            ()
    )
};

declare function xqts:execute-test-case($testCase as element(catalog:test-case), $inMemory as xs:boolean) as element()? {
    let $context :=
        <static-context>
            {
                xqts:compute-specific-static-context(string($testCase/@name))
            }
            {
                for $input in $testCase/catalog:input-file
                return
                    if ($inMemory) then
                        <variable name="{$input/@variable}" source="{xqts:get-input-value-uri($input)}"/>
                    else
                        <variable name="{$input/@variable}">{xqts:get-input-value($input)}</variable>,
                for $var in $testCase/catalog:input-query
                return
                    let $variable := xqts:get-variable($testCase, $var/@name)
                    return
                        <variable name="{$var/@variable}" type="{util:get-sequence-type($variable)}">{$variable}</variable>,
                for $input in $testCase/catalog:input-URI
                return
                    if ($input eq "works") then
                        <variable name="{$input/@variable}" type="xs:anyURI">{xs:anyURI("/db/XQTS/TestSources/works.xml")}</variable>
                    else if ($input eq "works-mod") then
                        <variable name="{$input/@variable}" type="xs:anyURI">{xs:anyURI("/db/XQTS/TestSources/works-mod.xml")}</variable>
                    else
                        <variable name="{$input/@variable}" type="xs:anyURI">{xs:anyURI(concat("/db/XQTS/TestSources/", $input))}</variable>
            }
            {
                for $input in $testCase/catalog:defaultCollection
                return
                    <staticallyKnownDocuments>{concat("/db/XQTS/TestSources/", $input)}</staticallyKnownDocuments>
            }
        </static-context>
    let $query := xqts:get-query($testCase)
    let $expectedResults := xqts:get-expected-results($testCase, $inMemory)
    let $formatedResult :=
        util:catch(
            "java.lang.Exception",
            let $raw_result := util:eval-with-context($query, $context, false(), xqts:get-context-item($testCase/catalog:contextItem))
            return
                xqts:compute-result($testCase, $query, $raw_result, $expectedResults),

            (: Exception processing :)
            (: Only expected exception and got exception. No check on if it is the right exception, though. :)
            if (fn:exists($testCase//catalog:expected-error) and empty($expectedResults)) then
               <test-case name="{$testCase/@name}" result="pass" dateRun="{util:system-time()}" print="expected-exception-got-exception">
                    (: TODO : check exception code :)
                    <exception>{$util:exception-message}</exception>
                    {
                        for $expected-error in $testCase//catalog:expected-error
                        return
                            <expected-error>{$expected-error/text()}</expected-error>
                    }
                    <query>{$query}</query>
               </test-case>
            (: Expected either output or exception. :)
            else if (fn:exists($testCase//catalog:expected-error) and fn:exists($expectedResults)) then
                <test-case name="{$testCase/@name}" result="pass" dateRun="{util:system-time()}" print="expected-exception-or-output">
                    (: TODO : check exception code :)
                    <exception>{$util:exception-message}</exception>
                    {
                        for $expectedResult in $expectedResults
                        return
                            $expectedResult
                    }
                    {
                        for $expected-error in $testCase//catalog:expected-error
                        return
                            <expected-error>{$expected-error/text()}</expected-error>
                    }
                    <query>{$query}</query>
                </test-case>
            (: Expected output, but got exception. :)
            else if (fn:empty($testCase//catalog:expected-error) and fn:exists($testCase//catalog:output-file)) then
                <test-case name="{$testCase/@name}" result="fail" dateRun="{util:system-time()}" print="expected-output-got-exception">
                    <exception>{$util:exception-message}</exception>
                    {
                        for $expectedResult in $expectedResults
                        return
                            $expectedResult
                    }
                    <query>{$query}</query>
                </test-case>
            (: Don't know what is expected but got here anyway. :)
            else
                <test-case name="{$testCase/@name}" result="fail" dateRun="{util:system-time()}" print="unhandled-error">
                    <exception>{$util:exception-message}</exception>
                    {
                        for $expectedResult in $expectedResults
                        return
                            $expectedResult
                    }
                    {
                        for $expected-error in $testCase//catalog:expected-error
                        return
                            <expected-error>{$expected-error/text()}</expected-error>
                    }
                    <query>{$query}</query>
                </test-case>
        )
        let $log :=
            if (fn:empty($formatedResult)) then
                util:log("DEBUG", ("Unable to generate a formated result: ", xs:string($testCase/@name)))
            else
                ()
    return $formatedResult
};

declare function xqts:compute-result($testCase as element(catalog:test-case), $query as xs:string, $result as item()*, $expectedResults as element()* ) {
    let $passed := some $expectedResultTest in (
        for $expectedResult in $expectedResults
        return
            let $comparisonMethod := $expectedResult/@compare
            return
                if ($comparisonMethod eq "Text") then
                    (: don't use text() because () neq "" :)
                    $expectedResult/string() eq xqts:normalize-text($result)
                else if ($comparisonMethod eq "UnnormalizedText") then
                    (: don't use text() because () neq "" :)
                    (: join the results in one single string :)
                    $expectedResult/string() eq string-join($result, "")
                else if ($comparisonMethod eq "TextAsXML") then
                    xdiff:compare($expectedResult/*, util:eval($result))
                else if ($comparisonMethod eq "XML") then
                    xdiff:compare($expectedResult/*, $result)
                else if ($comparisonMethod eq "Fragment") then
                    xdiff:compare($expectedResult/*, <f>{$result}</f>)
                (: unlikely :)
                else
                    false()
    ) satisfies $expectedResultTest
    return
        xqts:format-result($testCase, $passed, $query, $result, $expectedResults)
};

declare function xqts:format-result($testCase as element(catalog:test-case), $passed as xs:boolean, $query as xs:string,
    $result as item()*, $expectedResults as item()*) as element() {
    <test-case name="{$testCase/@name}" result="{if ($passed) then 'pass' else 'fail'}" dateRun="{util:system-time()}" print="result-without-exception">
        <result>{$result}</result>
        {
            for $expectedResult in $expectedResults
            return
                $expectedResult
        }
        {
            for $expected-error in $testCase//catalog:expected-error
            return
                <expected-error>{$expected-error/text()}</expected-error>
        }
        <query>{$query}</query>
    </test-case>
};

declare function xqts:run-single-test-case($case as element(catalog:test-case),
    $resultRoot as element()?, $inMemory as xs:boolean) as empty() {
    let $result := xqts:execute-test-case($case, $inMemory)
    return
        util:catch(
            "java.lang.Exception",
            update insert $result into $resultRoot,
            update insert <test-case name="{$case/@name}" result="fail" dateRun="{util:system-time()}" print="unhandled-error">
                    <exception>Caught late exception while inserting result: {$util:exception-message}</exception>
               </test-case> into $resultRoot
        ),
        let $added := $resultRoot/test-case[@name = $case/@name]
        let $log :=
            if (fn:empty($added)) then
                util:log("DEBUG", ("FAILURE in-memory-frag in test: ", xs:string($case/@name)))
            else
                ()
        return
            if ($added) then
                xqts:report-progress($added)
            else
                ()
};

declare function xqts:run-test-group($group as element(catalog:test-group), $inMemory as xs:boolean) 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, $inMemory),
                    if (fn:exists($tests) and fn:exists($resultsDoc/test-result)) 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, $inMemory)
        )
};

declare function xqts:test-single($name as xs:string, $inMemory as xs:boolean) 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, $inMemory)
            return
                $resultsDoc/test-result
        else
            <error>Test case not found: {$name}.</error>
};

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

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

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

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'])
    let $error := count($result//test-case[@result = 'error'])
    return (
        update value $result/@passed with xs:int($passed),
        update value $result/@failed with xs:int($failed),
        update value $result/@error with xs:int($error)
    )
};

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

declare variable $testGroup external;
declare variable $testCase external;

let $XQTSCatalog := xmldb:document('/db/XQTS/XQTSCatalog.xml'),
    $case := $XQTSCatalog//catalog:test-group[@name = $testGroup]/catalog:test-case[@name = $testCase]
return
xqts:execute-test-case($case, fn:true())

xquery version "1.0";

(: reuse webapp\xqts\xqts.xql :)

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

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

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

declare option exist:output-size-limit "-1";

(: $Id: xqts.xql 7721 2008-05-07 15:36:39Z brihaye $ :)

(:~  ----------------------------------------------------------------------------
     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:

     * Run EXIST_HOME/webapp/xqts/build.xml and follow the instructions.
     -------------------------------------------------------------------------- :)

declare variable $xqts:CONFIG := xqts:initialize();
declare variable $xqts:XQTS_HOME := xqts:path-to-uri(concat(system:get-exist-home(),"/",$xqts:CONFIG/basedir/text()));
declare variable $xqts:IN_MEMORY := ($xqts:CONFIG/mode/text() = "memory");

declare function xqts:initialize() as element() {
    let $home := system:get-exist-home()
    let $path := concat($home, "/webapp/xqts")
    let $collection := xdb:create-collection("/db", "XQTS")
    let $config0 := if (doc-available("/db/XQTS/config.xml")) then doc("/db/XQTS/config.xml")/config else ()
    let $config :=
        if ($config0) then
            $config0
        else
            let $stored := xdb:store-files-from-pattern("/db/XQTS", $path, "*.xml", "text/xml")
            return
                if (doc-available("/db/XQTS/config.xml")) then doc("/db/XQTS/config.xml")/config else ()
    let $xqtsHome := $config/basedir/text()
    let $catalog := doc("/db/XQTS/XQTSCatalog.xml")
    let $sources0 := collection("/db/XQTS/TestSources")
    let $sourceCol := xdb:create-collection("/db/XQTS", "TestSources")
    let $collection1 := xdb:create-collection("/db/XQTS/TestSources", "collection1")
    let $collection2 := xdb:create-collection("/db/XQTS/TestSources", "collection2")
    let $sources :=
        if ($sources0) then
            $sources0
        else
            xdb:store-files-from-pattern($sourceCol, concat($xqtsHome, "TestSources"), "*.xml", "text/xml")
    let $docs :=
        (
            (: since XQTS URIs are resolved against /db/XQTS/TestSources :)
            xdb:copy($sourceCol, "/db/XQTS/TestSources/collection1", "bib.xml"),
            xdb:copy($sourceCol, "/db/XQTS/TestSources/collection1", "reviews.xml"),
            xdb:copy($sourceCol, "/db/XQTS/TestSources/collection2", "bib.xml"),
            xdb:copy($sourceCol, "/db/XQTS/TestSources/collection2", "reviews.xml"),
            xdb:copy($sourceCol, "/db/XQTS/TestSources/collection2", "books.xml"),
            xdb:store($collection, "hacked-tests.xml",
                xs:anyURI(xqts:path-to-uri(
                        concat($home, "/test/src/org/exist/xquery/xqts/hacked-tests.xml")
                    )))
        )
    return
        $config
};

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

declare function xqts:create-collections($group as element(catalog:test-group)) as node() {
    let $rootColl := xdb:create-collection("/db/XQTS", "test-results")
    let $temp := xdb:create-collection("/db/XQTS", "temp")
    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" error="0"/>)
    return
        doc($results)
};

declare function xqts:create-collections($parent as xs:string,
    $pathElements as element()+, $currentPath as xs:string) as xs:string {
    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 $filePath := concat( $xqts:XQTS_HOME, "Queries/XQuery/", $case/@FilePath, $query-name, ".xq" )
    let $xq-string := file:read($filePath, "UTF-8")
    return
        $xq-string
};

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:get-input-value-uri($input as element(catalog:input-file)) as item()* {
    if ($input eq "emptydoc") then
       ()
    else
        let $source := root($input)//catalog:source[@ID = $input/text()]
        return concat( $xqts:XQTS_HOME, "/", $source/@FileName )
};

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

declare function xqts:compute-specific-static-context($testCaseName as xs:string) as element()* {
    (
        <unbind-namespace uri="http://exist.sourceforge.net/NS/exist"/>
    ,
        if ($testCaseName eq "ForExpr013") then
            <output-size-limit value="-1"/>
        else if ($testCaseName eq "fn-current-time-4") then
            (: arbitrary date :)
            <current-dateTime value="2005-12-05T13:38:03.455-05:00"/>
        else if ($testCaseName eq "fn-current-time-6") then
            (: arbitrary date :)
            <current-dateTime value="2005-12-05T13:38:18.059-05:00"/>
        else if ($testCaseName eq "fn-current-time-7") then
            (: arbitrary date :)
            <current-dateTime value="2005-12-05T13:38:18.059-05:00"/>
        else if ($testCaseName eq "fn-current-time-10") then
            (: arbitrary date :)
            <current-dateTime value="2005-12-05T13:38:18.09-05:00"/>
        else if (starts-with($testCaseName, "fn-current-time-")) then
            (: arbitrary date :)
            <current-dateTime value="2005-12-05T10:15:03.408-05:00"/>
        else if ($testCaseName eq "fn-current-dateTime-6") then
            <current-dateTime value="2005-12-05T17:10:00.312-05:00"/>
        (: bloody lower-case ! :)
        else if ($testCaseName eq "fn-current-datetime-7") then
            <current-dateTime value="2005-12-05T17:10:00.312-05:00"/>
        else if ($testCaseName eq "fn-current-dateTime-10") then
            <current-dateTime value="2005-12-05T17:10:00.344-05:00"/>
        else if ($testCaseName eq "fn-current-dateTime-21") then
            <current-dateTime value="2005-12-05T17:10:00.453-05:00"/>
        else if ($testCaseName eq "fn-current-dateTime-24") then
            <current-dateTime value="2005-12-05T17:10:00.469-05:00"/>
        else
            <current-dateTime value="2005-12-05T17:10:00.203-05:00"/>
    ,
        if (starts-with($testCaseName, "modules-") or starts-with($testCaseName, "K-ModuleImport-")) then
            (
            <mapModule namespace="http://www.w3.org/TestModules/test1"
                uri="{xs:anyURI('xmldb:exist:///db/XQTS/TestSources/test1-lib.xq')}"/>,
            <mapModule namespace="http://www.w3.org/TestModules/test2"
                uri="{xs:anyURI('xmldb:exist:///db/XQTS/TestSources/test2-lib.xq')}"/>,
            <mapModule namespace="http://www.w3.org/TestModules/module1"
                uri="{xs:anyURI('xmldb:exist:///db/XQTS/TestSources/module1-lib.xq')}"/>,
            <mapModule namespace="http://www.w3.org/TestModules/module2"
                uri="{xs:anyURI('xmldb:exist:///db/XQTS/TestSources/module2-lib.xq')}"/>,
            <mapModule namespace="http://www.w3.org/TestModules/defs"
                uri="{xs:anyURI('xmldb:exist:///db/XQTS/TestSources/moduleDefs-lib.xq')}"/>,
            <mapModule namespace="http://www.w3.org/TestModules/diffns"
                uri="{xs:anyURI('xmldb:exist:///db/XQTS/TestSources/modulesdiffns-lib.xq')}"/>
            )
        else
            ()
    ,
        if (matches($testCaseName,"^fn-implicit-timezone-.*$") or
            matches($testCaseName,"^K-ContextImplicitTimezoneFunc-.*$")) then
            <implicit-timezone value="-PT5H"/>
        else
            ()
    )
};

declare function xqts:get-context-item($input as element(catalog:contextItem)?) as item()* {
    if (empty($input)) 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:path-to-uri($path as xs:string) as xs:string {
    if (starts-with($path, "file:///")) then
        replace($path, "\\", "/")
    else if (starts-with($path, "/")) then
        concat("file://", replace($path, "\\", "/"))
    else
        concat("file:///", replace($path, "\\", "/"))
};

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

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

declare function xqts:get-expected-results($testCase as element(catalog:test-case), $inMemory as xs:boolean) as element()* {
    let $testName := $testCase/@name
    let $hackedTest := /hack:test-cases/hack:test-case[@name = $testName]
    return
    (
        for $output in $testCase/catalog:output-file
        return
            let $compare :=
                if (exists($hackedTest/@compare)) then
                    $hackedTest/@compare
                else if ($output/@compare eq "Inspect") then
                    (: "Text" by default. OK in most if not all the cases :)
                    "Text"
                else
                    $output/@compare
            let $outputFilePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $testCase/@FilePath,
                $output/text())
            return
                <expected-result compare="{$compare}">
                {
                    if ($compare eq "Text") then
                        xqts:normalize-and-expand(file:read($outputFilePath, "UTF-8"))
                    else if ($compare eq "UnnormalizedText") then
                        xqts:normalize-and-expand(file:read($outputFilePath, "UTF-8"))
                    else if ($compare eq "TextAsXML") then
                        xqts:normalize-and-expand(file:read($outputFilePath, "UTF-8"))
                    else if ($compare eq "XML") then
                        if ($inMemory) then
                            util:parse(file:read($outputFilePath, "UTF-8"))
                        else
                            util:catch(
                                "java.lang.Exception",
                                doc(xdb:store("/db/XQTS/temp", substring-before($output/text(), "."), xs:anyURI($outputFilePath), "text/xml")),
                                (: Handle unexpected exceptions :)
                                util:log("ERROR", concat("Exception while loading expected result: ", $util:exception-message))
                            )
                    else if ($compare eq "Fragment") then
                        let $xmlFrag := concat("<f>", file:read($outputFilePath, "UTF-8"), "</f>")
                        return
                            if ($inMemory) then
                                util:parse($xmlFrag)
                            else
                                util:catch(
                                    "java.lang.Exception",
                                    doc(xdb:store("/db/XQTS/temp", substring-before($output/text(), "."), $xmlFrag, "text/xml")),
                                    (: Handle unexpected exceptions :)
                                    util:log("ERROR", concat("Exception while loading expected result fragment: ", $util:exception-message))
                                )
                    else
                        util:log("ERROR", concat("Unknown comparison method: ", $compare))
                }
                </expected-result>
    ,
        (: due to a possible bug in the MemTreeBuilder, the parent element will be copied ! :)
        if (exists($hackedTest/hack:expected-result)) then
            $hackedTest/hack:expected-result
        else
            ()
    )
};

declare function xqts:execute-test-case($testCase as element(catalog:test-case), $inMemory as xs:boolean) as element()? {
    let $context :=
        <static-context>
            {
                xqts:compute-specific-static-context(string($testCase/@name))
            }
            {
                for $input in $testCase/catalog:input-file
                return
                    if ($inMemory) then
                        <variable name="{$input/@variable}" source="{xqts:get-input-value-uri($input)}"/>
                    else
                        <variable name="{$input/@variable}">{xqts:get-input-value($input)}</variable>,
                for $var in $testCase/catalog:input-query
                return
                    let $variable := xqts:get-variable($testCase, $var/@name)
                    return
                        <variable name="{$var/@variable}" type="{util:get-sequence-type($variable)}">{$variable}</variable>,
                for $input in $testCase/catalog:input-URI
                return
                    if ($input eq "works") then
                        <variable name="{$input/@variable}" type="xs:anyURI">{xs:anyURI("/db/XQTS/TestSources/works.xml")}</variable>
                    else if ($input eq "works-mod") then
                        <variable name="{$input/@variable}" type="xs:anyURI">{xs:anyURI("/db/XQTS/TestSources/works-mod.xml")}</variable>
                    else
                        <variable name="{$input/@variable}" type="xs:anyURI">{xs:anyURI(concat("/db/XQTS/TestSources/", $input))}</variable>
            }
            {
                for $input in $testCase/catalog:defaultCollection
                return
                    <staticallyKnownDocuments>{concat("/db/XQTS/TestSources/", $input)}</staticallyKnownDocuments>
            }
        </static-context>
    let $query := xqts:get-query($testCase)
    let $expectedResults := xqts:get-expected-results($testCase, $inMemory)
    let $formatedResult :=
        util:catch(
            "java.lang.Exception",
            let $raw_result := util:eval-with-context($query, $context, false(), xqts:get-context-item($testCase/catalog:contextItem))
            return
                xqts:compute-result($testCase, $query, $raw_result, $expectedResults),

            (: Exception processing :)
            (: Only expected exception and got exception. No check on if it is the right exception, though. :)
            if (fn:exists($testCase//catalog:expected-error) and empty($expectedResults)) then
               <test-case name="{$testCase/@name}" result="pass" dateRun="{util:system-time()}" print="expected-exception-got-exception">
                    (: TODO : check exception code :)
                    <exception>{$util:exception-message}</exception>
                    {
                        for $expected-error in $testCase//catalog:expected-error
                        return
                            <expected-error>{$expected-error/text()}</expected-error>
                    }
                    <query>{$query}</query>
               </test-case>
            (: Expected either output or exception. :)
            else if (fn:exists($testCase//catalog:expected-error) and fn:exists($expectedResults)) then
                <test-case name="{$testCase/@name}" result="pass" dateRun="{util:system-time()}" print="expected-exception-or-output">
                    (: TODO : check exception code :)
                    <exception>{$util:exception-message}</exception>
                    {
                        for $expectedResult in $expectedResults
                        return
                            $expectedResult
                    }
                    {
                        for $expected-error in $testCase//catalog:expected-error
                        return
                            <expected-error>{$expected-error/text()}</expected-error>
                    }
                    <query>{$query}</query>
                </test-case>
            (: Expected output, but got exception. :)
            else if (fn:empty($testCase//catalog:expected-error) and fn:exists($testCase//catalog:output-file)) then
                <test-case name="{$testCase/@name}" result="fail" dateRun="{util:system-time()}" print="expected-output-got-exception">
                    <exception>{$util:exception-message}</exception>
                    {
                        for $expectedResult in $expectedResults
                        return
                            $expectedResult
                    }
                    <query>{$query}</query>
                </test-case>
            (: Don't know what is expected but got here anyway. :)
            else
                <test-case name="{$testCase/@name}" result="fail" dateRun="{util:system-time()}" print="unhandled-error">
                    <exception>{$util:exception-message}</exception>
                    {
                        for $expectedResult in $expectedResults
                        return
                            $expectedResult
                    }
                    {
                        for $expected-error in $testCase//catalog:expected-error
                        return
                            <expected-error>{$expected-error/text()}</expected-error>
                    }
                    <query>{$query}</query>
                </test-case>
        )
        let $log :=
            if (fn:empty($formatedResult)) then
                util:log("DEBUG", ("Unable to generate a formated result: ", xs:string($testCase/@name)))
            else
                ()
    return $formatedResult
};

declare function xqts:compute-result($testCase as element(catalog:test-case), $query as xs:string, $result as item()*, $expectedResults as element()* ) {
    let $passed := some $expectedResultTest in (
        for $expectedResult in $expectedResults
        return
            let $comparisonMethod := $expectedResult/@compare
            return
                if ($comparisonMethod eq "Text") then
                    (: don't use text() because () neq "" :)
                    $expectedResult/string() eq xqts:normalize-text($result)
                else if ($comparisonMethod eq "UnnormalizedText") then
                    (: don't use text() because () neq "" :)
                    (: join the results in one single string :)
                    $expectedResult/string() eq string-join($result, "")
                else if ($comparisonMethod eq "TextAsXML") then
                    xdiff:compare($expectedResult/*, util:eval($result))
                else if ($comparisonMethod eq "XML") then
                    xdiff:compare($expectedResult/*, $result)
                else if ($comparisonMethod eq "Fragment") then
                    xdiff:compare($expectedResult/*, <f>{$result}</f>)
                (: unlikely :)
                else
                    false()
    ) satisfies $expectedResultTest
    return
        xqts:format-result($testCase, $passed, $query, $result, $expectedResults)
};

declare function xqts:format-result($testCase as element(catalog:test-case), $passed as xs:boolean, $query as xs:string,
    $result as item()*, $expectedResults as item()*) as element() {
    <test-case name="{$testCase/@name}" result="{if ($passed) then 'pass' else 'fail'}" dateRun="{util:system-time()}" print="result-without-exception">
        <result>{$result}</result>
        {
            for $expectedResult in $expectedResults
            return
                $expectedResult
        }
        {
            for $expected-error in $testCase//catalog:expected-error
            return
                <expected-error>{$expected-error/text()}</expected-error>
        }
        <query>{$query}</query>
    </test-case>
};

declare function xqts:run-single-test-case($case as element(catalog:test-case),
    $resultRoot as element()?, $inMemory as xs:boolean) as empty() {
    let $result := xqts:execute-test-case($case, $inMemory)
    return
        util:catch(
            "java.lang.Exception",
            update insert $result into $resultRoot,
            update insert <test-case name="{$case/@name}" result="fail" dateRun="{util:system-time()}" print="unhandled-error">
                    <exception>Caught late exception while inserting result: {$util:exception-message}</exception>
               </test-case> into $resultRoot
        ),
        let $added := $resultRoot/test-case[@name = $case/@name]
        let $log :=
            if (fn:empty($added)) then
                util:log("DEBUG", ("FAILURE in-memory-frag in test: ", xs:string($case/@name)))
            else
                ()
        return
            if ($added) then
                xqts:report-progress($added)
            else
                ()
};

declare function xqts:run-test-group($group as element(catalog:test-group), $inMemory as xs:boolean) 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, $inMemory),
                    if (fn:exists($tests) and fn:exists($resultsDoc/test-result)) 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, $inMemory)
        )
};

declare function xqts:test-single($name as xs:string, $inMemory as xs:boolean) 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, $inMemory)
            return
                $resultsDoc/test-result
        else
            <error>Test case not found: {$name}.</error>
};

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

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

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

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'])
    let $error := count($result//test-case[@result = 'error'])
    return (
        update value $result/@passed with xs:int($passed),
        update value $result/@failed with xs:int($failed),
        update value $result/@error with xs:int($error)
    )
};

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

declare variable $testGroup external;
declare variable $testCase external;

let $XQTSCatalog := xmldb:document('/db/XQTS/XQTSCatalog.xml'),
    $case := $XQTSCatalog//catalog:test-group[@name = $testGroup]/catalog:test-case[@name = $testCase]
return
xqts:execute-test-case($case, fn:true())