Update tmpl.xqm

Update tmpl.xqm

Insert link to CodeMirror CSS file

(:~
 : Template functions.
 :
 : @author Christian Grün, BaseX GmbH, 2014-15
 :)
module namespace tmpl = 'dba/tmpl';

import module namespace cons = 'dba/cons' at 'cons.xqm';

(:~
 : Extends the specified table rows with the page template.
 : @param  $tr  tr elements
 : @return HTML page
 :)
declare function tmpl:wrap(
  $tr  as element(tr)+
) as element(html) {
  tmpl:wrap(map{ }, $tr)
};

(:~
 : Extends the specified table rows with the page template.
 : The following options can be specified:
 :

 :
top: current top category

 :
error: error string

 :
info: info string

 :

 : @param  $options  options
 : @param  $tr       tr elements
 : @return page
 :)
declare function tmpl:wrap(
  $options  as map(*),
  $tr       as element(tr)+
) as element(html) {

      <meta charset="utf-8"/>
      <title>Database Administration</title>
      <meta name="description" content="Database Administration"/>
      <meta name="author" content="BaseX Team, 2014-15"/>
      <link rel="stylesheet" type="text/css" href="files/style.css"/>
      <link rel="stylesheet" type="text/css" href="files/codemirror/lib/codemirror.css"/>

};

(:~
 : Template functions.
 :
 : @author Christian Grün, BaseX GmbH, 2014-15
 :)
module namespace tmpl = 'dba/tmpl';

import module namespace cons = 'dba/cons' at 'cons.xqm';

(:~
 : Extends the specified table rows with the page template.
 : @param  $tr  tr elements
 : @return HTML page
 :)
declare function tmpl:wrap(
  $tr  as element(tr)+
) as element(html) {
  tmpl:wrap(map{ }, $tr)
};

(:~
 : Extends the specified table rows with the page template.
 : The following options can be specified:
 :

 :
top: current top category

 :
error: error string

 :
info: info string

 :

 : @param  $options  options
 : @param  $tr       tr elements
 : @return page
 :)
declare function tmpl:wrap(
  $options  as map(*),
  $tr       as element(tr)+
) as element(html) {

      <meta charset="utf-8"/>
      <title>Database Administration</title>
      <meta name="description" content="Database Administration"/>
      <meta name="author" content="BaseX Team, 2014-15"/>
      <link rel="stylesheet" type="text/css" href="files/style.css"/>

};


[testsuite] Added annotations %test:assertError("errcode") and %test:name("description") to XQuery test runner.

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

xquery version "3.0";

(:~
 : XQSuite - a functional test framework based on XQuery 3.0 annotations.
 : Relies on the functions util:list-functions and util:inspect-function
 : to inspect annotations. The rest is pretty much standard XQuery.
 :
 : Usage:
 :
 : <pre>
 : import module namespace test="http://exist-db.org/xquery/xqsuite" at "resource:org/exist/xquery/lib/xqsuite/xqsuite.xql";
 : import module namespace t="http://exist-db.org/xquery/test/examples" at "examples.xql";
 :
 : test:suite(util:list-functions("http://exist-db.org/xquery/test/examples"))
 : </pre>
 :
 : @author Wolfgang Meier
 :)
module namespace test="http://exist-db.org/xquery/xqsuite";

declare variable $test:TEST_NAMESPACE := "http://exist-db.org/xquery/xqsuite";

declare variable $test:UNKNOWN_ASSERTION := QName($test:TEST_NAMESPACE, "no-such-assertion");

(:~
 : Main entry point into the module. Takes a sequence of function items.
 : Functions with known test annotations will be evaluated and their results
 : checked against the annotations.
 :
 : @param $functions a sequence of function items
 : @return an XML report (in xUnit format)
 :)
declare function test:suite($functions as function(*)+) {
    let $modules := test:distinct-modules($functions)
    return
        <testsuites>
        {
            (: Run tests for each module in turn :)
            for $module in $modules
            let $modFunctions := filter(function($func) {
                    namespace-uri-from-QName(function-name($func)) = $module
                }, $functions)
            let $setup := test:call-func-with-annotation($modFunctions, "setUp")
            let $result :=
                if (empty($setup) or $setup/self::ok) then
                    let $results :=
                        test:function-by-annotation($modFunctions, "assert", test:test#2)
                    return
                        <testsuite package="{$module}" timestamp="{util:system-dateTime()}"
                            failures="{count($results/failure)}">
                            { $results }
                        </testsuite>
                else
                    <testsuite package="{$module}" timestamp="{util:system-dateTime()}"
                        errors="{count($functions)}">
                        {$setup/string()}
                    </testsuite>
            return
                ($result, test:call-func-with-annotation($modFunctions, "tearDown"))[1]
        }
        </testsuites>
};

(:~
 : Find functions having the given annotation and call the callback function.
 :)
declare %private function test:function-by-annotation($functions as function(*)+, $annot as xs:string,
    $callback as function(function(*), element(function)) as item()*) {
    for $function in $functions
    let $meta := util:inspect-function($function)
    where $meta/annotation[@namespace = $test:TEST_NAMESPACE][matches(@name, ":" || $annot)]
    return
        $callback($function, $meta)
};

(:~
 : Return the namespace URI of all distinct modules in the input set.
 :)
declare %private function test:distinct-modules($functions as function(*)+) as xs:string+ {
    distinct-values(
        for $func in $functions
        return
            namespace-uri-from-QName(function-name($func))
    )
};

(:~
 : Find functions having the specified annotation and call them,
 : return <ok/> upon success, an error description otherwise.
 : Used for setUp and tearDown.
 :)
declare %private function test:call-func-with-annotation($functions as function(*)+, $annot as xs:string) as element()? {
    test:function-by-annotation($functions, $annot, function($func, $meta) {
        try {
            (<ok/>, $func())[1]
        } catch * {
            <system-err>{$err:description}</system-err>
        }
    })
};

(:~
 : The main function for running a single test. Executes the test function
 : and compares the result against each assertXXX annotation.
 :)
declare %private function test:test($func as function(*), $meta as element(function)) {
    let $assertions := $meta/annotation[matches(@name, ":assert")]
    return
        if (exists($assertions)) then
            try {
                let $result := $func()
                let $assertResult := test:check-assertions($assertions, $result)
                return
                    test:print-result($meta, $result, $assertResult)
            } catch * {
                let $assertError := $meta/annotation[contains(@name, ":assertError")]
                return
                    if ($assertError) then
                        if ($assertError/value and not(contains($err:code, $assertError/value/string())
                            or contains($err:description, $assertError/value/string())))then
                            <report>
                                <failure message="Expected error {$assertError/value/string()}, got: {$err:code}"
                                    type="failure-error-code-1"/>
                            </report>
                        else
                            test:print-result($meta, (), ())
                    else
                        <error>{$err:code}: {$err:description}</error>
            }
        else
            ()
};

(:~
 : Print out evaluation results for a given test.
 :)
declare %private function test:print-result($meta as element(function), $result as item()*,
    $assertResult as element(report)?) {
    let $nameAnnot := $meta/annotation[matches(@name, ":name")]
    let $name := if ($nameAnnot) then $nameAnnot/value else replace($meta/@name, "^\w+:([^:]+)$", "$1")
    return
        <testcase name="{$name}" class="{$meta/@name}">
        {
            if (exists($assertResult)) then
                $assertResult/*
            else
                ()
        }
        </testcase>
};

(:~
 : Check the function's return value against each assertion.
 :)
declare %private function test:check-assertions($assertions as element(annotation)*, $result as item()*) as element(report)* {
    for $annotation in $assertions
    let $assert := replace($annotation/@name, "^\w+:(.*)$", "$1")
    return
        switch ($assert)
            case "assertEquals" return
                test:assertEquals($annotation/value/string(), $result)
            case "assertEmpty" return
                test:assertEmpty($result)
            case "assertExists" return
                test:assertExists($result)
            case "assertTrue" return
                test:assertTrue($result)
            case "assertFalse" return
                test:assertFalse($result)
            case "assertXPath" return
                test:assertXPath($annotation/value/string(), $result)
            case "assertError" return
                test:assertError($annotation/value/string(), $result)
            default return
                error($test:UNKNOWN_ASSERTION, $annotation/@name)
};

(:~
 : Check for equality of the function's result with the value in the annotation.
 : This function transforms the result to a string before checking for equality.
 :)
declare %private function test:assertEquals($value as xs:string, $result as item()*) as element(report)? {
    let $normResult :=
        typeswitch ($result)
            case node()* return
                test:normalize($result)
            default return
                string-join($result, " ")
    let $normValue :=
        typeswitch ($result)
            case node()* return
                util:parse("<r>" || $value || "</r>")/r/node()
            default return
                $value
    let $equal :=
        typeswitch ($normResult)
            case node()* return
                deep-equal($normValue, $normResult)
            default return
                $normResult = $normValue
    return
        if ($equal) then
            ()
        else
           <report>
                <failure message="assertEquals failed."
                    type="failure-error-code-1">
                { $normValue }
                </failure>
                <output>{ $result }</output>
            </report>
};

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

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

(:~
 : Check if the function's result is empty.
 :)
declare %private function test:assertEmpty($result as item()*) as element(report)? {
    if (empty($result)) then
        ()
    else
        <report>
            <failure message="assertEmpty failed."
                type="failure-error-code-1"/>,
            <output>{ $result }</output>
        </report>
};

(:~
 : Check if the function's result is not empty.
 :)
declare %private function test:assertExists($result as item()*) as element(report)? {
    if (exists($result)) then
        ()
    else
        <report>
            <failure message="assertExists failed."
                type="failure-error-code-1"/>,
            <output>{ $result }</output>
        </report>
};

(:~
 : Check if the function's result is true.
 :)
declare %private function test:assertTrue($result as item()*) as element(report)? {
    if ($result) then
        ()
    else
        <report>
            <failure message="assertExists failed."
                type="failure-error-code-1"/>,
            <output>{ $result }</output>
        </report>
};

(:~
 : Check if the function caused an error.
 :)
declare %private function test:assertError($value as xs:string, $result as item()*) as element(report)? {
    if ($result) then
        ()
    else
        <report>
            <failure message="assertError failed. Expected error {$value}"
                type="failure-error-code-1"/>,
            <output>{ $result }</output>
        </report>
};

(:~
 : Check if the function's result is false.
 :)
declare %private function test:assertFalse($result as item()*) as element(report)? {
    if (not($result)) then
        ()
    else
        <report>
            <failure message="assertExists failed."
                type="failure-error-code-1"/>,
            <output>{ $result }</output>
        </report>
};

(:~
 : Evaluate an arbitrary XPath expression against result. The test passes if
 : the XPath returns either true or a non-empty sequence.
 :)
declare %private function test:assertXPath($expr as xs:string?, $result as item()*) as element(report)? {
    let $xr :=
        test:checkXPathResult(
            if (matches($expr, "^\s*/")) then
                util:eval(concat("$result", $expr))
            else
                util:eval($expr)
        )
    return
        if ($xr) then
            ()
        else
            <report>
                <failure message="assertXPath failed."
                    type="failure-error-code-1">{ $expr }</failure>,
                <output>{ $result }</output>
            </report>
};

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

(: Helper functions to be used by test modules :)

declare function test:mkcol($root as xs:string, $path as xs:string) as empty() {
    test:mkcol-recursive($root, tokenize($path, "/"))
};

declare %private function test:mkcol-recursive($collection, $components) as empty() {
    if (exists($components)) then
        let $newColl := concat($collection, "/", $components[1])
        return (
            xmldb:create-collection($collection, $components[1])[2],
            test:mkcol-recursive($newColl, subsequence($components, 2))
        )
    else
        ()
};

xquery version "3.0";

(:~
 : XQSuite - a functional test framework based on XQuery 3.0 annotations.
 : Relies on the functions util:list-functions and util:inspect-function
 : to inspect annotations. The rest is pretty much standard XQuery.
 :
 : Usage:
 :
 : <pre>
 : import module namespace test="http://exist-db.org/xquery/xqsuite" at "resource:org/exist/xquery/lib/xqsuite/xqsuite.xql";
 : import module namespace t="http://exist-db.org/xquery/test/examples" at "examples.xql";
 :
 : test:suite(util:list-functions("http://exist-db.org/xquery/test/examples"))
 : </pre>
 :
 : @author Wolfgang Meier
 :)
module namespace test="http://exist-db.org/xquery/xqsuite";

declare variable $test:TEST_NAMESPACE := "http://exist-db.org/xquery/xqsuite";

declare variable $test:UNKNOWN_ASSERTION := QName($test:TEST_NAMESPACE, "no-such-assertion");

(:~
 : Main entry point into the module. Takes a sequence of function items.
 : Functions with known test annotations will be evaluated and their results
 : checked against the annotations.
 :
 : @param $functions a sequence of function items
 : @return an XML report (in xUnit format)
 :)
declare function test:suite($functions as function(*)+) {
    let $modules := test:distinct-modules($functions)
    return
        <testsuites>
        {
            (: Run tests for each module in turn :)
            for $module in $modules
            let $modFunctions := filter(function($func) {
                    namespace-uri-from-QName(function-name($func)) = $module
                }, $functions)
            let $setup := test:call-func-with-annotation($modFunctions, "setUp")
            let $result :=
                if (empty($setup) or $setup/self::ok) then
                    let $results :=
                        test:function-by-annotation($modFunctions, "assert", test:test#2)
                    return
                        <testsuite package="{$module}" timestamp="{util:system-dateTime()}"
                            failures="{count($results/failure)}">
                            { $results }
                        </testsuite>
                else
                    <testsuite package="{$module}" timestamp="{util:system-dateTime()}"
                        errors="{count($functions)}">
                        {$setup/string()}
                    </testsuite>
            return
                ($result, test:call-func-with-annotation($modFunctions, "tearDown"))[1]
        }
        </testsuites>
};

(:~
 : Find functions having the given annotation and call the callback function.
 :)
declare %private function test:function-by-annotation($functions as function(*)+, $annot as xs:string,
    $callback as function(function(*), element(function)) as item()*) {
    for $function in $functions
    let $meta := util:inspect-function($function)
    where $meta/annotation[@namespace = $test:TEST_NAMESPACE][matches(@name, ":" || $annot)]
    return
        $callback($function, $meta)
};

(:~
 : Return the namespace URI of all distinct modules in the input set.
 :)
declare %private function test:distinct-modules($functions as function(*)+) as xs:string+ {
    distinct-values(
        for $func in $functions
        return
            namespace-uri-from-QName(function-name($func))
    )
};

(:~
 : Find functions having the specified annotation and call them,
 : return <ok/> upon success, an error description otherwise.
 : Used for setUp and tearDown.
 :)
declare %private function test:call-func-with-annotation($functions as function(*)+, $annot as xs:string) as element()? {
    test:function-by-annotation($functions, $annot, function($func, $meta) {
        try {
            (<ok/>, $func())[1]
        } catch * {
            <system-err>{$err:description}</system-err>
        }
    })
};

(:~
 : The main function for running a single test. Executes the test function
 : and compares the result against each assertXXX annotation.
 :)
declare %private function test:test($func as function(*), $meta as element(function)) {
    let $assertions := $meta/annotation[matches(@name, ":assert")]
    return
        if (exists($assertions)) then
            try {
                let $result := $func()
                let $assertResult := test:check-assertions($assertions, $result)
                return
                    test:print-result($meta, $result, $assertResult)
            } catch * {
                <error>{$err:description}</error>
            }
        else
            ()
};

(:~
 : Print out evaluation results for a given test.
 :)
declare %private function test:print-result($meta as element(function), $result as item()*,
    $assertResult as element(report)?) {
    <testcase name="{$meta/@name}">
    {
        if (exists($assertResult)) then
            $assertResult/*
        else
            ()
    }
    </testcase>
};

(:~
 : Check the function's return value against each assertion.
 :)
declare %private function test:check-assertions($assertions as element(annotation)*, $result as item()*) as element(report)* {
    for $annotation in $assertions
    let $assert := replace($annotation/@name, "^\w+:(.*)$", "$1")
    return
        switch ($assert)
            case "assertEquals" return
                test:assertEquals($annotation/value/string(), $result)
            case "assertEmpty" return
                test:assertEmpty($result)
            case "assertExists" return
                test:assertExists($result)
            case "assertTrue" return
                test:assertTrue($result)
            case "assertFalse" return
                test:assertFalse($result)
            case "assertXPath" return
                test:assertXPath($annotation/value/string(), $result)
            default return
                error($test:UNKNOWN_ASSERTION, $annotation/@name)
};

(:~
 : Check for equality of the function's result with the value in the annotation.
 : This function transforms the result to a string before checking for equality.
 :)
declare %private function test:assertEquals($value as xs:string, $result as item()*) as element(report)? {
    let $normResult :=
        typeswitch ($result)
            case node()* return
                test:normalize($result)
            default return
                string-join($result, " ")
    let $normValue :=
        typeswitch ($result)
            case node()* return
                util:parse("<r>" || $value || "</r>")/r/node()
            default return
                $value
    let $equal :=
        typeswitch ($normResult)
            case node()* return
                deep-equal($normValue, $normResult)
            default return
                $normResult = $normValue
    return
        if ($equal) then
            ()
        else
           <report>
                <failure message="assertEquals failed."
                    type="failure-error-code-1">
                { $normValue }
                </failure>
                <output>{ $result }</output>
            </report>
};

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

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

(:~
 : Check if the function's result is empty.
 :)
declare %private function test:assertEmpty($result as item()*) as element(report)? {
    if (empty($result)) then
        ()
    else
        <report>
            <failure message="assertEmpty failed."
                type="failure-error-code-1"/>,
            <output>{ $result }</output>
        </report>
};

(:~
 : Check if the function's result is not empty.
 :)
declare %private function test:assertExists($result as item()*) as element(report)? {
    if (exists($result)) then
        ()
    else
        <report>
            <failure message="assertExists failed."
                type="failure-error-code-1"/>,
            <output>{ $result }</output>
        </report>
};

(:~
 : Check if the function's result is true.
 :)
declare %private function test:assertTrue($result as item()*) as element(report)? {
    if ($result) then
        ()
    else
        <report>
            <failure message="assertExists failed."
                type="failure-error-code-1"/>,
            <output>{ $result }</output>
        </report>
};

(:~
 : Check if the function's result is false.
 :)
declare %private function test:assertFalse($result as item()*) as element(report)? {
    if (not($result)) then
        ()
    else
        <report>
            <failure message="assertExists failed."
                type="failure-error-code-1"/>,
            <output>{ $result }</output>
        </report>
};

(:~
 : Evaluate an arbitrary XPath expression against result. The test passes if
 : the XPath returns either true or a non-empty sequence.
 :)
declare %private function test:assertXPath($expr as xs:string?, $result as item()*) as element(report)? {
    let $xr :=
        test:checkXPathResult(
            if (matches($expr, "^\s*/")) then
                util:eval(concat("$result", $expr))
            else
                util:eval($expr)
        )
    return
        if ($xr) then
            ()
        else
            <report>
                <failure message="assertXPath failed."
                    type="failure-error-code-1">{ $expr }</failure>,
                <output>{ $result }</output>
            </report>
};

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

(: Helper functions to be used by test modules :)

declare function test:mkcol($root as xs:string, $path as xs:string) as empty() {
    test:mkcol-recursive($root, tokenize($path, "/"))
};

declare %private function test:mkcol-recursive($collection, $components) as empty() {
    if (exists($components)) then
        let $newColl := concat($collection, "/", $components[1])
        return (
            xmldb:create-collection($collection, $components[1])[2],
            test:mkcol-recursive($newColl, subsequence($components, 2))
        )
    else
        ()
};


[apidoc] Support generating the MarkLogic 5.0 apidoc function signatures.

(:
 : Copyright (C) 2020 Reece H. Dunn
 :
 : 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 "3.1";

declare namespace apidoc = "http://marklogic.com/xdmp/apidoc";
declare namespace map = "http://www.w3.org/2005/xpath-functions/map";
declare namespace xhtml = "http://www.w3.org/1999/xhtml";

declare variable $apidoc as element(apidoc:apidoc) :=
    typeswitch (.)
    case xs:string return fn:parse-xml(.)/element()
    case document-node() return ./element()
    default return .;

declare variable $language as xs:string := "xquery"; (: xquery | rest :)

(: namespaces -------------------------------------------------------------- :)

declare variable $module-namespaces := map:merge(
    for $import in $apidoc//apidoc:module/apidoc:summary/(*:p|*:pre)
    let $match := fn:analyze-string(($import/*:code, $import)[1], "import module (namespace\s*([a-z0-9]+)\s*=\s*)?""([^""]+)""")/fn:match[1]
    let $prefix := ($match//fn:group[@nr = "2"]/string(), $import/ancestor::apidoc:module/@lib)[1]
    let $namespace := $match/fn:group[@nr = "3"]/string()
    where exists($namespace)
    return map:entry($prefix, $namespace)
);

declare variable $xquery-namespaces := map {
    "local": "http://www.w3.org/2005/xquery-local-functions",
    "fn": "http://www.w3.org/2005/xpath-functions",
    "xml": "http://www.w3.org/XML/1998/namespace",
    "xs": "http://www.w3.org/2001/XMLSchema",
    "xsi": "http://www.w3.org/2001/XMLSchema-instance"
};

declare variable $marklogic-5-builtin := map {
    "cts": "http://marklogic.com/cts",
    "dbg": "http://marklogic.com/xdmp/dbg",
    "dir": "http://marklogic.com/xdmp/directory",
    "error": "http://marklogic.com/xdmp/error",
    "map": "http://marklogic.com/xdmp/map",
    "math": "http://marklogic.com/xdmp/math",
    "prof": "http://marklogic.com/xdmp/profile",
    "sec": "http://marklogic.com/security",
    "spell": "http://marklogic.com/xdmp/spell",
    "xdmp": "http://marklogic.com/xdmp"
};

declare variable $marklogic-additional := map {
    "as": "http://marklogic.com/xdmp/assignments",
    "db": "http://marklogic.com/xdmp/database",
    "dg": "xdmp:document-get",
    "cl": "http://marklogic.com/xdmp/clusters",
    "exsl": "http://exslt.org/common",
    "gr": "http://marklogic.com/xdmp/group",
    "xdt": "http://www.w3.org/2004/10/xpath-datatypes",
    "xi": "http://www.w3.org/2001/XInclude",
    "mt": "http://marklogic.com/xdmp/mimetypes",
    "pkg": "http://marklogic.com/manage/package",
    "s": "http://www.w3.org/2009/xpath-functions/analyze-string",
    "x509": "http://marklogic.com/xdmp/x509"
};

declare variable $namespaces := map:merge((
    $module-namespaces,
    $xquery-namespaces,
    $marklogic-5-builtin,
    $marklogic-additional,
    ()
));

(: functions --------------------------------------------------------------- :)

(: Several functions in the apidocs have duplicate parameter names in some versions, so fix these. :)
declare variable $param-fixes := map {
    "fn:subtract-dateTimes-yielding-dayTimeDuration": ("srcval1", "srcval2"),
    "fn:subtract-dateTimes-yielding-yearMonthDuration": ("srcval1", "srcval2"),
    "math:fmod": ("x", "y"),
    "math:rank": ("arg1", "arg2", "options")
};

declare variable $functions as element(apidoc:function)* := $apidoc//apidoc:function[
    local:function-language(.) = $language and not(@name = "")
];

declare function local:function-language($function as element(apidoc:function)) as xs:string {
    let $bucket := $function/@bucket
    return switch ($bucket)
    case "REST Resources API" return "rest"
    default return "xquery"
};

declare function local:function-name($function as element(apidoc:function)) as xs:string {
    ``[`{$function/@lib}`:`{$function/@name}`]``
};

declare function local:function-parameters($function as element(apidoc:function)) as xs:string* {
    let $names as xs:string* :=
        let $names := map:get($param-fixes, local:function-name($function))
        return if (exists($names)) then
            $names
        else
            $function/apidoc:params/apidoc:param/@name/string()
    return if (count($names) != count(distinct-values($names))) then
        fn:error(xs:QName("err:XQST0039"),``[Duplicate parameter name in `{local:function-name($function)}`]``)
    else
        $names
};

declare function local:function-parameter($function as element(apidoc:function), $name as xs:string) as element(apidoc:param) {
    let $names := map:get($param-fixes, local:function-name($function))
    return if (exists($names)) then
        let $i := fn:index-of($names, $name)
        return $function/apidoc:params/apidoc:param[$i]
    else
        $function/apidoc:params/apidoc:param[@name = $name]
};

declare function local:function-parameter-type($function as element(apidoc:function), $name as xs:string) as xs:string {
    if ($function/@lib = "exsl" and $function/@name = "object-type") then
        "item()*" (: MarkLogic 7 and earlier docs have this as 'atomic type'. :)
    else
        let $type := local:function-parameter($function, $name)/@type/string()
        return replace($type, ",\.\.\.", "...")
};

declare function local:function-return-type($function as element(apidoc:function)) as xs:string {
    let $type := $function/apidoc:return/string()
    return switch ($type)
    case "An XML representation of the certificate." return "element()?"
    case "element())" return "element()"
    case "xs:unsignedLong)" return "xs:unsignedLong"
    default return $type
};

declare function local:function-xquery-signatures($function as element(apidoc:function)) as xs:string* {
    let $name := local:function-name($function)
    let $params :=
        for $name in local:function-parameters($function)
        let $type := local:function-parameter-type($function, $name)
        return ``[$`{$name}` as `{$type}`]``
    let $type := local:function-return-type($function)
    return ``[declare function `{$name}`(`{string-join($params, ", ")}`) as `{$type}` external;]``
};

(: query ------------------------------------------------------------------- :)

for $prefix in map:keys($namespaces)
let $namespace := map:get($namespaces, $prefix)
order by $prefix
return ``[declare namespace `{$prefix}` = "`{$namespace}`";]``
,
for $function in $functions
order by $function/@lib, $function/@name
return local:function-xquery-signatures($function)

(:
 : Copyright (C) 2020 Reece H. Dunn
 :
 : 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 "3.1";

declare namespace apidoc = "http://marklogic.com/xdmp/apidoc";
declare namespace map = "http://www.w3.org/2005/xpath-functions/map";

declare variable $apidoc as element(apidoc:apidoc) :=
    typeswitch (.)
    case xs:string return fn:parse-xml(.)/element()
    case document-node() return ./element()
    default return .;

declare variable $language as xs:string := "xquery"; (: xquery | rest :)

(: functions --------------------------------------------------------------- :)

(: Several functions in the apidocs have duplicate parameter names in some versions, so fix these. :)
declare variable $param-fixes := map {
    "fn:subtract-dateTimes-yielding-dayTimeDuration": ("srcval1", "srcval2"),
    "fn:subtract-dateTimes-yielding-yearMonthDuration": ("srcval1", "srcval2"),
    "math:fmod": ("x", "y"),
    "math:rank": ("arg1", "arg2", "options")
};

declare variable $functions as element(apidoc:function)* := $apidoc//apidoc:function[
    local:function-language(.) = $language and not(@name = "")
];

declare function local:function-language($function as element(apidoc:function)) as xs:string {
    let $bucket := $function/@bucket
    return switch ($bucket)
    case "REST Resources API" return "rest"
    default return "xquery"
};

declare function local:function-name($function as element(apidoc:function)) as xs:string {
    ``[`{$function/@lib}`:`{$function/@name}`]``
};

declare function local:function-parameters($function as element(apidoc:function)) as xs:string* {
    let $names as xs:string* :=
        let $names := map:get($param-fixes, local:function-name($function))
        return if (exists($names)) then
            $names
        else
            $function/apidoc:params/apidoc:param/@name/string()
    return if (count($names) != count(distinct-values($names))) then
        fn:error(xs:QName("err:XQST0039"),``[Duplicate parameter name in `{local:function-name($function)}`]``)
    else
        $names
};

declare function local:function-parameter($function as element(apidoc:function), $name as xs:string) as element(apidoc:param) {
    let $names := map:get($param-fixes, local:function-name($function))
    return if (exists($names)) then
        let $i := fn:index-of($names, $name)
        return $function/apidoc:params/apidoc:param[$i]
    else
        $function/apidoc:params/apidoc:param[@name = $name]
};

declare function local:function-parameter-type($function as element(apidoc:function), $name as xs:string) as xs:string {
    local:function-parameter($function, $name)/@type
};

declare function local:function-return-type($function as element(apidoc:function)) as xs:string {
    $function/apidoc:return
};

declare function local:function-xquery-signatures($function as element(apidoc:function)) as xs:string* {
    let $name := local:function-name($function)
    let $params :=
        for $name in local:function-parameters($function)
        let $type := local:function-parameter-type($function, $name)
        return ``[$`{$name}` as `{$type}`]``
    let $type := local:function-return-type($function)
    return ``[declare function `{$name}`(`{string-join($params, ", ")}`) as `{$type}` external;]``
};

(: query ------------------------------------------------------------------- :)

for $function in $functions
order by $function/@lib, $function/@name
return local:function-xquery-signatures($function)


Update validate_provider_facility_service.xq

fixes https://github.com/openhie/openinfoman-ilr/issues/3

import module namespace csd_bl = "https://github.com/openhie/openinfoman/csd_bl";
declare default element  namespace   "urn:ihe:iti:csd:2013";
declare variable $careServicesRequest as item() external;

(:
   The query will be executed against the root element of the CSD document.

   The dynamic context of this query has $careServicesRequest set to contain any of the search
   and limit paramaters as sent by the Service Finder
:)

<CSD xmlns:csd="urn:ihe:iti:csd:2013"  >
  <organizationDirectory/>
  <serviceDirectory/>
  <facilityDirectory/>
  <providerDirectory>
    {
      let $facility_oid := $careServicesRequest/facility[1]/@oid
      let $service_oid := $careServicesRequest/facility[1]/service[1]/@oid

      (: if no provider id was provided, then this is invalid. :)
      let $provs0 := if (exists($careServicesRequest/id/@oid))
	then csd_bl:filter_by_primary_id(/CSD/providerDirectory/*,$careServicesRequest/id)
      else ()

      let $provs1 := if (exists($facility_oid) and count($provs0) = 1)
	then
	   if (count ($provs0[1]/facilities/facility[@oid = $facility_oid]) > 0) then $provs0 else ()
	else $provs0

      let $provs2 := if (exists($service_oid) and count($provs1) = 1)
	then
	   if (count ($provs1[1]/facilities/facility[@oid = $facility_oid]/service[@oid = $service_oid]) > 0) then $provs1 else ()
	else $provs1

      return if (count($provs2) = 1) then
	<provider oid='{$provs2[1]/@oid}'/>
      else
	 ()
    }
  </providerDirectory>
</CSD>

import module namespace csd_bl = "https://github.com/openhie/openinfoman/csd_bl";
declare default element  namespace   "urn:ihe:iti:csd:2013";
declare variable $careServicesRequest as item() external;

(:
   The query will be executed against the root element of the CSD document.

   The dynamic context of this query has $careServicesRequest set to contain any of the search
   and limit paramaters as sent by the Service Finder
:)

<CSD xmlns:csd="urn:ihe:iti:csd:2013"  >
  <organizationDirectory/>
  <serviceDirectory/>
  <facilityDirectory/>
  <providerDirectory>
    {
      let $facility_oid := $careServicesRequest/facility[1]/@oid
      let $service_oid := $careServicesRequest/facility[1]/service[1]/@oid

      (: if no provider id was provided, then this is invalid. :)
      let $provs0 := if (exists($careServicesRequest/id))
	then csd_bl:filter_by_primary_id(/CSD/providerDirectory/*,$careServicesRequest/id)
      else ()

      let $provs1 := if (exists($facility_oid) and count($provs0) = 1)
	then
	   if (count ($provs0[1]/facilities/facility[@oid = $facility_oid]) > 0) then $provs0 else ()
	else $provs0

      let $provs2 := if (exists($service_oid) and count($provs1) = 1)
	then
	   if (count ($provs1[1]/facilities/facility[@oid = $facility_oid]/service[@oid = $service_oid]) > 0) then $provs1 else ()
	else $provs1

      return if (count($provs2) = 1) then
	<provider oid='{$provs2[1]/@oid}'/>
      else
	 ()
    }
  </providerDirectory>
</CSD>


fix test for leading-wildcard in ft:search

xquery version "3.0";

module namespace luct="http://exist-db.org/xquery/lucene/test";

import module namespace test="http://exist-db.org/xquery/xqsuite" at "resource:org/exist/xquery/lib/xqsuite/xqsuite.xql";

declare variable $luct:INDEX_DATA :=
    <doc>
        <field name="title">Lorem ipsum dolor</field>
    </doc>;

declare variable $luct:INDEX_DATA_SUBCOLL :=
    <doc>
        <field name="title">Only admin can read this</field>
    </doc>;

declare
    %test:setUp
function luct:setup() {
    xmldb:create-collection("/db", "lucenetest"),
    xmldb:store("/db/lucenetest", "test.txt", "Lorem ipsum", "text/text"),
    sm:chmod(xs:anyURI("/db/lucenetest/test.txt"), "rw-------"),
    ft:index("/db/lucenetest/test.txt", $luct:INDEX_DATA),

    xmldb:create-collection("/db/lucenetest", "sub"),
    sm:chmod(xs:anyURI("/db/lucenetest/sub"), "rwx------"),
    xmldb:store("/db/lucenetest/sub", "test.txt", "Lorem ipsum", "text/text"),
    sm:chmod(xs:anyURI("/db/lucenetest/sub/test.txt"), "rw-rw-rw-"),
    ft:index("/db/lucenetest/sub/test.txt", $luct:INDEX_DATA_SUBCOLL)
};

declare
    %test:tearDown
function luct:cleanup() {
    xmldb:remove("/db/lucenetest")
};

declare
    %test:assertEmpty
function luct:check-visibility-fail() {
    system:as-user("guest", "guest",
        ft:search("/db/lucenetest/", "title:ipsum")/search/@uri/string()
    )
};

declare
    %test:assertEquals("/db/lucenetest/test.txt")
function luct:check-visibility-pass() {
    system:as-user("admin", "",
        ft:search("/db/lucenetest/", "title:ipsum")/search/@uri/string()
    )
};

declare
    %test:assertEmpty
function luct:check-visibility-collection-fail() {
    system:as-user("guest", "guest",
        ft:search("/db/lucenetest/sub/", "title:admin")/search/@uri/string()
    )
};

declare
    %test:assertEquals("/db/lucenetest/sub/test.txt")
function luct:check-visibility-collection-pass() {
    system:as-user("admin", "",
        ft:search("/db/lucenetest/sub/", "title:admin")/search/@uri/string()
    )
};

declare
    %test:assertEquals("/db/lucenetest/test.txt")
function luct:check-leading-wildcard() {
    system:as-user("admin", "",
        ft:search("/db/lucenetest/", "title:*rem", (), <options><leading-wildcard>yes</leading-wildcard></options>)/search/@uri/string()
    )
};

xquery version "3.0";

module namespace luct="http://exist-db.org/xquery/lucene/test";

import module namespace test="http://exist-db.org/xquery/xqsuite" at "resource:org/exist/xquery/lib/xqsuite/xqsuite.xql";

declare variable $luct:INDEX_DATA :=
    <doc>
        <field name="title">Lorem ipsum dolor</field>
    </doc>;

declare variable $luct:INDEX_DATA_SUBCOLL :=
    <doc>
        <field name="title">Only admin can read this</field>
    </doc>;

declare
    %test:setUp
function luct:setup() {
    xmldb:create-collection("/db", "lucenetest"),
    xmldb:store("/db/lucenetest", "test.txt", "Lorem ipsum", "text/text"),
    sm:chmod(xs:anyURI("/db/lucenetest/test.txt"), "rw-------"),
    ft:index("/db/lucenetest/test.txt", $luct:INDEX_DATA),

    xmldb:create-collection("/db/lucenetest", "sub"),
    sm:chmod(xs:anyURI("/db/lucenetest/sub"), "rwx------"),
    xmldb:store("/db/lucenetest/sub", "test.txt", "Lorem ipsum", "text/text"),
    sm:chmod(xs:anyURI("/db/lucenetest/sub/test.txt"), "rw-rw-rw-"),
    ft:index("/db/lucenetest/sub/test.txt", $luct:INDEX_DATA_SUBCOLL)
};

declare
    %test:tearDown
function luct:cleanup() {
    xmldb:remove("/db/lucenetest")
};

declare
    %test:assertEmpty
function luct:check-visibility-fail() {
    system:as-user("guest", "guest",
        ft:search("/db/lucenetest/", "title:ipsum")/search/@uri/string()
    )
};

declare
    %test:assertEquals("/db/lucenetest/test.txt")
function luct:check-visibility-pass() {
    system:as-user("admin", "",
        ft:search("/db/lucenetest/", "title:ipsum")/search/@uri/string()
    )
};

declare
    %test:assertEmpty
function luct:check-visibility-collection-fail() {
    system:as-user("guest", "guest",
        ft:search("/db/lucenetest/sub/", "title:admin")/search/@uri/string()
    )
};

declare
    %test:assertEquals("/db/lucenetest/sub/test.txt")
function luct:check-visibility-collection-pass() {
    system:as-user("admin", "",
        ft:search("/db/lucenetest/sub/", "title:admin")/search/@uri/string()
    )
};

declare
    %test:assertEquals("Lorem")
function luct:check-leading-wildcard() {
    system:as-user("admin", "",
        ft:search("/db/lucenetest/", "title:*rem", (), <options><leading-wildcard>yes</leading-wildcard></options>)/search/@uri/string()
    )
};


Document the MarkLogic map functions.

Document the MarkLogic map functions.

xquery version "1.0-ml";
(:~
 : MarkLogic map functions
 :
 : @see https://docs.marklogic.com/map
 :
 : This documentation includes material copied from or derived from the XPath and
 : XQuery Functions and Operators 3.1 specifications. Copyright © 2017 W3C®
 : (MIT, ERCIM, Keio, Beihang).
 :)
module namespace map = "http://marklogic.com/xdmp/map";

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

declare option o:requires "marklogic/5.0";

(:~
 : Removes all the entries in the supplied map.
 :
 : This function updates the map supplied as $map so that each
 : entry is removed from the map.
 :
 : The effect of the function call map:clear($MAP) can be described
 : more formally as the result of the expression below:
 :
 :
map:keys($MAP) ! map:delete($MAP, .)

 :)
declare %a:since("marklogic", "5.0") function map:clear($map as map:map) as empty-sequence() external;
(:~
 : Tests whether a supplied map contains an entry for a given key.
 :
 : This function returns true if the map supplied as $map contains
 : an entry with the same key as the supplied value of $key;
 : otherwise it returns false.
 :)
declare %a:since("marklogic", "6.0") function map:contains($map as map:map, $key as xs:string) as xs:boolean external;
(:~
 : Returns the number of entries in the supplied map.
 :
 : This function takes any map as its $map argument and returns
 : the number of entries that are present in the map.
 :)
declare %a:since("marklogic", "5.0") function map:count($map as map:map) as xs:unsignedInt external;
(:~
 : Removes the entry with the specified key from the supplied map.
 :
 : This function removes the entry from $map whose key is the same
 : key as $key.
 :)
declare %a:since("marklogic", "5.0") function map:delete($map as map:map, $key as xs:string) as empty-sequence() external;
(:~
 : Returns a map that contains a single entry (a key-value pair).
 :
 : This function returns a map which contains a single entry. The key of the
 : entry in the new map is $key, and its associated value is
 : $value.
 :
 :
Notes

 :
 : This function is intended primarily for use in conjunction with the function
 : map:new. For example, a map containing seven entries may be
 : constructed like this:
 :
 :
map:new((
 :    map:entry("Su", "Sunday"),
 :    map:entry("Mo", "Monday"),
 :    map:entry("Tu", "Tuesday"),
 :    map:entry("We", "Wednesday"),
 :    map:entry("Th", "Thursday"),
 :    map:entry("Fr", "Friday"),
 :    map:entry("Sa", "Saturday")
 :    ))

 :
 : The map:new function can be used to construct a map with a
 : variable number of entries, for example:
 :
 :
map:new(for $b in //book return map:entry($b/isbn, $b))

 :)
declare %a:since("marklogic", "7.0") function map:entry($key as xs:string, $value as item()*) as map:map external;
(:~
 : Returns the value associated with a supplied key in a given map.
 :
 : This function attempts to find an entry within the map supplied as
 : $map that has the same key as the supplied value of
 : $key. If there is such an entry, it returns the associated value;
 : otherwise it returns an empty sequence.
 :
 :
Notes

 :
 : A return value of () from map:get could indicate that
 : the key is present in the map with an associated value of (), or it
 : could indicate that the key is not present in the map. The two cases can be
 : distinguished by calling map:contains.
 :
 : MarkLogic does not support the XQuery 3.1 ability to invoke the map as a function
 : item. Attempting this generates a dynamic error XDMP-NOTFUNC [err:XPTY0004].
 :)
declare %a:since("marklogic", "5.0") function map:get($map as map:map, $key as xs:string) as item()* external;
(:~
 : Returns a sequence containing all the keys present in a map.
 :
 : This function takes any map as its $map argument and returns
 : the keys that are present in the map as a sequence of string values, in
 : implementation-dependent order.
 :
 : This function is non-deterministic with respect to ordering. This means that
 : two calls with the same argument are not guaranteed to produce the results
 : in the same order.
 :
 :
Notes

 :
 : The number of items in the result will be the same as the number of entries
 : in the map, and the result sequence will contain no duplicate values.
 :)
declare %a:since("marklogic", "5.0") function map:keys($map as map:map) as xs:string* external;
(:~
 : Returns a map that contains no entries.
 :
 : This function returns a map which contains no entries.
 :
 :
Notes

 :
 : The function call map:map() produces the same result as the
 : expression map:map(<map xmlns="http://marklogic.com/xdmp/map"/>)
 : and map:new(()).
 :)
declare %a:since("marklogic", "5.0") function map:map() as map:map external;
(:~
 : Returns a map that contains the entries from the XML serialized map data.
 :
 : This function returns a map with the entries in the $map element.
 :)
declare %a:since("marklogic", "5.0") function map:map($map as element(map:map)) as map:map external;
(:~
 : Returns a map that contains no entries.
 :
 : This function returns a map which contains no entries.
 :
 :
Notes

 :
 : The function call map:new() produces the same result as the
 : expression map:map(<map xmlns="http://marklogic.com/xdmp/map"/>)
 : and map:new(()).
 :)
declare %a:since("marklogic", "7.0") function map:new() as map:map external;
(:~
 : Returns a map that combines the entries from a number of existing maps.
 :
 : This function returns a map that is formed by combining the contents of the
 : maps supplied in the $maps argument.
 :
 : The supplied maps are combined as follows:
 :

 :
There is one entry in the returned map for each distinct key present
 :         in the union of the input maps, where two keys are distinct if they
 :         are not the same key.

 :
If duplicate keys are present, all but the last of a set of duplicates
 :         are ignored, where the ordering is based on the order of maps in the
 :         $maps argument.

 :

 :)
declare %a:since("marklogic", "7.0") function map:new($maps as map:map*) as map:map external;
(:~
 : Updates the contents of the supplied map with an additional entry, which
 : replaces any existing entry for the same key.
 :
 : This function modifies the supplied $map, with a new entry whose
 : key is $key and whose associated value is $value.
 :
 : If the $map contains an entry whose key is the same key as
 : $key, that entry is replaced with the new value.
 :
 : If the $value is () then the key is removed from
 : the $map. This is equivalent to calling
 : map:delete($map, $key).
 :)
declare %a:since("marklogic", "5.0") function map:put($map as map:map, $key as xs:string, $value as item()*) as empty-sequence() external;
(:~
 : Configure the supplied map to be passed by reference or value in JavaScript.
 :
 : If $byref is true() then the $map is
 : passed by reference when it is passed to JavaScript.
 :
 : If $byref is false() then the $map is
 : passed by value when it is passed to JavaScript. This is the default behaviour
 : for the $map.
 :)
declare %a:since("marklogic", "9.0") function map:set-javascript-by-ref($map as map:map, $byref as xs:boolean) as empty-sequence() external;
(:~
 : Updates and returns the supplied map with an additional entry, which
 : replaces any existing entry for the same key.
 :
 : This function modifies the supplied $map, with a new entry whose
 : key is $key and whose associated value is $value.
 :
 : If the $map contains an entry whose key is the same key as
 : $key, that entry is replaced with the new value.
 :
 : If the $value is () then the key is removed from
 : the $map. This is equivalent to calling
 : map:delete($map, $key).
 :
 : The updated $map is returned from the map:with
 : function call.
 :
 :
Notes

 :
 : The map:with function calls can be chained when using the
 : arrow operator syntax. For example:
 :
 :
map:new()
 :    => map:with("Su", "Sunday")
 :    => map:with("Mo", "Monday")
 :    => map:with("Tu", "Tuesday")
 :    => map:with("We", "Wednesday")
 :    => map:with("Th", "Thursday")
 :    => map:with("Fr", "Friday")
 :    => map:with("Sa", "Saturday")

 :
 : The map:with function is otherwise equivalent to using the
 : map:put function.
 :)
declare %a:since("marklogic", "9.0") function map:with($map as map:map, $key as xs:string, $value as item()*) as map:map external;

xquery version "1.0-ml";
(:~
 : MarkLogic map functions
 :
 : @see https://docs.marklogic.com/map
 :)
module namespace map = "http://marklogic.com/xdmp/map";

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

declare option o:requires "marklogic/5.0";

declare %a:since("marklogic", "5.0") function map:clear($map as map:map) as empty-sequence() external;
declare %a:since("marklogic", "6.0") function map:contains($map as map:map, $key as xs:string) as xs:boolean external;
declare %a:since("marklogic", "5.0") function map:count($map as map:map) as xs:unsignedInt external;
declare %a:since("marklogic", "5.0") function map:delete($map as map:map, $key as xs:string) as empty-sequence() external;
declare %a:since("marklogic", "7.0") function map:entry($key as xs:string, $value as item()*) as map:map external;
declare %a:since("marklogic", "5.0") function map:get($map as map:map, $key as xs:string) as item()* external;
declare %a:since("marklogic", "5.0") function map:keys($map as map:map) as xs:string* external;
declare %a:since("marklogic", "5.0") function map:map() as map:map external;
declare %a:since("marklogic", "5.0") function map:map($map as element(map:map)) as map:map external;
declare %a:since("marklogic", "7.0") function map:new() as map:map external;
declare %a:since("marklogic", "7.0") function map:new($map as element(map:map)) as map:map external;
declare %a:since("marklogic", "5.0") function map:put($map as map:map, $key as xs:string, $value as item()*) as empty-sequence() external;
declare %a:since("marklogic", "9.0") function map:set-javascript-by-ref($map as map:map, $key as xs:boolean) as empty-sequence() external;
declare %a:since("marklogic", "9.0") function map:with($map as map:map, $key as xs:string, $value as item()*) as map:map external;


changed URL structure for adapter so that they leave under careServicesRequest/URN/adapater/fhir

module namespace page = 'http://basex.org/modules/web-page';

(:Import other namespaces.  :)
import module namespace csd_webconf =  "https://github.com/openhie/openinfoman/csd_webconf";
import module namespace csr_proc = "https://github.com/openhie/openinfoman/csr_proc";
import module namespace csd_dm = "https://github.com/openhie/openinfoman/csd_dm";
import module namespace fadpt = "https://github.com/openhie/openinfoman/adapter/fhir";
import module namespace request = "http://exquery.org/ns/request";

declare namespace xs = "http://www.w3.org/2001/XMLSchema";
declare namespace csd = "urn:ihe:iti:csd:2013";
declare namespace   xforms = "http://www.w3.org/2002/xforms";
declare namespace fhir = "http://hl7.org/fhir";

declare
  %rest:path("/CSD/csr/{$doc_name}/careServicesRequest/{$search_name}/adapter/fhir")
  %output:method("xhtml")
  function page:show_endpoints($search_name,$doc_name)
{
  let $function := csr_proc:get_function_definition($csd_webconf:db,$search_name)
  let $read :=  ($function/csd:extension[@urn='urn:openhie.org:openinfoman:adapter:fhir:read' ])[1]
  let $entity := string($read/@type)
  let $base_url := concat($csd_webconf:baseurl, "CSD/csr/",$doc_name ,"/careServicesRequest/",$search_name, "/adapter/fhir/", $entity)
  let $doc := csd_dm:open_document($csd_webconf:db,$doc_name)
  let $org_opts :=
    for $org in $doc/csd:CSD/csd:organizationDirectory/csd:organization
    return <option value="{$org/@urn}">{($org/csd:primaryName[1])/text()}</option>
  let $fac_opts :=
    for $fac in $doc/csd:CSD/csd:facilityDirectory/csd:facility
    return <option value="{$fac/@urn}">{($fac/csd:primaryName[1])/text()}</option>

  return
    if (not(fadpt:is_fhir_function($search_name)) or not($read)  )
      (:not a read practitioner query. should 404 or whatever is required by FHIR :)
    then ('Not a FHIR Compatible stored function'    )
    else
      let $headers :=
	(
	<link rel="stylesheet" type="text/css" media="screen"   href="{$csd_webconf:baseurl}static/bootstrap-datetimepicker/css/bootstrap-datetimepicker.min.css"/>
	,
	 )

      let $contents :=

{$entity} in {$doc_name}

Resource Endpoint:
{$base_url}

	    Search
	     XML
	    / JSON

Query by entity details

	    <form method='get' action="{$base_url}/_search">
	      Common Name
	      <input  size="35"    name='name.text' type="text" value=""/>

	      Format
	      <select name="_format">
	        <option value="xml">XML</option>
	        <option value="json">JSON</option>
	      </select>

	      Organization
	      <select name="organization.reference">
	        <option value="">Select A Value</option>
		{$org_opts}
	      </select>

	      Facility
	      <select name="location.reference">
	        <option value="">Select A Value</option>
		{$fac_opts}
	      </select>

	      <input type='submit' />
	    </form>

	    History
	     XML
	    / JSON

Query by last modified time

	    <form method='get' action="{$base_url}/_history">
	      Format
	      <select name="_format">
	        <option value="xml">XML</option>
	        <option value="json">JSON</option>
	      </select>

	      Updated
	      <input  size="35" id="datetimepicker_xml"    name='_since' type="text" value=""/>

	      <input type='submit' />
	    </form>

      return csd_webconf:wrapper($contents,$headers)
};

declare
  %rest:path("/CSD/csr/{$doc_name}/careServicesRequest/{$search_name}/adapter/fhir/{$entityType}/{$id}")
  %rest:query-param("_format","{$format}","application/xml+fhir")
  function page:read_entity($search_name,$doc_name,$entityType,$format,$id)
{

  let $function := csr_proc:get_function_definition($csd_webconf:db,$search_name)
  let $fEntityType :=   string(($function/csd:extension[@urn='urn:openhie.org:openinfoman:adapter:fhir:read' ])[1]/@type)
  return
    if (not(fadpt:is_fhir_function($search_name)) or not($fEntityType = $entityType))
    (:not a valid read query. should 404 or whatever is required by FHIR :)
  then ()
  else
    let $doc := csd_dm:open_document($csd_webconf:db,$doc_name)
    let $careServicesRequest :=
      <csd:careServicesRequest >
	<csd:function urn="{$search_name}" resource="{$doc_name}" base_url="{$csd_webconf:baseurl}">
	  <csd:requestParams >
	    <id>{$id}</id>
	  </csd:requestParams>
	</csd:function>
      </csd:careServicesRequest>
    let $entities := (csr_proc:process_CSR_stored_results($csd_webconf:db, $doc,$careServicesRequest))[1] (:make sure there is only one:)
    let $resource := fadpt:format_entities($doc,$entities,$entityType,$format)
    return
      if ($format = ('application/json+fhir' ,  'application/json' ,'json'))
      then
        (
        <rest:response>
	  <output:serialization-parameters>
	    <output:media-type value='application/json'/>
	  </output:serialization-parameters>
	</rest:response>
	,$resource
        )
      else
	$resource
};

declare
  %rest:path("/CSD/csr/{$doc_name}/careServicesRequest/{$search_name}/adapter/fhir/{$entityType}/_search")
  %rest:query-param("_format","{$format}","application/xml+fhir")
  function page:search_entity2($search_name,$doc_name,$entityType,$format)
{
  page:search_entity($search_name,$doc_name,$entityType,$format)
};

declare
  %rest:path("/CSD/csr/{$doc_name}/careServicesRequest/{$search_name}/adapter/fhir/{$entityType}")
  %rest:query-param("_format","{$format}","application/xml+fhir")
  function page:search_entity($search_name,$doc_name,$entityType,$format)
{
  let $function := csr_proc:get_function_definition($csd_webconf:db,$search_name)
  let $fEntityType :=   string(($function/csd:extension[@urn='urn:openhie.org:openinfoman:adapter:fhir:read' ])[1]/@type)
  return
    if (not(fadpt:is_fhir_function($search_name)) or not($fEntityType = $entityType))
    (:not a valid read query. should 404 or whatever is required by FHIR :)
  then ()
  else
    let $doc := csd_dm:open_document($csd_webconf:db,$doc_name)
    let $requestParams :=
      <csd:function urn="{$search_name}" resource="{$doc_name}" base_url="{$csd_webconf:baseurl}">
	<csd:requestParams >
	  {page:search_global_parameters() }
	  {
	    switch ($entityType)
	    case "Practitioner" return  page:search_practitioner_parameters()
	    case "Location" return () (: page:search_location_parameters() :)
	    case "Organization" return () (: page:search_organization_parameters() :)
	    default return ()
	  }
	</csd:requestParams>
      </csd:function>

    let $careServicesRequest :=   <csd:careServicesRequest >{$requestParams}</csd:careServicesRequest>
    let $entities := (csr_proc:process_CSR_stored_results($csd_webconf:db, $doc,$careServicesRequest))
    let $resources := fadpt:format_entities($doc,$entities,$entityType,$format)
    return
      if ($format = ('application/json+fhir' ,  'application/json' ,'json'))
      then fadpt:create_feed_from_entities_JSON($resources,$requestParams)
      else fadpt:create_feed_from_entities($resources,$requestParams)
};

declare
  %rest:path("/CSD/csr/{$doc_name}/careServicesRequest/{$search_name}/adapter/fhir/{$entityType}/_history")
  %rest:query-param("_format","{$format}","application/xml+fhir")
  function page:history_entity($search_name,$doc_name,$entityType,$format)
{
  let $function := csr_proc:get_function_definition($csd_webconf:db,$search_name)
  let $fEntityType :=   string(($function/csd:extension[@urn='urn:openhie.org:openinfoman:adapter:fhir:read' ])[1]/@type)
  return
    if (not(fadpt:is_fhir_function($search_name)) or not($fEntityType = $entityType))
    (:not a valid read query. should 404 or whatever is required by FHIR :)
  then ()
  else
    let $doc := csd_dm:open_document($csd_webconf:db,$doc_name)
    let $requestParams :=
      <csd:function urn="{$search_name}" resource="{$doc_name}" base_url="{$csd_webconf:baseurl}">
	<csd:requestParams >
	  {page:history_global_parameters() }
	</csd:requestParams>
      </csd:function>

    let $careServicesRequest :=   <csd:careServicesRequest >{$requestParams}</csd:careServicesRequest>
    let $entities := (csr_proc:process_CSR_stored_results($csd_webconf:db, $doc,$careServicesRequest))
    let $resources := fadpt:format_entities($doc,$entities,$entityType,$format)
    return
      if ($format = ('application/json+fhir' ,  'application/json' ,'json'))
      then fadpt:create_feed_from_entities_JSON($resources,$requestParams)
      else fadpt:create_feed_from_entities($resources,$requestParams)

};

declare function page:search_global_parameters()
{
  let $params := request:parameter-names()
  return
    (
      if ("_id" = $params)
      then <fhir:_id>{request:parameter("_id")}</fhir:_id>
      else ()
      ,
      if ("_count" = $params)
      then <fhir:_count>{request:parameter("_count")}</fhir:_count>
      else ()
      ,
      if ("page" = $params)
      then <page>{request:parameter("_pageOffset")}</page>
      else ()
    )
};

declare function page:search_practitioner_parameters(){
  let $params := request:parameter-names()
  return
    (
      if ("name.text" = $params)
      then <fhir:name><fhir:text>{request:parameter("name.text")}</fhir:text></fhir:name>
      else (),
      if ("organization.reference" = $params)
      then <fhir:organization value="{request:parameter('organization.reference')}"/>
      else (),
      if ("location.reference" = $params)
      then <fhir:location value="{request:parameter('location.reference')}"/>
      else ()

  )

};

declare function page:history_global_parameters()
{
  let $params := request:parameter-names()
  return
    (
      if ("_since" = $params)
      then <fhir:_since>{request:parameter("_since")}</fhir:_since>
      else ()
      ,
      if ("_count" = $params)
      then <fhir:_count>{request:parameter("_count")}</fhir:_count>
      else ()
      ,
      if ("page" = $params)
      then <page>{request:parameter("_pageOffset")}</page>
      else ()
    )
};

module namespace page = 'http://basex.org/modules/web-page';

(:Import other namespaces.  :)
import module namespace csd_webconf =  "https://github.com/openhie/openinfoman/csd_webconf";
import module namespace csr_proc = "https://github.com/openhie/openinfoman/csr_proc";
import module namespace csd_dm = "https://github.com/openhie/openinfoman/csd_dm";
import module namespace fadpt = "https://github.com/openhie/openinfoman/adapter/fhir";
import module namespace request = "http://exquery.org/ns/request";

declare namespace xs = "http://www.w3.org/2001/XMLSchema";
declare namespace csd = "urn:ihe:iti:csd:2013";
declare namespace   xforms = "http://www.w3.org/2002/xforms";
declare namespace fhir = "http://hl7.org/fhir";

declare
  %rest:path("/CSD/adapter/fhir/{$search_name}")
  %output:method("xhtml")
  function page:show_endpoints($search_name)
{
  let $function := csr_proc:get_function_definition($csd_webconf:db,$search_name)
  let $extensions :=   $function/csd:extension[@urn='urn:openhie.org:openinfoman:adapter' and  @type='fhir']
  return
    if (not(fadpt:is_fhir_function($search_name)))
      (:not a read fhir entity query. should 404 or whatever is required by FHIR :)
    then ('Not a FHIR Compatible stored functions' )
    else
      let
	$contents :=

FHIR Documents

              {
  		for $doc_name in csd_dm:registered_documents($csd_webconf:db)
		return

		  {string($doc_name)}

	      }

       return csd_webconf:wrapper($contents)

};

declare
  %rest:path("/CSD/adapter/fhir/{$search_name}/{$doc_name}")
  %output:method("xhtml")
  function page:show_endpoints($search_name,$doc_name)
{
  let $function := csr_proc:get_function_definition($csd_webconf:db,$search_name)
  let $read :=  ($function/csd:extension[@urn='urn:openhie.org:openinfoman:adapter:fhir:read' ])[1]
  let $entity := string($read/@type)
  let $base_url := concat($csd_webconf:baseurl, "CSD/adapter/fhir/",$search_name, "/", $doc_name, "/", $entity)
  let $doc := csd_dm:open_document($csd_webconf:db,$doc_name)
  let $org_opts :=
    for $org in $doc/csd:CSD/csd:organizationDirectory/csd:organization
    return <option value="{$org/@urn}">{($org/csd:primaryName[1])/text()}</option>
  let $fac_opts :=
    for $fac in $doc/csd:CSD/csd:facilityDirectory/csd:facility
    return <option value="{$fac/@urn}">{($fac/csd:primaryName[1])/text()}</option>

  return
    if (not(fadpt:is_fhir_function($search_name)) or not($read)  )
      (:not a read practitioner query. should 404 or whatever is required by FHIR :)
    then ('Not a FHIR Compatible stored function'    )
    else
      let $headers :=
	(
	<link rel="stylesheet" type="text/css" media="screen"   href="{$csd_webconf:baseurl}static/bootstrap-datetimepicker/css/bootstrap-datetimepicker.min.css"/>
	,
	 )

      let $contents :=

{$entity} in {$doc_name}

Resource Endpoint:
{$base_url}

	    Search
	     XML
	    / JSON

Query by entity details

	    <form method='get' action="{$base_url}/_search">
	      Common Name
	      <input  size="35"    name='name.text' type="text" value=""/>

	      Format
	      <select name="_format">
	        <option value="xml">XML</option>
	        <option value="json">JSON</option>
	      </select>

	      Organization
	      <select name="organization.reference">
	        <option value="">Select A Value</option>
		{$org_opts}
	      </select>

	      Facility
	      <select name="location.reference">
	        <option value="">Select A Value</option>
		{$fac_opts}
	      </select>

	      <input type='submit' />
	    </form>

	    History
	     XML
	    / JSON

Query by last modified time

	    <form method='get' action="{$base_url}/_history">
	      Format
	      <select name="_format">
	        <option value="xml">XML</option>
	        <option value="json">JSON</option>
	      </select>

	      Updated
	      <input  size="35" id="datetimepicker_xml"    name='_since' type="text" value=""/>

	      <input type='submit' />
	    </form>

      return csd_webconf:wrapper($contents,$headers)
};

declare
  %rest:path("/CSD/adapter/fhir/{$search_name}/{$doc_name}/{$entityType}/{$id}")
  %rest:query-param("_format","{$format}","application/xml+fhir")
  function page:read_entity($search_name,$doc_name,$entityType,$format,$id)
{

  let $function := csr_proc:get_function_definition($csd_webconf:db,$search_name)
  let $fEntityType :=   string(($function/csd:extension[@urn='urn:openhie.org:openinfoman:adapter:fhir:read' ])[1]/@type)
  return
    if (not(fadpt:is_fhir_function($search_name)) or not($fEntityType = $entityType))
    (:not a valid read query. should 404 or whatever is required by FHIR :)
  then ()
  else
    let $doc := csd_dm:open_document($csd_webconf:db,$doc_name)
    let $careServicesRequest :=
      <csd:careServicesRequest >
	<csd:function urn="{$search_name}" resource="{$doc_name}" base_url="{$csd_webconf:baseurl}">
	  <csd:requestParams >
	    <id>{$id}</id>
	  </csd:requestParams>
	</csd:function>
      </csd:careServicesRequest>
    let $entities := (csr_proc:process_CSR_stored_results($csd_webconf:db, $doc,$careServicesRequest))[1] (:make sure there is only one:)
    let $resource := fadpt:format_entities($doc,$entities,$entityType,$format)
    return
      if ($format = ('application/json+fhir' ,  'application/json' ,'json'))
      then
        (
        <rest:response>
	  <output:serialization-parameters>
	    <output:media-type value='application/json'/>
	  </output:serialization-parameters>
	</rest:response>
	,$resource
        )
      else
	$resource
};

declare
  %rest:path("/CSD/adapter/fhir/{$search_name}/{$doc_name}/{$entityType}/_search")
  %rest:query-param("_format","{$format}","application/xml+fhir")
  function page:search_entity2($search_name,$doc_name,$entityType,$format)
{
  page:search_entity($search_name,$doc_name,$entityType,$format)
};

declare
  %rest:path("/CSD/adapter/fhir/{$search_name}/{$doc_name}/{$entityType}")
  %rest:query-param("_format","{$format}","application/xml+fhir")
  function page:search_entity($search_name,$doc_name,$entityType,$format)
{
  let $function := csr_proc:get_function_definition($csd_webconf:db,$search_name)
  let $fEntityType :=   string(($function/csd:extension[@urn='urn:openhie.org:openinfoman:adapter:fhir:read' ])[1]/@type)
  return
    if (not(fadpt:is_fhir_function($search_name)) or not($fEntityType = $entityType))
    (:not a valid read query. should 404 or whatever is required by FHIR :)
  then ()
  else
    let $doc := csd_dm:open_document($csd_webconf:db,$doc_name)
    let $requestParams :=
      <csd:function urn="{$search_name}" resource="{$doc_name}" base_url="{$csd_webconf:baseurl}">
	<csd:requestParams >
	  {page:search_global_parameters() }
	  {
	    switch ($entityType)
	    case "Practitioner" return  page:search_practitioner_parameters()
	    case "Location" return () (: page:search_location_parameters() :)
	    case "Organization" return () (: page:search_organization_parameters() :)
	    default return ()
	  }
	</csd:requestParams>
      </csd:function>

    let $careServicesRequest :=   <csd:careServicesRequest >{$requestParams}</csd:careServicesRequest>
    let $entities := (csr_proc:process_CSR_stored_results($csd_webconf:db, $doc,$careServicesRequest))
    let $resources := fadpt:format_entities($doc,$entities,$entityType,$format)
    return
      if ($format = ('application/json+fhir' ,  'application/json' ,'json'))
      then fadpt:create_feed_from_entities_JSON($resources,$requestParams)
      else fadpt:create_feed_from_entities($resources,$requestParams)
};

declare
  %rest:path("/CSD/adapter/fhir/{$search_name}/{$doc_name}/{$entityType}/_history")
  %rest:query-param("_format","{$format}","application/xml+fhir")
  function page:history_entity($search_name,$doc_name,$entityType,$format)
{
  let $function := csr_proc:get_function_definition($csd_webconf:db,$search_name)
  let $fEntityType :=   string(($function/csd:extension[@urn='urn:openhie.org:openinfoman:adapter:fhir:read' ])[1]/@type)
  return
    if (not(fadpt:is_fhir_function($search_name)) or not($fEntityType = $entityType))
    (:not a valid read query. should 404 or whatever is required by FHIR :)
  then ()
  else
    let $doc := csd_dm:open_document($csd_webconf:db,$doc_name)
    let $requestParams :=
      <csd:function urn="{$search_name}" resource="{$doc_name}" base_url="{$csd_webconf:baseurl}">
	<csd:requestParams >
	  {page:history_global_parameters() }
	</csd:requestParams>
      </csd:function>

    let $careServicesRequest :=   <csd:careServicesRequest >{$requestParams}</csd:careServicesRequest>
    let $entities := (csr_proc:process_CSR_stored_results($csd_webconf:db, $doc,$careServicesRequest))
    let $resources := fadpt:format_entities($doc,$entities,$entityType,$format)
    return
      if ($format = ('application/json+fhir' ,  'application/json' ,'json'))
      then fadpt:create_feed_from_entities_JSON($resources,$requestParams)
      else fadpt:create_feed_from_entities($resources,$requestParams)

};

declare function page:search_global_parameters()
{
  let $params := request:parameter-names()
  return
    (
      if ("_id" = $params)
      then <fhir:_id>{request:parameter("_id")}</fhir:_id>
      else ()
      ,
      if ("_count" = $params)
      then <fhir:_count>{request:parameter("_count")}</fhir:_count>
      else ()
      ,
      if ("page" = $params)
      then <page>{request:parameter("_pageOffset")}</page>
      else ()
    )
};

declare function page:search_practitioner_parameters(){
  let $params := request:parameter-names()
  return
    (
      if ("name.text" = $params)
      then <fhir:name><fhir:text>{request:parameter("name.text")}</fhir:text></fhir:name>
      else (),
      if ("organization.reference" = $params)
      then <fhir:organization value="{request:parameter('organization.reference')}"/>
      else (),
      if ("location.reference" = $params)
      then <fhir:location value="{request:parameter('location.reference')}"/>
      else ()

  )

};

declare function page:history_global_parameters()
{
  let $params := request:parameter-names()
  return
    (
      if ("_since" = $params)
      then <fhir:_since>{request:parameter("_since")}</fhir:_since>
      else ()
      ,
      if ("_count" = $params)
      then <fhir:_count>{request:parameter("_count")}</fhir:_count>
      else ()
      ,
      if ("page" = $params)
      then <page>{request:parameter("_pageOffset")}</page>
      else ()
    )
};


-- prettified the module code and the layout of the backup information :)

module namespace admin = 'http://monetdb.cwi.nl/XQuery/admin/';

(: ADMIN MODULE, by Peter Boncz (boncz@cwi.nl)
 :
 : - makes administrative functionality available over SOAP
 : - standard part of the MonetDB/XQuery distribution
 : - can only be called from IPs listed in xrpc_admin (MonetDB.conf option)
 :)

declare namespace pf = 'http://www.pathfinder-xquery.org/';

(: =================== document management =================== :)

declare function admin:collections()
{ pf:collections-unsafe() };

declare function admin:documents()
{ pf:documents-unsafe() };

declare function admin:documents($collection as xs:string)
{ pf:documents-unsafe($collection) };

declare document management function admin:add-doc($uri as xs:string, $document as xs:string, $collection as xs:string, $percentage as xs:integer)
{ pf:add-doc($uri, $document, $collection, $percentage) };

declare document management function admin:del-doc($document as xs:string)
{ pf:del-doc($document) };

declare document management function admin:del-col($collection as xs:string)
{ let $docs := pf:documents-unsafe($collection)
  return if (count($docs) = 0)
    then error("collection not found")
    else for $document in $docs
         return pf:del-doc($document)
};

(: =================== backup & restore =================== :)

declare updating function admin:backup-col($collection as xs:string, $bakname as xs:string)
{
  let $path  := concat('backup/', $bakname, '/', $collection, '/')
  let $index :=
   element documents {
     for $document at $pos in pf:documents($collection)
     let $uri := concat($path, string(10000 + (($pos div 10000)) cast as xs:integer), '/',  string($pos) , '.xml')
     return (text { "
  " }, element document { attribute uri {$uri}, $document/text() }),
     text { "
" } }
  return
   (put($index, concat($path,'documents.xml')),
    for $document in $index/document
    return put(exactly-one(doc(string($document))), exactly-one($document/@uri)))
};

declare updating function admin:backup($bakname as xs:string)
{
  let $path  := concat('backup/', $bakname, '/')
  let $index :=
    element collections {
      for $collection in pf:collections()
      return (text { "
  " }, element collection { attribute updatable {$collection/@updatable}, $collection/text() }),
      text { "
" } }
  return
    (put($index, concat($path,'collections.xml')),
     for $collection in pf:collections()
     return admin:backup-col($collection, $bakname))
};

declare document management function admin:restore-col($collection as xs:string, $bakname as xs:string, $percentage as xs:integer)
{
  for $document in doc(concat('backup/', $bakname, '/', $collection, '/documents.xml'))//document
  return pf:add-doc(exactly-one($document/@uri), exactly-one($document/text()), $collection, $percentage)
};

declare document management function
admin:restore($bakname as xs:string, $percentage as xs:integer)
{
  for $collection in doc(concat('backup/', $bakname, '/collections.xml'))//collection
  let $perc := if ($collection/@updatable = 'true') then $percentage else 0
  return admin:restore-col(exactly-one($collection/text()), $bakname, $perc)
};

(: =================== server management =================== :)

declare function admin:db-stats()
{ pf:mil('lock_set(pf_short); var ret := bat(str,str); var tot := 0LL; colname_runtime@batloop() tot :+= sum([batsize]($t)); ret.insert("xquery_index_curMB", str(tot/1048576LL)); tot := doc_timestamp.select(timestamp_nil,timestamp_nil).reverse(); ret.insert("xquery_cache_curdocs", str(count(tot))); tot := tot.join(doc_collection).tunique().reverse().join(collection_size).sum(); ret.insert("xquery_cache_curMB", str(tot/1048576LL)); ret.insert("xquery_log_curMB", str((logger_changes(pf_logger) - logger_base)/131072)); ret.insert("gdk_vm_cursize", str(vm_cursize())); ret.insert("gdk_mem_cursize", str(mem_cursize())); lock_unset(pf_short); return ret;') };

declare function admin:db-env()
{ pf:mil('return environment().access(BAT_WRITE).delete("exec_prefix").delete("prefix").delete("gdk_debug").delete("gdk_embedded").delete("gdk_vm_minsize").delete("mapi_debug").delete("mapi_noheaders").delete("monet_daemon").delete("monet_mod_path").delete("monet_pid").delete("monet_prompt").delete("monet_welcome").delete("sql_debug").delete("sql_logdir").insert("gdk_mem_maxsize", str(mem_maxsize())).sort();') };

declare function admin:db-restart()
{ pf:mil('fork({ sleep(5); exit();}); return "Mserver will restart in 5 seconds..";') };

(: =================== HTTP =================== :)

declare function admin:GET($uri as xs:string)
{ doc($uri) };

declare updating function admin:PUT($uri as xs:string, $doc as element())
{
  if (substring($uri, 1,4) = 'tmp/')
  then put($doc, $uri)
  else error('PUT: only relative URIs starting with tmp/ allowed')
};

declare document management function admin:DELETE($uri as xs:string)
{
  if (substring($uri, 1,4) = 'tmp/')
  then pf:del-doc($uri)
  else error('DELETE: only relative URIs starting with tmp/ allowed')
};

module namespace admin = 'http://monetdb.cwi.nl/XQuery/admin/';

(: ADMIN MODULE, by Peter Boncz (boncz@cwi.nl)
 :
 : - makes administrative functionality available over SOAP
 : - standard part of the MonetDB/XQuery distribution
 : - can only be called from IPs listed in xrpc_admin (MonetDB.conf option)
 :)

declare namespace pf = 'http://www.pathfinder-xquery.org/';

(: =================== document management =================== :)

declare function admin:collections()
{ pf:collections-unsafe() };

declare function admin:documents()
{ pf:documents-unsafe() };

declare function admin:documents($collection as xs:string)
{ pf:documents-unsafe($collection) };

declare document management function admin:add-doc($uri as xs:string, $document as xs:string, $collection as xs:string, $percentage as xs:integer)
{ pf:add-doc($uri, $document, $collection, $percentage) };

declare document management function admin:del-doc($document as xs:string)
{ pf:del-doc($document) };

declare document management function admin:del-col($collection as xs:string)
{ let $docs := pf:documents-unsafe($collection)
  return if (count($docs) = 0)
    then error("collection not found")
    else for $document in $docs
         return pf:del-doc($document)
};

(: =================== backup & restore =================== :)

declare updating function admin:backup-col($collection as xs:string, $bakname as xs:string)
{
  let $path  := concat('backup/', $bakname, '/', $collection, '/')
  let $index :=
   element documents { text { "
"},  for $document at $pos in pf:documents($collection)
     let $uri := concat($path, string(10000 + (($pos div 10000)) cast as xs:integer), '/',  string($pos) , '.xml')
     return (element document { attribute uri {$uri}, $document/text() }, text {"
"})}
  return
   (put($index, concat($path,'documents.xml')),
    for $document in $index/document
    return put(exactly-one(doc(string($document))), exactly-one($document/@uri)))
};

declare updating function admin:backup($bakname as xs:string)
{
  let $path  := concat('backup/', $bakname, '/')
  let $index :=
    element collections { text { "
"},   for $collection in pf:collections()
      return (element collection { attribute updatable {$collection/@updatable}, $collection/text() }, text {"
"})}
  return
    (put($index, concat($path,'collections.xml')),
     for $collection in pf:collections()
     return admin:backup-col($collection, $bakname))
};

declare document management function admin:restore-col($collection as xs:string, $bakname as xs:string, $percentage as xs:integer)
{
  for $document in doc(concat('backup/', $bakname, '/', $collection, '/documents.xml'))//document
  return pf:add-doc(exactly-one($document/@uri), exactly-one($document/text()), $collection, $percentage)
};

declare document management function
admin:restore($bakname as xs:string, $percentage as xs:integer)
{
  for $collection in doc(concat('backup/', $bakname, '/collections.xml'))//collection
  let $perc := if ($collection/@updatable = 'true') then $percentage else 0
  return admin:restore-col(exactly-one($collection/text()), $bakname, $perc)
};

(: =================== server management =================== :)

declare function admin:db-stats()
{ pf:mil('lock_set(pf_short); var ret := bat(str,str); var tot := 0LL; colname_runtime@batloop() tot :+= sum([batsize]($t)); ret.insert("xquery_index_curMB", str(tot/1048576LL)); tot := doc_timestamp.select(timestamp_nil,timestamp_nil).reverse(); ret.insert("xquery_cache_curdocs", str(count(tot))); tot := tot.join(doc_collection).tunique().reverse().join(collection_size).sum(); ret.insert("xquery_cache_curMB", str(tot/1048576LL)); ret.insert("xquery_log_curMB", str((logger_changes(pf_logger) - logger_base)/131072)); ret.insert("gdk_vm_cursize", str(vm_cursize())); ret.insert("gdk_mem_cursize", str(mem_cursize())); lock_unset(pf_short); return ret;') };

declare function admin:db-env()
{ pf:mil('return environment().access(BAT_WRITE).delete("exec_prefix").delete("prefix").delete("gdk_debug").delete("gdk_embedded").delete("gdk_vm_minsize").delete("mapi_debug").delete("mapi_noheaders").delete("monet_daemon").delete("monet_mod_path").delete("monet_pid").delete("monet_prompt").delete("monet_welcome").delete("sql_debug").delete("sql_logdir").insert("gdk_mem_maxsize", str(mem_maxsize())).sort();') };

declare function admin:db-restart()
{ pf:mil('fork({ sleep(5); exit();}); return "Mserver will restart in 5 seconds..";') };

(: =================== HTTP =================== :)

declare function admin:GET($uri as xs:string)
{ doc($uri) };

declare updating function admin:PUT($uri as xs:string, $doc as element())
{
  if (substring($uri, 1,4) = 'tmp/')
  then put($doc, $uri)
  else error('PUT: only relative URIs starting with tmp/ allowed')
};

declare document management function admin:DELETE($uri as xs:string)
{
  if (substring($uri, 1,4) = 'tmp/')
  then pf:del-doc($uri)
  else error('DELETE: only relative URIs starting with tmp/ allowed')
};