Stupid provisional constraint to skip tests that are known to carsh the XQTS.
To be refined and externalized in a file.

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

declare namespace xqts="http://exist-db.org/xquery/xqts";
declare namespace catalog="http://www.w3.org/2005/02/query-test-XQTSCatalog";

declare namespace props="java:java.io.File";

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

(:~ ----------------------------------------------------------------------------------------
     W3C XQuery Test Suite

     This is the main module for running the XQTS on eXist. You can either
     run the whole test suite, a specific test group or a single test case.

     Setup:

     * Make sure the XmlDiff module is registered in conf.xml

     * Edit config.xml and change basedir to point to the directory into
     which you unzipped the XQTS sources. Note: it needs to be an URI.

     * Create a collection /db/XQTS in the database.

     * From the XQTS directory, upload XQTSCatalog.xml into the created
     collection.

     * Upload the "TestSources" directory so the source docs can be found
     in /db/XQTS/TestSources.

     * Run this script with the client.
     ------------------------------------------------------------------------------------------- :)
declare variable $xqts:CONFIG { xqts:initialize() };
declare variable $xqts:XQTS_HOME { xqts:path-to-uri($xqts:CONFIG/basedir/text()) };

declare function xqts:initialize() as element() {
    let $home := util:system-property("exist.home")
    let $path := concat($home, "/webapp/xqts")
    let $collection := xdb:create-collection("/db", "XQTS")
    let $config0 := doc("/db/XQTS")/config
    let $config :=
        if ($config0) then
            $config0
        else
            let $stored := xdb:store-files-from-pattern("/db/XQTS", $path, "*.xml", "text/xml")
            return
                doc("/db/XQTS/config.xml")/config
    let $xqtsHome := $config/basedir/text()
    let $catalog0 := doc("/db/XQTS/XQTSCatalog.xml")
    let $catalog :=
        if ($catalog0) then $catalog0
        else
            xdb:store($collection, "XQTSCatalog.xml",
                xs:anyURI(xqts:path-to-uri(concat($xqtsHome, "XQTSCatalog.xml"))))
    let $sources0 := collection("/db/XQTS/TestSources")
    let $sources :=
        if ($sources0) then
            $sources0
        else
            let $sourceCol := xdb:create-collection("/db/XQTS", "TestSources")
            return
                xdb:store-files-from-pattern($sourceCol, concat($xqtsHome, "TestSources"), "*.xml", "text/xml")
    return
        $config
};

declare function xqts:path-to-uri($path as xs:string) as xs:string {
        if (starts-with($path, "/")) then
            concat("file://", $path)
        else
            concat("file:///", $path)
};

declare function xqts:create-progress-file($testCount as xs:int) as empty() {
    let $results := xdb:store("/db/XQTS", "progress.xml",
        <progress total="{$testCount}" done="0" failed="0" passed="0"/>)
    return ()
};

declare function xqts:report-progress($test-case as element()) as empty() {
    let $result := string($test-case/@result)
    let $progress := doc("/db/XQTS/progress.xml")/progress
    let $counter := $progress/@done
    return (
        update value $counter with xs:int($counter + 1),
        if ($result eq 'fail') then
            update value $progress/@failed with xs:int($progress/@failed + 1)
        else
            update value $progress/@passed with xs:int($progress/@passed + 1)
    )
};

declare function xqts:create-collections($group as element(catalog:test-group)) as node() {
    let $rootColl := xdb:create-collection("/db/XQTS", "test-results")
    let $ancestors := reverse(($group/ancestor::catalog:test-group, $group))
    let $collection := xqts:create-collections($rootColl, $ancestors, "/db/XQTS/test-results")
    let $results := xdb:store($collection, "results.xml", <test-result failed="0" passed="0"/>)
    return
        doc($results)
};

declare function xqts:create-collections($parent as object,
    $pathElements as element()+, $currentPath as xs:string)
as object {
    let $next := $pathElements[last()]
    let $remainder := subsequence($pathElements, 1, count($pathElements) - 1)
    let $newColl := xdb:create-collection($parent, $next/@name)
    return
        if ($remainder) then
            xqts:create-collections($newColl, $remainder, concat($currentPath, "/", $next/@name))
        else
            $newColl
};

declare function xqts:get-query($case as element(catalog:test-case)) {
   let $query-name := $case//catalog:query/@name
   let $path := concat( $xqts:XQTS_HOME, "Queries/XQuery/", $case/@FilePath, $query-name, ".xq" )
   let $xq-string := util:file-read($path)
   return $xq-string
};

declare function xqts:print-result($test-name as xs:string, $passed as xs:boolean, $query as xs:string,
    $result as item()*, $expected as item()*, $case as element(catalog:test-case)) as element() {
    <test-case name="{$test-name}" result="{if ($passed) then 'pass' else 'fail'}">
    {
        if (not($passed)) then (
            <result>{$result}</result>,
            if ($expected instance of element() and count($expected/*) > 10) then
            	<expected truncated="">{$expected/*[position() < 10]}</expected>
            else
                <expected>{$expected}</expected>,
            (: element {$case/catalog:input-file/@variable} { xqts:getInputValue($case) }, :)
            <query>{$query}</query>
        ) else ()
    }
    </test-case>
};

declare function xqts:normalize-text($result as item()*) as xs:string {
    let $str := string-join($result, " ")
    return
        (: Remove leading and trailing whitespace :)
        replace(replace($str, "^\s+", ""), "\s+$", "")
};

declare function xqts:check-output($query as xs:string, $result as item()*, $case as element(catalog:test-case)) {
    let $output := $case/catalog:output-file[last()]
    return
        (: Expected an error, but got a result :)
        if (exists($case/catalog:expected-error)) then
            <test-case name="{$case/@name}" result="fail">
                   <expected-error>{$case/catalog:expected-error/text()}</expected-error>
                   <query>{$query}</query>
            </test-case>
        (: Comparison method: "Text" :)
        else if ($output/@compare eq "Text") then
            let $text := util:file-read(concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath,
                "/", $output/text()))
            let $test := xqts:normalize-text($text) eq xqts:normalize-text($result)
            return
                xqts:print-result($case/@name, $test, $query, $result, $text, $case)
        (: Comparison method: "XML" :)
        else if ($output/@compare eq "XML") then
            util:catch("java.lang.Exception",
                let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath,
                    $output/text())
                let $expected := doc(xdb:store("/db", "temp.xml", xs:anyURI($filePath), "text/xml"))
                let $test := xdiff:compare($expected, $result)
                return
                    xqts:print-result($case/@name, $test, $query, $result, $expected, $case),
                (: Handle unexpected exceptions :)
                <test-case name="{$case/@name}" result="fail">
                   <exception>Exception while loading expected result: {$util:exception-message}</exception>
                   <query>{$query}</query>
                </test-case>
            )
        (: Comparison method: "Fragment" :)
        else if ($output/@compare eq "Fragment") then
            util:catch("java.lang.Exception",
                let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath, $output/text())
                let $expectedFrag := util:file-read($filePath)
                let $xmlFrag := concat("<f>", $expectedFrag, "</f>")
                let $log := util:log("DEBUG", ("Frag stored: ", $xmlFrag))
                let $expected := doc(xdb:store("/db", "temp.xml", $xmlFrag, "text/xml"))
                let $test := xdiff:compare($expected, <f>{$result}</f>)
                return
                    xqts:print-result($case/@name, $test, $query, $result, $expected, $case),
                (: Handle unexpected exceptions :)
                <test-case name="{$case/@name}" result="fail">
                   <exception>Exception while loading expected result fragment: {$util:exception-message}</exception>
                   <query>{$query}</query>
                </test-case>
            )
        (: Comparison method: "Inspect" :)
        (: A text compare is sufficient in many test cases :)
        else if ($output/@compare eq "Inspect") then
            let $text := util:file-read(concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath,
                "/", $output/text()))
            let $test := xqts:normalize-text($text) eq xqts:normalize-text($result)
            return
                xqts:print-result($case/@name, $test, $query, $result, $text, $case)

        (: Don't know how to compare :)
        else
            <error test="{$case/@name}">Unknown comparison method: {$output/@compare}.</error>
};

declare function xqts:run-test-case( $case as element(catalog:test-case)) as item()* {
   let $query := xqts:get-query($case)
   let $context :=
       <static-context>
       {
           for $input in $case/catalog:input-file
           return
               <variable name="{$input/@variable}">{xqts:get-input-value($input)}</variable>
       }
       </static-context>
   let $result :=
       util:catch("java.lang.Exception",
           let $result :=
               util:eval-with-context($query, $context, false())
           return
               xqts:check-output($query, $result, $case),
           if ($case//catalog:expected-error) then
               <test-case name="{$case/@name}" result="pass">
                   <exception>{$util:exception-message}</exception>
                   <expected-error>{$case//catalog:expected-error/text()}</expected-error>
                   <query>{$query}</query>
               </test-case>
           else
               <test-case name="{$case/@name}" result="fail">
                   <exception>{$util:exception-message}</exception>
                   <query>{$query}</query>
               </test-case>
       )
   return $result
};

declare function xqts:finish($result as element()) as empty() {
    let $passed := count($result//test-case[@result = 'pass'])
    let $failed := count($result//test-case[@result = 'fail'])
    return (
        update value $result/@passed with xs:int($passed),
        update value $result/@failed with xs:int($failed)
    )
};

declare function xqts:run-single-test-case($case as element(catalog:test-case),
    $resultRoot as element()?) as empty() {
    let $result := xqts:run-test-case($case)
    return (
        update insert $result into $resultRoot,
        let $added := $resultRoot/test-case[@name = $case/@name]
        return
            if ($added) then xqts:report-progress($added)
            else ()
    )
};

declare function xqts:run-test-group($group as element(catalog:test-group)) as empty() {
    (: Create the collection hierarchy for this group and get the results.xml doc to
        append to. :)
    let $resultsDoc := xqts:create-collections($group)
    let $tests := $group/catalog:test-case[not(starts-with(@name, 'Constr-inscope-1'))]
    return (
        (: Execute the test cases :)
        for $test in $tests
        let $log := util:log("DEBUG", ("Running test case: ", string($test/@name)))
        return
            xqts:run-single-test-case($test, $resultsDoc/test-result),
        if ($tests) then
            xqts:finish($resultsDoc/test-result)
        else
            xdb:remove(util:collection-name($resultsDoc), util:document-name($resultsDoc)),
        (: Execute tests in child groups :)
        for $childGroup in $group/catalog:test-group
        let $log := util:log("DEBUG", ("Entering group: ", string($childGroup/@name)))
        return
            xqts:run-test-group($childGroup)
    )
};

declare function xqts:test-single($name as xs:string) as element() {
    let $test := //catalog:test-case[@name = $name]
    return
        if ($test) then
            let $resultsDoc := xqts:create-collections($test/parent::catalog:test-group)
            let $dummy := xqts:run-single-test-case($test, $resultsDoc/test-result)
            return
                $resultsDoc/test-result
        else
            <error>Test case not found: {$name}.</error>
};

declare function xqts:test-group($groupName as xs:string) as empty() {
    let $group := //catalog:test-group[@name = $groupName]
    return (
        xqts:create-progress-file(count($group//catalog:test-case)),
        xqts:run-test-group($group)
    )
};

declare function xqts:test-all() as empty() {
    for $test in /catalog:test-suite/catalog:test-group
    return
        xqts:test-group($test/@name)
};

declare function xqts:get-input-value($input as element(catalog:input-file)) as item()* {
   if ($input eq "emptydoc") then
       ()
   else (
       let $source := root($input)//catalog:source[@ID = $input/text()]
       return
           if (empty($source)) then
               concat("no input found: ", $input/text())
           else
               doc(concat("/db/XQTS/", $source/@FileName))
   )
};

declare function xqts:overall-result() {
    let $passed := count(//test-case[@result = "pass"])
    let $failed := count(//test-case[@result = "fail"])
    return
        <test-result failed="{$failed}" passed="{$passed}"
            percentage="{$passed div ($passed + $failed)}"/>
};

let $group := request:get-parameter('group', ())
return
    if ($group) then
        xqts:test-group($group)
    else
        ()

declare namespace xqts="http://exist-db.org/xquery/xqts";
declare namespace catalog="http://www.w3.org/2005/02/query-test-XQTSCatalog";

declare namespace props="java:java.io.File";

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

(:~ ----------------------------------------------------------------------------------------
     W3C XQuery Test Suite

     This is the main module for running the XQTS on eXist. You can either
     run the whole test suite, a specific test group or a single test case.

     Setup:

     * Make sure the XmlDiff module is registered in conf.xml

     * Edit config.xml and change basedir to point to the directory into
     which you unzipped the XQTS sources. Note: it needs to be an URI.

     * Create a collection /db/XQTS in the database.

     * From the XQTS directory, upload XQTSCatalog.xml into the created
     collection.

     * Upload the "TestSources" directory so the source docs can be found
     in /db/XQTS/TestSources.

     * Run this script with the client.
     ------------------------------------------------------------------------------------------- :)
declare variable $xqts:CONFIG { xqts:initialize() };
declare variable $xqts:XQTS_HOME { xqts:path-to-uri($xqts:CONFIG/basedir/text()) };

declare function xqts:initialize() as element() {
    let $home := util:system-property("exist.home")
    let $path := concat($home, "/webapp/xqts")
    let $collection := xdb:create-collection("/db", "XQTS")
    let $config0 := doc("/db/XQTS")/config
    let $config :=
        if ($config0) then
            $config0
        else
            let $stored := xdb:store-files-from-pattern("/db/XQTS", $path, "*.xml", "text/xml")
            return
                doc("/db/XQTS/config.xml")/config
    let $xqtsHome := $config/basedir/text()
    let $catalog0 := doc("/db/XQTS/XQTSCatalog.xml")
    let $catalog :=
        if ($catalog0) then $catalog0
        else
            xdb:store($collection, "XQTSCatalog.xml",
                xs:anyURI(xqts:path-to-uri(concat($xqtsHome, "XQTSCatalog.xml"))))
    let $sources0 := collection("/db/XQTS/TestSources")
    let $sources :=
        if ($sources0) then
            $sources0
        else
            let $sourceCol := xdb:create-collection("/db/XQTS", "TestSources")
            return
                xdb:store-files-from-pattern($sourceCol, concat($xqtsHome, "TestSources"), "*.xml", "text/xml")
    return
        $config
};

declare function xqts:path-to-uri($path as xs:string) as xs:string {
        if (starts-with($path, "/")) then
            concat("file://", $path)
        else
            concat("file:///", $path)
};

declare function xqts:create-progress-file($testCount as xs:int) as empty() {
    let $results := xdb:store("/db/XQTS", "progress.xml",
        <progress total="{$testCount}" done="0" failed="0" passed="0"/>)
    return ()
};

declare function xqts:report-progress($test-case as element()) as empty() {
    let $result := string($test-case/@result)
    let $progress := doc("/db/XQTS/progress.xml")/progress
    let $counter := $progress/@done
    return (
        update value $counter with xs:int($counter + 1),
        if ($result eq 'fail') then
            update value $progress/@failed with xs:int($progress/@failed + 1)
        else
            update value $progress/@passed with xs:int($progress/@passed + 1)
    )
};

declare function xqts:create-collections($group as element(catalog:test-group)) as node() {
    let $rootColl := xdb:create-collection("/db/XQTS", "test-results")
    let $ancestors := reverse(($group/ancestor::catalog:test-group, $group))
    let $collection := xqts:create-collections($rootColl, $ancestors, "/db/XQTS/test-results")
    let $results := xdb:store($collection, "results.xml", <test-result failed="0" passed="0"/>)
    return
        doc($results)
};

declare function xqts:create-collections($parent as object,
    $pathElements as element()+, $currentPath as xs:string)
as object {
    let $next := $pathElements[last()]
    let $remainder := subsequence($pathElements, 1, count($pathElements) - 1)
    let $newColl := xdb:create-collection($parent, $next/@name)
    return
        if ($remainder) then
            xqts:create-collections($newColl, $remainder, concat($currentPath, "/", $next/@name))
        else
            $newColl
};

declare function xqts:get-query($case as element(catalog:test-case)) {
   let $query-name := $case//catalog:query/@name
   let $path := concat( $xqts:XQTS_HOME, "Queries/XQuery/", $case/@FilePath, $query-name, ".xq" )
   let $xq-string := util:file-read($path)
   return $xq-string
};

declare function xqts:print-result($test-name as xs:string, $passed as xs:boolean, $query as xs:string,
    $result as item()*, $expected as item()*, $case as element(catalog:test-case)) as element() {
    <test-case name="{$test-name}" result="{if ($passed) then 'pass' else 'fail'}">
    {
        if (not($passed)) then (
            <result>{$result}</result>,
            if ($expected instance of element() and count($expected/*) > 10) then
            	<expected truncated="">{$expected/*[position() < 10]}</expected>
            else
                <expected>{$expected}</expected>,
            (: element {$case/catalog:input-file/@variable} { xqts:getInputValue($case) }, :)
            <query>{$query}</query>
        ) else ()
    }
    </test-case>
};

declare function xqts:normalize-text($result as item()*) as xs:string {
    let $str := string-join($result, " ")
    return
        (: Remove leading and trailing whitespace :)
        replace(replace($str, "^\s+", ""), "\s+$", "")
};

declare function xqts:check-output($query as xs:string, $result as item()*, $case as element(catalog:test-case)) {
    let $output := $case/catalog:output-file[last()]
    return
        (: Expected an error, but got a result :)
        if (exists($case/catalog:expected-error)) then
            <test-case name="{$case/@name}" result="fail">
                   <expected-error>{$case/catalog:expected-error/text()}</expected-error>
                   <query>{$query}</query>
            </test-case>
        (: Comparison method: "Text" :)
        else if ($output/@compare eq "Text") then
            let $text := util:file-read(concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath,
                "/", $output/text()))
            let $test := xqts:normalize-text($text) eq xqts:normalize-text($result)
            return
                xqts:print-result($case/@name, $test, $query, $result, $text, $case)
        (: Comparison method: "XML" :)
        else if ($output/@compare eq "XML") then
            util:catch("java.lang.Exception",
                let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath,
                    $output/text())
                let $expected := doc(xdb:store("/db", "temp.xml", xs:anyURI($filePath), "text/xml"))
                let $test := xdiff:compare($expected, $result)
                return
                    xqts:print-result($case/@name, $test, $query, $result, $expected, $case),
                (: Handle unexpected exceptions :)
                <test-case name="{$case/@name}" result="fail">
                   <exception>Exception while loading expected result: {$util:exception-message}</exception>
                   <query>{$query}</query>
                </test-case>
            )
        (: Comparison method: "Fragment" :)
        else if ($output/@compare eq "Fragment") then
            util:catch("java.lang.Exception",
                let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath, $output/text())
                let $expectedFrag := util:file-read($filePath)
                let $xmlFrag := concat("<f>", $expectedFrag, "</f>")
                let $log := util:log("DEBUG", ("Frag stored: ", $xmlFrag))
                let $expected := doc(xdb:store("/db", "temp.xml", $xmlFrag, "text/xml"))
                let $test := xdiff:compare($expected, <f>{$result}</f>)
                return
                    xqts:print-result($case/@name, $test, $query, $result, $expected, $case),
                (: Handle unexpected exceptions :)
                <test-case name="{$case/@name}" result="fail">
                   <exception>Exception while loading expected result fragment: {$util:exception-message}</exception>
                   <query>{$query}</query>
                </test-case>
            )
        (: Comparison method: "Inspect" :)
        (: A text compare is sufficient in many test cases :)
        else if ($output/@compare eq "Inspect") then
            let $text := util:file-read(concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath,
                "/", $output/text()))
            let $test := xqts:normalize-text($text) eq xqts:normalize-text($result)
            return
                xqts:print-result($case/@name, $test, $query, $result, $text, $case)

        (: Don't know how to compare :)
        else
            <error test="{$case/@name}">Unknown comparison method: {$output/@compare}.</error>
};

declare function xqts:run-test-case( $case as element(catalog:test-case)) as item()* {
   let $query := xqts:get-query($case)
   let $context :=
       <static-context>
       {
           for $input in $case/catalog:input-file
           return
               <variable name="{$input/@variable}">{xqts:get-input-value($input)}</variable>
       }
       </static-context>
   let $result :=
       util:catch("java.lang.Exception",
           let $result :=
               util:eval-with-context($query, $context, false())
           return
               xqts:check-output($query, $result, $case),
           if ($case//catalog:expected-error) then
               <test-case name="{$case/@name}" result="pass">
                   <exception>{$util:exception-message}</exception>
                   <expected-error>{$case//catalog:expected-error/text()}</expected-error>
                   <query>{$query}</query>
               </test-case>
           else
               <test-case name="{$case/@name}" result="fail">
                   <exception>{$util:exception-message}</exception>
                   <query>{$query}</query>
               </test-case>
       )
   return $result
};

declare function xqts:finish($result as element()) as empty() {
    let $passed := count($result//test-case[@result = 'pass'])
    let $failed := count($result//test-case[@result = 'fail'])
    return (
        update value $result/@passed with xs:int($passed),
        update value $result/@failed with xs:int($failed)
    )
};

declare function xqts:run-single-test-case($case as element(catalog:test-case),
    $resultRoot as element()?) as empty() {
    let $result := xqts:run-test-case($case)
    return (
        update insert $result into $resultRoot,
        let $added := $resultRoot/test-case[@name = $case/@name]
        return
            if ($added) then xqts:report-progress($added)
            else ()
    )
};

declare function xqts:run-test-group($group as element(catalog:test-group)) as empty() {
    (: Create the collection hierarchy for this group and get the results.xml doc to
        append to. :)
    let $resultsDoc := xqts:create-collections($group)
    let $tests := $group/catalog:test-case
    return (
        (: Execute the test cases :)
        for $test in $tests
        let $log := util:log("DEBUG", ("Running test case: ", string($test/@name)))
        return
            xqts:run-single-test-case($test, $resultsDoc/test-result),
        if ($tests) then
            xqts:finish($resultsDoc/test-result)
        else
            xdb:remove(util:collection-name($resultsDoc), util:document-name($resultsDoc)),
        (: Execute tests in child groups :)
        for $childGroup in $group/catalog:test-group
        let $log := util:log("DEBUG", ("Entering group: ", string($childGroup/@name)))
        return
            xqts:run-test-group($childGroup)
    )
};

declare function xqts:test-single($name as xs:string) as element() {
    let $test := //catalog:test-case[@name = $name]
    return
        if ($test) then
            let $resultsDoc := xqts:create-collections($test/parent::catalog:test-group)
            let $dummy := xqts:run-single-test-case($test, $resultsDoc/test-result)
            return
                $resultsDoc/test-result
        else
            <error>Test case not found: {$name}.</error>
};

declare function xqts:test-group($groupName as xs:string) as empty() {
    let $group := //catalog:test-group[@name = $groupName]
    return (
        xqts:create-progress-file(count($group//catalog:test-case)),
        xqts:run-test-group($group)
    )
};

declare function xqts:test-all() as empty() {
    for $test in /catalog:test-suite/catalog:test-group
    return
        xqts:test-group($test/@name)
};

declare function xqts:get-input-value($input as element(catalog:input-file)) as item()* {
   if ($input eq "emptydoc") then
       ()
   else (
       let $source := root($input)//catalog:source[@ID = $input/text()]
       return
           if (empty($source)) then
               concat("no input found: ", $input/text())
           else
               doc(concat("/db/XQTS/", $source/@FileName))
   )
};

declare function xqts:overall-result() {
    let $passed := count(//test-case[@result = "pass"])
    let $failed := count(//test-case[@result = "fail"])
    return
        <test-result failed="{$failed}" passed="{$passed}"
            percentage="{$passed div ($passed + $failed)}"/>
};

let $group := request:get-parameter('group', ())
return
    if ($group) then
        xqts:test-group($group)
    else
        ()


[ignore] fixed broken link to eXide, improved display of .xconfs whose only index entries are the disabled fulltext index, TODO remove all fulltext code here when the fulltext libraries are removed once and for all from eXist-db

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

xquery version "1.0";

(:
    Module: Browse Indexes: See an overview of .xconf files stored in /db/system/config,
    and browse the associated index keys.

    TODO: remove legacy fulltext code when it has been cut out of eXist-db 2.0
:)

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

declare namespace cc="http://exist-db.org/collection-config/1.0";

declare option exist:serialize "method=xhtml media-type=text/html omit-xml-declaration=no enforce-xhtml=yes";

(:
    Global variables - derived from URL parameters
:)
declare variable $indexes:start-value := request:get-parameter('start-value', '');
declare variable $indexes:callback := util:function(xs:QName("indexes:term-callback"), 2);
declare variable $indexes:max-number-returned := xs:integer(request:get-parameter('max', 100));
declare variable $indexes:index := request:get-parameter('index', '');
declare variable $indexes:sortby := request:get-parameter('sortby', 'term');
declare variable $indexes:sortorder := request:get-parameter('sortorder', 'ascending');
declare variable $indexes:node-name := request:get-parameter('node-name', '');
declare variable $indexes:match := request:get-parameter('match', '');
declare variable $indexes:collection := request:get-parameter('collection', '');
declare variable $indexes:node-set :=
    if ($indexes:node-name ne '' and $indexes:collection ne '') then
        indexes:get-nodeset-from-qname($indexes:collection, $indexes:node-name)
    else if ($indexes:match ne '' and $indexes:collection ne '') then
        indexes:get-nodeset-from-match($indexes:collection, $indexes:match)
    else
        ();
declare variable $indexes:qname :=
    if ($indexes:node-name ne '') then
        if (not(matches($indexes:node-name, 'xml:')) and contains($indexes:node-name, ':')) then
            QName(indexes:get-namespace-uri-from-node-name($indexes:node-name, $indexes:collection), $indexes:node-name)
        else
            xs:QName($indexes:node-name)
    else ();
declare variable $indexes:show-keys-by := request:get-parameter('show-keys-by', '');
declare variable $indexes:index-names :=

        <name>Index Types</name>
        <description>This is the list of known index types and their labels.</description>
        <items>
            <item>
                Lucene
                <value>lucene-index</value>
            </item>
            <item>
                NGram
                <value>ngram-index</value>
            </item>
            <item>
                Range
                <value>range-index</value>
            </item>
            <item>
                Legacy Fulltext
                <value>legacy-fulltext-index</value>
            </item>
        </items>
    ;

(:
    Main function: outputs the page.
:)
declare function indexes:main() {
    let $xconfs :=
        for $xconf in collection('/db/system/config/')/cc:collection[cc:index]
        order by util:collection-name($xconf)
        return $xconf
    return
        if (empty($xconfs)) then

Browse Indexes

No Index Configurations were found in the /db/system/config collection.
                    Consider installing eXist's example files or
                    documentation and then returning here
                    to browse the indexes.

        else if (empty($indexes:node-set)) then

            indexes:list-indexes($xconfs)

        else

            indexes:show-index-keys()
};

(:
    Lists indexes.
:)
declare function indexes:list-indexes($xconfs) {

Browse Indexes

This is an overview of the index definitions applied in the database,
            as well as the "index keys" (the actual items stored in the index).

Browsing indexes on {count($xconfs)} collections:

        { indexes:xconf-to-table($xconfs) }

};

(:
    Transforms an index definition into an HTML table.
:)
declare function indexes:xconf-to-table($xconfs as node()*) as item()* {

{
        for $xconf at $count in $xconfs
        let $xconf-collection-name := util:collection-name($xconf)
        let $data-collection-name := substring-after(util:collection-name($xconf), '/db/system/config')
        order by $xconf-collection-name
        return

                {$count}. {$data-collection-name} {if (xmldb:collection-available($data-collection-name)) then () else ' (no data)'}
                    (Open .xconf file in eXide)

                        Item Indexed
                        Index
                        Instances
                        Show Index Keys By

                    {
                    for $entry in ( indexes:analyze-legacy-fulltext-indexes($xconf),
                        indexes:analyze-lucene-indexes($xconf),
                        indexes:analyze-range-indexes($xconf),
                        indexes:analyze-ngram-indexes($xconf) )
                    let $item := $entry/td[1]
                    let $index := $entry/td[2]
                    (: order by $index, $item :)
                    return $entry
                    }

    }

};

(:
    Shows the index keys on a given nodeset or QName
:)
declare function indexes:show-index-keys() {
    let $query-start-time := util:system-time()

    let $keys :=
        (: legacy fulltext index use the text:index-terms() function :)
        if ($indexes:index eq 'legacy-fulltext-index') then
            text:index-terms($indexes:node-set, $indexes:start-value, $indexes:callback, $indexes:max-number-returned)
        (: range indexes can use util:index-keys() without specifying the index :)
        else if ($indexes:index eq 'range-index') then
            if (util:index-type($indexes:node-set) eq 'xs:string') then
                util:index-keys($indexes:node-set, $indexes:start-value, $indexes:callback, $indexes:max-number-returned)
            else
                let $start-value :=
                    if (util:index-type($indexes:node-set) eq 'xs:double') then
                        if ($indexes:start-value castable as xs:double) then xs:double($indexes:start-value) else xs:double(0)
                    else if (util:index-type($indexes:node-set) eq 'xs:float') then
                        if ($indexes:start-value castable as xs:float) then xs:float($indexes:start-value) else xs:float(0)
                    else if (util:index-type($indexes:node-set) eq 'xs:boolean') then
                        if ($indexes:start-value castable as xs:boolean) then xs:boolean($indexes:start-value) else xs:boolean(0)
                    else if (util:index-type($indexes:node-set) eq 'xs:dateTime') then
                        if ($indexes:start-value castable as xs:dateTime) then xs:dateTime($indexes:start-value) else xs:dateTime('0001-01-01T00:00:00-00:00')
                    else if (util:index-type($indexes:node-set) eq 'xs:date') then
                        if ($indexes:start-value castable as xs:date) then xs:date($indexes:start-value) else xs:date('0001-01-01')
                    else
                        if ($indexes:start-value castable as xs:integer) then xs:integer($indexes:start-value)
                    else 0
                return util:index-keys($indexes:node-set, $start-value, $indexes:callback, $indexes:max-number-returned)
        (: all other indexes need to specify the index in the 5th parameter of util:index-keys() :)
        else
            if ($indexes:show-keys-by eq 'node') then
                util:index-keys($indexes:node-set, $indexes:start-value, $indexes:callback, $indexes:max-number-returned, $indexes:index)
            else
                util:index-keys-by-qname($indexes:qname, $indexes:start-value, $indexes:callback, $indexes:max-number-returned, $indexes:index)

    let $log := util:log("DEBUG", concat("INDEXES index type:    ", $indexes:index))
    let $log := util:log("DEBUG", concat("INDEXES qname     :    ", $indexes:qname))

    (:  Reminder for sorting:
           term = $key/td[1]
           frequency := xs:integer($key/td[2])
           documents := xs:integer($key/td[3])
           position := xs:integer($key/td[4])
    :)

    let $sorted-keys :=
        if ($indexes:sortby eq 'term') then
            if ($indexes:sortorder eq 'ascending') then
                for $key in $keys order by $key/td[1] ascending return $key
            else
                for $key in $keys order by $key/td[1] descending return $key
        else if ($indexes:sortby eq 'frequency') then
            if ($indexes:sortorder eq 'ascending') then
                for $key in $keys order by xs:integer($key/td[2]) ascending, $key/td[1] ascending return $key
            else
                for $key in $keys order by xs:integer($key/td[2]) descending, $key/td[1] ascending return $key
        else if ($indexes:sortby eq 'documents') then
            if ($indexes:sortorder eq 'ascending') then
                for $key in $keys order by xs:integer($key/td[3]) ascending, $key/td[1] ascending return $key
            else
                for $key in $keys order by xs:integer($key/td[3]) descending, $key/td[1] ascending return $key
        else if ($indexes:sortby eq 'position') then
            if ($indexes:sortorder eq 'ascending') then
                for $key in $keys order by xs:integer($key/td[4]) ascending return $key
            else
                for $key in $keys order by xs:integer($key/td[4]) descending return $key
        else $keys

    let $query-end-time := util:system-time()
    let $query-duration := ($query-end-time - $query-start-time) div xs:dayTimeDuration('PT1S')

    return

View Index Keys

Select a different index

{count($keys)} keys returned in {$query-duration}s

Keys for the {indexes:index-name-to-label($indexes:index)} index defined on "{string-join(($indexes:node-name, $indexes:match), '')}" in the {$indexes:collection} collection, by {$indexes:show-keys-by}.

            <form method="get" action="{indexes:remove-parameter-names('start-value')}">

                    Max number returned: <select name="max">{
                        for $number in (10, 100, 1000, 10000)
                        return
                            <option value="{$number}">{if ($number eq $indexes:max-number-returned) then attribute selected {'selected'} else ()}{$number}</option>
                    }</select>

                    Search for terms starting with: <input name="start-value" type="text" value="{$indexes:start-value}"/>
                    {if ($indexes:start-value ne '') then Clear search else ()}
                    {
                    for $param in request:get-parameter-names()[not(. = ('max', 'start-value'))]
                    return
                        <input type="hidden" name="{$param}" value="{request:get-parameter($param, '')}"/>
                    }

                    <input type="submit"/>

            </form>

{
                    for $column in ('term', 'frequency', 'documents', 'position')
                    return
                        {$column} {indexes:sort-direction-indicator($column)}
                }

                { $sorted-keys }

};

(:
    Helper function: Callback function called used in indexes:show-index-keys() for util:index-keys()
:)
declare function indexes:term-callback($term as xs:string, $data as xs:int+) as element() {

        {$term}
        {$data[1]}
        {$data[2]}
        {$data[3]}

};

(:
    Analyzes the Lucene indexes in an index definition
:)
declare function indexes:analyze-lucene-indexes($xconf) {
    let $index-label := indexes:index-name-to-label('lucene-index')
    let $lucene := $xconf/cc:index/cc:lucene
    return if (not($lucene) or not($lucene/cc:text)) then () else
        (
        (: TODO: complete report of default/other Lucene analyzers :)
        (:let $analyzers := $lucene/cc:analyzer
        return
            if ($analyzers) then
                (

Lucene Analyzers

                ,
                for $node in $analyzers
                return
                    if (not($node/@id)) then

default: {concat(' ', $node/@class/string())}

                    else

{$node/@id/string()}: {concat(' ', $node/@class/string())}

                )
            else ()
        ,:)
        let $texts := $lucene//cc:text
        return
            (
            for $text in $texts
            let $qname := if ($text/@qname) then $text/@qname/string() else ()
            let $match := if ($text/@match) then $text/@match/string() else ()
            let $analyzer := if ($text/@analyzer) then $text/@analyzer/string() else ()
            let $collection := substring-after(util:collection-name($text), '/db/system/config')
            let $nodeset := if ($qname) then indexes:get-nodeset-from-qname($collection, $qname) else indexes:get-nodeset-from-match($collection, $match)
            return

                        {if ($qname) then $qname else $match}
                        {if ($text/@boost) then concat(' (boost: ', $text/@boost/string(), ')') else ()}
                        {if ($text/cc:ignore) then (
, concat('(ignore: ', string-join(for $ignore in $text/cc:ignore return $ignore/@qname/string(), ', '), ')')) else ()}
                    {$index-label} {if ($qname) then ' QName' else ' Match'} {if ($analyzer) then concat(' (', $analyzer, ')') else ' (default analyzer)' (: TODO: complete report of default/other Lucene analyzers :)}
                    {count($nodeset)}
                    {
                        if (empty($nodeset)) then ()
                        else
                            (
                            QName
                            ,
                            ', '
                            ,
                            Node
                            )
                    }

            )
        )
};

(:
    Analyzes the legacy fulltext indexes in an index definition
:)
declare function indexes:analyze-legacy-fulltext-indexes($xconf) {
    let $collection := substring-after(util:collection-name($xconf), '/db/system/config')
    let $index := 'legacy-fulltext-index'
    let $index-label := indexes:index-name-to-label($index)
    let $fulltext := $xconf/cc:index/cc:fulltext
    let $creates := $fulltext/cc:create
    let $default-none := $fulltext/@default eq 'none'
    let $attributes-none := $fulltext/@attributes eq 'false'

    let $no-fulltext := if ( not($fulltext) or ($default-none and $attributes-none and not($creates)) ) then '(disabled)' else ()
    return
        if ($no-fulltext) then

                -
                {concat($index-label, ' ', $no-fulltext)}
                -
                -

        else if (not($default-none) and not($attributes-none)) then

                All Elements and Attributes!
                {$index-label}
                {count(collection($collection)//*)} elements and {count(collection($collection)//@*)} attributes
                (Too many to display)

(: is it feasible to display all qnames/nodes here? :)
        else (: if ($creates) then :)
            (
            for $create in $creates
            let $qname := $create/@qname/string()
            let $mixed := $create/@mixed/string()
            return

                    {$qname}
                    {$index-label} {if ($mixed) then '(mixed)' else ()}
                    {count(util:eval(concat('collection(', $collection, ')//', $qname)))}
                    Node

            ,
            let $only-elements-disabled := if ($fulltext/@default eq 'none' and $fulltext/@attributes ne 'no') then '(elements disabled)' else ()
            let $only-attribs-disabled := if ($fulltext/@default ne 'none' and $fulltext/@attributes eq 'no') then '(attributes disabled)' else ()
            return
            if ($only-elements-disabled) then

                    All Attributes! {$only-elements-disabled}
                    {$index-label}
                    {count(collection($collection)//@*)} attributes
                    (Too many to display)

(: is it feasible to display all qnames/nodes here? :)
            else if ($only-attribs-disabled) then

                    All Elements! {$only-attribs-disabled}
                    {$index-label}
                    {count(collection($collection)//*)} elements
                    (Too many to display)

(: is it feasible to display all qnames/nodes here? :)
            else ()
            )
};

(:
    Analyzes the range indexes in an index definition
:)
declare function indexes:analyze-range-indexes($xconf) {
    let $index-label := indexes:index-name-to-label('range-index')
    let $ranges := $xconf/cc:index/cc:create
    return if (not($ranges)) then () else
        for $range in $ranges
        let $qname := $range/@qname/string()
        let $match := $range/@path/string()
        let $type := $range/@type/string()
        let $collection := substring-after(util:collection-name($range), '/db/system/config')
        let $nodeset := if ($qname) then indexes:get-nodeset-from-qname($collection, $qname) else indexes:get-nodeset-from-match($collection, $match)
        return

                {if ($qname) then $qname else $match}
                {$index-label} {if ($qname) then ' QName' else ' Path'} ({$type})
                {count($nodeset)}
                {
                    if (empty($nodeset)) then ()
                    else
                        Node
                }

};

(:
    Analyzes the NGram indexes in an index definition
:)
declare function indexes:analyze-ngram-indexes($xconf) {
    let $index-label := indexes:index-name-to-label('ngram-index')
    let $ngrams := $xconf/cc:index/cc:ngram
    return if (not($ngrams)) then () else
        for $ngram in $ngrams
        let $qname := $ngram/@qname/string()
        let $collection := substring-after(util:collection-name($ngram), '/db/system/config')
        let $nodeset := indexes:get-nodeset-from-qname($collection, $qname)
        return

                {$qname}
                {$index-label} QName
                {count($nodeset)}
                {
                    if (not(empty($nodeset))) then
                        (
                        QName,
                        ', '
                        ,
                        Node
                        )
                     else ()
                 }

};

(:
    Helper function: Returns a nodeset of instances of a node-name in a collection
:)
declare function indexes:get-nodeset-from-qname($collection as xs:string, $node-name as xs:string) as node()* {
    let $nodeset-expression :=
        concat(
            indexes:get-namespace-declaration-from-node-name($node-name, $collection)
            ,
            'collection("', $collection, '")//', $node-name
        )
    let $log := util:log("DEBUG", concat("INDEXES get-nodeset:          ", $nodeset-expression))
    return
        util:eval($nodeset-expression)
};

(:
    Helper function: Returns a nodeset of instances of a match expression in a collection
:)
declare function indexes:get-nodeset-from-match($collection as xs:string, $match as xs:string) as node()* {
    let $nodeset-expression :=
        concat(
            string-join(
                distinct-values(
                let $node-names := tokenize(replace($match, '//', '/'), '/')
                return
                    for $node-name in $node-names
                    return
                        indexes:get-namespace-declaration-from-node-name($node-name, $collection)
                ), ' ')
            ,
            'collection("', $collection, '")', $match, if (contains($match, '@')) then () else ()
        )
    return
        util:eval($nodeset-expression)
};

(:
    Helper function: Returns the index definition for a given collection
:)
declare function indexes:get-xconf($collection as xs:string) as document-node() {
    let $config-root := '/db/system/config'
    let $xconf-collection := concat($config-root, $collection)
    let $xconf-filename := xmldb:get-child-resources($xconf-collection)[ends-with(., '.xconf')]
    let $xconf := doc(concat($xconf-collection, '/', $xconf-filename))
    return $xconf
};

(:
    Helper function: Looks in the collection.xconf's collection and index elements for namespace URIs for a given node name
:)
declare function indexes:get-namespace-uri-from-node-name($node-name, $collection) {

    let $name := if (starts-with($node-name,'@')) then
                    substring-after( substring-before($node-name, ':'), '@' )
                else
                    substring-before($node-name, ':')

    let $xconf := indexes:get-xconf($collection)
    let $uri := (namespace-uri-for-prefix($name, $xconf/cc:collection), namespace-uri-for-prefix($name, $xconf//cc:index))
    return
        $uri
};

(:
    Helper function: Constructs a namespace declaration for use in util:eval()
:)
declare function indexes:get-namespace-declaration-from-node-name($node-name as xs:string, $collection as xs:string) as xs:string? {
    if (not(matches($node-name, 'xml:')) and contains($node-name, ':')) then

        let $name := if (starts-with($node-name,'@')) then
                        substring-after( substring-before($node-name, ':'), '@' )
                    else
                        substring-before($node-name, ':')

        let $uri := indexes:get-namespace-uri-from-node-name($node-name, $collection)
        return
            concat('declare namespace ', $name, '="', $uri, '"; ')
    else ()
};

(:
    Helper function: gets the label for a given index-name
:)
declare function indexes:index-name-to-label($index-name as xs:string) as xs:string {
    $indexes:index-names//item[value eq $index-name]/label/text()
};

(:
    ====
    Helper functions for modifying the sort order used in indexes:show-index-keys()
    ====
:)
declare function indexes:toggle-sortorder($current-sortorder) {
    indexes:toggle-sortorder($current-sortorder, ('ascending'))
};

declare function indexes:toggle-sortorder($current-sortorder, $other-new-parameters) {
    let $neworder :=
        if ($current-sortorder eq 'ascending') then
            'sortorder=descending'
        else
            'sortorder=ascending'
    let $new-parameters := ($neworder, $other-new-parameters)
    return
        indexes:replace-parameters($new-parameters)
};

declare function indexes:set-sortorder($current-sortorder, $current-sortby, $new-sortby) {
    if ($current-sortby eq $new-sortby) then
        indexes:toggle-sortorder($current-sortorder)
    else
        indexes:strip-param-from-param-string(indexes:replace-parameters(concat('sortby=', $new-sortby)), 'sortorder')
};

declare function indexes:set-sortorder($new-sortby) {
    indexes:set-sortorder($indexes:sortorder, $indexes:sortby, $new-sortby)
};

declare function indexes:sort-direction-indicator($sortby as xs:string) {
    if ($sortby eq $indexes:sortby) then
        if ($indexes:sortorder eq 'ascending') then
            ' ↓'
        else
            ' ↑'
    else ()
};

(:
    ====
    Helper functions for handling parameters
    ====
:)
declare function indexes:remove-parameter-names($parameter-names-to-remove) {
    let $current-parameter-names := request:get-parameter-names()
    let $remaining-parameters :=
        indexes:remove-parameter-names(
            for $current-parameter-name in $current-parameter-names
            return
                concat($current-parameter-name, '=', request:get-parameter( $current-parameter-name, () ))
            ,
            $parameter-names-to-remove
            )
    return
        if (exists($remaining-parameters)) then
            concat('?', string-join($remaining-parameters, '&'))
        else
            '?'
};

declare function indexes:remove-parameter-names($current-parameters, $parameter-names-to-remove) {
    for $current-parameter in $current-parameters
    return
        if (substring-before($current-parameter, '=') = $parameter-names-to-remove) then
            ()
        else
            $current-parameter
};

declare function indexes:remove-parameter-names-except($parameter-names-to-keep) {
    let $current-parameter-names := request:get-parameter-names()
    return
        indexes:remove-parameter-names($current-parameter-names[not(. = $parameter-names-to-keep)])
};

declare function indexes:replace-parameters($new-parameters) {
    let $current-parameter-names := request:get-parameter-names()
    let $current-parameters :=
        for $name in $current-parameter-names
        return concat($name, '=', request:get-parameter($name, ()))
    return
        indexes:replace-parameters($current-parameters, $new-parameters)
};

declare function indexes:replace-parameters($current-parameters, $new-parameters) {
    let $new-parameter-names := for $new-parameter in $new-parameters return substring-before($new-parameter, '=')
    let $remaining-parameters := indexes:remove-parameter-names($current-parameters, $new-parameter-names)
    let $result-parameters := for $param in ($remaining-parameters, $new-parameters) order by $param return $param
    return
        concat('?', string-join($result-parameters, '&'))
};

declare function indexes:strip-param-from-param-string($param-string, $param) {
    replace($param-string, concat('&?', $param, '=[^&]*?&?.*$'), '')
};

xquery version "1.0";

(:
    Module: Browse Indexes: See an overview of .xconf files stored in /db/system/config,
    and browse the associated index keys.
:)

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

declare namespace cc="http://exist-db.org/collection-config/1.0";

declare option exist:serialize "method=xhtml media-type=text/html omit-xml-declaration=no enforce-xhtml=yes";

(:
    Global variables - derived from URL parameters
:)
declare variable $indexes:start-value := request:get-parameter('start-value', '');
declare variable $indexes:callback := util:function(xs:QName("indexes:term-callback"), 2);
declare variable $indexes:max-number-returned := xs:integer(request:get-parameter('max', 100));
declare variable $indexes:index := request:get-parameter('index', '');
declare variable $indexes:sortby := request:get-parameter('sortby', 'term');
declare variable $indexes:sortorder := request:get-parameter('sortorder', 'ascending');
declare variable $indexes:node-name := request:get-parameter('node-name', '');
declare variable $indexes:match := request:get-parameter('match', '');
declare variable $indexes:collection := request:get-parameter('collection', '');
declare variable $indexes:node-set :=
    if ($indexes:node-name ne '' and $indexes:collection ne '') then
        indexes:get-nodeset-from-qname($indexes:collection, $indexes:node-name)
    else if ($indexes:match ne '' and $indexes:collection ne '') then
        indexes:get-nodeset-from-match($indexes:collection, $indexes:match)
    else
        ();
declare variable $indexes:qname :=
    if ($indexes:node-name ne '') then
        if (not(matches($indexes:node-name, 'xml:')) and contains($indexes:node-name, ':')) then
            QName(indexes:get-namespace-uri-from-node-name($indexes:node-name, $indexes:collection), $indexes:node-name)
        else
            xs:QName($indexes:node-name)
    else ();
declare variable $indexes:show-keys-by := request:get-parameter('show-keys-by', '');
declare variable $indexes:index-names :=

        <name>Index Types</name>
        <description>This is the list of known index types and their labels.</description>
        <items>
            <item>
                Lucene
                <value>lucene-index</value>
            </item>
            <item>
                NGram
                <value>ngram-index</value>
            </item>
            <item>
                Range
                <value>range-index</value>
            </item>
            <item>
                Legacy Fulltext
                <value>legacy-fulltext-index</value>
            </item>
        </items>
    ;

(:
    Main function: outputs the page.
:)
declare function indexes:main() {
    let $xconfs :=
        for $xconf in collection('/db/system/config/')/cc:collection
        order by util:collection-name($xconf)
        return $xconf
    return
        if (empty($xconfs)) then

Browse Indexes

No Index Configurations were found in the /db/system/config collection.
                    Consider installing eXist's example files or
                    documentation and then returning here
                    to browse the indexes.

        else if (empty($indexes:node-set)) then

            indexes:list-indexes($xconfs)

        else

            indexes:show-index-keys()
};

(:
    Lists indexes.
:)
declare function indexes:list-indexes($xconfs) {

Browse Indexes

This is an overview of the index definitions applied in the database,
            as well as the "index keys" (the actual items stored in the index).

Browsing {count($xconfs)} indexes:

        { indexes:xconf-to-table($xconfs) }

};

(:
    Transforms an index definition into an HTML table.
:)
declare function indexes:xconf-to-table($xconfs as node()*) as item()* {

{
        for $xconf at $count in $xconfs
        let $xconf-collection-name := util:collection-name($xconf)
        let $data-collection-name := substring-after(util:collection-name($xconf), '/db/system/config')
        order by $xconf-collection-name
        return

                {$count}. {$data-collection-name} {if (xmldb:collection-available($data-collection-name)) then () else ' (no data)'}
                    (View xconf file)

                        Item Indexed
                        Index
                        Instances
                        Show Index Keys By

                    {
                    for $entry in ( indexes:analyze-legacy-fulltext-indexes($xconf),
                        indexes:analyze-lucene-indexes($xconf),
                        indexes:analyze-range-indexes($xconf),
                        indexes:analyze-ngram-indexes($xconf) )
                    let $item := $entry/td[1]
                    let $index := $entry/td[2]
                    (: order by $index, $item :)
                    return $entry
                    }

    }

};

(:
    Shows the index keys on a given nodeset or QName
:)
declare function indexes:show-index-keys() {
    let $query-start-time := util:system-time()

    let $keys :=
        (: legacy fulltext index use the text:index-terms() function :)
        if ($indexes:index eq 'legacy-fulltext-index') then
            text:index-terms($indexes:node-set, $indexes:start-value, $indexes:callback, $indexes:max-number-returned)
        (: range indexes can use util:index-keys() without specifying the index :)
        else if ($indexes:index eq 'range-index') then
            if (util:index-type($indexes:node-set) eq 'xs:string') then
                util:index-keys($indexes:node-set, $indexes:start-value, $indexes:callback, $indexes:max-number-returned)
            else
                let $start-value :=
                    if (util:index-type($indexes:node-set) eq 'xs:double') then
                        if ($indexes:start-value castable as xs:double) then xs:double($indexes:start-value) else xs:double(0)
                    else if (util:index-type($indexes:node-set) eq 'xs:float') then
                        if ($indexes:start-value castable as xs:float) then xs:float($indexes:start-value) else xs:float(0)
                    else if (util:index-type($indexes:node-set) eq 'xs:boolean') then
                        if ($indexes:start-value castable as xs:boolean) then xs:boolean($indexes:start-value) else xs:boolean(0)
                    else if (util:index-type($indexes:node-set) eq 'xs:dateTime') then
                        if ($indexes:start-value castable as xs:dateTime) then xs:dateTime($indexes:start-value) else xs:dateTime('0001-01-01T00:00:00-00:00')
                    else if (util:index-type($indexes:node-set) eq 'xs:date') then
                        if ($indexes:start-value castable as xs:date) then xs:date($indexes:start-value) else xs:date('0001-01-01')
                    else
                        if ($indexes:start-value castable as xs:integer) then xs:integer($indexes:start-value)
                    else 0
                return util:index-keys($indexes:node-set, $start-value, $indexes:callback, $indexes:max-number-returned)
        (: all other indexes need to specify the index in the 5th parameter of util:index-keys() :)
        else
            if ($indexes:show-keys-by eq 'node') then
                util:index-keys($indexes:node-set, $indexes:start-value, $indexes:callback, $indexes:max-number-returned, $indexes:index)
            else
                util:index-keys-by-qname($indexes:qname, $indexes:start-value, $indexes:callback, $indexes:max-number-returned, $indexes:index)

    let $log := util:log("DEBUG", concat("INDEXES index type:    ", $indexes:index))
    let $log := util:log("DEBUG", concat("INDEXES qname     :    ", $indexes:qname))

    (:  Reminder for sorting:
           term = $key/td[1]
           frequency := xs:integer($key/td[2])
           documents := xs:integer($key/td[3])
           position := xs:integer($key/td[4])
    :)

    let $sorted-keys :=
        if ($indexes:sortby eq 'term') then
            if ($indexes:sortorder eq 'ascending') then
                for $key in $keys order by $key/td[1] ascending return $key
            else
                for $key in $keys order by $key/td[1] descending return $key
        else if ($indexes:sortby eq 'frequency') then
            if ($indexes:sortorder eq 'ascending') then
                for $key in $keys order by xs:integer($key/td[2]) ascending, $key/td[1] ascending return $key
            else
                for $key in $keys order by xs:integer($key/td[2]) descending, $key/td[1] ascending return $key
        else if ($indexes:sortby eq 'documents') then
            if ($indexes:sortorder eq 'ascending') then
                for $key in $keys order by xs:integer($key/td[3]) ascending, $key/td[1] ascending return $key
            else
                for $key in $keys order by xs:integer($key/td[3]) descending, $key/td[1] ascending return $key
        else if ($indexes:sortby eq 'position') then
            if ($indexes:sortorder eq 'ascending') then
                for $key in $keys order by xs:integer($key/td[4]) ascending return $key
            else
                for $key in $keys order by xs:integer($key/td[4]) descending return $key
        else $keys

    let $query-end-time := util:system-time()
    let $query-duration := ($query-end-time - $query-start-time) div xs:dayTimeDuration('PT1S')

    return

View Index Keys

Select a different index

{count($keys)} keys returned in {$query-duration}s

Keys for the {indexes:index-name-to-label($indexes:index)} index defined on "{string-join(($indexes:node-name, $indexes:match), '')}" in the {$indexes:collection} collection, by {$indexes:show-keys-by}.

            <form method="get" action="{indexes:remove-parameter-names('start-value')}">

                    Max number returned: <select name="max">{
                        for $number in (10, 100, 1000, 10000)
                        return
                            <option value="{$number}">{if ($number eq $indexes:max-number-returned) then attribute selected {'selected'} else ()}{$number}</option>
                    }</select>

                    Search for terms starting with: <input name="start-value" type="text" value="{$indexes:start-value}"/>
                    {if ($indexes:start-value ne '') then Clear search else ()}
                    {
                    for $param in request:get-parameter-names()[not(. = ('max', 'start-value'))]
                    return
                        <input type="hidden" name="{$param}" value="{request:get-parameter($param, '')}"/>
                    }

                    <input type="submit"/>

            </form>

{
                    for $column in ('term', 'frequency', 'documents', 'position')
                    return
                        {$column} {indexes:sort-direction-indicator($column)}
                }

                { $sorted-keys }

};

(:
    Helper function: Callback function called used in indexes:show-index-keys() for util:index-keys()
:)
declare function indexes:term-callback($term as xs:string, $data as xs:int+) as element() {

        {$term}
        {$data[1]}
        {$data[2]}
        {$data[3]}

};

(:
    Analyzes the Lucene indexes in an index definition
:)
declare function indexes:analyze-lucene-indexes($xconf) {
    let $index-label := indexes:index-name-to-label('lucene-index')
    let $lucene := $xconf/cc:index/cc:lucene
    return if (not($lucene) or not($lucene/cc:text)) then () else
        (
        (: TODO: complete report of default/other Lucene analyzers :)
        (:let $analyzers := $lucene/cc:analyzer
        return
            if ($analyzers) then
                (

Lucene Analyzers

                ,
                for $node in $analyzers
                return
                    if (not($node/@id)) then

default: {concat(' ', $node/@class/string())}

                    else

{$node/@id/string()}: {concat(' ', $node/@class/string())}

                )
            else ()
        ,:)
        let $texts := $lucene//cc:text
        return
            (
            for $text in $texts
            let $qname := if ($text/@qname) then $text/@qname/string() else ()
            let $match := if ($text/@match) then $text/@match/string() else ()
            let $analyzer := if ($text/@analyzer) then $text/@analyzer/string() else ()
            let $collection := substring-after(util:collection-name($text), '/db/system/config')
            let $nodeset := if ($qname) then indexes:get-nodeset-from-qname($collection, $qname) else indexes:get-nodeset-from-match($collection, $match)
            return

                        {if ($qname) then $qname else $match}
                        {if ($text/@boost) then concat(' (boost: ', $text/@boost/string(), ')') else ()}
                        {if ($text/cc:ignore) then (
, concat('(ignore: ', string-join(for $ignore in $text/cc:ignore return $ignore/@qname/string(), ', '), ')')) else ()}
                    {$index-label} {if ($qname) then ' QName' else ' Match'} {if ($analyzer) then concat(' (', $analyzer, ')') else ' (default analyzer)' (: TODO: complete report of default/other Lucene analyzers :)}
                    {count($nodeset)}
                    {
                        if (empty($nodeset)) then ()
                        else
                            (
                            QName
                            ,
                            ', '
                            ,
                            Node
                            )
                    }

            )
        )
};

(:
    Analyzes the legacy fulltext indexes in an index definition
:)
declare function indexes:analyze-legacy-fulltext-indexes($xconf) {
    let $collection := substring-after(util:collection-name($xconf), '/db/system/config')
    let $index := 'legacy-fulltext-index'
    let $index-label := indexes:index-name-to-label($index)
    let $fulltext := $xconf/cc:index/cc:fulltext
    let $creates := $fulltext/cc:create
    let $default-none := $fulltext/@default eq 'none'
    let $attributes-none := $fulltext/@attributes eq 'false'

    let $no-fulltext := if ( not($fulltext) or ($default-none and $attributes-none and not($creates)) ) then '(disabled)' else ()
    return
        if ($no-fulltext) then ()
        else if (not($default-none) and not($attributes-none)) then

                All Elements and Attributes!
                {$index-label}
                {count(collection($collection)//*)} elements and {count(collection($collection)//@*)} attributes
                (Too many to display)

(: is it feasible to display all qnames/nodes here? :)
        else (: if ($creates) then :)
            (
            for $create in $creates
            let $qname := $create/@qname/string()
            let $mixed := $create/@mixed/string()
            return

                    {$qname}
                    {$index-label} {if ($mixed) then '(mixed)' else ()}
                    {count(util:eval(concat('collection(', $collection, ')//', $qname)))}
                    Node

            ,
            let $only-elements-disabled := if ($fulltext/@default eq 'none' and $fulltext/@attributes ne 'no') then '(elements disabled)' else ()
            let $only-attribs-disabled := if ($fulltext/@default ne 'none' and $fulltext/@attributes eq 'no') then '(attributes disabled)' else ()
            return
            if ($only-elements-disabled) then

                    All Attributes!
                    {$index-label}
                    {count(collection($collection)//@*)} attributes
                    (Too many to display)

(: is it feasible to display all qnames/nodes here? :)
            else if ($only-attribs-disabled) then

                    All Elements!
                    {$index-label}
                    {count(collection($collection)//*)} elements
                    (Too many to display)

(: is it feasible to display all qnames/nodes here? :)
            else ()
            )
};

(:
    Analyzes the range indexes in an index definition
:)
declare function indexes:analyze-range-indexes($xconf) {
    let $index-label := indexes:index-name-to-label('range-index')
    let $ranges := $xconf/cc:index/cc:create
    return if (not($ranges)) then () else
        for $range in $ranges
        let $qname := $range/@qname/string()
        let $match := $range/@path/string()
        let $type := $range/@type/string()
        let $collection := substring-after(util:collection-name($range), '/db/system/config')
        let $nodeset := if ($qname) then indexes:get-nodeset-from-qname($collection, $qname) else indexes:get-nodeset-from-match($collection, $match)
        return

                {if ($qname) then $qname else $match}
                {$index-label} {if ($qname) then ' QName' else ' Path'} ({$type})
                {count($nodeset)}
                {
                    if (empty($nodeset)) then ()
                    else
                        Node
                }

};

(:
    Analyzes the NGram indexes in an index definition
:)
declare function indexes:analyze-ngram-indexes($xconf) {
    let $index-label := indexes:index-name-to-label('ngram-index')
    let $ngrams := $xconf/cc:index/cc:ngram
    return if (not($ngrams)) then () else
        for $ngram in $ngrams
        let $qname := $ngram/@qname/string()
        let $collection := substring-after(util:collection-name($ngram), '/db/system/config')
        let $nodeset := indexes:get-nodeset-from-qname($collection, $qname)
        return

                {$qname}
                {$index-label} QName
                {count($nodeset)}
                {
                    if (not(empty($nodeset))) then
                        (
                        QName,
                        ', '
                        ,
                        Node
                        )
                     else ()
                 }

};

(:
    Helper function: Returns a nodeset of instances of a node-name in a collection
:)
declare function indexes:get-nodeset-from-qname($collection as xs:string, $node-name as xs:string) as node()* {
    let $nodeset-expression :=
        concat(
            indexes:get-namespace-declaration-from-node-name($node-name, $collection)
            ,
            'collection("', $collection, '")//', $node-name
        )
    let $log := util:log("DEBUG", concat("INDEXES get-nodeset:          ", $nodeset-expression))
    return
        util:eval($nodeset-expression)
};

(:
    Helper function: Returns a nodeset of instances of a match expression in a collection
:)
declare function indexes:get-nodeset-from-match($collection as xs:string, $match as xs:string) as node()* {
    let $nodeset-expression :=
        concat(
            string-join(
                distinct-values(
                let $node-names := tokenize(replace($match, '//', '/'), '/')
                return
                    for $node-name in $node-names
                    return
                        indexes:get-namespace-declaration-from-node-name($node-name, $collection)
                ), ' ')
            ,
            'collection("', $collection, '")', $match, if (contains($match, '@')) then () else ()
        )
    return
        util:eval($nodeset-expression)
};

(:
    Helper function: Returns the index definition for a given collection
:)
declare function indexes:get-xconf($collection as xs:string) as document-node() {
    let $config-root := '/db/system/config'
    let $xconf-collection := concat($config-root, $collection)
    let $xconf-filename := xmldb:get-child-resources($xconf-collection)[ends-with(., '.xconf')]
    let $xconf := doc(concat($xconf-collection, '/', $xconf-filename))
    return $xconf
};

(:
    Helper function: Looks in the collection.xconf's collection and index elements for namespace URIs for a given node name
:)
declare function indexes:get-namespace-uri-from-node-name($node-name, $collection) {

    let $name := if (starts-with($node-name,'@')) then
                    substring-after( substring-before($node-name, ':'), '@' )
                else
                    substring-before($node-name, ':')

    let $xconf := indexes:get-xconf($collection)
    let $uri := (namespace-uri-for-prefix($name, $xconf/cc:collection), namespace-uri-for-prefix($name, $xconf//cc:index))
    return
        $uri
};

(:
    Helper function: Constructs a namespace declaration for use in util:eval()
:)
declare function indexes:get-namespace-declaration-from-node-name($node-name as xs:string, $collection as xs:string) as xs:string? {
    if (not(matches($node-name, 'xml:')) and contains($node-name, ':')) then

        let $name := if (starts-with($node-name,'@')) then
                        substring-after( substring-before($node-name, ':'), '@' )
                    else
                        substring-before($node-name, ':')

        let $uri := indexes:get-namespace-uri-from-node-name($node-name, $collection)
        return
            concat('declare namespace ', $name, '="', $uri, '"; ')
    else ()
};

(:
    Helper function: gets the label for a given index-name
:)
declare function indexes:index-name-to-label($index-name as xs:string) as xs:string {
    $indexes:index-names//item[value eq $index-name]/label/text()
};

(:
    ====
    Helper functions for modifying the sort order used in indexes:show-index-keys()
    ====
:)
declare function indexes:toggle-sortorder($current-sortorder) {
    indexes:toggle-sortorder($current-sortorder, ('ascending'))
};

declare function indexes:toggle-sortorder($current-sortorder, $other-new-parameters) {
    let $neworder :=
        if ($current-sortorder eq 'ascending') then
            'sortorder=descending'
        else
            'sortorder=ascending'
    let $new-parameters := ($neworder, $other-new-parameters)
    return
        indexes:replace-parameters($new-parameters)
};

declare function indexes:set-sortorder($current-sortorder, $current-sortby, $new-sortby) {
    if ($current-sortby eq $new-sortby) then
        indexes:toggle-sortorder($current-sortorder)
    else
        indexes:strip-param-from-param-string(indexes:replace-parameters(concat('sortby=', $new-sortby)), 'sortorder')
};

declare function indexes:set-sortorder($new-sortby) {
    indexes:set-sortorder($indexes:sortorder, $indexes:sortby, $new-sortby)
};

declare function indexes:sort-direction-indicator($sortby as xs:string) {
    if ($sortby eq $indexes:sortby) then
        if ($indexes:sortorder eq 'ascending') then
            ' ↓'
        else
            ' ↑'
    else ()
};

(:
    ====
    Helper functions for handling parameters
    ====
:)
declare function indexes:remove-parameter-names($parameter-names-to-remove) {
    let $current-parameter-names := request:get-parameter-names()
    let $remaining-parameters :=
        indexes:remove-parameter-names(
            for $current-parameter-name in $current-parameter-names
            return
                concat($current-parameter-name, '=', request:get-parameter( $current-parameter-name, () ))
            ,
            $parameter-names-to-remove
            )
    return
        if (exists($remaining-parameters)) then
            concat('?', string-join($remaining-parameters, '&'))
        else
            '?'
};

declare function indexes:remove-parameter-names($current-parameters, $parameter-names-to-remove) {
    for $current-parameter in $current-parameters
    return
        if (substring-before($current-parameter, '=') = $parameter-names-to-remove) then
            ()
        else
            $current-parameter
};

declare function indexes:remove-parameter-names-except($parameter-names-to-keep) {
    let $current-parameter-names := request:get-parameter-names()
    return
        indexes:remove-parameter-names($current-parameter-names[not(. = $parameter-names-to-keep)])
};

declare function indexes:replace-parameters($new-parameters) {
    let $current-parameter-names := request:get-parameter-names()
    let $current-parameters :=
        for $name in $current-parameter-names
        return concat($name, '=', request:get-parameter($name, ()))
    return
        indexes:replace-parameters($current-parameters, $new-parameters)
};

declare function indexes:replace-parameters($current-parameters, $new-parameters) {
    let $new-parameter-names := for $new-parameter in $new-parameters return substring-before($new-parameter, '=')
    let $remaining-parameters := indexes:remove-parameter-names($current-parameters, $new-parameter-names)
    let $result-parameters := for $param in ($remaining-parameters, $new-parameters) order by $param return $param
    return
        concat('?', string-join($result-parameters, '&'))
};

declare function indexes:strip-param-from-param-string($param-string, $param) {
    replace($param-string, concat('&?', $param, '=[^&]*?&?.*$'), '')
};