adapt reading config, update call to testing-module function signature changed

xquery version "1.0";
module namespace fcs-tests  = "http://clarin.eu/fcs/1.0/tests";

import module namespace httpclient = "http://exist-db.org/xquery/httpclient";
import module namespace t="http://exist-db.org/xquery/testing";
import module namespace repo-utils = "http://aac.ac.at/content_repository/utils" at  "/db/cr/repo-utils.xqm";

declare namespace zr="http://explain.z3950.org/dtd/2.1/";
declare namespace sru = "http://www.loc.gov/zing/srw/";
declare namespace fcs = "http://clarin.eu/fcs/1.0";
declare namespace diag = "http://www.loc.gov/zing/srw/diagnostic/";
declare namespace xhtml="http://www.w3.org/1999/xhtml";

(: sample input:

 :)
declare variable $fcs-tests:config := doc("config.xml");
declare variable $fcs-tests:cr-config := repo-utils:config("/db/cr/conf/cr/config.xml");
declare variable $fcs-tests:run-config := "run-config.xml";
declare variable $fcs-tests:testsets-coll := "/db/cr/modules/testing/testsets/";
declare variable $fcs-tests:results-coll := "/db/cr/modules/testing/results/";
declare variable $fcs-tests:href-prefix := "tests.xql";

(: this function is accessed by the testing-code to get configuration-options from the run-config :)
declare function fcs-tests:config-value($key as xs:string) as xs:string* {
            let $config := doc(concat($fcs-tests:testsets-coll, $fcs-tests:run-config))/config
                return if ($key eq "testset") then  xs:string($config//testset/@key)
                        else $config//target/text()
};

declare function fcs-tests:config-key($key as xs:string) as xs:string* {
            let $config := doc(concat($fcs-tests:testsets-coll, $fcs-tests:run-config))/config
                return if ($key eq "testset") then  xs:string($config//testset/@key)
                        else xs:string($config//target/@key)
};

declare function fcs-tests:get-result-paths($target  as xs:string, $testset as xs:string) as xs:string* {
        (concat($fcs-tests:results-coll, $target, "/"), concat($testset, ".xml"))
};

declare function fcs-tests:get-result-path($target  as xs:string, $testset as xs:string) as xs:string* {
        string-join(fcs-tests:get-result-paths($target , $testset ), "" )
};

declare function fcs-tests:get-result($target  as xs:string, $testset as xs:string) as item() {
  let $result-path := fcs-tests:get-result-path($target, $testset)
   let $result := if ($target = '' or $testset = '') then ()
                            else if (doc-available($result-path)) then
                            doc($result-path)
                        else <diagnostics><diagnostic key="result-unavailable">result unavailable: {$result-path}</diagnostic>
                                <diagnostic>{fcs-tests:get-testset($testset)}</diagnostic>
                              </diagnostics>
 return $result
};

(:~ try to get the testset-file based on the testset-key
@returns testset-file if available, otherwise empty result
:)
declare function fcs-tests:get-testset($testset as xs:string) as item()* {
    let $testset-path := concat($fcs-tests:testsets-coll, $testset, ".xml")
    return if (doc-available($testset-path)) then
                    doc($testset-path)
                  else
                  <diagnostic>unknown testset: {$testset}</diagnostic>
};

(:~ main function governing the execution of the tests

Generates a run-config out of the full config based on the parameters.
@param $target identifying key of the target  as set in the config
@param $testset-key identifying key of the testset as set in the config (that also has to be the name of the testset-file)
:)
declare function fcs-tests:run-testset($target  as xs:string, $testset-key as xs:string) as item()* {

    (: preparing a configuration for given run, based on the parameters :)
    let $run-config := <config>{($fcs-tests:config//target[xs:string(@key) = $target],
                                $fcs-tests:config//testset[xs:string(@key) = $testset-key])}</config>
    let $store := repo-utils:store($fcs-tests:testsets-coll, $fcs-tests:run-config, $run-config, true())
    let $testset := fcs-tests:get-testset($testset-key)
    let $start-time := util:system-dateTime()
    let $result := if (exists($testset)) then
                            let $tests := $testset//TestSet
                            (: distinguish the testset, that the testing-module can process
                               and the home-made test-doc, that tests URLs :)
                            return if (exists($tests)) then
                                        t:run-testSet($tests, ())
                                     else
                                        fcs-tests:test-rest($testset)
                       else
                           $testset
    let $end-time := util:system-dateTime()
    let $test-wrap := <testrun duration="{$end-time - $start-time}" on="{fn:current-dateTime()}" >{$result}</testrun>
    let $store-result := fcs-tests:store-result($target, $testset-key, $test-wrap)
    (:for $test in $tests/tests/test return fcs-tests:run-test($test):)
    return $store-result
};

(:~ process a test-doc (target is expected to be set in the config)
:)
declare function fcs-tests:test-rest($test-doc as node()) as item()* {

    let $result := local:dispatch($test-doc)

(:
let $targets := if (exists($test/target)) then $test/target else $test/preceding-sibling::target
let $requests := for $target in $targets return concat($target, $test/request/text())
let $data := for $request in $requests return
                <request href="{$request}" id
                httpclient:get(xs:anyURI($request), false(), () )

let $check := for $condition in $test/condition
                        let $expr :=concat("($data/", $condition/text(), " eq ", xs:string($condition/@result), ")")
                         return <check expr="{$expr}" >{util:eval($expr)} </check>
return <test><id>{$test/id}</id>{$test/label}
            <requests>{$requests}</requests>
            <results>{$check}</results>
        </test>
:)
return $result

};

(:~ This function takes the children of the node and passes them
   back into the typeswitch function. :)
declare function local:passthru($x as node()) as node()*
{
for $z in $x/node() return local:dispatch($z)
};

(:~ This is the recursive typeswitch function, to traverse the testset-document :)
declare function local:dispatch($x as node()) as node()*
{
typeswitch ($x)
  case text() return $x
  case element (test) return element div {$x/@*, attribute class {"test"}, fcs-tests:process-request($x)}
  case element() return element {$x/name()} {$x/@*, local:passthru($x)}
  default return local:passthru($x)
};

(:~ executes one URL-test.

Issues one http-call to the target-url in the a@href-attribute, stores the incoming result and evaluates the associated xpaths

expects:

      search: Haus
      //sru:numberOfRecords

@returns the requested-url, results of the xpath-evaluations as a div-list and any diagnostics
:)
declare function fcs-tests:process-request($test as node()) as item()* {

    let $a := $test/a,
        $test-id := xs:string($test/@id),
        $target := fcs-tests:config-value("target"),
        $target-key := fcs-tests:config-key("target"),
        $request := concat($target, xs:string($a/@href))
    let $a-processed := {$a/text()}
    let $result-data := httpclient:get(xs:anyURI($request), false(), () )

    let $store := fcs-tests:store-result($target-key, $test-id, $result-data)

    (: evaluate all xpaths defined for given request :)
    let $check := for $xpath in $test/xpath
                    let $evald := util:eval($xpath/text())

                    return

{if (exists($xpath/@key)) then xs:string($xpath/@key) else $xpath/text()}:
                          {$evald}

     (: checking extra for diagnostics :)
     let $http-status := $result-data/httpclient:response/@statusCode
     let $diag := ($result-data//diag:diagnostic, $result-data//exception,
                if ($http-status ne '200') then <http-status>{$http-status}</http-status> else ())
      let $wrapped-diag := if (exists($diag)) then
                <diagnostics type="{string-join($diag/name(),',')}" >{$diag}</diagnostics> else ()
return ($a-processed, $check, $wrapped-diag)
};

declare function fcs-tests:store-result($target as xs:string, $testset as xs:string, $result as node()) as item()* {
    fcs-tests:store-result ($target, $testset, "", $result)
};

declare function fcs-tests:store-result($target as xs:string, $testset as xs:string, $test as xs:string, $result as node()) as item()* {
(: create collection for results for one target :)
   let $create-coll := if (not(xmldb:collection-available(concat($fcs-tests:results-coll, $target)))) then
                           xmldb:create-collection($fcs-tests:results-coll, $target) else ()

  let $result-path := fcs-tests:get-result-paths($target, concat($testset, $test))

  let $store-result := repo-utils:store($result-path[1], $result-path[2], $result, true())

return $store-result
};

declare function fcs-tests:format-result($result as node()) as item()* {

    if ($result[self::element(diagnostics)]) then

{$result/text()}

       else if (exists($result/testrun)) then
          repo-utils:serialise-as ($result, "html", "test", $fcs-tests:cr-config)
       else repo-utils:serialise-as ($result, "html", "test", $fcs-tests:cr-config)
              (: return quite empty html ??
                t:format-testResult($result) :)
};

declare function fcs-tests:display-page($target  as xs:string, $testset as xs:string, $operation) as item()* {

    let $result := fcs-tests:get-result($target, $testset)

    let $formatted-result := fcs-tests:format-result($result)
    let $opt := util:declare-option("exist:serialize", "media-type=text/html method=xhtml")
    return

            <title>FCS - test suite</title>
            <meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/>
             <link rel="stylesheet" type="text/css" href="tests.css" />
             <link rel="stylesheet" type="text/css" href="../../scripts/style/cmds-ui.css" />

FCS - test suite

            {if ($operation = 'overview') then fcs-tests:display-overview() else () }
            <form>
                targets<select name="target">
                    {
                    for $target-elem  in $fcs-tests:config//target
                        let $target-key := xs:string($target-elem/@key)
                        let $option :=  if ($target = $target-key) then
                                            <option selected="selected" value="{$target-key}" >{$target-key}</option>
                                         else
                                            <option value="{$target-key}" >{$target-key } </option>
                        return $option
                    }
                </select>
                test-set<select name="testset">
                    {
                    for $testset-elem in $fcs-tests:config//testset
                        let $testset-key := xs:string($testset-elem/@key)
                        let $option :=  if ($testset= $testset-key) then
                                            <option selected="selected" value="{$testset-key}" >{$testset-key}</option>
                                         else
                                            <option value="{$testset-key}" >{$testset-key}</option>
                        return $option
                    }
                </select>
                test-set
                    <select name="operation">
                       <option value="run" >{if ($operation = 'run') then attribute selected { "selected" } else ()} run</option>
                       <option value="view" > {if ($operation = 'view') then attribute selected { "selected" } else ()} view</option>
                       <option value="overview" > {if ($operation = 'overview') then attribute selected { "selected" } else ()} overview</option>
                    </select>
                <input type="submit" value="View/Run" />
                </form>

{$formatted-result}

};

declare function fcs-tests:display-overview() as item()* {

	{for $target in $fcs-tests:config//target return {xs:string($target/@key)}	}

            {for $testset in $fcs-tests:config//testset
                    let $testset-key := $testset/xs:string(@key)
                    return

                        {$testset-key}
                        {for $target in $fcs-tests:config//target
                           let $target-key := $target/xs:string(@key)
                           let $test-result := fcs-tests:get-result($target-key , $testset-key )
                           let $root-elem := $test-result/*/name()
                           let $op := if ($test-result//diagnostic["result-unavailable" = xs:string(@key)]) then 'run' else 'view'
                           (: display number of all and failed tests in the testset, operates on the HTML produced during the test-run :)
                           let $view:= if ($test-result//diagnostic["result-unavailable" = xs:string(@key)]) then ()
                                       else
                                            let $show := if ($root-elem[1] eq 'testrun') then
                                                            {count($test-result//div[@class='test'][.//span[@class='value true']])}{"/"}
                                                                   {count($test-result//div[@class='test'][.//span[@class='value false']])}{"/"}
                                                                {count($test-result//div[@class='test'])}
                                                                {if (exists($test-result//diagnostics)) then !! else () }

                                                            else $root-elem
                                            return {$show}

                        return {$view} [run]
                        }

            }

};

xquery version "1.0";
module namespace fcs-tests  = "http://clarin.eu/fcs/1.0/tests";

import module namespace httpclient = "http://exist-db.org/xquery/httpclient";
import module namespace t="http://exist-db.org/xquery/testing";
import module namespace repo-utils = "http://aac.ac.at/content_repository/utils" at  "/db/cr/repo-utils.xqm";

declare namespace zr="http://explain.z3950.org/dtd/2.1/";
declare namespace sru = "http://www.loc.gov/zing/srw/";
declare namespace fcs = "http://clarin.eu/fcs/1.0";
declare namespace diag = "http://www.loc.gov/zing/srw/diagnostic/";
declare namespace xhtml="http://www.w3.org/1999/xhtml";

(: sample input:

 :)
declare variable $fcs-tests:config := doc("config.xml");
declare variable $fcs-tests:cr-config := doc("/db/cr/etc/config.xml");
declare variable $fcs-tests:run-config := "run-config.xml";
declare variable $fcs-tests:testsets-coll := "/db/cr/modules/testing/testsets/";
declare variable $fcs-tests:results-coll := "/db/cr/modules/testing/results/";
declare variable $fcs-tests:href-prefix := "tests.xql";

(: this function is accessed by the testing-code to get configuration-options from the run-config :)
declare function fcs-tests:config-value($key as xs:string) as xs:string* {
            let $config := doc(concat($fcs-tests:testsets-coll, $fcs-tests:run-config))/config
                return if ($key eq "testset") then  xs:string($config//testset/@key)
                        else $config//target/text()
};

declare function fcs-tests:config-key($key as xs:string) as xs:string* {
            let $config := doc(concat($fcs-tests:testsets-coll, $fcs-tests:run-config))/config
                return if ($key eq "testset") then  xs:string($config//testset/@key)
                        else xs:string($config//target/@key)
};

declare function fcs-tests:get-result-paths($target  as xs:string, $testset as xs:string) as xs:string* {
        (concat($fcs-tests:results-coll, $target, "/"), concat($testset, ".xml"))
};

declare function fcs-tests:get-result-path($target  as xs:string, $testset as xs:string) as xs:string* {
        string-join(fcs-tests:get-result-paths($target , $testset ), "" )
};

declare function fcs-tests:get-result($target  as xs:string, $testset as xs:string) as item() {
  let $result-path := fcs-tests:get-result-path($target, $testset)
   let $result := if ($target = '' or $testset = '') then ()
                            else if (doc-available($result-path)) then
                            doc($result-path)
                        else <diagnostics><diagnostic key="result-unavailable">result unavailable: {$result-path}</diagnostic>
                                <diagnostic>{fcs-tests:get-testset($testset)}</diagnostic>
                              </diagnostics>
 return $result
};

(:~ try to get the testset-file based on the testset-key
@returns testset-file if available, otherwise empty result
:)
declare function fcs-tests:get-testset($testset as xs:string) as item()* {
    let $testset-path := concat($fcs-tests:testsets-coll, $testset, ".xml")
    return if (doc-available($testset-path)) then
                    doc($testset-path)
                  else
                  <diagnostic>unknown testset: {$testset}</diagnostic>
};

(:~ main function governing the execution of the tests

Generates a run-config out of the full config based on the parameters.
@param $target identifying key of the target  as set in the config
@param $testset-key identifying key of the testset as set in the config (that also has to be the name of the testset-file)
:)
declare function fcs-tests:run-testset($target  as xs:string, $testset-key as xs:string) as item()* {

    (: preparing a configuration for given run, based on the parameters :)
    let $run-config := <config>{($fcs-tests:config//target[xs:string(@key) = $target],
                                $fcs-tests:config//testset[xs:string(@key) = $testset-key])}</config>
    let $store := repo-utils:store($fcs-tests:testsets-coll, $fcs-tests:run-config, $run-config, true())
    let $testset := fcs-tests:get-testset($testset-key)
    let $start-time := util:system-dateTime()
    let $result := if (exists($testset)) then
                            let $tests := $testset//TestSet
                            (: distinguish the testset, that the testing-module can process
                               and the home-made test-doc, that tests URLs :)
                            return if (exists($tests)) then
                                        t:run-testSet($tests)
                                     else
                                        fcs-tests:test-rest($testset)
                       else
                           $testset
    let $end-time := util:system-dateTime()
    let $test-wrap := <testrun duration="{$end-time - $start-time}" on="{fn:current-dateTime()}" >{$result}</testrun>
    let $store-result := fcs-tests:store-result($target, $testset-key, $test-wrap)
    (:for $test in $tests/tests/test return fcs-tests:run-test($test):)
    return $store-result
};

(:~ process a test-doc (target is expected to be set in the config)
:)
declare function fcs-tests:test-rest($test-doc as node()) as item()* {

    let $result := local:dispatch($test-doc)

(:
let $targets := if (exists($test/target)) then $test/target else $test/preceding-sibling::target
let $requests := for $target in $targets return concat($target, $test/request/text())
let $data := for $request in $requests return
                <request href="{$request}" id
                httpclient:get(xs:anyURI($request), false(), () )

let $check := for $condition in $test/condition
                        let $expr :=concat("($data/", $condition/text(), " eq ", xs:string($condition/@result), ")")
                         return <check expr="{$expr}" >{util:eval($expr)} </check>
return <test><id>{$test/id}</id>{$test/label}
            <requests>{$requests}</requests>
            <results>{$check}</results>
        </test>
:)
return $result

};

(:~ This function takes the children of the node and passes them
   back into the typeswitch function. :)
declare function local:passthru($x as node()) as node()*
{
for $z in $x/node() return local:dispatch($z)
};

(:~ This is the recursive typeswitch function, to traverse the testset-document :)
declare function local:dispatch($x as node()) as node()*
{
typeswitch ($x)
  case text() return $x
  case element (test) return element div {$x/@*, attribute class {"test"}, fcs-tests:process-request($x)}
  case element() return element {$x/name()} {$x/@*, local:passthru($x)}
  default return local:passthru($x)
};

(:~ executes one URL-test.

Issues one http-call to the target-url in the a@href-attribute, stores the incoming result and evaluates the associated xpaths

expects:

      search: Haus
      //sru:numberOfRecords

@returns the requested-url, results of the xpath-evaluations as a div-list and any diagnostics
:)
declare function fcs-tests:process-request($test as node()) as item()* {

    let $a := $test/a,
        $test-id := xs:string($test/@id),
        $target := fcs-tests:config-value("target"),
        $target-key := fcs-tests:config-key("target"),
        $request := concat($target, xs:string($a/@href))
    let $a-processed := {$a/text()}
    let $result-data := httpclient:get(xs:anyURI($request), false(), () )

    let $store := fcs-tests:store-result($target-key, $test-id, $result-data)

    (: evaluate all xpaths defined for given request :)
    let $check := for $xpath in $test/xpath
                    let $evald := util:eval($xpath/text())

                    return

{if (exists($xpath/@key)) then xs:string($xpath/@key) else $xpath/text()}:
                          {$evald}

     (: checking extra for diagnostics :)
     let $http-status := $result-data/httpclient:response/@statusCode
     let $diag := ($result-data//diag:diagnostic, $result-data//exception,
                if ($http-status ne '200') then <http-status>{$http-status}</http-status> else ())
      let $wrapped-diag := if (exists($diag)) then
                <diagnostics type="{string-join($diag/name(),',')}" >{$diag}</diagnostics> else ()
return ($a-processed, $check, $wrapped-diag)
};

declare function fcs-tests:store-result($target as xs:string, $testset as xs:string, $result as node()) as item()* {
    fcs-tests:store-result ($target, $testset, "", $result)
};

declare function fcs-tests:store-result($target as xs:string, $testset as xs:string, $test as xs:string, $result as node()) as item()* {
(: create collection for results for one target :)
   let $create-coll := if (not(xmldb:collection-available(concat($fcs-tests:results-coll, $target)))) then
                           xmldb:create-collection($fcs-tests:results-coll, $target) else ()

  let $result-path := fcs-tests:get-result-paths($target, concat($testset, $test))

  let $store-result := repo-utils:store($result-path[1], $result-path[2], $result, true())

return $store-result
};

declare function fcs-tests:format-result($result as node()) as item()* {

    if ($result[self::element(diagnostics)]) then

{$result/text()}

       else if (exists($result/testrun)) then
          repo-utils:serialise-as ($result, "html", "test", $fcs-tests:cr-config)
       else repo-utils:serialise-as ($result, "html", "test", $fcs-tests:cr-config)
              (: return quite empty html ??
                t:format-testResult($result) :)
};

declare function fcs-tests:display-page($target  as xs:string, $testset as xs:string, $operation) as item()* {

    let $result := fcs-tests:get-result($target, $testset)

    let $formatted-result := fcs-tests:format-result($result)
    let $opt := util:declare-option("exist:serialize", "media-type=text/html method=xhtml")
    return

            <title>FCS - test suite</title>
            <meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/>
             <link rel="stylesheet" type="text/css" href="tests.css" />
             <link rel="stylesheet" type="text/css" href="../../scripts/style/cmds-ui.css" />

FCS - test suite

            {if ($operation = 'overview') then fcs-tests:display-overview() else () }
            <form>
                targets<select name="target">
                    {
                    for $target-elem  in $fcs-tests:config//target
                        let $target-key := xs:string($target-elem/@key)
                        let $option :=  if ($target = $target-key) then
                                            <option selected="selected" value="{$target-key}" >{$target-key}</option>
                                         else
                                            <option value="{$target-key}" >{$target-key } </option>
                        return $option
                    }
                </select>
                test-set<select name="testset">
                    {
                    for $testset-elem in $fcs-tests:config//testset
                        let $testset-key := xs:string($testset-elem/@key)
                        let $option :=  if ($testset= $testset-key) then
                                            <option selected="selected" value="{$testset-key}" >{$testset-key}</option>
                                         else
                                            <option value="{$testset-key}" >{$testset-key}</option>
                        return $option
                    }
                </select>
                test-set
                    <select name="operation">
                       <option value="run" >{if ($operation = 'run') then attribute selected { "selected" } else ()} run</option>
                       <option value="view" > {if ($operation = 'view') then attribute selected { "selected" } else ()} view</option>
                       <option value="overview" > {if ($operation = 'overview') then attribute selected { "selected" } else ()} overview</option>
                    </select>
                <input type="submit" value="View/Run" />
                </form>

{$formatted-result}

};

declare function fcs-tests:display-overview() as item()* {

	{for $target in $fcs-tests:config//target return {xs:string($target/@key)}	}

            {for $testset in $fcs-tests:config//testset
                    let $testset-key := $testset/xs:string(@key)
                    return

                        {$testset-key}
                        {for $target in $fcs-tests:config//target
                           let $target-key := $target/xs:string(@key)
                           let $test-result := fcs-tests:get-result($target-key , $testset-key )
                           let $root-elem := $test-result/*/name()
                           let $op := if ($test-result//diagnostic["result-unavailable" = xs:string(@key)]) then 'run' else 'view'
                           (: display number of all and failed tests in the testset, operates on the HTML produced during the test-run :)
                           let $view:= if ($test-result//diagnostic["result-unavailable" = xs:string(@key)]) then ()
                                       else
                                            let $show := if ($root-elem[1] eq 'testrun') then
                                                            {count($test-result//div[@class='test'][.//span[@class='value true']])}{"/"}
                                                                   {count($test-result//div[@class='test'][.//span[@class='value false']])}{"/"}
                                                                {count($test-result//div[@class='test'])}
                                                                {if (exists($test-result//diagnostics)) then !! else () }

                                                            else $root-elem
                                            return {$show}

                        return {$view} [run]
                        }

            }

};


improved documentation

improved documentation

xquery version "3.0";

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

(:~
 : This module provides functions for processing URIs and URLs.
 :
 : @author Matthias Brantner, Luis Rodriguez Gonzalez
 : @project XDM/atomic
 :
 :)
module namespace uri = "http://www.zorba-xquery.com/modules/uri";

declare namespace zerr = "http://www.zorba-xquery.com/errors";
declare namespace ver = "http://www.zorba-xquery.com/options/versioning";
declare option ver:module-version "1.0";

(:~
 : Constant for the "scheme" part of a URI object.
 :)
declare variable $uri:scheme := "scheme";

(:~
 : Constant for the "authority" part of a URI object.
 :)
declare variable $uri:authority := "authority";

(:~
 : Constant for the "user-info" part of a URI object.
 :)
declare variable $uri:user-info := "user-info";

(:~
 : Constant for the "host" part of a URI object.
 :)
declare variable $uri:host := "host";

(:~
 : Constant for the "port" part of a URI object.
 :)
declare variable $uri:port := "port";

(:~
 : Constant for the "path" part of a URI object.
 :)
declare variable $uri:path := "path";

(:~
 : Constant for the "query" part of a URI object.
 :)
declare variable $uri:query := "query";

(:~
 : Constant for the "fragment" part of a URI object.
 :)
declare variable $uri:fragment := "fragment";

(:~
 : Constant for the "opaque-part" part of a URI object.
 :
 : If this is set in a URI object, then none of $uri:PATH, $uri:HOST,
 : $uri:PORT, $uri:USER-INFO, or : $uri:QUERY may be specified.
 :
 : If this is set in a URI object, $uri:SCHEME must also be specified
 : (ie, it must be an absolute URI).
 :)
declare variable $uri:opaque-part := "opaque-part";

(:~
 : Percent-decodes (aka URL decoding) the given string.
 :
 : All percent encoded octets will be translated into their
 : decoded UTF-8 representation.
 :
 : Please note that the percent encoding guarantees that a string
 : consists of ASCII characters only. Passing a string that contains
 : non-ASCII characters results in undefined behavior.
 :
 : @param $s the string to decode
 :
 : @return the percent decoded string
 :)
declare function uri:decode($u as xs:string) as xs:string
{
  uri:decode($u, fn:false())
};

(:~
 : Percent-decodes (aka URL decoding) the given string.
 :
 : All percent encoded octets will be translated into their
 : decoded UTF-8 representation.
 :
 : If $decode-plus is specified all occurrences of the char '+'
 : will be replaced with a space ' ' before the percent decoding
 : happens.
 :
 : Please note that the percent encoding guarantees that a string
 : consists of ASCII characters only. Passing a string that contains
 : non-ASCII characters results in undefined behavior.
 :
 : @param $s the string to decode
 : @param $decode-plus whether '+' chars will be replaced with spaces
 :
 : @return the percent decoded string
 :)
declare function uri:decode(
  $u as xs:string,
  $decode-plus as xs:boolean) as xs:string
{
  uri:decode($u, $decode-plus, "UTF-8")
};

(:~
 : Percent-decodes (aka URL decoding) the given string.
 :
 : All percent encoded octets will be translated into their
 : decoded UTF-8 representation.
 :
 : If $decode-plus is specified all occurrences of the char '+'
 : will be replaced with a space ' ' before the percent decoding
 : happens.
 :
 : The $charset parameter specifies the source charset after precent
 : decoding. It is used to convert the decoded string into UTF-8.
 :
 : Please note that the percent encoding guarantees that a string
 : consists of ASCII characters only. Passing a string that contains
 : non-ASCII characters results in undefined behavior.
 :
 : @param $s the string to decode
 : @param $decode-plus whether '+' chars will be replaced with spaces
 : @param $charset the source charset of the string after percent decoding
 :
 : @return the percent decoded string
 :
 : @error zerr:ZXQP0006 if the given charset is unknown or not supported
 :
 : @error zerr:ZOSE0006 if there is an error transcoding the string
 :)
declare function uri:decode(
  $s as xs:string,
  $decode-plus as xs:boolean,
  $charset as xs:string) as xs:string external;

(:~
 : Parses the URI passed as string. The returned object
 : contains only members with field names declared as constants in
 : this module.
 :
 : For example,
 :
 : let my-uri := "http://www.my.project.com/a/b/c?user=john;pass=1234#profile"
 : return uri:parse(my-uri)
 :
 :
 : returns
 :
 : { "squeme" : "http", "host" : "www.my.project.com", "path" : "/a/b/c",
 :   "query" : "user=john;pass=123", "fragment" : "profile" }
 :
 :
 : @param $uri the URI to parse
 :
 : @return the JSON object
 :
 : @error err:XQST0046 if the URI is textually invalid
 :)
declare function uri:parse(
  $uri as xs:string) as object() external;

(:~
 : Serialize the URI passed as object into a string.
 :
 : @param $uri the object representing the URI
 :
 : @return the URI as string
 :
 : @error zerr:ZURI0001 if opaque part is specified in conjunction with
 : host/port/path/user-info/query.
 :
 : @error zerr:ZURI0002 if opaque part is present but no scheme is present.
 :
 : @error zerr:ZURI0003 if a path component for an absolute URI
 : doesn't start with "/".
 :)
declare function uri:serialize(
  $uri as object()) as xs:string external;

xquery version "3.0";

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

(:~
 : This module provides functions for processing URIs and URLs.
 :
 : @author Matthias Brantner, Luis Rodriguez Gonzalez
 : @project XDM/atomic
 :
 :)
module namespace uri = "http://www.zorba-xquery.com/modules/uri";

declare namespace zerr = "http://www.zorba-xquery.com/errors";
declare namespace ver = "http://www.zorba-xquery.com/options/versioning";
declare option ver:module-version "1.0";

(:~
 : Constant for the "scheme" part of a URI object.
 :)
declare variable $uri:scheme := "scheme";

(:~
 : Constant for the "authority" part of a URI object.
 :)
declare variable $uri:authority := "authority";

(:~
 : Constant for the "user-info" part of a URI object.
 :)
declare variable $uri:user-info := "user-info";

(:~
 : Constant for the "host" part of a URI object.
 :)
declare variable $uri:host := "host";

(:~
 : Constant for the "port" part of a URI object.
 :)
declare variable $uri:port := "port";

(:~
 : Constant for the "path" part of a URI object.
 :)
declare variable $uri:path := "path";

(:~
 : Constant for the "query" part of a URI object.
 :)
declare variable $uri:query := "query";

(:~
 : Constant for the "fragment" part of a URI object.
 :)
declare variable $uri:fragment := "fragment";

(:~
 : Constant for the "opaque-part" part of a URI object.
 :
 : If this is set in a URI object, then none of $uri:PATH, $uri:HOST,
 : $uri:PORT, $uri:USER-INFO, or : $uri:QUERY may be specified.
 :
 : If this is set in a URI object, $uri:SCHEME must also be specified
 : (ie, it must be an absolute URI).
 :)
declare variable $uri:opaque-part := "opaque-part";

(:~
 : Percent-decodes (aka URL decoding) the given string.
 :
 : All percent encoded octets will be translated into their
 : decoded UTF-8 representation.
 :
 : Please note that the percent encoding guarantees that a string
 : consists of ASCII characters only. Passing a string that contains
 : non-ASCII characters results in undefined behavior.
 :
 : @param $s the string to decode
 :
 : @return the percent decoded string
 :)
declare function uri:decode($u as xs:string) as xs:string
{
  uri:decode($u, fn:false())
};

(:~
 : Percent-decodes (aka URL decoding) the given string.
 :
 : All percent encoded octets will be translated into their
 : decoded UTF-8 representation.
 :
 : If $decode-plus is specified all occurrences of the char '+'
 : will be replaced with a space ' ' before the percent decoding
 : happens.
 :
 : Please note that the percent encoding guarantees that a string
 : consists of ASCII characters only. Passing a string that contains
 : non-ASCII characters results in undefined behavior.
 :
 : @param $s the string to decode
 : @param $decode-plus whether '+' chars will be replaced with spaces
 :
 : @return the percent decoded string
 :)
declare function uri:decode(
  $u as xs:string,
  $decode-plus as xs:boolean) as xs:string
{
  uri:decode($u, $decode-plus, "UTF-8")
};

(:~
 : Percent-decodes (aka URL decoding) the given string.
 :
 : All percent encoded octets will be translated into their
 : decoded UTF-8 representation.
 :
 : If $decode-plus is specified all occurrences of the char '+'
 : will be replaced with a space ' ' before the percent decoding
 : happens.
 :
 : The $charset parameter specifies the source charset after precent
 : decoding. It is used to convert the decoded string into UTF-8.
 :
 : Please note that the percent encoding guarantees that a string
 : consists of ASCII characters only. Passing a string that contains
 : non-ASCII characters results in undefined behavior.
 :
 : @param $s the string to decode
 : @param $decode-plus whether '+' chars will be replaced with spaces
 : @param $charset the source charset of the string after percent decoding
 :
 : @return the percent decoded string
 :
 : @error zerr:ZXQP0006 if the given charset is unknown or not supported
 :
 : @error zerr:ZOSE0006 if there is an error transcoding the string
 :)
declare function uri:decode(
  $s as xs:string,
  $decode-plus as xs:boolean,
  $charset as xs:string) as xs:string external;

(:~
 : Parses the URI passed as xs:string into a URI JSON object. The object
 : will contain only members with field names declared as constants in
 : this module.
 :
 : @param $uri the URI as string to parse
 :
 : @return the URI JSONiq object
 :
 : Example: Assume that you have this xquery code:
 : import module namespace uri = "http://www.zorba-xquery.com/modules/uri";
 :
 : let my-uri := "http://www.my.project.com/a/b/c?user=john;pass=1234#profile"
 : return uri:parse(my-uri)
 :
 : The output of this code would be this JSON object:
 : <code>
 : { "squeme" : "http", "host" : "www.my.project.com", "path" : "/a/b/c",
 :   "query" : "user=john;pass=123", "fragment" : "profile" }
 : </code>
 :
 : @error err:XQST0046 if the URI is textually invalid
 :)
declare function uri:parse(
  $uri as xs:string) as object() external;

(:~
 : Serialize the URI passed as JSON object into a URI represented as xs:string.
 : The object should only contain members with field names declared as
 : constants in this module.
 :
 : @param $uri the URI JSONiq object
 :
 : @return the URI as xs:string
 :
 : @error zerr:ZURI0001 if opaque part is specified in conjunction with
 : host/port/path/user-info/query.
 :
 : @error zerr:ZURI0002 if opaque part is present but no scheme is present at the
 : same time.
 :
 : @error zerr:ZURI0003 if a path component for an absolute URI doesn't start with
 : "/".
 :
 :)
declare function uri:serialize(
  $uri as object()) as xs:string external;


Eliminated potentially empty matches from list of returns. Experimental use of 'paperlinks(...)'.

import module namespace notes="http://cefn.com/readinglog/notes" at "/home/cefn/Documents/highwire/participatory firmware design/readinglog/scripts/server/xquery/lib/notes.xq";
import module namespace template="http://cefn.com/readinglog/template" at "/home/cefn/Documents/highwire/participatory firmware design/readinglog/scripts/server/xquery/lib/template.xq";
declare default element namespace "http://www.w3.org/1999/xhtml";

declare variable $match external;

template:webpage(

{$match}

		{for $heading in notes:notesoftype($match)[self::p][text()] (: consider only non-empty paragraphs:)
			return

					{string($heading)}
					{notes:paperlinks($heading)}

		}

)

import module namespace notes="http://cefn.com/readinglog/notes" at "/home/cefn/Documents/highwire/participatory firmware design/readinglog/scripts/server/xquery/lib/notes.xq";
import module namespace template="http://cefn.com/readinglog/template" at "/home/cefn/Documents/highwire/participatory firmware design/readinglog/scripts/server/xquery/lib/template.xq";
declare default element namespace "http://www.w3.org/1999/xhtml";

declare variable $match external;

template:webpage(

{$match}

		{for $heading in notes:followingheader(notes:allnotes(),$match)[self::p] return
{string($heading)}
}

)


changed from map:new() to map:merge(()) as map:new() is no longer available in basex 8.0

(:~
: This is the Care Services Discovery RESTful document processor
: @version 1.0
: @see https://github.com/openhie/openinfoman
:
:)
module namespace csr_proc = "https://github.com/openhie/openinfoman/csr_proc";

import module namespace file = "http://expath.org/ns/file";
import module namespace csd_dm = "https://github.com/openhie/openinfoman/csd_dm";
import module namespace csd_mcs = "https://github.com/openhie/openinfoman/csd_mcs";

declare   namespace   csd = "urn:ihe:iti:csd:2013";
declare namespace xquery = "http://basex.org/modules/xquery";

(:this should proabably be moved to the database :)
declare variable $csr_proc:stored_query_dir := concat(file:current-dir() , "../resources/stored_query_definitions");
declare variable $csr_proc:stored_updating_query_dir := concat(file:current-dir() , "../resources/stored_updating_query_definitions");

declare variable $csr_proc:stored_functions_doc := 'stored_functions.xml';
declare variable $csr_proc:stored_updating_functions_doc := 'stored_updating_functions.xml';

declare function csr_proc:stored_functions($db) {
 db:open($db,$csr_proc:stored_functions_doc)/careServicesFunctions/csd:careServicesFunction
};

declare function csr_proc:stored_updating_functions($db) {
 db:open($db,$csr_proc:stored_updating_functions_doc)/careServicesFunctions/csd:careServicesFunction
};

declare updating function csr_proc:init($db) {
  (
    if (not (db:is-xml($db,$csr_proc:stored_updating_functions_doc))) then
      db:add($db, <careServicesFunctions/>,$csr_proc:stored_updating_functions_doc)
    else
      ()
      ,
    if (not (db:is-xml($db,$csr_proc:stored_functions_doc))) then
      db:add($db, <careServicesFunctions/>,$csr_proc:stored_functions_doc)
    else
      ()
  )
};

declare updating function csr_proc:clear_stored_functions($db) {
  (
    db:delete($db,$csr_proc:stored_functions_doc)
    ,db:delete($db,$csr_proc:stored_updating_functions_doc)
    ,csr_proc:init($db)
    )

};

declare updating function csr_proc:load_functions_from_files($db) {
  (
    if (file:is-dir($csr_proc:stored_query_dir)) then
      for $file in file:list($csr_proc:stored_query_dir,boolean('false'),"*.xml")
      let $func := doc(concat($csr_proc:stored_query_dir,'/',$file))/csd:careServicesFunction
      return if (exists($func)) then csr_proc:load_stored_function($db,$func) else ()
    else()
      ,
    if (file:is-dir($csr_proc:stored_updating_query_dir)) then
      for $file in file:list($csr_proc:stored_updating_query_dir,boolean('false'),"*.xml")
      let $func := doc(concat($csr_proc:stored_updating_query_dir,'/',$file))/csd:careServicesFunction
      return if (exists($func)) then csr_proc:load_stored_updating_function($db,$func) else ()
    else ()
  )
};

declare updating function csr_proc:delete_stored_function($db,$urn) {
  let $stored_updating_functions := db:open($db,$csr_proc:stored_updating_functions_doc)/careServicesFunctions/*
  let $stored_functions := db:open($db,$csr_proc:stored_functions_doc)/careServicesFunctions/*
  let $functions := ($stored_functions,$stored_updating_functions)

  let $old := $functions[@urn = $urn]
  return if ($old) then delete node $old else ()

};

declare updating function csr_proc:load_stored_updating_function($db,$func) {
  let $stored_updating_functions := db:open($db,$csr_proc:stored_updating_functions_doc)/careServicesFunctions
  let $urn := $func/@urn
  let $old := $stored_updating_functions/csd:careServicesFunction[@urn = $urn]
  return
    if (exists($urn)) then
      if (exists($old))
	then
	(delete node $old,
	insert node $func into $stored_updating_functions
	)
      else
	insert node $func into $stored_updating_functions
  else ()
};

declare updating function csr_proc:load_stored_function($db,$func) {
  let $stored_functions := db:open($db,$csr_proc:stored_functions_doc)/careServicesFunctions
  let $urn := $func/@urn
  let $old := $stored_functions/csd:careServicesFunction[@urn = $urn]
  return
    if (exists($urn) and exists($stored_functions)) then
      if (exists($old))
	then
	(delete node $old,
	insert node $func into $stored_functions
	)
      else
	insert node $func into $stored_functions
    else ()
};

declare function csr_proc:process_CSR($db,$careServicesRequest, $doc_name,$base_url)
{
csr_proc:process_CSR($db,$careServicesRequest, $doc_name, $base_url,map:merge(()))
};

declare function csr_proc:process_CSR($db,$careServicesRequest, $doc_name,$base_url,$bindings as map(*))
{
let $function :=$careServicesRequest/csd:function
let $adhoc :=$careServicesRequest/csd:expression
return if (exists($function))
then
  let $urn := string($function/@urn)
  let $csr :=
  <csd:careServicesRequest>
    <csd:function urn="{$urn}" resource='{$doc_name}' base_url='{$base_url}'>
      {($function/*)[1]}
    </csd:function>
  </csd:careServicesRequest>

  return csr_proc:process_CSR_stored($db,$csr,$bindings)
else if (exists($adhoc))
then
  csr_proc:process_CSR_adhoc($db,$adhoc,$doc_name,$bindings)
else
 (:
  <rest:response>
    <http:response status="400" message="Invalid care services request.">
      <http:header name="Content-Language" value="en"/>
      <http:header name="Content-Type" value="text/html; charset=utf-8"/>
    </http:response>
  </rest:response>
  :)
  $careServicesRequest

};

declare function csr_proc:process_CSR_adhoc($db,$expression,$doc_name) {
   csr_proc:process_CSR_adhoc($expression,$doc_name,map:merge(()))
};

declare function csr_proc:process_CSR_adhoc($db,$expression,$doc_name,$bindings as map(*))
{

let $doc :=  csd_dm:open_document($db,$doc_name)

let $expr :=string($expression)
return if ($expr) then
  let $result := xquery:eval($expr,map{"":$doc},$bindings)
  return(
   <rest:response>
   <http:response status="200" >
      <http:header name="Content-Type" value="{$expression/@content-type}"/>
    </http:response>
  </rest:response>
  ,$result
 )
else
   <rest:response>
     <http:response status="400" message="No ad-hoc expression" />
  </rest:response>
};

declare function csr_proc:process_CSR_stored($db,$careServicesRequest)
{
  csr_proc:process_CSR_stored($db,$careServicesRequest,map:merge(()))
};

declare function csr_proc:process_CSR_stored($db,$careServicesRequest,$bindings as map(*))
{
let $function :=$careServicesRequest/csd:function
let $stored_functions := csr_proc:stored_functions($db)
let $urn := string($function/@urn)
let $definition := ($stored_functions[@urn = $urn])[1]/csd:definition/text()
let $content_type := csr_proc:lookup_stored_content_type($db,$function/@urn)
let $doc_name := string($function/@resource)
let $doc :=  csd_dm:open_document($db,$doc_name)

let $results0 := csr_proc:process_CSR_stored_results($db,$doc,$careServicesRequest,$bindings)

return if (exists($definition)) then
  let $results1:=
    if ($function/@encapsulated) then
      csr_proc:wrap_result($results0,$content_type)
    else $results0
  return
    (
    <rest:response>
      <http:response status="200" >
	<http:header name="Content-Type" value="{$content_type}"/>
      </http:response>
    </rest:response>
    ,
    $results1
    )
else
  <rest:response>
    <http:response status="404" message="No registered function with URN='{$function/@urn}'.">
      <http:header name="Content-Language" value="en"/>
      <http:header name="Content-Type" value="text/html; charset=utf-8"/>
    </http:response>
  </rest:response>
};

declare function csr_proc:wrap_result($result,$content-type) {
 <csd:careServicesResponse content-type="{$content-type}"><csd:result>{$result}</csd:result></csd:careServicesResponse>
};

declare function csr_proc:process_CSR_stored_results($db,$doc,$careServicesRequest)
{
  csr_proc:process_CSR_stored_results($db,$doc,$careServicesRequest,map:merge(()))
};

declare function csr_proc:process_CSR_stored_results($db,$doc,$careServicesRequest,$bindings as map(*))
{
let $function :=$careServicesRequest/csd:function
let $urn := string($function/@urn)
let $doc_name := string($function/@resource)
let $base_url := string($function/@base_url)

let $stored_functions := csr_proc:stored_functions($db)
let $definition := ($stored_functions[@urn = $urn])[1]/csd:definition/text()

let $options := csr_proc:lookup_stored_options($db,$function/@urn)

let $requestParams :=
 <csd:requestParams resource='{$doc_name}' function='{$urn}' base_url='{$base_url}'>
   {
     if ($function/csd:requestParams) then $function/csd:requestParams/*
   else $function/requestParams/*
   }
 </csd:requestParams>

let $csr_bindings :=  map{'':$doc,'careServicesRequest':$requestParams}
let $all_bindings :=  map:merge(($csr_bindings, $bindings))

return if (exists($definition)) then
  xquery:eval($definition,$all_bindings,$options)
else ()
};

declare function csr_proc:create_adhoc_doc($adhoc_query,$content_type) {
let $content := if ($content_type) then $content_type else "application/xml"
return
 <csd:careServicesRequest xmlns:csd='urn:ihe:iti:csd:2013'>
  <csd:expression content-type='{$content}'>
  {$adhoc_query}
  </csd:expression>
</csd:careServicesRequest>

};

declare function csr_proc:get_function_definition($db,$urn) {
  csr_proc:stored_functions($db)[@urn = $urn][1]
};

declare function csr_proc:get_updating_function_definition($db,$urn) {
  csr_proc:stored_updating_functions($db)[@urn = $urn][1]
};

declare function csr_proc:get_any_function_definition($db,$urn) {
  (csr_proc:stored_updating_functions($db)[@urn = $urn] , csr_proc:stored_functions($db)[@urn = $urn])[1]
};

declare updating function csr_proc:process_updating_CSR($db,$function,$doc_name,$base_url)
{
  csr_proc:process_updating_CSR($db,$function,$doc_name,$base_url,map:merge(()))
};

declare updating function csr_proc:process_updating_CSR_results($db,$function)
{
  csr_proc:process_updating_CSR_results($db,$function,map:merge(()))
};

declare updating function csr_proc:process_updating_CSR_results($db,$careServicesRequest, $bindings as map(*)) {
let $function :=$careServicesRequest//csd:function
let $doc_name := string($function/@resource)
let $base_url := string($function/@base_url)
let $doc := csd_dm:open_document($db,$doc_name)
let $urn := $function/@urn
let $stored_updating_functions := csr_proc:stored_updating_functions($db)
let $definition := $stored_updating_functions[@urn = $urn][1]/csd:definition/text()
let $content_type := csr_proc:lookup_stored_content_type($db,$function/@urn)
let $requestParams := <csd:requestParams resource='{$doc_name}' function='{$urn}' base_url='{$base_url}'>
  {
    if ($function/csd:requestParams) then $function/csd:requestParams/*
    else $function/requestParams/*
  }
</csd:requestParams>

let $csr_bindings :=  map{'':$doc,'careServicesRequest':$requestParams}
let $all_bindings :=  map:merge(($csr_bindings, $bindings))

let $options := csr_proc:lookup_stored_options($db,$function/@urn)

return if (exists($definition)) then
  (
  xquery:update($definition,$all_bindings,$options)
  )
else  ()

};

declare updating function csr_proc:process_updating_CSR_stored_results($db,$doc,$careServicesRequest)
{
  csr_proc:process_updating_CSR_stored_results($db,$doc,$careServicesRequest,map:merge(()))
};

declare updating function csr_proc:process_updating_CSR_stored_results($db,$doc,$careServicesRequest,$bindings as map(*))
{
let $stored_updating_functions := csr_proc:stored_updating_functions($db)

let $csr_bindings :=  map{'':$doc,'careServicesRequest':$careServicesRequest}
let $all_bindings :=  map:merge(($csr_bindings, $bindings))
let $function := $careServicesRequest/@function
let $options := csr_proc:lookup_stored_options($db,$function)
let $definition := $stored_updating_functions[@urn = $function][1]/csd:definition/text()

return if (exists($definition)) then
  xquery:update($definition,$all_bindings,$options)
else
    db:output(
    <rest:response>
      <http:response status="404" message="No registered updating function with URN='{$function}">
	<http:header name="Content-Language" value="en"/>
	<http:header name="Content-Type" value="text/html; charset=utf-8"/>
      </http:response>
    </rest:response>
       )
};

declare updating function csr_proc:process_updating_CSR($db,$careServicesRequest, $doc_name, $base_url,$bindings as map(*))
{

let $doc := csd_dm:open_document($db,$doc_name)
let $function :=$careServicesRequest//csd:function
let $urn := $function/@urn
let $content_type := csr_proc:lookup_stored_content_type($db,$function/@urn)
let $requestParams := <csd:requestParams resource="{$doc_name}" function="{$urn}" base_url="{$base_url}">
  {
    if ($function/csd:requestParams) then $function/csd:requestParams/*
    else $function/requestParams/*
  }
</csd:requestParams>
return csr_proc:process_updating_CSR_stored_results($db,$doc,$requestParams,$bindings)
};

declare function csr_proc:lookup_stored_options($db,$urn)
{
  let $stored_updating_functions := csr_proc:stored_updating_functions($db)
  let $stored_functions := csr_proc:stored_functions($db)
  let $func := ($stored_functions[@urn = $urn], $stored_updating_functions[@urn = $urn])[1]
   return  ($func/csd:extension[@urn='urn:openhie.org:openinfoman:csr_processor' and  @type='xquery:options']/xquery:options)[1]
     (: See: http://docs.basex.org/wiki/XQuery_Module :)
};

declare function csr_proc:lookup_stored_content_type($db,$urn)
{
  let $stored_updating_functions := csr_proc:stored_updating_functions($db)
  let $stored_functions := csr_proc:stored_functions($db)
  return string(($stored_functions[@urn = $urn]/@content-type, $stored_updating_functions[@urn = $urn]/@content-type  , "text/xml")[1])
};

(:~
: This is the Care Services Discovery RESTful document processor
: @version 1.0
: @see https://github.com/openhie/openinfoman
:
:)
module namespace csr_proc = "https://github.com/openhie/openinfoman/csr_proc";

import module namespace file = "http://expath.org/ns/file";
import module namespace csd_dm = "https://github.com/openhie/openinfoman/csd_dm";
import module namespace csd_mcs = "https://github.com/openhie/openinfoman/csd_mcs";

declare   namespace   csd = "urn:ihe:iti:csd:2013";
declare namespace xquery = "http://basex.org/modules/xquery";

(:this should proabably be moved to the database :)
declare variable $csr_proc:stored_query_dir := concat(file:current-dir() , "../resources/stored_query_definitions");
declare variable $csr_proc:stored_updating_query_dir := concat(file:current-dir() , "../resources/stored_updating_query_definitions");

declare variable $csr_proc:stored_functions_doc := 'stored_functions.xml';
declare variable $csr_proc:stored_updating_functions_doc := 'stored_updating_functions.xml';

declare function csr_proc:stored_functions($db) {
 db:open($db,$csr_proc:stored_functions_doc)/careServicesFunctions/csd:careServicesFunction
};

declare function csr_proc:stored_updating_functions($db) {
 db:open($db,$csr_proc:stored_updating_functions_doc)/careServicesFunctions/csd:careServicesFunction
};

declare updating function csr_proc:init($db) {
  (
    if (not (db:is-xml($db,$csr_proc:stored_updating_functions_doc))) then
      db:add($db, <careServicesFunctions/>,$csr_proc:stored_updating_functions_doc)
    else
      ()
      ,
    if (not (db:is-xml($db,$csr_proc:stored_functions_doc))) then
      db:add($db, <careServicesFunctions/>,$csr_proc:stored_functions_doc)
    else
      ()
  )
};

declare updating function csr_proc:clear_stored_functions($db) {
  (
    db:delete($db,$csr_proc:stored_functions_doc)
    ,db:delete($db,$csr_proc:stored_updating_functions_doc)
    ,csr_proc:init($db)
    )

};

declare updating function csr_proc:load_functions_from_files($db) {
  (
    if (file:is-dir($csr_proc:stored_query_dir)) then
      for $file in file:list($csr_proc:stored_query_dir,boolean('false'),"*.xml")
      let $func := doc(concat($csr_proc:stored_query_dir,'/',$file))/csd:careServicesFunction
      return if (exists($func)) then csr_proc:load_stored_function($db,$func) else ()
    else()
      ,
    if (file:is-dir($csr_proc:stored_updating_query_dir)) then
      for $file in file:list($csr_proc:stored_updating_query_dir,boolean('false'),"*.xml")
      let $func := doc(concat($csr_proc:stored_updating_query_dir,'/',$file))/csd:careServicesFunction
      return if (exists($func)) then csr_proc:load_stored_updating_function($db,$func) else ()
    else ()
  )
};

declare updating function csr_proc:delete_stored_function($db,$urn) {
  let $stored_updating_functions := db:open($db,$csr_proc:stored_updating_functions_doc)/careServicesFunctions/*
  let $stored_functions := db:open($db,$csr_proc:stored_functions_doc)/careServicesFunctions/*
  let $functions := ($stored_functions,$stored_updating_functions)

  let $old := $functions[@urn = $urn]
  return if ($old) then delete node $old else ()

};

declare updating function csr_proc:load_stored_updating_function($db,$func) {
  let $stored_updating_functions := db:open($db,$csr_proc:stored_updating_functions_doc)/careServicesFunctions
  let $urn := $func/@urn
  let $old := $stored_updating_functions/csd:careServicesFunction[@urn = $urn]
  return
    if (exists($urn)) then
      if (exists($old))
	then
	(delete node $old,
	insert node $func into $stored_updating_functions
	)
      else
	insert node $func into $stored_updating_functions
  else ()
};

declare updating function csr_proc:load_stored_function($db,$func) {
  let $stored_functions := db:open($db,$csr_proc:stored_functions_doc)/careServicesFunctions
  let $urn := $func/@urn
  let $old := $stored_functions/csd:careServicesFunction[@urn = $urn]
  return
    if (exists($urn) and exists($stored_functions)) then
      if (exists($old))
	then
	(delete node $old,
	insert node $func into $stored_functions
	)
      else
	insert node $func into $stored_functions
    else ()
};

declare function csr_proc:process_CSR($db,$careServicesRequest, $doc_name,$base_url)
{
csr_proc:process_CSR($db,$careServicesRequest, $doc_name, $base_url,map:new(()))
};

declare function csr_proc:process_CSR($db,$careServicesRequest, $doc_name,$base_url,$bindings as map(*))
{
let $function :=$careServicesRequest/csd:function
let $adhoc :=$careServicesRequest/csd:expression
return if (exists($function))
then
  let $urn := string($function/@urn)
  let $csr :=
  <csd:careServicesRequest>
    <csd:function urn="{$urn}" resource='{$doc_name}' base_url='{$base_url}'>
      {($function/*)[1]}
    </csd:function>
  </csd:careServicesRequest>

  return csr_proc:process_CSR_stored($db,$csr,$bindings)
else if (exists($adhoc))
then
  csr_proc:process_CSR_adhoc($db,$adhoc,$doc_name,$bindings)
else
 (:
  <rest:response>
    <http:response status="400" message="Invalid care services request.">
      <http:header name="Content-Language" value="en"/>
      <http:header name="Content-Type" value="text/html; charset=utf-8"/>
    </http:response>
  </rest:response>
  :)
  $careServicesRequest

};

declare function csr_proc:process_CSR_adhoc($db,$expression,$doc_name) {
   csr_proc:process_CSR_adhoc($expression,$doc_name,map:new(()))
};

declare function csr_proc:process_CSR_adhoc($db,$expression,$doc_name,$bindings as map(*))
{

let $doc :=  csd_dm:open_document($db,$doc_name)

let $expr :=string($expression)
return if ($expr) then
  let $result := xquery:eval($expr,map{"":$doc},$bindings)
  return(
   <rest:response>
   <http:response status="200" >
      <http:header name="Content-Type" value="{$expression/@content-type}"/>
    </http:response>
  </rest:response>
  ,$result
 )
else
   <rest:response>
     <http:response status="400" message="No ad-hoc expression" />
  </rest:response>
};

declare function csr_proc:process_CSR_stored($db,$careServicesRequest)
{
  csr_proc:process_CSR_stored($db,$careServicesRequest,map:new())
};

declare function csr_proc:process_CSR_stored($db,$careServicesRequest,$bindings as map(*))
{
let $function :=$careServicesRequest/csd:function
let $stored_functions := csr_proc:stored_functions($db)
let $urn := string($function/@urn)
let $definition := ($stored_functions[@urn = $urn])[1]/csd:definition/text()
let $content_type := csr_proc:lookup_stored_content_type($db,$function/@urn)
let $doc_name := string($function/@resource)
let $doc :=  csd_dm:open_document($db,$doc_name)

let $results0 := csr_proc:process_CSR_stored_results($db,$doc,$careServicesRequest,$bindings)

return if (exists($definition)) then
  let $results1:=
    if ($function/@encapsulated) then
      csr_proc:wrap_result($results0,$content_type)
    else $results0
  return
    (
    <rest:response>
      <http:response status="200" >
	<http:header name="Content-Type" value="{$content_type}"/>
      </http:response>
    </rest:response>
    ,
    $results1
    )
else
  <rest:response>
    <http:response status="404" message="No registered function with URN='{$function/@urn}'.">
      <http:header name="Content-Language" value="en"/>
      <http:header name="Content-Type" value="text/html; charset=utf-8"/>
    </http:response>
  </rest:response>
};

declare function csr_proc:wrap_result($result,$content-type) {
 <csd:careServicesResponse content-type="{$content-type}"><csd:result>{$result}</csd:result></csd:careServicesResponse>
};

declare function csr_proc:process_CSR_stored_results($db,$doc,$careServicesRequest)
{
  csr_proc:process_CSR_stored_results($db,$doc,$careServicesRequest,map:new())
};

declare function csr_proc:process_CSR_stored_results($db,$doc,$careServicesRequest,$bindings as map(*))
{
let $function :=$careServicesRequest/csd:function
let $urn := string($function/@urn)
let $doc_name := string($function/@resource)
let $base_url := string($function/@base_url)

let $stored_functions := csr_proc:stored_functions($db)
let $definition := ($stored_functions[@urn = $urn])[1]/csd:definition/text()

let $options := csr_proc:lookup_stored_options($db,$function/@urn)

let $requestParams :=
 <csd:requestParams resource='{$doc_name}' function='{$urn}' base_url='{$base_url}'>
   {
     if ($function/csd:requestParams) then $function/csd:requestParams/*
   else $function/requestParams/*
   }
 </csd:requestParams>

let $csr_bindings :=  map{'':$doc,'careServicesRequest':$requestParams}
let $all_bindings :=  map:new(($csr_bindings, $bindings))

return if (exists($definition)) then
  xquery:eval($definition,$all_bindings,$options)
else ()
};

declare function csr_proc:create_adhoc_doc($adhoc_query,$content_type) {
let $content := if ($content_type) then $content_type else "application/xml"
return
 <csd:careServicesRequest xmlns:csd='urn:ihe:iti:csd:2013'>
  <csd:expression content-type='{$content}'>
  {$adhoc_query}
  </csd:expression>
</csd:careServicesRequest>

};

declare function csr_proc:get_function_definition($db,$urn) {
  csr_proc:stored_functions($db)[@urn = $urn][1]
};

declare function csr_proc:get_updating_function_definition($db,$urn) {
  csr_proc:stored_updating_functions($db)[@urn = $urn][1]
};

declare function csr_proc:get_any_function_definition($db,$urn) {
  (csr_proc:stored_updating_functions($db)[@urn = $urn] , csr_proc:stored_functions($db)[@urn = $urn])[1]
};

declare updating function csr_proc:process_updating_CSR($db,$function,$doc_name,$base_url)
{
  csr_proc:process_updating_CSR($db,$function,$doc_name,$base_url,map:new(()))
};

declare updating function csr_proc:process_updating_CSR_results($db,$function)
{
  csr_proc:process_updating_CSR_results($db,$function,map:new(()))
};

declare updating function csr_proc:process_updating_CSR_results($db,$careServicesRequest, $bindings as map(*)) {
let $function :=$careServicesRequest//csd:function
let $doc_name := string($function/@resource)
let $base_url := string($function/@base_url)
let $doc := csd_dm:open_document($db,$doc_name)
let $urn := $function/@urn
let $stored_updating_functions := csr_proc:stored_updating_functions($db)
let $definition := $stored_updating_functions[@urn = $urn][1]/csd:definition/text()
let $content_type := csr_proc:lookup_stored_content_type($db,$function/@urn)
let $requestParams := <csd:requestParams resource='{$doc_name}' function='{$urn}' base_url='{$base_url}'>
  {
    if ($function/csd:requestParams) then $function/csd:requestParams/*
    else $function/requestParams/*
  }
</csd:requestParams>

let $csr_bindings :=  map{'':$doc,'careServicesRequest':$requestParams}
let $all_bindings :=  map:new(($csr_bindings, $bindings))

let $options := csr_proc:lookup_stored_options($db,$function/@urn)

return if (exists($definition)) then
  (
  xquery:update($definition,$all_bindings,$options)
  )
else  ()

};

declare updating function csr_proc:process_updating_CSR_stored_results($db,$doc,$careServicesRequest)
{
  csr_proc:process_updating_CSR_stored_results($db,$doc,$careServicesRequest,map:new())
};

declare updating function csr_proc:process_updating_CSR_stored_results($db,$doc,$careServicesRequest,$bindings as map(*))
{
let $stored_updating_functions := csr_proc:stored_updating_functions($db)

let $csr_bindings :=  map{'':$doc,'careServicesRequest':$careServicesRequest}
let $all_bindings :=  map:new(($csr_bindings, $bindings))
let $function := $careServicesRequest/@function
let $options := csr_proc:lookup_stored_options($db,$function)
let $definition := $stored_updating_functions[@urn = $function][1]/csd:definition/text()

return if (exists($definition)) then
  xquery:update($definition,$all_bindings,$options)
else
    db:output(
    <rest:response>
      <http:response status="404" message="No registered updating function with URN='{$function}">
	<http:header name="Content-Language" value="en"/>
	<http:header name="Content-Type" value="text/html; charset=utf-8"/>
      </http:response>
    </rest:response>
       )
};

declare updating function csr_proc:process_updating_CSR($db,$careServicesRequest, $doc_name, $base_url,$bindings as map(*))
{

let $doc := csd_dm:open_document($db,$doc_name)
let $function :=$careServicesRequest//csd:function
let $urn := $function/@urn
let $content_type := csr_proc:lookup_stored_content_type($db,$function/@urn)
let $requestParams := <csd:requestParams resource="{$doc_name}" function="{$urn}" base_url="{$base_url}">
  {
    if ($function/csd:requestParams) then $function/csd:requestParams/*
    else $function/requestParams/*
  }
</csd:requestParams>
return csr_proc:process_updating_CSR_stored_results($db,$doc,$requestParams,$bindings)
};

declare function csr_proc:lookup_stored_options($db,$urn)
{
  let $stored_updating_functions := csr_proc:stored_updating_functions($db)
  let $stored_functions := csr_proc:stored_functions($db)
  let $func := ($stored_functions[@urn = $urn], $stored_updating_functions[@urn = $urn])[1]
   return  ($func/csd:extension[@urn='urn:openhie.org:openinfoman:csr_processor' and  @type='xquery:options']/xquery:options)[1]
     (: See: http://docs.basex.org/wiki/XQuery_Module :)
};

declare function csr_proc:lookup_stored_content_type($db,$urn)
{
  let $stored_updating_functions := csr_proc:stored_updating_functions($db)
  let $stored_functions := csr_proc:stored_functions($db)
  return string(($stored_functions[@urn = $urn]/@content-type, $stored_updating_functions[@urn = $urn]/@content-type  , "text/xml")[1])
};


Add functionality for non-string literal values

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

(:~
 :    Transform XML fragments into JSON. The target of this module
 :    is to create a straight-forward Javasript representation of data-centric XML. It does not try to handle
 :    mixed content nodes (with a mix of elements and text).
 :
 :
Special rules

 :
The root element will be absorbed, i.e. <root>text</root> becomes "text".

 :
Child elements with the same name are added to an array.

 :
If an element has attribute and text content, the text content becomes a
 :       property, e.g. '#text': 'my text'.

 :
In mixed content nodes, text nodes will be dropped.

 :
An empty element becomes 'null', i.e. <e/> becomes {"e": null}.

 :
An element with a single text child becomes a property with the value of the text child, i.e.
 :       <e>text</e> becomes {"e": "text"}

 :
If the attribute json:literal="true" is present on an element, then its text value is considered literal and not quoted as a string. Useful for boolean and numberic values!

 :)
module namespace json="http://www.json.org";

(:~
 :   Helper function: output element content for elements with more than one child node or attribute.
 :
 :   Special cases:
 :
 :
Child elements with the same name are added to an array.

 :
If an element has attribute and text content, the text content becomes a
 :       property, e.g. '#text': 'my text'.

 :
In mixed content nodes, text nodes will be dropped.

 :)
declare function json:element-helper($attribs as attribute()*, $children as node()*) {
    string-join((
        (: Output the attributes :)
        for $attr in $attribs
        return
            json:node-to-json($attr),
        if ($children instance of text()+) then
            for $text in $children
            return
                if($text/parent::node()/@json:literal)then
                (
                    $text
                )else(
                    concat('"#text": "', $text, '"')
                )
        else
            for $name in distinct-values(for $c in $children return node-name($c))
            return
                json:node-to-json($children[node-name(.) = $name])
    ),
    ', ')
};

(:~
 :   Helper function: output the contents of a node or attribute.
 :
 :   Special cases:
 :
 :
An empty element becomes 'null', i.e. <e/> becomes {"e": null}.

 :
An element with a single text child becomes a property with the value of the text child, i.e.
 :       <e>text</e> becomes {"e": "text"}

 :)
declare function json:contents-to-json($node as node()) {
    typeswitch ($node)
        case $elem as element() return
            let $children := $elem/node()
            let $attribs := $elem/@*
            return
                (: XML: <e/> JSON: "e": null :)
                if (count($children) eq 0 and count($attribs) eq 0) then
                    'null'
                (: XML: <e>text</e> JSON: "e": "text" :)
                else if (count($children) eq 1 and (count($attribs) eq 0 or $attribs[name() eq "json:literal"])
                    and $children[1] instance of text()) then
                    json:node-to-json($children[1])
                else
                    concat('{', json:element-helper($attribs, $children), '}')
        case $attr as attribute() return
            concat('"', string($attr), '"')
        case $text as text() return
            if($text/parent::node()/@json:literal)then(
                $text
            ) else (
                concat('"', $text, '"')
            )
        default return ()
};
(:~
 :    Helper function: convert a node into JSON.
 :)
declare function json:node-to-json($node as node()+) {
    typeswitch ($node)
        case $elem as element() return
            concat('"', node-name($elem), '" : ', json:contents-to-json($node))
        (: sequence of nodes passed from json:element-helper(), treat as array :)
        case $elements as element()+ return
            concat(
                '"', node-name($elements[1]), '" : [ ',
                string-join(
                    for $e in $elements return json:contents-to-json($e),
                ', '),
                ']'
            )
        case $attr as attribute() return
            if(name($attr) ne "json:literal")then(
                concat('"@', node-name($attr), '": ', json:contents-to-json($attr))
            )else()
        default return
            json:contents-to-json($node)
};

(:~
 :    Main entry point of the module. Convert a single node into JSON.
 :    The root element will be absorbed.
 :)
declare function json:xml-to-json($node as node()) {
    json:contents-to-json($node)
};

(:~
 :    Transform XML fragments into JSON. The target of this module
 :    is to create a straight-forward Javasript representation of data-centric XML. It does not try to handle
 :    mixed content nodes (with a mix of elements and text).
 :
 :
Special rules

 :
The root element will be absorbed, i.e. <root>text</root> becomes "text".

 :
Child elements with the same name are added to an array.

 :
If an element has attribute and text content, the text content becomes a
 :       property, e.g. '#text': 'my text'.

 :
In mixed content nodes, text nodes will be dropped.

 :
An empty element becomes 'null', i.e. <e/> becomes {"e": null}.

 :
An element with a single text child becomes a property with the value of the text child, i.e.
 :       <e>text</e> becomes {"e": "text"}

 :)
module namespace json="http://www.json.org";

(:~
 :   Helper function: output element content for elements with more than one child node or attribute.
 :
 :   Special cases:
 :
 :
Child elements with the same name are added to an array.

 :
If an element has attribute and text content, the text content becomes a
 :       property, e.g. '#text': 'my text'.

 :
In mixed content nodes, text nodes will be dropped.

 :)
declare function json:element-helper($attribs as attribute()*, $children as node()*) {
    string-join((
        (: Output the attributes :)
        for $attr in $attribs
        return
            json:node-to-json($attr),
        if ($children instance of text()+) then
            for $text in $children
            return
                concat('"#text": "', $text, '"')
        else
            for $name in distinct-values(for $c in $children return node-name($c))
            return
                json:node-to-json($children[node-name(.) = $name])
    ),
    ', ')
};

(:~
 :   Helper function: output the contents of a node or attribute.
 :
 :   Special cases:
 :
 :
An empty element becomes 'null', i.e. <e/> becomes {"e": null}.

 :
An element with a single text child becomes a property with the value of the text child, i.e.
 :       <e>text</e> becomes {"e": "text"}

 :)
declare function json:contents-to-json($node as node()) {
    typeswitch ($node)
        case $elem as element() return
            let $children := $elem/node()
            let $attribs := $elem/@*
            return
                (: XML: <e/> JSON: "e": null :)
                if (count($children) eq 0 and count($attribs) eq 0) then
                    'null'
                (: XML: <e>text</e> JSON: "e": "text" :)
                else if (count($children) eq 1 and count($attribs) eq 0
                    and $children[1] instance of text()) then
                    json:node-to-json($children[1])
                else
                    concat('{', json:element-helper($attribs, $children), '}')
        case $attr as attribute() return
            concat('"', string($attr), '"')
        case $text as text() return
            concat('"', $text, '"')
        default return ()
};
(:~
 :    Helper function: convert a node into JSON.
 :)
declare function json:node-to-json($node as node()+) {
    typeswitch ($node)
        case $elem as element() return
            concat('"', node-name($elem), '" : ', json:contents-to-json($node))
        (: sequence of nodes passed from json:element-helper(), treat as array :)
        case $elements as element()+ return
            concat(
                '"', node-name($elements[1]), '" : [ ',
                string-join(
                    for $e in $elements return json:contents-to-json($e),
                ', '),
                ']'
            )
        case $attr as attribute() return
            concat('"@', node-name($attr), '": ', json:contents-to-json($attr))
        default return
            json:contents-to-json($node)
};

(:~
 :    Main entry point of the module. Convert a single node into JSON.
 :    The root element will be absorbed.
 :)
declare function json:xml-to-json($node as node()) {
    json:contents-to-json($node)
};


fixup csd_webconf references

fixup csd_webconf references

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

(:Import other namespaces.  :)
import module namespace csd_webui =  "https://github.com/openhie/openinfoman/csd_webui";
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 csd_mcs = "https://github.com/openhie/openinfoman/csd_mcs";
import module namespace functx = "http://www.functx.com";
import module namespace json = "http://basex.org/modules/json";
import module namespace request = "http://exquery.org/ns/request";

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

declare function page:is_rapidpro($search_name) {
  let $function := csr_proc:get_function_definition($search_name)
  let $ext := $function//csd:extension[  @urn='urn:openhie.org:openinfoman:adapter' and @type='rapidpro']
  return (count($ext) > 0)
};

declare function page:get_actions($search_name) {
  let $function := csr_proc:get_function_definition($search_name)
  return
    (
    for $act in $function//csd:extension[  @urn='urn:openhie.org:openinfoman:adapter:rapidpro:action']/@type
    return string($act)
  )
};

declare
  %rest:path("/CSD/csr/{$doc_name}/careServicesRequest/{$search_name}/adapter/rapidpro")
  %output:method("xhtml")
  function page:show_endpoints($search_name,$doc_name)
{
    if (not(page:is_rapidpro($search_name)) )
      then ('Not a RapidPro Compatible stored function'    )
    else
      let $actions := page:get_actions($search_name)
      let $contents :=

RapidPro Operations on {$doc_name}

        {
          if ($actions = 'get')
	  then

JSON Contacts  -- GET

	     {
	       let $url := csd_webui:generateURL(("CSD/csr/" , $doc_name , "/careServicesRequest/",$search_name, "/adapter/rapidpro/get"))
	       return
Get Contacts

	     }

	  else ()
	}

        {
          if ($actions = 'WebHookGET')
	  then

WebHook  -- GET

	     {
	       let $url := csd_webui:generateURL(("CSD/csr/" , $doc_name , "/careServicesRequest/",$search_name, "/adapter/rapidpro/createDXF"))
	       return
WebHook defined at {$url}

	     }

	  else ()
	}
        {
          if ($actions = 'WebHookPOST')
	  then

WebHook  -- POST

	     {
	       let $url := csd_webui:generateURL(("CSD/csr/" , $doc_name , "/careServicesRequest/",$search_name, "/adapter/rap/createDXF"))
	       return
WebHook defined at {$url}

	     }

	  else ()
	}

      return csd_webui:wrapper($contents)
};

declare
  %rest:path("/CSD/csr/{$doc_name}/careServicesRequest/{$search_name}/adapter/rapidpro/WebHook")
  %rest:query-param("event","{$event}")
  %rest:query-param("relayer","{$relayer}")
  %rest:query-param("relayer_phone","{$relayer_phone}")
  %rest:query-param("phone","{$phone}")
  %rest:query-param("flow","{$flow}")
  %rest:query-param("step","{$step}")
  %rest:query-param("values","{$values}")
  %output:media-type("application/json")
  %rest:POST
  %rest:GET
  function page:webhook($search_name,$doc_name,$event,$relayer,$relayer_phone,$phone,$flow,$step,$values)
{
  if (not(page:is_rapidpro($search_name)) )
    then ('Not a RapidPro Compatible stored function'    )
  else
    let $doc :=  csd_dm:open_document($doc_name)
    let $function := csr_proc:get_function_definition($search_name)

    let $careServicesRequest :=
      <csd:careServicesRequest>
       <csd:function urn="{$search_name}" resource="{$doc_name}" base_url="{csd_webui:generateURL()}">
         <csd:requestParams >
	   <event type="{$event}"/>
	   <relayer id="{$relayer}"/>
	   <relayer_phone number="{$relayer_phone}"/>
	   <phone number="{$phone}"/>
	   <flow id="{$flow}"/>
	   <step id="{$step}"/>
           <values>
	     {
	       if ($values)
	       then    json:parse($values,map{'format':'attributes'})/json/*
	       else ()
	     }
	   </values>
	   {
	     for $param in request:parameter-names()
	     return <query name="{$param}">{request:parameter($param)}</query>
	   }
         </csd:requestParams>
       </csd:function>
      </csd:careServicesRequest>
    return csr_proc:process_CSR_stored_results( $doc,$careServicesRequest)
};

declare
  %rest:path("/CSD/csr/{$doc_name}/careServicesRequest/{$search_name}/adapter/rapidpro/get")
  function page:get($search_name,$doc_name)
{
  if (not(page:is_rapidpro($search_name)) )
    then

    {csr_proc:get_function_definition($search_name)}
    {(concat('Not a RapidPro Compatible stored function: ', $search_name )    )}

  else
    let $doc :=  csd_dm:open_document($doc_name)
    let $function := csr_proc:get_function_definition($search_name)

    let $careServicesRequest :=
      <csd:careServicesRequest>
       <csd:function urn="{$search_name}" resource="{$doc_name}" base_url="{csd_webui:generateURL()}">
         <csd:requestParams/>
       </csd:function>
     </csd:careServicesRequest>
    let $content := csr_proc:process_CSR_stored_results( $doc,$careServicesRequest)
    let $output := $function/@content-type
    let $mime :=
      if (exists($output))
      then string($output)
      else "text/html"
    return
    (
      <rest:response>
	<http:response status="200" >
          <http:header name='Content-Type' value="{$mime}"/>
	  <http:header name='Content-Disposition' value="attachment; filename='{$doc_name}.json'"/>
	</http:response>
      </rest:response>
      ,$content
    )

};

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 csd_webui =  "https://github.com/openhie/openinfoman/csd_webui";
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 csd_mcs = "https://github.com/openhie/openinfoman/csd_mcs";
import module namespace functx = "http://www.functx.com";
import module namespace json = "http://basex.org/modules/json";
import module namespace request = "http://exquery.org/ns/request";

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

declare function page:is_rapidpro($search_name) {
  let $function := csr_proc:get_function_definition($search_name)
  let $ext := $function//csd:extension[  @urn='urn:openhie.org:openinfoman:adapter' and @type='rapidpro']
  return (count($ext) > 0)
};

declare function page:get_actions($search_name) {
  let $function := csr_proc:get_function_definition($search_name)
  return
    (
    for $act in $function//csd:extension[  @urn='urn:openhie.org:openinfoman:adapter:rapidpro:action']/@type
    return string($act)
  )
};

declare
  %rest:path("/CSD/csr/{$doc_name}/careServicesRequest/{$search_name}/adapter/rapidpro")
  %output:method("xhtml")
  function page:show_endpoints($search_name,$doc_name)
{
    if (not(page:is_rapidpro($search_name)) )
      then ('Not a RapidPro Compatible stored function'    )
    else
      let $actions := page:get_actions($search_name)
      let $contents :=

RapidPro Operations on {$doc_name}

        {
          if ($actions = 'get')
	  then

JSON Contacts  -- GET

	     {
	       let $url := csd_webui:generateURL(("CSD/csr/" , $doc_name , "/careServicesRequest/",$search_name, "/adapter/rapidpro/get"))
	       return
Get Contacts

	     }

	  else ()
	}

        {
          if ($actions = 'WebHookGET')
	  then

WebHook  -- GET

	     {
	       let $url := csd_webui:generateURL(("CSD/csr/" , $doc_name , "/careServicesRequest/",$search_name, "/adapter/rapidpro/createDXF"))
	       return
WebHook defined at {$url}

	     }

	  else ()
	}
        {
          if ($actions = 'WebHookPOST')
	  then

WebHook  -- POST

	     {
	       let $url := csd_webui:generateURL(("CSD/csr/" , $doc_name , "/careServicesRequest/",$search_name, "/adapter/rap/createDXF"))
	       return
WebHook defined at {$url}

	     }

	  else ()
	}

      return csd_webui:wrapper($contents)
};

declare
  %rest:path("/CSD/csr/{$doc_name}/careServicesRequest/{$search_name}/adapter/rapidpro/WebHook")
  %rest:query-param("event","{$event}")
  %rest:query-param("relayer","{$relayer}")
  %rest:query-param("relayer_phone","{$relayer_phone}")
  %rest:query-param("phone","{$phone}")
  %rest:query-param("flow","{$flow}")
  %rest:query-param("step","{$step}")
  %rest:query-param("values","{$values}")
  %output:media-type("application/json")
  %rest:POST
  %rest:GET
  function page:webhook($search_name,$doc_name,$event,$relayer,$relayer_phone,$phone,$flow,$step,$values)
{
  if (not(page:is_rapidpro($search_name)) )
    then ('Not a RapidPro Compatible stored function'    )
  else
    let $doc :=  csd_dm:open_document($doc_name)
    let $function := csr_proc:get_function_definition($search_name)

    let $careServicesRequest :=
      <csd:careServicesRequest>
       <csd:function urn="{$search_name}" resource="{$doc_name}" base_url="{csd_webui:generateURL()}">
         <csd:requestParams >
	   <event type="{$event}"/>
	   <relayer id="{$relayer}"/>
	   <relayer_phone number="{$relayer_phone}"/>
	   <phone number="{$phone}"/>
	   <flow id="{$flow}"/>
	   <step id="{$step}"/>
           <values>
	     {
	       if ($values)
	       then    json:parse($values,map{'format':'attributes'})/json/*
	       else ()
	     }
	   </values>
	   {
	     for $param in request:parameter-names()
	     return <query name="{$param}">{request:parameter($param)}</query>
	   }
         </csd:requestParams>
       </csd:function>
      </csd:careServicesRequest>
    return csr_proc:process_CSR_stored_results( $doc,$careServicesRequest)
};

declare
  %rest:path("/CSD/csr/{$doc_name}/careServicesRequest/{$search_name}/adapter/rapidpro/get")
  function page:get($search_name,$doc_name)
{
  if (not(page:is_rapidpro($search_name)) )
    then

    {csr_proc:get_function_definition($search_name)}
    {(concat('Not a RapidPro Compatible stored function: ', $search_name )    )}

  else
    let $doc :=  csd_dm:open_document($doc_name)
    let $function := csr_proc:get_function_definition($search_name)

    let $careServicesRequest :=
      <csd:careServicesRequest>
       <csd:function urn="{$search_name}" resource="{$doc_name}" base_url="{csd_webui:generateURL()}">
         <csd:requestParams/>
       </csd:function>
     </csd:careServicesRequest>
    let $content := csr_proc:process_CSR_stored_results( $doc,$careServicesRequest)
    let $output := $function/@content-type
    let $mime :=
      if (exists($output))
      then string($output)
      else "text/html"
    return
    (
      <rest:response>
	<http:response status="200" >
          <http:header name='Content-Type' value="{$mime}"/>
	  <http:header name='Content-Disposition' value="attachment; filename='{$doc_name}.json'"/>
	</http:response>
      </rest:response>
      ,$content
    )

};