eliminating absolute path

eliminating absolute path

module namespace repo-utils = "http://aac.ac.at/content_repository/utils";

import module namespace xdb="http://exist-db.org/xquery/xmldb";
import module namespace diag =  "http://www.loc.gov/zing/srw/diagnostic/" at  "modules/diagnostics/diagnostics.xqm";
import module namespace request="http://exist-db.org/xquery/request";

(:~ HELPER functions - configuration, caching, data-access
:)

(:
: this all cannot be defined as global variable, because we want different configurations,
: thus the $config has to be sent as param everywhere
: declare variable $repo-utils:config := doc("config.xml");
: declare variable $repo-utils:mappings := doc(repo-utils:config-value('mappings'));
: declare variable $repo-utils:data-collection := collection(repo-utils:config-value('data.path'));
: declare variable $repo-utils:md-collection := collection(repo-utils:config-value('metadata.path'));
: declare variable $repo-utils:cachePath as xs:string := repo-utils:config-value('cache.path');
:)

declare variable $repo-utils:xmlExt as xs:string := ".xml";
declare variable $repo-utils:responseFormatXml as xs:string := "xml";
declare variable $repo-utils:responseFormatJSon as xs:string := "json";
declare variable $repo-utils:responseFormatText as xs:string := "text";
declare variable $repo-utils:responseFormatHTML as xs:string := "html";
declare variable $repo-utils:responseFormatHTMLpage as xs:string := "htmlpage";

declare variable $repo-utils:sys-config-file := "conf/config-system.xml";

declare function repo-utils:base-url($config) as xs:string* {
    let $server-base := if (repo-utils:config-value($config, 'server.base') = '') then ''  else repo-utils:config-value($config, 'server.base')
    let $config-base-url := if (repo-utils:config-value($config, 'base.url') = '') then request:get-uri() else repo-utils:config-value($config, 'base.url')
    return concat($server-base, $config-base-url)
};

declare function repo-utils:config($config-file as xs:string) as node()* {
let $sys-config := if (doc-available($repo-utils:sys-config-file)) then doc($repo-utils:sys-config-file) else (),
    $config := if (doc-available($config-file)) then (doc($config-file), $sys-config)
                        else diag:diagnostics("general-error", concat("config not available: ", $config-file))
    return $config
};

declare function repo-utils:config-value($config, $key as xs:string) as xs:string* {
    ($config[not(@type='system')]//property[@key=$key], $config[@type='system']//property[@key=$key])[1]
};

(:~ Get value of a param based on a key, from config or from request-param (precedence) :)
declare function repo-utils:param-value($config, $key as xs:string, $default as xs:string) as xs:string* {

    let $param := request:get-parameter($key, $default)
    return if ($param) then $param else $config//property[@key=$key]
};

(:~ returns db-collection (as nodeset) based on the identifier in x-context, looked up in the mapping or default collection as defined in config

@returns nodeset of given context
 if no x-context match or no context provided returns default collection from the config (data.path )
 (if available, otherwise again empty result)

WATCHME: changed to lax handling of the context (if no match - go to default)
        gives better recall, but may confuse - alternatively: strict: empty result if x-context does not match
TODO: accept $x-context as xs:string*
:)
declare function repo-utils:context-to-collection($x-context as xs:string, $config) as node()* {
(:      let $mappings := doc(repo-utils:config-value($config, 'mappings')):)
      let $dbcoll-path := repo-utils:context-to-collection-path($x-context, $config)
    return if ($dbcoll-path eq "" ) then ()
                else collection($dbcoll-path)
};

(:~ returns path to db-collection (as nodeset) based on the identifier in x-context,
looked up in the mapping or default data.path as defined in config

@returns dbcoll-path of given context
 if no x-context match or no context provided returns default collection from the config (data.path )
 (if available, otherwise again empty result)

WATCHME: changed to lax handling of the context (if no match - go to default)
        gives better recall, but may confuse - alternatively: strict: empty result if x-context does not match
changed again: only give default if x-context is empty string or 'default'-string.
T
:)
declare function repo-utils:context-to-collection-path($x-context as xs:string, $config) as xs:string {
      let $mappings:= doc(repo-utils:config-value($config, 'mappings'))
    return    (: if ($x-context) then :)
            if (exists($mappings//map[xs:string(@key) eq $x-context]/@path)) then
                    $mappings//map[xs:string(@key) eq $x-context]/xs:string(@path)
                (: else "" :)
                  else if (exists(repo-utils:config-value($config, 'data.path')) and
                            ($x-context = ('', 'default'))) then
                        repo-utils:config-value($config, 'data.path')
                  else ""
};

(:~ Get the resource by PID/handle/URL or some known identifier.
  TODO: NOT ADAPTED YET! (taken from CMD)
  TODO: be clear about resource itself and metadata-record!
:)
(:declare function repo-utils:get-resource-by-id($id as xs:string) as node()* {
  let $collection := collection($cr:dataPath)
  return
    if ($id eq "" or $id eq $cr:collectionRoot) then
    $collection//IsPartOf[. = $cr:collectionRoot]/ancestor::CMD
  else
    util:eval(concat("$collection/ft:query(descendant::MdSelfLink, <term>", xdb:decode($id), "</term>)/ancestor::CMD"))
 (\: $collection/descendant::MdSelfLink[. = xdb:decode($id)]/ancestor::CMD :\)
};
:)

(:~ Checks whether the document is available or not.
  generic, currently not used
:)
declare function repo-utils:is-doc-available($collection as xs:string, $doc-name as xs:string) as xs:boolean {
  fn:doc-available(fn:concat($collection, "/", $doc-name))
};

declare function repo-utils:is-in-cache($doc-name as xs:string,$config) as xs:boolean {
  fn:doc-available(fn:concat(repo-utils:config-value($config, 'cache.path'), "/", $doc-name))
};

declare function repo-utils:get-from-cache($doc-name as xs:string,$config) as item()* {
      fn:doc(fn:concat(repo-utils:config-value($config, 'cache.path'), "/", $doc-name))
};

(:~ Store the data in cache. Uses own writer-account
:)
declare function repo-utils:store-in-cache($doc-name as xs:string, $data as node(),$config) as item()* {
  let $clarin-writer := fn:doc("/db/cr/writer.xml"),
  $cache-path := repo-utils:config-value($config, 'cache.path'),
  $dummy := xdb:login($cache-path, $clarin-writer//write-user/text(), $clarin-writer//write-user-cred/text()),
  $store := (: util:catch("org.exist.xquery.XPathException", :) xdb:store($cache-path, $doc-name, $data), (: , ()) :)
  $stored-doc := fn:doc(concat($cache-path, "/", $doc-name))
  return $stored-doc
(:  ():)
};

(:
this tries to create sub-collections in index for
individual data-collection - but it makes the retrieval etc. also more complicated
so rather encoding the data-collection also in the name

declare function repo-utils:store-in-cache($data-collection as item(), $doc-name as xs:string, $data as node()) as item()* {
    let $data-coll-name := collection-name($data-collection)
    let $index-coll-path := concat($repo-utils:cachePath, "/", $data-coll-name )
   let $create-coll := if (not(xmldb:collection-available($index-coll-path ))) then
                           xmldb:create-collection($repo-utils:cachePath, $data-collname) else ()
  let $store-result := repo-utils:store($index-coll-path, $doc-name, $data, true())

return $store-result
};
:)

(:<options><option key="update">yes</option></options>:)
declare function repo-utils:store($collection as xs:string, $doc-name as xs:string, $data as node(), $overwrite as xs:boolean) as item()* {
  let $clarin-writer := fn:doc("writer.xml"),
  $dummy := xdb:login($collection, $clarin-writer//write-user/text(), $clarin-writer//write-user-cred/text())

  let $rem := if ($overwrite and doc-available(concat($collection, $doc-name))) then xdb:remove($collection, $doc-name) else ()

  let $store := (: util:catch("org.exist.xquery.XPathException", :) xdb:store($collection, $doc-name, $data), (: , ()) :)
  $stored-doc := fn:doc(concat($collection, "/", $doc-name))
  return $stored-doc
};

declare function repo-utils:gen-cache-id($type-name as xs:string, $keys as xs:string+, $depth as xs:string) as xs:string {
    repo-utils:gen-cache-id($type-name , ($keys, $depth) )
};
(:~ Create document name with md5-hash for selected collections (or types) for reuse.
:)
declare function repo-utils:gen-cache-id($type-name as xs:string, $keys as xs:string+) as xs:string {
       let $sanitized-names := for $key in $keys return repo-utils:sanitize-name($key)
    return
(:    fn:concat($name-prefix, "-", util:hash(string-join($sorted-names, ""), "MD5"), $repo-utils:xmlExt):)
    fn:concat($type-name, "-", string-join($sanitized-names, "-"), $repo-utils:xmlExt)
};

(:~ wipes out problematic characters from names
:)
declare function repo-utils:sanitize-name($name as xs:string) as xs:string {
    translate($name, ":/",'_')
};

declare function repo-utils:serialise-as($item as node()?, $format as xs:string, $operation as xs:string, $config) as item()? {
    repo-utils:serialise-as($item, $format, $operation, $config, ())
};

(:~ transform result to HTML, JSON, or leave as XML - according to format parameter

@param $parameters optional additional parameters to be passed to xsl
:)
declare function repo-utils:serialise-as($item as node()?, $format as xs:string, $operation as xs:string, $config, $parameters as node()* ) as item()? {
        if ($format eq $repo-utils:responseFormatJSon) then
	       let $option := util:declare-option("exist:serialize", "method=json media-type=application/json")
	       return $item
	    else if (contains($format, $repo-utils:responseFormatHTML)) then
	           let $xslDoc := doc(concat(repo-utils:config-value($config, 'scripts.path'), repo-utils:config-value($config, concat($operation, ".xsl"))) )
	           let $res := transform:transform($item,$xslDoc,
              			<parameters><param name="format" value="{$format}"/>
              			            <param name="x-context" value="{repo-utils:param-value($config, 'x-context', '' )}"/>
              			            <param name="base_url" value="{repo-utils:base-url($config)}"/>
              			            <param name="mappings-file" value="{repo-utils:config-value($config, 'mappings')}"/>
              			            <param name="scripts_url" value="{repo-utils:config-value($config, 'scripts.url')}"/>
              			             <param name="site_name" value="{repo-utils:config-value($config, 'site.name')}"/>
              			             <param name="site_logo" value="{repo-utils:config-value($config, 'site.logo')}"/>
              			             {$parameters/param}
              			</parameters>)
(:               let $option := util:declare-option("exist:serialize", "method=xml media-type=text/html"):)
let $option := util:declare-option("exist:serialize", "method=xhtml media-type=text/html")
	           return $res
	   else
	       let $option := util:declare-option("exist:serialize", "method=xml media-type=application/xml")
	    return $item
};
(: $repo-utils:responseFormatXml, $repo-utils:responseFormatText:)

	    (:let $option :=
	              if (contains($format, $repo-utils:responseFormatHTML)) then
	                  util:declare-option("exist:serialize", "method=xml media-type=text/xhtml")
	              else
    	              util:declare-option("exist:serialize", "method=xml media-type=application/xml")
:)

	          	(: $item :)

(:
testing when trying to log import 2012-10-24 - not used
declare function repo-utils:write-log ($action as xs:string, $dataset as xs:string) {

			let $log-doc := repo-utils:config
			let $data := <log timestamp="{$timestamp}">{current-dateTime()}
			             </log>
			  return	xmldb:store($data-path, "test.log", $data )

	let $time := util:system-dateTime()
    let $upd-dummy :=
        update insert <xpath key="{$xpath/@key}" label="{$xpath/@label}" dur="{$duration}">{$answer}</xpath> into $result-doc/result

    return $result-doc

};:)

module namespace repo-utils = "http://aac.ac.at/content_repository/utils";

import module namespace xdb="http://exist-db.org/xquery/xmldb";
import module namespace diag =  "http://www.loc.gov/zing/srw/diagnostic/" at  "modules/diagnostics/diagnostics.xqm";
import module namespace request="http://exist-db.org/xquery/request";

(:~ HELPER functions - configuration, caching, data-access
:)

(:
: this all cannot be defined as global variable, because we want different configurations,
: thus the $config has to be sent as param everywhere
: declare variable $repo-utils:config := doc("config.xml");
: declare variable $repo-utils:mappings := doc(repo-utils:config-value('mappings'));
: declare variable $repo-utils:data-collection := collection(repo-utils:config-value('data.path'));
: declare variable $repo-utils:md-collection := collection(repo-utils:config-value('metadata.path'));
: declare variable $repo-utils:cachePath as xs:string := repo-utils:config-value('cache.path');
:)

declare variable $repo-utils:xmlExt as xs:string := ".xml";
declare variable $repo-utils:responseFormatXml as xs:string := "xml";
declare variable $repo-utils:responseFormatJSon as xs:string := "json";
declare variable $repo-utils:responseFormatText as xs:string := "text";
declare variable $repo-utils:responseFormatHTML as xs:string := "html";
declare variable $repo-utils:responseFormatHTMLpage as xs:string := "htmlpage";

declare variable $repo-utils:sys-config-file := "conf/config-system.xml";

declare function repo-utils:base-url($config) as xs:string* {
    let $server-base := if (repo-utils:config-value($config, 'server.base') = '') then ''  else repo-utils:config-value($config, 'server.base')
    let $config-base-url := if (repo-utils:config-value($config, 'base.url') = '') then request:get-uri() else repo-utils:config-value($config, 'base.url')
    return concat($server-base, $config-base-url)
};

declare function repo-utils:config($config-file as xs:string) as node()* {
let $sys-config := if (doc-available($repo-utils:sys-config-file)) then doc($repo-utils:sys-config-file) else (),
    $config := if (doc-available($config-file)) then (doc($config-file), $sys-config)
                        else diag:diagnostics("general-error", concat("config not available: ", $config-file))
    return $config
};

declare function repo-utils:config-value($config, $key as xs:string) as xs:string* {
    ($config[not(@type='system')]//property[@key=$key], $config[@type='system']//property[@key=$key])[1]
};

(:~ Get value of a param based on a key, from config or from request-param (precedence) :)
declare function repo-utils:param-value($config, $key as xs:string, $default as xs:string) as xs:string* {

    let $param := request:get-parameter($key, $default)
    return if ($param) then $param else $config//property[@key=$key]
};

(:~ returns db-collection (as nodeset) based on the identifier in x-context, looked up in the mapping or default collection as defined in config

@returns nodeset of given context
 if no x-context match or no context provided returns default collection from the config (data.path )
 (if available, otherwise again empty result)

WATCHME: changed to lax handling of the context (if no match - go to default)
        gives better recall, but may confuse - alternatively: strict: empty result if x-context does not match
TODO: accept $x-context as xs:string*
:)
declare function repo-utils:context-to-collection($x-context as xs:string, $config) as node()* {
(:      let $mappings := doc(repo-utils:config-value($config, 'mappings')):)
      let $dbcoll-path := repo-utils:context-to-collection-path($x-context, $config)
    return if ($dbcoll-path eq "" ) then ()
                else collection($dbcoll-path)
};

(:~ returns path to db-collection (as nodeset) based on the identifier in x-context,
looked up in the mapping or default data.path as defined in config

@returns dbcoll-path of given context
 if no x-context match or no context provided returns default collection from the config (data.path )
 (if available, otherwise again empty result)

WATCHME: changed to lax handling of the context (if no match - go to default)
        gives better recall, but may confuse - alternatively: strict: empty result if x-context does not match
changed again: only give default if x-context is empty string or 'default'-string.
T
:)
declare function repo-utils:context-to-collection-path($x-context as xs:string, $config) as xs:string {
      let $mappings:= doc(repo-utils:config-value($config, 'mappings'))
    return    (: if ($x-context) then :)
            if (exists($mappings//map[xs:string(@key) eq $x-context]/@path)) then
                    $mappings//map[xs:string(@key) eq $x-context]/xs:string(@path)
                (: else "" :)
                  else if (exists(repo-utils:config-value($config, 'data.path')) and
                            ($x-context = ('', 'default'))) then
                        repo-utils:config-value($config, 'data.path')
                  else ""
};

(:~ Get the resource by PID/handle/URL or some known identifier.
  TODO: NOT ADAPTED YET! (taken from CMD)
  TODO: be clear about resource itself and metadata-record!
:)
(:declare function repo-utils:get-resource-by-id($id as xs:string) as node()* {
  let $collection := collection($cr:dataPath)
  return
    if ($id eq "" or $id eq $cr:collectionRoot) then
    $collection//IsPartOf[. = $cr:collectionRoot]/ancestor::CMD
  else
    util:eval(concat("$collection/ft:query(descendant::MdSelfLink, <term>", xdb:decode($id), "</term>)/ancestor::CMD"))
 (\: $collection/descendant::MdSelfLink[. = xdb:decode($id)]/ancestor::CMD :\)
};
:)

(:~ Checks whether the document is available or not.
  generic, currently not used
:)
declare function repo-utils:is-doc-available($collection as xs:string, $doc-name as xs:string) as xs:boolean {
  fn:doc-available(fn:concat($collection, "/", $doc-name))
};

declare function repo-utils:is-in-cache($doc-name as xs:string,$config) as xs:boolean {
  fn:doc-available(fn:concat(repo-utils:config-value($config, 'cache.path'), "/", $doc-name))
};

declare function repo-utils:get-from-cache($doc-name as xs:string,$config) as item()* {
      fn:doc(fn:concat(repo-utils:config-value($config, 'cache.path'), "/", $doc-name))
};

(:~ Store the data in cache. Uses own writer-account
:)
declare function repo-utils:store-in-cache($doc-name as xs:string, $data as node(),$config) as item()* {
  let $clarin-writer := fn:doc("/db/cr/writer.xml"),
  $cache-path := repo-utils:config-value($config, 'cache.path'),
  $dummy := xdb:login($cache-path, $clarin-writer//write-user/text(), $clarin-writer//write-user-cred/text()),
  $store := (: util:catch("org.exist.xquery.XPathException", :) xdb:store($cache-path, $doc-name, $data), (: , ()) :)
  $stored-doc := fn:doc(concat($cache-path, "/", $doc-name))
  return $stored-doc
(:  ():)
};

(:
this tries to create sub-collections in index for
individual data-collection - but it makes the retrieval etc. also more complicated
so rather encoding the data-collection also in the name

declare function repo-utils:store-in-cache($data-collection as item(), $doc-name as xs:string, $data as node()) as item()* {
    let $data-coll-name := collection-name($data-collection)
    let $index-coll-path := concat($repo-utils:cachePath, "/", $data-coll-name )
   let $create-coll := if (not(xmldb:collection-available($index-coll-path ))) then
                           xmldb:create-collection($repo-utils:cachePath, $data-collname) else ()
  let $store-result := repo-utils:store($index-coll-path, $doc-name, $data, true())

return $store-result
};
:)

(:<options><option key="update">yes</option></options>:)
declare function repo-utils:store($collection as xs:string, $doc-name as xs:string, $data as node(), $overwrite as xs:boolean) as item()* {
  let $clarin-writer := fn:doc("/db/cr/writer.xml"),
  $dummy := xdb:login($collection, $clarin-writer//write-user/text(), $clarin-writer//write-user-cred/text())

  let $rem := if ($overwrite and doc-available(concat($collection, $doc-name))) then xdb:remove($collection, $doc-name) else ()

  let $store := (: util:catch("org.exist.xquery.XPathException", :) xdb:store($collection, $doc-name, $data), (: , ()) :)
  $stored-doc := fn:doc(concat($collection, "/", $doc-name))
  return $stored-doc
};

declare function repo-utils:gen-cache-id($type-name as xs:string, $keys as xs:string+, $depth as xs:string) as xs:string {
    repo-utils:gen-cache-id($type-name , ($keys, $depth) )
};
(:~ Create document name with md5-hash for selected collections (or types) for reuse.
:)
declare function repo-utils:gen-cache-id($type-name as xs:string, $keys as xs:string+) as xs:string {
       let $sanitized-names := for $key in $keys return repo-utils:sanitize-name($key)
    return
(:    fn:concat($name-prefix, "-", util:hash(string-join($sorted-names, ""), "MD5"), $repo-utils:xmlExt):)
    fn:concat($type-name, "-", string-join($sanitized-names, "-"), $repo-utils:xmlExt)
};

(:~ wipes out problematic characters from names
:)
declare function repo-utils:sanitize-name($name as xs:string) as xs:string {
    translate($name, ":/",'_')
};

declare function repo-utils:serialise-as($item as node()?, $format as xs:string, $operation as xs:string, $config) as item()? {
    repo-utils:serialise-as($item, $format, $operation, $config, ())
};

(:~ transform result to HTML, JSON, or leave as XML - according to format parameter

@param $parameters optional additional parameters to be passed to xsl
:)
declare function repo-utils:serialise-as($item as node()?, $format as xs:string, $operation as xs:string, $config, $parameters as node()* ) as item()? {
        if ($format eq $repo-utils:responseFormatJSon) then
	       let $option := util:declare-option("exist:serialize", "method=json media-type=application/json")
	       return $item
	    else if (contains($format, $repo-utils:responseFormatHTML)) then
	           let $xslDoc := doc(concat(repo-utils:config-value($config, 'scripts.path'), repo-utils:config-value($config, concat($operation, ".xsl"))) )
	           let $res := transform:transform($item,$xslDoc,
              			<parameters><param name="format" value="{$format}"/>
              			            <param name="x-context" value="{repo-utils:param-value($config, 'x-context', '' )}"/>
              			            <param name="base_url" value="{repo-utils:base-url($config)}"/>
              			            <param name="mappings-file" value="{repo-utils:config-value($config, 'mappings')}"/>
              			            <param name="scripts_url" value="{repo-utils:config-value($config, 'scripts.url')}"/>
              			             <param name="site_name" value="{repo-utils:config-value($config, 'site.name')}"/>
              			             <param name="site_logo" value="{repo-utils:config-value($config, 'site.logo')}"/>
              			             {$parameters/param}
              			</parameters>)
(:               let $option := util:declare-option("exist:serialize", "method=xml media-type=text/html"):)
let $option := util:declare-option("exist:serialize", "method=xhtml media-type=text/html")
	           return $res
	   else
	       let $option := util:declare-option("exist:serialize", "method=xml media-type=application/xml")
	    return $item
};
(: $repo-utils:responseFormatXml, $repo-utils:responseFormatText:)

	    (:let $option :=
	              if (contains($format, $repo-utils:responseFormatHTML)) then
	                  util:declare-option("exist:serialize", "method=xml media-type=text/xhtml")
	              else
    	              util:declare-option("exist:serialize", "method=xml media-type=application/xml")
:)

	          	(: $item :)

(:
testing when trying to log import 2012-10-24 - not used
declare function repo-utils:write-log ($action as xs:string, $dataset as xs:string) {

			let $log-doc := repo-utils:config
			let $data := <log timestamp="{$timestamp}">{current-dateTime()}
			             </log>
			  return	xmldb:store($data-path, "test.log", $data )

	let $time := util:system-dateTime()
    let $upd-dummy :=
        update insert <xpath key="{$xpath/@key}" label="{$xpath/@label}" dur="{$duration}">{$answer}</xpath> into $result-doc/result

    return $result-doc

};:)


cleaned up test docs menu

cleaned up test docs menu

module namespace page = 'http://basex.org/modules/web-page';
import module namespace csd = "urn:ihe:iti:csd:2013" at "../repo/csd_base_library.xqm";
import module namespace csr_proc = "https://github.com/his-interop/openinfoman/csr_proc" at "../repo/csr_processor.xqm";
import module namespace csd_webconf =  "https://github.com/his-interop/openinfoman/csd_webconf" at "../repo/csd_webapp_config.xqm";
import module namespace csd_lsd = "https://github.com/his-interop/openinfoman/csd_lsd" at "../repo/csd_load_sample_directories.xqm";
import module namespace csd_dm = "https://github.com/his-interop/openinfoman/csd_dm" at "../repo/csd_document_manager.xqm";

declare variable $page:test_doc_dirs :=
   ( "../resources/test_docs/"
    ,"../resources-pr/test_docs/"
   );

declare variable $page:test_docs :=
for $test_doc_dir in $page:test_doc_dirs
where file:exists($test_doc_dir)
return file:list($test_doc_dir,boolean('false'),"*.xml");

declare
  %output:method("xhtml")
  %rest:path("/CSD/test/{$name}")
  %rest:GET
function page:show_test_menu($name) {
  page:wrapper(page:test_menu($name))
};

declare
  %rest:path("/CSD/test/{$name}/{$test}")
  %rest:GET
  function page:test($name, $test as xs:string)
{
let $test_doc := page:get_test_doc($test)
return if ($test_doc) then
  csr_proc:process_CSR($test_doc/csd:careServicesRequest,csd_dm:open_document($csd_webconf:db,$name))
else
   (:need better error handling:)

Bad Test Doc

};

declare
  %rest:path("/CSD/test_source/{$test}")
  %rest:GET
  %output:method("xml")
  function page:test_source(
    $test as xs:string)
{
let $test_doc := page:get_test_doc($test)
return if ($test_doc) then
 $test_doc
else

Shame on you

};

declare function page:get_test_doc($test) {
let $files :=
  for $test_doc_dir in $page:test_doc_dirs
  let $dir_base := file:resolve-path($test_doc_dir)
  let $file := file:resolve-path(concat($dir_base , "/" ,$test,".xml"))
  return if ( file:exists($file))  then $file else ()

return if ( count($files) > 0) then
  doc($files[1])
else
  ()
};

declare
  %rest:path("/CSD/test")
  %rest:GET
  %output:method("xhtml")
  function page:list_tests()
{
let $response:=

Registered Documents

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

  }

  {
    for $name in csd_dm:registered_documents($csd_webconf:db)
    return
Tests for {$name}
{page:test_menu($name)}
  }

return page:wrapper($response)
};

declare function page:test_menu($name)
{

  To test submission on your machine you can do:

  curl --data "@test.xml" {$csd_webconf:baseurl}CSD/csr/{$name}/careServicesRequest --header "content-type: text/xml"

  where test.xml is one of the downloaded source documents below

    {for $test_doc in $page:test_docs
    order by $test_doc
    let $test := csd_lsd:fn_base_name($test_doc,".xml")
    return

    {$test}: process on server  /
     download source

    }

};

declare function page:wrapper($response) {

    <link href="{$csd_webconf:baseurl}static/bootstrap/css/bootstrap.css" rel="stylesheet"/>
    <link href="{$csd_webconf:baseurl}static/bootstrap/css/bootstrap-theme.css" rel="stylesheet"/>

module namespace page = 'http://basex.org/modules/web-page';
import module namespace csd = "urn:ihe:iti:csd:2013" at "../repo/csd_base_library.xqm";
import module namespace csr_proc = "https://github.com/his-interop/openinfoman/csr_proc" at "../repo/csr_processor.xqm";
import module namespace csd_webconf =  "https://github.com/his-interop/openinfoman/csd_webconf" at "../repo/csd_webapp_config.xqm";
import module namespace csd_lsd = "https://github.com/his-interop/openinfoman/csd_lsd" at "../repo/csd_load_sample_directories.xqm";
import module namespace csd_dm = "https://github.com/his-interop/openinfoman/csd_dm" at "../repo/csd_document_manager.xqm";

declare variable $page:test_doc_dirs :=
   ( "../resources/test_docs/"
    ,"../resources-pr/test_docs/"
   );

declare variable $page:test_docs :=
for $test_doc_dir in $page:test_doc_dirs
where file:exists($test_doc_dir)
return file:list($test_doc_dir,boolean('false'),"*.xml");

declare
  %output:method("xhtml")
  %rest:path("/CSD/test/{$name}")
  %rest:GET
function page:show_test_menu($name) {
  page:wrapper(page:test_menu($name))
};

declare
  %rest:path("/CSD/test/{$name}/{$test}")
  %rest:GET
  function page:test($name, $test as xs:string)
{
let $test_doc := page:get_test_doc($test)
return if ($test_doc) then
  csr_proc:process_CSR($test_doc/csd:careServicesRequest,csd_dm:open_document($csd_webconf:db,$name))
else
   (:need better error handling:)

Bad Test Doc

};

declare
  %rest:path("/CSD/test_source/{$test}")
  %rest:GET
  %output:method("xml")
  function page:test_source(
    $test as xs:string)
{
let $test_doc := page:get_test_doc($test)
return if ($test_doc) then
 $test_doc
else

Shame on you

};

declare function page:get_test_doc($test) {
let $files :=
  for $test_doc_dir in $page:test_doc_dirs
  let $dir_base := file:resolve-path($test_doc_dir)
  let $file := file:resolve-path(concat($dir_base , "/" ,$test,".xml"))
  return if ( file:exists($file))  then $file else ()

return if ( count($files) > 0) then
  doc($files[1])
else
  ()
};

declare
  %rest:path("/CSD/test")
  %rest:GET
  %output:method("xhtml")
  function page:list_tests()
{
let $response:=

Registered Documents

  {
    for $name in csd_dm:registered_documents($csd_webconf:db)
    return
Tests for {$name}
{page:test_menu($name)}
  }

Available Stored Functions:

    {for $sf in ($csd_webconf:stored_functions,$csd_webconf:stored_updating_functions)
    return

    UUID: {string($sf/@uuid)}

    Returns: {csd_webconf:lookup_stored_content_type($sf/@uuid)}

    Description:
 {$sf/csd:description/*}

    }

return page:wrapper($response)
};

declare function page:test_menu($name)
{

  To test submission on your machine you can do:

  curl --data "@test.xml" {$csd_webconf:baseurl}CSD/csr/{$name}/careServicesRequest --header "content-type: text/xml"

  where test.xml is one of the downloaded source documents below

    {for $test_doc in $page:test_docs
    order by $test_doc
    let $test := csd_lsd:fn_base_name($test_doc,".xml")
    return

    {$test}: process on server  /
     download source

    }

};

declare function page:wrapper($response) {

    <link href="{$csd_webconf:baseurl}static/bootstrap/css/bootstrap.css" rel="stylesheet"/>
    <link href="{$csd_webconf:baseurl}static/bootstrap/css/bootstrap-theme.css" rel="stylesheet"/>


Change extension endpoint to return a zip file

xquery version "1.0-ml";

module namespace resource = "http://marklogic.com/rest-api/resource/export-presentation-ml";

declare namespace html = "http://www.w3.org/1999/xhtml";
declare namespace zip = "xdmp:zip";

declare function get(
  $context as map:map,
  $params  as map:map
  ) as document-node()*
{
  let $dir := map:get($params, "dir")
  let $template := (map:get($params, "template"), "template")[1]
  let $zip-manifest :=
    <parts xmlns="xdmp:zip">
      <part>docProps/app.xml</part>
      <part>docProps/core.xml</part>
    </parts>
  let $zip :=
    xdmp:zip-create(
      $zip-manifest,
      (
        fn:doc("/template.pptx/docProps/app.xml"),
        fn:doc("/template.pptx/docProps/core.xml")
      )
    )
  return
  (
    map:put($context, "output-types", "application/zip"),
    document{ binary {$zip} }
  )
};

declare function put(
  $context as map:map,
  $params  as map:map,
  $input   as document-node()*
  ) as document-node()?
{
  xdmp:log("PUT called")
};

declare function post(
  $context as map:map,
  $params  as map:map,
  $input   as document-node()*
  ) as document-node()*
{
  xdmp:log("POST called")
};

declare function delete(
  $context as map:map,
  $params  as map:map
  ) as document-node()?
{
  xdmp:log("DELETE called")
};

xquery version "1.0-ml";

module namespace resource = "http://marklogic.com/rest-api/resource/export-presentation-ml";

declare namespace html = "http://www.w3.org/1999/xhtml";

declare function get(
  $context as map:map,
  $params  as map:map
  ) as document-node()*
{
  let $dir := map:get($params, "dir")
  let $template := (map:get($params, "template"), "template")[1]
  let $doc :=
    document {
      element html:html {
        element html:body {
          element html:p { fn:concat("dir: ", $dir) },
          element html:p { fn:concat("template: ", $template) },
          for $uri in cts:uris("", (), cts:directory-query(fn:concat("/", $template, ".pptx/"), "infinity"))
          return element html:p { $uri }
        }
      }
    }
  return $doc
};

declare function put(
  $context as map:map,
  $params  as map:map,
  $input   as document-node()*
  ) as document-node()?
{
  xdmp:log("PUT called")
};

declare function post(
  $context as map:map,
  $params  as map:map,
  $input   as document-node()*
  ) as document-node()*
{
  xdmp:log("POST called")
};

declare function delete(
  $context as map:map,
  $params  as map:map
  ) as document-node()?
{
  xdmp:log("DELETE called")
};


Use normalize-space() to get rid of extraneous space after punctuation.

declare variable $pos := //parts-of-speech;
declare variable $morph := //morphology;

declare function local:morph-description($tag, $category)
{
   $morph/field[@tag=$category]/value[@tag=$tag]/@summary ! string(.)
};

declare function local:number($morph as xs:string)
{
  let $tag := substring($morph,2,1)
  where $tag != "-"
  return
    attribute number {
      local:morph-description($tag, "number")
    }
};

declare function local:person($morph as xs:string)
{
  let $tag := substring($morph,1,1)
  where $tag != "-"
  return
    attribute person {
      tokenize(local:morph-description($tag, "person"))[1]
    }
};

declare function local:gender($morph as xs:string)
{
  let $tag := substring($morph,6,1)
  where $tag != "-"
  return
    attribute gender {
      local:morph-description($tag,"gender")
    }
};

declare function local:case($morph as xs:string)
{
  let $tag := substring($morph,7,1)
  where $tag != "-"
  return
    attribute case {
      local:morph-description($tag,"case")
    }
};

declare function local:tense($morph as xs:string)
{
  let $tag := substring($morph,3,1)
  where $tag != "-"
  return
    attribute tense {
      local:morph-description($tag,"tense")
    }
};

declare function local:voice($morph as xs:string)
{
  let $tag := substring($morph,5,1)
  where $tag != "-"
  return
    attribute voice {
      local:morph-description($tag,"voice")
    }
};

declare function local:mood($morph as xs:string)
{
  let $tag := substring($morph,4,1)
  where $tag != "-"
  return
    attribute mood {
      local:morph-description($tag,"mood")
    }
};

declare function local:degree($morph as xs:string)
{
  let $tag := substring($morph,8,1)
  where $tag != "-"
  return
    attribute degree {
      local:morph-description($tag,"degree")
    }
};

declare function local:strength($morph as xs:string)
{
  let $tag := substring($morph,9,1)
  where $tag != "-"
  return
    attribute strength {
      local:morph-description($tag,"strength")
    }
};

declare function local:inflection($morph as xs:string)
{
  let $tag := substring($morph,10,1)
  where $tag != "-"
  return
    attribute inflection {
      local:morph-description($tag,"inflection")
    }
};

declare function local:morphology($t)
{
  let $morph := string($t/@morphology)
  where $morph
  return (
    $t/@lemma,
    local:number($morph),
    local:person($morph),
    local:gender($morph),
    local:case($morph),
    local:tense($morph),
    local:voice($morph),
    local:mood($morph),
    local:degree($morph),
    local:strength($morph),
    local:inflection($morph)
  )
};

declare function local:class($t)
{
  let $description :=  string($pos/value[@tag = $t/@part-of-speech]/@summary)
  let $class :=
    switch ($description)
      case "interrogative adverb" return "adverb"
      case "relative adverb" return "adverb"
      case "common noun" return "noun"
      case "proper noun" return "noun"
      case "cardinal numeral" return "numeral"
      case "ordinal numeral" return "numeral"
      case "demonstrative pronoun" return "pronoun"
      case "indefinite pronoun" return "pronoun"
      case "interrogative pronoun" return "pronoun"
      case "relative pronoun" return "pronoun"
      case "personal pronoun" return "pronoun"
      case "personal reflexive pronoun" return "pronoun"
      case "possessive pronoun" return "pronoun"
      case "possessive reflexive pronoun" return "pronoun"
      case "reciprocal pronoun" return "pronoun"
      case "" return ()
      default return $description
  let $type :=
    switch ($description)
      case "interrogative adverb" return "interrogative"
      case "relative adverb" return "relative"
      case "common noun" return "common"
      case "proper noun" return "proper"
      case "cardinal numeral" return "cardinal"
      case "ordinal numeral" return "ordinal"
      case "demonstrative pronoun" return "demonstrative"
      case "indefinite pronoun" return "indefinite"
      case "interrogative pronoun" return "interrogative"
      case "relative pronoun" return "relative"
      case "personal pronoun" return "personal"
      case "personal reflexive pronoun" return "personal relative"
      case "possessive pronoun" return "possessive"
      case "possessive reflexive pronoun" return "possessive reflexive"
      case "reciprocal pronoun" return "reciprocal"
      default return ()
  return
    (
      $class ! attribute class {$class},
      $type ! attribute type {$type}
    )
};

declare function local:token($t)
{
  <w>
    {
      local:class($t),
      attribute role {$t/@relation},
      local:morphology($t),
      attribute id {$t/@id},
      $t/@head-id ! attribute head-id {$t/@head-id }
    }
    {
      string($t/@form)
    }
  </w>,
  $t/@presentation-after[. != ' '] ! <pc>{normalize-string(.)}</pc>
};

declare function local:unwrap($t, $stok)
{
  let $children :=  $stok[@head-id = $t/@id]
  let $seq := ($children | $t)/.
  return
    if ($children)
    then
      <wg role="{$t/@relation}" head="{$t/@id}">
        {
          for $s in $seq
          return
            if ($s is $t)
            then local:token($t)
            else local:unwrap($s, $stok)
        }
      </wg>
    else local:token($t)
};

declare function local:milestone($ms)
{
  let $groups := analyze-string($ms, "(\d+)?(\w+) (\d+)\.(\d+)")//fn:group
  let $name :=
    switch ($groups[@nr="2"])
      case "PHILEM" return "phlm"
      default return $groups[@nr="2"]
  let $first :=
    string-join(($groups[@nr="1"], upper-case(substring($name,1,1)),lower-case(substring($name,2))),"")
  let $osisId := string-join(($first, $groups[@nr="3"], $groups[@nr="4"]),".")
  return
    <milestone unit="verse" id="{$osisId}">{ $osisId }</milestone>
};

declare function local:sentence($s)
{
  <sentence>
    {
      attribute id { $s/@id }
    }
    {
      for $ms in distinct-values($s//@citation-part)
      return local:milestone($ms)
    }
    {
      <p>
       {
         string-join( $s//token ! (@form, @presentation-after), "")
       }
      </p>
    }
    {
      let $stok := $s//token
      for $t in $stok[not(@head-id)]
      return local:unwrap($t, $stok)
    }
  </sentence>
};

<?xml-stylesheet href="treedown.css"?>,
<?xml-stylesheet href="boxwood.css"?>,
<book>
  {
    for $s in //sentence
    return local:sentence($s)
  }
</book>

declare variable $pos := //parts-of-speech;
declare variable $morph := //morphology;

declare function local:morph-description($tag, $category)
{
   $morph/field[@tag=$category]/value[@tag=$tag]/@summary ! string(.)
};

declare function local:number($morph as xs:string)
{
  let $tag := substring($morph,2,1)
  where $tag != "-"
  return
    attribute number {
      local:morph-description($tag, "number")
    }
};

declare function local:person($morph as xs:string)
{
  let $tag := substring($morph,1,1)
  where $tag != "-"
  return
    attribute person {
      tokenize(local:morph-description($tag, "person"))[1]
    }
};

declare function local:gender($morph as xs:string)
{
  let $tag := substring($morph,6,1)
  where $tag != "-"
  return
    attribute gender {
      local:morph-description($tag,"gender")
    }
};

declare function local:case($morph as xs:string)
{
  let $tag := substring($morph,7,1)
  where $tag != "-"
  return
    attribute case {
      local:morph-description($tag,"case")
    }
};

declare function local:tense($morph as xs:string)
{
  let $tag := substring($morph,3,1)
  where $tag != "-"
  return
    attribute tense {
      local:morph-description($tag,"tense")
    }
};

declare function local:voice($morph as xs:string)
{
  let $tag := substring($morph,5,1)
  where $tag != "-"
  return
    attribute voice {
      local:morph-description($tag,"voice")
    }
};

declare function local:mood($morph as xs:string)
{
  let $tag := substring($morph,4,1)
  where $tag != "-"
  return
    attribute mood {
      local:morph-description($tag,"mood")
    }
};

declare function local:degree($morph as xs:string)
{
  let $tag := substring($morph,8,1)
  where $tag != "-"
  return
    attribute degree {
      local:morph-description($tag,"degree")
    }
};

declare function local:strength($morph as xs:string)
{
  let $tag := substring($morph,9,1)
  where $tag != "-"
  return
    attribute strength {
      local:morph-description($tag,"strength")
    }
};

declare function local:inflection($morph as xs:string)
{
  let $tag := substring($morph,10,1)
  where $tag != "-"
  return
    attribute inflection {
      local:morph-description($tag,"inflection")
    }
};

declare function local:morphology($t)
{
  let $morph := string($t/@morphology)
  where $morph
  return (
    $t/@lemma,
    local:number($morph),
    local:person($morph),
    local:gender($morph),
    local:case($morph),
    local:tense($morph),
    local:voice($morph),
    local:mood($morph),
    local:degree($morph),
    local:strength($morph),
    local:inflection($morph)
  )
};

declare function local:class($t)
{
  let $description :=  string($pos/value[@tag = $t/@part-of-speech]/@summary)
  let $class :=
    switch ($description)
      case "interrogative adverb" return "adverb"
      case "relative adverb" return "adverb"
      case "common noun" return "noun"
      case "proper noun" return "noun"
      case "cardinal numeral" return "numeral"
      case "ordinal numeral" return "numeral"
      case "demonstrative pronoun" return "pronoun"
      case "indefinite pronoun" return "pronoun"
      case "interrogative pronoun" return "pronoun"
      case "relative pronoun" return "pronoun"
      case "personal pronoun" return "pronoun"
      case "personal reflexive pronoun" return "pronoun"
      case "possessive pronoun" return "pronoun"
      case "possessive reflexive pronoun" return "pronoun"
      case "reciprocal pronoun" return "pronoun"
      case "" return ()
      default return $description
  let $type :=
    switch ($description)
      case "interrogative adverb" return "interrogative"
      case "relative adverb" return "relative"
      case "common noun" return "common"
      case "proper noun" return "proper"
      case "cardinal numeral" return "cardinal"
      case "ordinal numeral" return "ordinal"
      case "demonstrative pronoun" return "demonstrative"
      case "indefinite pronoun" return "indefinite"
      case "interrogative pronoun" return "interrogative"
      case "relative pronoun" return "relative"
      case "personal pronoun" return "personal"
      case "personal reflexive pronoun" return "personal relative"
      case "possessive pronoun" return "possessive"
      case "possessive reflexive pronoun" return "possessive reflexive"
      case "reciprocal pronoun" return "reciprocal"
      default return ()
  return
    (
      $class ! attribute class {$class},
      $type ! attribute type {$type}
    )
};

declare function local:token($t)
{
  <w>
    {
      local:class($t),
      attribute role {$t/@relation},
      local:morphology($t),
      attribute id {$t/@id},
      $t/@head-id ! attribute head-id {$t/@head-id }
    }
    {
      string($t/@form)
    }
  </w>,
  $t/@presentation-after[. != ' '] ! <pc>{string(.)}</pc>
};

declare function local:unwrap($t, $stok)
{
  let $children :=  $stok[@head-id = $t/@id]
  let $seq := ($children | $t)/.
  return
    if ($children)
    then
      <wg role="{$t/@relation}" head="{$t/@id}">
        {
          for $s in $seq
          return
            if ($s is $t)
            then local:token($t)
            else local:unwrap($s, $stok)
        }
      </wg>
    else local:token($t)
};

declare function local:milestone($ms)
{
  let $groups := analyze-string($ms, "(\d+)?(\w+) (\d+)\.(\d+)")//fn:group
  let $name :=
    switch ($groups[@nr="2"])
      case "PHILEM" return "phlm"
      default return $groups[@nr="2"]
  let $first :=
    string-join(($groups[@nr="1"], upper-case(substring($name,1,1)),lower-case(substring($name,2))),"")
  let $osisId := string-join(($first, $groups[@nr="3"], $groups[@nr="4"]),".")
  return
    <milestone unit="verse" id="{$osisId}">{ $osisId }</milestone>
};

declare function local:sentence($s)
{
  <sentence>
    {
      attribute id { $s/@id }
    }
    {
      for $ms in distinct-values($s//@citation-part)
      return local:milestone($ms)
    }
    {
      <p>
       {
         string-join( $s//token ! (@form, @presentation-after), "")
       }
      </p>
    }
    {
      let $stok := $s//token
      for $t in $stok[not(@head-id)]
      return local:unwrap($t, $stok)
    }
  </sentence>
};

<?xml-stylesheet href="treedown.css"?>,
<?xml-stylesheet href="boxwood.css"?>,
<book>
  {
    for $s in //sentence
    return local:sentence($s)
  }
</book>


switched to require basex 8.0 so that we can use xquery:eval and xquery:update to stored queries

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

(:import module namespace csd_bsq = "https://github.com/his-interop/openinfoman/csd_bsq" at "csd_base_stored_queries.xqm";
import module namespace csd_hwr = "https://github.com/his-interop/openinfoman-hwr/csd_hwr" at "csd_health_worker_registry.xqm";
import module namespace csd_hwru = "https://github.com/his-interop/openinfoman-hwr/csd_hwru" at "csd_health_worker_registry_updating.xqm";
:)

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

(:this should proabably be moved to the database :)
declare variable $csr_proc:stored_query_dir := "../resources/stored_query_definitions";
declare variable $csr_proc:stored_updating_query_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/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: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))/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))/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,$uuid) {
  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[@uuid = $uuid]
  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 $uuid := $func/@uuid
  let $old := $stored_updating_functions/careServicesFunction[@uuid = $uuid]
  return
    if (exists($uuid)) 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 $uuid := $func/@uuid
  let $old := $stored_functions/careServicesFunction[@uuid = $uuid]
  return
    if (exists($uuid) 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)
{
let $func :=$careServicesRequest/function
let $adhoc :=$careServicesRequest/expression
return if (exists($func))
then
  csr_proc:process_CSR_stored($db,$func,$doc)
else if (exists($adhoc))
then
  csr_proc:process_CSR_adhoc($adhoc,$doc)
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>

};

declare function csr_proc:process_CSR_adhoc($expression,$doc)
{

let $expr :=string($expression)
return if ($expr) then
  let $result := xquery:eval($expr,map{"":=$doc})
  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,$function,$doc)
{
let $uuid := $function/@uuid
let $stored_functions := csr_proc:stored_functions($db)
let $definition := $stored_functions[@uuid = $uuid][1]/definition/text()
let $content_type := csr_proc:lookup_stored_content_type($db,$function/@uuid)
let $result0 :=
  if (exists($definition)) then
    xquery:eval($definition,map{'':=$doc,'careServicesRequest':=$function/requestParams})
  else
    ()
let $result1:=
  if ($function/@encapsulated) then
    csr_proc:wrap_result($result0,$content_type)
  else $result0
return if ($result0) then
  (
  <rest:response>
    <http:response status="200" >
      <http:header name="Content-Type" value="{$content_type}"/>
    </http:response>
  </rest:response>
  ,
  $result1
  )
else
  <rest:response>
    <http:response status="404" message="No registered function with UUID='{$function/@uuid}.'">
      <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) {
 <careServicesResponse content-type="{$content-type}"><result>{$result}</result></careServicesResponse>
};

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 updating function csr_proc:process_updating_CSR($db,$careServicesRequest, $doc)
{
(:not allowing ad-hoc updates:)
let $function :=$careServicesRequest//csd:function
let $uuid := $function/@uuid
let $stored_updating_functions := csr_proc:stored_updating_functions($db)
let $definition := $stored_updating_functions[@uuid = $uuid][1]/definition/text()
let $content_type := csr_proc:lookup_stored_content_type($db,$function/@uuid)
return if (exists($definition)) then
  xquery:update($definition,map{'':=$doc,'careServicesRequest':=$function/requestParams})
else
    db:output(
    <rest:response>
      <http:response status="404" message="No registered updating function with UUID='{$function/@uuid} ">
	<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:lookup_stored_content_type($db,$uuid)
{
  let $stored_updating_functions := csr_proc:stored_updating_functions($db)
  let $stored_functions := csr_proc:stored_functions($db)
  return string(($stored_functions[@uuid = $uuid]/@content-type, $stored_updating_functions[@uuid = $uuid]/@content-type  , "text/xml")[1])
};

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

(:import module namespace csd_bsq = "https://github.com/his-interop/openinfoman/csd_bsq" at "csd_base_stored_queries.xqm";
import module namespace csd_hwr = "https://github.com/his-interop/openinfoman-hwr/csd_hwr" at "csd_health_worker_registry.xqm";
import module namespace csd_hwru = "https://github.com/his-interop/openinfoman-hwr/csd_hwru" at "csd_health_worker_registry_updating.xqm";
:)

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

(:this should proabably be moved to the database :)
declare variable $csr_proc:stored_query_dir := "../resources/stored_query_definitions";
declare variable $csr_proc:stored_updating_query_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/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: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))/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))/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,$uuid) {
  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[@uuid = $uuid]
  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 $uuid := $func/@uuid
  let $old := $stored_updating_functions/careServicesFunction[@uuid = $uuid]
  return
    if (exists($uuid)) 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 $uuid := $func/@uuid
  let $old := $stored_functions/careServicesFunction[@uuid = $uuid]
  return
    if (exists($uuid) 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)
{
let $func :=$careServicesRequest/function
let $adhoc :=$careServicesRequest/expression
return if (exists($func))
then
  csr_proc:process_CSR_stored($db,$func,$doc)
else if (exists($adhoc))
then
  csr_proc:process_CSR_adhoc($adhoc,$doc)
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>

};

declare function csr_proc:process_CSR_adhoc($expression,$doc)
{

let $expr :=string($expression)
return if ($expr) then
  let $result := xquery:evaluate($expr,map{"":=$doc})
  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,$function,$doc)
{
let $uuid := $function/@uuid
let $stored_functions := csr_proc:stored_functions($db)
let $definition := $stored_functions[@uuid = $uuid][1]/definition/text()
let $method_name := $stored_functions[@uuid = $uuid][1]/definition/@method
let $method :=  if ($method_name) then function-lookup( xs:QName($method_name), 2) else ()
let $content_type := csr_proc:lookup_stored_content_type($db,$function/@uuid)
let $result0 :=
  if (exists($method)) then
    $method($function/requestParams,$doc)
  else
    if (exists($definition)) then
      xquery:evaluate($definition,map{'':=$doc,'careServicesRequest':=$function/requestParams})
    else
      ()
let $result1:=
  if ($function/@encapsulated) then
    csr_proc:wrap_result($result0,$content_type)
  else $result0
return if ($result0) then
  (
  <rest:response>
    <http:response status="200" >
      <http:header name="Content-Type" value="{$content_type}"/>
    </http:response>
  </rest:response>
  ,
  $result1
  )
else
  <rest:response>
    <http:response status="404" message="No registered function with UUID='{$function/@uuid}.'">
      <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) {
 <careServicesResponse content-type="{$content-type}"><result>{$result}</result></careServicesResponse>
};

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 updating function csr_proc:process_updating_CSR($db,$careServicesRequest, $doc)
{
(:not allowing ad-hoc updates:)
let $function :=$careServicesRequest//csd:function
let $uuid := $function/@uuid
let $stored_updating_functions := csr_proc:stored_updating_functions($db)
let $method_name := $stored_updating_functions[@uuid = $uuid][1]/csd:definition/@method
let $method :=  if ($method_name) then function-lookup( xs:QName($method_name), 2) else ()
let $content_type := csr_proc:lookup_stored_content_type($db,$function/@uuid)
return  if (exists($method)) then
    db:output(
      $method($function/requestParams,$doc)
    )
  else
    db:output(
    <rest:response>
      <http:response status="404" message="No registered updating function with UUID='{$function/@uuid} or method name '{$method_name}'">
	<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:lookup_stored_content_type($db,$uuid)
{
  let $stored_updating_functions := csr_proc:stored_updating_functions($db)
  let $stored_functions := csr_proc:stored_functions($db)
  return string(($stored_functions[@uuid = $uuid]/@content-type, $stored_updating_functions[@uuid = $uuid]/@content-type  , "text/xml")[1])
};