cosmetics

cosmetics

xquery version "1.0";

declare namespace demo="http://luxdb.net/demo";

import module namespace config="http://luxdb.net/demo/config" at "config.xqy";
import module namespace layout="http://luxdb.net/demo/layout" at "layout.xqy";
import module namespace search="http://luxdb.net/search" at "search-lib.xqy";

declare variable $lux:http as document-node() external;

declare function demo:get-document ($path)
as document-node()?
{
    if (doc-available ($path))
    then doc($path)
    else
        if (starts-with ($path, "/"))
        then doc (substring($path, 2))
        else ()
};

declare function demo:get-document ($query, $pos, $sort)
    as document-node()?
{
    subsequence(lux:search ($query, $sort), $pos, 1)
};

declare function demo:search-at-pos ($pos, $params)
{
    let $ps := $params[not(@name=('start','pos','index','total'))]
    let $kvs := for $p in $ps return concat($p/@name,"=",$p/value)
    return concat ("index.xqy?start=", $pos, "&", string-join($kvs, "&"))
};

declare function demo:view ()
{
    let $enq as xs:string := $lux:http/http/params/param[@name='enq']/string()
    let $qs as element(param)* := search:decode-query ($enq)
    let $query := search:query ($qs)
    let $pos := (xs:integer($lux:http/http/params/param[@name='pos']), ($qs[@name='start'],1)[1] + $qs[@name='index']- 1)[1]
    let $last := xs:integer($qs[@name='total']/value)
    let $pagination :=
{
        "results:", $pos,
        if ($pos gt 1) then ← previous else (),
        ↰ back,
        if ($pos lt $last) then next → else ()
    }

    let $path := $lux:http/http/params/param[@name='uri']/string()
    let $sort := $qs[@name='sort']
    let $doc := if ($path) then demo:get-document ($path) else demo:get-document ($query, $pos, $sort)
    let $doctype := name($doc/*)
    let $stylesheet-name := concat("file:view-", $doctype, ".xsl")
    let $parts :=
        if (doc-available ($stylesheet-name)) then
            lux:transform (doc($stylesheet-name), lux:highlight ($doc, $query), ("query", $query))
        else
            (
{$path} ({$doctype})
,
{lux:transform(doc('file:chrome-xml.xsl'), $doc, ('whole-page', 'no'))}
)
    return layout:outer ("/view.xqy", (), ($pagination, $parts), $lux:http)
};

demo:view()

xquery version "1.0";

declare namespace demo="http://luxdb.net/demo";

import module namespace config="http://luxdb.net/demo/config" at "config.xqy";
import module namespace layout="http://luxdb.net/demo/layout" at "layout.xqy";
import module namespace search="http://luxdb.net/search" at "search-lib.xqy";

declare variable $lux:http as document-node() external;

declare function demo:get-document ($path)
as document-node()?
{
    if (doc-available ($path))
    then doc($path)
    else
        if (starts-with ($path, "/"))
        then doc (substring($path, 2))
        else ()
};

declare function demo:get-document ($query, $pos, $sort)
    as document-node()?
{
    subsequence(lux:search ($query, $sort), $pos, 1)
};

declare function demo:search-at-pos ($pos, $params)
{
    let $ps := $params[not(@name=('start','pos','index','total'))]
    let $kvs := for $p in $ps return concat($p/@name,"=",$p/value)
    return concat ("index.xqy?start=", $pos, "&", string-join($kvs, "&"))
};

declare function demo:view ()
{
    let $enq as xs:string := $lux:http/http/params/param[@name='enq']/string()
    let $qs as element(param)* := search:decode-query ($enq)
    let $query := search:query ($qs)
    let $pos := (xs:integer($lux:http/http/params/param[@name='pos']), ($qs[@name='start'],1)[1] + $qs[@name='index']- 1)[1]
    let $last := xs:integer($qs[@name='total']/value)
    let $pagination :=
{
        "results:", $pos,
        if ($pos gt 1) then ← previous else (),
        ↰ back,
        if ($pos lt $last) then next → else ()
    }

    let $path := $lux:http/http/params/param[@name='uri']/string()
    let $sort := $qs[@name='sort']
    let $doc := if ($path) then demo:get-document ($path) else demo:get-document ($query, $pos, $sort)
    let $doctype := name($doc/*)
    let $stylesheet-name := concat("file:view-", $doctype, ".xsl")
    let $parts :=
        if (doc-available ($stylesheet-name)) then
            lux:transform (doc($stylesheet-name), lux:highlight ($doc, $query), ("query", $query))
        else
            (
{$path} ({$doctype})
,
{lux:transform(doc('file:chrome-xml.xsl'), $doc, ('whole-page', 'no'))}
)
    return layout:outer ('/view.xqy', (), ($pagination, $parts), $lux:http)
};

demo:view()


csr process smarter about accepting requestParams or careServicesFunction

(:~
: 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 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 :=
  if (exists($careServicesRequest/csd:function ))
  then $careServicesRequest/csd:function
  else $careServicesRequest

let $urn :=
  if (exists($careServicesRequest/csd:function ))
  then string($function/@urn)
  else string($function/@function)

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 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])
};


Use async:fork-join

Use async:fork-join

module namespace p = 'https://github.com/james-jw/xq-promise';
import module namespace async = 'http://basex.org/modules/async';

(:~
 : Defers a piece of work, with the specified arguments and callbacks for later execution
 :)
declare function p:defer($work as function(*), $args as item()*) {
  function () {
    fn:apply($work, if($args instance of array(*)) then $args else array { $args })
  }
};

(:~
 : Adds the callbacks provided to the then chain of the provided deferreds
 :)
declare function p:then($promises as function(*)*, $callback as function(*)?, $reject as function(*)?) {
  function () {
    for $promise in $promises
    return
      let $promise := if(exists($reject)) then
                        p:fail($promise, $reject)
                      else $promise
      let $out := p:invoke($promise, ())
      return
        if(p:is-function($out))
        then p:then($out, $callback)
        else if(exists($callback)) then
          p:invoke($callback, $out)
        else $out
  }
};

declare function p:then($promises as function(*)*, $callback as function(*)?) {
   p:then($promises, $callback, ())
};

(:~
 : Adds the callbacks provided to the done chain of the provided deferreds
 :)
declare function p:done($promise, $callback) {
  function () {
    let $out := $promise()
    return
       ($out, prof:void(p:invoke($callback, $out)))
  }
};

(:~
 : Combines a set of promises into a single promise
 :)
declare function p:when($inputs as item()*) {
  function () {
    array {
      for $input in $inputs
      return
        if(p:is-function($input))
        then $input() else $input
    }
  }
};

(:~
 : Adds the callbacks provided to the always chain of the provided deferreds
 :)
declare function p:always($promise, $callback) {
  function () {
    try {
      let $out := $promise()
      return
        ($out, prof:void(p:invoke($callback, $out)))
    } catch * {
      let $error := map {
          'code': $err:code,
          'description': $err:description,
          'module': $err:module,
          'line': $err:line-number,
          'column': $err:column-number,
          'value': $err:value,
          'additional': map {
            'deferred': $promise
          }
      }
        return
          p:invoke($callback, $error)
    }
  }
};

declare function p:fail($promise, $handler) {
  function () {
    try {
      $promise()
    } catch * {
      let $error := map {
        'code': $err:code,
        'description': $err:description,
        'module': $err:module,
        'line': $err:line-number,
        'column': $err:column-number,
        'value': $err:value,
        'additional': map {
          'deferred': $promise
        }
     }
      return
        p:invoke($handler, $error)
    }
  }
};

(:~
 : Forks the provided functions or deferred work in a fork join fashion, returning the results once all
 : forked computation is complete.
 :)
declare function p:fork-join($work as function(*)*) as item()* {
  async:fork-join($work)
};

(:~
 : Forks the provided functions or deferred work in a fork join fashion, returning the results once all
 : forked computation is complete.
 :)
declare function p:fork-join($work as function(*)*,
                             $compute-size as xs:integer) as item()* {
  async:fork-join($work, $compute-size)
};

(:~
 : Forks the provided functions or deferred work in a fork join fashion, returning the results once all
 : forked computation is complete.
 :)
declare function p:fork-join($work as function(*)*,
                             $compute-size as xs:integer,
                             $max-forks as xs:integer) as item()* {
  async:fork-join($work,  map { 'thread-size': $compute-size, 'threads': $max-forks})
};

(: Private functions :)
declare %private function p:is-function($input) {
  if($input instance of function(*) and
      not($input instance of map(*) or $input instance of array(*)))
  then true()
  else false()
};

declare %private function p:invoke($handler, $input) {
  if(fn:function-arity($handler) = 0) then $handler()
  else if (fn:function-arity($handler) > 1 and $input instance of array(*)) then
    fn:apply($handler, $input)
  else $handler($input)
};

module namespace p = 'https://github.com/james-jw/xq-promise';
import module namespace promise = 'org.jw.basex.async.xq-promise';

(:~
 : Defers a piece of work, with the specified arguments and callbacks for later execution
 :)
declare function p:defer($work as function(*), $args as item()*) {
  function () {
    fn:apply($work, if($args instance of array(*)) then $args else array { $args })
  }
};

(:~
 : Adds the callbacks provided to the then chain of the provided deferreds
 :)
declare function p:then($promises as function(*)*, $callback as function(*)?, $reject as function(*)?) {
  function () {
    for $promise in $promises
    return
      let $promise := if(exists($reject)) then
                        p:fail($promise, $reject)
                      else $promise
      let $out := p:invoke($promise, ())
      return
        if(p:is-function($out))
        then p:then($out, $callback)
        else if(exists($callback)) then
          p:invoke($callback, $out)
        else $out
  }
};

declare function p:then($promises as function(*)*, $callback as function(*)?) {
   p:then($promises, $callback, ())
};

(:~
 : Adds the callbacks provided to the done chain of the provided deferreds
 :)
declare function p:done($promise, $callback) {
  function () {
    let $out := $promise()
    return
       ($out, prof:void(p:invoke($callback, $out)))
  }
};

(:~
 : Combines a set of promises into a single promise
 :)
declare function p:when($inputs as item()*) {
  function () {
    array {
      for $input in $inputs
      return
        if(p:is-function($input))
        then $input() else $input
    }
  }
};

(:~
 : Adds the callbacks provided to the always chain of the provided deferreds
 :)
declare function p:always($promise, $callback) {
  function () {
    try {
      let $out := $promise()
      return
        ($out, prof:void(p:invoke($callback, $out)))
    } catch * {
      let $error := map {
          'code': $err:code,
          'description': $err:description,
          'module': $err:module,
          'line': $err:line-number,
          'column': $err:column-number,
          'value': $err:value,
          'additional': map {
            'deferred': $promise
          }
      }
        return
          p:invoke($callback, $error)
    }
  }
};

declare function p:fail($promise, $handler) {
  function () {
    try {
      $promise()
    } catch * {
      let $error := map {
        'code': $err:code,
        'description': $err:description,
        'module': $err:module,
        'line': $err:line-number,
        'column': $err:column-number,
        'value': $err:value,
        'additional': map {
          'deferred': $promise
        }
     }
      return
        p:invoke($handler, $error)
    }
  }
};

(:~
 : Forks the provided functions or deferred work in a fork join fashion, returning the results once all
 : forked computation is complete.
 :)
declare function p:fork-join($work as function(*)*) as item()* {
  promise:fork-join($work)
};

(:~
 : Forks the provided functions or deferred work in a fork join fashion, returning the results once all
 : forked computation is complete.
 :)
declare function p:fork-join($work as function(*)*,
                             $compute-size as xs:integer) as item()* {
  promise:fork-join($work, $compute-size)
};

(:~
 : Forks the provided functions or deferred work in a fork join fashion, returning the results once all
 : forked computation is complete.
 :)
declare function p:fork-join($work as function(*)*,
                             $compute-size as xs:integer,
                             $max-forks as xs:integer) as item()* {
  promise:fork-join($work, $compute-size, $max-forks)
};

(: Private functions :)
declare %private function p:is-function($input) {
  if($input instance of function(*) and
      not($input instance of map(*) or $input instance of array(*)))
  then true()
  else false()
};

declare %private function p:invoke($handler, $input) {
  if(fn:function-arity($handler) = 0) then $handler()
  else if (fn:function-arity($handler) > 1 and $input instance of array(*)) then
    fn:apply($handler, $input)
  else $handler($input)
};


added default params allows call without params (gives overview)

xquery version "1.0";

import module namespace fcs-tests = "http://clarin.eu/fcs/1.0/tests" at  "tests.xqm";
(:import module namespace httpclient = "http://exist-db.org/xquery/httpclient";:)

declare namespace sru = "http://www.loc.gov/zing/srw/";
declare namespace fcs = "http://clarin.eu/fcs/1.0";
declare namespace tei = "http://www.tei-c.org/ns/1.0";

(:let $target := "http://localhost:8681/exist/cr/"
let $testset-name := "test_connect"

let $tests := doc(concat("testsets/", $testset-name, ".xml"))//TestSet
:)
(:let $data := httpclient:get(xs:anyURI("http://localhost:8680/exist/rest/db/content_repository/scripts/cr.xql"), false(), () ) :)
(:let $store := xmldb:store("results", concat($testset-name, '.xml'), t:run-testSet($tests)) :)

(: t:run-testSet($tests)
t:format-testResult($store):)

let $target := request:get-parameter("target", "0")
let $testset := request:get-parameter("testset", "0")
let $operation := request:get-parameter("operation", "overview")
let $messages := ""
return
    if ($operation eq "run" or $operation eq "run-store") then
        let $run := fcs-tests:run-testset($target, $testset, $operation)
        return fcs-tests:display-page($target, $testset, $operation)
    else
        fcs-tests:display-page($target, $testset,$operation)

xquery version "1.0";

import module namespace fcs-tests = "http://clarin.eu/fcs/1.0/tests" at  "tests.xqm";
(:import module namespace httpclient = "http://exist-db.org/xquery/httpclient";:)

declare namespace sru = "http://www.loc.gov/zing/srw/";
declare namespace fcs = "http://clarin.eu/fcs/1.0";
declare namespace tei = "http://www.tei-c.org/ns/1.0";

(:let $target := "http://localhost:8681/exist/cr/"
let $testset-name := "test_connect"

let $tests := doc(concat("testsets/", $testset-name, ".xml"))//TestSet
:)
(:let $data := httpclient:get(xs:anyURI("http://localhost:8680/exist/rest/db/content_repository/scripts/cr.xql"), false(), () ) :)
(:let $store := xmldb:store("results", concat($testset-name, '.xml'), t:run-testSet($tests)) :)

(: t:run-testSet($tests)
t:format-testResult($store):)

let $target := request:get-parameter("target", ())
let $testset := request:get-parameter("testset", ())
let $operation := request:get-parameter("operation", ())
let $messages := ""
return
    if ($operation eq "run" or $operation eq "run-store") then
        let $run := fcs-tests:run-testset($target, $testset, $operation)
        return fcs-tests:display-page($target, $testset, $operation)
    else
        fcs-tests:display-page($target, $testset,$operation)


[ignore] added a note to the admin webapp login screen

svn path=/branches/eXist-stable-1.2/; revision=9160

xquery version "1.0";
(: $Id$ :)
(:
    Main module of the database administration interface.
:)

declare namespace admin = "http://exist-db.org/xquery/admin-interface";

declare namespace request = "http://exist-db.org/xquery/request";
declare namespace session = "http://exist-db.org/xquery/session";
declare namespace util = "http://exist-db.org/xquery/util";
declare namespace xdb = "http://exist-db.org/xquery/xmldb";

import module namespace status = "http://exist-db.org/xquery/admin-interface/status" at "status.xqm";
import module namespace browse = "http://exist-db.org/xquery/admin-interface/browse" at "browse.xqm";
import module namespace users = "http://exist-db.org/xquery/admin-interface/users" at "users.xqm";
import module namespace xqueries = "http://exist-db.org/xquery/admin-interface/xqueries" at "xqueries.xqm";
import module namespace shut = "http://exist-db.org/xquery/admin-interface/shutdown" at "shutdown.xqm";
import module namespace setup = "http://exist-db.org/xquery/admin-interface/setup" at "setup.xqm";
import module namespace backup="http://exist-db.org/xquery/admin-interface/backup" at "backup.xqm";

(:
    Display the version, SVN revision and user info in the top right corner
:)
declare function admin:info-header() as element()
{

Version: { util:system-property( "product-version" ) }

SVN Revision: { util:system-property( "svn-revision" ) }

Build: {util:system-property("product-build")}

User: { xdb:get-current-user() }

};

(:
    Select the page to show. Every page is defined in its own module
:)
declare function admin:panel() as element()
{
    let $panel := request:get-parameter("panel", "status") return
        if($panel eq "browse") then
        (
            browse:main()
        )
        else if($panel eq "users") then
        (
            users:main()
        )
         else if($panel eq "xqueries") then
        (
            xqueries:main()
        )
        else if($panel eq "shutdown") then
        (
            shut:main()
        )
        else if($panel eq "setup") then
        (
            setup:main()
        )
		else if ($panel eq "backup") then
		    backup:main()
        else
        (
            status:main()
        )
};

(:~
    Display the login form.
:)
declare function admin:display-login-form() as element()
{

Login

This is a protected resource. Only registered database users can log
        in. If you have not set up any users, login as "admin" and leave the
        password field empty or use the password you supplied during the installation
		process. Note that the "guest" user is not permitted access.

        <form action="{session:encode-url(request:get-uri())}" method="post">

                    Please Login

                    Username:
                    <input name="user" type="text" size="20"/>

                    Password:
                    <input name="pass" type="password" size="20"/>

                    <input type="submit"/>

        </form>

};

(: main entry point :)
let $isLoggedIn :=  if(xdb:get-current-user() eq "guest")then
    (
        (: is this a login attempt? :)
        if(request:get-parameter("user", ()) and not(empty(request:get-parameter("pass", ()))))then
        (
            if(request:get-parameter("user", ()) eq "guest")then
            (
                (: prevent the guest user from accessing the admin webapp :)
                false()
            )
            else
            (
                (: try and log the user in :)
                xdb:login("/db", request:get-parameter("user", ()), request:get-parameter("pass", ()))
            )
        )
        else
        (
            (: prevent the guest user from accessing the admin webapp :)
            false()
        )
    )
    else
    (
        (: if we are already logged in, are we logging out - i.e. set permissions back to guest :)
        if(request:get-parameter("logout",()))then
        (
        	let $null := xdb:login("/db", "guest", "guest") return
        	    false()
        )
        else
        (
             (: we are already logged in and we are not the guest user :)
            true()
        )
    )
return

            <title>eXist Database Administration</title>
            <link type="text/css" href="admin.css" rel="stylesheet"/>

                {admin:info-header()}

Select a Page

Home

System Status

Browse Collections

Manage Users

						View Running Jobs

Examples Setup

Backups

Shutdown

Logout

                        Logged in as: {xdb:get-current-user()}

                {
                    if($isLoggedIn)then
                    (
                        admin:panel()
                    )
                    else
                    (
                        admin:display-login-form()
                    )
                }

xquery version "1.0";
(: $Id$ :)
(:
    Main module of the database administration interface.
:)

declare namespace admin = "http://exist-db.org/xquery/admin-interface";

declare namespace request = "http://exist-db.org/xquery/request";
declare namespace session = "http://exist-db.org/xquery/session";
declare namespace util = "http://exist-db.org/xquery/util";
declare namespace xdb = "http://exist-db.org/xquery/xmldb";

import module namespace status = "http://exist-db.org/xquery/admin-interface/status" at "status.xqm";
import module namespace browse = "http://exist-db.org/xquery/admin-interface/browse" at "browse.xqm";
import module namespace users = "http://exist-db.org/xquery/admin-interface/users" at "users.xqm";
import module namespace xqueries = "http://exist-db.org/xquery/admin-interface/xqueries" at "xqueries.xqm";
import module namespace shut = "http://exist-db.org/xquery/admin-interface/shutdown" at "shutdown.xqm";
import module namespace setup = "http://exist-db.org/xquery/admin-interface/setup" at "setup.xqm";
import module namespace backup="http://exist-db.org/xquery/admin-interface/backup" at "backup.xqm";

(:
    Display the version, SVN revision and user info in the top right corner
:)
declare function admin:info-header() as element()
{

Version: { util:system-property( "product-version" ) }

SVN Revision: { util:system-property( "svn-revision" ) }

Build: {util:system-property("product-build")}

User: { xdb:get-current-user() }

};

(:
    Select the page to show. Every page is defined in its own module
:)
declare function admin:panel() as element()
{
    let $panel := request:get-parameter("panel", "status") return
        if($panel eq "browse") then
        (
            browse:main()
        )
        else if($panel eq "users") then
        (
            users:main()
        )
         else if($panel eq "xqueries") then
        (
            xqueries:main()
        )
        else if($panel eq "shutdown") then
        (
            shut:main()
        )
        else if($panel eq "setup") then
        (
            setup:main()
        )
		else if ($panel eq "backup") then
		    backup:main()
        else
        (
            status:main()
        )
};

(:~
    Display the login form.
:)
declare function admin:display-login-form() as element()
{

Login

This is a protected resource. Only registered database users can log
        in. If you have not set up any users, login as "admin" and leave the
        password field empty. Note that the "guest" user is not permitted access.

        <form action="{session:encode-url(request:get-uri())}" method="post">

                    Please Login

                    Username:
                    <input name="user" type="text" size="20"/>

                    Password:
                    <input name="pass" type="password" size="20"/>

                    <input type="submit"/>

        </form>

};

(: main entry point :)
let $isLoggedIn :=  if(xdb:get-current-user() eq "guest")then
    (
        (: is this a login attempt? :)
        if(request:get-parameter("user", ()) and not(empty(request:get-parameter("pass", ()))))then
        (
            if(request:get-parameter("user", ()) eq "guest")then
            (
                (: prevent the guest user from accessing the admin webapp :)
                false()
            )
            else
            (
                (: try and log the user in :)
                xdb:login("/db", request:get-parameter("user", ()), request:get-parameter("pass", ()))
            )
        )
        else
        (
            (: prevent the guest user from accessing the admin webapp :)
            false()
        )
    )
    else
    (
        (: if we are already logged in, are we logging out - i.e. set permissions back to guest :)
        if(request:get-parameter("logout",()))then
        (
        	let $null := xdb:login("/db", "guest", "guest") return
        	    false()
        )
        else
        (
             (: we are already logged in and we are not the guest user :)
            true()
        )
    )
return

            <title>eXist Database Administration</title>
            <link type="text/css" href="admin.css" rel="stylesheet"/>

                {admin:info-header()}

Select a Page

Home

System Status

Browse Collections

Manage Users

						View Running Jobs

Examples Setup

Backups

Shutdown

Logout

                        Logged in as: {xdb:get-current-user()}

                {
                    if($isLoggedIn)then
                    (
                        admin:panel()
                    )
                    else
                    (
                        admin:display-login-form()
                    )
                }


fixed a syntax error in test, so that it will show the actual bug

pf:mil('var a := new(str,str); a.insert(str_nil, "abc"); return a;'),
pf:mil('var a := new(str,str); a.insert("abc", str_nil); return a;')

pf:mil('var a := new(str,str); a.insert(str_nil, "abc"); return a;')
pf:mil('var a := new(str,str); a.insert("abc", str_nil); return a;')


[FIX] DBA, logs

[FIX] DBA, logs

(:~
 : Logging page.
 :
 : @author Christian Grün, BaseX Team 2005-21, BSD License
 :)
module namespace dba = 'dba/logs';

import module namespace html = 'dba/html' at '../lib/html.xqm';
import module namespace options = 'dba/options' at '../lib/options.xqm';

(:~ Top category :)
declare variable $dba:CAT := 'logs';

(:~
 : Redirects to the URL that creates a log entry table for the specified timestamp.
 : @param  $name  name (date) of log file
 : @param  $time  timestamp to be found
 : @return redirection
 :)
declare
  %rest:GET
  %rest:path('/dba/logs-jump')
  %rest:query-param('name', '{$name}')
  %rest:query-param('time', '{$time}')
function dba:logs-jump(
  $name  as xs:string,
  $time  as xs:string
) as element(rest:response) {
  let $page := head((
    let $ignore-logs := options:get($options:IGNORE-LOGS)
    let $max := options:get($options:MAXROWS)
    for $log at $pos in reverse(
      admin:logs($name, true())[not($ignore-logs and matches(., $ignore-logs, 'i'))]
    )
    where $log/@time = $time
    return ($pos - 1) idiv $max + 1,
    1
  ))
  return web:redirect('/dba/logs', map { 'name': $name, 'page': $page, 'time': $time }) update {
    .//*:header/@value ! (replace value of node . with . || '#' || $time)
  }
};

(:~
 : Logging page.
 : @param  $input  search input
 : @param  $name   name (date) of log file
 : @param  $sort   table sort key
 : @param  $error  error string
 : @param  $info   info string
 : @param  $page   current page
 : @param  $time   timestamp to highlight
 : @return page
 :)
declare
  %rest:GET
  %rest:path('/dba/logs')
  %rest:query-param('input', '{$input}')
  %rest:query-param('name',  '{$name}')
  %rest:query-param('sort',  '{$sort}', '')
  %rest:query-param('error', '{$error}')
  %rest:query-param('info',  '{$info}')
  %rest:query-param('page',  '{$page}', '1')
  %rest:query-param('time',  '{$time}')
  %output:method('html')
function dba:logs(
  $input  as xs:string?,
  $name   as xs:string?,
  $sort   as xs:string,
  $error  as xs:string?,
  $info   as xs:string?,
  $page   as xs:string,
  $time   as xs:string?
) as element(html) {
  let $files := reverse(sort(admin:logs()))
  let $name := if($name) then $name else string(head($files))
  return html:wrap(map { 'header': $dba:CAT, 'info': $info, 'error': $error },

{ html:link('Logs', $dba:CAT) }

        <form action='{ $dba:CAT }' method='post' class='update'>
          <input type='hidden' name='name' id='name' value='{ $name }'/>
          <input type='hidden' name='sort' id='sort' value='{ $sort }'/>
          <input type='hidden' name='page' id='page' value='{ $page }'/>
          <input type='hidden' name='time' id='time' value='{ $time }'/>

{
            let $buttons := html:button('log-delete', 'Delete', true())
            let $headers := (
              map { 'key': 'name', 'label': 'Name', 'type': 'dynamic' },
              map { 'key': 'size', 'label': 'Size', 'type': 'bytes' }
            )
            let $entries :=
              for $entry in $files
              return map {
                'name': function() {
                  let $link := html:link(
                    $entry, $dba:CAT, (map { 'sort': $sort }, map { 'name': $entry })
                  ) update {
                    (: enrich link targets with current search string :)
                    insert node attribute onclick { 'addInput(this);' } into .
                  }
                  return if ($name = $entry) then element b { $link } else $link
                },
                'size': $entry/@size
              }
            return html:table($headers, $entries, $buttons, map { }, map { })
          }

        </form>

      {
        if($name) then (
          <form action='log-download' method='post' id='resources' autocomplete='off'>

{
              $name, ' ',
              <input type='hidden' name='name' value='{ $name }'/>,
              <input size='40' id='input' name='input' value='{ $input }'
                title='Enter regular expression'
                onkeydown='if(event.keyCode==13) {{logEntries(true,false);event.preventDefault();}}'
                onkeyup='logEntries(false, true);'/>,
              ' ',
              html:button('download', 'Download')
            }

          </form>,

,
          html:js('logEntries(true, false);')
        ) else (),
        html:focus('input')
      }

  )
};

(:~
 : Returns a log entry table.
 : @param  $input  search input
 : @param  $name   name of selected log files
 : @param  $sort   table sort key
 : @param  $page   current page
 : @param  $time   timestamp to highlight
 : @return html elements
 :)
declare
  %rest:POST('{$input}')
  %rest:path('/dba/log')
  %rest:query-param('name', '{$name}')
  %rest:query-param('sort', '{$sort}', 'time')
  %rest:query-param('page', '{$page}', '1')
  %rest:query-param('time', '{$time}')
  %output:method('html')
  %output:html-version('5.0')
  %output:indent('no')
  %rest:single
function dba:log(
  $input  as xs:string?,
  $name   as xs:string,
  $sort   as xs:string,
  $page   as xs:string,
  $time   as xs:string?
) as element()+ {
  let $headers := (
    map { 'key': 'time', 'label': 'Time', 'type': 'dynamic', 'order': 'desc' },
    map { 'key': 'address', 'label': 'Address' },
    map { 'key': 'user', 'label': 'User', 'type': 'dynamic' },
    map { 'key': 'type', 'label': 'Type', 'type': 'dynamic' },
    map { 'key': 'ms', 'label': 'ms', 'type': 'decimal', 'order': 'desc' },
    map { 'key': 'text', 'label': 'Text', 'type': 'dynamic' }
  )
  let $entries := (
    let $ignore-logs := options:get($options:IGNORE-LOGS)
    let $search := boolean($input)
    let $highlight := function($string) {
      for $match in analyze-string($string, $input, 'i')/*
      let $value := string($match)
      return if(local-name($match) = 'match') then element b { $value } else $value
    }

    for $log in reverse(admin:logs($name, true()))
    let $user := string($log/@user)
    let $type := string($log/@type)
    let $text := string($log)
    let $user-hit := $search and matches($user, $input, 'iq')
    let $type-hit := $search and not($user-hit) and matches($type, $input, 'iq')
    let $text-hit := $search and not($user-hit or $type-hit) and matches($text, $input, 'i')
    where (not($search) or $user-hit or $type-hit or $text-hit) and (
      not($ignore-logs and matches($text, $ignore-logs, 'i'))
    )
    let $id := string($log/@time)
    let $time := if($input or $sort != 'time') then (
      function() { html:link($id, $dba:CAT || '-jump', map { 'name': $name, 'time': $id }) }
    ) else if($id = $time) then (
      element b { $id }
    ) else (
      $id
    )
    return map {
      'id': $id,
      'time': $time,
      'address': string($log/@address),
      'user': if($user-hit) then function() { $highlight($user) } else $user,
      'type': if($type-hit) then function() { $highlight($type) } else $type,
      'ms': xs:decimal($log/@ms),
      'text': if($text-hit) then function() { $highlight($text) } else $text
    }
  )
  let $params := map { 'name': $name, 'input': $input }
  let $options := map { 'sort': $sort, 'presort': 'time', 'page': xs:integer($page) }
  return html:table($headers, $entries, (), $params, $options)
};

(:~
 : Redirects to the specified action.
 : @param  $action  action to perform
 : @param  $names   names of selected log files
 : @return redirection
 :)
declare
  %rest:POST
  %rest:path('/dba/logs')
  %rest:query-param('action', '{$action}')
  %rest:query-param('name',   '{$names}')
function dba:logs-redirect(
  $action  as xs:string,
  $names   as xs:string*
) as element(rest:response) {
  web:redirect($action, map { 'name': $names[.], 'redirect': $dba:CAT })
};

(:~
 : Logging page.
 :
 : @author Christian Grün, BaseX Team 2005-21, BSD License
 :)
module namespace dba = 'dba/logs';

import module namespace html = 'dba/html' at '../lib/html.xqm';
import module namespace options = 'dba/options' at '../lib/options.xqm';

(:~ Top category :)
declare variable $dba:CAT := 'logs';

(:~
 : Redirects to the URL that creates a log entry table for the specified timestamp.
 : @param  $name  name (date) of log file
 : @param  $time  timestamp to be found
 : @return redirection
 :)
declare
  %rest:GET
  %rest:path('/dba/logs-jump')
  %rest:query-param('name', '{$name}')
  %rest:query-param('time', '{$time}')
function dba:logs-jump(
  $name  as xs:string,
  $time  as xs:string
) as element(rest:response) {
  let $page := head((
    let $ignore-logs := options:get($options:IGNORE-LOGS)
    let $max := options:get($options:MAXROWS)
    for $log at $pos in reverse(
      admin:logs($name, true())[not($ignore-logs and matches(., $ignore-logs, 'i'))]
    )
    where $log/@time = $time
    return ($pos - 1) idiv $max + 1,
    1
  ))
  return web:redirect('/dba/logs', map { 'name': $name, 'page': $page, 'time': $time }) update {
    .//*:header/@value ! (replace value of node . with . || '#' || $time)
  }
};

(:~
 : Logging page.
 : @param  $input  search input
 : @param  $name   name (date) of log file
 : @param  $sort   table sort key
 : @param  $error  error string
 : @param  $info   info string
 : @param  $page   current page
 : @param  $time   timestamp to highlight
 : @return page
 :)
declare
  %rest:GET
  %rest:path('/dba/logs')
  %rest:query-param('input', '{$input}')
  %rest:query-param('name',  '{$name}')
  %rest:query-param('sort',  '{$sort}', '')
  %rest:query-param('error', '{$error}')
  %rest:query-param('info',  '{$info}')
  %rest:query-param('page',  '{$page}', '1')
  %rest:query-param('time',  '{$time}')
  %output:method('html')
function dba:logs(
  $input  as xs:string?,
  $name   as xs:string?,
  $sort   as xs:string,
  $error  as xs:string?,
  $info   as xs:string?,
  $page   as xs:string,
  $time   as xs:string?
) as element(html) {
  let $files := (
    for $file in admin:logs()
    order by $file descending
    return $file
  )
  let $name := if($name) then $name else string(head($files))
  return html:wrap(map { 'header': $dba:CAT, 'info': $info, 'error': $error },

{ html:link('Logs', $dba:CAT) }

        <form action='{ $dba:CAT }' method='post' class='update'>
          <input type='hidden' name='name' id='name' value='{ $name }'/>
          <input type='hidden' name='sort' id='sort' value='{ $sort }'/>
          <input type='hidden' name='page' id='page' value='{ $page }'/>
          <input type='hidden' name='time' id='time' value='{ $time }'/>

{
            let $buttons := html:button('log-delete', 'Delete', true())
            let $headers := (
              map { 'key': 'name', 'label': 'Name', 'type': 'dynamic' },
              map { 'key': 'size', 'label': 'Size', 'type': 'bytes' }
            )
            let $entries :=
              for $entry in reverse(sort($files))
              return map {
                'name': function() {
                  let $link := html:link(
                    $entry, $dba:CAT, (map { 'sort': $sort }, map { 'name': $entry })
                  ) update {
                    (: enrich link targets with current search string :)
                    insert node attribute onclick { 'addInput(this);' } into .
                  }
                  return if ($name = $entry) then element b { $link } else $link
                },
                'size': $entry/@size
              }
            return html:table($headers, $entries, $buttons, map { }, map { })
          }

        </form>

      {
        if($name) then (
          <form action='log-download' method='post' id='resources' autocomplete='off'>

{
              $name, ' ',
              <input type='hidden' name='name' value='{ $name }'/>,
              <input size='40' id='input' name='input' value='{ $input }'
                title='Enter regular expression'
                onkeydown='if(event.keyCode==13) {{logEntries(true,false);event.preventDefault();}}'
                onkeyup='logEntries(false, true);'/>,
              ' ',
              html:button('download', 'Download')
            }

          </form>,

,
          html:js('logEntries(true, false);')
        ) else (),
        html:focus('input')
      }

  )
};

(:~
 : Returns a log entry table.
 : @param  $input  search input
 : @param  $name   name of selected log files
 : @param  $sort   table sort key
 : @param  $page   current page
 : @param  $time   timestamp to highlight
 : @return html elements
 :)
declare
  %rest:POST('{$input}')
  %rest:path('/dba/log')
  %rest:query-param('name', '{$name}')
  %rest:query-param('sort', '{$sort}', 'time')
  %rest:query-param('page', '{$page}', '1')
  %rest:query-param('time', '{$time}')
  %output:method('html')
  %output:html-version('5.0')
  %output:indent('no')
  %rest:single
function dba:log(
  $input  as xs:string?,
  $name   as xs:string,
  $sort   as xs:string,
  $page   as xs:string,
  $time   as xs:string?
) as element()+ {
  let $headers := (
    map { 'key': 'time', 'label': 'Time', 'type': 'dynamic', 'order': 'desc' },
    map { 'key': 'address', 'label': 'Address' },
    map { 'key': 'user', 'label': 'User', 'type': 'dynamic' },
    map { 'key': 'type', 'label': 'Type', 'type': 'dynamic' },
    map { 'key': 'ms', 'label': 'ms', 'type': 'decimal', 'order': 'desc' },
    map { 'key': 'text', 'label': 'Text', 'type': 'dynamic' }
  )
  let $entries := (
    let $ignore-logs := options:get($options:IGNORE-LOGS)
    let $search := boolean($input)
    let $highlight := function($string) {
      for $match in analyze-string($string, $input, 'i')/*
      let $value := string($match)
      return if(local-name($match) = 'match') then element b { $value } else $value
    }

    for $log in reverse(admin:logs($name, true()))
    let $user := string($log/@user)
    let $type := string($log/@type)
    let $text := string($log)
    let $user-hit := $search and matches($user, $input, 'iq')
    let $type-hit := $search and not($user-hit) and matches($type, $input, 'iq')
    let $text-hit := $search and not($user-hit or $type-hit) and matches($text, $input, 'i')
    where (not($search) or $user-hit or $type-hit or $text-hit) and (
      not($ignore-logs and matches($text, $ignore-logs, 'i'))
    )
    let $id := string($log/@time)
    let $time := if($input or $sort != 'time') then (
      function() { html:link($id, $dba:CAT || '-jump', map { 'name': $name, 'time': $id }) }
    ) else if($id = $time) then (
      element b { $id }
    ) else (
      $id
    )
    return map {
      'id': $id,
      'time': $time,
      'address': string($log/@address),
      'user': if($user-hit) then function() { $highlight($user) } else $user,
      'type': if($type-hit) then function() { $highlight($type) } else $type,
      'ms': xs:decimal($log/@ms),
      'text': if($text-hit) then function() { $highlight($text) } else $text
    }
  )
  let $params := map { 'name': $name, 'input': $input }
  let $options := map { 'sort': $sort, 'presort': 'time', 'page': xs:integer($page) }
  return html:table($headers, $entries, (), $params, $options)
};

(:~
 : Redirects to the specified action.
 : @param  $action  action to perform
 : @param  $names   names of selected log files
 : @return redirection
 :)
declare
  %rest:POST
  %rest:path('/dba/logs')
  %rest:query-param('action', '{$action}')
  %rest:query-param('name',   '{$names}')
function dba:logs-redirect(
  $action  as xs:string,
  $names   as xs:string*
) as element(rest:response) {
  web:redirect($action, map { 'name': $names[.], 'redirect': $dba:CAT })
};


Generating JSON from XQuery leads to unreadable and unmaintainable code that melts your brain. Rewrote to use the JSON module.

Also implemented the missing functionality for correct browsing of groups collections and whether they are read/write.

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

xquery version "1.0";

import module namespace config="http://exist-db.org/mods/config" at "config.xqm";
import module namespace json="http://www.json.org";
import module namespace security="http://exist-db.org/mods/security" at "security.xqm";
import module namespace session = "http://exist-db.org/xquery/session";
import module namespace sharing="http://exist-db.org/mods/sharing" at "sharing.xqm";
import module namespace util="http://exist-db.org/xquery/util";
import module namespace xmldb = "http://exist-db.org/xquery/xmldb";

declare namespace group = "http://exist-db.org/mods/sharing/group";

(:~
: Generates an XML collection navigation representation for the biblio app
: and then renders it as JSON
:
: Includes virtual users homes and shared collections via groups
:
: @author Adam Retter <adam@exist-db.org>
:)

(:~
: Gets a collection and its descendants from the database
:)
declare function local:db-collection-children($collection-path as xs:string) as element(children)* {
    for $child in xmldb:get-child-collections($collection-path)
    let $sub-collection-path := fn:concat($collection-path, "/", $child) return
        let $children := local:collections($sub-collection-path) return
            if($children)then(
                <children>{$children}</children>
            )else()
};

(:~
: Gets all the child collections for the groups accesible to a user
:)
declare function local:group-children($collection-path as xs:string) as element(children)* {
    let $user-groups := sharing:get-users-groups(security:get-user-credential-from-session()[1]) return
        for $group at $i in  $user-groups return
            <children>{local:tree-node(fn:concat($sharing:groups-collection, "/", $group/@id), false(), $group/group:name, (), util:function(xs:QName("local:group-collection-children"), 1))/*}</children>
};

(:~
: Finds all of the collections inside a users home folder which match the group
:
:)
declare function local:user-collection-for-group($group-id as xs:string, $user-collection-path as xs:string) as node()*
{
    let $system-group := sharing:get-group($group-id)/group:system/group:group return
        for $user-sub-collection in xmldb:get-child-collections($user-collection-path)
            let $user-sub-collection-path := fn:concat($user-collection-path, "/", $user-sub-collection) return
                (
                    if(security:get-group($user-sub-collection-path) eq $system-group)then(
                        local:tree-node($user-sub-collection-path, sharing:group-writeable($user-sub-collection-path, $group-id), (), (), ())
                    )else(),
                        local:user-collection-for-group($group-id, $user-sub-collection-path)
                )
};

(:~
: Generates the collections for a group in the navigation tree
:
: $group-collection-path The virtual collection path of the group e.g. /db/mods/groups/1234-1234-1234-1234
:)
declare function local:group-collection-children($group-collection-path as xs:string) {

    let $group-id := fn:replace($group-collection-path, ".*/", "") return
        for $user-collection in xmldb:get-child-collections($security:users-collection)
        let $user-collection-path := fn:concat($security:users-collection, "/", $user-collection) return
            for $node in local:user-collection-for-group($group-id, $user-collection-path) return
                <children>{$node/*}</children>
};

(:~
: Generates a node for the navigation tree
:)
declare function local:tree-node($collection-path as xs:string, $can-write as xs:boolean, $title as xs:string?, $icon-path as xs:string?, $children-function) as element(node)
{
    <node>
        <title>{if($title)then($title)else(fn:replace($collection-path, '.*/',''))}</title>
        <isFolder json:literal="true">true</isFolder>
        <key>{$collection-path}</key>
        <writeable json:literal="true">{$can-write}</writeable>
        <addClass>{if ($can-write) then 'writable' else 'readable'}</addClass>
        {
            if($icon-path)then(
                <icon>{$icon-path}</icon>
            )else(),

            if(not(empty($children-function)))then(
                util:call($children-function, $collection-path)
            )else()
        }
    </node>
};

(:~
: Gets the collections for the navigation
:)
declare function local:collections($root as xs:string) {

    if(xmldb:collection-available($root))then
    (
        let $user := security:get-user-credential-from-session()[1],
        $children := xmldb:get-child-collections($root),
        $can-write := security:can-write-collection($user, $root) return

            if(security:can-read-collection($user, $root)) then

                (: is this the users collection? :)
                if($root eq $security:users-collection) then
                (
                    (: users collection is treated specially :)
                    if($children = $user)then
                    (
                        (: found a mods home collection for the currently logged in user :)
                        let $home-collection-uri := security:get-home-collection-uri($user) return
                            local:tree-node($home-collection-uri, $can-write, "Home", "../css/dynatree/ltFld.user.gif", util:function(xs:QName("local:db-collection-children"), 1))/*
                    )else()
                )
                (: groups collection is treated specially, i.e. skipped :)
                else if($root eq $sharing:groups-collection)then
                (
                    if($user ne "guest")then(
                        local:tree-node($sharing:groups-collection, false(), "Groups", "../css/dynatree/ltFld.groups.gif", util:function(xs:QName("local:group-children"), 1))/*
                    )else()
                )
                else
                (   (: normal collection:)
                    local:tree-node($root, $can-write, (), (), util:function(xs:QName("local:db-collection-children"), 1))/*
                )
            else()
    )else()
};

(: get the collection navigation and convert to json :)
let $xml := <json>{local:collections($config:mods-root)}</json> return
    json:xml-to-json($xml)

xquery version "1.0";

import module namespace security="http://exist-db.org/mods/security" at "security.xqm";
import module namespace sharing="http://exist-db.org/mods/sharing" at "sharing.xqm";
import module namespace config="http://exist-db.org/mods/config" at "config.xqm";
declare namespace session = "http://exist-db.org/xquery/session";
declare namespace xmldb = "http://exist-db.org/xquery/xmldb";
declare namespace group = "http://exist-db.org/mods/sharing/group";

declare option exist:serialize "method=text media-type=text/javascript";

declare function local:sub-collections($root as xs:string, $children as xs:string*) {
    fn:string-join(
        for $child in $children
        return
            local:collections(concat($root, '/', $child)),
        ","
    )
};

declare function local:get-group-collections($group-id as xs:string, $collection as xs:string) {

        fn:concat(
            """children"": [",

                let $sub-collections := xmldb:get-child-collections($collection) return
                    fn:string-join(
                        for $sub-collection at $i in  $sub-collections
                        let $sub-collection-path := fn:concat($collection, "/", $sub-collection),
                        $can-write := security:can-write-collection(security:get-user-credential-from-session()[1], $sub-collection-path) return
                            fn:concat(
                                "{""title"": """, fn:replace($sub-collection, '.*/',''), """,",
                                """isFolder"": true,",
                                """key"": """, $sub-collection-path, """,",
                                """writable"": ", if($can-write)then("true")else("false"), ",",
                                """addClass"": ", if($can-write)then("""writable""")else("""readable"""), ",",
                                local:get-group-collections($group-id, $sub-collection-path),
                                "}",
                                if($i lt count($sub-collections))then(",")else()
                            )
                    ,""),

            "]"
        )
};

declare function local:collections($root as xs:string) {

    if(xmldb:collection-available($root))then
    (
        let $user := security:get-user-credential-from-session()[1],
        $children := xmldb:get-child-collections($root),
        $can-write := security:can-write-collection($user, $root) return

            if(security:can-read-collection($user, $root)) then

                (: is this the users collection? :)
                if($root eq $security:users-collection) then
                (
                    (: users collection is treated specially :)
                    if($children = $user)then
                    (
                        (: found a mods home collection for the currently logged in user :)
                        let $home-collection-uri := security:get-home-collection-uri($user) return
                            <s>{{ "title": "Home", "isFolder": true, "key": "{$home-collection-uri}",
                                "writable": {if ($can-write) then 'true' else 'false' },
                                "addClass": "{if ($can-write) then 'writable' else 'readable'}",
                                "icon": "../css/dynatree/ltFld.user.gif"
                                {
                                    let $home-children := xmldb:get-child-collections($home-collection-uri) return
                                        if(fn:exists($home-children)) then
                                            <s>, "children": [
                                            {
                                                local:sub-collections($home-collection-uri, $home-children)
                                            }
                                            ]
                                            </s>
                                        else
                                            ()
                                }
                            }}</s>
                    )else(),

                    (: groups collection of shared group items :)
                    <s>{{ "title": "Groups", "isFolder": true, "key": "{$sharing:groups-collection}",
                                "writable": false,
                                "addClass": "readable",
                                "icon": "../css/dynatree/ltFld.groups.gif"
                                <s>, "children": [
                                {
                                    let $user-groups := sharing:get-users-groups(security:get-user-credential-from-session()[1]) return
                                        for $group at $i in  $user-groups return
                                            <s>{{
                                                "title": "{$group/group:name}",
                                                "isFolder": true,
                                                "key": "{fn:concat($sharing:groups-collection, "/", $group/@id)}",
                                                "writable": true,
                                                "addClass": "writable"
                                                {
                                                <s>,
                                                    {local:get-group-collections($group/@id, $security:users-collection)}
                                                </s>
                                                }
                                            }}{if($i lt count($user-groups))then(",")else()}</s>
                                }
                                ]
                                </s>
                    }}</s>
                )

                (: groups collection is treated specially, i.e. skipped :)
                else if($root eq $sharing:groups-collection)then
                (
                )
                else
                (   (: normal collection:)
                    <s>{{ "title": "{fn:replace($root, '.*/','')}", "isFolder": true, "key": "{$root}",
                        "writable": {if ($can-write) then 'true' else 'false' },
                        "addClass": "{if ($can-write) then 'writable' else 'readable'}"
                        {
                            if (fn:exists($children)) then
                                <s>, "children": [
                                {
                                    local:sub-collections($root, $children)
                                }
                                ]
                                </s>
                            else
                                ()
                        }
                    }}</s>
                )
            else()
    )else()
};

<s>[{local:collections($config:mods-root)}]</s>


when listing available documents via documents.json show the registered ones, not the sample ones

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

import module namespace csd_lsd = "https://github.com/openhie/openinfoman/csd_lsd";
import module namespace csd_dm = "https://github.com/openhie/openinfoman/csd_dm";
import module namespace csd_webconf =  "https://github.com/openhie/openinfoman/csd_webconf";
import module namespace csr_proc = "https://github.com/openhie/openinfoman/csr_proc";

declare function page:redirect($redirect as xs:string) as element(restxq:redirect)
{
  <restxq:redirect>{ $redirect }</restxq:redirect>
};

declare function page:nocache($response)
{(
  <rest:response>
    <http:response >
      <http:header name="Cache-Control" value="must-revalidate,no-cache,no-store"/>
    </http:response>
  </rest:response>
  ,
  $response
)};

declare
  %rest:path("/CSD/initSampleDirectory/directory/{$name}")
  %rest:GET
  %output:method("xhtml")
  function page:get_service_menu($name)
{
  let $response := page:services_menu($name)
  return page:nocache(csd_webconf:wrapper($response))
};

declare
  %rest:path("/CSD/initSampleDirectory/directory/{$name}/get")
  %rest:GET
  function page:get_directory($name)
{
  csd_dm:open_document($csd_webconf:db,$name)
};

declare updating
  %rest:path("/CSD/initSampleDirectory/directory/{$name}/load")
  %rest:GET
  function page:load($name)
{
(
  csd_lsd:load($csd_webconf:db,$name)   ,
  db:output(page:redirect(concat($csd_webconf:baseurl,"CSD/initSampleDirectory")))
)
};

declare updating
  %rest:path("/CSD/initSampleDirectory/directory/{$name}/reload")
  %rest:GET
  function page:reload($name)
{
(
  csd_dm:empty($csd_webconf:db,$name)   ,
  db:output(page:redirect(concat($csd_webconf:baseurl,concat("CSD/initSampleDirectory/directory/",$name,"/load"))))
)

};

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

Sample Directories

	    {for $name in csd_lsd:sample_directories()
	    order by $name
	    return

	      {$name}

	      {page:services_menu($name)}

	    }

return page:nocache(  csd_webconf:wrapper($response))

};

declare
  %rest:path("/CSD/documents.json")
  %rest:GET
  function page:export_function_details_json(){

  xml-to-json( page:get_export_document_details())
};

declare
  %rest:path("/CSD/documents.xml")
  %rest:GET
  function page:export_document_details_xml(){

    page:get_export_document_details()
};

declare function page:get_export_document_details() {
  <map xmlns="http://www.w3.org/2005/xpath-functions">
    {
      for $name in csd_dm:registered_documents($csd_webconf:db)
      return
      <map key="{string($name)}">
	<string key="careServicesRequest">{$csd_webconf:baseurl}CSD/csr/{$name}/careServicesRequest</string>
	<map key="careServicesRequests">
	  {
	    for $function in (csr_proc:stored_functions($csd_webconf:db),csr_proc:stored_updating_functions($csd_webconf:db))
	    let $urn:= string($function/@urn)
	    return <string key="{$urn}">{$csd_webconf:baseurl}CSD/csr/{$name}/careServicesRequest/{$urn}</string>
	  }
	</map>
      </map>
    }
  </map>
};

declare function page:services_menu($name) {

    {if (not(csd_dm:document_source_exists($csd_webconf:db,$name))) then

Initialize  {$name}

  else
    (

Get  {$name}
,

Reload {$name}

  )
    }

};

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

import module namespace csd_lsd = "https://github.com/openhie/openinfoman/csd_lsd";
import module namespace csd_dm = "https://github.com/openhie/openinfoman/csd_dm";
import module namespace csd_webconf =  "https://github.com/openhie/openinfoman/csd_webconf";
import module namespace csr_proc = "https://github.com/openhie/openinfoman/csr_proc";

declare function page:redirect($redirect as xs:string) as element(restxq:redirect)
{
  <restxq:redirect>{ $redirect }</restxq:redirect>
};

declare function page:nocache($response)
{(
  <rest:response>
    <http:response >
      <http:header name="Cache-Control" value="must-revalidate,no-cache,no-store"/>
    </http:response>
  </rest:response>
  ,
  $response
)};

declare
  %rest:path("/CSD/initSampleDirectory/directory/{$name}")
  %rest:GET
  %output:method("xhtml")
  function page:get_service_menu($name)
{
  let $response := page:services_menu($name)
  return page:nocache(csd_webconf:wrapper($response))
};

declare
  %rest:path("/CSD/initSampleDirectory/directory/{$name}/get")
  %rest:GET
  function page:get_directory($name)
{
  csd_dm:open_document($csd_webconf:db,$name)
};

declare updating
  %rest:path("/CSD/initSampleDirectory/directory/{$name}/load")
  %rest:GET
  function page:load($name)
{
(
  csd_lsd:load($csd_webconf:db,$name)   ,
  db:output(page:redirect(concat($csd_webconf:baseurl,"CSD/initSampleDirectory")))
)
};

declare updating
  %rest:path("/CSD/initSampleDirectory/directory/{$name}/reload")
  %rest:GET
  function page:reload($name)
{
(
  csd_dm:empty($csd_webconf:db,$name)   ,
  db:output(page:redirect(concat($csd_webconf:baseurl,concat("CSD/initSampleDirectory/directory/",$name,"/load"))))
)

};

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

Sample Directories

	    {for $name in csd_lsd:sample_directories()
	    order by $name
	    return

	      {$name}

	      {page:services_menu($name)}

	    }

return page:nocache(  csd_webconf:wrapper($response))

};

declare
  %rest:path("/CSD/documents.json")
  %rest:GET
  function page:export_function_details_json(){

  xml-to-json( page:get_export_document_details())
};

declare
  %rest:path("/CSD/documents.xml")
  %rest:GET
  function page:export_document_details_xml(){

    page:get_export_document_details()
};

declare function page:get_export_document_details() {
  <map xmlns="http://www.w3.org/2005/xpath-functions">
    {
      for $name in csd_lsd:sample_directories()
      return
      <map key="{string($name)}">
	<string key="careServicesRequest">{$csd_webconf:baseurl}CSD/csr/{$name}/careServicesRequest</string>
	<map key="careServicesRequests">
	  {
	    for $function in (csr_proc:stored_functions($csd_webconf:db),csr_proc:stored_updating_functions($csd_webconf:db))
	    let $urn:= string($function/@urn)
	    return <string key="{$urn}">{$csd_webconf:baseurl}CSD/csr/{$name}/careServicesRequest/{$urn}</string>
	  }
	</map>
      </map>
    }
  </map>
};

declare function page:services_menu($name) {

    {if (not(csd_dm:document_source_exists($csd_webconf:db,$name))) then

Initialize  {$name}

  else
    (

Get  {$name}
,

Reload {$name}

  )
    }

};