updated (module-)paths, allow auth, generic param-substitution in request, added docs

xquery version "1.0";
module namespace fcs-tests  = "http://clarin.eu/fcs/1.0/tests";

import module namespace httpclient = "http://exist-db.org/xquery/httpclient";
import module namespace t="http://exist-db.org/xquery/testing";
import module namespace repo-utils = "http://aac.ac.at/content_repository/utils" at  "/db/cr/repo-utils.xqm";

declare namespace zr="http://explain.z3950.org/dtd/2.1/";
declare namespace sru = "http://www.loc.gov/zing/srw/";
declare namespace fcs = "http://clarin.eu/fcs/1.0";
declare namespace diag = "http://www.loc.gov/zing/srw/diagnostic/";
declare namespace xhtml="http://www.w3.org/1999/xhtml";

(: sample input:

 :)
declare variable $fcs-tests:config := doc("config.xml");
declare variable $fcs-tests:cr-config := repo-utils:config("/db/cr/conf/cr/config.xml");
declare variable $fcs-tests:run-config := "run-config.xml";
declare variable $fcs-tests:testsets-coll := "/db/cr/modules/testing/testsets/";
declare variable $fcs-tests:results-coll := "/db/cr/modules/testing/results/";
declare variable $fcs-tests:href-prefix := "tests.xql";

(:~ this function is accessed by the testing-code to get configuration-options from the run-config :)
declare function fcs-tests:config-value($key as xs:string) as xs:string* {
            let $config := doc(concat($fcs-tests:testsets-coll, $fcs-tests:run-config))/config
                return if ($key eq "testset") then  xs:string($config//testset/@key)
                        else if ($key eq "operation") then $config//property[@key='operation']/text()
                        else $config//target/text()
};

declare function fcs-tests:config-key($key as xs:string) as xs:string* {
            let $config := doc(concat($fcs-tests:testsets-coll, $fcs-tests:run-config))/config
                return if ($key eq "testset") then  xs:string($config//testset/@key)
                        else xs:string($config//target/@key)
};

declare function fcs-tests:get-result-paths($target  as xs:string, $testset as xs:string) as xs:string* {
        (concat($fcs-tests:results-coll, $target, "/"), concat($testset, ".xml"))
};

declare function fcs-tests:get-result-path($target  as xs:string, $testset as xs:string) as xs:string* {
        string-join(fcs-tests:get-result-paths($target , $testset ), "" )
};

declare function fcs-tests:get-result($target  as xs:string, $testset as xs:string) as item() {
  let $result-path := fcs-tests:get-result-path($target, $testset)
   let $result := if ($target = '' or $testset = '') then ()
                            else if (doc-available($result-path)) then
                            doc($result-path)
                        else <diagnostics><diagnostic key="result-unavailable">result unavailable: {$result-path}</diagnostic>
                                <diagnostic>{fcs-tests:get-testset($testset)}</diagnostic>
                              </diagnostics>
 return $result
};

(:~ try to get the testset-file based on the testset-key
@returns testset-file if available, otherwise empty result
:)
declare function fcs-tests:get-testset($testset as xs:string) as item()* {
    let $testset-path := concat($fcs-tests:testsets-coll, $testset, ".xml")
    return if (doc-available($testset-path)) then
                    doc($testset-path)
                  else
                  <diagnostic>unknown testset: {$testset}</diagnostic>
};

(:~ main function governing the execution of the tests

Generates a run-config out of the full config based on the parameters.
@param $target identifying key of the target  as set in the config
@param $testset-key identifying key of the testset as set in the config (that also has to be the name of the testset-file)
@param $operation run or run-store; with `run-store` also the fetched individual results stored, the final result is stored anyway
:)
declare function fcs-tests:run-testset($target  as xs:string, $testset-key as xs:string, $operation as xs:string) as item()* {

    (: preparing a configuration for given run, based on the parameters :)
    let $run-config := <config>{($fcs-tests:config//target[xs:string(@key) = $target],
                                $fcs-tests:config//testset[xs:string(@key) = $testset-key],
                                <property key="operation">{$operation}</property>)}</config>
    let $store := repo-utils:store($fcs-tests:testsets-coll, $fcs-tests:run-config, $run-config, true())
    let $testset := fcs-tests:get-testset($testset-key)
    let $start-time := util:system-dateTime()
    let $result := if (exists($testset)) then
                            let $tests := $testset//TestSet
                            (: distinguish the testset, that the testing-module can process
                               and the home-made test-doc, that tests URLs :)
                            return if (exists($tests)) then
                                        t:run-testSet($tests, ())
                                     else
                                        fcs-tests:test-rest($testset)
                       else
                           $testset
    let $end-time := util:system-dateTime()
    let $test-wrap := <testrun duration="{$end-time - $start-time}" on="{fn:current-dateTime()}" >{$result}</testrun>
    let $store-result := fcs-tests:store-result($target, $testset-key, $test-wrap)
    (:for $test in $tests/tests/test return fcs-tests:run-test($test):)
    return $store-result
};

(:~ process a test-doc (target is expected to be set in the config)
:)
declare function fcs-tests:test-rest($test-doc as node()) as item()* {

    let $result := local:dispatch($test-doc)

(:
let $targets := if (exists($test/target)) then $test/target else $test/preceding-sibling::target
let $requests := for $target in $targets return concat($target, $test/request/text())
let $data := for $request in $requests return
                <request href="{$request}" id
                httpclient:get(xs:anyURI($request), false(), () )

let $check := for $condition in $test/condition
                        let $expr :=concat("($data/", $condition/text(), " eq ", xs:string($condition/@result), ")")
                         return <check expr="{$expr}" >{util:eval($expr)} </check>
return <test><id>{$test/id}</id>{$test/label}
            <requests>{$requests}</requests>
            <results>{$check}</results>
        </test>
:)
return $result

};

(:~ This function takes the children of the node and passes them
   back into the typeswitch function. :)
declare function local:passthru($x as node()) as node()*
{
for $z in $x/node() return local:dispatch($z)
};

(:~ This is the recursive typeswitch function, to traverse the testset-document :)
declare function local:dispatch($x as node()) as node()*
{
typeswitch ($x)
  case text() return $x
  case element (test) return element div {$x/@*[not(name()=('username','password'))], attribute class {"test"}, fcs-tests:process-test($x)}
  case element() return element {$x/name()} {$x/@*, local:passthru($x)}
  default return local:passthru($x)
};

(:~ executes a rest-test.

if the test references a list, iterate over the items of the list and run a request for each
(substituting the values from the list in the request)
the substituted request is passed to fcs-tests:process-request() for actual execution

expects:

      search: Haus
      //sru:numberOfRecords

@returns the (sequence of) requested-url as link, results of the xpath-evaluations as a div-list and any diagnostics
:)
declare function fcs-tests:process-test($test as node()) as item()* {

    let $a := $test/a,
        $test-id := xs:string($test/@id),
        $test-list := xs:string($test/@list),
        $list-doc := if (doc-available($test-list)) then doc($test-list) else (),
        $target := fcs-tests:config-value("target"),
        $target-key := fcs-tests:config-key("target"),
        $operation := fcs-tests:config-value("operation")

    return if (empty($list-doc)) then
                let $request := concat($target, xs:string($a/@href))
                return fcs-tests:process-request ($test, $request, $a/text(), $target-key, $test-id, $operation)
            else
            (: if we have a list, iterate over the items of the list and run a request for each :)
                for $i at $c in $list-doc/lst/*
                  let $request := concat($target,  fcs-tests:subst(xs:string($a/@href), $i)),
                      $i-id := if ($i/@id) then xs:string($i/@id) else $c,
                      $request-id := concat($test-id, $i-id),
                      $a-text := fcs-tests:subst(xs:string($a/text()), $i)
                  return fcs-tests:process-request ($test, $request, $a-text, $target-key, $request-id, $operation)
};

(:~ executes one URL-test.

Issues one http-call to the target-url in the a@href-attribute, stores the incoming result (only if $operation='run-store') and evaluates the associated xpaths

@param $test div[@class='test']-element
@param $request resolved (substituted) link
@param $a-text resolved (substituted) text for the link
@param $target-key identifier of the target (will be used as directory, when storing the result)
@param $request-id identifier of the request (will be used as the name of the file, when storing the result)

@returns the requested-url as link, results of the xpath-evaluations as a div-list and any diagnostics
:)
declare function fcs-tests:process-request($test, $request as xs:string, $a-text as xs:string, $target-key as xs:string, $request-id as xs:string, $operation as xs:string) as item()* {

    let $a-processed := {$a-text}
    let $username := if ($test/@username) then $test/xs:string(@username)  else ""
    let $password := if ($test/@password) then $test/xs:string(@password) else ""

    let $headers := if ($username='') then () else
                            let $auth := concat("Basic ", util:base64-encode(concat($username, ':', $password)))
                            return <headers></headers>

    let $result-data := httpclient:get(xs:anyURI($request), false(), $headers )

    let $store := if ($operation eq 'run-store') then fcs-tests:store-result($target-key, $request-id, $result-data//httpclient:body/*) else ()
    let $cache-uri := if (exists($store)) then
    cache else ()
(:    <a href="{fcs-tests:get-result-paths($target-key, $request-id) else ():)
(:    let $cache-uri := if (exists($store)) then  cache  else ():)
    (: evaluate all xpaths defined for given request :)
    let $check := for $xpath in $test/xpath
                    let $evald := util:eval($xpath/text())

                    return

{if (exists($xpath/@key)) then xs:string($xpath/@key) else $xpath/text()}:
                          {$evald}

     (: checking extra for diagnostics :)
     let $http-status := $result-data//xs:string(@statusCode)
     let $diag := ($result-data//diag:diagnostic, $result-data//exception,
                if ($http-status ne '200') then <http-status>{$http-status}</http-status> else ())
      let $wrapped-diag := if (exists($diag)) then
                <diagnostics type="{string-join($diag/name(),',')}" >{$diag}</diagnostics> else ()
return ($a-processed, $cache-uri, $check, $wrapped-diag)
};

declare function fcs-tests:store-result($target as xs:string, $testset as xs:string, $result as node()) as item()* {
    fcs-tests:store-result ($target, $testset, "", $result)
};

(:~ stores the result of a testset
@returns reference to the stored document (as the underlying function repo-utils:store())
:)
declare function fcs-tests:store-result($target as xs:string, $testset as xs:string, $test as xs:string, $result as node()) as item()* {
(: create collection for results for one target :)
   let $create-coll := if (not(xmldb:collection-available(concat($fcs-tests:results-coll, $target)))) then
                           xmldb:create-collection($fcs-tests:results-coll, $target) else ()

  let $result-path := fcs-tests:get-result-paths($target, concat($testset, $test))

  let $store-result := repo-utils:store($result-path[1], $result-path[2], $result, true())

return $store-result
};

(:~ generates a html-view of the resulting testset
relies on repo-utils serialization function, expecting a stylesheet with the key: test2view
:)
declare function fcs-tests:format-result($result as node()) as item()* {

    if ($result[self::element(diagnostics)]) then

{$result/text()}

       else if (exists($result/testrun)) then
          repo-utils:serialise-as ($result, "html", "test", $fcs-tests:cr-config)
       else repo-utils:serialise-as ($result, "html", "test", $fcs-tests:cr-config)
              (: return quite empty html ??
                t:format-testResult($result) :)
};

(:~ generates the html-page displaying either the overview, or the result of selected testset
:)
declare function fcs-tests:display-page($target  as xs:string, $testset as xs:string, $operation) as item()* {

    let $result := fcs-tests:get-result($target, $testset)

    let $formatted-result := fcs-tests:format-result($result)
    let $opt := util:declare-option("exist:serialize", "media-type=text/html method=xhtml")
    return

            <title>FCS - test suite</title>
            <meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/>
             <link rel="stylesheet" type="text/css" href="tests.css" />
             <link rel="stylesheet" type="text/css" href="../../scripts/style/cmds-ui.css" />

FCS - test suite

                overview

            {if ($operation = 'overview') then fcs-tests:display-overview() else () }
            <form>
                targets<select name="target">
                    {
                    for $target-elem  in $fcs-tests:config//target
                        let $target-key := xs:string($target-elem/@key)
                        let $option :=  if ($target = $target-key) then
                                            <option selected="selected" value="{$target-key}" >{$target-key}</option>
                                         else
                                            <option value="{$target-key}" >{$target-key } </option>
                        return $option
                    }
                </select>
                test-set<select name="testset">
                    {
                    for $testset-elem in $fcs-tests:config//testset
                        let $testset-key := xs:string($testset-elem/@key)
                        let $option :=  if ($testset= $testset-key) then
                                            <option selected="selected" value="{$testset-key}" >{$testset-key}</option>
                                         else
                                            <option value="{$testset-key}" >{$testset-key}</option>
                        return $option
                    }
                </select>
                test-set
                    <select name="operation">
                       <option value="run" >{if ($operation = 'run') then attribute selected { "selected" } else ()} run</option>
                       <option value="run-store" >{if ($operation = 'run-store') then attribute selected { "selected" } else ()} run-store</option>
                       <option value="view" > {if ($operation = 'view') then attribute selected { "selected" } else ()} view</option>
                       <option value="overview" > {if ($operation = 'overview') then attribute selected { "selected" } else ()} overview</option>
                    </select>
                <input type="submit" value="View/Run" />
                </form>

{$formatted-result}

};

declare function fcs-tests:display-overview() as item()* {

	{for $target in $fcs-tests:config//target return {xs:string($target/@key)}	}

            {for $testset in $fcs-tests:config//testset
                    let $testset-key := $testset/xs:string(@key)
                    return

                        {$testset-key}
                        {for $target in $fcs-tests:config//target
                           let $target-key := $target/xs:string(@key)
                           let $test-result := fcs-tests:get-result($target-key , $testset-key )
                           let $root-elem := $test-result/*/name()
                           let $op := if ($test-result//diagnostic["result-unavailable" = xs:string(@key)]) then 'run' else 'view'
                           (: display number of all and failed tests in the testset, operates on the HTML produced during the test-run :)
                           let $view:= if ($test-result//diagnostic["result-unavailable" = xs:string(@key)]) then ()
                                       else
                                            let $show := if ($root-elem[1] eq 'testrun') then
                                                            {count($test-result//div[@class='test'][.//span[@class='value true']])}{"/"}
                                                                   {count($test-result//div[@class='test'][.//span[@class='value false']])}{"/"}
                                                                {count($test-result//div[@class='test'])}
                                                                {if (exists($test-result//diagnostics)) then !! else () }

                                                            else $root-elem
                                            return {$show}

                        return {$view} [run]
                        }

            }

};

(:~ helper function for substituting a string with values from a substitution-element
? should be probably moved to repo-utils

@param $string string with %-keys in it (eg: "My name is %name")
@param $substset an element with attributes and subelements that will be used for substitution (their name being use for matching the %-keys in the string
                 (eg <subst name="Homer" />)
@return the original string, with %-keys replaced by values from the substitution element (if found,  otherwise the %-key stays unchanged)
          (eg "My name is Homer")
:)
declare function fcs-tests:subst($string as xs:string, $substset)
    {
        let $substkeys := for $substi in $substset/(*|@*) return concat('%', $substi/name())
        let $substvalues := for $substi in $substset/(*|@*) return
                            if (ends-with($substi/name(),'url')) then xmldb:encode(xs:string($substi)) else xs:string($substi)

        (: let $temp := replace($string, concat('%', $substkey), $substvalue)
        return if count($substset local:subst($temp, $substset/*[position() > 1]) :)
        return repo-utils:replace-multi ($string, $substkeys, $substvalues)

    };

xquery version "1.0";
module namespace fcs-tests  = "http://clarin.eu/fcs/1.0/tests";

import module namespace httpclient = "http://exist-db.org/xquery/httpclient";
import module namespace t="http://exist-db.org/xquery/testing";
import module namespace repo-utils = "http://aac.ac.at/content_repository/utils" at  "../../repo-utils.xqm";

declare namespace zr="http://explain.z3950.org/dtd/2.1/";
declare namespace sru = "http://www.loc.gov/zing/srw/";
declare namespace fcs = "http://clarin.eu/fcs/1.0";
declare namespace diag = "http://www.loc.gov/zing/srw/diagnostic/";
declare namespace xhtml="http://www.w3.org/1999/xhtml";
declare namespace rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#";
declare namespace skos="http://www.w3.org/2004/02/skos/core#";

(: sample input:

 :)
declare variable $fcs-tests:config := doc("config.xml");
declare variable $fcs-tests:cr-config := repo-utils:config("/db/apps/cr/conf/cr/config.xml");
declare variable $fcs-tests:run-config := "run-config.xml";
(: avoid absolute paths - but probably this should be a config-option anyway
not possible, because when passed to fcs:repo-utils, it does not know, where they are: :)
declare variable $fcs-tests:testsets-coll := "/db/apps/cr/modules/testing/testsets/";
declare variable $fcs-tests:results-coll := "/db/apps/cr/modules/testing/results/";
(:declare variable $fcs-tests:testsets-coll := "testsets/";
declare variable $fcs-tests:results-coll := "results/";:)

declare variable $fcs-tests:href-prefix := "tests.xql";

(:~ this function is accessed by the testing-code to get configuration-options from the run-config :)
declare function fcs-tests:config-value($key as xs:string) as xs:string* {
            let $config := doc(concat($fcs-tests:testsets-coll, $fcs-tests:run-config))/config
                return if ($key eq "testset") then  xs:string($config//testset/@key)
                        else if ($key eq "operation") then $config//property[@key='operation']/text()
                        else $config//target/text()
};

declare function fcs-tests:config-key($key as xs:string) as xs:string* {
            let $config := doc(concat($fcs-tests:testsets-coll, $fcs-tests:run-config))/config
                return if ($key eq "testset") then  xs:string($config//testset/@key)
                        else xs:string($config//target/@key)
};

declare function fcs-tests:get-result-paths($target  as xs:string, $testset as xs:string) as xs:string* {
        (concat($fcs-tests:results-coll, $target, "/"), concat($testset, ".xml"))
};

declare function fcs-tests:get-result-path($target  as xs:string, $testset as xs:string) as xs:string* {
        string-join(fcs-tests:get-result-paths($target , $testset ), "" )
};

declare function fcs-tests:get-result($target  as xs:string, $testset as xs:string) as item() {
  let $result-path := fcs-tests:get-result-path($target, $testset)
   let $result := if ($target = '' or $testset = '') then ()
                            else if (doc-available($result-path)) then
                            doc($result-path)
                        else <diagnostics><diagnostic key="result-unavailable">result unavailable: {$result-path}</diagnostic>
                                <diagnostic>{fcs-tests:get-testset($testset)}</diagnostic>
                              </diagnostics>
 return $result
};

(:~ try to get the testset-file based on the testset-key
@returns testset-file if available, otherwise empty result
:)
declare function fcs-tests:get-testset($testset as xs:string) as item()* {
    let $testset-path := concat($fcs-tests:testsets-coll, $testset, ".xml")
    return if (doc-available($testset-path)) then
                    doc($testset-path)
                  else
                  <diagnostic>unknown testset: {$testset}</diagnostic>
};

(:~ main function governing the execution of the tests

Generates a run-config out of the full config based on the parameters.
@param $target identifying key of the target  as set in the config
@param $testset-key identifying key of the testset as set in the config (that also has to be the name of the testset-file)
@param $operation run or run-store; with `run-store` also the fetched individual results stored, the final result is stored anyway
:)
declare function fcs-tests:run-testset($target  as xs:string, $testset-key as xs:string, $operation as xs:string) as item()* {

    (: preparing a configuration for given run, based on the parameters :)
    let $run-config := <config>{($fcs-tests:config//target[xs:string(@key) = $target],
                                $fcs-tests:config//testset[xs:string(@key) = $testset-key],
                                <property key="operation">{$operation}</property>)}</config>
    let $store := repo-utils:store($fcs-tests:testsets-coll, $fcs-tests:run-config, $run-config, true())
    let $testset := fcs-tests:get-testset($testset-key)
    let $start-time := util:system-dateTime()
    let $result := if (exists($testset)) then
                            let $tests := $testset//TestSet
                            (: distinguish the testset, that the testing-module can process
                               and the home-made test-doc, that tests URLs :)
                            return if (exists($tests)) then
                                        t:run-testSet($tests, ())
                                     else
                                        fcs-tests:test-rest($testset)
                       else
                           $testset
    let $end-time := util:system-dateTime()
    let $test-wrap := <testrun duration="{$end-time - $start-time}" on="{fn:current-dateTime()}" >{$result}</testrun>
    let $store-result := fcs-tests:store-result($target, $testset-key, $test-wrap)
    (:for $test in $tests/tests/test return fcs-tests:run-test($test):)
    return $store-result
};

(:~ process a test-doc (target is expected to be set in the config)
:)
declare function fcs-tests:test-rest($test-doc as node()) as item()* {

    let $result := local:dispatch($test-doc)

(:
let $targets := if (exists($test/target)) then $test/target else $test/preceding-sibling::target
let $requests := for $target in $targets return concat($target, $test/request/text())
let $data := for $request in $requests return
                <request href="{$request}" id
                httpclient:get(xs:anyURI($request), false(), () )

let $check := for $condition in $test/condition
                        let $expr :=concat("($data/", $condition/text(), " eq ", xs:string($condition/@result), ")")
                         return <check expr="{$expr}" >{util:eval($expr)} </check>
return <test><id>{$test/id}</id>{$test/label}
            <requests>{$requests}</requests>
            <results>{$check}</results>
        </test>
:)
return $result

};

(:~ This function takes the children of the node and passes them
   back into the typeswitch function. :)
declare function local:passthru($x as node()) as node()*
{
for $z in $x/node() return local:dispatch($z)
};

(:~ This is the recursive typeswitch function, to traverse the testset-document :)
declare function local:dispatch($x as node()) as node()*
{
typeswitch ($x)
  case text() return $x
  case element (test) return element div {$x/@*, attribute class {"test"}, fcs-tests:process-test($x)}
  case element() return element {$x/name()} {$x/@*, local:passthru($x)}
  default return local:passthru($x)
};

(:~ executes one URL-test.

Issues one http-call to the target-url in the a@href-attribute, stores the incoming result (only if $operation='run-store') and evaluates the associated xpaths

expects:

      search: Haus
      //sru:numberOfRecords

 or rather ?:
    <test id="clarin-at-mdrepo">
        clarin-at mdrepo
        <xpath key="html">exists($result-data//html)</xpath>
        <xpath key="xhtml">exists($result-data//xhtml:html)</xpath>
    </test>

@returns the requested-url, results of the xpath-evaluations as a div-list and any diagnostics
:)
declare function fcs-tests:process-test($test as node()) as item()* {

    let $a := $test/a,
        $test-id := xs:string($test/@id),
        $test-list := xs:string($test/@list),
        $list-doc := if (doc-available($test-list)) then doc($test-list) else (),
        $target := fcs-tests:config-value("target"),
        $target-key := fcs-tests:config-key("target"),
        $operation := fcs-tests:config-value("operation")

    return if (empty($list-doc)) then
                let $request := concat($target, xs:string($a/@href))
                return fcs-tests:process-request ($test, $request, $a/text(), $target-key, $test-id, $operation)
            else
            (: if we have a list, iterate over the items of the list and run a request for each :)
                for $i at $c in $list-doc/lst/*
                  let $q := xs:string($i/@q),
                            (: has to have the varaible there - currenlty only supports $q-variable :)
                      $request := concat($target,  replace(xs:string($a/@href), '%q', xmldb:encode($q))),
                      $i-id := if ($i/@id) then xs:string($i/@id) else $c,
                      $request-id := concat($test-id, $i-id),
                      $a-text := replace(xs:string($a/text()), '%q', $q)
                  return fcs-tests:process-request ($test, $request, $a-text, $target-key, $request-id, $operation)
};

declare function fcs-tests:process-request($test, $request as xs:string, $a-text as xs:string, $target-key as xs:string, $request-id as xs:string, $operation as xs:string) as item()* {

    let $a-processed := {$a-text}
    let $result-data := httpclient:get(xs:anyURI($request), false(), () )

    let $store := if ($operation eq 'run-store') then fcs-tests:store-result($target-key, $request-id, $result-data) else ()

    (: evaluate all xpaths defined for given request :)
    let $check := for $xpath in $test/xpath
                    let $evald := util:eval($xpath/text())

                    return

{if (exists($xpath/@key)) then xs:string($xpath/@key) else $xpath/text()}:
                          {$evald}

     (: checking extra for diagnostics :)
     let $http-status := $result-data//xs:string(@statusCode)
     let $diag := ($result-data//diag:diagnostic, $result-data//exception,
                if ($http-status ne '200') then <http-status>{$http-status}</http-status> else ())
      let $wrapped-diag := if (exists($diag)) then
                <diagnostics type="{string-join($diag/name(),',')}" >{$diag}</diagnostics> else ()
return ($a-processed, $check, $wrapped-diag)
};

declare function fcs-tests:store-result($target as xs:string, $testset as xs:string, $result as node()) as item()* {
    fcs-tests:store-result ($target, $testset, "", $result)
};

declare function fcs-tests:store-result($target as xs:string, $testset as xs:string, $test as xs:string, $result as node()) as item()* {
(: create collection for results for one target :)
   let $create-coll := if (not(xmldb:collection-available(concat($fcs-tests:results-coll, $target)))) then
                           xmldb:create-collection($fcs-tests:results-coll, $target) else ()

  let $result-path := fcs-tests:get-result-paths($target, concat($testset, $test))

  let $store-result := repo-utils:store($result-path[1], $result-path[2], $result, true())

return $store-result
};

(:~ generates a html-view of the resulting testset
relies on repo-utils serialization function, expecting a stylesheet with the key: test2view
:)
declare function fcs-tests:format-result($result as node()) as item()* {

    if ($result[self::element(diagnostics)]) then

{$result/text()}

       else if (exists($result/testrun)) then
          repo-utils:serialise-as ($result, "html", "test", $fcs-tests:cr-config)
       else repo-utils:serialise-as ($result, "html", "test", $fcs-tests:cr-config)
              (: return quite empty html ??
                t:format-testResult($result) :)
};

(:~ generates the html-page displaying either the overview, or the result of selected testset
:)
declare function fcs-tests:display-page($target  as xs:string, $testset as xs:string, $operation) as item()* {

    let $result := fcs-tests:get-result($target, $testset)

    let $formatted-result := fcs-tests:format-result($result)
    let $opt := util:declare-option("exist:serialize", "media-type=text/html method=xhtml")
    return

            <title>FCS - test suite</title>
            <meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/>
             <link rel="stylesheet" type="text/css" href="tests.css" />
             <link rel="stylesheet" type="text/css" href="../../scripts/style/cmds-ui.css" />

FCS - test suite

                overview

            {if ($operation = 'overview') then fcs-tests:display-overview() else () }
            <form>
                targets<select name="target">
                    {
                    for $target-elem  in $fcs-tests:config//target
                        let $target-key := xs:string($target-elem/@key)
                        let $option :=  if ($target = $target-key) then
                                            <option selected="selected" value="{$target-key}" >{$target-key}</option>
                                         else
                                            <option value="{$target-key}" >{$target-key } </option>
                        return $option
                    }
                </select>
                test-set<select name="testset">
                    {
                    for $testset-elem in $fcs-tests:config//testset
                        let $testset-key := xs:string($testset-elem/@key)
                        let $option :=  if ($testset= $testset-key) then
                                            <option selected="selected" value="{$testset-key}" >{$testset-key}</option>
                                         else
                                            <option value="{$testset-key}" >{$testset-key}</option>
                        return $option
                    }
                </select>
                test-set
                    <select name="operation">
                       <option value="run" >{if ($operation = 'run') then attribute selected { "selected" } else ()} run</option>
                       <option value="run-store" >{if ($operation = 'run-store') then attribute selected { "selected" } else ()} run-store</option>
                       <option value="view" > {if ($operation = 'view') then attribute selected { "selected" } else ()} view</option>
                       <option value="overview" > {if ($operation = 'overview') then attribute selected { "selected" } else ()} overview</option>
                    </select>
                <input type="submit" value="View/Run" />
                </form>

{$formatted-result}

};

declare function fcs-tests:display-overview() as item()* {

	{for $target in $fcs-tests:config//target return {xs:string($target/@key)}	}

            {for $testset in $fcs-tests:config//testset
                    let $testset-key := $testset/xs:string(@key)
                    return

                        {$testset-key}
                        {for $target in $fcs-tests:config//target
                           let $target-key := $target/xs:string(@key)
                           let $test-result := fcs-tests:get-result($target-key , $testset-key )
                           let $root-elem := $test-result/*/name()
                           let $op := if ($test-result//diagnostic["result-unavailable" = xs:string(@key)]) then 'run' else 'view'
                           (: display number of all and failed tests in the testset, operates on the HTML produced during the test-run :)
                           let $view:= if ($test-result//diagnostic["result-unavailable" = xs:string(@key)]) then ()
                                       else
                                            let $show := if ($root-elem[1] eq 'testrun') then
                                                            {count($test-result//div[@class='test'][.//span[@class='value true']])}{"/"}
                                                                   {count($test-result//div[@class='test'][.//span[@class='value false']])}{"/"}
                                                                {count($test-result//div[@class='test'])}
                                                                {if (exists($test-result//diagnostics)) then !! else () }

                                                            else $root-elem
                                            return {$show}

                        return {$view} [run]
                        }

            }

};


Adding copyright notice

Adding copyright notice

(:
 :	Copyright 2010-2011 Mark Logic Corporation
 :
 :	Licensed under the Apache License, Version 2.0 (the "License");
 :	you may not use this file except in compliance with the License.
 :	You may obtain a copy of the License at
 :
 :	    http://www.apache.org/licenses/LICENSE-2.0
 :
 :	Unless required by applicable law or agreed to in writing, software
 :	distributed under the License is distributed on an "AS IS" BASIS,
 :	WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 :	See the License for the specific language governing permissions and
 :	limitations under the License.
 :
 :	@author Justin Makeig <jmakeig@marklogic.com>
 :
 :)
xquery version "1.0-ml";
module namespace http="http://marklogic.com/util/http";
import module namespace functx = "http://www.functx.com" at "/MarkLogic/functx/functx-1.0-nodoc-2007-01.xqy";
declare default function namespace "http://www.w3.org/2005/xpath-functions";
(:declare namespace http="xdmp:http";:)

(:
declare variable $http:status :=
	let $map as map:map := map:map();
	let $codes :=
	return
:)

declare function http:parse-params() (:as map:map?:) {
	let $params as map:map := map:map()
	let $_ := for $name in xdmp:get-request-field-names()
	return
		map:put($params, $name, xdmp:get-request-field($name))
	return $params
};

(:
declare function http:parse-request() as item()+ {
	(<request xmlns="xdmp:http">
		<url>{xdmp:get-request-url()}</url>
		<path>{xdmp:get-request-path()}</path>
		<method>{xdmp:get-request-method()}</method>
		<username>{xdmp:get-request-username()}</username>
		<address>{xdmp:get-request-client-address()}</address>
		<headers>{
			for $h in xdmp:get-request-header-names()
			return element {xs:QName($h)} {
				xdmp:get-request-header($h)
			}
		}</headers>
		<fields>{
			for $f in xdmp:get-request-field-names()
			return element {QName("xdmp:http", $f)} {
				xdmp:get-request-field($f)
			}
		}</fields>
	</request>,
	xdmp:get-request-body())
};
:)

(:~
 : Parses an Accept HTTP header into something like:
	<accept xmlns="http://marklogic.com/http">
		<variant order="1">
			<media-type>
				<type>text</type>
				plain
				<charset>utf-8</charset>
			</media-type>
			<quality>0.7</quality>
			<param name="foo">bar</param>
		</variant>
		<variant>

		</variant>
	</accept>
 :
 : @param $
 : @return
 :)
declare function http:parse-accept-header($header as xs:string?) as element(http:variants)? {
	if($header) then
		<http:variants>{
			for $t1 at $i in tokenize($header, '\s*,\s*')
			return <http:variant order={$i}>{
				for $t2 at $j in tokenize($t1, '\s*;\s*')
				return
					if($j eq 1) then
						<http:media-type>{
							let $media-type := tokenize($t2,'/')
							return (
								<http:type>{$media-type[1]}</http:type>,
								<http:sub-type>{$media-type[2]}</http:sub-type>
							)
						}</http:media-type>
					else
						let $t3 := tokenize($t2, '\s*=\s*')
						return
							if($t3[1] eq 'q') then <http:quality>{functx:trim($t3[2])}</http:quality>
							else <http:param name={$t3[1]}>{functx:trim($t3[2])}</http:param>
			}</http:variant>
		}</http:variants>
	else ()
};

declare function http:preferred-variant($accept as element(http:variant)*, $variants as element(http:variant)*) as element(http:variant)* {
	(:let $_ := xdmp:log($accept/http:variant[http:media-type/http:type eq "application" and http:media-type/http:sub-type eq "xml"]):)
	(:let $_ := xdmp:log($accept):)
	let $matches :=
		for $v in $variants
		(: TODO: Implement wildcard matching and ordering :)
		let $candidates := $accept
			[
				(http:media-type/http:type eq data($v/http:media-type/http:type) or
				"*" eq data(http:media-type/http:type))
				and
				(http:media-type/http:sub-type eq data($v/http:media-type/http:sub-type) or
				 "*" eq data(http:media-type/http:sub-type))
			]
		return
			for $c in $candidates
			return
				<match score="{(data($c/http:quality), 1.0)[1]}"
					is-wildcard="{count($c/http:media-type/(http:type|http:sub-type)[. eq "*"])}">
					{$v}
				</match>
	return (
		for $m in $matches
		order by xs:float($m/@score) descending,
			xs:int($m/@is-wildcard) ascending,
			xs:int($m/http:variant/@order) ascending
		return $m
	)[1]/http:variant
};

declare function http:variant-to-string($variant as element(http:variant)*) as xs:string? {
	for $v at $i in $variant
	return
		concat($v/http:media-type/http:type,'/',$v/http:media-type/http:sub-type)
};

declare function http:string-to-variant($string as xs:string*) as element(http:variant)* {
    for $variant in $string
    let $media-params := tokenize($variant, "\s*;\s*")
    let $types := tokenize($media-params[1], "/")
    return <http:variant>
			<http:media-type>
				<http:type>{$types[1]}</http:type>
				<http:sub-type>{$types[2]}</http:sub-type>
			</http:media-type>{
				for $param in subsequence($media-params, 2)
				let $equal := tokenize($param, "\s*=\s*")
				return <http:param name="{$equal[1]}">{$equal[2]}</http:param>
			}
		</http:variant>
};

(:
(
<response xmlns="xdmp:http">
  200
  <message>OK</message>
  <headers>
    <date>Wed, 20 Jan 2010 07:21:56 GMT</date>
    <server>Apache</server>
    <accept-ranges>bytes</accept-ranges>
    <cache-control>max-age=60, private, private</cache-control>
    <expires>Wed, 20 Jan 2010 07:22:52 GMT</expires>
    <content-type>text/html</content-type>
    <vary>User-Agent,Accept-Encoding</vary>
    <content-length>108906</content-length>
    <connection>close</connection>
  </headers>
</response>,
...body...
)
:)

(:
declare function http:prepare-response($response as item()+) as item() {
	let $meta as element(http:response) := $response[1]/http:response
	let $body as item()? := $response[2]
	return (
		xdmp:set-response-code(xs:int($meta/http:code), data($meta/http:message)),
		for $h in $response/http:headers/http:*
		return xdmp:add-response-header(local-name($h), data($h)),
		$response[2]
	)
};
:)


[bugfix] wrong header links in documentation search results

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

xquery version "1.0";

(:~ ================================================
    Implements the documentation search.
    ================================================ :)
import module namespace xdb="http://exist-db.org/xquery/xmldb";

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

import module namespace setup="http://exist-db.org/xquery/docs/setup" at "docsetup.xql";

declare namespace dq="http://exist-db.org/xquery/documentation";

declare option exist:serialize "method=html media-type=text/html expand-xincludes=yes";

declare variable $dq:COLLECTION := "xqdocs";

declare variable $dq:FIELDS :=
	<fields>
		<field name="title">section[ft:query(.//title, '$q')]</field>
		<field>section[ft:query(., '$q')]</field>
	</fields>;

declare variable $dq:CHARS_SUMMARY := 120;
declare variable $dq:CHARS_KWIC := 40;

(:~
	Display the hits: this function iterates through all hits and calls
	kwic:summarize to print out a summary of each match.
:)
declare function dq:print($hit as element(), $docXPath as xs:string, $mode as xs:string)
as element()* {
    let $nodeId := util:node-id($hit)
	let $uri := concat(
		"../", util:document-name(root($hit)), "?q=",
		(: "docs.xql?path=", document-uri(root($hit)), "&q=", :)
		escape-uri($docXPath, true()), "&id=", $nodeId, "#", $nodeId
	)
	let $config :=
		<config xmlns="" width="{if ($mode eq 'summary') then $dq:CHARS_SUMMARY else $dq:CHARS_KWIC}"
			table="{if ($mode eq 'summary') then 'no' else 'yes'}"
			link="{$uri}"/>

    let $matches := kwic:get-matches($hit)
    for $ancestor in $matches/ancestor::para | $matches/ancestor::title | $matches/ancestor::td
    return
        kwic:get-summary($ancestor, ($ancestor//exist:match)[1], $config)
};

(:~
	Print the hierarchical context of a hit.
:)
declare function dq:print-headings($section as element(section)*, $docXPath as xs:string) {
	$section/ancestor::chapter/title//text(),
	for $s at $p in $section/ancestor-or-self::section
	let $nodeId := util:node-id($s)
	let $uri := concat("../",
		util:document-name(root($s)), "?q=",
		escape-uri($docXPath, true()), "&id=", $nodeId, "#", $nodeId
	)
	return
		(" > ", {$s/title//text()})
};

(:~
	Display the query results.
:)
declare function dq:print-results($hits as element()*, $docXPath as xs:string) {
	let $mode := request:get-parameter("view", "summary")
	return

Found: {count($hits)}.

			{
				if ($mode eq 'summary') then
					for $section in $hits
					let $score := ft:score($section)
					order by $score descending
					return

					        Score: {round-half-to-even($score, 2)}

{ dq:print-headings($section, $docXPath) }

							{ dq:print($section, $docXPath, $mode) }

				else

					{
						for $section in $hits
						order by ft:score($section) descending
						return (

								{dq:print-headings($section, $docXPath)}

,
							dq:print($section, $docXPath, $mode)
						)
					}

			}

};

(:~
	Process the query.
:)
declare function dq:query() {
	let $query := request:get-parameter("q", ())
	let $field := request:get-parameter("field", "all")
	return
		if ($query) then
			let $fields :=
				if ($field ne "all") then $dq:FIELDS/field[@name = $field] else $dq:FIELDS/field
			let $queryParts :=
			    for $f in $fields return
			        replace($f, "\$q", $query)
			let $xpath := string-join(
				for $p in $queryParts return
					concat("collection('/db/", $dq:COLLECTION, "')//", $p),
				" | "
			)
			let $log := util:log("DEBUG", ("Query: ", $xpath))
			let $docXPath := string-join(for $p in $queryParts return concat(".//", $p), " or ")
			let $hits := util:eval($xpath)
			return
				dq:print-results($hits, $docXPath)
		else
			()
};

(:~
    Return the main XML page, which will be transformed into HTML by Cocoon.
    If Javascript is enabled on the client, this function will only be called
    once. All subsequent calls to this script will be made via AJAX and we don't
    need to return the entire page.
:)
declare function dq:get-page($action as xs:string?, $askPass as xs:boolean)
as element() {
    <book>
        <bookinfo>
            <graphic fileref="logo.jpg"/>

            <productname>Open Source Native XML Database</productname>
            <title>Documentation Search</title>
            <link rel="stylesheet" type="text/css" href="styles/docsearch.css"/>

xquery version "1.0";

(:~ ================================================
    Implements the documentation search.
    ================================================ :)
import module namespace xdb="http://exist-db.org/xquery/xmldb";

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

import module namespace setup="http://exist-db.org/xquery/docs/setup" at "docsetup.xql";

declare namespace dq="http://exist-db.org/xquery/documentation";

declare option exist:serialize "method=html media-type=text/html expand-xincludes=yes";

declare variable $dq:COLLECTION := "xqdocs";

declare variable $dq:FIELDS :=
	<fields>
		<field name="title">section[ft:query(.//title, '$q')]</field>
		<field>section[ft:query(., '$q')]</field>
	</fields>;

declare variable $dq:CHARS_SUMMARY := 120;
declare variable $dq:CHARS_KWIC := 40;

(:~
	Display the hits: this function iterates through all hits and calls
	kwic:summarize to print out a summary of each match.
:)
declare function dq:print($hit as element(), $docXPath as xs:string, $mode as xs:string)
as element()* {
    let $nodeId := util:node-id($hit)
	let $uri := concat(
		"../", util:document-name(root($hit)), "?q=",
		(: "docs.xql?path=", document-uri(root($hit)), "&q=", :)
		escape-uri($docXPath, true()), "&id=", $nodeId, "#", $nodeId
	)
	let $config :=
		<config xmlns="" width="{if ($mode eq 'summary') then $dq:CHARS_SUMMARY else $dq:CHARS_KWIC}"
			table="{if ($mode eq 'summary') then 'no' else 'yes'}"
			link="{$uri}"/>

    let $matches := kwic:get-matches($hit)
    for $ancestor in $matches/ancestor::para | $matches/ancestor::title | $matches/ancestor::td
    return
        kwic:get-summary($ancestor, ($ancestor//exist:match)[1], $config)
};

(:~
	Print the hierarchical context of a hit.
:)
declare function dq:print-headings($section as element(section)*, $docXPath as xs:string) {
	$section/ancestor::chapter/title//text(),
	for $s at $p in $section/ancestor-or-self::section
	let $nodeId := util:node-id($s)
	let $uri := concat(
		util:document-name(root($s)), "?q=",
		escape-uri($docXPath, true()), "&id=", $nodeId, "#", $nodeId
	)
	return
		(" > ", {$s/title//text()})
};

(:~
	Display the query results.
:)
declare function dq:print-results($hits as element()*, $docXPath as xs:string) {
	let $mode := request:get-parameter("view", "summary")
	return

Found: {count($hits)}.

			{
				if ($mode eq 'summary') then
					for $section in $hits
					let $score := ft:score($section)
					order by $score descending
					return

					        Score: {round-half-to-even($score, 2)}

{ dq:print-headings($section, $docXPath) }

							{ dq:print($section, $docXPath, $mode) }

				else

					{
						for $section in $hits
						order by ft:score($section) descending
						return (

								{dq:print-headings($section, $docXPath)}

,
							dq:print($section, $docXPath, $mode)
						)
					}

			}

};

(:~
	Process the query.
:)
declare function dq:query() {
	let $query := request:get-parameter("q", ())
	let $field := request:get-parameter("field", "all")
	return
		if ($query) then
			let $fields :=
				if ($field ne "all") then $dq:FIELDS/field[@name = $field] else $dq:FIELDS/field
			let $queryParts :=
			    for $f in $fields return
			        replace($f, "\$q", $query)
			let $xpath := string-join(
				for $p in $queryParts return
					concat("collection('/db/", $dq:COLLECTION, "')//", $p),
				" | "
			)
			let $log := util:log("DEBUG", ("Query: ", $xpath))
			let $docXPath := string-join(for $p in $queryParts return concat(".//", $p), " or ")
			let $hits := util:eval($xpath)
			return
				dq:print-results($hits, $docXPath)
		else
			()
};

(:~
    Return the main XML page, which will be transformed into HTML by Cocoon.
    If Javascript is enabled on the client, this function will only be called
    once. All subsequent calls to this script will be made via AJAX and we don't
    need to return the entire page.
:)
declare function dq:get-page($action as xs:string?, $askPass as xs:boolean)
as element() {
    <book>
        <bookinfo>
            <graphic fileref="logo.jpg"/>

            <productname>Open Source Native XML Database</productname>
            <title>Documentation Search</title>
            <link rel="stylesheet" type="text/css" href="styles/docsearch.css"/>


Don't check %private variables.

Don't check %private variables.

xquery version "3.0";

import module namespace file = "http://expath.org/ns/file";
import module namespace xqd = "http://www.zorba-xquery.com/modules/xqdoc";
import module namespace fetch = "http://www.zorba-xquery.com/modules/fetch";

import schema namespace xqdoc = "http://www.xqdoc.org/1.0";

declare namespace ann = "http://www.zorba-xquery.com/annotations";
declare namespace err = "http://www.w3.org/2005/xqt-errors";
declare namespace zm = "http://www.zorba-xquery.com/manifest";

declare copy-namespaces preserve, inherit;

(:~
 : This variable contains the path to ZorbaManifestPath.xml
 :)
declare variable $ZorbaManifestPath as xs:string external;

declare %private %ann:nondeterministic function local:load-manifest()
{
  try
  {
    fn:parse-xml(file:read-text($ZorbaManifestPath))
  }
  catch *
  {
    fn:error(fn:concat("The file <",$ZorbaManifestPath,"> does not have the correct structure."))
  }
};

(:~
 : This function generates the XQDoc XML for all correctly configured in Zorba
 : (in other words all modules present in ZorbaManifest.xml) and checks if the modules are correctly documented.
 :
 :)
declare %ann:sequential function local:testXQDoc() as xs:string?
{
  if(not(file:is-file($ZorbaManifestPath))) then
  {
    variable $message := fn:concat("The file <ZorbaManifest.xml> was not found: <", $ZorbaManifestPath, ">. Suggestion: run 'cmake' in your build folder such that ZorbaManifest.xml is regenerated.");
    fn:error($message)
  }
  else
  {
    variable $manifestXML := local:load-manifest();
    variable $moduleManifests := $manifestXML/zm:manifest/zm:module;
    variable $res :=
    if(count($moduleManifests) eq xs:integer(0)) then ()
    else
    {
      for $module in $moduleManifests
      let $moduleURI := if(ends-with(data($module/zm:uri),".xq")) then substring-before(data($module/zm:uri),".xq") else data($module/zm:uri)
      let $moduleFetched := fetch:content($moduleURI, "MODULE")
      return
      try {
          let $xqdoc := xqd:xqdoc-content($moduleFetched)/self::xqdoc:xqdoc
          let $moduleUri := data($xqdoc/xqdoc:module/xqdoc:uri)
          return string-join(
             if(($moduleUri = "http://www.w3.org/2005/xpath-functions") or
                ($moduleUri = "http://www.w3.org/2005/xpath-functions/math") or
                ($moduleUri = "http://www.functx.com/") or
                ($moduleUri = "http://www.w3.org/2005/xqt-errors") or
                ($moduleUri = "http://zorba.io/modules/zorba-errors") or
                ($moduleUri = "http://zorba.io/modules/zorba-warnings") or
                ($moduleUri = "http://jsoniq.org/errors") or
                ($moduleUri = "http://www.zorba-xquery.com/modules/xqdoc/batch") or
                ($moduleUri = "http://www.zorba-xquery.com/modules/xqdoc/menu") or
                ($moduleUri = "http://www.zorba-xquery.com/modules/xqdoc/html")) then ()
            else(
            local:test-module($xqdoc),
            local:test-functions($xqdoc),
            local:test-variables($xqdoc)
          ),"")
      }
      catch *
      {
        fn:concat("ERROR: ", $err:code,
                  " Message: ", $err:description,
                  " Line: ", $err:line-number, "
processing module: ", $moduleURI)
      }
    };

    fn:string-join($res,"")
  }
};

declare function local:test-module($xqdoc as element(xqdoc:xqdoc)) as xs:string?
{
  let $module := $xqdoc/xqdoc:module/xqdoc:comment
  let $moduleUri := $xqdoc/xqdoc:module/xqdoc:uri
  let $hasDescription := exists($module/xqdoc:description)
  let $hasAuthor := exists($module/xqdoc:author)
  let $hasXQueryVersion := exists($xqdoc/xqdoc:module/xqdoc:comment/xqdoc:custom[@tag="XQuery version"])

  return string-join((
    (: Test for module description :)
    if (not($hasDescription)) then
      concat("
    ERROR: Missing module description
    Module: ", $xqdoc/xqdoc:module/xqdoc:uri)
    else
      ()
    ,
    (: Test for module author :)
    if (fn:not($hasAuthor)) then
      fn:concat("
    ERROR: Missing module author name
    Module: ", $xqdoc/xqdoc:module/xqdoc:uri)
    else
      ()
      ,
    (: Test for explicit XQuery Version :)
    if(($moduleUri = "http://www.w3.org/2005/xpath-functions") or
       ($moduleUri = "http://www.w3.org/2005/xpath-functions/math") or
       ($moduleUri = "http://www.functx.com/")) then ()
    else
      if (fn:not($hasXQueryVersion)) then
      fn:concat("
    ERROR: Missing explicit XQuery version declaration in prolog
    Module: ", $xqdoc/xqdoc:module/xqdoc:uri)
    else
      ()
  ),"")
};

declare function local:test-functions(
  $xqdoc as element(xqdoc:xqdoc)
)as xs:string?
{
    let $module := $xqdoc/xqdoc:module
    return
      string-join(for $function in $xqdoc/xqdoc:functions/xqdoc:function
      where not(exists($function//xqdoc:annotation[@localname = 'private']))
      return local:test-function($module, $function),"")
};

declare function local:test-function(
  $module as element(xqdoc:module),
  $function as element(xqdoc:function)
) as xs:string {
    let $signature := $function/xqdoc:signature
    let $paramCount := count(tokenize($signature, "\$")) - 1
    let $params := $function/xqdoc:comment/xqdoc:param
    let $docParamCount := count($params)
    let $missing := $paramCount - $docParamCount
    let $hasDescr := exists($function/xqdoc:comment/xqdoc:description)
    let $hasReturn := exists($function/xqdoc:return)
    let $isUpdating := contains($signature, "updating")
    let $isReturnDocumented := exists($function/xqdoc:comment/xqdoc:return)
    return string-join((
        (: Test for function description :)
        if (not($hasDescr)) then
            concat("
    ERROR: Missing function description
    Module: ", $module/xqdoc:uri, "
    Function: ", $function/xqdoc:name, "
    Arity: ", $paramCount)
        else
            (),
        (: Test for documented parameters :)
        if ($docParamCount ne $paramCount) then
            concat("
    ERROR: ", $missing, " parameter(s) not documented
    Module: ", $module/xqdoc:uri, "
    Function: ", $function/xqdoc:name, "
    Arity: ", $paramCount)
        else
            (),
        (: Test for existing return value in function signature:)
        if (not($hasReturn) and not($isUpdating)) then
            concat("
    ERROR: Return value for the function not stated explicitly in the function signature;
    Module: ", $module/xqdoc:uri, "
    Function: ", $function/xqdoc:name, "
    Arity: ", $paramCount)
        else
            (),
        (: Test for documented return value :)
        if (not($isReturnDocumented)) then
            concat("
    ERROR: Return value not documented;
    Module: ", $module/xqdoc:uri, "
    Function: ", $function/xqdoc:name, "
    Arity: ", $paramCount)
        else
            ()
    ),"")
};

declare function local:test-variables(
  $xqdoc as element(xqdoc:xqdoc)
) as xs:string?
{
    let $module := $xqdoc/xqdoc:module
    let $moduleUri := $module/xqdoc:uri
    return
      string-join(for $variable in $xqdoc/xqdoc:variables/xqdoc:variable
      where not(exists($variable//xqdoc:annotation[@localname = 'private']))
      return local:test-variable($module, $variable),"")
};

declare function local:test-variable(
  $module as element(xqdoc:module),
  $variable as element(xqdoc:variable)
) as xs:string?
{
    let $hasDescr := exists($variable/xqdoc:comment/xqdoc:description)
    return
        (: Test for variable description :)
       (if (not($hasDescr)) then
            concat("
    ERROR: Missing variable description
    Module: ", $module/xqdoc:uri, "
    Variable: ", $variable/xqdoc:uri)
        else
            ())
};

variable $errors as xs:string := local:testXQDoc();

variable $errorsCount := count(fn:analyze-string($errors,"ERROR:")//fn:match);

if ($errorsCount = 0) then
"CONGRATULATIONS! You've got a Schnitzel!"
else
        concat("
------------------------------------------------
ERROR COUNT: ", xs:string($errorsCount), "
------------------------------------------------
",$errors)

xquery version "3.0";

import module namespace file = "http://expath.org/ns/file";
import module namespace xqd = "http://www.zorba-xquery.com/modules/xqdoc";
import module namespace fetch = "http://www.zorba-xquery.com/modules/fetch";

import schema namespace xqdoc = "http://www.xqdoc.org/1.0";

declare namespace ann = "http://www.zorba-xquery.com/annotations";
declare namespace err = "http://www.w3.org/2005/xqt-errors";
declare namespace zm = "http://www.zorba-xquery.com/manifest";

declare copy-namespaces preserve, inherit;

(:~
 : This variable contains the path to ZorbaManifestPath.xml
 :)
declare variable $ZorbaManifestPath as xs:string external;

declare %private %ann:nondeterministic function local:load-manifest()
{
  try
  {
    fn:parse-xml(file:read-text($ZorbaManifestPath))
  }
  catch *
  {
    fn:error(fn:concat("The file <",$ZorbaManifestPath,"> does not have the correct structure."))
  }
};

(:~
 : This function generates the XQDoc XML for all correctly configured in Zorba
 : (in other words all modules present in ZorbaManifest.xml) and checks if the modules are correctly documented.
 :
 :)
declare %ann:sequential function local:testXQDoc() as xs:string?
{
  if(not(file:is-file($ZorbaManifestPath))) then
  {
    variable $message := fn:concat("The file <ZorbaManifest.xml> was not found: <", $ZorbaManifestPath, ">. Suggestion: run 'cmake' in your build folder such that ZorbaManifest.xml is regenerated.");
    fn:error($message)
  }
  else
  {
    variable $manifestXML := local:load-manifest();
    variable $moduleManifests := $manifestXML/zm:manifest/zm:module;
    variable $res :=
    if(count($moduleManifests) eq xs:integer(0)) then ()
    else
    {
      for $module in $moduleManifests
      let $moduleURI := if(ends-with(data($module/zm:uri),".xq")) then substring-before(data($module/zm:uri),".xq") else data($module/zm:uri)
      let $moduleFetched := fetch:content($moduleURI, "MODULE")
      return
      try {
          let $xqdoc := xqd:xqdoc-content($moduleFetched)/self::xqdoc:xqdoc
          let $moduleUri := data($xqdoc/xqdoc:module/xqdoc:uri)
          return string-join(
             if(($moduleUri = "http://www.w3.org/2005/xpath-functions") or
                ($moduleUri = "http://www.w3.org/2005/xpath-functions/math") or
                ($moduleUri = "http://www.functx.com/") or
                ($moduleUri = "http://www.w3.org/2005/xqt-errors") or
                ($moduleUri = "http://zorba.io/modules/zorba-errors") or
                ($moduleUri = "http://zorba.io/modules/zorba-warnings") or
                ($moduleUri = "http://jsoniq.org/errors") or
                ($moduleUri = "http://www.zorba-xquery.com/modules/xqdoc/batch") or
                ($moduleUri = "http://www.zorba-xquery.com/modules/xqdoc/menu") or
                ($moduleUri = "http://www.zorba-xquery.com/modules/xqdoc/html")) then ()
            else(
            local:test-module($xqdoc),
            local:test-functions($xqdoc),
            local:test-variables($xqdoc)
          ),"")
      }
      catch *
      {
        fn:concat("ERROR: ", $err:code,
                  " Message: ", $err:description,
                  " Line: ", $err:line-number, "
processing module: ", $moduleURI)
      }
    };

    fn:string-join($res,"")
  }
};

declare function local:test-module($xqdoc as element(xqdoc:xqdoc)) as xs:string?
{
  let $module := $xqdoc/xqdoc:module/xqdoc:comment
  let $moduleUri := $xqdoc/xqdoc:module/xqdoc:uri
  let $hasDescription := exists($module/xqdoc:description)
  let $hasAuthor := exists($module/xqdoc:author)
  let $hasXQueryVersion := exists($xqdoc/xqdoc:module/xqdoc:comment/xqdoc:custom[@tag="XQuery version"])

  return string-join((
    (: Test for module description :)
    if (not($hasDescription)) then
      concat("
    ERROR: Missing module description
    Module: ", $xqdoc/xqdoc:module/xqdoc:uri)
    else
      ()
    ,
    (: Test for module author :)
    if (fn:not($hasAuthor)) then
      fn:concat("
    ERROR: Missing module author name
    Module: ", $xqdoc/xqdoc:module/xqdoc:uri)
    else
      ()
      ,
    (: Test for explicit XQuery Version :)
    if(($moduleUri = "http://www.w3.org/2005/xpath-functions") or
       ($moduleUri = "http://www.w3.org/2005/xpath-functions/math") or
       ($moduleUri = "http://www.functx.com/")) then ()
    else
      if (fn:not($hasXQueryVersion)) then
      fn:concat("
    ERROR: Missing explicit XQuery version declaration in prolog
    Module: ", $xqdoc/xqdoc:module/xqdoc:uri)
    else
      ()
  ),"")
};

declare function local:test-functions(
  $xqdoc as element(xqdoc:xqdoc)
)as xs:string?
{
    let $module := $xqdoc/xqdoc:module
    return
      string-join(for $function in $xqdoc/xqdoc:functions/xqdoc:function
      where not(exists($function//xqdoc:annotation[@localname = 'private']))
      return local:test-function($module, $function),"")
};

declare function local:test-function(
  $module as element(xqdoc:module),
  $function as element(xqdoc:function)
) as xs:string {
    let $signature := $function/xqdoc:signature
    let $paramCount := count(tokenize($signature, "\$")) - 1
    let $params := $function/xqdoc:comment/xqdoc:param
    let $docParamCount := count($params)
    let $missing := $paramCount - $docParamCount
    let $hasDescr := exists($function/xqdoc:comment/xqdoc:description)
    let $hasReturn := exists($function/xqdoc:return)
    let $isUpdating := contains($signature, "updating")
    let $isReturnDocumented := exists($function/xqdoc:comment/xqdoc:return)
    return string-join((
        (: Test for function description :)
        if (not($hasDescr)) then
            concat("
    ERROR: Missing function description
    Module: ", $module/xqdoc:uri, "
    Function: ", $function/xqdoc:name, "
    Arity: ", $paramCount)
        else
            (),
        (: Test for documented parameters :)
        if ($docParamCount ne $paramCount) then
            concat("
    ERROR: ", $missing, " parameter(s) not documented
    Module: ", $module/xqdoc:uri, "
    Function: ", $function/xqdoc:name, "
    Arity: ", $paramCount)
        else
            (),
        (: Test for existing return value in function signature:)
        if (not($hasReturn) and not($isUpdating)) then
            concat("
    ERROR: Return value for the function not stated explicitly in the function signature;
    Module: ", $module/xqdoc:uri, "
    Function: ", $function/xqdoc:name, "
    Arity: ", $paramCount)
        else
            (),
        (: Test for documented return value :)
        if (not($isReturnDocumented)) then
            concat("
    ERROR: Return value not documented;
    Module: ", $module/xqdoc:uri, "
    Function: ", $function/xqdoc:name, "
    Arity: ", $paramCount)
        else
            ()
    ),"")
};

declare function local:test-variables(
  $xqdoc as element(xqdoc:xqdoc)
) as xs:string?
{
    let $module := $xqdoc/xqdoc:module
    let $moduleUri := $module/xqdoc:uri
    return
      string-join(for $variable in $xqdoc/xqdoc:variables/xqdoc:variable
      return local:test-variable($module, $variable),"")
};

declare function local:test-variable(
  $module as element(xqdoc:module),
  $variable as element(xqdoc:variable)
) as xs:string?
{
    let $hasDescr := exists($variable/xqdoc:comment/xqdoc:description)
    return
        (: Test for variable description :)
       (if (not($hasDescr)) then
            concat("
    ERROR: Missing variable description
    Module: ", $module/xqdoc:uri, "
    Variable: ", $variable/xqdoc:uri)
        else
            ())
};

variable $errors as xs:string := local:testXQDoc();

variable $errorsCount := count(fn:analyze-string($errors,"ERROR:")//fn:match);

if ($errorsCount = 0) then
"CONGRATULATIONS! You've got a Schnitzel!"
else
        concat("
------------------------------------------------
ERROR COUNT: ", xs:string($errorsCount), "
------------------------------------------------
",$errors)


[betterform]  fixed JavaScript imports

[betterform]  fixed JavaScript imports

svn path=/stable/eXist-1.4.x/; revision=15419

xquery version "1.0";
declare option exist:serialize "method=xhtml media-type=application/xhtml+html";

let $contextPath := request:get-context-path()
return

        <title>betterFORM Demo XForms: Address, Registration, FeatureExplorer</title>
        <link rel="stylesheet" type="text/css" href="./resources/InlineRoundBordersAlert.css"/>
        <link rel="stylesheet" type="text/css" href="./resources/timetracker.css"/>

                <xf:model id="model-1">
                    <xf:instance>
                        <data xmlns="">
                            <from>2000-01-01</from>
                            <to>2000-01-02</to>
                            <project/>
                            <billable/>
                            <billed/>
                        </data>
                    </xf:instance>
                    <xf:bind nodeset="from" type="xf:date"/>
                    <xf:bind nodeset="to" type="xf:date" />

                    <xf:submission id="s-query-tasks"
                                    resource="{$contextPath}/rest/db/betterform/apps/timetracker/views/list-items.xql"
                                    method="get"
                                    replace="embedHTML"
                                    targetid="embedInline"
                                    ref="instance()"
                                    validate="false">
                        <xf:action ev:event="xforms-submit-error">
                            <xf:message>Submission failed</xf:message>
                        </xf:action>
                    </xf:submission>

                    <xf:submission id="s-delete-task"
                                    method="delete"
                                    replace="none"
                                    validate="false">
                        <xf:resource value="concat('{$contextPath}/rest/db/betterform/apps/timetracker/data/task/',instance('i-vars')/currentTask,'.xml')"/>
                        <xf:header>
                            <xf:name>username</xf:name>
                            <xf:value>admin</xf:value>
                        </xf:header>
                        <xf:header>
                            <xf:name>password</xf:name>
                            <xf:value></xf:value>
                        </xf:header>
                        <xf:header>
                            <xf:name>realm</xf:name>
                            <xf:value>exist</xf:value>
                        </xf:header>

                        <xf:action ev:event="xforms-submit-done">

                            <xf:message level="ephemeral">Entry has been removed</xf:message>
                        </xf:action>
                    </xf:submission>

                    <xf:instance id="i-project" src="{$contextPath}/rest/db/betterform/apps/timetracker/data/project.xml" />

                    <xf:instance id="i-vars">
                        <data xmlns="">
                            <default-duration>120</default-duration>
                            <currentTask/>
                            <selectedTasks/>
                        </data>
                    </xf:instance>
                    <xf:bind nodeset="instance('i-vars')/default-duration" type="xf:integer"/>

                    <xf:submission  id="s-update-billed"
                                    ref="instance('i-vars')/selectedTasks"
                                    method="post"
                                    replace="new"
                                    resource="{$contextPath}/rest/db/betterform/apps/timetracker/reports/timeAndEffort.xql">
                                    <xf:message ev:event="xforms-submit">here it comes...</xf:message>
                    </xf:submission>

                    <xf:action ev:event="xforms-ready">
                        <xf:setvalue ref="to" value="substring(local-date(), 1, 10)"/>
                        <xf:recalculate/>

                        <xf:setvalue ref="from" value="'2010-01-01'"/>
                    </xf:action>

                </xf:model>

                <xf:trigger id="overviewTrigger">
                    <xf:label>Overview</xf:label>
                    <xf:send submission="s-query-tasks"/>
                </xf:trigger>

                <xf:trigger id="addTask">
                    <xf:label>new</xf:label>
                    <xf:action>
                        <xf:load show="embed" targetid="embedDialog">
                            <xf:resource
                                    value="'{$contextPath}/rest/db/betterform/apps/timetracker/edit/edit-item.xql#xforms'"/>
                        </xf:load>
                    </xf:action>
                </xf:trigger>

                <xf:trigger id="editTask">
                    <xf:label>new</xf:label>
                    <xf:action>
                        <xf:load show="embed" targetid="embedDialog">
                            <xf:resource value="concat('{$contextPath}/rest/db/betterform/apps/timetracker/edit/edit-item.xql#xforms?timestamp=',instance('i-vars')/currentTask)"/>
                        </xf:load>
                    </xf:action>
                </xf:trigger>

                <xf:trigger id="deleteTask">
                    <xf:label>delete</xf:label>
                    <xf:send submission="s-delete-task"/>
                </xf:trigger>

                <xf:input id="currentTask" ref="instance('i-vars')/currentTask">
                    <xf:label>This is just a dummy used by JS</xf:label>
                </xf:input>

                <xf:input id="selectedTaskIds" ref="instance('i-vars')/selectedTasks">
                    <xf:label>This is another dummy allowing to pass all selected tasks into an instance</xf:label>
                    <xf:send submission="s-update-billed" ev:event="xforms-value-changed"/>
                </xf:input>

Timetracker

                        Filter

                                        <xf:input ref="from" incremental="true">
                                            <xf:label>from</xf:label>
                                            <xf:action ev:event="xforms-value-changed">
                                                <xf:dispatch name="DOMActivate" targetid="overviewTrigger"/>
                                            </xf:action>
                                        </xf:input>

                                        <xf:input ref="to" incremental="true">
                                            <xf:label>to</xf:label>
                                            <xf:action ev:event="xforms-value-changed">
                                                <xf:dispatch  name="DOMActivate" targetid="overviewTrigger"/>
                                            </xf:action>
                                        </xf:input>

                                        <xf:select1 ref="project" appearance="minimal" incremental="true">
                                            <xf:label>Project</xf:label>
                                            <xf:action ev:event="xforms-value-changed">
                                                <xf:dispatch  name="DOMActivate" targetid="overviewTrigger"/>
                                            </xf:action>
                                            <xf:itemset nodeset="instance('i-project')/*">
                                                <xf:label ref="."/>
                                                <xf:value ref="."/>
                                            </xf:itemset>
                                        </xf:select1>

                                        <xf:select1 ref="billable" appearance="minimal" incremental="true">
                                            <xf:label>Billable</xf:label>
                                            <xf:action ev:event="xforms-value-changed">
                                                <xf:dispatch  name="DOMActivate" targetid="overviewTrigger"/>
                                            </xf:action>
                                            <xf:item>
                                                <xf:label>yes</xf:label>
                                                <xf:value>true</xf:value>
                                            </xf:item>
                                            <xf:item>
                                                <xf:label>no</xf:label>
                                                <xf:value>false</xf:value>
                                            </xf:item>
                                        </xf:select1>

                                        <xf:select1 ref="billed" appearance="minimal" incremental="true">
                                            <xf:label>Billed</xf:label>
                                            <xf:action ev:event="xforms-value-changed">
                                                <xf:dispatch  name="DOMActivate" targetid="overviewTrigger"/>
                                            </xf:action>
                                            <xf:item>
                                                <xf:label>not billed yet</xf:label>
                                                <xf:value>false</xf:value>
                                            </xf:item>
                                            <xf:item>
                                                <xf:label>already billed</xf:label>
                                                <xf:value>true</xf:value>
                                            </xf:item>
                                        </xf:select1>

                                        <xf:trigger id="closeFilter">
                                            <xf:label/>

                                        </xf:trigger>

                        New Task

                        Search

                        Settings

                        About

                    <xf:output value="concat(from,' - ',to)" id="durationLabel">
                        <xf:label/>
                    </xf:output>


[FIX] DBA, Sessions Panel: Kill Sessions. Closes #1811

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

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

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

(:~
 : Sessions page.
 : @param  $sort   table sort key
 : @param  $error  error message
 : @param  $info   info message
 : @return page
 :)
declare
  %rest:GET
  %rest:path('/dba/sessions')
  %rest:query-param('sort',  '{$sort}', 'access')
  %rest:query-param('error', '{$error}')
  %rest:query-param('info',  '{$info}')
  %output:method('html')
function dba:sessions(
  $sort   as xs:string,
  $error  as xs:string?,
  $info   as xs:string?
) as element(html) {
  html:wrap(map { 'header': $dba:CAT, 'info': $info, 'error': $error },

        <form action='{ $dba:CAT }' method='post' class='update'>

Web Sessions

        {
          let $headers := (
            map { 'key': 'id', 'label': 'ID', 'type': 'id' },
            map { 'key': 'name', 'label': 'Name' },
            map { 'key': 'value', 'label': 'Value' },
            map { 'key': 'access', 'label': 'Last Access', 'type': 'dateTime', 'order': 'desc' },
            map { 'key': 'you', 'label': 'You' }
          )
          let $entries :=
            for $id in sessions:ids()
            let $access := sessions:accessed($id)
            let $you := if(session:id() = $id) then '✓' else '–'
            (: supported session ids (application-specific, can be extended) :)
            for $name in sessions:names($id)[. = ($config:SESSION-KEY, 'id')]
            let $value := try {
              sessions:get($id, $name)
            } catch sessions:get {
              '–' (: non-XQuery session value :)
            }
            let $string := util:chop(serialize($value, map { 'method': 'basex' }), 20)
            order by $access descending
            return map {
              'id': $id || '|' || $name,
              'name': $name,
              'value': $string,
              'access': $access,
              'you': $you
            }
          let $buttons := (
            html:button('session-kill', 'Kill', true())
          )
          let $options := map { 'sort': $sort, 'presort': 'access' }
          return html:table($headers, $entries, $buttons, map { }, $options)
        }
        </form>

Database Sessions

        {
          let $headers := (
            map { 'key': 'address', 'label': 'Address' },
            map { 'key': 'user', 'label': 'User' }
          )
          let $entries := admin:sessions() ! map {
            'address': @address,
            'user': @user
          }
          return html:table($headers, $entries, (), map { }, map { })
        }

  )
};

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

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

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

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

(:~
 : Sessions page.
 : @param  $sort   table sort key
 : @param  $error  error message
 : @param  $info   info message
 : @return page
 :)
declare
  %rest:GET
  %rest:path('/dba/sessions')
  %rest:query-param('sort',  '{$sort}', 'access')
  %rest:query-param('error', '{$error}')
  %rest:query-param('info',  '{$info}')
  %output:method('html')
function dba:sessions(
  $sort   as xs:string,
  $error  as xs:string?,
  $info   as xs:string?
) as element(html) {
  html:wrap(map { 'header': $dba:CAT, 'info': $info, 'error': $error },

        <form action='{ $dba:CAT }' method='post' class='update'>

Web Sessions

        {
          let $headers := (
            map { 'key': 'name', 'label': 'Name' },
            map { 'key': 'value', 'label': 'Value' },
            map { 'key': 'access', 'label': 'Last Access', 'type': 'dateTime', 'order': 'desc' },
            map { 'key': 'you', 'label': 'You' },
            map { 'key': 'id', 'label': 'ID', 'type': 'id' }
          )
          let $entries :=
            for $id in sessions:ids()
            let $access := sessions:accessed($id)
            let $you := if(session:id() = $id) then '✓' else '–'
            (: supported session ids (application-specific, can be extended) :)
            for $name in sessions:names($id)[. = ($config:SESSION-KEY, 'id')]
            let $value := try {
              sessions:get($id, $name)
            } catch sessions:get {
              '–' (: non-XQuery session value :)
            }
            let $string := util:chop(serialize($value, map { 'method': 'basex' }), 20)
            order by $access descending
            return map {
              'name': $name,
              'value': $string,
              'access': $access,
              'you': $you,
              'id': $id || '|' || $name
            }
          let $buttons := (
            html:button('session-kill', 'Kill', true())
          )
          let $options := map { 'sort': $sort, 'presort': 'access' }
          return html:table($headers, $entries, $buttons, map { }, $options)
        }
        </form>

Database Sessions

        {
          let $headers := (
            map { 'key': 'address', 'label': 'Address' },
            map { 'key': 'user', 'label': 'User' }
          )
          let $entries := admin:sessions() ! map {
            'address': @address,
            'user': @user
          }
          return html:table($headers, $entries, (), map { }, map { })
        }

  )
};

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


[ignore] redirect requests of ~/mobiledocs to ~/mobiledocs/ -- otherwise URLs constructed within the app can be invalid, e.g. ~/fn instead of ~/mobiledocs/fn

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

xquery version "1.0";

(: $Id: controller.xql 13019 2010-10-28 03:41:35Z joewiz $ :)

(:~
	Controller XQuery for the RESTful function docs application.

	Demonstrates how to use in URL Rewriting for RESTful applications, e.g.:
	   - functions/ forwards transparently to functions/functions.xql
	   - functions/xmldb displays the docs for the xmldb module
	   - functions/xmldb/login displays the docs for the xmldb:login() module
	   - functions/xmldb:login() redirects to functions/xmldb/login
	       in order to display the docs for the xmldb:login() module

    Un-comment logging functions and monitor EXIST_HOME/webapp/WEB-INF/logs/exist.log
    to follow the construction of these parameters.
:)

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

(: standard variables passed automatically to controller.xql  :)

declare variable $exist:root external;
declare variable $exist:prefix external;
declare variable $exist:controller external;
declare variable $exist:path external;
declare variable $exist:resource external;

(: variables from the HTTP Request module :)
let $url := request:get-url()
let $uri := request:get-uri()
let $context := request:get-context-path()
let $effective-uri := request:get-effective-uri()

(: the default query for this app:)
let $app-default-query := 'index.xql'

(: used to forward matching requests to the correct 'internal' path to the main query :)
let $internal-path-to-app := concat($exist:controller, '/', $app-default-query)

(: the 'external' path to app to the for use in constructing URLs  :)
let $external-path-to-app := concat($context, $exist:prefix, $exist:controller, '/')

(: prepare the URL parameters for use :)
let $post-query-url-params := subsequence(tokenize($exist:path, '/'), 2)

(: logging to demonstrate how variables are constructed for use in URL Rewriting :)
(:
let $log := util:log("DEBUG", concat("URL Info: request:get-url():           ", $url))
let $log := util:log("DEBUG", concat("URL Info: request:get-uri():           ", $uri))
let $log := util:log("DEBUG", concat("URL Info: request:get-effective-uri(): ", $effective-uri))
let $log := util:log("DEBUG", concat("URL Info: request:get-context-path():  ", $context))

let $log := util:log("DEBUG", concat("URL Info: $exist:root:                 ", $exist:root))
let $log := util:log("DEBUG", concat("URL Info: $exist:prefix:               ", $exist:prefix))
let $log := util:log("DEBUG", concat("URL Info: $exist:controller:           ", $exist:controller))
let $log := util:log("DEBUG", concat("URL Info: $exist:path:                 ", $exist:path))
let $log := util:log("DEBUG", concat("URL Info: $exist:resource:             ", $exist:resource))

let $log := util:log("DEBUG", concat("URL Info: $internal-path-to-app:       ", $internal-path-to-app))
let $log := util:log("DEBUG", concat("URL Info: $external-path-to-app:       ", $external-path-to-app))
:)

return
    (: redirect requests of ~/mobiledocs to ~/mobiledocs/ :)
    if ($exist:path eq '') then
        <dispatch xmlns="http://exist.sourceforge.net/NS/exist">
            <redirect url="{$external-path-to-app}"/>
            <cache-control cache="no"/>
        </dispatch>
    (: make sure the global css, js and image files are resolved :)
    else if (matches($exist:path, '((styles|scripts|resources)/|logo.jpg)')) then
        let $newPath := replace($exist:path, '^.*(((styles|scripts|resources)/|logo).*)$', '/$1')
        return
            <dispatch xmlns="http://exist.sourceforge.net/NS/exist">
                <forward url="{$newPath}"/>
                <cache-control cache="yes"/>
            </dispatch>
    else
        let $module := $post-query-url-params[1]
        let $function := $post-query-url-params[2]
        return
            <dispatch xmlns="http://exist.sourceforge.net/NS/exist">
                <forward url="{$internal-path-to-app}">
                    <add-parameter name="module" value="{$module}"/>
                    <add-parameter name="function" value="{$function}"/>
                </forward>
            </dispatch>

xquery version "1.0";

(: $Id: controller.xql 13019 2010-10-28 03:41:35Z joewiz $ :)

(:~
	Controller XQuery for the RESTful function docs application.

	Demonstrates how to use in URL Rewriting for RESTful applications, e.g.:
	   - functions/ forwards transparently to functions/functions.xql
	   - functions/xmldb displays the docs for the xmldb module
	   - functions/xmldb/login displays the docs for the xmldb:login() module
	   - functions/xmldb:login() redirects to functions/xmldb/login
	       in order to display the docs for the xmldb:login() module

    Un-comment logging functions and monitor EXIST_HOME/webapp/WEB-INF/logs/exist.log
    to follow the construction of these parameters.
:)

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

(: standard variables passed automatically to controller.xql  :)

declare variable $exist:root external;
declare variable $exist:prefix external;
declare variable $exist:controller external;
declare variable $exist:path external;
declare variable $exist:resource external;

(: variables from the HTTP Request module :)
let $url := request:get-url()
let $uri := request:get-uri()
let $context := request:get-context-path()
let $effective-uri := request:get-effective-uri()

(: the default query for this app:)
let $app-default-query := 'index.xql'

(: used to forward matching requests to the correct 'internal' path to the main query :)
let $internal-path-to-app := concat($exist:controller, '/', $app-default-query)

(: the 'external' path to app to the for use in constructing URLs  :)
let $external-path-to-app := concat($context, $exist:prefix, $exist:controller, '/')

(: prepare the URL parameters for use :)
let $post-query-url-params := subsequence(tokenize($exist:path, '/'), 2)

(: logging to demonstrate how variables are constructed for use in URL Rewriting :)
(:
let $log := util:log("DEBUG", concat("URL Info: request:get-url():           ", $url))
let $log := util:log("DEBUG", concat("URL Info: request:get-uri():           ", $uri))
let $log := util:log("DEBUG", concat("URL Info: request:get-effective-uri(): ", $effective-uri))
let $log := util:log("DEBUG", concat("URL Info: request:get-context-path():  ", $context))

let $log := util:log("DEBUG", concat("URL Info: $exist:root:                 ", $exist:root))
let $log := util:log("DEBUG", concat("URL Info: $exist:prefix:               ", $exist:prefix))
let $log := util:log("DEBUG", concat("URL Info: $exist:controller:           ", $exist:controller))
let $log := util:log("DEBUG", concat("URL Info: $exist:path:                 ", $exist:path))
let $log := util:log("DEBUG", concat("URL Info: $exist:resource:             ", $exist:resource))

let $log := util:log("DEBUG", concat("URL Info: $internal-path-to-app:       ", $internal-path-to-app))
let $log := util:log("DEBUG", concat("URL Info: $external-path-to-app:       ", $external-path-to-app))
:)

return
    (: make sure the global css, js and image files are resolved :)
    if (matches($exist:path, '((styles|scripts|resources)/|logo.jpg)')) then
        let $newPath := replace($exist:path, '^.*(((styles|scripts|resources)/|logo).*)$', '/$1')
        return
            <dispatch xmlns="http://exist.sourceforge.net/NS/exist">
                <forward url="{$newPath}"/>
                <cache-control cache="yes"/>
            </dispatch>
    else
        let $module := $post-query-url-params[1]
        let $function := $post-query-url-params[2]
        return
            <dispatch xmlns="http://exist.sourceforge.net/NS/exist">
                <forward url="{$internal-path-to-app}">
                    <add-parameter name="module" value="{$module}"/>
                    <add-parameter name="function" value="{$function}"/>
                </forward>
            </dispatch>