Address #56 - Builtin Saxon functions: continue adding function signatures.

xquery version "1.0";
(:~
 : Saxon extension functions
 : @see http://www.saxonica.com/html/documentation/functions/saxon
 :
 :)
module namespace saxon = "http://saxon.sf.net/";

declare namespace jt = "http://saxon.sf.net/java-type";

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

declare %a:since("saxon/pe", "9.2") %a:since("saxon/ee", "9.2") function saxon:adjust-to-civil-time($in as xs:dateTime, $tz as xs:string) as xs:dateTime? external; (: reqs PE or EE :)
declare %a:since("saxon/pe", "9.8") function saxon:array-member($value as item()*) as jt:com.saxonica.functions.extfn.ArrayMemberValue external;
declare %a:since("saxon/pe", "8.1") %a:since("saxon/ee", "8.1") function saxon:base64Binary-to-octets($input as xs:base64Binary) as xs:integer* external;
declare %a:since("saxon/pe", "8.5") %a:since("saxon/ee", "8.5") function saxon:base64Binary-to-string($input as xs:base64Binary?, $encoding as xs:string) as xs:string external;
declare %a:since("saxon/pe", "9.1") %a:since("saxon/ee", "9.1") function saxon:column-number() as xs:integer external;
declare %a:since("saxon/pe", "9.1") %a:since("saxon/ee", "9.1") function saxon:column-number($node as node()) as xs:integer external;
declare %a:since("saxon/pe", "9.0") %a:since("saxon/ee", "9.0") function saxon:compile-query($query as xs:string) as jt:net.sf.saxon.query.XQueryExpression external;
declare %a:since("saxon/pe", "8.5") %a:since("saxon/ee", "8.5") function saxon:compile-stylesheet($stylesheet as document-node()) as jt.net.sf.saxon.PreparedStylesheet external;
declare %a:since("saxon/pe", "9.3") %a:since("saxon/ee", "9.3") function saxon:current-mode-name() as xs:QName? external; (: @TODO the documentation claims that this was designed for XSLT :)
declare %a:since("saxon/pe", "8.0") %a:since("saxon/ee", "8.0") function saxon:decimal-divide($arg1 as xs:decimal?, $arg2 as xs:decimal, $precision as xs:integer) as xs:decimal? external;
declare %a:since("saxon/pe", "8.6.1") %a:since("saxon/ee", "8.6.1") function saxon:deep-equal($arg1 as item()*, $arg2 as item()*, $collation as xs:string?, $flags as xs:string) as xs:boolean external;
declare %a:since("saxon/pe", "8.0") %a:since("saxon/ee", "8.0") function saxon:discard-document($doc as document-node()) as document-node() external;
declare %a:since("saxon/pe", "7.2") %a:since("saxon/ee", "7.2") function saxon:eval($stored-expression as jt:net.sf.saxon.functions.Evaluate-PreparedExpression, $param1 as item()*, $param2 as item()*, $param3 as item()*) as xs:double external;
declare %a:since("saxon/pe", "7.2") %a:since("saxon/ee", "7.2") function saxon:evaluate($xpath as xs:string, $param1 as item()*, $param2 as item()*, $param3 as item()*) as item()* external;
declare %a:since("saxon/pe", "8.2") %a:since("saxon/ee", "8.2") function saxon:evaluate-node($node as node()) as item()* external;
declare %a:since("saxon/pe", "7.2") %a:since("saxon/ee", "7.2") function saxon:expression($string as xs:string) as jt:net.sf.saxon.functions.Evaluate-PreparedExpression external;
declare %a:since("saxon/pe", "7.2") %a:since("saxon/ee", "7.2") function saxon:expression($string as xs:string, $ns as element()) as jt:net.sf.saxon.functions.Evaluate-PreparedExpression external;
declare %a:since("saxon/pe", "8.0") %a:since("saxon/ee", "8.0") function saxon:get-pseudo-attribute($att as xs:string) as xs:string? external;
declare %a:since("saxon/pe", "8.0") %a:since("saxon/ee", "8.0") function saxon:has-same-nodes($arg1 as node()*, $arg2 as node()*) as xs:boolean external;
declare %a:since("saxon/pe", "8.1") %a:since("saxon/ee", "8.1") function saxon:hexBinary-to-octets($input as xs:hexBinary) as xs:integer* external;
declare %a:since("saxon/pe", "8.5") %a:since("saxon/ee", "8.5") function saxon:hexBinary-to-string($input as xs:hexBinary, $encoding as xs:string) as xs:string external;
declare %a:since("saxon/pe", "8.1") %a:since("saxon/ee", "8.1") function saxon:highest($input as item()*) as item()* external;
declare %a:since("saxon/pe", "8.1") %a:since("saxon/ee", "8.1") function saxon:highest($input as item()*, $key as function(*) (: $key [8.1] as jt:net.sf.saxon.functions.Evaluate-PreparedExpression [9.2] as function() [9.5] as function(*) :)) as item()* external;
declare %a:since("saxon/pe", "9.1") %a:since("saxon/ee", "9.1") function saxon:in-summer-time($date as xs:dateTime, $region as xs:string) as xs:boolean external;
declare %a:since("saxon/pe", "8.3") %a:since("saxon/ee", "8.3") %a:until("saxon/pe", "9.4") %a:until("saxon/ee", "9.4") function saxon:index($sequence as item()*, $expression as jt:net.sf.saxon.functions.Evaluate-PreparedExpression, $collation as xs:string) as jt:com.saxonica.expr.IndexedSequence external;
declare %a:since("saxon/pe", "9.5") %a:since("saxon/ee", "9.5") function saxon:index($sequence as item()*, $function as function(item()) as xs:anyAtomicType* (: [9.5] as xs:integer  :)) as map(*) (: [8.3] as jt:com.saxonica.expr.IndexedSequence [9.5] as xs:double [9.7] as map(*) :) external;
declare %a:since("saxon/ee", "9.7") function saxon:is-defaulted($node as node()) as xs:boolean external;
declare %a:since("saxon/pe", "8.0") %a:since("saxon/ee", "8.0") function saxon:is-whole-number($arg as xs:numeric?) as xs:boolean external;
declare %a:since("saxon/pe", "9.0") %a:since("saxon/ee", "9.0") function saxon:last-modified($uri as xs:string? (: [9.0] () as document-uri($node)) [9.2] $uri as xs:string? :)) as xs:dateTime? external;
declare %a:since("saxon/pe", "9.0") %a:since("saxon/ee", "9.0") %a:until("saxon/pe", "9.1") %a:until("saxon/ee", "9.1") function saxon:last-modified($node as node()) as xs:dateTime? external;
declare %a:since("saxon/pe", "8.0") %a:since("saxon/ee", "8.0") function saxon:leading($input as item()*) as item() external;
declare %a:since("saxon/pe", "8.0") %a:since("saxon/ee", "8.0") function saxon:leading($input as item()*, $test as function(*) (: [8.0] as jt:net.sf.saxon.functions.Evaluate-PreparedExpression [9.5] as function(*) :)) as item() external;


[docs.xforms] tidied up

[docs.xforms] tidied up

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

xquery version "1.0";

import module namespace request = "http://exist-db.org/xquery/request";
import module namespace const = "http://xproc.net/xproc/const";
import module namespace xproc = "http://xproc.net/xproc";
import module namespace u = "http://xproc.net/xproc/util";

declare option exist:serialize "method=xhtml media-type=html";

let $pipeline := request:get-parameter("xproc", ())
let $stdin := request:get-parameter("stdin", ())
let $indoc := if ($stdin) then doc($stdin) else ()
let $debug := if(request:get-parameter("debug", ())) then
					request:get-parameter("debug", ())
				 else
					'0'
return
     xproc:run(doc($pipeline), $indoc, $debug)


Update fn.xql

Update fn.xql

(:
 : eXist-db Open Source Native XML Database
 : Copyright (C) 2001 The eXist-db Authors
 :
 : info@exist-db.org
 : http://www.exist-db.org
 :
 : This library is free software; you can redistribute it and/or
 : modify it under the terms of the GNU Lesser General Public
 : License as published by the Free Software Foundation; either
 : version 2.1 of the License, or (at your option) any later version.
 :
 : This library is distributed in the hope that it will be useful,
 : but WITHOUT ANY WARRANTY; without even the implied warranty of
 : MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 : Lesser General Public License for more details.
 :
 : You should have received a copy of the GNU Lesser General Public
 : License along with this library; if not, write to the Free Software
 : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 :)
xquery version "3.1";

(:~
 : Test various F+O functions
 :)
module namespace fnt="http://exist-db.org/xquery/test/fn";

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

declare variable $fnt:composed := 'Åström';
declare variable $fnt:decomposed := 'Åström';

declare
    %test:setUp
function fnt:store() {
    let $col := xmldb:create-collection("/db", "fn-test")
    return
        (
            xmldb:store($col, "test.xml", <books><book/></books>),
            xmldb:store($col, "test.bin", "some binary", "application/octet-stream")
        )
};

declare
    %test:tearDown
function fnt:cleanup() {
    xmldb:remove("/db/fn-test")
};

declare
    %test:args("NFC")
    %test:assertEquals(6, 6)
    %test:args("NFD")
    %test:assertEquals(8, 8)
    %test:args("NFKD")
    %test:assertEquals(8, 8)
    %test:args("NFKC")
    %test:assertEquals(6, 6)
    %test:args("XYZ")
    %test:assertError
function fnt:normalize-unicode($normalization-form as xs:string) {
    count(string-to-codepoints(normalize-unicode($fnt:composed, $normalization-form))),
    count(string-to-codepoints(normalize-unicode($fnt:decomposed, $normalization-form)))
};

declare
    %test:args("test.xml")
    %test:assertEquals("true")
    %test:args("test.bin")
    %test:assertEquals("false")
    %test:args("no-such-file.xml")
    %test:assertEquals("false")
    %test:args("no-such-file.bin")
    %test:assertEquals("false")
function fnt:doc-available($filename as xs:string) {
    fn:doc-available("/db/fn-test/" || $filename)
};

(:
  Intentionally marked as pending as it has
  an external dependency
:)
declare
    %test:pending
    %test:args("https://www.kingjamesbibleonline.org/Genesis-Chapter-1_Original-1611-KJV/")
    %test:assertEquals("false")
function fnt:doc-available-remote($uri as xs:string) {
    fn:doc-available($uri)
};

declare
    %test:args("\adamretter")
    %test:assertError("FODC0005")
function fnt:doc-available-invalid-uri($uri as xs:string) {
    fn:doc-available($uri)
};

declare
    %test:args("test.xml")
    %test:assertEquals("true")
function fnt:doc-returns-document-node($filename as xs:string) {
    fn:doc("/db/fn-test/" || $filename) instance of document-node()
};

declare
    %test:args("test.xml")
    %test:assertEmpty
function fnt:doc-does-not-return-element-node($filename as xs:string) {
    fn:doc("/db/fn-test/" || $filename)/book
};

declare
    %test:assertEquals(0, 0)
function fnt:tokenize-empty() {
     count(() => tokenize("\s")),
     count(tokenize((), "\s"))
};

declare
    %test:args("hello adam")
    %test:assertEquals("hello", "adam")
    %test:args("hello   adam")
    %test:assertEquals("hello", "adam")
function fnt:tokenize-onearg($str as xs:string) {
     tokenize($str)
};

declare
    %test:assertError("err:XPDY0002")
function fnt:document-uri0_noarg() {
     document-uri()
};

declare
    %test:assertError("err:XPDY0002")
function fnt:document-uri0() {
     document-uri(.)
};

declare
    %test:assertEquals("/db/fn-test/test.xml")
function fnt:document-uri0_context() {
     root(collection('/db/fn-test')//book)/document-uri()
};

declare
    %test:assertError("err:XPDY0002")
function fnt:document-uri0_context_empty() {
     root(collection('/db/fn-test')//bookies)/document-uri()
};

declare
    %test:assertEquals("/db/fn-test/test.xml")
function fnt:document-uri1() {
     document-uri(root(collection('/db/fn-test')//book))
};

declare
    %test:assertEmpty
function fnt:document-uri1_empty() {
     document-uri(root(collection('/db/fn-test')//bookies))
};

declare
    %test:assertTrue
function fnt:fn-document-uri-32() {
     let $uri := "/db/fn-test/test.xml"
     return
         fn:contains(fn:doc($uri)/document-uri(), $uri)
};

(:
 : eXist-db Open Source Native XML Database
 : Copyright (C) 2001 The eXist-db Authors
 :
 : info@exist-db.org
 : http://www.exist-db.org
 :
 : This library is free software; you can redistribute it and/or
 : modify it under the terms of the GNU Lesser General Public
 : License as published by the Free Software Foundation; either
 : version 2.1 of the License, or (at your option) any later version.
 :
 : This library is distributed in the hope that it will be useful,
 : but WITHOUT ANY WARRANTY; without even the implied warranty of
 : MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 : Lesser General Public License for more details.
 :
 : You should have received a copy of the GNU Lesser General Public
 : License along with this library; if not, write to the Free Software
 : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 :)
xquery version "3.1";

(:~
 : Test various F+O functions
 :)
module namespace fnt="http://exist-db.org/xquery/test/fn";

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

declare variable $fnt:composed := 'Åström';
declare variable $fnt:decomposed := 'Åström';

declare
    %test:setUp
function fnt:store() {
    let $col := xmldb:create-collection("/db", "fn-test")
    return
        (
            xmldb:store($col, "test.xml", <books><book/></books>),
            xmldb:store($col, "test.bin", "some binary", "application/octet-stream")
        )
};

declare
    %test:tearDown
function fnt:cleanup() {
    xmldb:remove("/db/fn-test")
};

declare
    %test:args("NFC")
    %test:assertEquals(6, 6)
    %test:args("NFD")
    %test:assertEquals(8, 8)
    %test:args("NFKD")
    %test:assertEquals(8, 8)
    %test:args("NFKC")
    %test:assertEquals(6, 6)
    %test:args("XYZ")
    %test:assertError
function fnt:normalize-unicode($normalization-form as xs:string) {
    count(string-to-codepoints(normalize-unicode($fnt:composed, $normalization-form))),
    count(string-to-codepoints(normalize-unicode($fnt:decomposed, $normalization-form)))
};

declare
    %test:args("test.xml")
    %test:assertEquals("true")
    %test:args("test.bin")
    %test:assertEquals("false")
    %test:args("no-such-file.xml")
    %test:assertEquals("false")
    %test:args("no-such-file.bin")
    %test:assertEquals("false")
function fnt:doc-available($filename as xs:string) {
    fn:doc-available("/db/fn-test/" || $filename)
};

(:
  Intentionally marked as pending as it has
  an external dependency
:)
declare
    %test:pending
    %test:args("https://www.kingjamesbibleonline.org/Genesis-Chapter-1_Original-1611-KJV/")
    %test:assertEquals("false")
function fnt:doc-available-remote($uri as xs:string) {
    fn:doc-available($uri)
};

declare
    %test:args("\adamretter")
    %test:assertError("FODC0005")
function fnt:doc-available-invalid-uri($uri as xs:string) {
    fn:doc-available($uri)
};

declare
    %test:args("test.xml")
    %test:assertEquals("true")
function fnt:doc-returns-document-node($filename as xs:string) {
    fn:doc("/db/fn-test/" || $filename) instance of document-node()
};

declare
    %test:args("test.xml")
    %test:assertEmpty
function fnt:doc-does-not-return-element-node($filename as xs:string) {
    fn:doc("/db/fn-test/" || $filename)/book
};

declare
    %test:assertEquals(0, 0)
function fnt:tokenize-empty() {
     count(() => tokenize("\s")),
     count(tokenize((), "\s"))
};

declare
    %test:args("hello adam")
    %test:assertEquals("hello", "adam")
    %test:args("hello   adam")
    %test:assertEquals("hello", "adam")
function fnt:tokenize-onearg($str as xs:string) {
     tokenize($str)
};

declare
    %test:assertError("err:XPDY0002")
function fnt:document-uri0_noarg() {
     document-uri()
};

declare
    %test:assertError("err:XPDY0002")
function fnt:document-uri0() {
     document-uri(.)
};

declare
    %test:assertEquals("/db/fn-test/test.xml")
function fnt:document-uri0_context() {
     root(collection('/db/fn-test')//book)/document-uri()
};

declare
    %test:assertError("err:XPDY0002")
function fnt:document-uri0_context_empty() {
     root(collection('/db/fn-test')//bookies)/document-uri()
};

declare
    %test:assertEquals("/db/fn-test/test.xml")
function fnt:document-uri1() {
     document-uri(root(collection('/db/fn-test')//book))
};

declare
    %test:assertEmpty
function fnt:document-uri1_empty() {
     document-uri(root(collection('/db/fn-test')//bookies))
};

declare
    %test:assertEquals("TRUE")
function fnt:fn-document-uri-32() {
     let $uri := "/db/fn-test/test.xml"
     return
     fn:upper-case(fn:string(fn:contains((fn:doc($uri))/document-uri(),$uri)))
};


Added tooltip showing the group that the collection is shared with. The size and apperance of these tooltips should be improved soon

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

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?, $additional-classes as xs:string*, $children-function) as element(node)
{
    let $is-user-home-subcollection := fn:starts-with($collection-path, fn:concat(security:get-home-collection-uri(security:get-user-credential-from-session()[1]), '/')) return

    <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>
        {
            fn:concat(
                if($can-write) then 'writable' else 'readable',
                ' ',
                fn:string-join(
                    for $additional-class in $additional-classes return
                        $additional-class,
                    ' '
                ),
                if($is-user-home-subcollection)then 'userHomeSubCollection' else ''
            )
        }
        </addClass>
        {
            if($icon-path)then
            (
                <icon>{$icon-path}</icon>
            )else(),

            if($is-user-home-subcollection)then
            (
                let $group-id := sharing:get-group-id($collection-path) return
                    if($group-id)then
                    (
                        <tooltip>Shared With: {sharing:get-group($group-id)/group:name/text()}</tooltip>
                    )else()
            )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", "../skin/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", "../skin/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 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", "../skin/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", "../skin/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)


*** empty log message ***

*** empty log message ***

svn path=/trunk/eXist-1.0/; revision=936

(:
    Module: examples setup
:)
module namespace setup="http://exist-db.org/xquery/admin-interface/setup";

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

declare function setup:main() as element() {

Examples Setup

        {
            let $action := request:request-parameter("action", ())
            return
                if($action) then
                    if($action eq "Import Example Data") then
                        setup:importLocal()
                    else if($action eq "Import Remote Files") then
                        setup:importFromURLs()
                    else
                        setup:page3()
                else
                    setup:page1()
        }

};

declare function setup:importLocal() as element()+ {
	let $home := util:system-property("exist.home"),
		$pathSep := util:system-property("file.separator"),
		$dir :=
			if(ends-with($home, "WEB-INF")) then
				concat(substring-before($home, "WEB-INF"), "samples")
			else
				concat($home, $pathSep, "samples")
    return (
        setup:page2(),

Actions:

            {
                setup:create-collection("/db", "shakespeare"),
                setup:create-collection("/db/shakespeare", "plays"),
                setup:store-files("/db/shakespeare/plays", $dir,
                    ( "shakespeare/*.xml", "shakespeare/*.xsl" ),
                    "text/xml"
                ),
                setup:store-files("/db/shakespeare/plays", $dir,
                    "shakespeare/*.css", "text/css"),
                setup:create-collection("/db", "xinclude"),
                setup:store-files("/db/xinclude", $dir,
                    ( "xinclude/*.xsl", "xinclude/*.xml"), "text/xml"),
                setup:create-collection("/db", "library"),
                setup:store-files("/db/library", $dir, "*.rdf", "text/xml"),
                setup:create-collection("/db", "mods"),
                setup:store-files("/db/mods", $dir, "mods/*.xml", "text/xml"),
                setup:store-files("/db", $dir, "*.xml", "text/xml"),
				setup:create-collection("/db/system/config", "db"),
				setup:create-collection("/db/system/config/db", "mondial"),
				setup:store-files("/db/system/config/db/mondial", $dir,
					"mondial.xconf", "text/xml")
            }

    )
};

declare function setup:importFromURLs() as element()+ {
    (
        setup:page3(),

Actions:

            {
                let $includeXmlad := request:request-parameter("xmlad", ()),
                    $includeMondial := request:request-parameter("mondial", ())
                return (
                    if($includeXmlad) then (
                        setup:create-collection("/db", "xmlad"),
                        setup:load-URL("/db/xmlad",
                            "http://belnet.dl.sourceforge.net/sourceforge/xmlad/xmlad.xml",
                            "xmlad.xml")
                    ) else (),
                    if($includeMondial) then (
                        setup:create-collection("/db", "mondial"),
                        setup:load-URL("/db/mondial",
                            "http://dbis.informatik.uni-goettingen.de/Mondial/mondial-europe.xml",
                            "mondial.xml")
                    ) else ()
                )
            }

    )
};

declare function setup:load-URL($collection, $url, $docName) as element() {
    xdb:store($collection, $docName, xs:anyURI($url)),

File {$docName} imported from url: {$url}

};

declare function setup:store-files($collection, $home, $patterns, $mimeType) as element()* {
    let $stored := xdb:store-files-from-pattern($collection, $home, $patterns, $mimeType)
    for $doc in $stored
    return

Uploaded: {$doc}

};

declare function setup:create-collection($parent, $name) as element() {
    let $col := xdb:create-collection($parent, $name)
    return

Created collection: {util:collection-name($col)}

};

declare function setup:page1() as element() {
    <form action="{request:encode-url(request:request-uri())}" method="POST">

eXist ships with a number of XQuery examples. Some of these
        require certain documents to be stored in the database. Clicking on the button
        below will import the required data from the samples directory:

        <input type="submit" name="action" value="Import Example Data"/>
        <input type="hidden" name="panel" value="setup"/>
    </form>
};

declare function setup:page2() as element() {
    <form action="{request:encode-url(request:request-uri())}" method="POST">

The XQuery examples also use some XML data not included with the distribution.
        I can try to download the corresponding data. Do you want me to do so?

        <input type="checkbox" name="xmlad" checked="true"/>
        The XML Acronym Demystifier
        (approx. 384K)

        <input type="checkbox" name="mondial"/>
        The Mondial Database (Europe)
        (approx. 410K)

<input type="submit" name="action" value="Import Remote Files"/>
        <input type="submit" name="action" value="Skip"/>

        <input type="hidden" name="panel" value="setup"/>
    </form>
};

declare function setup:page3() as element() {

Files have been loaded. You can now go to the
    examples page.

};

(:
    Module: examples setup
:)
module namespace setup="http://exist-db.org/xquery/admin-interface/setup";

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

declare function setup:main() as element() {

Examples Setup

        {
            let $action := request:request-parameter("action", ())
            return
                if($action) then
                    if($action eq "Import Example Data") then
                        setup:importLocal()
                    else if($action eq "Import Remote Files") then
                        setup:importFromURLs()
                    else
                        setup:page3()
                else
                    setup:page1()
        }

};

declare function setup:importLocal() as element()+ {
	let $home := util:system-property("exist.home"),
		$pathSep := util:system-property("file.separator"),
		$dir :=
			if(ends-with($home, "WEB-INF")) then
				concat(substring-before($home, "WEB-INF"), "samples")
			else
				concat($home, $pathSep, "samples")
    return (
        setup:page2(),

Actions:

            {
                setup:create-collection("/db", "shakespeare"),
                setup:create-collection("/db/shakespeare", "plays"),
                setup:store-files("/db/shakespeare/plays", $dir,
                    ( "shakespeare/*.xml", "shakespeare/*.xsl" ),
                    "text/xml"
                ),
                setup:store-files("/db/shakespeare/plays", $dir,
                    "shakespeare/*.css", "text/css"),
                setup:create-collection("/db", "xinclude"),
                setup:store-files("/db/xinclude", $dir,
                    ( "xinclude/*.xsl", "xinclude/*.xml"), "text/xml"),
                setup:create-collection("/db", "library"),
                setup:store-files("/db/library", $dir, "*.rdf", "text/xml"),
                setup:create-collection("/db", "mods"),
                setup:store-files("/db/mods", $dir, "mods/*.xml", "text/xml"),
                setup:store-files("/db", $dir, "*.xml", "text/xml")
            }

    )
};

declare function setup:importFromURLs() as element()+ {
    (
        setup:page3(),

Actions:

            {
                let $includeXmlad := request:request-parameter("xmlad", ()),
                    $includeMondial := request:request-parameter("mondial", ())
                return (
                    if($includeXmlad) then (
                        setup:create-collection("/db", "xmlad"),
                        setup:load-URL("/db/xmlad",
                            "http://belnet.dl.sourceforge.net/sourceforge/xmlad/xmlad.xml",
                            "xmlad.xml")
                    ) else (),
                    if($includeMondial) then (
                        setup:create-collection("/db", "mondial"),
                        setup:load-URL("/db/mondial",
                            "http://dbis.informatik.uni-goettingen.de/Mondial/mondial-europe.xml",
                            "mondial.xml")
                    ) else ()
                )
            }

    )
};

declare function setup:load-URL($collection, $url, $docName) as element() {
    xdb:store($collection, $docName, xs:anyURI($url)),

File {$docName} imported from url: {$url}

};

declare function setup:store-files($collection, $home, $patterns, $mimeType) as element()* {
    let $stored := xdb:store-files-from-pattern($collection, $home, $patterns, $mimeType)
    for $doc in $stored
    return

Uploaded: {$doc}

};

declare function setup:create-collection($parent, $name) as element() {
    let $col := xdb:create-collection($parent, $name)
    return

Created collection: {util:collection-name($col)}

};

declare function setup:page1() as element() {
    <form action="{request:encode-url(request:request-uri())}" method="POST">

eXist ships with a number of XQuery examples. Some of these
        require certain documents to be stored in the database. Clicking on the button
        below will import the required data from the samples directory:

        <input type="submit" name="action" value="Import Example Data"/>
        <input type="hidden" name="panel" value="setup"/>
    </form>
};

declare function setup:page2() as element() {
    <form action="{request:encode-url(request:request-uri())}" method="POST">

The XQuery examples also use some XML data not included with the distribution.
        I can try to download the corresponding data. Do you want me to do so?

        <input type="checkbox" name="xmlad" checked="true"/>
        The XML Acronym Demystifier
        (approx. 384K)

        <input type="checkbox" name="mondial"/>
        The Mondial Database (Europe)
        (approx. 410K)

<input type="submit" name="action" value="Import Remote Files"/>
        <input type="submit" name="action" value="Skip"/>

        <input type="hidden" name="panel" value="setup"/>
    </form>
};

declare function setup:page3() as element() {

Files have been loaded. You can now go to the
    examples page.

};


[bugfix] Fix an issue with String Constructor line endings test on Windows

xquery version "3.1";

module namespace sc="http://exist-db.org/xquery/test/string-constructor";

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

declare variable $sc:win := map {
      "name": "Chris",
      "value": 10000,
      "taxed_value": 10000 - (10000 * 0.4),
      "in_ca": true()
    };

declare
    %test:assertEquals("Hello world!")
function sc:simple() {
    ``[Hello world!]``
};

(:
 : Character entities are not expanded, chars like <> are allowed.
 :)
declare
    %test:assertEquals("Hello &<world>{!}(:no comment:)")
function sc:special-chars() {
    ``[Hello &<world>{!}(:no comment:)]``
};

declare
    %test:assertEquals("Hello my world!")
function sc:simple-interpolation() {
    let $a := "my"
    return
        ``[Hello `{$a}` world!]``
};

declare
    %test:assertEquals('Hello "my" ''my'' world!')
function sc:simple-interpolation-quoted() {
    let $a := "my"
    return
        ``[Hello "`{$a}`" '`{$a}`' world!]``
};

declare
    %test:assertEquals("Hello my new world!")
function sc:simple-interpolation-sequence() {
    let $a := ("my", "new")
    return
        ``[Hello `{$a}` world!]``
};

declare
    %test:assertEquals("one fish", "two fish", "red fish", "blue fish")
function sc:simple-for() {
    for $s in ("one", "two", "red", "blue")
    return ``[`{$s}` fish]``
};

declare
    %test:assertEquals("1 literal text 2 more literal text")
function sc:nested() {
    let $i := 1
    let $j := 2
    return
        ``[`{ $i, ``[literal text]``, $j, ``[more literal text]`` }`]``
};

declare
    %test:assertEquals("Hello my world!")
function sc:path-interpolation() {
    let $a :=
my

    return
        ``[Hello `{$a/span}` world!]``
};

declare
    %test:assertEquals("I count 6!")
function sc:interpolation-funcall() {
    let $a := (1, 2, 3)
    return
        ``[I count `{sum($a)}`!]``
};

declare
    %test:assertXPath('count(tokenize($result, "\n")) eq 3')
function sc:newlines() {
``[Hello `{$sc:win?name}`
You have just won `{$sc:win?value}` dollars!
`{
   if ($sc:win?in_ca)
   then ``[Well, `{$sc:win?taxed_value}` dollars, after taxes.]``
   else ""
}`]``
};

xquery version "3.1";

module namespace sc="http://exist-db.org/xquery/test/string-constructor";

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

declare variable $sc:win := map {
      "name": "Chris",
      "value": 10000,
      "taxed_value": 10000 - (10000 * 0.4),
      "in_ca": true()
    };

declare
    %test:assertEquals("Hello world!")
function sc:simple() {
    ``[Hello world!]``
};

(:
 : Character entities are not expanded, chars like <> are allowed.
 :)
declare
    %test:assertEquals("Hello &<world>{!}(:no comment:)")
function sc:special-chars() {
    ``[Hello &<world>{!}(:no comment:)]``
};

declare
    %test:assertEquals("Hello my world!")
function sc:simple-interpolation() {
    let $a := "my"
    return
        ``[Hello `{$a}` world!]``
};

declare
    %test:assertEquals('Hello "my" ''my'' world!')
function sc:simple-interpolation-quoted() {
    let $a := "my"
    return
        ``[Hello "`{$a}`" '`{$a}`' world!]``
};

declare
    %test:assertEquals("Hello my new world!")
function sc:simple-interpolation-sequence() {
    let $a := ("my", "new")
    return
        ``[Hello `{$a}` world!]``
};

declare
    %test:assertEquals("one fish", "two fish", "red fish", "blue fish")
function sc:simple-for() {
    for $s in ("one", "two", "red", "blue")
    return ``[`{$s}` fish]``
};

declare
    %test:assertEquals("1 literal text 2 more literal text")
function sc:nested() {
    let $i := 1
    let $j := 2
    return
        ``[`{ $i, ``[literal text]``, $j, ``[more literal text]`` }`]``
};

declare
    %test:assertEquals("Hello my world!")
function sc:path-interpolation() {
    let $a :=
my

    return
        ``[Hello `{$a/span}` world!]``
};

declare
    %test:assertEquals("I count 6!")
function sc:interpolation-funcall() {
    let $a := (1, 2, 3)
    return
        ``[I count `{sum($a)}`!]``
};

declare
    %test:assertEquals("Hello Chris
You have just won 10000 dollars!
Well, 6000 dollars, after taxes.")
function sc:newlines() {
``[Hello `{$sc:win?name}`
You have just won `{$sc:win?value}` dollars!
`{
   if ($sc:win?in_ca)
   then ``[Well, `{$sc:win?taxed_value}` dollars, after taxes.]``
   else ""
}`]``
};


reworked cmd-stats as entry-point for summaries about cmd

xquery version "1.0";
import module namespace request="http://exist-db.org/xquery/request";
(:import module namespace cradmin  = "http://aac.ac.at/content_repository/admin" at "/db/cr/admin.xqm";:)
import module namespace cmdcheck = "http://clarin.eu/cmd/check" at "/db/cr/modules/cmd/cmd-check.xqm";

let $config-path := request:get-parameter("config", "/db/cr/etc/config_mdrepo.xml"),
    $op := request:get-parameter("operation", ""),
    $config := doc($config-path),
    $x-context := request:get-parameter("x-context", "") (: "univie.at:cpas"  "clarin.at:icltt:cr:stb" :),

    $result := if ($op eq '') then cmdcheck:display-overview($config-path)
                    else cmdcheck:run-stats($config-path)

return $result

(: OBSOLETED by crday:query-internal() :)
let $doc-name := xmldb:store("/db/mdrepo-data/", "stats_cmdi-providers.xml", <result></result>),
    $doc := doc($doc-name),
    (:    $ns-uri := namespace-uri($context[1]/*), :)
            (: dynamically declare a namespace for the next step, if one is defined in current context :)
    (: $dummy := if (exists($ns-uri)) then util:declare-namespace("",$ns-uri) else () :)
    $dummy := util:declare-namespace("",xs:anyURI("http://www.clarin.eu/cmd/")),
    $collection := collection("/db/mdrepo-data/cmdi-providers"),
$items := (<item key="C" label="CMD" >count($collection//CMD)</item> ,
<item key="C.-handle" label="CMD without MdSelfLink" >count($collection//CMD[not(Header/MdSelfLink)])</item>,
<item key="C.0" label="CMD without " >count($collection//CMD[not(.//ResourceType='Resource')][not(.//ResourceType='Metadata')])</item>,
<item key="C.R+M" label="CMD with MD and Res" >count(($collection//CMD[.//ResourceType='Resource'][.//ResourceType='Metadata']))</item>,
<item key="C.R" label="CMD with Resource" >count($collection//CMD[.//ResourceType='Resource'])</item>,
<item key="C.R.0" label="CMD - with Resource empty">count($collection//CMD[.//ResourceType='Resource'][.//ResourceRef[. = ""]])</item>,
<item key="C.R.1" label="CMD with relative Resource (starts-with('.'))" >count($collection//CMD[.//ResourceType='Resource'][starts-with(.//normalize-space(ResourceRef),'.')])</item>,
<item key="C.R.2" label="CMD with http-uri Resource" >count($collection//CMD[.//ResourceType='Resource'][starts-with(.//normalize-space(ResourceRef),'http')])</item>,
<item key="C.R.1+2" label="CMD - with relative and http Resource">count($collection//CMD[.//ResourceType='Resource'][starts-with(.//ResourceRef,'.')][starts-with(.//normalize-space(ResourceRef),'http')])</item>,
<item key="C.R.3" label="CMD - Resource only filename (not empty, no '/')" >count($collection//CMD[.//ResourceProxy[ResourceType='Resource'][ResourceRef[not(. = "")][not(contains(.,'/'))]]])</item>,
<item key="RP.R" label="ResourceProxy - Resource" >count(//ResourceProxy[ResourceType='Resource'])</item>,

<item key="C.cc.self" label="CMD with IsPartOf=MdSelfLink" >count($collection//CMD[.//MdSelfLink=.//IsPartOf])</item>,
<item key="C.cc.link-match" label="CMD with MdSelfLink=ResourceRef" >count($collection//MdSelfLink[. = $collection//ResourceProxy[ResourceType eq 'Metadata']/ResourceRef])</item>,
<item key="C.cc.orphans" label="CMD with orphaned MdSelfLink" >count($collection//MdSelfLink[not(. = $collection//ResourceProxy[ResourceType eq 'Metadata']/ResourceRef)])</item>,
<item key="C.cc.deadlinks" label="CMD with dead Metadata-ResourceRef" >count($collection//ResourceRef[not(. =  $collection//MdSelfLink)][../ResourceType eq 'Metadata'])</item>,

<item key="C.M" label="CMD with Metadata = Collections" >count($collection//CMD[.//ResourceType='Metadata'])</item>,
<item key="C.M.1" label="CMD with relative MD" >count($collection//CMD[.//ResourceType='Metadata'][starts-with(.//normalize-space(ResourceRef),'.')])</item>,
<item key="C.M.2" label="CMD with http-uri MD" >count($collection//CMD[.//ResourceType='Metadata'][starts-with(.//normalize-space(ResourceRef),'http')])</item>
)
let $upd-dummy :=
        for $item in $items
            let $start-time := util:system-dateTime()
            let $answer := util:eval($item/text())
            let $duration := util:system-dateTime() - $start-time
           return update insert <item key="{$item/@key}" label="{$item/@label}" dur="{$duration}">{$answer}</item> into $doc/result

return $doc

(: <item key="C.R.3" label="CMD - Resource not empty, not relative, not http">5100</item>
  <item label="CMD - Resource not relative, not http" >count(//CMD[.//ResourceType='Resource'][not(starts-with(.//ResourceRef,'.'))][not(starts-with(.//ResourceRef,'http'))])</item>,

 ,
<item key="C.0" label="CMD without " >count(//CMD[not(.//ResourceType='Resource')][not(.//ResourceType='Metadata')])</item>,
<item key="C.R+M" label="CMD with MD and Res" >count((//CMD[.//ResourceType='Resource'][.//ResourceType='Metadata']))</item>,
<item key="C.R" label="CMD with Resource" >count(//CMD[.//ResourceType='Resource'])</item>,
<item key="C.R.0" label="CMD - with Resource empty">count(//CMD[.//ResourceType='Resource'][.//ResourceRef[. = ""]])</item>,
<item key="C.R.1" label="CMD with relative Resource (starts-with('.'))" >count(//CMD[.//ResourceType='Resource'][starts-with(.//ResourceRef,'.')])</item>,
<item key="C.R.2" label="CMD with http-uri Resource" >count(//CMD[.//ResourceType='Resource'][starts-with(.//ResourceRef,'http')])</item>,
<item key="C.R.1+2" label="CMD - with relative and http Resource">count(//CMD[.//ResourceType='Resource'][starts-with(.//ResourceRef,'.')][starts-with(.//ResourceRef,'http')])</item>,
<item key="C.R.3" label="CMD - Resource only filename (not empty, no '/')" >count(//CMD[.//ResourceProxy[ResourceType='Resource'][ResourceRef[not(. = "")][not(contains(.,'/'))]]])</item>,
<item key="RP.R" label="ResourceProxy - Resource" >count(//ResourceProxy[ResourceType='Resource'])</item>,

<item key="C.M" label="CMD with Metadata = Collections" >count(//CMD[.//ResourceType='Metadata'])</item>,
<item key="C.M.1" label="CMD with relative MD" >count(//CMD[.//ResourceType='Metadata'][starts-with(.//ResourceRef,'.')])</item>,
<item key="C.M.2" label="CMD with http-uri MD" >count(//CMD[.//ResourceType='Metadata'][starts-with(.//ResourceRef,'http')])</item>,

<item key="RP.M" label="ResourceProxy - Metadata" >count(//ResourceProxy[ResourceType='Metadata'])</item>,

<item key="C..3" label="CMD - only filename (not empty, no '/')" >count(//CMD[.//ResourceRef[not(. = "")][not(contains(.,'/'))]])</item>,
<item key="RR.3" label="ResourceRef only filename (not empty, no '/')" >count(//ResourceRef[not(. = "")][not(contains(.,'/'))])</item>,
<item key="C..RR.0" label="CMD - empty ResourceRef">count(//CMD[.//ResourceRef[. = ""]])</item>,
<item key="RR.0 label="ResourceRef empty">count(//ResourceRef[. = ""])</item>,
<item key="C..RR.0+1" label="CMD - empty and non-empty ResourceRef">count((//CMD[.//ResourceRef[. = ""]][.//ResourceRef[not(. = "")]]))</item>
 :)


Update queries.xqm

Update queries.xqm

Insert script elements to load the CodeMirror main library and the XQuery and XML modes.
Insert script element to load the CSS file.
Insert script element to do the replacement of the standard text areas if CodeMirror is available.

(:~
 : Queries page.
 :
 : @author Christian Grün, BaseX GmbH, 2014-15
 :)
module namespace _ = 'dba/queries';

import module namespace cons = 'dba/cons' at '../modules/cons.xqm';
import module namespace html = 'dba/html' at '../modules/html.xqm';
import module namespace tmpl = 'dba/tmpl' at '../modules/tmpl.xqm';
import module namespace util = 'dba/util' at '../modules/util.xqm';

(:~ Top category. :)
declare variable $_:CAT := 'queries';
(:~ Query file suffix. :)
declare variable $_:SUFFIX := '.txt';

(:~
 : Queries page.
 : @param  $error   error string
 : @param  $info    info string
 : @return HTML page
 :)
declare
  %rest:GET
  %rest:path("/dba/queries")
  %rest:query-param("error",  "{$error}")
  %rest:query-param("info",   "{$info}")
  %output:method("html")
function _:queries(
  $error   as xs:string?,
  $info    as xs:string?
) as element() {
  cons:check(),

  let $f := function($b) { "editor('Please wait…', 'Query was successful.', " || $b || ");" }
  return tmpl:wrap(map { 'top': $_:CAT, 'info': $info, 'error': $error },

              <select id='mode' onchange='{ $f(false()) }'>{
                ('Standard', 'Realtime', 'Updating') ! element option { . }
              }</select>
              <button id='run' onclick="{ $f(true()) }">Run</button>

Editor

        <textarea id='editor' name='editor' rows='20' spellcheck='false' onkeyup="{ $f(false()) }"/>

                <input id='file' name='file' list='files' autocomplete='off' placeholder='Name of query'
                       oninput='checkButtons()' onpropertychange='checkButtons()'/>
                <datalist id='files'>{
                  file:list($cons:QUERY-DIR) ! element option { replace(., $_:SUFFIX || '$', '') }
                }</datalist>
                <button type='submit' name='open' id='open' disabled='true'
                        onclick='openQuery()'>Open</button>
                <button type='save' name='save' id='save' disabled='true'
                        onclick='saveQuery()'>Save</button>
                <button type='delete' name='delete' id='delete' disabled='true'
                        onclick='deleteQuery()'>Delete</button>

        { html:focus('editor') }

Result

        <textarea id='output' rows='20' readonly='' spellcheck='false'/>

  )
};

(:~
 : Evaluates a query and returns the result.
 : @param  $query  query
 : @return result of query
 :)
declare
  %rest:path("/dba/eval-query")
  %rest:query-param("query", "{$query}")
  %output:method("text")
function _:eval-query(
  $query  as xs:string?
) as xs:string {
  cons:check(),
  util:query($query)
};

(:~
 : Returns the contents of a query file.
 : @param  $name  name of query file (without suffix)
 : @return query string
 :)
declare
  %rest:path("/dba/open-query")
  %rest:query-param("name", "{$name}")
  %output:method("text")
function _:open-query(
  $name  as xs:string
) as xs:string {
  cons:check(),
  file:read-text(_:to-path($name))
};

(:~
 : Delete a query file and returns the names of stored queries.
 : @param  $name  name of query file (without suffix)
 : @return names of stored queries
 :)
declare
  %rest:path("/dba/delete-query")
  %rest:query-param("name", "{$name}")
  %output:method("text")
function _:delete-query(
  $name  as xs:string
) as xs:string {
  cons:check(),
  file:delete(_:to-path($name)),
  string-join(file:list($cons:QUERY-DIR) ! replace(., $_:SUFFIX || '$', ''), '/')
};

(:~
 : Saves a query file and returns the list of stored queries.
 : @param  $name   name of query file (without suffix)
 : @param  $query  query string
 : @return names of stored queries
 :)
declare
  %rest:POST("{$query}")
  %rest:path("/dba/save-query")
  %rest:query-param("name", "{$name}")
  %output:method("text")
function _:save-query(
  $name   as xs:string,
  $query  as xs:string
) as xs:string {
  cons:check(),
  file:write-text(_:to-path($name), $query),
  string-join(file:list($cons:QUERY-DIR) ! replace(., $_:SUFFIX || '$', ''), '/')
};

(:~
 : Runs an updating query.
 : @param  $query  query
 :)
declare
  %updating
  %rest:path("/dba/update-query")
  %rest:query-param("query", "{$query}")
  %output:method("text")
function _:update-query(
  $query  as xs:string?
) {
  cons:check(),
  util:update-query($query)
};

(:~
 : Returns the options for evaluating a query.
 : @return options
 :)
declare %private function _:query-options() as xs:string {
  "map { 'timeout':" || $cons:TIMEOUT ||
       ",'memory':" || $cons:MEMORY ||
       ",'permission':'" || $cons:PERMISSION || "' }"
};

(:~
 : Returns a normalized file path for the specified file name.
 : @param  $name  file name
 : @return file path
 :)
declare %private function _:to-path(
  $name  as xs:string
) as xs:string {
  $cons:QUERY-DIR || translate($name, '\/:*?"<>|', '---------') || $_:SUFFIX
};


[ignore] minor tidy-up

[ignore] minor tidy-up

(:~
    KWIC module: formats query results to display keywords in context (KWIC). A configurable
    amount of text is displayed to the left and right of a matching keyword (or phrase).

    The module works with all indexes that support match highlighting (matches are tagged
    with an <exist:match> element or exist:matches attribute). This includes the old
    full text index, the new Lucene-based full text index, as well as the NGram index.

    The kwic:summarize() function represents the main entry point into the module.
    To have more control over the text extraction context, you can also call
    kwic:get-summary() instead. For example, the following snippet will only print the
    first match within a given set of context nodes ($ancestor):

    let $matches := kwic:get-matches($hit)

    for $ancestor in $matches/ancestor::para | $matches/ancestor::title | $matches/ancestor::td

    return

        kwic:get-summary($ancestor, ($ancestor//exist:match, $ancestor//*[@exist:matches])[1], $config)

    The configuration element used by some functions has the following structure:

    <config
        width="character width"
        table="yes|no"
        link="URL to which the match is linked"
        whitespace-text-nodes="collapse|drop|leave"
        debug-text-nodes="yes|no"/>
:)
xquery version "3.0";

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

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

declare namespace exist = "http://exist.sourceforge.net/NS/exist";

declare variable $kwic:MODE_BEFORE := "before";
declare variable $kwic:MODE_AFTER := "after";

declare %private variable $kwic:CHARS_SUMMARY := 120;
declare %private variable $kwic:CHARS_KWIC := 40;

(:~
	Like fn:substring, but takes a node argument. If the node is an element,
	a new element is created with the same node-name as the old one and the
	shortened text content.
:)
declare
    %private
function kwic:substring($node as text(), $start as xs:integer, $count as xs:integer) as node() {
	let $str := substring($node, $start, $count)
	return
		if ($node instance of element()) then
			element { node-name($node) } { $str }
		else
			text { $str }
};

declare
    %private
function kwic:display-text($text as text()?) as node()? {
    if ($text/parent::exist:match) then
    	{$text}
    else
        $text
};

declare
    %private
function kwic:callback($callback as (function(text(), xs:string) as text()?)?, $node as text(), $mode as xs:string) as text()? {
    if (exists($callback)) then
        $callback($node, $mode)
    else
        $node
};

(:~
	Generate the left-hand context of the match. Returns a sequence of nodes
	and strings, whose total string length is less than or equal to $max characters.

	Note: this function calls itself recursively until $nodes is empty or
	the returned sequence has the desired total string length.
:)
declare
    %private
function kwic:truncate-previous($root as node(), $node as node()?, $truncated as item()*,
	   $max as xs:integer, $chars as xs:integer, $callback as (function(text(), xs:string) as text()?)?) {
	if ($node) then
		let $next := $node/preceding::text()[1] intersect $root//text()
		return
			if (empty($next)) then
				$truncated
			else if ($chars + string-length($next) gt $max) then
			    let $text-node := kwic:callback($callback, $next, $kwic:MODE_BEFORE)
			    return
    			    if (exists($text-node)) then
        				let $remaining := $max - $chars
        				return (
        				    text { "..." },
        				    kwic:substring($text-node, string-length($text-node) - $remaining + 1, $remaining),
        				    $truncated
        			    )
        			else
        			    kwic:truncate-previous($root, $next, $truncated, $max, $chars, $callback)
			else
				kwic:truncate-previous($root, $next,
				    (kwic:callback($callback, $next, $kwic:MODE_BEFORE), $truncated),
					$max, $chars + string-length($next), $callback)
	else
		$truncated
};

(:~
	Generate the right-hand context of the match. Returns a sequence of nodes
	and strings, whose total string length is less than or equal to $max characters.

	Note: this function calls itself recursively until $nodes is empty or
	the returned sequence has the desired total string length.
:)
declare
    %private
function kwic:truncate-following($root as node(), $node as node()?, $truncated as item()*,
	$max as xs:integer, $chars as xs:integer, $callback as (function(text(), xs:string) as text()?)?) {
	if ($node) then
		let $next := $node/following::text()[1] intersect $root//text()
		return
			if (empty($next)) then
				$truncated
			else if ($chars + string-length($next) gt $max) then
			    let $text-node := kwic:callback($callback, $next, $kwic:MODE_AFTER)
			    return
    			    if (exists($text-node)) then
        				let $remaining := $max - $chars
        				return (
                            $truncated,
                            kwic:substring($text-node, 1, $remaining),
                            text { "..." }
        			    )
        			else
        			    kwic:truncate-following($root, $next, $truncated, $max, $chars, $callback)
			else
				kwic:truncate-following($root, $next,
				    ($truncated, kwic:callback($callback, $next, $kwic:MODE_AFTER)),
					$max, $chars + string-length($next), $callback)
	else
		$truncated
};

(:~
	Computes the total string length of the nodes in the argument sequence
:)
declare
    %private
function kwic:string-length($nodes as item()*) as xs:integer {
	if (exists($nodes)) then
		sum($nodes ! string-length(.))
	else
		0
};

declare
    %private
function kwic:collapse-whitespace-fn($callback as (function(text(), xs:string) as text()?)?) as (function(text(), xs:string) as text()) {
    function($text as text(), $mode as xs:string) as text()? {
        let $text :=
            if (matches($text, "\s+")) then
                text { " " }
            else
                $text
        return
            if (exists($callback)) then
                $callback($text, $mode)
            else
                $text
    }
};

declare
    %private
function kwic:drop-whitespace-fn($callback as (function(text(), xs:string) as text()?)?) as (function(text(), xs:string) as text()?) {
    function($text as text(), $mode as xs:string) as text()? {
        let $text :=
            if (matches($text, "\s+")) then
                ()
            else
                $text
        return
            if (exists($text) and exists($callback)) then
                $callback($text, $mode)
            else
                $text
    }
};

declare
    %private
function kwic:output-text($debug-text-nodes as xs:boolean, $text-nodes as text()*) as node()* {
    if($debug-text-nodes) then
        $text-nodes ! <text-node>{.}</text-node>
    else
        $text-nodes
};

declare function kwic:get-summary($root as node(), $node as element(),
	$config as element(config)?) as element() {
	kwic:get-summary($root, $node, $config, ())
};

(:~
	Print a summary of the match in $node. Output a predefined amount of text to
	the left and the right of the match.

	@param $root root element which should be used as context for the match. It defines the
	    boundaries for the text extraction. Text will be taken from this context.
	@param $node the exist:match element or the element with @exist:macthes attribute to process.
	@param $config configuration element which determines the behaviour of the function
	@param $callback (optional) reference to a callback function which will be called
	once for every text node before it is appended to the displayed text. The function
	should accept 2 parameters: 1) a single text node, 2) a string indicating the
	current direction in which text is appended, i.e. $kwic:MODE_BEFORE or $kwic:MODE_AFTER.
	The function may return the empty sequence if the current node should be ignore
	(e.g. if it belongs to a "footnote" which should not be displayed). Otherwise it should
	return a single string.
:)
declare function kwic:get-summary($root as node(), $node as element(),
	$config as element(config)?,
    $callback as (function(text(), xs:string) as text()?)?
) as element() {
	let $chars := xs:integer(($config/@width, $kwic:CHARS_KWIC)[1])
	let $table := $config/@table = ('yes', 'true')
	let $whitespace-text-nodes := string($config/@whitespace-text-nodes)
	let $debug-text-nodes := $config/@debug-text-nodes = ('yes', 'true')

	let $callback :=
	   if ($whitespace-text-nodes eq "collapse") then
	       kwic:collapse-whitespace-fn($callback)
	   else if ($whitespace-text-nodes eq "drop") then
	       kwic:drop-whitespace-fn($callback)
	   else
	       $callback

	let $prevTrunc := kwic:truncate-previous($root, $node, (), $chars, 0, $callback)
	let $remain :=
		if (not($table)) then
			$chars * 2 - kwic:string-length($prevTrunc)
		else
			$chars
	let $followingTrunc := kwic:truncate-following($root, $node, (), $remain, 0, $callback)
	return
		if (not($table)) then

				{kwic:output-text($debug-text-nodes, $prevTrunc)}
				{
					if ($config/@link) then
						{kwic:output-text($debug-text-nodes, $node/text())}
					else
						{kwic:output-text($debug-text-nodes, $node/text())}
				}
				{kwic:output-text($debug-text-nodes, $followingTrunc)}

		else

				{kwic:output-text($debug-text-nodes, $prevTrunc)}

				{
					if ($config/@link) then
						{kwic:output-text($debug-text-nodes, $node/text())}
					else
						kwic:output-text($debug-text-nodes, $node/text())
				}

				{kwic:output-text($debug-text-nodes, $followingTrunc)}

};

(:~
    Expand the element in $hit. Creates an in-memory copy of the element and marks
    all element matches with an exist:match tag and attribute matches with an
    exist:matches tag, which will be used by all other functions in
    this module. You need to call kwic:expand before kwic:get-summary.
    kwic:summarize will call it automatically.
:)
declare function kwic:expand($hit as element()) as element() {
    util:expand($hit, "expand-xincludes=no highlight-matches=both")
};

(:~
    Return all matches within the specified element, $hit. Matches are returned as
    exist:match elements or elements with exist:matches attribute. The returned nodes
    are part of a new document whose root element is a copy of the specified $hit element.

    @param $hit an arbitrary XML element which has been selected by one of the full text
		operations or an ngram search.
:)
declare function kwic:get-matches($hit as element()) as element()* {
    let $expanded := kwic:expand($hit)
	return ($expanded//exist:match, $expanded//*[@exist:matches])
};

declare function kwic:summarize($hit as element(), $config as element(config)?) as element()* {
    kwic:summarize($hit, $config, ())
};

(:~
	Main function of the KWIC module: takes the passed element and returns an
	XHTML fragment containing a chunk of text before and after the first full text
	match in the node.

	The optional config parameter is used to configure the behaviour of the function:

	<config width="character width" table="yes|no" link="URL to which the match is linked"/>

	By default, kwic:summarize returns an XHTML fragment with the following structure:

	<p xmlns="http://www.w3.org/1999/xhtml">
		<span class="previous">Text before match</span>
		<a href="passed URL if any" class="hi">The highlighted term</a>
		<span class="following">Text after match</span>
	</p>

	If table=yes is passed with the config element, a tr table row will be returned instead
	of a span (using the same class names).

	@param $hit an arbitrary XML element which has been selected by one of the full text
		operations or an ngram search.
	@param $config configuration element to configure the behaviour of the function
:)
declare function kwic:summarize($hit as element(), $config as element(config)?,
    $callback as (function(text(), xs:string) as text()?)?) as element()* {
    let $expanded := util:expand($hit, "expand-xincludes=no highlight-matches=both")
	for $match in ($expanded//exist:match, $expanded//*[@exist:matches])
	return
		kwic:get-summary($expanded, $match, $config, $callback)
};

(:
declare function kwic:summarize-all($hits as element()*, $config as element(config),
    $wrap as function(node(), function(node()) as element()) as element()) {
    let $hits := util:expand($hits, "expand-xincludes=no")
    for $hit in $hits
    return
        $wrap($hit, function($node) {
            for $match in $node//exist:match
            return
        		kwic:get-summary($node, $match, $config, ())
        })
};
:)

(:~
    KWIC module: formats query results to display keywords in context (KWIC). A configurable
    amount of text is displayed to the left and right of a matching keyword (or phrase).

    The module works with all indexes that support match highlighting (matches are tagged
    with an <exist:match> element or exist:matches attribute). This includes the old
    full text index, the new Lucene-based full text index, as well as the NGram index.

    The kwic:summarize() function represents the main entry point into the module.
    To have more control over the text extraction context, you can also call
    kwic:get-summary() instead. For example, the following snippet will only print the
    first match within a given set of context nodes ($ancestor):

    let $matches := kwic:get-matches($hit)

    for $ancestor in $matches/ancestor::para | $matches/ancestor::title | $matches/ancestor::td

    return

        kwic:get-summary($ancestor, ($ancestor//exist:match, $ancestor//*[@exist:matches])[1], $config)

    The configuration element used by some functions has the following structure:

    <config
        width="character width"
        table="yes|no"
        link="URL to which the match is linked"
        whitespace-text-nodes="collapse|drop|leave"
        debug-text-nodes="yes|no"/>
:)
xquery version "3.0";

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

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

declare namespace exist = "http://exist.sourceforge.net/NS/exist";

declare variable $kwic:MODE_BEFORE := "before";
declare variable $kwic:MODE_AFTER := "after";

declare %private variable $kwic:CHARS_SUMMARY := 120;
declare %private variable $kwic:CHARS_KWIC := 40;

(:~
	Like fn:substring, but takes a node argument. If the node is an element,
	a new element is created with the same node-name as the old one and the
	shortened text content.
:)
declare
    %private
function kwic:substring($node as item(), $start as xs:integer, $count as xs:integer) as node() {
	let $str := substring($node, $start, $count)
	return
		if ($node instance of element()) then
			element { node-name($node) } { $str }
		else
			text { $str }
};

declare
    %private
function kwic:display-text($text as text()?) as node()? {
    if ($text/parent::exist:match) then
    	{$text}
    else
        $text
};

declare
    %private
function kwic:callback($callback as (function(text(), xs:string) as text()?)?, $node as text(), $mode as xs:string) as text()? {
    if (exists($callback)) then
        $callback($node, $mode)
    else
        $node
};

(:~
	Generate the left-hand context of the match. Returns a sequence of nodes
	and strings, whose total string length is less than or equal to $max characters.

	Note: this function calls itself recursively until $nodes is empty or
	the returned sequence has the desired total string length.
:)
declare
    %private
function kwic:truncate-previous($root as node(), $node as node()?, $truncated as item()*,
	   $max as xs:integer, $chars as xs:integer, $callback as (function(text(), xs:string) as text()?)?) {
	if ($node) then
		let $next := $node/preceding::text()[1] intersect $root//text()
		return
			if (empty($next)) then
				$truncated
			else if ($chars + string-length($next) gt $max) then
			    let $str := kwic:callback($callback, $next, $kwic:MODE_BEFORE)
			    return
    			    if (exists($str)) then
        				let $remaining := $max - $chars
        				return (
        				    text { "..." },
        				    kwic:substring($str, string-length($str) - $remaining + 1, $remaining),
        				    $truncated
        			    )
        			else
        			    kwic:truncate-previous($root, $next, $truncated, $max, $chars, $callback)
			else
				kwic:truncate-previous($root, $next,
				    (kwic:callback($callback, $next, $kwic:MODE_BEFORE), $truncated),
					$max, $chars + string-length($next), $callback)
	else
		$truncated
};

(:~
	Generate the right-hand context of the match. Returns a sequence of nodes
	and strings, whose total string length is less than or equal to $max characters.

	Note: this function calls itself recursively until $nodes is empty or
	the returned sequence has the desired total string length.
:)
declare
    %private
function kwic:truncate-following($root as node(), $node as node()?, $truncated as item()*,
	$max as xs:integer, $chars as xs:integer, $callback as (function(text(), xs:string) as text()?)?) {
	if ($node) then
		let $next := $node/following::text()[1] intersect $root//text()
		return
			if (empty($next)) then
				$truncated
			else if ($chars + string-length($next) gt $max) then
			    let $str := kwic:callback($callback, $next, $kwic:MODE_AFTER)
			    return
    			    if (exists($str)) then
        				let $remaining := $max - $chars
        				return (
                            $truncated, kwic:substring($str, 1, $remaining), text { "..." }
        			    )
        			else
        			    kwic:truncate-following($root, $next, $truncated, $max, $chars, $callback)
			else
				kwic:truncate-following($root, $next,
				    ($truncated, kwic:callback($callback, $next, $kwic:MODE_AFTER)),
					$max, $chars + string-length($next), $callback)
	else
		$truncated
};

(:~
	Computes the total string length of the nodes in the argument sequence
:)
declare
    %private
function kwic:string-length($nodes as item()*) as xs:integer {
	if (exists($nodes)) then
		sum($nodes ! string-length(.))
	else
		0
};

declare
    %private
function kwic:collapse-whitespace-fn($callback as (function(text(), xs:string) as text()?)?) as (function(text(), xs:string) as text()) {
    function($text as text(), $mode as xs:string) as text()? {
        let $text :=
            if (matches($text, "\s+")) then
                text { " " }
            else
                $text
        return
            if (exists($callback)) then
                $callback($text, $mode)
            else
                $text
    }
};

declare
    %private
function kwic:drop-whitespace-fn($callback as (function(text(), xs:string) as text()?)?) as (function(text(), xs:string) as text()?) {
    function($text as text(), $mode as xs:string) as text()? {
        let $text :=
            if (matches($text, "\s+")) then
                ()
            else
                $text
        return
            if (exists($text) and exists($callback)) then
                $callback($text, $mode)
            else
                $text
    }
};

declare
    %private
function kwic:output-text($debug-text-nodes as xs:boolean, $text-nodes as text()*) as node()* {
    if($debug-text-nodes) then
        $text-nodes ! <text-node>{.}</text-node>
    else
        $text-nodes
};

declare function kwic:get-summary($root as node(), $node as element(),
	$config as element(config)?) as element() {
	kwic:get-summary($root, $node, $config, ())
};

(:~
	Print a summary of the match in $node. Output a predefined amount of text to
	the left and the right of the match.

	@param $root root element which should be used as context for the match. It defines the
	    boundaries for the text extraction. Text will be taken from this context.
	@param $node the exist:match element or the element with @exist:macthes attribute to process.
	@param $config configuration element which determines the behaviour of the function
	@param $callback (optional) reference to a callback function which will be called
	once for every text node before it is appended to the displayed text. The function
	should accept 2 parameters: 1) a single text node, 2) a string indicating the
	current direction in which text is appended, i.e. $kwic:MODE_BEFORE or $kwic:MODE_AFTER.
	The function may return the empty sequence if the current node should be ignore
	(e.g. if it belongs to a "footnote" which should not be displayed). Otherwise it should
	return a single string.
:)
declare function kwic:get-summary($root as node(), $node as element(),
	$config as element(config)?,
    $callback as (function(text(), xs:string) as text()?)?
) as element() {
	let $chars := xs:integer(($config/@width, $kwic:CHARS_KWIC)[1])
	let $table := $config/@table = ('yes', 'true')
	let $whitespace-text-nodes := string($config/@whitespace-text-nodes)
	let $debug-text-nodes := $config/@debug-text-nodes = ('yes', 'true')

	let $callback :=
	   if ($whitespace-text-nodes eq "collapse") then
	       kwic:collapse-whitespace-fn($callback)
	   else if ($whitespace-text-nodes eq "drop") then
	       kwic:drop-whitespace-fn($callback)
	   else
	       $callback

	let $prevTrunc := kwic:truncate-previous($root, $node, (), $chars, 0, $callback)
	let $remain :=
		if (not($table)) then
			$chars * 2 - kwic:string-length($prevTrunc)
		else
			$chars
	let $followingTrunc := kwic:truncate-following($root, $node, (), $remain, 0, $callback)
	return
		if (not($table)) then

				{kwic:output-text($debug-text-nodes, $prevTrunc)}
				{
					if ($config/@link) then
						{kwic:output-text($debug-text-nodes, $node/text())}
					else
						{kwic:output-text($debug-text-nodes, $node/text())}
				}
				{kwic:output-text($debug-text-nodes, $followingTrunc)}

		else

				{kwic:output-text($debug-text-nodes, $prevTrunc)}

				{
					if ($config/@link) then
						{kwic:output-text($debug-text-nodes, $node/text())}
					else
						kwic:output-text($debug-text-nodes, $node/text())
				}

				{kwic:output-text($debug-text-nodes, $followingTrunc)}

};

(:~
    Expand the element in $hit. Creates an in-memory copy of the element and marks
    all element matches with an exist:match tag and attribute matches with an
    exist:matches tag, which will be used by all other functions in
    this module. You need to call kwic:expand before kwic:get-summary.
    kwic:summarize will call it automatically.
:)
declare function kwic:expand($hit as element()) as element() {
    util:expand($hit, "expand-xincludes=no highlight-matches=both")
};

(:~
    Return all matches within the specified element, $hit. Matches are returned as
    exist:match elements or elements with exist:matches attribute. The returned nodes
    are part of a new document whose root element is a copy of the specified $hit element.

    @param $hit an arbitrary XML element which has been selected by one of the full text
		operations or an ngram search.
:)
declare function kwic:get-matches($hit as element()) as element()* {
    let $expanded := kwic:expand($hit)
	return ($expanded//exist:match, $expanded//*[@exist:matches])
};

declare function kwic:summarize($hit as element(), $config as element(config)?) as element()* {
    kwic:summarize($hit, $config, ())
};

(:~
	Main function of the KWIC module: takes the passed element and returns an
	XHTML fragment containing a chunk of text before and after the first full text
	match in the node.

	The optional config parameter is used to configure the behaviour of the function:

	<config width="character width" table="yes|no" link="URL to which the match is linked"/>

	By default, kwic:summarize returns an XHTML fragment with the following structure:

	<p xmlns="http://www.w3.org/1999/xhtml">
		<span class="previous">Text before match</span>
		<a href="passed URL if any" class="hi">The highlighted term</a>
		<span class="following">Text after match</span>
	</p>

	If table=yes is passed with the config element, a tr table row will be returned instead
	of a span (using the same class names).

	@param $hit an arbitrary XML element which has been selected by one of the full text
		operations or an ngram search.
	@param $config configuration element to configure the behaviour of the function
:)
declare function kwic:summarize($hit as element(), $config as element(config)?,
    $callback as (function(text(), xs:string) as text()?)?) as element()* {
    let $expanded := util:expand($hit, "expand-xincludes=no highlight-matches=both")
	for $match in ($expanded//exist:match, $expanded//*[@exist:matches])
	return
		kwic:get-summary($expanded, $match, $config, $callback)
};

(:
declare function kwic:summarize-all($hits as element()*, $config as element(config),
    $wrap as function(node(), function(node()) as element()) as element()) {
    let $hits := util:expand($hits, "expand-xincludes=no")
    for $hit in $hits
    return
        $wrap($hit, function($node) {
            for $match in $node//exist:match
            return
        		kwic:get-summary($node, $match, $config, ())
        })
};
:)


updated document to have xquery declaration first

xquery version "1.0-ml";
(:
  Copyright 2014-2015 MarkLogic Corporation

  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.
:)

module namespace my = "http://my.test.module";
declare function my:useless()
{
    let $x := (1,2,3,4,5)
    return subsequence($x, 2)
};

(:
  Copyright 2014-2015 MarkLogic Corporation

  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";

module namespace my = "http://my.test.module";
declare function my:useless()
{
    let $x := (1,2,3,4,5)
    return subsequence($x, 2)
};


[ignore] Redirect from /exist/ broken.

[ignore] Redirect from /exist/ broken.

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

(: 	This is the main controller for the web application. It is called from the
	XQueryURLRewrite filter configured in web.xml. :)
xquery version "3.0";

(:~ -------------------------------------------------------
    Main controller: handles all requests not matched by
    sub-controllers.
    ------------------------------------------------------- :)

declare namespace c="http://exist-db.org/xquery/controller";

import module namespace request="http://exist-db.org/xquery/request";
import module namespace xdb = "http://exist-db.org/xquery/xmldb";

declare function local:get-dashboard() {
	(: TODO: is there an easier way to determine the location of an app? :)
	let $meta := repo:get-resource("http://exist-db.org/apps/dashboard", "repo.xml")
	let $data := if (exists($meta)) then util:binary-to-string($meta) else ()
	return
    	if (exists($data)) then
            util:parse($data)//repo:target/string()
        else
            ()
};

let $query := request:get-parameter("q", ())
return
	(: redirect webapp root to index.xml :)
    if ($exist:path eq '') then
	   <dispatch xmlns="http://exist.sourceforge.net/NS/exist">
	     <redirect url="{concat(request:get-uri(), '/')}"/>
	   </dispatch>
    else if ($exist:path eq '/') then
    	let $dashboard := local:get-dashboard()
    	return
			<dispatch xmlns="http://exist.sourceforge.net/NS/exist">
			{
				if ($dashboard) then
					<redirect url="apps/{$dashboard}/"/>
				else
					<redirect url="404.html"/>
			}
			</dispatch>
	else
		<ignore xmlns="http://exist.sourceforge.net/NS/exist">
            <cache-control cache="yes"/>
		</ignore>

(: 	This is the main controller for the web application. It is called from the
	XQueryURLRewrite filter configured in web.xml. :)
xquery version "3.0";

(:~ -------------------------------------------------------
    Main controller: handles all requests not matched by
    sub-controllers.
    ------------------------------------------------------- :)

declare namespace c="http://exist-db.org/xquery/controller";

import module namespace request="http://exist-db.org/xquery/request";
import module namespace xdb = "http://exist-db.org/xquery/xmldb";

declare function local:get-dashboard() {
	(: TODO: is there an easier way to determine the location of an app? :)
	let $meta := repo:get-resource("http://exist-db.org/apps/dashboard", "repo.xml")
	let $data := if (exists($meta)) then util:binary-to-string($meta) else ()
	return
    	if (exists($data)) then
            util:parse($data)//repo:target/string()
        else
            ()
};

let $query := request:get-parameter("q", ())
return
	(: redirect webapp root to index.xml :)
    if ($exist:path eq '') then
	   <dispatch xmlns="http://exist.sourceforge.net/NS/exist">
	     <redirect url="{concat(request:get-uri(), '/')}"/>
	   </dispatch>
    else if ($exist:path eq '/') then
    	let $dashboard := local:get-dashboard()
    	return
			<dispatch xmlns="http://exist.sourceforge.net/NS/exist">
			{
				if ($dashboard) then
					<redirect url="apps/{substring-after($dashboard, '/db/')}/"/>
				else
					<redirect url="404.html"/>
			}
			</dispatch>
	else
		<ignore xmlns="http://exist.sourceforge.net/NS/exist">
            <cache-control cache="yes"/>
		</ignore>


wrap adapter interface

wrap adapter interface

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

(:Import other namespaces.  :)
import module namespace csd_webconf =  "https://github.com/openhie/openinfoman/csd_webconf";
import module namespace osf = "https://github.com/openhie/openinfoman/adapter/opensearch";
import module namespace csr_proc = "https://github.com/openhie/openinfoman/csr_proc";
import module namespace csd_dm = "https://github.com/openhie/openinfoman/csd_dm";
import module namespace fhir = "https://github.com/openhie/openinfoman/adapter/fhir";

declare namespace xs = "http://www.w3.org/2001/XMLSchema";
declare namespace csd = "urn:ihe:iti:csd:2013";
declare namespace   xforms = "http://www.w3.org/2002/xforms";
declare namespace os =  "http://a9.com/-/spec/opensearch/1.1/";

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

FHIR Documents

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

		  {string($doc_name)}

	      }

       return csd_webconf:wrapper($contents)

};

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

Read

	  {
	    for $read in $reads
	    let $entity := string($read/@type)
	    let $url := concat($csd_webconf:baseurl, "CSD/adapter/fhir/",$search_name, "/", $doc_name, "/", $entity)
	    return
Read {$entity}

	  }

      return csd_webconf:wrapper($contents)
};

declare
  %rest:path("/CSD/adapter/fhir/{$search_name}/{$doc_name}/{$entity}/{$id}")
  %output:media-type("text/xml")
  function page:read_entity_id_1($search_name,$doc_name,$entity,$id)
{
  page:read_entity_id_2($search_name,$doc_name,$entity,$id)
};

declare
  %rest:path("/CSD/adapter/fhir/{$search_name}/{$doc_name}/{$entity}")
  %rest:query-param("_id","{$id}")
  %output:media-type("text/xml")
  function page:read_entity_id_2($search_name,$doc_name,$entity,$id)
{
  let $function := csr_proc:get_function_definition($csd_webconf:db,$search_name)
  let $reads :=   $function/csd:extension[@urn='urn:openhie.org:openinfoman:adapter:fhir:read' ]
  return
    if (not(fhir:is_fhir_function($search_name)) or count($reads) = 0 )
    (:not a read practitioner query. should 404 or whatever is required by FHIR :)
  then ()
  else
    let $doc := csd_dm:open_document($csd_webconf:db,$doc_name)
    let $careServicesRequest :=
      <csd:careServicesRequest >
	<csd:function urn="{$search_name}" resource="{$doc_name}" base_url="{$csd_webconf:baseurl}">
	  <csd:requestParams >
	   {
	     if ($id)
	     then <id>{$id}</id>
	     else ()
	   }
	  </csd:requestParams>
	</csd:function>
      </csd:careServicesRequest>
    let $contents := csr_proc:process_CSR_stored_results($csd_webconf:db, $doc,$careServicesRequest)
    return $contents
};

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

(:Import other namespaces.  :)
import module namespace csd_webconf =  "https://github.com/openhie/openinfoman/csd_webconf";
import module namespace osf = "https://github.com/openhie/openinfoman/adapter/opensearch";
import module namespace csr_proc = "https://github.com/openhie/openinfoman/csr_proc";
import module namespace csd_dm = "https://github.com/openhie/openinfoman/csd_dm";
import module namespace fhir = "https://github.com/openhie/openinfoman/adapter/fhir";

declare namespace xs = "http://www.w3.org/2001/XMLSchema";
declare namespace csd = "urn:ihe:iti:csd:2013";
declare namespace   xforms = "http://www.w3.org/2002/xforms";
declare namespace os =  "http://a9.com/-/spec/opensearch/1.1/";

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

FHIR Documents

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

		  {string($doc_name)}

	      }

       return $contents

};

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

Read

	  {
	    for $read in $reads
	    let $entity := string($read/@type)
	    let $url := concat($csd_webconf:baseurl, "CSD/adapter/fhir/",$search_name, "/", $doc_name, "/", $entity)
	    return
Read {$entity}

	  }

      return $contents
};

declare
  %rest:path("/CSD/adapter/fhir/{$search_name}/{$doc_name}/{$entity}/{$id}")
  %output:media-type("text/xml")
  function page:read_entity_id_1($search_name,$doc_name,$entity,$id)
{
  page:read_entity_id_2($search_name,$doc_name,$entity,$id)
};

declare
  %rest:path("/CSD/adapter/fhir/{$search_name}/{$doc_name}/{$entity}")
  %rest:query-param("_id","{$id}")
  %output:media-type("text/xml")
  function page:read_entity_id_2($search_name,$doc_name,$entity,$id)
{
  let $function := csr_proc:get_function_definition($csd_webconf:db,$search_name)
  let $reads :=   $function/csd:extension[@urn='urn:openhie.org:openinfoman:adapter:fhir:read' ]
  return
    if (not(fhir:is_fhir_function($search_name)) or count($reads) = 0 )
    (:not a read practitioner query. should 404 or whatever is required by FHIR :)
  then ()
  else
    let $doc := csd_dm:open_document($csd_webconf:db,$doc_name)
    let $careServicesRequest :=
      <csd:careServicesRequest >
	<csd:function urn="{$search_name}" resource="{$doc_name}" base_url="{$csd_webconf:baseurl}">
	  <csd:requestParams >
	   {
	     if ($id)
	     then <id>{$id}</id>
	     else ()
	   }
	  </csd:requestParams>
	</csd:function>
      </csd:careServicesRequest>
    let $contents := csr_proc:process_CSR_stored_results($csd_webconf:db, $doc,$careServicesRequest)
    return $contents
};


[bugfix] wrong jar name

[bugfix] wrong jar name

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

xquery version "1.0";

import module namespace webstart = "http://exist-db.org/xquery/webstart" at "webstart.xqm";
import module namespace request  = "http://exist-db.org/xquery/request";

declare variable $jnlp {

    <jnlp spec="1.0+" href="gate.jnlp">
      <information>
        <title>eXist Gate client</title>
        <vendor>exist-db.org</vendor>
        <homepage href="http://exist-db.org/"/>
        <description>Java applet for automate document managment via REST.</description>
        <description kind="short">eXist Gate client</description>
        <description kind="tooltip">eXist Gate client</description>
        <icon href="jnlp_logo.jpg" kind="splash"/>
        <icon href="jnlp_logo.jpg"/>
        <icon href="jnlp_icon_64x64.gif" width="64" height="64"/>
        <icon href="jnlp_icon_32x32.gif" width="32" height="32"/>
      </information>
      <security>
        <all-permissions/>
      </security>
      <resources>
        <j2se version="1.6+"/>
        <jar href="exist-gate.jar" main="true"/>
        <jar href="commons-codec-%latest%.jar"/>
        <jar href="commons-httpclient-%latest%.jar"/>
        <jar href="commons-logging-%latest%.jar"/>
      </resources>
      <applet-desc documentBase="{request:get-attribute("codebase")}"
          name="Gate" main-class="org.exist.gate.GateApplet" width="1" height="1"/>
    </jnlp>

};

webstart:jnlp($jnlp)

xquery version "1.0";

import module namespace webstart = "http://exist-db.org/xquery/webstart" at "webstart.xqm";
import module namespace request  = "http://exist-db.org/xquery/request";

declare variable $jnlp {

    <jnlp spec="1.0+" href="gate.jnlp">
      <information>
        <title>eXist Gate client</title>
        <vendor>exist-db.org</vendor>
        <homepage href="http://exist-db.org/"/>
        <description>Java applet for automate document managment via REST.</description>
        <description kind="short">eXist Gate client</description>
        <description kind="tooltip">eXist Gate client</description>
        <icon href="jnlp_logo.jpg" kind="splash"/>
        <icon href="jnlp_logo.jpg"/>
        <icon href="jnlp_icon_64x64.gif" width="64" height="64"/>
        <icon href="jnlp_icon_32x32.gif" width="32" height="32"/>
      </information>
      <security>
        <all-permissions/>
      </security>
      <resources>
        <j2se version="1.6+"/>
        <jar href="gate.jar" main="true"/>
        <jar href="commons-codec-%latest%.jar"/>
        <jar href="commons-httpclient-%latest%.jar"/>
        <jar href="commons-logging-%latest%.jar"/>
      </resources>
      <applet-desc documentBase="{request:get-attribute("codebase")}"
          name="Gate" main-class="org.exist.gate.GateApplet" width="1" height="1"/>
    </jnlp>

};

webstart:jnlp($jnlp)