fixed #140 - vet plugins not working correctly

(:
  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 flow = "http://marklogic.com/data-hub/flow-lib";

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

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

import module namespace functx = "http://www.functx.com"
  at "/MarkLogic/functx/functx-1.0-nodoc-2007-01.xqy";

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

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

declare option xdmp:mapping "false";

(: xml describing the default writer :)
declare variable $DEFAULT-WRITER :=
  element hub:writer {
    attribute type { "xquery" },
    attribute module { "/com.marklogic.hub/writers/default.xqy" }
  };

(: xml describing the default content plugin :)
declare variable $DEFAULT-CONTENT-PLUGIN :=
  element hub:plugin {
    attribute dest { "content" },
    attribute type { "xquery" },
    attribute module { "/com.marklogic.hub/plugins/raw.xqy" }
  };

(: xml describing a no-op plugin. used when no plugin is given :)
declare variable $NO-OP-PLUGIN :=
  element hub:plugin {
    attribute type { "null" }
  };

(: the directory where entities live :)
declare variable $ENTITIES-DIR := "/entities/";

declare variable $PLUGIN-NS := "http://marklogic.com/data-hub/plugins/";

declare variable $TYPE-XQUERY := "xquery";

declare variable $TYPE-JAVASCRIPT := "javascript";

declare variable $TYPE-XSLT := "xslt";

declare variable $TYPE-XML := "xml";

declare variable $TYPE-JSON := "json";

(:
 : Determines the type of flow given a filename
 :
 : @param $filename - name of the module plugin file
 : @return - a type (xquery, xml, sjs, ...)
 :)
declare %private function flow:get-type($filename) as xs:string?
{
  let $ext as xs:string := hul:get-file-extension($filename)
  return
    if ($ext = hul:get-xqy-extensions()) then
      $TYPE-XQUERY
    else if ($ext = hul:get-sjs-extensions()) then
      $TYPE-JAVASCRIPT
    else if ($ext = hul:get-xslt-extensions()) then
      $TYPE-XSLT
    else if ($ext = "xml") then
      $TYPE-XML
    else if ($ext = "json") then
      $TYPE-JSON
    else
      fn:error(xs:QName("INVALID_PLUGIN"), $filename)
};

(:~
 : Returns xml describing a collector
 :)
declare %private function flow:get-collector(
  $flow-name as xs:string,
  $uris as xs:string*) as element(hub:collector)
{
  let $uri := $uris[1]
  let $filename as xs:string := hul:get-file-from-uri($uri)
  let $type := flow:get-type($filename)
  return
    element hub:collector {
      attribute type { $type },
      attribute module { $uri }
    }
};

(:~
 : Returns xml describing a plugin
 :)
declare %private function flow:get-plugin(
  $flow-name as xs:string,
  $uris as xs:string*,
  $destination as xs:string) as element(hub:plugin)*
{
  for $uri in $uris
  let $filename as xs:string := hul:get-file-from-uri($uri)
  let $type := flow:get-type($filename)
  return
    element hub:plugin {
      attribute dest { $destination },
      attribute type { $type },
      attribute module { $uri }
    }
};

(:~
 : Returns xml describing a content plugin
 :)
declare %private function flow:get-content(
  $flow-name as xs:string,
  $uris as xs:string*)
{
  let $plugin := flow:get-plugin($flow-name, $uris, "content")
  return
    if ($plugin) then $plugin
    else
      $DEFAULT-CONTENT-PLUGIN
};

(:~
 : Returns xml describing a headers plugin
 :)
declare %private function flow:get-headers(
  $flow-name as xs:string,
  $uris as xs:string*)
{
  let $plugin := flow:get-plugin($flow-name, $uris, "headers")
  return
    if ($plugin) then $plugin
    else
      $NO-OP-PLUGIN
};

(:~
 : Returns xml describing a triples plugin
 :)
declare %private function flow:get-triples(
  $flow-name as xs:string,
  $uris as xs:string*)
{
  let $plugin := flow:get-plugin($flow-name, $uris, "triples")
  return
    if ($plugin) then $plugin
    else
      $NO-OP-PLUGIN
};

(:~
 : Returns xml describing a writer
 :)
declare %private function flow:get-writer(
  $flow-name as xs:string,
  $uris as xs:string*)
{
  if ($uris) then
    for $uri in $uris
    let $filename as xs:string := hul:get-file-from-uri($uri)
    let $type := flow:get-type($filename)
    let $_ :=
      if (debug:on()) then
        debug:log((
          "$flow-name: " || $flow-name,
          "$uri: " || $uri,
          "$filename: " || $filename,
          "$type: " || $type
        ))
      else ()
    return
      element hub:writer {
        attribute type { $type },
        attribute module { $uri }
      }
  else
    $DEFAULT-WRITER
};

(:~
 : Returns a flow by name. This xml is dynamically constructed
 : by looking in the modules database.
 :
 : @param $entity-name - name of the entity that owns the flow
 : @param $flow-name - name of the flow to retrieve
 : @return - xml describing the flow
 :)
declare function flow:get-flow(
  $entity-name as xs:string,
  $flow-name as xs:string,
  $flow-type as xs:string?) as element(hub:flow)
{
  let $uris :=
    hul:run-in-modules(function() {
      let $type :=
        if ($flow-type) then $flow-type
        else "*"
      return
        cts:uri-match($ENTITIES-DIR || $entity-name || "/" || $type || "/" || $flow-name || "/*")
    })
  return
    flow:get-flow($entity-name, $flow-name, $flow-type, $uris)
};

(:~
 : Returns a flow by name. This xml is dynamically constructed
 : by looking in the modules database.
 :
 : @param $entity-name - name of the entity that owns the flow
 : @param $flow-name - name of the flow to retrieve
 : @param $uris - uris used to build the entity xml
 : @return - xml describing the flow
 :)
declare %private function flow:get-flow(
  $entity-name as xs:string,
  $flow-name as xs:string,
  $flow-type as xs:string?,
  $uris as xs:string*) as element(hub:flow)
{
  let $_ := xdmp:log(("entity: " || $entity-name, "flow: " || $flow-name, "flow-type: " || $flow-type, "uris:", $uris))
  let $real-flow-type := fn:replace($uris[1], $ENTITIES-DIR || $entity-name || "/([^/]+)/" || $flow-name || ".*$", "$1")
  let $map := map:map()
  let $_ :=
    for $dir in $uris
    let $type :=
      if ($flow-type) then $flow-type
      else "[^/]+"
    let $dir-name := fn:replace($dir, $ENTITIES-DIR || $entity-name || "/" || $type || "/" || $flow-name || "/([^/]+)/$", "$1")
    let $child-uris := $uris[fn:matches(., $ENTITIES-DIR || $entity-name || "/" || $type || "/" || $flow-name || "/" || $dir-name || "/([^/]+)$")]
    return
      switch ($dir-name)
        case "collector" return
          map:put($map, "collector", flow:get-collector($flow-name, $child-uris))
        case "content" return
          map:put($map, "content", flow:get-content($flow-name, $child-uris))
        case "headers" return
          map:put($map, "headers", flow:get-headers($flow-name, $child-uris))
        case "triples" return
          map:put($map, "triples", flow:get-triples($flow-name, $child-uris))
        case "writer" return
          map:put($map, "writer", flow:get-writer($flow-name, $child-uris))
        default return
          ()
  let $flow := hul:run-in-modules(function() {
    let $uri := $ENTITIES-DIR || $entity-name || "/" || $real-flow-type || "/" || $flow-name || "/" || $flow-name || ".xml"
    return
      fn:doc($uri)/hub:flow
  })
  return
    <flow xmlns="http://marklogic.com/data-hub">
      <name>{$flow-name}</name>
      <entity>{$entity-name}</entity>
      <complexity>{ ($flow/hub:complexity/fn:data(), "simple")[1] }</complexity>
      <data-format>{ $flow/hub:data-format/fn:data() }</data-format>
      <type>{$real-flow-type}</type>
      {map:get($map, "collector")}
      <plugins>
      {
        if ($flow/hub:plugins/*) then
          $flow/hub:plugins/*
        else
        (
          (map:get($map, "content"), $DEFAULT-CONTENT-PLUGIN)[1],
          (map:get($map, "headers"), $NO-OP-PLUGIN)[1],
          (map:get($map, "triples"), $NO-OP-PLUGIN)[1]
        )
      }
      </plugins>
      {
        (map:get($map, "writer"), $DEFAULT-WRITER)[1]
      }
    </flow>
};

(:~
 : Returns the flows that belong to the given entity in the database
 :
 : @param $entity-name - the name of the entity containing the flows
 : @return - xml describing the flows
 :)
declare function flow:get-flows(
  $entity-name as xs:string) as element(hub:flows)
{
  let $uris := hul:run-in-modules(function() {
    cts:uri-match($ENTITIES-DIR || "*")
  })
  let $flows :=
    for $flow in $uris[fn:matches(., $ENTITIES-DIR || $entity-name || "/(input|conformance)/[^/]+/$")]
    let $name := fn:replace($flow, $ENTITIES-DIR || $entity-name || "/(input|conformance)/([^/]+)/$", "$2")
    return
      flow:get-flow($entity-name, $name, (), $uris[fn:matches(., $ENTITIES-DIR || $entity-name || "/(input|conformance)/" || $name || "/.+")])
  return
    <flows xmlns="http://marklogic.com/data-hub">
    {
      $flows
    }
    </flows>
};

(:~
 : Returns a entity by name. This xml is dynamically constructed
 : by looking in the modules database.
 :
 : @param $entity-name - name of the entity to retrieve
 : @return - xml describing the entity
 :)
declare function flow:get-entity(
  $entity-name as xs:string)
{
  let $uris :=
    hul:run-in-modules(function() {
      cts:uri-match($ENTITIES-DIR || $entity-name || "/*")
    })
  return
    flow:get-entity($entity-name, $uris)
};

(:~
 : Returns a entity by name. This xml is dynamically constructed
 : by looking in the modules database.
 :
 : @param $entity-name - name of the entity to retrieve
 : @param $uris - uris used to build the entity xml
 : @return - xml describing the entity
 :)
declare %private function flow:get-entity(
  $entity-name as xs:string,
  $uris as xs:string*)
  as element(hub:entity)
{
  <entity xmlns="http://marklogic.com/data-hub">
    <name>{$entity-name}</name>
    {
      flow:get-flows($entity-name)
    }
  </entity>
};

(:~
 : Returns the entities in the database
 :
 : @return - xml describing the entities
 :)
declare function flow:get-entities() as element(hub:entities)
{
  let $uris := hul:run-in-modules(function() {
    cts:uri-match($ENTITIES-DIR || "*")
  })
  let $entities :=
    for $flow in $uris[fn:matches(., $ENTITIES-DIR || "[^/]+/$")]
    let $name := fn:replace($flow, $ENTITIES-DIR || "([^/]+)/$", "$1")
    return
      flow:get-entity($name, $uris[fn:matches(., $ENTITIES-DIR || $name || "/.+")])
  return
    <entities xmlns="http://marklogic.com/data-hub">
    {
      $entities
    }
    </entities>
};

(:~
 : Runs a collector
 :
 : @param $module-uri - the uri of the collector module
 : @param $options - a map of options passed in by the client
 : @return - a sequence of strings
 :)
declare function flow:run-collector(
  $module-uri as xs:string,
  $options as map:map) as xs:string*
{
  let $module-name := hul:get-module-name($module-uri)
  let $filename as xs:string := hul:get-file-from-uri($module-uri)
  let $type := flow:get-type($filename)
  let $ns :=
    if ($type eq $TYPE-JAVASCRIPT) then ()
    else
      $PLUGIN-NS || fn:lower-case($module-name)
  let $func := xdmp:function(fn:QName($ns, "collect"), $module-uri)
  return
    $func($options)
};

(:~
 : Runs a given flow
 :
 : @param $flow - xml describing the flow
 : @param $idenifier - the identifier to send to the flow steps (URI in corb lingo)
 : @param $options - a map of options passed in by the client
 : @return - nothing
 :)
declare function flow:run-flow(
  $flow as element(hub:flow),
  $identifier as xs:string,
  $options as map:map) as empty-sequence()
{
  flow:run-flow($flow, $identifier, (), $options)
};

declare function flow:run-plugins(
  $flow as element(hub:flow),
  $identifier as xs:string,
  $content as item()?,
  $options as map:map
)
{
  let $content :=
    map:new((
      map:entry("identifier", $identifier),
      if ($content) then
        map:entry("content", $content)
      else ()
    ))
  let $data-format := $flow/hub:data-format
  let $_ :=
    for $plugin in $flow/hub:plugins/hub:plugin
    let $destination := $plugin/@dest
    let $resp :=
      flow:run-plugin(
        $plugin,
        $data-format,
        $identifier,
        map:get($content, "content"),
        map:get($content, "headers"),
        map:get($content, "triple"),
        $options)
    return
      if (fn:empty($destination))
      then ()
      else map:put($content, $destination, $resp)
  return
    flow:make-envelope($content, $data-format)
};

declare function flow:run-flow(
  $flow as element(hub:flow),
  $identifier as xs:string,
  $content as item()?,
  $options as map:map) as empty-sequence()
{
  let $envelope := flow:run-plugins($flow, $identifier, $content, $options)
  let $_ :=
    xdmp:invoke-function(function() {
      for $writer in $flow/hub:writer
      return
        flow:run-writer($writer, $identifier, $envelope, $options)
    },
    map:new((
      map:entry("isolation", "different-transaction"),
      map:entry("database", xdmp:database("data-hub-FINAL")),
      map:entry("transactionMode", "update-auto-commit")
    )))

  return
    ()
};

(:~
 : Construct an envelope
 :
 : @param $map - a map with all the stuff in it
 : @return - the newly constructed envelope
 :)
declare function flow:make-envelope($map as map:map, $data-format as xs:string)
{
  xdmp:log(("map:", $map)),
  if ($data-format eq "application/json") then
    xdmp:to-json($map)/node()
  else
    <envelope xmlns="http://marklogic.com/data-hub/envelope">
      <headers>{map:get($map, "headers")}</headers>
      <triples>{map:get($map, "triples")}</triples>
      <content>{map:get($map, "content")}</content>
    </envelope>
};

(:~
 : Run a given plugin
 :
 : @param $plugin - xml describing the plugin to run
 : @param $idenifier - the identifier to send to the flow steps (URI in corb lingo)
 : @param $content - the output of the content plugin
 : @param $headers - the output of the headers plugin
 : @param $triples - the output of the triples plugin
 : @param $options - a map of options passed in by the client
 : @return - the output of the plugin. It varies.
 :)
declare function flow:run-plugin(
  $plugin as element(hub:plugin),
  $data-format as xs:string,
  $identifier as xs:string,
  $content as item()?,
  $headers as item()*,
  $triples as sem:triple*,
  $options as map:map)
{
  let $module-uri := $plugin/@module
  return
    if (fn:empty($module-uri)) then ()
    else
      let $destination := $plugin/@dest
      let $module-name := hul:get-module-name($module-uri)
      let $filename as xs:string := hul:get-file-from-uri($module-uri)
      let $type := flow:get-type($filename)
      let $ns :=
        if ($type eq $TYPE-JAVASCRIPT) then ()
        else
          $PLUGIN-NS || fn:lower-case($module-name)
      let $func-name :=
        if ($type eq $TYPE-JAVASCRIPT) then
          "create" || functx:capitalize-first($destination)
        else
          "create-" || $destination
      let $func := xdmp:function(fn:QName($ns, $func-name), $module-uri)
      let $resp := $func($identifier, $content, $headers, $triples, $options)
      return
        typeswitch($resp)
          case document-node() return
            if (fn:count($resp/node()) > 1) then
              fn:error("Too Many Nodes!. Return just 1 node")
            else
              $resp/node()
          case json:array return
            if ($data-format = 'application/xml') then
              json:array-values($resp)
            else
              $resp
          default return
            $resp
};

(:~
 : Run a given writer
 :
 : @param $writer - xml describing the writer to run
 : @param $idenifier - the identifier to send to the flow steps (URI in corb lingo)
 : @param $envelope - the envelope
 : @param $options - a map of options passed in by the client
 : @return - the output of the writer. It varies.
 :)
declare function flow:run-writer(
  $writer as element(hub:writer),
  $identifier as xs:string,
  $envelope as item(),
  $options as map:map)
{
  let $module-uri as xs:string := $writer/@module
  let $module-name := hul:get-module-name($module-uri)
  let $ns := $PLUGIN-NS || fn:lower-case($module-name)
  let $func := xdmp:function(fn:QName($ns, "write"), $module-uri)
  return
    $func($identifier, $envelope, $options)
};

declare function flow:make-error-json($ex) {
  map:new((
    map:entry("msg", $ex/error:format-string/fn:data()),
    let $f := $ex/error:stack/error:frame[1]
    return
      (
        map:entry("uri", $f/error:uri/fn:data()),
        map:entry("line", $f/error:line/fn:data()),
        map:entry("column", $f/error:column/fn:data())
      )
  ))
};

declare function flow:validate-entities()
{
  let $errors := json:array()
  let $options := map:map()
  let $_ :=
    for $entity in flow:get-entities()/hub:entity
    for $flow in $entity/hub:flows/hub:flow
    let $data-format := $flow/hub:data-format
    (: validate collector :)
    let $_ :=
      let $collector := $flow/hub:collector
      return
        if ($collector) then
          try {
            flow:run-collector($collector/@module, $options)
          }
          catch($ex) {
            json:array-push($errors, flow:make-error-json($ex))
          }
        else ()
    (: validate plugins :)
    let $_ :=
      for $plugin in $flow/hub:plugins/hub:plugin
      let $destination := $plugin/@dest
      let $module-uri := $plugin/@module
      let $module-name := hul:get-module-name($module-uri)
      let $filename as xs:string := hul:get-file-from-uri($module-uri)
      let $type := flow:get-type($filename)
      let $ns :=
        if ($type eq $flow:TYPE-JAVASCRIPT) then ()
        else
          $flow:PLUGIN-NS || fn:lower-case($module-name)
      let $func-name :=
        if ($type eq $flow:TYPE-JAVASCRIPT) then
          "create" || functx:capitalize-first($destination)
        else
          "create-" || $destination
      return
        try {
          if ($type eq $flow:TYPE-XQUERY) then
            xdmp:eval(
              'import module namespace x = "' || $ns || '" at "' || $module-uri || '"; ' ||
              '()',
              map:new(map:entry("staticCheck", fn:true()))
            )
          else
            xdmp:javascript-eval(
              'var x = require("' || $module-uri || '");',
              map:new(map:entry("staticCheck", fn:true()))
            )
        }
        catch($ex) {
          json:array-push($errors, flow:make-error-json($ex))
        }
    return
      ()
  return
    map:new(
      map:entry("errors", $errors)
    )
};

(:
  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 flow = "http://marklogic.com/data-hub/flow-lib";

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

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

import module namespace functx = "http://www.functx.com"
  at "/MarkLogic/functx/functx-1.0-nodoc-2007-01.xqy";

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

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

declare option xdmp:mapping "false";

(: xml describing the default writer :)
declare variable $DEFAULT-WRITER :=
  element hub:writer {
    attribute type { "xquery" },
    attribute module { "/com.marklogic.hub/writers/default.xqy" }
  };

(: xml describing the default content plugin :)
declare variable $DEFAULT-CONTENT-PLUGIN :=
  element hub:plugin {
    attribute dest { "content" },
    attribute type { "xquery" },
    attribute module { "/com.marklogic.hub/plugins/raw.xqy" }
  };

(: xml describing a no-op plugin. used when no plugin is given :)
declare variable $NO-OP-PLUGIN :=
  element hub:plugin {
    attribute type { "null" }
  };

(: the directory where entities live :)
declare variable $ENTITIES-DIR := "/entities/";

declare variable $PLUGIN-NS := "http://marklogic.com/data-hub/plugins/";

declare variable $TYPE-XQUERY := "xquery";

declare variable $TYPE-JAVASCRIPT := "javascript";

declare variable $TYPE-XSLT := "xslt";

declare variable $TYPE-XML := "xml";

declare variable $TYPE-JSON := "json";

(:
 : Determines the type of flow given a filename
 :
 : @param $filename - name of the module plugin file
 : @return - a type (xquery, xml, sjs, ...)
 :)
declare %private function flow:get-type($filename) as xs:string?
{
  let $ext as xs:string := hul:get-file-extension($filename)
  return
    if ($ext = hul:get-xqy-extensions()) then
      $TYPE-XQUERY
    else if ($ext = hul:get-sjs-extensions()) then
      $TYPE-JAVASCRIPT
    else if ($ext = hul:get-xslt-extensions()) then
      $TYPE-XSLT
    else if ($ext = "xml") then
      $TYPE-XML
    else if ($ext = "json") then
      $TYPE-JSON
    else
      fn:error(xs:QName("INVALID_PLUGIN"), $filename)
};

(:~
 : Returns xml describing a collector
 :)
declare %private function flow:get-collector(
  $flow-name as xs:string,
  $uris as xs:string*) as element(hub:collector)
{
  let $uri := $uris[1]
  let $filename as xs:string := hul:get-file-from-uri($uri)
  let $type := flow:get-type($filename)
  return
    element hub:collector {
      attribute type { $type },
      attribute module { $uri }
    }
};

(:~
 : Returns xml describing a plugin
 :)
declare %private function flow:get-plugin(
  $flow-name as xs:string,
  $uris as xs:string*,
  $destination as xs:string) as element(hub:plugin)*
{
  for $uri in $uris
  let $filename as xs:string := hul:get-file-from-uri($uri)
  let $type := flow:get-type($filename)
  return
    element hub:plugin {
      attribute dest { $destination },
      attribute type { $type },
      attribute module { $uri }
    }
};

(:~
 : Returns xml describing a content plugin
 :)
declare %private function flow:get-content(
  $flow-name as xs:string,
  $uris as xs:string*)
{
  let $plugin := flow:get-plugin($flow-name, $uris, "content")
  return
    if ($plugin) then $plugin
    else
      $DEFAULT-CONTENT-PLUGIN
};

(:~
 : Returns xml describing a headers plugin
 :)
declare %private function flow:get-headers(
  $flow-name as xs:string,
  $uris as xs:string*)
{
  let $plugin := flow:get-plugin($flow-name, $uris, "headers")
  return
    if ($plugin) then $plugin
    else
      $NO-OP-PLUGIN
};

(:~
 : Returns xml describing a triples plugin
 :)
declare %private function flow:get-triples(
  $flow-name as xs:string,
  $uris as xs:string*)
{
  let $plugin := flow:get-plugin($flow-name, $uris, "triples")
  return
    if ($plugin) then $plugin
    else
      $NO-OP-PLUGIN
};

(:~
 : Returns xml describing a writer
 :)
declare %private function flow:get-writer(
  $flow-name as xs:string,
  $uris as xs:string*)
{
  if ($uris) then
    for $uri in $uris
    let $filename as xs:string := hul:get-file-from-uri($uri)
    let $type := flow:get-type($filename)
    let $_ :=
      if (debug:on()) then
        debug:log((
          "$flow-name: " || $flow-name,
          "$uri: " || $uri,
          "$filename: " || $filename,
          "$type: " || $type
        ))
      else ()
    return
      element hub:writer {
        attribute type { $type },
        attribute module { $uri }
      }
  else
    $DEFAULT-WRITER
};

(:~
 : Returns a flow by name. This xml is dynamically constructed
 : by looking in the modules database.
 :
 : @param $entity-name - name of the entity that owns the flow
 : @param $flow-name - name of the flow to retrieve
 : @return - xml describing the flow
 :)
declare function flow:get-flow(
  $entity-name as xs:string,
  $flow-name as xs:string,
  $flow-type as xs:string?) as element(hub:flow)
{
  let $uris :=
    hul:run-in-modules(function() {
      let $type :=
        if ($flow-type) then $flow-type
        else "*"
      return
        cts:uri-match($ENTITIES-DIR || $entity-name || "/" || $type || "/" || $flow-name || "/*")
    })
  return
    flow:get-flow($entity-name, $flow-name, $flow-type, $uris)
};

(:~
 : Returns a flow by name. This xml is dynamically constructed
 : by looking in the modules database.
 :
 : @param $entity-name - name of the entity that owns the flow
 : @param $flow-name - name of the flow to retrieve
 : @param $uris - uris used to build the entity xml
 : @return - xml describing the flow
 :)
declare %private function flow:get-flow(
  $entity-name as xs:string,
  $flow-name as xs:string,
  $flow-type as xs:string?,
  $uris as xs:string*) as element(hub:flow)
{
  let $_ := xdmp:log(("entity: " || $entity-name, "flow: " || $flow-name, "flow-type: " || $flow-type, "uris:", $uris))
  let $real-flow-type := fn:replace($uris[1], $ENTITIES-DIR || $entity-name || "/([^/]+)/" || $flow-name || ".*$", "$1")
  let $map := map:map()
  let $_ :=
    for $dir in $uris
    let $type :=
      if ($flow-type) then $flow-type
      else "[^/]+"
    let $dir-name := fn:replace($dir, $ENTITIES-DIR || $entity-name || "/" || $type || "/" || $flow-name || "/([^/]+)/$", "$1")
    let $child-uris := $uris[fn:matches(., $ENTITIES-DIR || $entity-name || "/" || $type || "/" || $flow-name || "/" || $dir-name || "/([^/]+)$")]
    return
      switch ($dir-name)
        case "collector" return
          map:put($map, "collector", flow:get-collector($flow-name, $child-uris))
        case "content" return
          map:put($map, "content", flow:get-content($flow-name, $child-uris))
        case "headers" return
          map:put($map, "headers", flow:get-headers($flow-name, $child-uris))
        case "triples" return
          map:put($map, "triples", flow:get-triples($flow-name, $child-uris))
        case "writer" return
          map:put($map, "writer", flow:get-writer($flow-name, $child-uris))
        default return
          ()
  let $flow := hul:run-in-modules(function() {
    let $uri := $ENTITIES-DIR || $entity-name || "/" || $real-flow-type || "/" || $flow-name || "/" || $flow-name || ".xml"
    return
      fn:doc($uri)/hub:flow
  })
  return
    <flow xmlns="http://marklogic.com/data-hub">
      <name>{$flow-name}</name>
      <entity>{$entity-name}</entity>
      <complexity>{ ($flow/hub:complexity/fn:data(), "simple")[1] }</complexity>
      <data-format>{ $flow/hub:data-format/fn:data() }</data-format>
      <type>{$real-flow-type}</type>
      {map:get($map, "collector")}
      <plugins>
      {
        if ($flow/hub:plugins/*) then
          $flow/hub:plugins/*
        else
        (
          (map:get($map, "content"), $DEFAULT-CONTENT-PLUGIN)[1],
          (map:get($map, "headers"), $NO-OP-PLUGIN)[1],
          (map:get($map, "triples"), $NO-OP-PLUGIN)[1]
        )
      }
      </plugins>
      {
        (map:get($map, "writer"), $DEFAULT-WRITER)[1]
      }
    </flow>
};

(:~
 : Returns the flows that belong to the given entity in the database
 :
 : @param $entity-name - the name of the entity containing the flows
 : @return - xml describing the flows
 :)
declare function flow:get-flows(
  $entity-name as xs:string) as element(hub:flows)
{
  let $uris := hul:run-in-modules(function() {
    cts:uri-match($ENTITIES-DIR || "*")
  })
  let $flows :=
    for $flow in $uris[fn:matches(., $ENTITIES-DIR || $entity-name || "/(input|conformance)/[^/]+/$")]
    let $name := fn:replace($flow, $ENTITIES-DIR || $entity-name || "/(input|conformance)/([^/]+)/$", "$2")
    return
      flow:get-flow($entity-name, $name, (), $uris[fn:matches(., $ENTITIES-DIR || $entity-name || "/(input|conformance)/" || $name || "/.+")])
  return
    <flows xmlns="http://marklogic.com/data-hub">
    {
      $flows
    }
    </flows>
};

(:~
 : Returns a entity by name. This xml is dynamically constructed
 : by looking in the modules database.
 :
 : @param $entity-name - name of the entity to retrieve
 : @return - xml describing the entity
 :)
declare function flow:get-entity(
  $entity-name as xs:string)
{
  let $uris :=
    hul:run-in-modules(function() {
      cts:uri-match($ENTITIES-DIR || $entity-name || "/*")
    })
  return
    flow:get-entity($entity-name, $uris)
};

(:~
 : Returns a entity by name. This xml is dynamically constructed
 : by looking in the modules database.
 :
 : @param $entity-name - name of the entity to retrieve
 : @param $uris - uris used to build the entity xml
 : @return - xml describing the entity
 :)
declare %private function flow:get-entity(
  $entity-name as xs:string,
  $uris as xs:string*)
  as element(hub:entity)
{
  <entity xmlns="http://marklogic.com/data-hub">
    <name>{$entity-name}</name>
    {
      flow:get-flows($entity-name)
    }
  </entity>
};

(:~
 : Returns the entities in the database
 :
 : @return - xml describing the entities
 :)
declare function flow:get-entities() as element(hub:entities)
{
  let $uris := hul:run-in-modules(function() {
    cts:uri-match($ENTITIES-DIR || "*")
  })
  let $entities :=
    for $flow in $uris[fn:matches(., $ENTITIES-DIR || "[^/]+/$")]
    let $name := fn:replace($flow, $ENTITIES-DIR || "([^/]+)/$", "$1")
    return
      flow:get-entity($name, $uris[fn:matches(., $ENTITIES-DIR || $name || "/.+")])
  return
    <entities xmlns="http://marklogic.com/data-hub">
    {
      $entities
    }
    </entities>
};

(:~
 : Runs a collector
 :
 : @param $module-uri - the uri of the collector module
 : @param $options - a map of options passed in by the client
 : @return - a sequence of strings
 :)
declare function flow:run-collector(
  $module-uri as xs:string,
  $options as map:map) as xs:string*
{
  let $module-name := hul:get-module-name($module-uri)
  let $filename as xs:string := hul:get-file-from-uri($module-uri)
  let $type := flow:get-type($filename)
  let $ns :=
    if ($type eq $TYPE-JAVASCRIPT) then ()
    else
      $PLUGIN-NS || fn:lower-case($module-name)
  let $func := xdmp:function(fn:QName($ns, "collect"), $module-uri)
  return
    $func($options)
};

(:~
 : Runs a given flow
 :
 : @param $flow - xml describing the flow
 : @param $idenifier - the identifier to send to the flow steps (URI in corb lingo)
 : @param $options - a map of options passed in by the client
 : @return - nothing
 :)
declare function flow:run-flow(
  $flow as element(hub:flow),
  $identifier as xs:string,
  $options as map:map) as empty-sequence()
{
  flow:run-flow($flow, $identifier, (), $options)
};

declare function flow:run-plugins(
  $flow as element(hub:flow),
  $identifier as xs:string,
  $content as item()?,
  $options as map:map
)
{
  let $content :=
    map:new((
      map:entry("identifier", $identifier),
      if ($content) then
        map:entry("content", $content)
      else ()
    ))
  let $data-format := $flow/hub:data-format
  let $_ :=
    for $plugin in $flow/hub:plugins/hub:plugin
    let $destination := $plugin/@dest
    let $resp :=
      flow:run-plugin(
        $plugin,
        $data-format,
        $identifier,
        map:get($content, "content"),
        map:get($content, "headers"),
        map:get($content, "triple"),
        $options)
    return
      if (fn:empty($destination))
      then ()
      else map:put($content, $destination, $resp)
  return
    flow:make-envelope($content, $data-format)
};

declare function flow:run-flow(
  $flow as element(hub:flow),
  $identifier as xs:string,
  $content as item()?,
  $options as map:map) as empty-sequence()
{
  let $envelope := flow:run-plugins($flow, $identifier, $content, $options)
  let $_ :=
    xdmp:invoke-function(function() {
      for $writer in $flow/hub:writer
      return
        flow:run-writer($writer, $identifier, $envelope, $options)
    },
    map:new((
      map:entry("isolation", "different-transaction"),
      map:entry("database", xdmp:database("data-hub-FINAL")),
      map:entry("transactionMode", "update-auto-commit")
    )))

  return
    ()
};

(:~
 : Construct an envelope
 :
 : @param $map - a map with all the stuff in it
 : @return - the newly constructed envelope
 :)
declare function flow:make-envelope($map as map:map, $data-format as xs:string)
{
  xdmp:log(("map:", $map)),
  if ($data-format eq "application/json") then
    xdmp:to-json($map)/node()
  else
    <envelope xmlns="http://marklogic.com/data-hub/envelope">
      <headers>{map:get($map, "headers")}</headers>
      <triples>{map:get($map, "triples")}</triples>
      <content>{map:get($map, "content")}</content>
    </envelope>
};

(:~
 : Run a given plugin
 :
 : @param $plugin - xml describing the plugin to run
 : @param $idenifier - the identifier to send to the flow steps (URI in corb lingo)
 : @param $content - the output of the content plugin
 : @param $headers - the output of the headers plugin
 : @param $triples - the output of the triples plugin
 : @param $options - a map of options passed in by the client
 : @return - the output of the plugin. It varies.
 :)
declare function flow:run-plugin(
  $plugin as element(hub:plugin),
  $data-format as xs:string,
  $identifier as xs:string,
  $content as item()?,
  $headers as item()*,
  $triples as sem:triple*,
  $options as map:map)
{
  let $module-uri := $plugin/@module
  return
    if (fn:empty($module-uri)) then ()
    else
      let $destination := $plugin/@dest
      let $module-name := hul:get-module-name($module-uri)
      let $filename as xs:string := hul:get-file-from-uri($module-uri)
      let $type := flow:get-type($filename)
      let $ns :=
        if ($type eq $TYPE-JAVASCRIPT) then ()
        else
          $PLUGIN-NS || fn:lower-case($module-name)
      let $func-name :=
        if ($type eq $TYPE-JAVASCRIPT) then
          "create" || functx:capitalize-first($destination)
        else
          "create-" || $destination
      let $func := xdmp:function(fn:QName($ns, $func-name), $module-uri)
      let $resp := $func($identifier, $content, $headers, $triples, $options)
      return
        typeswitch($resp)
          case document-node() return
            if (fn:count($resp/node()) > 1) then
              fn:error("Too Many Nodes!. Return just 1 node")
            else
              $resp/node()
          case json:array return
            if ($data-format = 'application/xml') then
              json:array-values($resp)
            else
              $resp
          default return
            $resp
};

(:~
 : Run a given writer
 :
 : @param $writer - xml describing the writer to run
 : @param $idenifier - the identifier to send to the flow steps (URI in corb lingo)
 : @param $envelope - the envelope
 : @param $options - a map of options passed in by the client
 : @return - the output of the writer. It varies.
 :)
declare function flow:run-writer(
  $writer as element(hub:writer),
  $identifier as xs:string,
  $envelope as item(),
  $options as map:map)
{
  let $module-uri as xs:string := $writer/@module
  let $module-name := hul:get-module-name($module-uri)
  let $ns := $PLUGIN-NS || fn:lower-case($module-name)
  let $func := xdmp:function(fn:QName($ns, "write"), $module-uri)
  return
    $func($identifier, $envelope, $options)
};

declare function flow:make-error-json($ex) {
  map:new((
    map:entry("msg", $ex/error:format-string/fn:data()),
    let $f := $ex/error:stack/error:frame[1]
    return
      (
        map:entry("uri", $f/error:uri/fn:data()),
        map:entry("line", $f/error:line/fn:data()),
        map:entry("column", $f/error:column/fn:data())
      )
  ))
};

declare function flow:validate-entities()
{
  let $errors := json:array()
  let $options := map:map()
  let $_ :=
    for $entity in flow:get-entities()/hub:entity
    for $flow in $entity/hub:flows/hub:flow
    let $data-format := $flow/hub:data-format
    (: validate collector :)
    let $_ :=
      let $collector := $flow/hub:collector
      return
        if ($collector) then
          try {
            flow:run-collector($collector/@module, $options)
          }
          catch($ex) {
            json:array-push($errors, flow:make-error-json($ex))
          }
        else ()
    (: validate plugins :)
    let $_ :=
      for $plugin in $flow/hub:plugins/hub:plugin
      let $destination := $plugin/@dest
      return
        try {
          flow:run-plugin(
            $plugin,
            $data-format,
            "123",
            (),
            (),
            (),
            $options)
        }
        catch($ex) {
          json:array-push($errors, flow:make-error-json($ex))
        }
    return
      ()
  return
    map:new(
      map:entry("errors", $errors)
    )
};


[bugfix] Fix a bug in XQSuite when the 'expected' element contains CData section

xquery version "3.1";

module namespace t = "http://exist-db.org/xquery/testing";

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

declare namespace err = "http://www.w3.org/2005/xqt-errors";
declare namespace exerr = "http://www.exist-db.org/xqt-errors/";

declare function t:setup-action($action) {
    typeswitch ($action)
        case element(create-collection) return
            xmldb:create-collection($action/@parent, $action/@name)
        case element(store) return
			t:store($action)
		case element(store-files) return
            t:store-files($action)
        case element(remove-collection) return
            xmldb:remove($action/@collection)
        case element(remove-document) return
            xmldb:remove($action/@collection, $action/@name)
        default return
            ()
};

declare function t:store($action as element(store)) {
    let $type := if ($action/@type) then $action/@type/string() else "application/xml"
    let $data :=
		if ($action/*) then
			$action/*[1]
		else
			$action/string()
	return
        xmldb:store($action/@collection, $action/@name, $data, $type)
};

declare function t:store-files($action as element(store-files)) {
    let $type := if ($action/@type) then $action/@type/string() else "application/xml"
    return
        xmldb:store-files-from-pattern($action/@collection, $action/@dir, $action/@pattern, $type)
};

declare function t:setup($setup as element(setup)?) {
    for $action in $setup/*
    return
        t:setup-action($action)
};

declare function t:tearDown($tearDown as element(tearDown)?) {
    for $action in $tearDown/*
    return
        t:setup-action($action)
};

declare function t:declare-variable($var as element(variable)) as item()? {
    let $children := $var/*
    return
        if (empty($children)) then
            string-join($var/node(), '')
        else
            util:serialize($children, ())
};

declare function t:init-prolog($test as element(test)) {
	let $imports := $test/../imports
	let $vars :=
	    string-join(
        	for $var in $test/../variable
        	return
        	    concat("declare variable $", $var/@name, " := ", t:declare-variable($var), ";"),
            ""
        )
	return
		string-join(($imports, $vars, $test/../functions), '')
};

declare function t:test($result as item()*) {
    if ($result instance of xs:boolean) then
        $result
    else
        exists($result)
};

declare function t:run-test($test as element(test), $count as xs:integer) {
    t:run-test($test, $count, (), (), (), (), (), ())
};

declare function t:run-test($test as element(test), $count as xs:integer,
        $test-ignored-function as (function(xs:string) as empty-sequence())?,
        $test-started-function as (function(xs:string) as empty-sequence())?,
        $test-failure-function as (function(xs:string, map(xs:string, item()?), map(xs:string, item()?)) as empty-sequence())?,
        $test-assumption-failed-function as (function(xs:string, map(xs:string, item()?)?) as empty-sequence())?,
        $test-error-function as (function(xs:string, map(xs:string, item()?)?) as empty-sequence())?,
        $test-finished-function as (function(xs:string) as empty-sequence())?) {
	let $context := t:init-prolog($test)
	let $null :=
	   if ($test/@trace eq 'yes') then
	       (system:clear-trace(), system:enable-tracing(true(), false()))
       else ()
    let $highlight-option := concat("highlight-matches=",
          if ($test/expected//@*[matches(., '^(\|{3}).*\1$')] and $test/expected//exist:match) then "both"
          else if ($test/expected//@*[matches(., '^(\|{3}).*\1$')]) then "attributes"
          else if ($test/expected//exist:match) then "elements"
          else "none"
          )
    let $serialize-options :=
      let $decls := ($test/../*[name() ne 'test']|$test/code)[matches(., 'declare[\- ]option(\(("|')|\s+)exist:serialize(\2,)?\s+("|').*?\4[;)]')]
      let $ops1 := $decls/replace(., "declare[\- ]option(\(("|')|\s+)exist:serialize(\2,)?\s+("|')(.*?)\4[;)]", "_|$5_")
      let $ops2 :=
        for $a in $ops1
        for $b in tokenize($a, '_')[starts-with(., '|')]
        return tokenize(substring-after($b, '|'), '\s+')
      return if (count($ops2[matches(., 'highlight-matches')]))
        then string-join($ops2, ' ')
        else string-join(($ops2, $highlight-option), ' ')
    let $_notify-start := if(not(empty($test-started-function))) then $test-started-function($test/task) else ()
    let $queryOutput :=
        try {
            map {
                "result": util:eval(concat($context, $test/code/string()), false())
            }
        } catch * {
            map {
                "error": map {
                    "code": $err:code,
                    "description": $err:description,
                    "value": $err:value,
                    "module": $err:module,
                    "line-number": $err:line-number,
                    "column-number": $err:column-number,
                    "additional": $err:additional,
                    "xquery-stack-trace": $exerr:xquery-stack-trace,
                    "java-stack-trace": $exerr:java-stack-trace
                }
            }
        }
	let $output := if ($test/@trace eq 'yes') then map { "result": system:trace() } else $queryOutput
    let $expanded :=
        if (not(empty($output("error")))) then
            $output
        else if ($test/@serialize) then
            try {
                let $options := $test/@serialize/string()
                return
                    map {
                        "result": normalize-space(string-join($output("result") ! util:serialize(., $options)))
                    }
            } catch * {
                map {
                    "error": map {
                        "code": $err:code,
                        "description": $err:description,
                        "value": $err:value,
                        "module": $err:module,
                        "line-number": $err:line-number,
                        "column-number": $err:column-number,
                        "additional": $err:additional,
                        "xquery-stack-trace": $exerr:xquery-stack-trace,
                        "java-stack-trace": $exerr:java-stack-trace
                    }
                }
            }

		else if ($output("result") instance of node()) then
        	map {
        	    "result": util:expand($output("result"), $serialize-options)
        	}
		else
			$output
    let $expected :=
        if ($test/@output eq 'text') then
            data($test/expected)
        else $test/expected/node()
    let $OK :=
        if ($test/error) then
            not(empty($expanded("error"))) and (contains($expanded("error")("description"), $test/error) or local-name-from-QName($expanded("error")("code")) eq string($test/error))
        else if ($test/xpath) then
            t:test(t:xpath($output("result"), $test/xpath))
        else if ($test/@output eq 'text') then
            let $asString :=
                if ($test/@serialize) then
                    $expanded("result")
                else
                    normalize-space(string-join(for $x in $output("result") return string($x),' '))
            return
                $asString eq normalize-space($expected)
        else
            let $xn := t:normalize($expanded("result"))
            let $en := t:normalize($expected)
            return
        	   deep-equal($xn, $en)
    return
        (
            <test n="{$count}" pass="{$OK}">
            { $test/@id }
            {
                if (not($OK)) then
                    let $_notify :=
                        if(not(empty($expanded("error")))) then
                            if(not(empty($test-error-function))) then $test-error-function($test/task, $expanded("error")) else ()
                        else
                            if(not(empty($test-failure-function))) then $test-failure-function($test/task, map { "value": $test/expected/node(), "xpath": $test/xpath/node(), "error": $test/error/node() }, $expanded) else ()
                    return
                        ($test/task, $test/expected, $test/xpath, <result>{$expanded("result"), if(not(empty($expanded("error")))) then $expanded("error")("description") else ()}</result>)
                else
                    ()
            }
            </test>
            ,
            let $_notify-finished := if(not(empty($test-finished-function))) then $test-finished-function($test/task) else ()
            return ()
        )
};

declare function t:normalize($nodes as node()*) {
	for $node in $nodes return t:normalize-node($node)
};

declare function t:normalize-node($node as node()) {
	typeswitch ($node)
		case element() return
			element { node-name($node) } {
				$node/@*, for $child in $node/node() return t:normalize-node($child)
			}
		case text() return
			let $norm := normalize-space($node)
			return
				if (string-length($norm) eq 0) then () else $node
		default return
			$node
};

declare function t:xpath($output as item()*, $xpath as element()) {
    for $prefix in in-scope-prefixes($xpath)
    let $nsuri := namespace-uri-for-prefix($prefix, $xpath)
    return
        if ($prefix != 'xml') then
            util:declare-namespace($prefix, $nsuri)
        else (),
    let $expr := $xpath/string()
    return
        if (matches($expr, "^\s*/")) then
            util:eval(concat("$output", $expr))
        else
            util:eval($expr)
};

declare function t:run-testSet($set as element(TestSet), $id as xs:string?) {
    t:run-testSet($set, $id, (), (), (), (), (), ())
};

declare function t:run-testSet($set as element(TestSet), $id as xs:string?,
        $test-ignored-function as (function(xs:string) as empty-sequence())?,
        $test-started-function as (function(xs:string) as empty-sequence())?,
        $test-failure-function as (function(xs:string, map(xs:string, item()?), map(xs:string, item()?)) as empty-sequence())?,
        $test-assumption-failed-function as (function(xs:string, map(xs:string, item()?)?) as empty-sequence())?,
        $test-error-function as (function(xs:string, map(xs:string, item()?)?) as empty-sequence())?,
        $test-finished-function as (function(xs:string) as empty-sequence())?) {
    let $copy := util:expand($set)
    let $null := t:setup($copy/setup)
    let $tests :=
        if ($id) then
            $copy/test[@id = $id]
        else
            for $test in $copy/test
            return
                if($test[empty(@ignore) or @ignore = "no"])then
                    $test
                else
                    let $_notify-ignored := if(not(empty($test-ignored-function))) then $test-ignored-function($test/task) else ()
                    return ()
    let $result := util:expand(
           <TestSet>
           {$copy/testName}
           {$copy/description}
           {
               for $test at $p in $tests
               return
                   t:run-test($test, $p,
                        $test-ignored-function, $test-started-function, $test-failure-function,
                        $test-assumption-failed-function, $test-error-function, $test-finished-function)
           }
           </TestSet>
        )
    let $null := t:tearDown($copy/tearDown)
    return $result
};

declare function t:format-testResult($result) {
    let $formatted :=

{$result/testName}

{$result/description/p}

          {for $test in $result//test
           return

                    {$test/@n/.}
                    {$test/@pass/.}

          }

     return
        $formatted
};

xquery version "3.1";

module namespace t = "http://exist-db.org/xquery/testing";

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

declare namespace err = "http://www.w3.org/2005/xqt-errors";
declare namespace exerr = "http://www.exist-db.org/xqt-errors/";

declare function t:setup-action($action) {
    typeswitch ($action)
        case element(create-collection) return
            xmldb:create-collection($action/@parent, $action/@name)
        case element(store) return
			t:store($action)
		case element(store-files) return
            t:store-files($action)
        case element(remove-collection) return
            xmldb:remove($action/@collection)
        case element(remove-document) return
            xmldb:remove($action/@collection, $action/@name)
        default return
            ()
};

declare function t:store($action as element(store)) {
    let $type := if ($action/@type) then $action/@type/string() else "application/xml"
    let $data :=
		if ($action/*) then
			$action/*[1]
		else
			$action/string()
	return
        xmldb:store($action/@collection, $action/@name, $data, $type)
};

declare function t:store-files($action as element(store-files)) {
    let $type := if ($action/@type) then $action/@type/string() else "application/xml"
    return
        xmldb:store-files-from-pattern($action/@collection, $action/@dir, $action/@pattern, $type)
};

declare function t:setup($setup as element(setup)?) {
    for $action in $setup/*
    return
        t:setup-action($action)
};

declare function t:tearDown($tearDown as element(tearDown)?) {
    for $action in $tearDown/*
    return
        t:setup-action($action)
};

declare function t:declare-variable($var as element(variable)) as item()? {
    let $children := $var/*
    return
        if (empty($children)) then
            string-join($var/node(), '')
        else
            util:serialize($children, ())
};

declare function t:init-prolog($test as element(test)) {
	let $imports := $test/../imports
	let $vars :=
	    string-join(
        	for $var in $test/../variable
        	return
        	    concat("declare variable $", $var/@name, " := ", t:declare-variable($var), ";"),
            ""
        )
	return
		string-join(($imports, $vars, $test/../functions), '')
};

declare function t:test($result as item()*) {
    if ($result instance of xs:boolean) then
        $result
    else
        exists($result)
};

declare function t:run-test($test as element(test), $count as xs:integer) {
    t:run-test($test, $count, (), (), (), (), (), ())
};

declare function t:run-test($test as element(test), $count as xs:integer,
        $test-ignored-function as (function(xs:string) as empty-sequence())?,
        $test-started-function as (function(xs:string) as empty-sequence())?,
        $test-failure-function as (function(xs:string, map(xs:string, item()?), map(xs:string, item()?)) as empty-sequence())?,
        $test-assumption-failed-function as (function(xs:string, map(xs:string, item()?)?) as empty-sequence())?,
        $test-error-function as (function(xs:string, map(xs:string, item()?)?) as empty-sequence())?,
        $test-finished-function as (function(xs:string) as empty-sequence())?) {
	let $context := t:init-prolog($test)
	let $null :=
	   if ($test/@trace eq 'yes') then
	       (system:clear-trace(), system:enable-tracing(true(), false()))
       else ()
    let $highlight-option := concat("highlight-matches=",
          if ($test/expected//@*[matches(., '^(\|{3}).*\1$')] and $test/expected//exist:match) then "both"
          else if ($test/expected//@*[matches(., '^(\|{3}).*\1$')]) then "attributes"
          else if ($test/expected//exist:match) then "elements"
          else "none"
          )
    let $serialize-options :=
      let $decls := ($test/../*[name() ne 'test']|$test/code)[matches(., 'declare[\- ]option(\(("|')|\s+)exist:serialize(\2,)?\s+("|').*?\4[;)]')]
      let $ops1 := $decls/replace(., "declare[\- ]option(\(("|')|\s+)exist:serialize(\2,)?\s+("|')(.*?)\4[;)]", "_|$5_")
      let $ops2 :=
        for $a in $ops1
        for $b in tokenize($a, '_')[starts-with(., '|')]
        return tokenize(substring-after($b, '|'), '\s+')
      return if (count($ops2[matches(., 'highlight-matches')]))
        then string-join($ops2, ' ')
        else string-join(($ops2, $highlight-option), ' ')
    let $_notify-start := if(not(empty($test-started-function))) then $test-started-function($test/task) else ()
    let $queryOutput :=
        try {
            map {
                "result": util:eval(concat($context, $test/code/string()), false())
            }
        } catch * {
            map {
                "error": map {
                    "code": $err:code,
                    "description": $err:description,
                    "value": $err:value,
                    "module": $err:module,
                    "line-number": $err:line-number,
                    "column-number": $err:column-number,
                    "additional": $err:additional,
                    "xquery-stack-trace": $exerr:xquery-stack-trace,
                    "java-stack-trace": $exerr:java-stack-trace
                }
            }
        }
	let $output := if ($test/@trace eq 'yes') then map { "result": system:trace() } else $queryOutput
    let $expanded :=
        if (not(empty($output("error")))) then
            $output
        else if ($test/@serialize) then
            try {
                let $options := $test/@serialize/string()
                return
                    map {
                        "result": normalize-space(string-join($output("result") ! util:serialize(., $options)))
                    }
            } catch * {
                map {
                    "error": map {
                        "code": $err:code,
                        "description": $err:description,
                        "value": $err:value,
                        "module": $err:module,
                        "line-number": $err:line-number,
                        "column-number": $err:column-number,
                        "additional": $err:additional,
                        "xquery-stack-trace": $exerr:xquery-stack-trace,
                        "java-stack-trace": $exerr:java-stack-trace
                    }
                }
            }

		else if ($output("result") instance of node()) then
        	map {
        	    "result": util:expand($output("result"), $serialize-options)
        	}
		else
			$output
    let $expected :=
        if ($test/@output eq 'text') then
            data($test/expected)
        else $test/expected/node()
    let $OK :=
        if ($test/error) then
            not(empty($expanded("error"))) and (contains($expanded("error")("description"), $test/error) or local-name-from-QName($expanded("error")("code")) eq string($test/error))
        else if ($test/xpath) then
            t:test(t:xpath($output("result"), $test/xpath))
        else if ($test/@output eq 'text') then
            let $asString :=
                if ($test/@serialize) then
                    $expanded("result")
                else
                    normalize-space(string-join(for $x in $output("result") return string($x),' '))
            return
                $asString eq normalize-space($expected)
        else
            let $xn := t:normalize($expanded("result"))
            let $en := t:normalize($expected)
            return
        	   deep-equal($xn, $en)
    return
        (
            <test n="{$count}" pass="{$OK}">
            { $test/@id }
            {
                if (not($OK)) then
                    let $_notify :=
                        if(not(empty($expanded("error")))) then
                            if(not(empty($test-error-function))) then $test-error-function($test/task, $expanded("error")) else ()
                        else
                            if(not(empty($test-failure-function))) then $test-failure-function($test/task, map { "value": $test/expected/*, "xpath": $test/xpath/*, "error": $test/error/* }, $expanded) else ()
                    return
                        ($test/task, $test/expected, $test/xpath, <result>{$expanded("result"), if(not(empty($expanded("error")))) then $expanded("error")("description") else ()}</result>)
                else
                    ()
            }
            </test>
            ,
            let $_notify-finished := if(not(empty($test-finished-function))) then $test-finished-function($test/task) else ()
            return ()
        )
};

declare function t:normalize($nodes as node()*) {
	for $node in $nodes return t:normalize-node($node)
};

declare function t:normalize-node($node as node()) {
	typeswitch ($node)
		case element() return
			element { node-name($node) } {
				$node/@*, for $child in $node/node() return t:normalize-node($child)
			}
		case text() return
			let $norm := normalize-space($node)
			return
				if (string-length($norm) eq 0) then () else $node
		default return
			$node
};

declare function t:xpath($output as item()*, $xpath as element()) {
    for $prefix in in-scope-prefixes($xpath)
    let $nsuri := namespace-uri-for-prefix($prefix, $xpath)
    return
        if ($prefix != 'xml') then
            util:declare-namespace($prefix, $nsuri)
        else (),
    let $expr := $xpath/string()
    return
        if (matches($expr, "^\s*/")) then
            util:eval(concat("$output", $expr))
        else
            util:eval($expr)
};

declare function t:run-testSet($set as element(TestSet), $id as xs:string?) {
    t:run-testSet($set, $id, (), (), (), (), (), ())
};

declare function t:run-testSet($set as element(TestSet), $id as xs:string?,
        $test-ignored-function as (function(xs:string) as empty-sequence())?,
        $test-started-function as (function(xs:string) as empty-sequence())?,
        $test-failure-function as (function(xs:string, map(xs:string, item()?), map(xs:string, item()?)) as empty-sequence())?,
        $test-assumption-failed-function as (function(xs:string, map(xs:string, item()?)?) as empty-sequence())?,
        $test-error-function as (function(xs:string, map(xs:string, item()?)?) as empty-sequence())?,
        $test-finished-function as (function(xs:string) as empty-sequence())?) {
    let $copy := util:expand($set)
    let $null := t:setup($copy/setup)
    let $tests :=
        if ($id) then
            $copy/test[@id = $id]
        else
            for $test in $copy/test
            return
                if($test[empty(@ignore) or @ignore = "no"])then
                    $test
                else
                    let $_notify-ignored := if(not(empty($test-ignored-function))) then $test-ignored-function($test/task) else ()
                    return ()
    let $result := util:expand(
           <TestSet>
           {$copy/testName}
           {$copy/description}
           {
               for $test at $p in $tests
               return
                   t:run-test($test, $p,
                        $test-ignored-function, $test-started-function, $test-failure-function,
                        $test-assumption-failed-function, $test-error-function, $test-finished-function)
           }
           </TestSet>
        )
    let $null := t:tearDown($copy/tearDown)
    return $result
};

declare function t:format-testResult($result) {
    let $formatted :=

{$result/testName}

{$result/description/p}

          {for $test in $result//test
           return

                    {$test/@n/.}
                    {$test/@pass/.}

          }

     return
        $formatted
};


[repo] removed dependency on file module

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

xquery version "1.0";

declare option exist:serialize "method=xml media-type=text/xml indent=yes omit-xml-declaration=no";

declare variable $repo-packages-uri := "http://127.0.0.1:8080/exist/rest/db/repo/";
declare variable $repo-coll := "/db/repo";

<packages repo-url="{$repo-packages-uri}" description="package repository">
    {
    let $repocol :=  if (collection($repo-coll)) then () else xmldb:create-collection('/db','repo')
    let $files := if (collection($repo-coll)) then collection($repo-coll)/util:document-name(.) else ()
    for $file in $files[ends-with(.,'.xar')]
    return
            <package name="{$file}">
            <url>{$repo-packages-uri}{$file}</url>
            </package>
    }
</packages>

xquery version "1.0";

import module namespace file="http://exist-db.org/xquery/file";

declare option exist:serialize "method=xml media-type=text/xml indent=yes omit-xml-declaration=no";

declare variable $repo-packages-uri := "http://127.0.0.1:8080/exist/rest/db/repo/";
declare variable $repo-coll := "/db/repo";

<packages repo-url="{$repo-packages-uri}" description="package repository">
    {
    let $repocol :=  if (collection($repo-coll)) then () else xmldb:create-collection('/db','repo')
    let $files := if (collection($repo-coll)) then collection($repo-coll)/util:document-name(.) else ()
    for $file in $files[ends-with(.,'.xar')]
    return
            <package name="{$file}">
            <url>{$repo-packages-uri}{$file}</url>
            </package>
    }
</packages>


changed location of csd_msc.xqm module in csd_dm.xqm

(:~
: This is the Care Services Discovery stored query registry
: @version 1.0
: @see https://github.com/his-interop/openinfoman
:
:)
module namespace csd_dm = "https://github.com/his-interop/openinfoman/csd_dm";

import module namespace csd_mcs = "https://github.com/his-interop/openinfoman/csd_mcs" at "csd_merge_cached_services.xqm";

declare namespace csd = "urn:ihe:iti:csd:2013";
declare default element  namespace   "urn:ihe:iti:csd:2013";

declare variable $csd_dm:document_manager := 'csd_docs.xml';

declare updating function csd_dm:init($db) {
  if ( not(csd_dm:dm_exists($db)))  then
    db:add($db, <documentLibrary/>,$csd_dm:document_manager)
  else
      ()
};

declare function csd_dm:dm_exists($db) {
  db:is-xml($db,$csd_dm:document_manager)
};

declare  function csd_dm:document_source_exists($db,$name) {
  let $source := csd_dm:document_source($db,$name)
  return  (db:is-xml($db,$source))

};

declare  function csd_dm:open_document($db,$name) {
  if (csd_dm:document_source_exists($db,$name)) then
    db:open($db,csd_dm:document_source($db,$name))
  else
    ()
};

declare updating function csd_dm:register_document($db,$name,$source) {
  let $dm :=  db:open($db,$csd_dm:document_manager)/documentLibrary
  let $reg_doc := <document name="{$name}" source="{$source}"/>
  let $existing := $dm/document[@name = $name]
  return if (not(exists($existing)))  then
      (insert node $reg_doc into $dm, csd_mcs:merge($db))
    else
      (replace  node $existing with $reg_doc, csd_mcs:merge($db))
};

declare  function csd_dm:is_registered($db,$name) {
  if (csd_dm:dm_exists($db)) then
    let $dm :=  db:open($db,$csd_dm:document_manager)/documentLibrary
    let $existing := $dm/document[@name = $name]
    return exists($existing)
  else
    false()

};

declare updating function csd_dm:deregister_document($db,$name) {
  if (csd_dm:dm_exists($db)) then
    let $dm :=  db:open($db,$csd_dm:document_manager)/documentLibrary
    let $existing := $dm/document[@name = $name]
    return if (exists($existing))  then
      (delete node $existing, csd_mcs:merge($db))
    else ()
  else ()

};

declare function csd_dm:registered_documents($db) {
  if (csd_dm:dm_exists($db)) then
    for $name in db:open($db,$csd_dm:document_manager)/documentLibrary/document/text{@name}
    where csd_dm:document_source_exists($db,$name)
      return $name
  else
    ()
};

declare function csd_dm:document_source($db,$name) {
    db:open($db,$csd_dm:document_manager)/documentLibrary/document[@name = $name]/@source
};

(:~
: This is the Care Services Discovery stored query registry
: @version 1.0
: @see https://github.com/his-interop/openinfoman
:
:)
module namespace csd_dm = "https://github.com/his-interop/openinfoman/csd_dm";

import module namespace csd_mcs = "https://github.com/his-interop/openinfoman/csd_mcs" at "../repo/csd_merge_cached_services.xqm";

declare namespace csd = "urn:ihe:iti:csd:2013";
declare default element  namespace   "urn:ihe:iti:csd:2013";

declare variable $csd_dm:document_manager := 'csd_docs.xml';

declare updating function csd_dm:init($db) {
  if ( not(csd_dm:dm_exists($db)))  then
    db:add($db, <documentLibrary/>,$csd_dm:document_manager)
  else
      ()
};

declare function csd_dm:dm_exists($db) {
  db:is-xml($db,$csd_dm:document_manager)
};

declare  function csd_dm:document_source_exists($db,$name) {
  let $source := csd_dm:document_source($db,$name)
  return  (db:is-xml($db,$source))

};

declare  function csd_dm:open_document($db,$name) {
  if (csd_dm:document_source_exists($db,$name)) then
    db:open($db,csd_dm:document_source($db,$name))
  else
    ()
};

declare updating function csd_dm:register_document($db,$name,$source) {
  let $dm :=  db:open($db,$csd_dm:document_manager)/documentLibrary
  let $reg_doc := <document name="{$name}" source="{$source}"/>
  let $existing := $dm/document[@name = $name]
  return if (not(exists($existing)))  then
      (insert node $reg_doc into $dm, csd_mcs:merge($db))
    else
      (replace  node $existing with $reg_doc, csd_mcs:merge($db))
};

declare  function csd_dm:is_registered($db,$name) {
  if (csd_dm:dm_exists($db)) then
    let $dm :=  db:open($db,$csd_dm:document_manager)/documentLibrary
    let $existing := $dm/document[@name = $name]
    return exists($existing)
  else
    false()

};

declare updating function csd_dm:deregister_document($db,$name) {
  if (csd_dm:dm_exists($db)) then
    let $dm :=  db:open($db,$csd_dm:document_manager)/documentLibrary
    let $existing := $dm/document[@name = $name]
    return if (exists($existing))  then
      (delete node $existing, csd_mcs:merge($db))
    else ()
  else ()

};

declare function csd_dm:registered_documents($db) {
  if (csd_dm:dm_exists($db)) then
    for $name in db:open($db,$csd_dm:document_manager)/documentLibrary/document/text{@name}
    where csd_dm:document_source_exists($db,$name)
      return $name
  else
    ()
};

declare function csd_dm:document_source($db,$name) {
    db:open($db,$csd_dm:document_manager)/documentLibrary/document[@name = $name]/@source
};


[ignore] Wrong server address.

[ignore] Wrong server address.

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

xquery version "1.0";

(:~ Retrieve package list from server. Needed to work around cross-site-scripting browser restrictions. :)
declare option exist:serialize "method=html media-type=text/html";

let $url := request:get-parameter("url", "http://demo.exist-db.org/exist/apps/public-repo/retrieve.html")
return
    if ($url) then
        httpclient:get($url, false(), ())//httpclient:body/*
    else
        response:set-status-code(404)

xquery version "1.0";

(:~ Retrieve package list from server. Needed to work around cross-site-scripting browser restrictions. :)
declare option exist:serialize "method=html media-type=text/html";

let $url := request:get-parameter("url", "http://192.168.2.104:8080/exist/apps/public-repo/retrieve.html")
return
    if ($url) then
        httpclient:get($url, false(), ())//httpclient:body/*
    else
        response:set-status-code(404)


Fix for bug #3102184.

Fix for bug #3102184.

(: Schema for results :)
import schema default element namespace "http://www.w3.org/2005/02/query-test-XQTSResult" at "w3c_reportingresults/XQTSResult.xsd";

(: Test.xml file from ctest :)
declare variable $ctests as document-node() external;

if(fn:empty($ctests)) then
  fn:error()
else
  validate {
    <test-suite-result>
       <implementation name="Zorba"
         version='1.5.0 (svn rev. 9658)'
         anonymous-result-column="false">

         <organization
            name='FLWOR Foundation'
            website="http://zorba-xquery.com/"
            anonymous="false" />

         <submittor
            name="Zorba Team"
            email="contact@zorba-xquery.com" />

         <description>

Zorba is a general purpose XQuery processor implementing in C++
            the W3C family of specifications. It is not an XML database.
            The query processor has been designed to be embeddable in a
            variety of environments such as other programming languages
            extended with XML processing capabilities, browsers,
            database servers, XML message dispatchers, or smartphones.
            Its architecture employes a modular design, which allows customizing
            the Zorba query processor to the environment’s needs.
            In particular the architecture of the query processor allows a
            pluggable XML store (e.g. main memory, DOM stores, persistent
            disk-based large stores, S3 stores). Zorba runs on most platforms
            and is available under the Apache license v2. Currently, Zorba
            implements the following W3C specifications: XQuery 1.0, XQuery Update
            Facility 1.0, XQuery Scripting Extension 1.0, and XSLT 2.0 and XQuery 1.0
            Serialization.

         </description>

         <implementation-defined-items>
           <implementation-defined-item
              name="The revalidation modes that are supported by this implementation."
              value="lax, skip, strict" />

          <implementation-defined-item
             name="The default revalidation mode for this implementation."
             value="lax" />

         </implementation-defined-items>

         <features>
            <feature name='Minimum Conformance' supported='true' />
            <feature name='Schema Import' supported='true' />
            <feature name='Schema Validation' supported='true' />
            <feature name='Static Typing' supported='false' />
            <feature name='Static Typing Extensions' supported='false' />
            <feature name='Full Axis' supported='true' />
            <feature name='Module' supported='true' />
            <feature name='Serialization' supported='true' />
         </features>

         <context-properties>
            <context-property name="Boundary-space policy" context-type="static" value="strip"/>
            <context-property name="Ordering mode" context-type="static" value="ordered"/>
            <context-property name="Context item static type" context-type="static" value="item()"/>
            <context-property name="Default element/type namespace" context-type="static" value=""/>
            <context-property name="Default function namespace" context-type="static" value="http://www.w3.org/2005/xpath-functions"/>

            <context-property name="Default collation" context-type="static" value="http://www.w3.org/2005/xpath-functions/collation/codepoint"/>
            <context-property name="Construction mode" context-type="static" value="preserve"/>

            <context-property name="Default order for empty sequences" context-type="static" value="empty greatest"/>

            <context-property name="Copy-namespaces mode" context-type="static" value="inherit preserve"/>

         </context-properties>

       </implementation>

       <syntax>XQuery</syntax>

       <test-run dateRun="2011-01-03">
          <test-suite version="current"/>
          <transformation>
Standard
</transformation>
          <comparison>
Standard
</comparison>
          <otherComments>
XQTS taken from W3C CVS as of 2011-01-03.
</otherComments>
       </test-run>

      {
        for $test in $ctests/*:Site/*:Testing/*:Test
        let $testname := fn:tokenize(fn:data($test/*:Name), "/")[last()]
        return
        if (fn:contains(fn:data($test),'StaticTyping')) then
          <test-case
            name="{$testname}"
            result="not applicable"
            comment="Zorba does not support the 'Static Typing Feature'"
          />
        else if (fn:contains(fn:data($test),'CastFOCA0001-1') or
                 fn:contains(fn:data($test),'CastFOCA0003-1')) then
          <test-case
            name="{$testname}"
            result="pass"
            comment="There is an openened bug #11400 with the W3C for this issue. Please see http://www.w3.org/Bugs/Public/show_bug.cgi?id=11400."
          />
        else
          <test-case
            name="{$testname}"
            result="{fn:substring(fn:data($test/@Status), 0, 5)}"
          />
       }
    </test-suite-result>
  }

(: Schema for results :)
import schema default element namespace "http://www.w3.org/2005/02/query-test-XQTSResult" at "w3c_reportingresults/XQTSResult.xsd";

(: Test.xml file from ctest :)
declare variable $ctests as document-node() external;

if(fn:empty($ctests)) then
  fn:error()
else
  validate {
    <test-suite-result>
       <implementation name="Zorba"
         version='1.4.0 (svn rev. 8998)'
         anonymous-result-column="false">

         <organization
            name='FLWOR Foundation'
            website="http://zorba-xquery.com/"
            anonymous="false" />

         <submittor
            name="Zorba Team"
            email="contact@zorba-xquery.com" />

         <description>

Zorba is a general purpose XQuery processor implementing in C++
            the W3C family of specifications. It is not an XML database.
            The query processor has been designed to be embeddable in a
            variety of environments such as other programming languages
            extended with XML processing capabilities, browsers,
            database servers, XML message dispatchers, or smartphones.
            Its architecture employes a modular design, which allows customizing
            the Zorba query processor to the environment’s needs.
            In particular the architecture of the query processor allows a
            pluggable XML store (e.g. main memory, DOM stores, persistent
            disk-based large stores, S3 stores). Zorba runs on most platforms
            and is available under the Apache license v2. Currently, Zorba
            implements the following W3C specifications: XQuery 1.0, XQuery Update
            Facility 1.0, XQuery Scripting Extension 1.0, and XSLT 2.0 and XQuery 1.0
            Serialization.

         </description>

         <implementation-defined-items>
           <implementation-defined-item
              name="The revalidation modes that are supported by this implementation."
              value="lax, skip, strict" />

          <implementation-defined-item
             name="The default revalidation mode for this implementation."
             value="lax" />

         </implementation-defined-items>

         <features>
            <feature name='Minimum Conformance' supported='true' />
            <feature name='Schema Import' supported='true' />
            <feature name='Schema Validation' supported='true' />
            <feature name='Static Typing' supported='false' />
            <feature name='Static Typing Extensions' supported='false' />
            <feature name='Full Axis' supported='true' />
            <feature name='Module' supported='true' />
            <feature name='Serialization' supported='true' />
         </features>

         <context-properties>
            <context-property name="Boundary-space policy" context-type="static" value="strip"/>
            <context-property name="Ordering mode" context-type="static" value="ordered"/>
            <context-property name="Context item static type" context-type="static" value="item()"/>
            <context-property name="Default element/type namespace" context-type="static" value=""/>
            <context-property name="Default function namespace" context-type="static" value="http://www.w3.org/2005/xpath-functions"/>

            <context-property name="Default collation" context-type="static" value="http://www.w3.org/2005/xpath-functions/collation/codepoint"/>
            <context-property name="Construction mode" context-type="static" value="preserve"/>

            <context-property name="Default order for empty sequences" context-type="static" value="empty greatest"/>

            <context-property name="Copy-namespaces mode" context-type="static" value="inherit preserve"/>

         </context-properties>

       </implementation>

       <syntax>XQuery</syntax>

       <test-run dateRun="2010-10-11">
          <test-suite version="current"/>
          <transformation>
Standard
</transformation>
          <comparison>
Standard
</comparison>
          <otherComments>
XQTS taken from W3C CVS as of 2010-10-11.
</otherComments>
       </test-run>

      {
        for $test in $ctests/*:Site/*:Testing/*:Test
        let $testname := fn:tokenize(fn:data($test/*:Name), "/")[last()]
        return
        if (fn:contains(fn:data($test),'StaticTyping')) then
          <test-case
            name="{$testname}"
            result="not applicable"
            comment="Zorba does not support the 'Static Typing Feature'"
          />
        else
          <test-case
            name="{$testname}"
            result="{fn:substring(fn:data($test/@Status), 0, 5)}"
          />
       }
    </test-suite-result>
  }


Annotate the BaseX proc functions with versioned type restrictions.

xquery version "3.1";
(:~
 : BaseX Process Module functions
 :
 : @see http://docs.basex.org/wiki/Process_Module
 :)
module namespace proc = "http://basex.org/modules/proc";

declare namespace a = "http://reecedunn.co.uk/xquery/annotations";
declare namespace o = "http://reecedunn.co.uk/xquery/options";

declare option o:requires "basex/7.3";

declare %a:since("basex", "7.3") function proc:system($cmd as xs:string) as xs:string external;
declare %a:since("basex", "7.3") function proc:system($cmd as xs:string, $args as xs:string*) as xs:string external;
declare %a:restrict-until("$options", "basex", "8.6", "xs:string")
        %a:restrict-since("$options", "basex", "8.6", "map(xs:string, xs:string)")
        %a:since("basex", "7.3") function proc:system($cmd as xs:string, $args as xs:string*, $options as (xs:string|map(xs:string, xs:string))) as xs:string external;
declare %a:since("basex", "7.3") function proc:execute($cmd as xs:string) as element(result) external;
declare %a:since("basex", "7.3") function proc:execute($cmd as xs:string, $args as xs:string*) as element(result) external;
declare %a:restrict-until("$options", "basex", "8.6", "xs:string")
        %a:restrict-since("$options", "basex", "8.6", "map(xs:string, xs:string)")
        %a:since("basex", "7.3") function proc:execute($cmd as xs:string, $args as xs:string*, $options as (xs:string|map(xs:string, xs:string))) as element(result) external;
declare %a:since("basex", "9.0") function proc:fork($cmd as xs:string) as element(result) external;
declare %a:since("basex", "9.0") function proc:fork($cmd as xs:string, $args as xs:string*) as element(result) external;
declare %a:since("basex", "9.0") function proc:fork($cmd as xs:string, $args as xs:string*, $options as map(xs:string, xs:string)) as element(result) external;
declare %a:since("basex", "8.3") function proc:property($name as xs:string) as xs:string? external;
declare %a:since("basex", "8.3") function proc:property-names() as xs:string* external;

xquery version "3.1";
(:~
 : BaseX Process Module functions
 :
 : @see http://docs.basex.org/wiki/Process_Module
 :)
module namespace proc = "http://basex.org/modules/proc";

declare namespace a = "http://reecedunn.co.uk/xquery/annotations";
declare namespace o = "http://reecedunn.co.uk/xquery/options";

declare option o:requires "basex/7.3";

declare %a:since("basex", "7.3") function proc:system($cmd as xs:string) as xs:string external;
declare %a:since("basex", "7.3") function proc:system($cmd as xs:string, $args as xs:string*) as xs:string external;
declare %a:since("basex", "7.3") function proc:system($cmd as xs:string, $args as xs:string*, $options as map(xs:string, xs:string) (: $options [7.3] as xs:string [8.6] as map(xs:string, xs:string) :)) as xs:string external;
declare %a:since("basex", "7.3") function proc:execute($cmd as xs:string) as element(result) external;
declare %a:since("basex", "7.3") function proc:execute($cmd as xs:string, $args as xs:string*) as element(result) external;
declare %a:since("basex", "7.3") function proc:execute($cmd as xs:string, $args as xs:string*, $options as map(xs:string, xs:string) (: $options [7.3] as xs:string [8.6] as map(xs:string, xs:string) :)) as element(result) external;
declare %a:since("basex", "9.0") function proc:fork($cmd as xs:string) as element(result) external;
declare %a:since("basex", "9.0") function proc:fork($cmd as xs:string, $args as xs:string*) as element(result) external;
declare %a:since("basex", "9.0") function proc:fork($cmd as xs:string, $args as xs:string*, $options as map(xs:string, xs:string)) as element(result) external;
declare %a:since("basex", "8.3") function proc:property($name as xs:string) as xs:string? external;
declare %a:since("basex", "8.3") function proc:property-names() as xs:string* external;


adding article & prefixes & other tweaks for search strings

(: Creates search strings for macro-affiliations to use in Voyant Tools :)

(: The labels to append to each item in $search-strings :)
let $search-labels := (
'Muslim',
'Christian',
'Jewish',
'Zoroastrian',
'Sabian',
'Zindiq',
'Convert-to-Islam')

let $search-strings := (
'حنف*|زيدي*|السنّي*|أنصاري*|خارجي*|صحابي*|إمامي*|مالكي*|شافع*|معتزل*|صوفي*|حنبل*|مرجئ*|أشعر*|علوي*|شيع*|رافض*',
'مسيح*|نسطور*|نصران*|نصارى*|راهب*|سرياني*'
,'يهود*|إسرائيل*'
,'مجوس*'
,'صابئ*'
,'زنديق*',
'اسلم*|*عتنق* الإسلام')

let $prefixes := ('ب','ل','ك','ف','و')

(: If turned on will only search for variants that include any shaddas in above strings. :)
let $require-existing-shadda := 1
(: If turned on will not allow any vowels provided in $search-strings to be absent. If off, will match any specified vowels as well as unvocalized versions, but not alternate vowels. :)
let $require-existing-vowels := 0
(: If turned on will add a search term with the definite article prefixed to the word. :)
let $add-optional-article := 1
(: If turned on will add attached prepositions and conjunctions as optional search strings. :)
let $add-optional-prefixes := 1

for $string at $i in $search-strings
let $existing-vowels :=
    if ($require-existing-vowels) then
        if ($require-existing-shadda) then
            replace(replace($string, '([ً-ِْ-ٖ])','ّ?$1ّ?'),'(ّّ\?([ً-ِْ-ٖ])ّ\?)|(ّ\?([ً-ِْ-ٖ])ّ\?ّ)','(ّ$2$4)|($2$4ّ)') (: optional shadda before / after required vowel, but keeps existing shaddas by replacing optional shaddas with required :)
        else
            replace(replace($string, '([ً-ِْ-ٖ])','ّ?$1ّ?'),'(ّّ\?)|(ّ\?ّ)','ّ?') (: optional shadda before / after required vowel, ignoring existing shaddas by removing duplicate shaddas :)
    else
        if ($require-existing-shadda) then
            replace(replace($string, '([ً-ِْ-ٖ])','$1?'),'(ّ([ً-ِْ-ٖ]\?))|(([ً-ِْ-ٖ]\?)ّ)','($2$4ّ)|(ّ$2$4)') (: optional existing vowel + required shadda on either side :)
        else
            replace(replace($string, '([ً-ٖ])','[ّ$1]*'),'ّ?(\[ّ[ً-ٖ]\]\*)ّ?','$1') (: optional existing vowel + optional shadda, in any order, replacing existing shaddas :)

let $add-vowels :=
    if ($require-existing-shadda) then
        replace(
            replace(
                replace(
                    $existing-vowels,
                    '([ء-ي])(ّ?)',
                    '$1$2[ً-ِْ-ٖ]*') (: Adds vowel wildcard after all consonants :)
                ,'\[ً-ِْ-ٖ\]\*([ً-ِْ-ٖ])'
                ,'$1'), (: Then removes wildcard if it is next to an existing vowel. :)
            '([ء-ي])\[ً-ِْ-ٖ\]\*',
            '$1[ً-ٖ]*') (: If there is no shadda normalizes to shadda-agnostic. :)
    else
        replace(
            replace(
                $existing-vowels,
                '([ء-ي])',
                '$1[ً-ٖ]*') (: Adds vowel wildcard after all consonants :)
            ,'\[ً-ٖ\]\*([\(ّ])'
            ,'$1') (: Then removes wildcard if it is next to an existing vowel-shadda combo. :)

let $remove-final-vowel := (: Removes final vowel because it confuses Voyant Tools. :)
    replace(
        replace($add-vowels,
        '\[ً-ٖ\]\*(\*?)($|\|)',
        '$1$2'),
    '\[ً-ِْ-ٖ\]\*(\*?)($|\|)',
    '$1$2')

let $add-article :=
    if ($add-optional-article) then
     (: Duplicates each segment of the search string, adding the article on the front of one.
     Then removes any back-to-back | characters created in the process. :)
        replace(
            replace($remove-final-vowel,'(.*?[\|$])','$1|الْ?$1'),
            '\|\|',
            '|')
    else $remove-final-vowel

let $add-prefixes :=
    if ($add-optional-prefixes) then
        let $prefixes-to-add := concat(string-join($prefixes,'?[ً-ِْ-ٖ]?'),'?[ً-ِْ-ٖ]?')
        (: Breaks string into segments by | character and adds prefix query to each string, then rejoins them. :)
        let $prefixes-added := concat($prefixes-to-add,string-join(tokenize($add-article,'\|'),concat('|',$prefixes-to-add)))
        (: Accounts for elided ا when preposition ل is added producing لل instead of لال.
        Duplicates the form with the article (if present) and creates an additional form with لل in place
        of the article. :)
        return replace(
            replace(
                $prefixes-added,
                concat('((',$prefixes-to-add,')(الْ\?)(.*?[\|$]))'),
                '$1|لِ?لْ?$4'),
            '\|\|',
            '|')
    else $add-article

let $normalize-alif := replace($add-prefixes,'ا','[آاإأ]')
let $normalize-ya := replace($normalize-alif,'ى','[يىئ]')
let $normalize-waw := replace($normalize-ya,'و','[وؤ]')

return (concat($search-labels[$i],': '),$normalize-waw,'
')

(: Creates search strings for macro-affiliations to use in Voyant Tools :)

(: The labels to append to each item in $search-strings :)
let $search-labels := (
'Muslim',
'Christian',
'Jewish',
'Zoroastrian',
'Sabian',
'Zindiq',
'Convert-to-Islam')

let $search-strings := (
'حنف*|زيدي*|السنّي*|أنصاري*|خارجي*|صحابي*|إمامي*|مالكي*|شافع*|معتزل*|صوفي*|حنبل*|مرجئ*|أشعر*|علوي*|شيع*|رافض*',
'مسيح*|نسطور*|نصران*|راهب*|سرياني*'
,'يهود*|إسرائيل*'
,'مجوس*'
,'صابئ*'
,'زنديق*',
'اسلم*|*عتنق* الإسلام')

(: If turned on will only search for variants that include any shaddas in above strings. :)
let $require-existing-shadda := 1
(: If turned on will not allow any vowels provided in $search-strings to be absent. If off, will match any specified vowels as well as unvocalized versions, but not alternate vowels. :)
let $require-existing-vowels := 0

for $string at $i in $search-strings
let $existing-vowels :=
    if ($require-existing-vowels) then
        if ($require-existing-shadda) then
            replace(replace($string, '([ً-ِْ-ٖ])','ّ?$1ّ?'),'(ّّ\?([ً-ِْ-ٖ])ّ\?)|(ّ\?([ً-ِْ-ٖ])ّ\?ّ)','(ّ$2$4)|($2$4ّ)') (: optional shadda before / after required vowel, but keeps existing shaddas by replacing optional shaddas with required :)
        else
            replace(replace($string, '([ً-ِْ-ٖ])','ّ?$1ّ?'),'(ّّ\?)|(ّ\?ّ)','ّ?') (: optional shadda before / after required vowel, ignoring existing shaddas by removing duplicate shaddas :)
    else
        if ($require-existing-shadda) then
        (: Does this properly include optional shaddas where there are not required ones? :)
            replace(replace($string, '([ً-ِْ-ٖ])','$1?'),'(ّ([ً-ِْ-ٖ]\?))|(([ً-ِْ-ٖ]\?)ّ)','($2$4ّ)|(ّ$2$4)') (: optional existing vowel + required shadda on either side :)
        else
            replace(replace($string, '([ً-ٖ])','[ّ$1]*'),'ّ?(\[ّ[ً-ٖ]\]\*)ّ?','$1') (: optional existing vowel + optional shadda, in any order, replacing existing shaddas :)

let $add-vowels :=
    if ($require-existing-shadda) then
        replace(
            replace(
                replace(
                    $existing-vowels,
                    '([ء-ي])(ّ?)',
                    '$1$2[ً-ِْ-ٖ]*') (: Adds vowel wildcard after all consonants :)
                ,'\[ً-ِْ-ٖ\]\*([ً-ِْ-ٖ])'
                ,'$1'), (: Then removes wildcard if it is next to an existing vowel. :)
            '([ء-ي])\[ً-ِْ-ٖ\]\*',
            '$1[ً-ٖ]*') (: If there is no shadda normalizes to shadda-agnostic. :)
    else
        replace(
            replace(
                $existing-vowels,
                '([ء-ي])',
                '$1[ً-ٖ]*') (: Adds vowel wildcard after all consonants :)
            ,'\[ً-ٖ\]\*([\(ّ])'
            ,'$1') (: Then removes wildcard if it is next to an existing vowel-shadda combo. :)

let $remove-final-vowel := (: Removes final vowel because it confuses Voyant Tools. :)
    replace(
        replace($add-vowels,
        '\[ً-ٖ\]\*(\*?)($|\|)',
        '$1$2'),
    '\[ً-ِْ-ٖ\]\*(\*?)($|\|)',
    '$1$2')

let $normalize-alif := replace($remove-final-vowel,'ا','[آاإأ]')
let $normalize-ya := replace($normalize-alif,'ى','[يىئ]')
let $normalize-waw := replace($normalize-ya,'و','[وؤ]')

return (concat($search-labels[$i],': '),$normalize-waw,'
')