Added author to subtopic entries.

Added author to subtopic entries.

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

<feed xmlns="http://www.w3.org/2005/Atom"
xmlns:atom="http://www.w3.org/2005/Atom">
   {
     "
",
     /atom:feed/atom:title,
     "
",
     /atom:feed/atom:id,
     "
",
     /atom:feed/atom:updated,
     "
",
     /atom:feed/atom:entry[atom:category[@scheme='http://www.smallx.com/Ontology/Atopic/2006/1/0/topic/relation' and @term='subtopic']],
     "
",
     /atom:feed/atom:link
   }
   {
      let $current := substring-before(base-uri(/atom:feed),'/.feed.atom'),
           $current-path := substring-after($current,'/db')
         return (
            <link rel="alternate" href="/atom/content{substring-after($current,'/db')}" type="application/atom+xml"/>,
           "
",
            let $parts := tokenize($current-path,'/')
               for $i in (1 to count($parts)-1)
                   let $apath := string-join(subsequence($parts,1,$i),'/'),
                       $feed := document(concat($apath,'/.feed.atom'))/atom:feed
                     return if ($feed and not($feed/atom:category[@scheme='http://www.smallx.com/Ontology/Atopic/2006/1/0/display' and @term='false']))
                       then (<entry>
                            {
                                "
",
                                $feed/atom:id,
                                "
",
                                $feed/atom:title,
                                "
",
                                $feed/atom:updated,
                                "
",
                                $feed/atom:author,
                                "
",
                                <category scheme="http://www.smallx.com/Ontology/Atopic/2006/1/0/topic/relation" term="ancestor"/>,
                                "
",
                                <link rel="alternate" href="/atom/content/{$apath}" type="application/atom+xml"/>,
                                "
",
                                <summary>
                                     {
                                         $feed/atom:subtitle/@type,
                                         $feed/atom:subtitle/node()
                                     }
                                </summary>,
                                "
"
                             }
                            </entry>,
                            "
"
                            )
                       else (),
            for $i in (collection($current)/atom:feed)
               let $path :=  substring-before(base-uri($i),'/.feed.atom'),
                   $prefix := concat($current,'/')
                  return if ($current!=$path and not(contains(substring-after($path,$prefix),'/'))
                             and not($i/atom:category[@scheme='http://www.smallx.com/Ontology/Atopic/2006/1/0/display' and @term='false']))
                     then (<entry>
                            {
                                "
",
                                $i/atom:id,
                                "
",
                                $i/atom:title,
                                "
",
                                $i/atom:updated,
                                "
",
                                <category scheme="http://www.smallx.com/Ontology/Atopic/2006/1/0/topic/relation" term="subtopic"/>,
                                "
",
                                <link rel="alternate" href="/atom/content{substring-after($path,'/db')}" type="application/atom+xml"/>,
                                "
",
                                <summary>
                                     {
                                         $i/atom:subtitle/@type,
                                         $i/atom:subtitle/node()
                                     }
                                </summary>,
                                "
"
                             }
                            </entry>,
                            "
"
                            )
                     else ()
         )
   }
</feed>

<feed xmlns="http://www.w3.org/2005/Atom"
xmlns:atom="http://www.w3.org/2005/Atom">
   {
     "
",
     /atom:feed/atom:title,
     "
",
     /atom:feed/atom:id,
     "
",
     /atom:feed/atom:updated,
     "
",
     /atom:feed/atom:entry[atom:category[@scheme='http://www.smallx.com/Ontology/Atopic/2006/1/0/topic/relation' and @term='subtopic']],
     "
",
     /atom:feed/atom:link
   }
   {
      let $current := substring-before(base-uri(/atom:feed),'/.feed.atom'),
           $current-path := substring-after($current,'/db')
         return (
            <link rel="alternate" href="/atom/content{substring-after($current,'/db')}" type="application/atom+xml"/>,
           "
",
            let $parts := tokenize($current-path,'/')
               for $i in (1 to count($parts)-1)
                   let $apath := string-join(subsequence($parts,1,$i),'/'),
                       $feed := document(concat($apath,'/.feed.atom'))/atom:feed
                     return if ($feed and not($feed/atom:category[@scheme='http://www.smallx.com/Ontology/Atopic/2006/1/0/display' and @term='false']))
                       then (<entry>
                            {
                                "
",
                                $feed/atom:id,
                                "
",
                                $feed/atom:title,
                                "
",
                                $feed/atom:updated,
                                "
",
                                <category scheme="http://www.smallx.com/Ontology/Atopic/2006/1/0/topic/relation" term="ancestor"/>,
                                "
",
                                <link rel="alternate" href="/atom/content/{$apath}" type="application/atom+xml"/>,
                                "
",
                                <summary>
                                     {
                                         $feed/atom:subtitle/@type,
                                         $feed/atom:subtitle/node()
                                     }
                                </summary>,
                                "
"
                             }
                            </entry>,
                            "
"
                            )
                       else (),
            for $i in (collection($current)/atom:feed)
               let $path :=  substring-before(base-uri($i),'/.feed.atom'),
                   $prefix := concat($current,'/')
                  return if ($current!=$path and not(contains(substring-after($path,$prefix),'/'))
                             and not($i/atom:category[@scheme='http://www.smallx.com/Ontology/Atopic/2006/1/0/display' and @term='false']))
                     then (<entry>
                            {
                                "
",
                                $i/atom:id,
                                "
",
                                $i/atom:title,
                                "
",
                                $i/atom:updated,
                                "
",
                                <category scheme="http://www.smallx.com/Ontology/Atopic/2006/1/0/topic/relation" term="subtopic"/>,
                                "
",
                                <link rel="alternate" href="/atom/content{substring-after($path,'/db')}" type="application/atom+xml"/>,
                                "
",
                                <summary>
                                     {
                                         $i/atom:subtitle/@type,
                                         $i/atom:subtitle/node()
                                     }
                                </summary>,
                                "
"
                             }
                            </entry>,
                            "
"
                            )
                     else ()
         )
   }
</feed>


fixed xml issue

fixed xml issue

(:
  Copyright 2012-2016 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/lib/config.xqy";

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

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

declare option xdmp:mapping "false";

declare variable $FORMAT-XML := "xml";
declare variable $FORMAT-JSON := "json";

declare %private variable $current-trace-settings := map:map();

declare %private variable $current-trace := map:new((
  map:entry("traceId", xdmp:random()),
  map:entry("created", fn:current-dateTime())
));

declare function trace:enable-tracing($enabled as xs:boolean)
{
  xdmp:document-insert(
    "/com.marklogic.hub/__tracing_enabled__.xml",
    element trace:is-tracing-enabled { if ($enabled) then 1 else 0 })
};

declare function trace:enabled() as xs:boolean
{
  let $value := cts:element-values(xs:QName("trace:is-tracing-enabled"), (), ("type=unsignedInt","limit=1"))
  return
    if ($value) then
      $value eq 1
    else
      fn:false()
};

declare function trace:has-errors()
{
  map:get($current-trace-settings, "_has_errors") eq fn:true()
};

declare function trace:init-trace($format as xs:string)
{
  map:put($current-trace-settings, "data-format", $format)
};

declare function trace:write-trace()
{
  if (trace:enabled() or trace:has-errors()) then
    let $format := map:get($current-trace-settings, "data-format")
    let $trace :=
      if ($format eq $FORMAT-JSON) then
        xdmp:to-json($current-trace)
      else
        element trace {
          element format { map:get($current-trace, "format") },
          element traceId { map:get($current-trace, "traceId") },
          element created { map:get($current-trace, "created") },
          element identifier { map:get($current-trace, "identifier") },
          element flowType { map:get($current-trace, "flowType") },
          for $key in ("collectorPlugin", "contentPlugin", "headersPlugin", "triplesPlugin", "writerPlugin")
          let $m := map:get($current-trace, $key)
          return
            if (fn:exists($m)) then
              element { $key } {
                element pluginModuleUri { map:get($m, "pluginModuleUri") },
                element input { map:get($m, "input") },
                element output { map:get($m, "output") },
                element duration { map:get($m, "duration") }
              }
            else ()
        }
    return
      xdmp:eval('
        xquery version "1.0-ml";

        declare option xdmp:mapping "false";

        declare variable $trace external;

        xdmp:document-insert(
          "/" || $trace/traceId,
          $trace,
          xdmp:default-permissions(),
          ("trace", $trace/*:type)
        )
      ',
      map:new((
        map:entry("trace", $trace)
      )),
      map:new((
        map:entry("database", xdmp:database($config:TRACING-DATABASE)),
        map:entry("transactionMode", "update-auto-commit")
      )))
  else ()
};

declare function trace:plugin-trace(
  $identifier,
  $module-uri,
  $plugin-type as xs:string,
  $flowType as xs:string,
  $input,
  $output,
  $duration as xs:dayTimeDuration)
{
  let $format :=
    let $o :=
      if ($input instance of document-node()) then
        $input/node()
      else
        $input
    return
      typeswitch($o)
        case element() return "xml"
        case object-node() return "json"
        case array-node() return "json"
        default return "xml"
  return
    map:put($current-trace, "format", $format),
  map:put($current-trace, "identifier", $identifier),
  map:put($current-trace, "flowType", $flowType),
  let $plugin-map := map:new((
    map:entry("pluginModuleUri", $module-uri),
    map:entry("input", $input),
    map:entry("output", $output),
    map:entry("duration", $duration)
  ))
  return
    map:put($current-trace, $plugin-type || "Plugin", $plugin-map)
};

declare function trace:error-trace(
  $identifier as xs:string?,
  $module-uri as xs:string,
  $plugin-type as xs:string,
  $flowType as xs:string,
  $input,
  $error as element(error:error),
  $duration as xs:dayTimeDuration)
{
  let $format :=
    let $o :=
      if ($input instance of document-node()) then
        $input/node()
      else
        $input
    return
      typeswitch($o)
        case element() return "xml"
        case object-node() return "json"
        case array-node() return "json"
        default return "xml"
  return
    map:put($current-trace, "format", $format),
  map:put($current-trace, "identifier", $identifier),
  map:put($current-trace, "flowType", $flowType),
  map:put($current-trace-settings, "_has_errors", fn:true()),
  let $plugin-map := map:new((
    map:entry("pluginModuleUri", $module-uri),
    map:entry("input", $input),
    map:entry("error", $error),
    map:entry("duration", $duration)
  ))
  let $_ := map:put($current-trace, $plugin-type || "Plugin", $plugin-map)
  let $_ := trace:write-trace()
  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>
    </options>

  for $n in $nodes
  return
    typeswitch($n)
      case array-node() return
        let $name as xs:string := fn:string(fn:node-name($n))
        return
          map:put($o, $name, xdmp:quote($n))
      case object-node() return
        let $oo := json:object()
        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()
                let $nn := fn:string(fn:node-name($x))
                return
                  map:put($oo, $nn, xdmp:quote($x, $quote-options))
              return
                map:put($o, $name, $oo)
            else
              map:put($o, $name, null-node {})
          else if ($name = "output") then
            map:put($o, $name, xdmp:quote($n, $quote-options))
          else
            let $_ := trace:_walk_json($n/node(), $oo)
            return
              map:put($o, $name, $oo)
      case number-node() |
           boolean-node() |
           null-node() |
           text() return
        map:put($o, fn:string(fn:node-name($n)), fn:data($n))
      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(duration) return
        map:put($o, "duration", fn:seconds-from-duration(xs:dayTimeDuration($n)))
      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), fn:data($n))
      default return
        $n
};

declare function trace:trace-to-json($trace)
{
  if ($trace instance of element()) 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
};

declare function trace:trace-to-json-slim($trace)
{
  (:if ($trace instance of element()) then:)
    let $o := json:object()
    let $_ := (
      map:put($o, "traceId", $trace/traceId/string()),
      map:put($o, "created", $trace/created/string()),
      map:put($o, "identifier", $trace/identifier/string()),
      map:put($o, "flowType", $trace/flowType/string())
    )
    return
      $o
(:  else
    let $o := json:object()
    let $_ := (
      map:put($o, "traceId", $trace/traceId),
      map:put($o, "created", $trace/created),
      map:put($o, "identifier", $trace/identifier),
      map:put($o, "flowType", $trace/flowType)
    )
    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">
        <element ns="" name="created"/>
      </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:element-reference(xs:QName("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:element-range-query(xs:QName("traceId"), "=", $id, ("collation=http://marklogic.com/collation/codepoint")),
      cts:json-property-range-query("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:element-value-co-occurrences(
      xs:QName("traceId"),
      xs:QName("identifier"),
      (
        "limit=10",
        "collation=http://marklogic.com/collation/codepoint"
      ),
      $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-2016 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/lib/config.xqy";

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

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

declare option xdmp:mapping "false";

declare variable $FORMAT-XML := "xml";
declare variable $FORMAT-JSON := "json";

declare %private variable $current-trace-settings := map:map();

declare %private variable $current-trace := map:new((
  map:entry("traceId", xdmp:random()),
  map:entry("created", fn:current-dateTime())
));

declare function trace:enable-tracing($enabled as xs:boolean)
{
  xdmp:document-insert(
    "/com.marklogic.hub/__tracing_enabled__.xml",
    element trace:is-tracing-enabled { if ($enabled) then 1 else 0 })
};

declare function trace:enabled() as xs:boolean
{
  let $value := cts:element-values(xs:QName("trace:is-tracing-enabled"), (), ("type=unsignedInt","limit=1"))
  return
    if ($value) then
      $value eq 1
    else
      fn:false()
};

declare function trace:has-errors()
{
  map:get($current-trace-settings, "_has_errors") eq fn:true()
};

declare function trace:init-trace($format as xs:string)
{
  map:put($current-trace-settings, "data-format", $format)
};

declare function trace:write-trace()
{
  if (trace:enabled() or trace:has-errors()) then
    let $format := map:get($current-trace-settings, "data-format")
    let $trace :=
      if ($format eq $FORMAT-JSON) then
        xdmp:to-json($current-trace)
      else
        element trace {
          element format { map:get($current-trace, "format") },
          element traceId { map:get($current-trace, "traceId") },
          element created { map:get($current-trace, "created") },
          element identifier { map:get($current-trace, "identifier") },
          element flowType { map:get($current-trace, "flowType") },
          for $key in ("collectorPlugin", "contentPlugin", "headersPlugin", "triplesPlugin", "writerPlugin")
          let $m := map:get($current-trace, $key)
          return
            if (fn:exists($m)) then
              element { $key } {
                element pluginModuleUri { map:get($m, "pluginModuleUri") },
                element input { map:get($m, "input") },
                element output { map:get($m, "output") },
                element duration { map:get($m, "duration") }
              }
            else ()
        }
    return
      xdmp:eval('
        xquery version "1.0-ml";

        declare option xdmp:mapping "false";

        declare variable $trace external;

        xdmp:document-insert(
          "/" || $trace/traceId,
          $trace,
          xdmp:default-permissions(),
          ("trace", $trace/*:type)
        )
      ',
      map:new((
        map:entry("trace", $trace)
      )),
      map:new((
        map:entry("database", xdmp:database($config:TRACING-DATABASE)),
        map:entry("transactionMode", "update-auto-commit")
      )))
  else ()
};

declare function trace:plugin-trace(
  $identifier,
  $module-uri,
  $plugin-type as xs:string,
  $flowType as xs:string,
  $input,
  $output,
  $duration as xs:dayTimeDuration)
{
  let $format :=
    let $o :=
      if ($input instance of document-node()) then
        $input/node()
      else
        $input
    return
      typeswitch($o)
        case element() return "xml"
        case object-node() return "json"
        case array-node() return "json"
        default return "xml"
  return
    map:put($current-trace, "format", $format),
  map:put($current-trace, "identifier", $identifier),
  map:put($current-trace, "flowType", $flowType),
  let $plugin-map := map:new((
    map:entry("pluginModuleUri", $module-uri),
    map:entry("input", $input),
    map:entry("output", $output),
    map:entry("duration", $duration)
  ))
  return
    map:put($current-trace, $plugin-type || "Plugin", $plugin-map)
};

declare function trace:error-trace(
  $identifier as xs:string?,
  $module-uri as xs:string,
  $plugin-type as xs:string,
  $flowType as xs:string,
  $input,
  $error as element(error:error),
  $duration as xs:dayTimeDuration)
{
  let $format :=
    let $o :=
      if ($input instance of document-node()) then
        $input/node()
      else
        $input
    return
      typeswitch($o)
        case element() return "xml"
        case object-node() return "json"
        case array-node() return "json"
        default return "xml"
  return
    map:put($current-trace, "format", $format),
  map:put($current-trace, "identifier", $identifier),
  map:put($current-trace, "flowType", $flowType),
  map:put($current-trace-settings, "_has_errors", fn:true()),
  let $plugin-map := map:new((
    map:entry("pluginModuleUri", $module-uri),
    map:entry("input", $input),
    map:entry("error", $error),
    map:entry("duration", $duration)
  ))
  let $_ := map:put($current-trace, $plugin-type || "Plugin", $plugin-map)
  let $_ := trace:write-trace()
  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>
    </options>

  for $n in $nodes
  return
    typeswitch($n)
      case array-node() return
        let $name as xs:string := fn:string(fn:node-name($n))
        return
          map:put($o, $name, xdmp:quote($n))
      case object-node() return
        let $oo := json:object()
        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()
                let $nn := fn:string(fn:node-name($x))
                return
                  map:put($oo, $nn, xdmp:quote($x, $quote-options))
              return
                map:put($o, $name, $oo)
            else
              map:put($o, $name, null-node {})
          else if ($name = "output") then
            map:put($o, $name, xdmp:quote($n, $quote-options))
          else
            let $_ := trace:_walk_json($n/node(), $oo)
            return
              map:put($o, $name, $oo)
      case number-node() |
           boolean-node() |
           null-node() |
           text() return
        map:put($o, fn:string(fn:node-name($n)), fn:data($n))
      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(duration) return
        map:put($o, "duration", fn:seconds-from-duration(xs:dayTimeDuration($n)))
      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), fn:data($n))
      default return
        $n
};

declare function trace:trace-to-json($trace)
{
  if ($trace instance of element()) 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
};

declare function trace:trace-to-json-slim($trace)
{
  (:if ($trace instance of element()) then:)
    let $o := json:object()
    let $_ := (
      map:put($o, "traceId", $trace/traceId/string()),
      map:put($o, "created", $trace/created/string()),
      map:put($o, "identifier", $trace/identifier/string()),
      map:put($o, "flowType", $trace/flowType/string())
    )
    return
      $o
(:  else
    let $o := json:object()
    let $_ := (
      map:put($o, "traceId", $trace/traceId),
      map:put($o, "created", $trace/created),
      map:put($o, "identifier", $trace/identifier),
      map:put($o, "flowType", $trace/flowType)
    )
    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">
        <element ns="" name="created"/>
      </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:element-reference(xs:QName("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:element-range-query(xs:QName("traceId"), "=", $id, ("collation=http://marklogic.com/collation/codepoint")),
      cts:json-property-range-query("traceId", "=", $id, ("collation=http://marklogic.com/collation/codepoint"))
    ))
  return
    trace:trace-to-json(cts:search(fn:doc(), $query)[1])
};

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:element-value-co-occurrences(
      xs:QName("traceId"),
      xs:QName("identifier"),
      (
        "limit=10",
        "collation=http://marklogic.com/collation/codepoint"
      ),
      $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)
};


collectresults works now OK for 1.1........ 1.0 has some issues still

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

declare option exist:serialize "method=xml indent=yes";
declare option exist:output-size-limit "-1";
declare namespace response="http://exist-db.org/xquery/response";

let $product-version := util:system-property("product-version")
let $product-build := util:system-property("product-build")
let $test-suite := doc('/db/XQTS/XQTSCatalog.xml')/*:test-suite/@version
let $dummy := response:set-header("Content-Disposition", concat(
	"attachment; filename="results_XQTS-" , $test-suite , "_eXist-" ,
	$product-version , '_' , $product-build , ".xml"" ) )

return
<test-suite-result xmlns="http://www.w3.org/2005/02/query-test-XQTSResult"
        xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">

        <implementation name="{$product-version}" version="{$product-build}" anonymous-result-column="false">

                <organization name="eXist Open Source native XML database"  website="http://www.exist-db.org" anonymous="false"/>

                <submittor name="eXist XQTS testsuite runner" email="me@not.com"/>

                <description>

eXist is an Open Source native XML database featuring efficient,
                        index-based XQuery processing, automatic indexing, extensions for full-text
                        search,  XUpdate  support and tight integration with existing XML development tools.

                </description>

                <implementation-defined-items>

                </implementation-defined-items>

                <features>
{ for $feature in doc('/db/XQTS/XQTSCatalog.xml')/*:test-suite/*:features/*:feature
							return
							<feature name="{$feature/@name}" supported="true"/>
						}</features>

                <context-properties>

                </context-properties>

        </implementation>

        <syntax>XQuery</syntax>

        <test-run dateRun="{fn:current-dateTime()}">
                <test-suite version="{$test-suite}"/>
                <transformation>

No unusual transformations.

                </transformation>
                <comparison>

No unusual comparisons

                </comparison>
                <otherComments>

The test run took n seconds.

                </otherComments>
        </test-run>

{
		(: for $case in fn:collection(  '/db/XQTS' )//*:test-case :)
    for $case in fn:collection(  '/db/XQTS' )//test-case
    return <test-case name="{$case/@name}" result="{$case/@result}" />
}
</test-suite-result>

declare option exist:serialize "method=xml indent=yes";
declare option exist:output-size-limit "-1";
declare namespace response="http://exist-db.org/xquery/response";

let $product-version := util:system-property("product-version")
let $product-build := util:system-property("product-build")
let $test-suite := doc('/db/XQTS/XQTSCatalog.xml')/*:test-suite/@version
let $dummy := response:set-header("Content-Disposition", concat(
	"attachment; filename="results_XQTS-" , $test-suite , "_eXist-" ,
	$product-version , '_' , $product-build , ".xml"" ) )

return
(: <test-suite-result xmlns="http://www.w3.org/2005/02/query-test-XQTSResult"
        xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"> :)
<test-suite-result>
        <implementation name="{$product-version}" version="{$product-build}" anonymous-result-column="false">

                <organization name="eXist Open Source native XML database"  website="http://www.exist-db.org" anonymous="false"/>

                <submittor name="eXist XQTS testsuite runner" email="me@not.com"/>

                <description>

eXist is an Open Source native XML database featuring efficient,
                        index-based XQuery processing, automatic indexing, extensions for full-text
                        search,  XUpdate  support and tight integration with existing XML development tools.

                </description>

                <implementation-defined-items>

                </implementation-defined-items>

                <features>
{ for $feature in doc('/db/XQTS/XQTSCatalog.xml')/*:test-suite/*:features/*:feature
							return
							<feature name="{$feature/@name}" supported="true"/>
						}</features>

                <context-properties>

                </context-properties>

        </implementation>

        <syntax>XQuery</syntax>

        <test-run dateRun="{fn:current-dateTime()}">
                <test-suite version="{$test-suite}"/>
                <transformation>

No unusual transformations.

                </transformation>
                <comparison>

No unusual comparisons

                </comparison>
                <otherComments>

The test run took n seconds.

                </otherComments>
        </test-run>

{
		(: for $case in fn:collection(  '/db/XQTS' )//*:test-case :)
    for $case in fn:collection(  '/db/XQTS' )//test-case
    return <test-case name="{$case/@name}" result="{$case/@result}" />
}
</test-suite-result>


Made all invoke and eval functions nondeterministic

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

(:~
 : Reflection Module for Zorba.
 :
 : @author Nicolae Brinza
 : @project reflection
 :
 :)

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

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

(:~
 : The invoke function allows to dynamically call a function given its QName
 : and parameters. It is possible to invoke a function who's name is not known
 : at compilation time -- it can be computed, passed through an external
 : variable, taken from a file, etc. The first parameter must always be a
 : QName identifying a known function. The rest of the parameters will be
 : passed to the function that is called.
 :
 : invoke comes in three flavours:
 : invoke-simple() - for the invocation of functions that are non-updating and
 :                   non-side effecting
 : invoke-updating() - for the invocation of updating functions
 : invoke-sequential() - for the invocation of sequential functions
 :
 :

 : Example usage :
 reflection:invoke-simple ( xs:QName("fn:max"),
 :                                                  (1,2,3) )

 :

 : Returns :
 3

 :
 : @param $name the QName of the function that is to be called.
 : @return the result that is returned by the invoked function.
 :)
declare %nondeterministic %ann:variadic function reflection:invoke-simple($name as xs:QName) as item()* external;

(:~
 : invoke-updating()
 :
 : @param $name the QName of the function that is to be called.
 : @return the result that is returned by the invoked function.
 :)
declare %nondeterministic %ann:variadic updating function reflection:invoke-updating($name as xs:QName) external;

(:~
 : invoke-sequential()
 :
 : @param $name the QName of the function that is to be called.
 : @return the result that is returned by the invoked function.
 :)
declare %nondeterministic %ann:variadic %sequential function reflection:invoke-sequential($name as xs:QName) as item()* external;

(:~
 : Eval
 :
 : @param $query the query string to be evaluated.
 : @return the result of evaluating the query (the result is not supposed to
 :         contain any PUL).
 :)
declare %nondeterministic function reflection:eval-simple(
    $query as xs:string
) as item()* external;

(:~
 : Eval
 :
 : @param $query the query string to be evaluated.
 : @return the PUL resulting from evaluating the query
 :)
declare %nondeterministic updating function reflection:eval-updating(
    $query as xs:string
) external;

(:~
 : Eval
 :
 : @param $query the query string to be evaluated.
 : @return the result of evaluating the query (the result is not supposed to
 :         contain any PUL).
 :)
declare %nondeterministic %sequential function reflection:eval-sequential(
    $query as xs:string
) as item()* external;

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

(:~
 : Reflection Module for Zorba.
 :
 : @author Nicolae Brinza
 : @project reflection
 :
 :)

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

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

(:~
 : The invoke function allows to dynamically call a function given its QName
 : and parameters. It is possible to invoke a function who's name is not known
 : at compilation time -- it can be computed, passed through an external
 : variable, taken from a file, etc. The first parameter must always be a
 : QName identifying a known function. The rest of the parameters will be
 : passed to the function that is called.
 :
 : invoke comes in three flavours:
 : invoke-simple() - for the invocation of functions that are non-updating and
 :                   non-side effecting
 : invoke-updating() - for the invocation of updating functions
 : invoke-sequential() - for the invocation of sequential functions
 :
 :

 : Example usage :
 reflection:invoke-simple ( xs:QName("fn:max"),
 :                                                  (1,2,3) )

 :

 : Returns :
 3

 :
 : @param $name the QName of the function that is to be called.
 : @return the result that is returned by the invoked function.
 :)
declare %non-deterministic %ann:variadic function reflection:invoke-simple($name as xs:QName) as item()* external;

(:~
 : invoke-updating()
 :
 : @param $name the QName of the function that is to be called.
 : @return the result that is returned by the invoked function.
 :)
declare %ann:variadic updating function reflection:invoke-updating($name as xs:QName) external;

(:~
 : invoke-sequential()
 :
 : @param $name the QName of the function that is to be called.
 : @return the result that is returned by the invoked function.
 :)
declare %ann:variadic %sequential function reflection:invoke-sequential($name as xs:QName) as item()* external;

(:~
 : Eval
 :
 : @param $query the query string to be evaluated.
 : @return the result of evaluating the query (the result is not supposed to
 :         contain any PUL).
 :)
declare function reflection:eval-simple(
    $query as xs:string
) as item()* external;

(:~
 : Eval
 :
 : @param $query the query string to be evaluated.
 : @return the PUL resulting from evaluating the query
 :)
declare updating function reflection:eval-updating(
    $query as xs:string
) external;

(:~
 : Eval
 :
 : @param $query the query string to be evaluated.
 : @return the result of evaluating the query (the result is not supposed to
 :         contain any PUL).
 :)
declare %sequential function reflection:eval-sequential(
    $query as xs:string
) as item()* external;


Fixed xmldiff module import

Fixed xmldiff module import

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

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

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

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

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

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

     Setup:

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

import module namespace util="http://exist-db.org/xquery/util";
import module namespace xdb="http://exist-db.org/xquery/xmldb";
import module namespace xdiff="http://exist-db.org/xquery/xmldiff";
import module namespace request="http://exist-db.org/xquery/request";

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

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

     Setup:

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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