MarkLogic: Create a local:server-coordinate-system helper function.

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

import module namespace sem = "http://marklogic.com/semantics" at "/MarkLogic/semantics.xqy";

declare namespace o = "http://reecedunn.co.uk/xquery/options";
declare namespace eval = "xdmp:eval";

declare option o:implementation "marklogic/6.0";

(:~ Run a query on a MarkLogic server.
 :
 : @param $mode Whether to "run", "profile", or "debug" the query.
 : @param $mimetype The mimetype of the query.
 : @param $module-path The path of the module to invoke, or "" for evaluated scripts.
 : @param $query The query script to evaluate, or "" for invoked modules.
 : @param $vars A map of the variable values by the variable name.
 : @param $types A map of the variable types by the variable name.
 : @param $context-value The context item for XSLT queries as an XML object.
 : @param $context-path The context item for XSLT queries as a module file.
 : @param $rdf-output-format The mimetype to format sem:triple results as, or "" to leave them as is.
 : @param $updating An updating query if "true", or a non-updating query if "false".
 : @param $server The name of the server to use, or "" to not use a server.
 : @param $database The name of the database to use, or "" to not use a database.
 : @param $module-root The path to the server modules, or "" to use the default server value.
 :
 : This script has additional logic to map the semantics of the REST/XCC API to
 : the semantics of the API implemented in the xquery-intellij-plugin to support
 : the Run/Debug Configurations of the IntelliJ IDEs. Specifically:
 :
 : 1.  If there is an error, the REST API returns a "500 Internal Error" HTTP
 :     status. This catches the error and returns an element(err:error) object.
 :
 : 2.  The variables are passed via the REST API as xs:untypedAtomic. This
 :     converts the variables to the type they were specified as in the
 :     xquery-intellij-plugin API.
 :
 : 3.  The REST API only returns the primitive type of each item.
 :)

declare variable $mode as xs:string external := "run";
declare variable $mimetype as xs:string external := "application/xquery";
declare variable $module-path as xs:string external := "";
declare variable $query as xs:string external := "()";
declare variable $vars as xs:string external := "{}";
declare variable $types as xs:string external := "{}";
declare variable $context-value as xs:string external := "";
declare variable $context-path as xs:string external := "";
declare variable $rdf-output-format as xs:string external := "";
declare variable $updating as xs:string external := "false";
declare variable $server as xs:string external := "";
declare variable $database as xs:string external := "";
declare variable $module-root as xs:string external := "";

declare variable $content-type-header-prefix as xs:string external := "X-Content-Type-";
declare variable $derived-type-header-prefix as xs:string external := "X-Derived-";

declare function local:nullize($value) {
    if (string-length($value) eq 0) then () else $value
};

declare function local:version() {
    substring-before(xdmp:version(), "-") cast as xs:double
};

declare function local:version-minor() {
    substring-after(xdmp:version(), "-") cast as xs:double
};

declare function local:function($ref as xs:string) {
    try { xdmp:eval($ref) } catch * { () }
};

declare function local:server-coordinate-system($server as xs:unsignedLong?) {
    let $server-coordinate-system := local:function("xdmp:server-coordinate-system#1")
    return if (exists($server) and exists($server-coordinate-system)) then
        $server-coordinate-system($server)
    else
        ()
};

declare function local:item($path as xs:string, $value as xs:string, $type as xs:string) {
    if (string-length($value) ne 0) then
        xdmp:unquote($value)
    else if (string-length($path) ne 0) then
        doc($path)
    else
        ()
};

declare function local:cast-as($value, $type) {
    switch ($type)
    case "xs:anyURI" return $value cast as xs:anyURI
    case "xs:base64Binary" return $value cast as xs:base64Binary
    case "xs:boolean" return $value cast as xs:boolean
    case "xs:byte" return $value cast as xs:byte
    case "xs:date" return $value cast as xs:date
    case "xs:dateTime" return $value cast as xs:dateTime
    case "xs:dateTimeStamp" return $value cast as xs:dateTime (: MarkLogic does not support XML Schema 1.1 Part 2 :)
    case "xs:dayTimeDuration" return $value cast as xs:dayTimeDuration
    case "xs:decimal" return $value cast as xs:decimal
    case "xs:double" return $value cast as xs:double
    case "xs:duration" return $value cast as xs:duration
    case "xs:float" return $value cast as xs:float
    case "xs:gDay" return $value cast as xs:gDay
    case "xs:gMonth" return $value cast as xs:gMonth
    case "xs:gMonthDay" return $value cast as xs:gMonthDay
    case "xs:gYear" return $value cast as xs:gYear
    case "xs:gYearMonth" return $value cast as xs:gYearMonth
    case "xs:hexBinary" return $value cast as xs:hexBinary
    case "xs:int" return $value cast as xs:int
    case "xs:integer" return $value cast as xs:integer
    case "xs:language" return $value cast as xs:language
    case "xs:long" return $value cast as xs:long
    case "xs:negativeInteger" return $value cast as xs:negativeInteger
    case "xs:nonNegativeInteger" return $value cast as xs:nonNegativeInteger
    case "xs:nonPositiveInteger" return $value cast as xs:nonPositiveInteger
    case "xs:normalizedString" return $value cast as xs:normalizedString
    case "xs:numeric" return $value cast as xs:numeric
    case "xs:positiveInteger" return $value cast as xs:positiveInteger
    case "xs:short" return $value cast as xs:short
    case "xs:string" return $value cast as xs:string
    case "xs:time" return $value cast as xs:time
    case "xs:token" return $value cast as xs:token
    case "xs:unsignedByte" return $value cast as xs:unsignedByte
    case "xs:unsignedInt" return $value cast as xs:unsignedInt
    case "xs:unsignedLong" return $value cast as xs:unsignedLong
    case "xs:unsignedShort" return $value cast as xs:unsignedShort
    case "xs:yearMonthDuration" return $value cast as xs:yearMonthDuration
    case "xs:ENTITY" return $value cast as xs:ENTITY
    case "xs:ID" return $value cast as xs:ID
    case "xs:IDREF" return $value cast as xs:IDREF
    case "xs:Name" return $value cast as xs:Name
    case "xs:NCName" return $value cast as xs:NCName
    case "xs:NMTOKEN" return $value cast as xs:NMTOKEN
    case "xs:QName" return $value cast as xs:QName
    default return $value
};

declare function local:parse-vars($values as map:map, $types as map:map) as item()* {
    for $key in map:keys($values)
    let $value := local:cast-as(map:get($values, $key), map:get($types, $key))
    return (xs:QName($key), $value)
};

declare function local:parse-vars-map($values as map:map, $types as map:map) as map:map {
    let $ret := map:map()
    let $_ :=
        for $key in map:keys($values)
        let $value := local:cast-as(map:get($values, $key), map:get($types, $key))
        return map:put($ret, $key, $value)
    return $ret
};

declare function local:derived-type-name($value) {
    (: NOTE: Ordering is important here -- reverse type hierarchy :)
    typeswitch ($value)
    case function(*) return "function(*)"
    (: xs:integer derived types :)
    case xs:positiveInteger return "xs:positiveInteger"
    case xs:unsignedByte return "xs:unsignedByte"
    case xs:unsignedShort return "xs:unsignedShort"
    case xs:unsignedInt return "xs:unsignedInt"
    case xs:unsignedLong return "xs:unsignedLong"
    case xs:nonNegativeInteger return "xs:nonNegativeInteger"
    case xs:byte return "xs:byte"
    case xs:short return "xs:short"
    case xs:int return "xs:int"
    case xs:long return "xs:long"
    case xs:negativeInteger return "xs:negativeInteger"
    case xs:nonPositiveInteger return "xs:nonPositiveInteger"
    (: xs:string derived types :)
    case xs:ENTITY return "xs:ENTITY"
    case xs:IDREF return "xs:IDREF"
    case xs:ID return "xs:ID"
    case xs:NCName return "xs:NCName"
    case xs:Name return "xs:Name"
    case xs:NMTOKEN return "xs:NMTOKEN"
    case xs:language return "xs:language"
    case xs:token return "xs:token"
    case xs:normalizedString return "xs:normalizedString"
    default return () (: primitive type, so does not need the type name to be specified. :)
};

declare function local:rdf-format($mimetype) {
    switch ($mimetype)
    case "application/n-quads" return "nquad"
    case "application/n-triples" return "ntriple"
    case "application/rdf+json" return "rdfjson"
    case "application/rdf+xml" return "rdfxml"
    case "application/trig" return "trig"
    case "application/vnd.marklogic.triples+xml" return "triplexml"
    case "text/n3" return "n3"
    case "text/turtle" return "turtle"
    default return fn:error("UNSUPPORTED-RDF-FORMAT", "Unsupported RDF format: " || $mimetype)
};

declare function local:use-modules-root($server-root) {
    exists($server-root) and string-length($module-root) ne 0 and not($module-root eq $server-root)
};

declare function local:eval-static-check($static-check as xs:boolean) {
    <eval:static-check>{$static-check}</eval:static-check>
};

declare function local:eval-database($database as xs:unsignedLong?) {
    if (exists($database)) then
        <eval:database>{$database}</eval:database>
    else
        ()
};

declare function local:eval-default-collation($collation as xs:string?) {
    if (exists($collation)) then
        <eval:default-collation>{$collation}</eval:default-collation>
    else
        ()
};

declare function local:eval-default-coordinate-system($coordinate-system as xs:string?) {
    if (exists($coordinate-system)) then
        <eval:default-coordinate-system>{$coordinate-system}</eval:default-coordinate-system>
    else
        ()
};

declare function local:eval-options() {
    let $server := local:nullize($server) ! xdmp:server(.)
    let $database :=
        let $id := local:nullize($database) ! xdmp:database(.)
        return if (exists($id)) then
            $id
        else if (exists($server)) then
            xdmp:server-database($server)
        else
            ()
    return <eval:options>{
        local:eval-static-check($mode eq "validate"),
        local:eval-database($database),
        local:eval-default-collation($server ! xdmp:server-collation(.)),
        local:eval-default-coordinate-system($server ! local:server-coordinate-system(.)),
        if (exists($server) and $mimetype eq "application/xquery") then
            <eval:default-xquery-version>{xdmp:server-default-xquery-version($server)}</eval:default-xquery-version>
        else
            (),
        let $server-root := $server ! xdmp:server-root(.)
        return if (local:use-modules-root($server-root)) then
            (<eval:modules>0</eval:modules>, <eval:root>{$module-root}</eval:root>) (: file system :)
        else
            (), (: use the default server settings :)
        let $major := local:version()
        let $minor := local:version-minor()
        return if ($mode = "debug") then
            if ($updating = "true") then
                fn:error(xs:QName("err:FOER0000"), "Debugging an update query is not supported by MarkLogic.")
            else
                ()
        else if ($major lt 7.0 or ($major eq 8.0 and $minor lt 7.0) or ($major eq 9.0 and $minor lt 2.0)) then
            if ($updating = "true") then
                <eval:transaction-mode>update</eval:transaction-mode>
            else
                <eval:transaction-mode>query</eval:transaction-mode>
        else
            (: MarkLogic 8.0-7 and 9.0-2 support <update> :)
            <eval:update>{$updating}</eval:update>
    }</eval:options>
};

declare function local:javascript() as item()* {
    let $variables := local:parse-vars(xdmp:unquote($vars), xdmp:unquote($types))
    let $options := local:eval-options()
    return if (local:version() < 8.0) then
        fn:error(
            xs:QName("UNSUPPORTED-VERSION"),
            "MarkLogic " || xdmp:version() || " does not support server-side JavaScript"
        )
    else if (string-length($query) ne 0) then
        switch ($mode)
        case "run" return
            let $f := local:function("xdmp:javascript-eval#3")
            let $start := xdmp:elapsed-time()
            let $ret := $f($query, $variables, $options)
            return (xdmp:elapsed-time() - $start, $ret)
        default return ()
    else
        switch ($mode)
        case "run" return
            let $start := xdmp:elapsed-time()
            let $ret := xdmp:invoke($module-path, $variables, $options)
            return (xdmp:elapsed-time() - $start, $ret)
        default return ()
};

declare function local:sparql-query() as item()* {
    let $variables := local:parse-vars-map(xdmp:unquote($vars), xdmp:unquote($types))
    let $query :=
        if (string-length($query) ne 0) then
            $query
        else
            () (: TODO: Read the contents of the query file from the modules database. :)
    return switch ($mode)
    case "run" return
        let $start := xdmp:elapsed-time()
        let $ret := sem:sparql($query, $variables)
        return (xdmp:elapsed-time() - $start, $ret)
    default return ()
};

declare function local:sparql-update() as item()* {
    let $variables := local:parse-vars-map(xdmp:unquote($vars), xdmp:unquote($types))
    let $query :=
        if (string-length($query) ne 0) then
            $query
        else
            () (: TODO: Read the contents of the query file from the modules database. :)
    return if (local:version() < 8.0) then
        fn:error(
            xs:QName("UNSUPPORTED-VERSION"),
            "MarkLogic " || xdmp:version() || " does not support SPARQL update queries"
        )
    else switch ($mode)
    case "run" return
        let $start := xdmp:elapsed-time()
        let $ret := sem:sparql-update($query, $variables)
        return (xdmp:elapsed-time() - $start, $ret)
    default return ()
};

declare function local:sql() as item()* {
    let $variables := local:parse-vars(xdmp:unquote($vars), xdmp:unquote($types))
    let $query :=
        if (string-length($query) ne 0) then
            $query
        else
            () (: TODO: Read the contents of the query file from the modules database. :)
    return switch ($mode)
    case "run" return
        if (local:version() < 9.0) then
            let $f := local:function("xdmp:sql#1")
            let $start := xdmp:elapsed-time()
            let $ret := $f($query)
            return (xdmp:elapsed-time() - $start, $ret)
        else
            let $f := local:function("xdmp:sql#3")
            let $start := xdmp:elapsed-time()
            let $ret := $f($query, (), $variables)
            return (xdmp:elapsed-time() - $start, $ret)
    default return ()
};

declare function local:xquery() as item()* {
    let $variables := local:parse-vars(xdmp:unquote($vars), xdmp:unquote($types))
    let $options := local:eval-options()
    return if (string-length($query) ne 0) then
        switch ($mode)
        case "debug" return dbg:eval($query, $variables, $options)
        case "profile" return prof:eval($query, $variables, $options)
        case "run" return
            let $start := xdmp:elapsed-time()
            let $ret := xdmp:eval($query, $variables, $options)
            return (xdmp:elapsed-time() - $start, $ret)
        case "validate" return xdmp:eval($query, $variables, $options)
        default return ()
    else
        switch ($mode)
        case "debug" return dbg:invoke($module-path, $variables, $options)
        case "profile" return prof:invoke($module-path, $variables, $options)
        case "run" return
            let $start := xdmp:elapsed-time()
            let $ret := xdmp:invoke($module-path, $variables, $options)
            return (xdmp:elapsed-time() - $start, $ret)
        case "validate" return xdmp:invoke($module-path, $variables, $options)
        default return ()
};

declare function local:xslt() as item()* {
    let $variables := local:parse-vars(xdmp:unquote($vars), xdmp:unquote($types))
    let $input := local:item($context-path, $context-value, "application/xml")
    let $options := local:eval-options()
    return if (string-length($query) ne 0) then
        switch ($mode)
        case "profile" return prof:xslt-eval(xdmp:unquote($query), $input, $variables, $options)
        case "run" return
            let $query := xdmp:unquote($query)
            let $start := xdmp:elapsed-time()
            let $ret := xdmp:xslt-eval($query, $input, $variables, $options)
            return (xdmp:elapsed-time() - $start, $ret)
        case "validate" return xdmp:xslt-eval(xdmp:unquote($query), $input, $variables, $options)
        default return ()
    else
        switch ($mode)
        case "profile" return prof:xslt-invoke($module-path, $input, $variables, $options)
        case "run" return
            let $start := xdmp:elapsed-time()
            let $ret := xdmp:xslt-invoke($module-path, $input, $variables, $options)
            return (xdmp:elapsed-time() - $start, $ret)
        case "validate" return xdmp:xslt-invoke($module-path, $input, $variables, $options)
        default return ()
};

try {
    let $retvals :=
        switch ($mimetype)
        case "application/sparql-query" return local:sparql-query()
        case "application/sparql-update" return local:sparql-update()
        case "application/sql" return local:sql()
        case "application/vnd.marklogic-javascript" return local:javascript()
        case "application/xquery" return local:xquery()
        case "application/xslt+xml" return local:xslt()
        default return ()
    let $triples := for $item in $retvals where $item instance of sem:triple return $item
    let $retvals := for $item in $retvals where not($item instance of sem:triple) return $item
    return if (exists($triples) and $rdf-output-format ne "") then
        let $rdf-output := sem:rdf-serialize($triples, local:rdf-format($rdf-output-format))
        let $_ := xdmp:add-response-header($content-type-header-prefix || (count($retvals) + 1), $rdf-output-format)
        return (
            for $retval at $i in $retvals
            let $_ := local:derived-type-name($retval) ! xdmp:add-response-header($derived-type-header-prefix || $i, .)
            return $retval,
            $rdf-output
        )
    else
        for $retval at $i in ($retvals, $triples)
        let $_ := local:derived-type-name($retval) ! xdmp:add-response-header($derived-type-header-prefix || $i, .)
        return $retval
} catch * {
    let $_ := xdmp:add-response-header($derived-type-header-prefix || 1, "err:error")
    return $err:additional
}

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

import module namespace sem = "http://marklogic.com/semantics" at "/MarkLogic/semantics.xqy";

declare namespace o = "http://reecedunn.co.uk/xquery/options";
declare namespace eval = "xdmp:eval";

declare option o:implementation "marklogic/6.0";

(:~ Run a query on a MarkLogic server.
 :
 : @param $mode Whether to "run", "profile", or "debug" the query.
 : @param $mimetype The mimetype of the query.
 : @param $module-path The path of the module to invoke, or "" for evaluated scripts.
 : @param $query The query script to evaluate, or "" for invoked modules.
 : @param $vars A map of the variable values by the variable name.
 : @param $types A map of the variable types by the variable name.
 : @param $context-value The context item for XSLT queries as an XML object.
 : @param $context-path The context item for XSLT queries as a module file.
 : @param $rdf-output-format The mimetype to format sem:triple results as, or "" to leave them as is.
 : @param $updating An updating query if "true", or a non-updating query if "false".
 : @param $server The name of the server to use, or "" to not use a server.
 : @param $database The name of the database to use, or "" to not use a database.
 : @param $module-root The path to the server modules, or "" to use the default server value.
 :
 : This script has additional logic to map the semantics of the REST/XCC API to
 : the semantics of the API implemented in the xquery-intellij-plugin to support
 : the Run/Debug Configurations of the IntelliJ IDEs. Specifically:
 :
 : 1.  If there is an error, the REST API returns a "500 Internal Error" HTTP
 :     status. This catches the error and returns an element(err:error) object.
 :
 : 2.  The variables are passed via the REST API as xs:untypedAtomic. This
 :     converts the variables to the type they were specified as in the
 :     xquery-intellij-plugin API.
 :
 : 3.  The REST API only returns the primitive type of each item.
 :)

declare variable $mode as xs:string external := "run";
declare variable $mimetype as xs:string external := "application/xquery";
declare variable $module-path as xs:string external := "";
declare variable $query as xs:string external := "()";
declare variable $vars as xs:string external := "{}";
declare variable $types as xs:string external := "{}";
declare variable $context-value as xs:string external := "";
declare variable $context-path as xs:string external := "";
declare variable $rdf-output-format as xs:string external := "";
declare variable $updating as xs:string external := "false";
declare variable $server as xs:string external := "";
declare variable $database as xs:string external := "";
declare variable $module-root as xs:string external := "";

declare variable $content-type-header-prefix as xs:string external := "X-Content-Type-";
declare variable $derived-type-header-prefix as xs:string external := "X-Derived-";

declare function local:nullize($value) {
    if (string-length($value) eq 0) then () else $value
};

declare function local:version() {
    substring-before(xdmp:version(), "-") cast as xs:double
};

declare function local:version-minor() {
    substring-after(xdmp:version(), "-") cast as xs:double
};

declare function local:function($ref as xs:string) {
    try { xdmp:eval($ref) } catch * { () }
};

declare function local:item($path as xs:string, $value as xs:string, $type as xs:string) {
    if (string-length($value) ne 0) then
        xdmp:unquote($value)
    else if (string-length($path) ne 0) then
        doc($path)
    else
        ()
};

declare function local:cast-as($value, $type) {
    switch ($type)
    case "xs:anyURI" return $value cast as xs:anyURI
    case "xs:base64Binary" return $value cast as xs:base64Binary
    case "xs:boolean" return $value cast as xs:boolean
    case "xs:byte" return $value cast as xs:byte
    case "xs:date" return $value cast as xs:date
    case "xs:dateTime" return $value cast as xs:dateTime
    case "xs:dateTimeStamp" return $value cast as xs:dateTime (: MarkLogic does not support XML Schema 1.1 Part 2 :)
    case "xs:dayTimeDuration" return $value cast as xs:dayTimeDuration
    case "xs:decimal" return $value cast as xs:decimal
    case "xs:double" return $value cast as xs:double
    case "xs:duration" return $value cast as xs:duration
    case "xs:float" return $value cast as xs:float
    case "xs:gDay" return $value cast as xs:gDay
    case "xs:gMonth" return $value cast as xs:gMonth
    case "xs:gMonthDay" return $value cast as xs:gMonthDay
    case "xs:gYear" return $value cast as xs:gYear
    case "xs:gYearMonth" return $value cast as xs:gYearMonth
    case "xs:hexBinary" return $value cast as xs:hexBinary
    case "xs:int" return $value cast as xs:int
    case "xs:integer" return $value cast as xs:integer
    case "xs:language" return $value cast as xs:language
    case "xs:long" return $value cast as xs:long
    case "xs:negativeInteger" return $value cast as xs:negativeInteger
    case "xs:nonNegativeInteger" return $value cast as xs:nonNegativeInteger
    case "xs:nonPositiveInteger" return $value cast as xs:nonPositiveInteger
    case "xs:normalizedString" return $value cast as xs:normalizedString
    case "xs:numeric" return $value cast as xs:numeric
    case "xs:positiveInteger" return $value cast as xs:positiveInteger
    case "xs:short" return $value cast as xs:short
    case "xs:string" return $value cast as xs:string
    case "xs:time" return $value cast as xs:time
    case "xs:token" return $value cast as xs:token
    case "xs:unsignedByte" return $value cast as xs:unsignedByte
    case "xs:unsignedInt" return $value cast as xs:unsignedInt
    case "xs:unsignedLong" return $value cast as xs:unsignedLong
    case "xs:unsignedShort" return $value cast as xs:unsignedShort
    case "xs:yearMonthDuration" return $value cast as xs:yearMonthDuration
    case "xs:ENTITY" return $value cast as xs:ENTITY
    case "xs:ID" return $value cast as xs:ID
    case "xs:IDREF" return $value cast as xs:IDREF
    case "xs:Name" return $value cast as xs:Name
    case "xs:NCName" return $value cast as xs:NCName
    case "xs:NMTOKEN" return $value cast as xs:NMTOKEN
    case "xs:QName" return $value cast as xs:QName
    default return $value
};

declare function local:parse-vars($values as map:map, $types as map:map) as item()* {
    for $key in map:keys($values)
    let $value := local:cast-as(map:get($values, $key), map:get($types, $key))
    return (xs:QName($key), $value)
};

declare function local:parse-vars-map($values as map:map, $types as map:map) as map:map {
    let $ret := map:map()
    let $_ :=
        for $key in map:keys($values)
        let $value := local:cast-as(map:get($values, $key), map:get($types, $key))
        return map:put($ret, $key, $value)
    return $ret
};

declare function local:derived-type-name($value) {
    (: NOTE: Ordering is important here -- reverse type hierarchy :)
    typeswitch ($value)
    case function(*) return "function(*)"
    (: xs:integer derived types :)
    case xs:positiveInteger return "xs:positiveInteger"
    case xs:unsignedByte return "xs:unsignedByte"
    case xs:unsignedShort return "xs:unsignedShort"
    case xs:unsignedInt return "xs:unsignedInt"
    case xs:unsignedLong return "xs:unsignedLong"
    case xs:nonNegativeInteger return "xs:nonNegativeInteger"
    case xs:byte return "xs:byte"
    case xs:short return "xs:short"
    case xs:int return "xs:int"
    case xs:long return "xs:long"
    case xs:negativeInteger return "xs:negativeInteger"
    case xs:nonPositiveInteger return "xs:nonPositiveInteger"
    (: xs:string derived types :)
    case xs:ENTITY return "xs:ENTITY"
    case xs:IDREF return "xs:IDREF"
    case xs:ID return "xs:ID"
    case xs:NCName return "xs:NCName"
    case xs:Name return "xs:Name"
    case xs:NMTOKEN return "xs:NMTOKEN"
    case xs:language return "xs:language"
    case xs:token return "xs:token"
    case xs:normalizedString return "xs:normalizedString"
    default return () (: primitive type, so does not need the type name to be specified. :)
};

declare function local:rdf-format($mimetype) {
    switch ($mimetype)
    case "application/n-quads" return "nquad"
    case "application/n-triples" return "ntriple"
    case "application/rdf+json" return "rdfjson"
    case "application/rdf+xml" return "rdfxml"
    case "application/trig" return "trig"
    case "application/vnd.marklogic.triples+xml" return "triplexml"
    case "text/n3" return "n3"
    case "text/turtle" return "turtle"
    default return fn:error("UNSUPPORTED-RDF-FORMAT", "Unsupported RDF format: " || $mimetype)
};

declare function local:use-modules-root($server-root) {
    exists($server-root) and string-length($module-root) ne 0 and not($module-root eq $server-root)
};

declare function local:eval-static-check($static-check as xs:boolean) {
    <eval:static-check>{$static-check}</eval:static-check>
};

declare function local:eval-database($database as xs:unsignedLong?) {
    if (exists($database)) then
        <eval:database>{$database}</eval:database>
    else
        ()
};

declare function local:eval-default-collation($collation as xs:string?) {
    if (exists($collation)) then
        <eval:default-collation>{$collation}</eval:default-collation>
    else
        ()
};

declare function local:eval-default-coordinate-system($coordinate-system as xs:string?) {
    if (exists($coordinate-system)) then
        <eval:default-coordinate-system>{$coordinate-system}</eval:default-coordinate-system>
    else
        ()
};

declare function local:eval-options() {
    let $server := local:nullize($server) ! xdmp:server(.)
    let $database :=
        let $id := local:nullize($database) ! xdmp:database(.)
        return if (exists($id)) then
            $id
        else if (exists($server)) then
            xdmp:server-database($server)
        else
            ()
    return <eval:options>{
        local:eval-static-check($mode eq "validate"),
        local:eval-database($database),
        local:eval-default-collation($server ! xdmp:server-collation(.)),
        let $server-coordinate-system := local:function("xdmp:server-coordinate-system#1")
        return if (exists($server) and exists($server-coordinate-system)) then
            local:eval-default-coordinate-system($server-coordinate-system($server))
        else
            (),
        if (exists($server) and $mimetype eq "application/xquery") then
            <eval:default-xquery-version>{xdmp:server-default-xquery-version($server)}</eval:default-xquery-version>
        else
            (),
        let $server-root := $server ! xdmp:server-root(.)
        return if (local:use-modules-root($server-root)) then
            (<eval:modules>0</eval:modules>, <eval:root>{$module-root}</eval:root>) (: file system :)
        else
            (), (: use the default server settings :)
        let $major := local:version()
        let $minor := local:version-minor()
        return if ($mode = "debug") then
            if ($updating = "true") then
                fn:error(xs:QName("err:FOER0000"), "Debugging an update query is not supported by MarkLogic.")
            else
                ()
        else if ($major lt 7.0 or ($major eq 8.0 and $minor lt 7.0) or ($major eq 9.0 and $minor lt 2.0)) then
            if ($updating = "true") then
                <eval:transaction-mode>update</eval:transaction-mode>
            else
                <eval:transaction-mode>query</eval:transaction-mode>
        else
            (: MarkLogic 8.0-7 and 9.0-2 support <update> :)
            <eval:update>{$updating}</eval:update>
    }</eval:options>
};

declare function local:javascript() as item()* {
    let $variables := local:parse-vars(xdmp:unquote($vars), xdmp:unquote($types))
    let $options := local:eval-options()
    return if (local:version() < 8.0) then
        fn:error(
            xs:QName("UNSUPPORTED-VERSION"),
            "MarkLogic " || xdmp:version() || " does not support server-side JavaScript"
        )
    else if (string-length($query) ne 0) then
        switch ($mode)
        case "run" return
            let $f := local:function("xdmp:javascript-eval#3")
            let $start := xdmp:elapsed-time()
            let $ret := $f($query, $variables, $options)
            return (xdmp:elapsed-time() - $start, $ret)
        default return ()
    else
        switch ($mode)
        case "run" return
            let $start := xdmp:elapsed-time()
            let $ret := xdmp:invoke($module-path, $variables, $options)
            return (xdmp:elapsed-time() - $start, $ret)
        default return ()
};

declare function local:sparql-query() as item()* {
    let $variables := local:parse-vars-map(xdmp:unquote($vars), xdmp:unquote($types))
    let $query :=
        if (string-length($query) ne 0) then
            $query
        else
            () (: TODO: Read the contents of the query file from the modules database. :)
    return switch ($mode)
    case "run" return
        let $start := xdmp:elapsed-time()
        let $ret := sem:sparql($query, $variables)
        return (xdmp:elapsed-time() - $start, $ret)
    default return ()
};

declare function local:sparql-update() as item()* {
    let $variables := local:parse-vars-map(xdmp:unquote($vars), xdmp:unquote($types))
    let $query :=
        if (string-length($query) ne 0) then
            $query
        else
            () (: TODO: Read the contents of the query file from the modules database. :)
    return if (local:version() < 8.0) then
        fn:error(
            xs:QName("UNSUPPORTED-VERSION"),
            "MarkLogic " || xdmp:version() || " does not support SPARQL update queries"
        )
    else switch ($mode)
    case "run" return
        let $start := xdmp:elapsed-time()
        let $ret := sem:sparql-update($query, $variables)
        return (xdmp:elapsed-time() - $start, $ret)
    default return ()
};

declare function local:sql() as item()* {
    let $variables := local:parse-vars(xdmp:unquote($vars), xdmp:unquote($types))
    let $query :=
        if (string-length($query) ne 0) then
            $query
        else
            () (: TODO: Read the contents of the query file from the modules database. :)
    return switch ($mode)
    case "run" return
        if (local:version() < 9.0) then
            let $f := local:function("xdmp:sql#1")
            let $start := xdmp:elapsed-time()
            let $ret := $f($query)
            return (xdmp:elapsed-time() - $start, $ret)
        else
            let $f := local:function("xdmp:sql#3")
            let $start := xdmp:elapsed-time()
            let $ret := $f($query, (), $variables)
            return (xdmp:elapsed-time() - $start, $ret)
    default return ()
};

declare function local:xquery() as item()* {
    let $variables := local:parse-vars(xdmp:unquote($vars), xdmp:unquote($types))
    let $options := local:eval-options()
    return if (string-length($query) ne 0) then
        switch ($mode)
        case "debug" return dbg:eval($query, $variables, $options)
        case "profile" return prof:eval($query, $variables, $options)
        case "run" return
            let $start := xdmp:elapsed-time()
            let $ret := xdmp:eval($query, $variables, $options)
            return (xdmp:elapsed-time() - $start, $ret)
        case "validate" return xdmp:eval($query, $variables, $options)
        default return ()
    else
        switch ($mode)
        case "debug" return dbg:invoke($module-path, $variables, $options)
        case "profile" return prof:invoke($module-path, $variables, $options)
        case "run" return
            let $start := xdmp:elapsed-time()
            let $ret := xdmp:invoke($module-path, $variables, $options)
            return (xdmp:elapsed-time() - $start, $ret)
        case "validate" return xdmp:invoke($module-path, $variables, $options)
        default return ()
};

declare function local:xslt() as item()* {
    let $variables := local:parse-vars(xdmp:unquote($vars), xdmp:unquote($types))
    let $input := local:item($context-path, $context-value, "application/xml")
    let $options := local:eval-options()
    return if (string-length($query) ne 0) then
        switch ($mode)
        case "profile" return prof:xslt-eval(xdmp:unquote($query), $input, $variables, $options)
        case "run" return
            let $query := xdmp:unquote($query)
            let $start := xdmp:elapsed-time()
            let $ret := xdmp:xslt-eval($query, $input, $variables, $options)
            return (xdmp:elapsed-time() - $start, $ret)
        case "validate" return xdmp:xslt-eval(xdmp:unquote($query), $input, $variables, $options)
        default return ()
    else
        switch ($mode)
        case "profile" return prof:xslt-invoke($module-path, $input, $variables, $options)
        case "run" return
            let $start := xdmp:elapsed-time()
            let $ret := xdmp:xslt-invoke($module-path, $input, $variables, $options)
            return (xdmp:elapsed-time() - $start, $ret)
        case "validate" return xdmp:xslt-invoke($module-path, $input, $variables, $options)
        default return ()
};

try {
    let $retvals :=
        switch ($mimetype)
        case "application/sparql-query" return local:sparql-query()
        case "application/sparql-update" return local:sparql-update()
        case "application/sql" return local:sql()
        case "application/vnd.marklogic-javascript" return local:javascript()
        case "application/xquery" return local:xquery()
        case "application/xslt+xml" return local:xslt()
        default return ()
    let $triples := for $item in $retvals where $item instance of sem:triple return $item
    let $retvals := for $item in $retvals where not($item instance of sem:triple) return $item
    return if (exists($triples) and $rdf-output-format ne "") then
        let $rdf-output := sem:rdf-serialize($triples, local:rdf-format($rdf-output-format))
        let $_ := xdmp:add-response-header($content-type-header-prefix || (count($retvals) + 1), $rdf-output-format)
        return (
            for $retval at $i in $retvals
            let $_ := local:derived-type-name($retval) ! xdmp:add-response-header($derived-type-header-prefix || $i, .)
            return $retval,
            $rdf-output
        )
    else
        for $retval at $i in ($retvals, $triples)
        let $_ := local:derived-type-name($retval) ! xdmp:add-response-header($derived-type-header-prefix || $i, .)
        return $retval
} catch * {
    let $_ := xdmp:add-response-header($derived-type-header-prefix || 1, "err:error")
    return $err:additional
}


[MIN] DBA: trace removed

[MIN] DBA: trace removed

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

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

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

(:~
 : Redirects to the URL that creates a log entry table for the specified timestamp.
 : @param  $name  name (date) of log file
 : @param  $time  timestamp to be found
 : @return redirection
 :)
declare
  %rest:GET
  %rest:path("/dba/logs/jump")
  %rest:query-param("name", "{$name}")
  %rest:query-param("time", "{$time}")
function dba:jump-page(
  $name  as xs:string,
  $time  as xs:string
) as element(rest:response) {
  let $page := head((
    let $max := options:get($options:MAXROWS)
    for $log at $pos in reverse(admin:logs($name, true()))
    where $log/@time = $time
    return ($pos - 1) idiv $max + 1,
    1
  ))
  return web:redirect('/dba/logs', map { 'name': $name, 'page': $page, 'time': $time })
};

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

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

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

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

        </form>

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

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

          </form>,

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

  )
};

(:~
 : Returns a log entry table.
 : @param  $input  search input
 : @param  $name   name of selected log files
 : @param  $sort   table sort key
 : @param  $page   current page
 : @param  $time   timestamp to highlight
 : @return html elements
 :)
declare
  %rest:POST("{$input}")
  %rest:path("/dba/log")
  %rest:query-param("name", "{$name}")
  %rest:query-param("sort", "{$sort}", "")
  %rest:query-param("page", "{$page}", "1")
  %rest:query-param("time", "{$time}")
  %output:method("html")
  %output:indent("no")
  %rest:single
function dba:log(
  $input  as xs:string?,
  $name   as xs:string,
  $sort   as xs:string,
  $page   as xs:string,
  $time   as xs:string?
) as element()+ {
  let $sort := if($sort = 'time') then '' else $sort
  let $headers := (
    map { 'key': 'time', 'label': 'Time', 'type': 'xml', 'order': 'desc' },
    map { 'key': 'address', 'label': 'Address' },
    map { 'key': 'user', 'label': 'User', 'type': 'xml' },
    map { 'key': 'type', 'label': 'Type' },
    map { 'key': 'ms', 'label': 'ms', 'type': 'decimal', 'order': 'desc' },
    map { 'key': 'message', 'label': 'Message', 'type': 'xml' }
  )
  let $entries :=
    let $input-exists := boolean($input)
    let $highlight := function($string, $found) {
      if($found) then (
        for $match in analyze-string($string, $input, 'i')/*
        let $text := string($match)
        return if(local-name($match) = 'match') then element b { $text } else $text
      ) else (
        $string
      )
    }
    for $log in reverse(admin:logs($name, true()))
    let $user := data($log/@user)
    let $message := data($log/text())
    let $user-found := $input-exists and contains($user, $input)
    let $message-found := $input-exists and matches($message, $input, 'i')
    where not($input-exists) or $user-found or $message-found
    return map {
      'time': function() {
        let $value := string($log/@time)
        return if($input or $sort) then (
          html:link($value, $dba:CAT || '/jump', map { 'name': $name, 'time': $value })
        ) else if($value = $time) then (
          { $value }
        ) else (
          $value
        )
      },
      'address': $log/@address,
      'user': function() { $highlight($user, $user-found) },
      'type': $log/@type,
      'ms': $log/@ms,
      'message': function() { $highlight($message, $message-found) }
    }
  let $params := map { 'name': $name, 'input': $input }
  let $options := map {
    'sort': $sort,
    'page': if($page) then xs:integer($page) else ()
  }
  return html:table($headers, $entries, (), $params, $options)
};

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

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

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

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

(:~
 : Redirects to the URL that creates a log entry table for the specified timestamp.
 : @param  $name  name (date) of log file
 : @param  $time  timestamp to be found
 : @return redirection
 :)
declare
  %rest:GET
  %rest:path("/dba/logs/jump")
  %rest:query-param("name", "{$name}")
  %rest:query-param("time", "{$time}")
function dba:jump-page(
  $name  as xs:string,
  $time  as xs:string
) as element(rest:response) {
  let $page := head((
    let $max := options:get($options:MAXROWS)
    for $log at $pos in reverse(admin:logs($name, true()))
    where $log/@time = $time
    return trace(($pos - 1) idiv $max + 1),
    1
  ))
  return web:redirect('/dba/logs', map { 'name': $name, 'page': $page, 'time': $time })
};

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

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

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

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

        </form>

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

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

          </form>,

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

  )
};

(:~
 : Returns a log entry table.
 : @param  $input  search input
 : @param  $name   name of selected log files
 : @param  $sort   table sort key
 : @param  $page   current page
 : @param  $time   timestamp to highlight
 : @return html elements
 :)
declare
  %rest:POST("{$input}")
  %rest:path("/dba/log")
  %rest:query-param("name", "{$name}")
  %rest:query-param("sort", "{$sort}", "")
  %rest:query-param("page", "{$page}", "1")
  %rest:query-param("time", "{$time}")
  %output:method("html")
  %output:indent("no")
  %rest:single
function dba:log(
  $input  as xs:string?,
  $name   as xs:string,
  $sort   as xs:string,
  $page   as xs:string,
  $time   as xs:string?
) as element()+ {
  let $sort := if($sort = 'time') then '' else $sort
  let $headers := (
    map { 'key': 'time', 'label': 'Time', 'type': 'xml', 'order': 'desc' },
    map { 'key': 'address', 'label': 'Address' },
    map { 'key': 'user', 'label': 'User', 'type': 'xml' },
    map { 'key': 'type', 'label': 'Type' },
    map { 'key': 'ms', 'label': 'ms', 'type': 'decimal', 'order': 'desc' },
    map { 'key': 'message', 'label': 'Message', 'type': 'xml' }
  )
  let $entries :=
    let $input-exists := boolean($input)
    let $highlight := function($string, $found) {
      if($found) then (
        for $match in analyze-string($string, $input, 'i')/*
        let $text := string($match)
        return if(local-name($match) = 'match') then element b { $text } else $text
      ) else (
        $string
      )
    }
    for $log in reverse(admin:logs($name, true()))
    let $user := data($log/@user)
    let $message := data($log/text())
    let $user-found := $input-exists and contains($user, $input)
    let $message-found := $input-exists and matches($message, $input, 'i')
    where not($input-exists) or $user-found or $message-found
    return map {
      'time': function() {
        let $value := string($log/@time)
        return if($input or $sort) then (
          html:link($value, $dba:CAT || '/jump', map { 'name': $name, 'time': $value })
        ) else if($value = $time) then (
          { $value }
        ) else (
          $value
        )
      },
      'address': $log/@address,
      'user': function() { $highlight($user, $user-found) },
      'type': $log/@type,
      'ms': $log/@ms,
      'message': function() { $highlight($message, $message-found) }
    }
  let $params := map { 'name': $name, 'input': $input }
  let $options := map {
    'sort': $sort,
    'page': if($page) then xs:integer($page) else ()
  }
  return html:table($headers, $entries, (), $params, $options)
};

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


Initial multi-value roles?

Initial multi-value roles?

xquery version "3.1" encoding "UTF-8";

declare namespace output = "http://www.w3.org/2010/xslt-xquery-serialization";
declare namespace map = "http://www.w3.org/2005/xpath-functions/map";
declare namespace array = "http://www.w3.org/2005/xpath-functions/array";
declare namespace mapping = "http://docs.rackspace.com/identity/api/ext/MappingRules";
declare namespace xs = "http://www.w3.org/2001/XMLSchema";

declare option output:method "json";
declare option output:indent "yes";

declare function mapping:convertAttributeList($in as xs:string) as array(xs:string) {
  let $inStrings := for $s in tokenize($in, ' ') return replace($s,' ',' ')
  return array {$inStrings}
};

declare function mapping:convertAttributeMap($elem as element(), $multiValueAttribs as xs:string*) as map(*) {
  let $attribs := $elem/@*[namespace-uri(.) != 'http://www.w3.org/2001/XMLSchema-instance']
  return map:merge(for $attrib in $attribs return map:entry(local-name($attrib),
    if (local-name($attrib) = $multiValueAttribs) then mapping:convertAttributeList(string($attrib))
    else string($attrib)))
};

declare function mapping:convertLocalGroup($local as element()) as map(*) {
  let $elems := $local/element()
  return map:merge(for $elem in $elems return map:entry(local-name($elem),
  let $multiAttribs := (
    if ((local-name($elem) = 'roles') and (local-name($elem/..) = 'user') and count(tokenize($elem/@value,' ')) > 1) then "value" else (),
      if (exists($elem/@multiValue) and xs:boolean($elem/@multiValue) and count(tokenize($elem/@value,' ')) > 1) then "value" else ())
        return if ($elem/@*[name(.) = ('type','multivalue')]) then mapping:convertAttributeMap($elem, $multiAttribs) else
          if ($multiAttribs) then mapping:convertAttributeList (string($elem/@value)) else string($elem/@value)))
};

declare function mapping:convertLocalGroups($local as element()) as map(*) {
  let $elems := $local/element()
  return map:merge(for $elem in $elems return map:entry(local-name($elem),mapping:convertLocalGroup($elem)))
};

declare function mapping:convertRemote($remote as element()) as array(*) {
  let $elems := $remote/element()
  return array {for $elem in $elems return mapping:convertAttributeMap($elem,('blacklist','whitelist','notAnyOf','anyOneOf'))}
};

let $rules := for $rule in /mapping:rules/mapping:rule return map:merge((
  map:entry("local",mapping:convertLocalGroups($rule/mapping:local)),
  if (exists($rule/mapping:remote)) then map:entry("remote",mapping:convertRemote($rule/mapping:remote)) else ()))
return map {"rules" : array{$rules}}

xquery version "3.1" encoding "UTF-8";

declare namespace output = "http://www.w3.org/2010/xslt-xquery-serialization";
declare namespace map = "http://www.w3.org/2005/xpath-functions/map";
declare namespace array = "http://www.w3.org/2005/xpath-functions/array";
declare namespace mapping = "http://docs.rackspace.com/identity/api/ext/MappingRules";
declare namespace xs = "http://www.w3.org/2001/XMLSchema";

declare option output:method "json";
declare option output:indent "yes";

declare function mapping:convertAttributeList($in as xs:string) as array(xs:string) {
  let $inStrings := for $s in tokenize($in, ' ') return replace($s,' ',' ')
  return array {$inStrings}
};

declare function mapping:convertAttributeMap($elem as element(), $multiValueAttribs as xs:string*) as map(*) {
  let $attribs := $elem/@*[namespace-uri(.) != 'http://www.w3.org/2001/XMLSchema-instance']
  return map:merge(for $attrib in $attribs return map:entry(local-name($attrib),
    if (local-name($attrib) = $multiValueAttribs) then mapping:convertAttributeList(string($attrib))
    else string($attrib)))
};

declare function mapping:convertLocalGroup($local as element()) as map(*) {
  let $elems := $local/element()
  return map:merge(for $elem in $elems return map:entry(local-name($elem),
    if ($elem/@*[name(.) = ('type','multivalue')]) then mapping:convertAttributeMap($elem, ()) else string($elem/@value)))
};

declare function mapping:convertLocalGroups($local as element()) as map(*) {
  let $elems := $local/element()
  return map:merge(for $elem in $elems return map:entry(local-name($elem),mapping:convertLocalGroup($elem)))
};

declare function mapping:convertRemote($remote as element()) as array(*) {
  let $elems := $remote/element()
  return array {for $elem in $elems return mapping:convertAttributeMap($elem,('blacklist','whitelist','notAnyOf','anyOneOf'))}
};

let $rules := for $rule in /mapping:rules/mapping:rule return map:merge((
  map:entry("local",mapping:convertLocalGroups($rule/mapping:local)),
  if (exists($rule/mapping:remote)) then map:entry("remote",mapping:convertRemote($rule/mapping:remote)) else ()))
return map {"rules" : array{$rules}}


[apps biblio] this change is for the bug that JENS reported that when the last item of a repeating group of mods subelements is deleted, the item stays on the hard disk.

The change was to remove ALL of the sub-items on the hard-drive and then reinsert all the items in the sub-form, one after another.  The complex part was that after all items were deleted the save script had to know where to insert the new item.  To solve this I used the "insert" with a "preceding" option and so the first sub-element insert has to know what elements to insert berfore it does an insert.

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

xquery version "1.0";

(: XQuery script to save a new MODS record from an incomming HTTP POST :)

import module namespace style = "http://exist-db.org/mods-style" at "../../../modules/style.xqm";

declare namespace xf="http://www.w3.org/2002/xforms";
declare namespace xforms="http://www.w3.org/2002/xforms";
declare namespace ev="http://www.w3.org/2001/xml-events";
declare namespace mods="http://www.loc.gov/mods/v3";

let $title := 'MODS Record Save'

(: this service takes an incomming POST and saves the appropriate records :)
(: note that in this version, the incomming @ID is required :)
(: the user must have write and update access to the data collection :)

let $app-collection := $style:db-path-to-app
let $data-collection := $style:db-path-to-app-data

(: this is where the form "POSTS" documents to this XQuery using the POST method of a submission :)
let $item := request:get-data()

(: check to see if we have an indentifier in the incomming post :)
let $incomming-id := $item/@ID

(: if we do not have an ID then throw an error :)
return
if ( string-length($incomming-id) = 0 )
   then
        <error>
          <message class="warning">ERROR! Attempted to save a record with no ID specified.</message>
        </error>
   else

(: else we are doing an update to an existing file :)

let $file-to-update := concat($incomming-id, '.xml')
let $file-path := concat($data-collection, '/', $file-to-update)

(: uncomment the following line in for testing if you have not run the security setup tools :)
let $login := xmldb:login($style:db-path-to-app-data, 'admin', 'admin123')

(: this is the document on disk to be updated :)
let $doc := doc($file-path)/mods:mods

(: If the incoming has any part then we update it in the document

Note that is has the side effect of adding the mods prefix in the data files.  Semantically this
means the same thing but I don't know of a way to tell eXist to always use a default namespace
when doing an update.  :)

(: TODO figure out some way to pass the element name to an XQuery function and then do an eval on the update :)

(: this checks to see if we have a titleInfo in the save.  If we do then it goes through each one and
   it that is in the data it does a replace, else it does an insert. :)

let $titleInfo :=
   (: test to see if the incomming item has a title :)
   if ($item/mods:titleInfo)
     then
        (
            (: first delete all current on-disk titles :)
            update delete $doc/mods:titleInfo,

            (: now we insert all the net titles :)
            for $new-title-info at $count in $item/mods:titleInfo
               return
                  (: if we have an existing title then we just append after the previous, else we place it before the next item :)
                  if ($doc/mods:titleInfo)
                  then
                     update insert $new-title-info following $doc/mods:titleInfo[$count - 1]
                  else
                     update insert $new-title-info preceding $doc/mods:name
         )
   else ()

let $name :=
   if ($item/mods:name)
      then
        (
        update delete $doc/mods:name,
        for $new-name-info at $count in $item/mods:name
           return
              if ($doc/mods:name)
              then
                 update insert $new-name-info following $doc/mods:name[$count - 1]
              else
                 update insert $new-name-info preceding $doc/mods:originInfo
         )
      else ()

let $originInfo :=
   if ($item/mods:originInfo)
      then
        (
        update delete $doc/mods:originInfo,
        for $new-item at $count in $item/mods:originInfo
           return
              if ($doc/mods:originInfo)
              then
                 update insert $new-item following $doc/mods:originInfo[$count - 1]
              else
                 update insert $new-item preceding $doc/mods:physicalDescription
         )
      else ()

let $physicalDescription :=
   if ($item/mods:physicalDescription)
      then
        (
        update delete $doc/mods:physicalDescription,
        for $new-item at $count in $item/mods:physicalDescription
           return
              if ($doc/mods:physicalDescription)
              then
                 update insert $new-item following $doc/mods:physicalDescription[$count - 1]
              else
                 update insert $new-item preceding $doc/mods:targetAudience
         )
      else ()

let $targetAudience :=
   if ($item/mods:targetAudience)
      then
        (
        update delete $doc/mods:targetAudience,
        for $new-item at $count in $item/mods:targetAudience
           return
              if ($doc/mods:targetAudience)
              then
                 update insert $new-item following $doc/mods:targetAudience[$count - 1]
              else
                 update insert $new-item preceding $doc/mods:language
         )
      else ()

let $language :=
   if ($item/mods:language)
      then
        (
        update delete $doc/mods:language,
        for $new-item at $count in $item/mods:language
           return
              if ($doc/mods:language)
              then
                 update insert $new-item following $doc/mods:language[$count - 1]
              else
                 update insert $new-item preceding $doc/mods:typeOfResource
         )
      else ()

let $typeOfResource :=
   if ($item/mods:typeOfResource)
      then
        (
        update delete $doc/mods:typeOfResource,
        for $new-item at $count in $item/mods:typeOfResource
           return
              if ($doc/mods:typeOfResource)
              then
                 update insert $new-item following $doc/mods:typeOfResource[$count - 1]
              else
                 update insert $new-item preceding $doc/mods:genre
         )
      else ()

let $genre :=
   if ($item/mods:genre)
      then
        (
        update delete $doc/mods:genre,
        for $new-item at $count in $item/mods:genre
           return
              if ($doc/mods:genre)
              then
                 update insert $new-item following $doc/mods:genre[$count - 1]
              else
                 update insert $new-item preceding $doc/mods:subject
         )
      else ()

let $subject :=
   if ($item/mods:subject)
      then
        (
        update delete $doc/mods:subject,
        for $new-item at $count in $item/mods:subject
           return
              if ($doc/mods:subject)
              then
                 update insert $new-item following $doc/mods:subject[$count - 1]
              else
                 update insert $new-item preceding $doc/mods:classification
         )
      else ()

let $classification :=
   if ($item/mods:classification)
      then
        (
        update delete $doc/mods:classification,
        for $new-item at $count in $item/mods:classification
           return
              if ($doc/mods:classification)
              then
                 update insert $new-item following $doc/mods:classification[$count - 1]
              else
                 update insert $new-item preceding $doc/mods:abstract
         )
      else ()

let $abstract :=
   if ($item/mods:abstract)
      then
        (
        update delete $doc/mods:abstract,
        for $new-item at $count in $item/mods:abstract
           return
              if ($doc/mods:abstract)
              then
                 update insert $new-item following $doc/mods:abstract[$count - 1]
              else
                 update insert $new-item preceding $doc/mods:table-of-contents
         )
      else ()

let $table-of-contents :=
   if ($item/mods:table-of-contents)
      then
        (
        update delete $doc/mods:table-of-contents,
        for $new-item at $count in $item/mods:table-of-contents
           return
              if ($doc/mods:table-of-contents)
              then
                 update insert $new-item following $doc/mods:table-of-contents[$count - 1]
              else
                 update insert $new-item preceding $doc/mods:note
         )
      else ()

let $note :=
   if ($item/mods:note)
      then
        (
        update delete $doc/mods:note,
        for $new-item at $count in $item/mods:note
           return
              if ($doc/mods:note)
              then
                 update insert $new-item following $doc/mods:note[$count - 1]
              else
                 update insert $new-item preceding $doc/mods:related
         )
      else ()

let $related :=
   if ($item/mods:related)
      then
        (
        update delete $doc/mods:related,
        for $new-item at $count in $item/mods:related
           return
              if ($doc/mods:related)
              then
                 update insert $new-item following $doc/mods:related[$count - 1]
              else
                 update insert $new-item preceding $doc/mods:identifier
         )
      else ()

let $identifier :=
   if ($item/mods:identifier)
      then
        (
        update delete $doc/mods:identifier,
        for $new-item at $count in $item/mods:identifier
           return
              if ($doc/mods:identifier)
              then
                 update insert $new-item following $doc/mods:identifier[$count - 1]
              else
                 update insert $new-item preceding $doc/mods:record-info
         )
      else ()

let $record-info :=
   if ($item/mods:record-info)
      then
        (
        update delete $doc/mods:record-info,
        for $new-item at $count in $item/mods:record-info
           return
              if ($doc/mods:record-info)
              then
                 update insert $new-item following $doc/mods:record-info[$count - 1]
              else
                 update insert $new-item preceding $doc/mods:access-condition
         )
      else ()

let $access-condition :=
   if ($item/mods:access-condition)
      then
        (
        update delete $doc/mods:access-condition,
        for $new-item at $count in $item/mods:access-condition
           return
              if ($doc/mods:access-condition)
              then
                 update insert $new-item following $doc/mods:access-condition[$count - 1]
              else
                 (: update it into the very end of the document :)
                 update insert $new-item into $doc
         )
      else ()

return
<results>
  <message>Update Status = OK titles = {count($item/mods:titleInfo)}</message>
</results>

xquery version "1.0";

(: XQuery script to save a new MODS record from an incomming HTTP POST :)

import module namespace style = "http://exist-db.org/mods-style" at "../../../modules/style.xqm";

declare namespace xf="http://www.w3.org/2002/xforms";
declare namespace xforms="http://www.w3.org/2002/xforms";
declare namespace ev="http://www.w3.org/2001/xml-events";
declare namespace mods="http://www.loc.gov/mods/v3";

let $title := 'MODS Record Save'

(: this service takes an incomming POST and saves the appropriate records :)
(: note that in this version, the incomming @ID is required :)
(: the user must have write and update access to the data collection :)

let $app-collection := $style:db-path-to-app
let $data-collection := $style:db-path-to-app-data

(: this is where the form "POSTS" documents to this XQuery using the POST method of a submission :)
let $item := request:get-data()

(: check to see if we have an indentifier in the incomming post :)
let $incomming-id := $item/@ID

(: if we do not have an ID then throw an error :)
return
if ( string-length($incomming-id) = 0 )
   then
        <error>
          <message class="warning">ERROR! Attempted to save a record with no ID specified.</message>
        </error>
   else

(: else we are doing an update to an existing file :)

let $file-to-update := concat($incomming-id, '.xml')
let $file-path := concat($data-collection, '/', $file-to-update)

(: uncomment the following line in for testing if you have not run the security setup tools :)
let $login := xmldb:login($style:db-path-to-app-data, 'admin', 'admin123')

(: this is the document on disk to be updated :)
let $doc := doc($file-path)/mods:mods

(: If the incoming has any part then we update it in the document

Note that is has the side effect of adding the mods prefix in the data files.  Semantically this
means the same thing but I don't know of a way to tell eXist to always use a default namespace
when doing an update.  :)

(: TODO figure out some way to pass the element name to an XQuery function and then do an eval on the update :)

(: this checks to see if we have a titleInfo in the save.  If we do then it goes through each one and
it that is in the data it does a replace, else it does an insert. :)

let $titleInfo :=
   if ($item/mods:titleInfo)
     then
        for $new-title-info at $count in $item/mods:titleInfo
           return
              if ($doc/mods:titleInfo[$count])
              then
                 update replace $doc/mods:titleInfo[$count] with $new-title-info
              else
                 update insert $item/mods:titleInfo[2] following $doc/mods:titleInfo[$count -1]
   else ()

let $name :=
   if ($item/mods:name)
      then
         for $new-name-info at $count in $item/mods:name
           return
              if ($doc/mods:name[$count])
              then
                 update replace $doc/mods:name[$count] with $new-name-info
              else
                 update insert $item/mods:name[2] following $doc/mods:name[$count -1]
      else ()

let $originInfo := if ($item/mods:originInfo) then update replace $doc/mods:originInfo with $item/mods:originInfo else ()

let $physicalDescription := if ($item/mods:physicalDescription) then update replace $doc/mods:physicalDescription with $item/mods:physicalDescription else ()

let $targetAudience := if ($item/mods:targetAudience) then update replace $doc/mods:targetAudience with $item/mods:targetAudience else ()

let $language := if ($item/mods:language) then update replace $doc/mods:language with $item/mods:language else ()

let $typeOfResource := if ($item/mods:typeOfResource) then update replace $doc/mods:typeOfResource with $item/mods:typeOfResource else ()

let $genre := if ($item/mods:genre) then update replace $doc/mods:genre with $item/mods:genre else ()

let $subject := if ($item/mods:subject) then update replace $doc/mods:subject with $item/mods:subject else ()

let $classification := if ($item/mods:classification) then update replace $doc/mods:classification with $item/mods:classification else ()

let $abstract := if ($item/mods:abstract) then update replace $doc/mods:abstract with $item/mods:abstract else ()

let $table-of-contents := if ($item/mods:table-of-contents) then update replace $doc/mods:table-of-contents with $item/mods:table-of-contents else ()

let $note := if ($item/mods:note) then update replace $doc/mods:note with $item/mods:note else ()

let $related := if ($item/mods:related) then update replace $doc/mods:related with $item/mods:related else ()

let $identifier := if ($item/mods:identifier) then update replace $doc/mods:identifier with $item/mods:identifier else ()

let $record-info := if ($item/mods:record-info) then update replace $doc/mods:record-info with $item/mods:record-info else ()

let $access-condition := if ($item/mods:access-condition) then update replace $doc/mods:access-condition with $item/mods:access-condition else ()

return
<results>
  <message>Update Status = OK titles = {count($item/mods:titleInfo)}</message>
</results>


Fixed broken xquery.xq/process.xq

Fixed broken xquery.xq/process.xq

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

xquery version "1.0";

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

(: Namespace for the local functions in this script :)
declare namespace f="http://exist-db.org/xquery/local-functions";

(:
    Display hits for the current page. The number of hits to print per page
    is read from parameter "howmany". Parameter "start" identifies the
    current offset in the result set.
:)
declare function f:display($hits as item()*, $count as xs:int)
as element()+
{
    if (empty($hits)) then

Nothing found! Back to query form.

    else
        let $howmany := request:request-parameter("howmany", "10") cast as xs:int,
            $start := request:request-parameter("start", "1") cast as xs:int,
            $end := if ($start + $howmany le $count) then $start + $howmany - 1 else $count
        return (

                        <New Query>

                { f:navbar($start, $end, $howmany, $count) }
                {
                    for $p in $start to $end
                    let $current := item-at($hits, $p),
                        $style := if($p mod 2 eq 0) then "high" else "low"
                    return

                            {$p}

                                {
                                    if ($current instance of element()) then
                                        <xml-source>{$current}</xml-source>
                                    (: TODO : revisit :)
                                    else if ($current instance of attribute()) then
                                    	concat("attribute ", local-name($current), " { ", data($current), " }")
									else if ($current instance of processing-instruction()) then
                                    	concat("processing-instruction { ", name($current), " } { ", data($current), " }")
									else if ($current instance of comment()) then
                                    	concat("comment { ", data($current), " }")
                                    else
                                        string($current)
                                }

                }
                { f:navbar($start, $end, $howmany, $count) }

                        <New Query>

        )
};

(: Display the navigation bar :)
declare function f:navbar($start as xs:int, $end as xs:int,
$hitsPerPage as xs:int, $count as xs:int) as element()
{
    let $uri := request:request-uri()
    return

                {
                    (: Link to previous page :)
                    if ($start gt 1) then
                        <<
                    else ()
                }

                {
                    (: Create page shortcuts :)
                    let $sections := $count idiv $hitsPerPage - 1,
                        $currentSection := $start idiv $hitsPerPage,
                        $lastSection :=
                            if ($sections lt 0) then 0 else
                                (: show 10 max unless current page > 10 :)
                                if ($sections gt 9) then
                                    if ($currentSection gt 8) then $currentSection + 1
                                    else 9
                                else $sections
                    for $i in 0 to $lastSection
                    let $s := xs:int($i * $hitsPerPage + 1)
                    return
                        if($i ne $currentSection) then

                                [{$i + 1}]

                        else
                            (: current page doesn't get a link :)
                            [{$i + 1}]
                }

                {
                    (: Link to next page :)
                    if ($end lt $count) then

                            >>

                    else ()
                }

};

(: Auxiliary function called in add-to-history()
   to avoid having twice the same query in history
:)
declare function f:string-list-union(
   $list as xs:string*,
   $s as xs:string ) as xs:string*
{
  let $contains := some $ss in $list satisfies $ss eq $s

  return
    if ( $contains ) then
      $list
    else
      ( $list, $s )
};

(:  Add the last query to the query-history. The history is
    stored in the session as an XQuery sequence.
:)
declare function f:add-to-history($query as xs:string) as empty()
{
    let $history := request:get-session-attribute("history")
    return
        request:set-session-attribute( "history",
                                       f:string-list-union($history, $query) )
};

declare function f:handleException() as element()+
{
	,

Defined server limits exceeded!
,
	(
		if($util:exception eq
			"org.exist.xquery.TerminatedException$TimeoutException") then

The execution time of your query exceeded the predefined limits.
			It has been forced to terminate.

		else

The query exceeded the predefined size limits for
			temporary document fragments and has been forced to
			terminate.

	),

Limits can be configured! Please have a look at the
	"watchdog" section in the configuration file (conf.xml).

};

declare function f:eval($query as xs:string) as element()+
{
	let $startTime := util:system-time(),
		$collection := request:request-parameter("collection", ())
	return
		util:catch("org.exist.xquery.TerminatedException",
                        util:catch("org.exist.xquery.XPathException",
                            let	$result := util:eval($query),
                                $count := count($result),
                                $queryTime := util:system-time() - $startTime
                            return (

Found {$count} hits in
                                {seconds-from-duration($queryTime)} seconds.
                                {if($count gt 100) then "Max. 100 will be shown." else ()}

,
                                request:set-session-attribute(
                                    "results",
                                    subsequence($result, 1, 100)
                                ),
                                f:add-to-history($query),
                                f:display($result, $count)
                            ),

Error found: {$util:exception-message}.

                        ),
			f:handleException()
		)
};

(:  The main function. If a query has been passed in parameter
    "query", execute the query and store the results into the
    session. If "query" is empty, try to retrieve the previous
    result set from the session.
:)
declare function f:main() as element()+
{
    let $query := request:request-parameter("query", ()),
        $previous := request:get-session-attribute("results")
    return
        if ($query) then
           f:eval($query)
        else if ($previous) then
            f:display($previous, count($previous))
        else

Please specify a query! Back to query
            form.

};

<document xmlns:xi="http://www.w3.org/2001/XInclude">

        <logo src="logo.jpg"/>
        <title>Open Source XML Database</title>
	    <author email="wolfgang@exist-db.org">Wolfgang M. Meier</author>

xquery version "1.0";

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

(: Namespace for the local functions in this script :)
declare namespace f="http://exist-db.org/xquery/local-functions";

(:
    Display hits for the current page. The number of hits to print per page
    is read from parameter "howmany". Parameter "start" identifies the
    current offset in the result set.
:)
declare function f:display($hits as item()*, $count as xs:int)
as element()+
{
    if (empty($hits)) then

Nothing found! Back to query form.

    else
        let $howmany := request:request-parameter("howmany", "10") cast as xs:int,
            $start := request:request-parameter("start", "1") cast as xs:int,
            $end := if ($start + $howmany le $count) then $start + $howmany - 1 else $count
        return (

                        <New Query>

                { f:navbar($start, $end, $howmany, $count) }
                {
                    for $p in $start to $end
                    let $current := item-at($hits, $p),
                        $style := if($p mod 2 eq 0) then "high" else "low"
                    return

                            {$p}

                                {
                                    if ($current instance of element()) then
                                        <xml-source>{$current}</xml-source>
                                    (: TODO : revisit :)
                                    else if ($current instance of attribute()) then
                                    	concat("attribute ", local-name($current), " { ", data($current), " }")
									else if ($current instance of processing-instruction()) then
                                    	concat("processing-instruction { ", name($current), " } { ", data($current), " }")
									else if ($current instance of comment()) then
                                    	concat("comment { ", data($current), " }")
                                    else
                                        string($current)
                                }

                }
                { f:navbar($start, $end, $howmany, $count) }

                        <New Query>

        )
};

(: Display the navigation bar :)
declare function f:navbar($start as xs:int, $end as xs:int,
$hitsPerPage as xs:int, $count as xs:int) as element()
{
    let $uri := request:request-uri()
    return

                {
                    (: Link to previous page :)
                    if ($start gt 1) then
                        <<
                    else ()
                }

                {
                    (: Create page shortcuts :)
                    let $sections := $count idiv $hitsPerPage - 1,
                        $currentSection := $start idiv $hitsPerPage,
                        $lastSection :=
                            if ($sections lt 0) then 0 else
                                (: show 10 max unless current page > 10 :)
                                if ($sections gt 9) then
                                    if ($currentSection gt 8) then $currentSection + 1
                                    else 9
                                else $sections
                    for $i in 0 to $lastSection
                    let $s := xs:int($i * $hitsPerPage + 1)
                    return
                        if($i ne $currentSection) then

                                [{$i + 1}]

                        else
                            (: current page doesn't get a link :)
                            [{$i + 1}]
                }

                {
                    (: Link to next page :)
                    if ($end lt $count) then

                            >>

                    else ()
                }

};

(: Auxiliary function called in add-to-history()
   to avoid having twice the same query in history
:)
declare function f:string-list-union(
   $list as xs:string*,
   $s as xs:string ) as xs:string*
{
  let $contains := some $ss in $list satisfies $ss eq $s

  return
    if ( $contains ) then
      $list
    else
      ( $list, $s )
};

(:  Add the last query to the query-history. The history is
    stored in the session as an XQuery sequence.
:)
declare function f:add-to-history($query as xs:string) as empty()
{
    let $history := request:get-session-attribute("history")
    return
        request:set-session-attribute( "history",
                                       f:string-list-union($history, $query) )
};

declare function f:handleException() as element()+
{
	,

Defined server limits exceeded!
,
	(
		if($util:exception eq
			"org.exist.xquery.TerminatedException$TimeoutException") then

The execution time of your query exceeded the predefined limits.
			It has been forced to terminate.

		else

The query exceeded the predefined size limits for
			temporary document fragments and has been forced to
			terminate.

	),

Limits can be configured! Please have a look at the
	"watchdog" section in the configuration file (conf.xml).

};

declare function f:eval($query as xs:string) as element()+
{
	let $startTime := util:system-time(),
		$collection := request:request-parameter("collection", ())
	return
		util:catch("org.exist.xquery.TerminatedException",
            util:catch("org.exist.xquery.XPathException",
                let	$result := util:eval($query, $collection),
                    $count := count($result),
                    $queryTime := util:system-time() - $startTime
                return (

Found {$count} hits in
                    {seconds-from-duration($queryTime)} seconds.
                    {if($count gt 100) then "Max. 100 will be shown." else ()}

,
                    request:set-session-attribute(
                        "results",
                        subsequence($result, 1, 100)
                    ),
                    f:add-to-history($query),
                    f:display($result, $count)
                ),

Error found: {$util:exception-message}.

            ),
			f:handleException()
		)
};

(:  The main function. If a query has been passed in parameter
    "query", execute the query and store the results into the
    session. If "query" is empty, try to retrieve the previous
    result set from the session.
:)
declare function f:main() as element()+
{
    let $query := request:request-parameter("query", ()),
        $previous := request:get-session-attribute("results")
    return
        if ($query) then
           f:eval($query)
        else if ($previous) then
            f:display($previous, count($previous))
        else

Please specify a query! Back to query
            form.

};

<document xmlns:xi="http://www.w3.org/2001/XInclude">

        <logo src="logo.jpg"/>
        <title>Open Source XML Database</title>
	    <author email="wolfgang@exist-db.org">Wolfgang M. Meier</author>


Added targets & ids to tabs; added name of app to delete tooltip

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

xquery version "1.0";

module namespace repomanager="http://exist-db.org/xquery/admin-interface/repo";

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

declare variable $repomanager:coll := "/db/system/repo";
declare variable $repomanager:repo-uri :=
    if (request:get-parameter("repository-url", ())) then
        request:get-parameter("repository-url", ())
    else
        "http://demo.exist-db.org/exist/apps/public-repo/retrieve.html"
        (: "http://192.168.2.104:8080/exist/apps/public-repo/retrieve.html" :)
;

declare function local:entry-data($path as xs:anyURI, $type as xs:string, $data as item()?, $param as item()*) as item()?
{
    if (starts-with($path, "icon")) then
        <icon>{$path}</icon>
    else
    	<entry>
    		<path>{$path}</path>
    		<type>{$type}</type>
    		<data>{$data}</data>
    	</entry>
};

declare function local:entry-filter($path as xs:anyURI, $type as xs:string, $param as item()*) as xs:boolean
{
	starts-with($path, "icon") or $path = ("repo.xml", "expath-pkg.xml")
};

declare function repomanager:publicrepo() as element()
{
    let $package-url := request:get-parameter("package-url", ())
    return

Actions:

                {
                if (ends-with($package-url,'.xar')) then (

Downloaded package: {$package-url}
,

                    let $http-response := httpclient:get(xs:anyURI($package-url), false(), ())
                    let $name := tokenize($package-url, "/")[last()]
                    let $package-mimetype := "application/xar"
                    let $package-data := xs:base64Binary($http-response/httpclient:body/text())
                    let $stored := xmldb:store($repomanager:coll, $name, $package-data, $package-mimetype)
                    let $meta :=
                        compression:unzip(
                            util:binary-doc($stored), util:function(xs:QName("local:entry-filter"), 3),
                            (),  util:function(xs:QName("local:entry-data"), 4), ()
                        )
                    let $package := $meta//package:package/string(@name)
                    let $type := $meta//repo:meta//repo:type/string()
                    let $install :=
                        repo:install(concat('http://localhost:',request:get-server-port(),'/exist/rest',$stored))
                    let $deploy :=
                        if ($type eq "application") then
                            repo:deploy($package)
                        else
                            ()
                    return

Package installed.

                )
                else

Error uploading - Must be a valid Package archive (.xar file extension)

                }

            Important: installed XQuery library mappings will not become visible until eXist is restarted.

};

declare function repomanager:upload() as element()
{

Actions:

        {
            let $name := request:get-parameter("name", ())
            let $repocol :=  if (collection($repomanager:coll)) then () else xmldb:create-collection('/db/system','repo')
            let $docName := if($name) then $name else request:get-uploaded-file-name("upload")
            let $file := request:get-uploaded-file-data("upload")
            return
                if ($docName) then
                    let $stored := xdb:store($repomanager:coll, xdb:encode-uri($docName), $file)
                    let $meta :=
                        compression:unzip(
                            util:binary-doc($stored), util:function(xs:QName("local:entry-filter"), 3),
                            (),  util:function(xs:QName("local:entry-data"), 4), ()
                        )
                    let $package := $meta//package:package/string(@name)
                    let $type := $meta//repo:meta//repo:type/string()
                    let $install :=
                        repo:install(concat('http://localhost:',request:get-server-port(),'/exist/rest',$stored))
                    let $deployed :=
                        if ($type eq "application") then
                            repo:deploy($package)
                        else
                            ()
                    return

Package uploaded and installed: {$name}

                else

Error uploading - Must be a valid Package archive (.xar file extension)

        }

};

declare function repomanager:activate() as element()
{
    let $name := request:get-parameter("name", ())
    let $package := request:get-parameter("package", ())
    let $type := request:get-parameter("type", ())
    let $hostname := request:get-hostname()            (:  pkg-repo.jar needs http or file scheme :)
    let $port := request:get-server-port()
     return

Actions:

Installed package: {$name}

                {
                    repo:install(concat('http://localhost:',$port,'/exist/rest',$repomanager:coll,'/',$name,'.xar')),
                    if ($type eq "application") then
                        repo:deploy($package)
                    else
                        ()
                }

};

declare function repomanager:deactivate() as element()
{
    let $name := request:get-parameter("name", ())
    let $package := request:get-parameter("package", ())
    let $type := request:get-parameter("type", ())
    let $undeploy :=
        if ($type eq "application") then
            repo:undeploy($package)
        else
            ()
    let $remove := repo:remove($package)
    (: let $delete := xmldb:remove($repomanager:coll, $name) :)
    return

Actions:

Uninstalled package: {$name}

};

declare function repomanager:process-action() as element()*
{
    let $action := request:get-parameter("action", ()) return
        util:catch("java.lang.Exception",
            if($action eq "activate") then
            (
                repomanager:activate()
            )
            else if($action eq "deactivate") then
            (
                repomanager:deactivate()
            )
            else if($action eq "Upload Package") then
            (
                repomanager:upload()
            )
            else if($action eq "download") then
            (
                repomanager:publicrepo()
            )else(),

                An error occurred while processing the action:

                {$util:exception-message}

        )
};

declare function repomanager:all-packages() {
    for $repo in repo:list()
    return
        <package url="{$repo}">
        {
            for $r in ("repo.xml", "expath-pkg.xml")
            let $meta := repo:get-resource($repo, $r)
            let $data := if (exists($meta)) then util:binary-to-string($meta) else ()
            return
                if (exists($data)) then
                    util:parse($data)
                else
                    ()
        }
        {
            let $icon := repo:get-resource($repo, "icon.png")
            return
                if (exists($icon)) then
                    <icon>icon.png</icon>
                else
                    ()
        }
        </package>
};

declare function repomanager:view-installed() {
    let $packages := repomanager:all-packages()
    return

        {
            for $package in $packages
            let $iconURL :=
                if ($package/icon) then
                    concat("get-icon.xql?package=", $package/@url)
                else
                    "images/package.png"
            let $pkg-name := $package/package:package/string(@name)
            let $pkg-abbrev := $package/package:package/string(@abbrev)
            let $type := $package//repo:type/string()
            let $version := $package/package:package/@version/string()
            let $app-url :=
				if ($package//repo:target) then
                	concat(
                    	request:get-context-path(), "/apps",
                    	substring-after($package//repo:target, "/db"), "/"
                	)
				else
					()
            return

{$package//package:title/string()} ({$version})

                                Title:
                                { $package//package:title/text() }

							{
								if ($app-url) then

										Local URL:

											{$app-url}

								else
									()
							}

                                Author(s):

                                    {
                                        for $author in $package//repo:author
                                        return

{$author/text()}

                                    }

                                Version:
                                { $version }

                                Description:
                                { $package//repo:description/text() }

                                License:
                                { $package//repo:license/text() }

                                Website:
                                { $package//repo:website/text() }

                                    <form method="POST" action="admin.xql">
                                        <input type="hidden" name="panel" value="repo"/>
                                        <input type="hidden" name="name" value="{$pkg-abbrev}-{$version}.xar"/>
                                        <input type="hidden" name="package" value="{$pkg-name}"/>
                                        <input type="hidden" name="type" value="{$type}"/>
                                        <button type="submit" name="action" value="deactivate">

                                        </button>
                                    </form>

        }

};

declare function repomanager:show-public() {

        <input name="repository-url" size="60" value="{$repomanager:repo-uri}"/>
        <button name="retrieve-repo" id="retrieve-repo">Retrieve packages</button>

Retrieving packages ...

};

declare function repomanager:main() as element() {
    let $action := lower-case(request:get-parameter("action", "set repository"))
    let $repocol :=  if (collection($repomanager:coll)) then () else xmldb:create-collection('/db/system','repo')

    return

Package Repository

            { repomanager:process-action() }

Installed

Public Repo

Upload

                    { repomanager:view-installed() }

                    { repomanager:show-public() }

                    <form method="POST" enctype="multipart/form-data">
                        <input type="hidden" name="panel" value="repo"/>

                                <input type="submit" name="action" value="Upload Package"/>
                                <input type="file" size="30" name="upload"/>

                        Note: You can upload example .xar packages located under webapp/repo/packages
                    </form>

};