[MOD] DBA: Additional directories. Closes #1589

(:~
 : Files page.
 :
 : @author Christian Grün, BaseX Team, 2014-18
 :)
module namespace dba = 'dba/files';

import module namespace html = 'dba/html' at '../modules/html.xqm';
import module namespace options = 'dba/options' at '../modules/options.xqm';
import module namespace session = 'dba/session' at '../modules/session.xqm';
import module namespace util = 'dba/util' at '../modules/util.xqm';

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

(:~
 : Files page.
 : @param  $sort   table sort key
 : @param  $error  error message
 : @param  $info   info message
 : @return page
 :)
declare
  %rest:GET
  %rest:path("/dba/files")
  %rest:query-param("sort",  "{$sort}", "")
  %rest:query-param("error", "{$error}")
  %rest:query-param("info",  "{$info}")
  %output:method("html")
function dba:files(
  $sort   as xs:string,
  $error  as xs:string?,
  $info   as xs:string?
) as element(html) {
  let $dir := session:directory()
  return html:wrap(map { 'header': $dba:CAT, 'info': $info, 'error': $error },

Directory

        <form action="dir-change" method="post">
          <select name="dir" style="width: 350px;" onchange="this.form.submit();">{
            let $webapp := dba:dir(db:option('webpath'))[.]
            let $options := (
              ['DBA'       , $options:DBA-DIRECTORY],
              ['Webapp'    , $webapp],
              ['RESTXQ'    , dba:dir($webapp ! file:resolve-path(db:option('restxqpath'), .))],
              ['Repository', dba:dir(db:option('repopath'))],
              ['Home'      , Q{org.basex.util.Prop}HOMEDIR() ],
              ['Working'   , file:current-dir() ],
              ['Temporary' , file:temp-dir() ],
              Q{java:java.io.File}listRoots() ! ['Root', string(.)],
              ['Current'   , $dir]
            )
            let $selected := (
              for $option at $pos in $options
              where $option(2) = $dir
              return $pos
            )[1]
            for $option at $pos in $options
            let $name := $option(1), $path := $option(2)
            where $path
            return element option {
              attribute value { $path },
              attribute selected { }[$pos = $selected],
              $path[.] ! (($name || ': ')[$name] || .)
            }
          }</select><![CDATA[ ]]>
        </form>

        <form action="{ $dba:CAT }" method="post" class="update">{
          let $headers := (
            map { 'key': 'name', 'label': 'Name', 'type': 'xml' },
            map { 'key': 'date', 'label': 'Date', 'type': 'dateTime', 'order': 'desc' },
            map { 'key': 'bytes', 'label': 'Bytes', 'type': 'bytes', 'order': 'desc' },
            map { 'key': 'action', 'label': 'Action', 'type': 'xml' }
          )
          let $entries :=
            let $jobs := jobs:list-details()
            let $parent := if(file:parent($dir)) then ($dir || '..') else ()
            for $file in ($parent, file:children($dir))
            let $dir := file:is-dir($file)
            let $name := file:name($file)
            order by $dir descending, $name != '..', $name collation '?lang=en'
            return map {
              'name': function() {
                if($dir) then html:link($name, 'dir-change', map { 'dir': $name }) else $name
              },
              'date': file:last-modified($file),
              'bytes': file:size($file),
              'action': function() {
                util:item-join(
                  if($dir) then () else (
                    html:link('Download', 'file/' || encode-for-uri($name)),
                    if(matches($name, '\.xqm?$')) then (
                      html:link('Edit', 'queries', map { 'file': $name })
                    ) else (),
                    if(matches($name, '\.xq$')) then (
                      (: choose first running job :)
                      let $job := head(
                        let $uri := replace(file:path-to-uri($file), '^file:/*', '')
                        return $jobs[replace(., '^file:/*', '') = $uri]
                      )
                      let $id := string($job/@id)
                      return if(empty($job)) then (
                        html:link('Start', 'file-start', map { 'file': $name })
                      ) else (
                        html:link('Job', 'jobs', map { 'job': $id })
                      )
                    ) else ()
                  )
                , ' · ')
              }
            }
          let $buttons := html:button('file-delete', 'Delete', true())
          let $options := map { 'sort': $sort }
          return html:table($headers, $entries, $buttons, map { }, $options)
        }</form>

Upload Files

        <form action="file-upload" method="post" enctype="multipart/form-data">
          <input type="file" name="files" multiple="multiple"/>
          <input type="submit" value='Send'/>
        </form>

Create Directory

        <form action="dir-create" method="post">
          <input type="text" name="name"/><![CDATA[ ]]>
          <input type="submit" value='Create'/>
        </form>

  )
};

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

(:~
 : Returns a native directory representation of the specified file.
 : @param  $dir  directory
 : @return native path (or empty sequence)
 :)
declare function dba:dir(
  $dir  as xs:string
) as xs:string? {
  try {
    file:path-to-native($dir)
  } catch file:* { }
};

(:~
 : Files page.
 :
 : @author Christian Grün, BaseX Team, 2014-18
 :)
module namespace dba = 'dba/files';

import module namespace html = 'dba/html' at '../modules/html.xqm';
import module namespace options = 'dba/options' at '../modules/options.xqm';
import module namespace session = 'dba/session' at '../modules/session.xqm';
import module namespace util = 'dba/util' at '../modules/util.xqm';

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

(:~
 : Files page.
 : @param  $sort   table sort key
 : @param  $error  error message
 : @param  $info   info message
 : @return page
 :)
declare
  %rest:GET
  %rest:path("/dba/files")
  %rest:query-param("sort",  "{$sort}", "")
  %rest:query-param("error", "{$error}")
  %rest:query-param("info",  "{$info}")
  %output:method("html")
function dba:files(
  $sort   as xs:string,
  $error  as xs:string?,
  $info   as xs:string?
) as element(html) {
  let $dir := session:directory()
  return html:wrap(map { 'header': $dba:CAT, 'info': $info, 'error': $error },

Directory

        <form action="dir-change" method="post">
          <select name="dir" style="width: 350px;" onchange="this.form.submit();">{
            let $webapp := dba:dir(db:option('webpath'))[.]
            let $options := (
              ['DBA'       , $options:DBA-DIRECTORY],
              ['Webapp'    , $webapp],
              ['RESTXQ'    , dba:dir($webapp ! file:resolve-path(db:option('restxqpath'), .))],
              ['Repository', dba:dir(db:option('repopath'))],
              Q{java:java.io.File}listRoots() ! ['Root', string(.)],
              ['Current'   , $dir]
            )
            let $selected := (
              for $option at $pos in $options
              where $option(2) = $dir
              return $pos
            )[1]
            for $option at $pos in $options
            let $name := $option(1), $path := $option(2)
            where $path
            return element option {
              attribute value { $path },
              attribute selected { }[$pos = $selected],
              $path[.] ! (($name || ': ')[$name] || .)
            }
          }</select><![CDATA[ ]]>
        </form>

        <form action="{ $dba:CAT }" method="post" class="update">{
          let $headers := (
            map { 'key': 'name', 'label': 'Name', 'type': 'xml' },
            map { 'key': 'date', 'label': 'Date', 'type': 'dateTime', 'order': 'desc' },
            map { 'key': 'bytes', 'label': 'Bytes', 'type': 'bytes', 'order': 'desc' },
            map { 'key': 'action', 'label': 'Action', 'type': 'xml' }
          )
          let $entries :=
            let $jobs := jobs:list-details()
            let $parent := if(file:parent($dir)) then ($dir || '..') else ()
            for $file in ($parent, file:children($dir))
            let $dir := file:is-dir($file)
            let $name := file:name($file)
            order by $dir descending, $name != '..', $name collation '?lang=en'
            return map {
              'name': function() {
                if($dir) then html:link($name, 'dir-change', map { 'dir': $name }) else $name
              },
              'date': file:last-modified($file),
              'bytes': file:size($file),
              'action': function() {
                util:item-join(
                  if($dir) then () else (
                    html:link('Download', 'file/' || encode-for-uri($name)),
                    if(matches($name, '\.xqm?$')) then (
                      html:link('Edit', 'queries', map { 'file': $name })
                    ) else (),
                    if(matches($name, '\.xq$')) then (
                      (: choose first running job :)
                      let $job := head(
                        let $uri := replace(file:path-to-uri($file), '^file:/*', '')
                        return $jobs[replace(., '^file:/*', '') = $uri]
                      )
                      let $id := string($job/@id)
                      return if(empty($job)) then (
                        html:link('Start', 'file-start', map { 'file': $name })
                      ) else (
                        html:link('Job', 'jobs', map { 'job': $id })
                      )
                    ) else ()
                  )
                , ' · ')
              }
            }
          let $buttons := html:button('file-delete', 'Delete', true())
          let $options := map { 'sort': $sort }
          return html:table($headers, $entries, $buttons, map { }, $options)
        }</form>

Upload Files

        <form action="file-upload" method="post" enctype="multipart/form-data">
          <input type="file" name="files" multiple="multiple"/>
          <input type="submit" value='Send'/>
        </form>

Create Directory

        <form action="dir-create" method="post">
          <input type="text" name="name"/><![CDATA[ ]]>
          <input type="submit" value='Create'/>
        </form>

  )
};

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

(:~
 : Returns a native directory representation of the specified file.
 : @param  $dir  directory
 : @return native path (or empty sequence)
 :)
declare function dba:dir(
  $dir  as xs:string
) as xs:string? {
  try {
    file:path-to-native($dir)
  } catch file:* { }
};


Fix querying the MarkLogic stack frame on a running query.

(:
 : Copyright (C) 2020 Reece H. Dunn
 :
 : Licensed under the Apache License, Version 2.0 (the "License");
 : you may not use this file except in compliance with the License.
 : You may obtain a copy of the License at
 :
 : http://www.apache.org/licenses/LICENSE-2.0
 :
 : Unless required by applicable law or agreed to in writing, software
 : distributed under the License is distributed on an "AS IS" BASIS,
 : WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 : See the License for the specific language governing permissions and
 : limitations under the License.
 :)
xquery version "1.0-ml";
declare namespace o = "http://reecedunn.co.uk/xquery/options";
declare option o:implementation "marklogic/6.0";

(: Get the current call stack for a request. :)

declare variable $requestId as xs:unsignedLong external;

if (dbg:status($requestId)/dbg:request/dbg:request-status = "stopped") then
    dbg:stack($requestId)
else
    (: Stack frames are only available for stopped queries.
     :
     : The request may not be in the stopped state if the following happens:
     : 1.  the user pauses the request;
     : 2.  IntelliJ initiates a request for the stack frame on a separate thread;
     : 3.  the user resumes the request before the stack frame has been queried;
     : 4.  the stack frame is queried on a resumed request.
     :)
    <dbg:stack/>

(:
 : Copyright (C) 2020 Reece H. Dunn
 :
 : Licensed under the Apache License, Version 2.0 (the "License");
 : you may not use this file except in compliance with the License.
 : You may obtain a copy of the License at
 :
 : http://www.apache.org/licenses/LICENSE-2.0
 :
 : Unless required by applicable law or agreed to in writing, software
 : distributed under the License is distributed on an "AS IS" BASIS,
 : WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 : See the License for the specific language governing permissions and
 : limitations under the License.
 :)
xquery version "1.0-ml";
declare namespace o = "http://reecedunn.co.uk/xquery/options";
declare option o:implementation "marklogic/6.0";

(: Get the current call stack for a request. :)

declare variable $requestId as xs:unsignedLong external;

dbg:stack($requestId)


changed all 'his-tools' references to 'openhie'.  removed the 'at's on module import

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

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

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

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

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

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

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

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

import module namespace csd = "urn:ihe:iti:csd:2013" at "../repo/csd_base_library.xqm";
declare default element  namespace   "urn:ihe:iti:csd:2013";
declare variable $careServicesRequest as item() external;

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

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

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

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

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

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

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


fix(exist-cache): remove draft map constructor

xquery version "3.1";

module namespace c="http://exist-db.org/xquery/cache/test";

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

declare namespace test="http://exist-db.org/xquery/xqsuite";

declare variable $c:cache-name := "test" ;
declare variable $c:simple-options := map {};
declare variable $c:maximumSize := 5;
declare variable $c:maximumSize-options := map { "maximumSize": $c:maximumSize };
declare variable $c:expireAfterAccess := 1000;
declare variable $c:expireAfterAccess-options := map { "expireAfterAccess": $c:expireAfterAccess };

declare function c:_create-simple() {
    cache:create($c:cache-name, $c:simple-options)
};

declare function c:_create-maximumSize() {
    cache:create($c:cache-name, $c:maximumSize-options)
};

declare function c:_create-expireAfterAccess() {
    cache:create($c:cache-name, $c:expireAfterAccess-options)
};

declare function c:_populate($size as xs:integer) {
    (1 to $size) ! cache:put($c:cache-name, "foo" || ., "bar" || .)
};

declare function c:_keys() {
    cache:keys($c:cache-name)
};

declare function c:_cleanup() {
    cache:cleanup($c:cache-name)
};

declare function c:_destroy() {
    cache:destroy($c:cache-name)
};

declare
    %test:assertTrue
function c:create-simple-success() {
    let $setup := c:_destroy()
    return
        c:_create-simple()
};

declare
    %test:assertTrue
function c:create-maximumSize-success() {
    let $setup := c:_destroy()
    return
        c:_create-maximumSize()
};

declare
    %test:assertFalse
function c:create-already-exists() {
    let $setup :=
        (
            c:_destroy(),
            c:_create-simple()
        )
    return
        c:_create-simple()
};

declare
    %test:assertTrue
function c:names() {
    let $setup :=
        (
            c:_destroy(),
            c:_create-simple()
        )
    return
        cache:names() = $c:cache-name
};

declare
    %test:assertEquals("foo1 foo2")
function c:keys() {
    let $setup :=
        (
            c:_destroy(),
            c:_create-simple(),
            c:_populate(2)
        )
    return
        c:_keys() => sort() => string-join(" ")
};

declare
    %test:assertEquals("bar1 bar2")
function c:list-all-values() {
    let $setup :=
        (
            c:_destroy(),
            c:_create-simple(),
            c:_populate(2)
        )
    return
        cache:list($c:cache-name, ()) => sort() => string-join(" ")
};

declare
    %test:assertEquals("bar2")
function c:list-one-value() {
    let $setup :=
        (
            c:_destroy(),
            c:_create-simple(),
            c:_populate(2)
        )
    return
        cache:list($c:cache-name, "foo2")
};

declare
    %test:args(10)
    %test:assertEquals(5)
function c:exercise-maximumSize($size as xs:integer) {
    let $setup :=
        (
            c:_destroy(),
            c:_create-maximumSize(),
            c:_populate($size),
            c:_cleanup()
        )
    return
        count(c:_keys())
};

declare
    %test:assertEquals(0)
function c:exercise-expireAfterAccess() {
    let $setup :=
        (
            c:_destroy(),
            c:_create-expireAfterAccess(),
            c:_populate(5),
            util:wait($c:expireAfterAccess * 1.1),
            c:_cleanup()
        )
    return
        count(c:_keys())
};

declare
    %test:assertEquals("bar5")
function c:get() {
    let $setup :=
        (
            c:_destroy(),
            c:_create-simple(),
            c:_populate(5)
        )
    return
        cache:get($c:cache-name, "foo5")
};

declare
    %test:assertEmpty
function c:remove() {
    let $setup :=
        (
            c:_destroy(),
            c:_create-simple(),
            c:_populate(5),
            cache:remove($c:cache-name, "foo5")
        )
    return
        cache:get($c:cache-name, "foo5")
};

declare
    %test:assertEquals("bar5")
function c:remove-returns-previous-value() {
    let $setup :=
        (
            c:_destroy(),
            c:_create-simple(),
            c:_populate(5)
        )
    return
        cache:remove($c:cache-name, "foo5")
};

xquery version "3.1";

module namespace c="http://exist-db.org/xquery/cache/test";

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

declare namespace test="http://exist-db.org/xquery/xqsuite";

declare variable $c:cache-name := "test" ;
declare variable $c:simple-options := map {};
declare variable $c:maximumSize := 5;
declare variable $c:maximumSize-options := map { "maximumSize" := $c:maximumSize };
declare variable $c:expireAfterAccess := 1000;
declare variable $c:expireAfterAccess-options := map { "expireAfterAccess" := $c:expireAfterAccess };

declare function c:_create-simple() {
    cache:create($c:cache-name, $c:simple-options)
};

declare function c:_create-maximumSize() {
    cache:create($c:cache-name, $c:maximumSize-options)
};

declare function c:_create-expireAfterAccess() {
    cache:create($c:cache-name, $c:expireAfterAccess-options)
};

declare function c:_populate($size as xs:integer) {
    (1 to $size) ! cache:put($c:cache-name, "foo" || ., "bar" || .)
};

declare function c:_keys() {
    cache:keys($c:cache-name)
};

declare function c:_cleanup() {
    cache:cleanup($c:cache-name)
};

declare function c:_destroy() {
    cache:destroy($c:cache-name)
};

declare
    %test:assertTrue
function c:create-simple-success() {
    let $setup := c:_destroy()
    return
        c:_create-simple()
};

declare
    %test:assertTrue
function c:create-maximumSize-success() {
    let $setup := c:_destroy()
    return
        c:_create-maximumSize()
};

declare
    %test:assertFalse
function c:create-already-exists() {
    let $setup :=
        (
            c:_destroy(),
            c:_create-simple()
        )
    return
        c:_create-simple()
};

declare
    %test:assertTrue
function c:names() {
    let $setup :=
        (
            c:_destroy(),
            c:_create-simple()
        )
    return
        cache:names() = $c:cache-name
};

declare
    %test:assertEquals("foo1 foo2")
function c:keys() {
    let $setup :=
        (
            c:_destroy(),
            c:_create-simple(),
            c:_populate(2)
        )
    return
        c:_keys() => sort() => string-join(" ")
};

declare
    %test:assertEquals("bar1 bar2")
function c:list-all-values() {
    let $setup :=
        (
            c:_destroy(),
            c:_create-simple(),
            c:_populate(2)
        )
    return
        cache:list($c:cache-name, ()) => sort() => string-join(" ")
};

declare
    %test:assertEquals("bar2")
function c:list-one-value() {
    let $setup :=
        (
            c:_destroy(),
            c:_create-simple(),
            c:_populate(2)
        )
    return
        cache:list($c:cache-name, "foo2")
};

declare
    %test:args(10)
    %test:assertEquals(5)
function c:exercise-maximumSize($size as xs:integer) {
    let $setup :=
        (
            c:_destroy(),
            c:_create-maximumSize(),
            c:_populate($size),
            c:_cleanup()
        )
    return
        count(c:_keys())
};

declare
    %test:assertEquals(0)
function c:exercise-expireAfterAccess() {
    let $setup :=
        (
            c:_destroy(),
            c:_create-expireAfterAccess(),
            c:_populate(5),
            util:wait($c:expireAfterAccess * 1.1),
            c:_cleanup()
        )
    return
        count(c:_keys())
};

declare
    %test:assertEquals("bar5")
function c:get() {
    let $setup :=
        (
            c:_destroy(),
            c:_create-simple(),
            c:_populate(5)
        )
    return
        cache:get($c:cache-name, "foo5")
};

declare
    %test:assertEmpty
function c:remove() {
    let $setup :=
        (
            c:_destroy(),
            c:_create-simple(),
            c:_populate(5),
            cache:remove($c:cache-name, "foo5")
        )
    return
        cache:get($c:cache-name, "foo5")
};

declare
    %test:assertEquals("bar5")
function c:remove-returns-previous-value() {
    let $setup :=
        (
            c:_destroy(),
            c:_create-simple(),
            c:_populate(5)
        )
    return
        cache:remove($c:cache-name, "foo5")
};