Re-enable match highlighting in XQuery sandbox.

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

xquery version "1.0";
(: $Id$ :)

declare namespace sandbox="http://exist-db.org/xquery/sandbox";
declare namespace system="http://exist-db.org/xquery/system";

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

declare option exist:serialize "method=xhtml indent=no highlight-matches=elements";

(:~ Points to the location of the xml-highlight.xsl stylesheet stored in the database :)
declare variable $sandbox:XML_HIGHLIGHT_STYLE { "/db/sandbox/xml-highlight.xsl" };

(:~ The required stylesheets were not found in the db. Try to import them. :)
declare function sandbox:import-stylesheets() as xs:string* {
    let $home := system:get-exist-home()
    let $pathSep := util:system-property("file.separator")
    let $dir :=
			if (doc-available(concat("file:///", system:get-module-load-path(), "/stylesheets/xml-highlight.xsl")))
			then
				concat(system:get-module-load-path(), $pathSep, "stylesheets")
        	else if(ends-with($home, "WEB-INF")) then
        	    concat(substring-before($home, "WEB-INF"), "sandbox", $pathSep, "stylesheets")
        	else
               concat($home, $pathSep, "webapp", $pathSep, "sandbox", $pathSep, "stylesheets")
    let $col := xdb:create-collection("/db", "sandbox")
    return
        concat("Imported: ", xdb:store-files-from-pattern($col, $dir, "*.xsl", "text/xml"))
};

(:~ Check for stylesheets required for the application. Try to import them if they could not be found. :)
declare function sandbox:check-paths() as item()* {
    if (not(doc-available($sandbox:XML_HIGHLIGHT_STYLE))) then
        let $dummy := sandbox:import-stylesheets()
        return
            if (not(doc-available($sandbox:XML_HIGHLIGHT_STYLE))) then
                concat($sandbox:XML_HIGHLIGHT_STYLE, " not found! Please store this file into ",
                    "the database collection or the application will not work properly.")
            else ()
    else
        You can also try out an updated XQuery sandbox.
        It does not work with all browsers yet though.
};

declare function sandbox:init-slots() as element()+ {
    for $i in 1 to 10 return

[{$i}] --- empty ---

};

(:~ Export the current query results into a new document in the database. :)
declare function sandbox:export($docName as xs:string) as element() {
    let $collection := request:get-parameter("collection", ())
    let $wrapper0 := request:get-parameter("wrapper", ())
    let $wrapper := if ($wrapper0) then $wrapper0 else "exist:result"
    let $cached := session:get-attribute("cached")
    return
        if (empty($cached)) then
            <error>No query results to export!</error>
        else
            let $newDoc :=
                element { $wrapper } { $cached }
            return
                util:catch("java.lang.Exception",
                    (let $dummy := xdb:store($collection, $docName, $newDoc, "text/xml") return <ajax-response/>),
                    <error>{$util:exception-message}</error>
                )
};

(:~ Append the given query to the query examples file or update an existing old query. :)
declare function sandbox:save-query($query as xs:string, $description as xs:string) as element() {
    let $root0 := /example-queries
    let $root :=
        if ($root0) then
            $root0
        else
            xdb:store("/db", "examples.xml", <example-queries/>, "text/xml")
    let $existing := $root/query[description = $description][1]
    let $newEntry :=
            <query>
                <description>{$description}</description>
                {$query}
            </query>
    return (
        if ($existing) then
            update replace $existing with $newEntry
        else
            update insert $newEntry into $root,
        <ajax-response/>
    )
};

(:~ Check if the passed query string would correctly compile. :)
declare function sandbox:check-query($query as xs:string) as element() {
    util:declare-option("exist:serialize", "media-type=text/xml omit-xml-declaration=no"),
    <ajax-response>
        { util:compile($query) }
    </ajax-response>
};

(:~ Retrieve a single query result. :)
declare function sandbox:retrieve($num as xs:integer) as element() {
    util:declare-option("exist:serialize", "media-type=text/xml omit-xml-declaration=no indent=no"),
    let $cached := session:get-attribute("cached")
    let $item :=
        <item num="{$num}">
            {$cached[$num]}
        </item>
    return
        transform:transform($item, doc($sandbox:XML_HIGHLIGHT_STYLE), ())
};

(:~ Execute a query :)
declare function sandbox:exec-query($qu as xs:string) as element() {
    let $startTime := util:system-time()
    let $results := util:eval($qu)
    let $elapsed :=
		string(seconds-from-duration(util:system-time() - $startTime))
	let $elapsedStr := concat(substring-before($elapsed, '.'), '.',
			substring(substring-after($elapsed, '.'), 1, 3))
    return (
        session:set-attribute("cached", $results),
        <result hits="{count($results)}" elapsed="{$elapsedStr}"/>
    )
};

declare function sandbox:query($qu as xs:string) as element() {
    util:declare-option("exist:serialize", "media-type=text/xml omit-xml-declaration=no"),
    util:catch("org.exist.xquery.XPathException",
         sandbox:exec-query($qu),
         <error>{$util:exception-message}</error>
    )
 };

declare function sandbox:display-page() as element() {
    util:declare-option("exist:serialize", "media-type=text/html method=xhtml"),

            <title>XQuery Sandbox</title>
            <meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/>
            <link type="text/css" href="styles/sandbox.css" rel="stylesheet"/>

xquery version "1.0";
(: $Id$ :)

declare namespace sandbox="http://exist-db.org/xquery/sandbox";
declare namespace system="http://exist-db.org/xquery/system";

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

declare option exist:serialize "method=xhtml indent=no";

(:~ Points to the location of the xml-highlight.xsl stylesheet stored in the database :)
declare variable $sandbox:XML_HIGHLIGHT_STYLE { "/db/sandbox/xml-highlight.xsl" };

(:~ The required stylesheets were not found in the db. Try to import them. :)
declare function sandbox:import-stylesheets() as xs:string* {
    let $home := system:get-exist-home()
    let $pathSep := util:system-property("file.separator")
    let $dir :=
			if (doc-available(concat("file:///", system:get-module-load-path(), "/stylesheets/xml-highlight.xsl")))
			then
				concat(system:get-module-load-path(), $pathSep, "stylesheets")
        	else if(ends-with($home, "WEB-INF")) then
        	    concat(substring-before($home, "WEB-INF"), "sandbox", $pathSep, "stylesheets")
        	else
               concat($home, $pathSep, "webapp", $pathSep, "sandbox", $pathSep, "stylesheets")
    let $col := xdb:create-collection("/db", "sandbox")
    return
        concat("Imported: ", xdb:store-files-from-pattern($col, $dir, "*.xsl", "text/xml"))
};

(:~ Check for stylesheets required for the application. Try to import them if they could not be found. :)
declare function sandbox:check-paths() as item()* {
    if (not(doc-available($sandbox:XML_HIGHLIGHT_STYLE))) then
        let $dummy := sandbox:import-stylesheets()
        return
            if (not(doc-available($sandbox:XML_HIGHLIGHT_STYLE))) then
                concat($sandbox:XML_HIGHLIGHT_STYLE, " not found! Please store this file into ",
                    "the database collection or the application will not work properly.")
            else ()
    else
        You can also try out an updated XQuery sandbox.
        It does not work with all browsers yet though.
};

declare function sandbox:init-slots() as element()+ {
    for $i in 1 to 10 return

[{$i}] --- empty ---

};

(:~ Export the current query results into a new document in the database. :)
declare function sandbox:export($docName as xs:string) as element() {
    let $collection := request:get-parameter("collection", ())
    let $wrapper0 := request:get-parameter("wrapper", ())
    let $wrapper := if ($wrapper0) then $wrapper0 else "exist:result"
    let $cached := session:get-attribute("cached")
    return
        if (empty($cached)) then
            <error>No query results to export!</error>
        else
            let $newDoc :=
                element { $wrapper } { $cached }
            return
                util:catch("java.lang.Exception",
                    (let $dummy := xdb:store($collection, $docName, $newDoc, "text/xml") return <ajax-response/>),
                    <error>{$util:exception-message}</error>
                )
};

(:~ Append the given query to the query examples file or update an existing old query. :)
declare function sandbox:save-query($query as xs:string, $description as xs:string) as element() {
    let $root0 := /example-queries
    let $root :=
        if ($root0) then
            $root0
        else
            xdb:store("/db", "examples.xml", <example-queries/>, "text/xml")
    let $existing := $root/query[description = $description][1]
    let $newEntry :=
            <query>
                <description>{$description}</description>
                {$query}
            </query>
    return (
        if ($existing) then
            update replace $existing with $newEntry
        else
            update insert $newEntry into $root,
        <ajax-response/>
    )
};

(:~ Check if the passed query string would correctly compile. :)
declare function sandbox:check-query($query as xs:string) as element() {
    util:declare-option("exist:serialize", "media-type=text/xml omit-xml-declaration=no"),
    <ajax-response>
        { util:compile($query) }
    </ajax-response>
};

(:~ Retrieve a single query result. :)
declare function sandbox:retrieve($num as xs:integer) as element() {
    util:declare-option("exist:serialize", "media-type=text/xml omit-xml-declaration=no indent=no"),
    let $cached := session:get-attribute("cached")
    let $item :=
        <item num="{$num}">
            {$cached[$num]}
        </item>
    return
        transform:transform($item, doc($sandbox:XML_HIGHLIGHT_STYLE), ())
};

(:~ Execute a query :)
declare function sandbox:exec-query($qu as xs:string) as element() {
    let $startTime := util:system-time()
    let $results := util:eval($qu)
    let $elapsed :=
		string(seconds-from-duration(util:system-time() - $startTime))
	let $elapsedStr := concat(substring-before($elapsed, '.'), '.',
			substring(substring-after($elapsed, '.'), 1, 3))
    return (
        session:set-attribute("cached", $results),
        <result hits="{count($results)}" elapsed="{$elapsedStr}"/>
    )
};

declare function sandbox:query($qu as xs:string) as element() {
    util:declare-option("exist:serialize", "media-type=text/xml omit-xml-declaration=no"),
    util:catch("org.exist.xquery.XPathException",
         sandbox:exec-query($qu),
         <error>{$util:exception-message}</error>
    )
 };

declare function sandbox:display-page() as element() {
    util:declare-option("exist:serialize", "media-type=text/html method=xhtml"),

            <title>XQuery Sandbox</title>
            <meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/>
            <link type="text/css" href="styles/sandbox.css" rel="stylesheet"/>


Fix for bug #897616.

Fix for bug #897616.

(: Schema for results :)
import schema default element namespace "http://www.w3.org/2005/02/query-test-XQTSResult" at "w3c_full_text_reportingresults/XQFTTSResult.xsd";

(: Test.xml file from ctest :)
declare variable $ctests as document-node() external;

if(fn:empty($ctests)) then
  fn:error()
else
  validate {
    <test-suite-result>
      <implementation
        name="Zorba"
        version="2.1, 'Basileia'"
        anonymous-result-column="false">

     <organization
        name='FLWOR Foundation'
        website="http://zorba-xquery.com/"
        anonymous="false" />

     <submittor
        name="Zorba Team"
        email="contact@zorba-xquery.com" />

     <description>

Zorba is a general purpose XQuery processor implementing in C++
        the W3C family of specifications. It is not an XML database.
        The query processor has been designed to be embeddable in a
        variety of environments such as other programming languages
        extended with XML processing capabilities, browsers,
        database servers, XML message dispatchers, or smartphones.
        Its architecture employes a modular design, which allows customizing
        the Zorba query processor to the environment’s needs.
        For more details please check out http://www.zorba-xquery.com.

      </description>

    {
      let $XQFTTSZorba := fn:doc("XQFTTS.xml")
      return
      (
        <implementation-defined-items>
        {
          for $idi in $XQFTTSZorba//*:implementation-defined-item
          return
             <implementation-defined-item name="{data($idi/@name)}" value="{data($idi/@value)}" />
        }
        </implementation-defined-items>,
        <features>{$XQFTTSZorba//*:feature}</features>,
        <context-properties>
        {
          for $cp in $XQFTTSZorba//*:context-property
          return
             <context-property name="{data($cp/@name)}" context-type="{data($cp/@context-type)}" value="{data($cp/@value)}" />
        }
        </context-properties>
      )
    }

    </implementation>

    <syntax>XQuery</syntax>

    <test-run dateRun="2011-11-28">
      <test-suite version="current"/>
      <transformation>
Standard
</transformation>
      <comparison>
Standard
</comparison>
      <otherComments>
XQFTTS taken from W3C CVS as of 2011-11-28.
</otherComments>
    </test-run>

    {
      for $test in $ctests/*:Site/*:Testing/*:Test
      let $testname := fn:tokenize(fn:data($test/*:Name), "/")[last()]
      order by $testname
      return
      <test-case
        name="{$testname}"
        result="{fn:substring(fn:data($test/@Status), 0, 5)}"
      />
     }
  </test-suite-result>
}

(: Schema for results :)
import schema default element namespace "http://www.w3.org/2005/02/query-test-XQTSResult" at "w3c_full_text_reportingresults/XQFTTSResult.xsd";

(: Test.xml file from ctest :)
declare variable $ctests as document-node() external;

if(fn:empty($ctests)) then
  fn:error()
else
  validate {
    <test-suite-result>
      <implementation
        name="Zorba"
        version='2.0.3'
        anonymous-result-column="false">

     <organization
        name='FLWOR Foundation'
        website="http://zorba-xquery.com/"
        anonymous="false" />

     <submittor
        name="Zorba Team"
        email="contact@zorba-xquery.com" />

     <description>

Zorba is a general purpose XQuery processor implementing in C++
        the W3C family of specifications. It is not an XML database.
        The query processor has been designed to be embeddable in a
        variety of environments such as other programming languages
        extended with XML processing capabilities, browsers,
        database servers, XML message dispatchers, or smartphones.
        Its architecture employes a modular design, which allows customizing
        the Zorba query processor to the environment’s needs.
        For more details please check out http://www.zorba-xquery.com.

      </description>

    {
      let $XQFTTSZorba := fn:doc("XQFTTS.xml")
      return
      (
        <implementation-defined-items>
        {
          for $idi in $XQFTTSZorba//*:implementation-defined-item
          return
             <implementation-defined-item name="{data($idi/@name)}" value="{data($idi/@value)}" />
        }
        </implementation-defined-items>,
        <features>{$XQFTTSZorba//*:feature}</features>,
        <context-properties>
        {
          for $cp in $XQFTTSZorba//*:context-property
          return
             <context-property name="{data($cp/@name)}" context-type="{data($cp/@context-type)}" value="{data($cp/@value)}" />
        }
        </context-properties>
        <context-properties>{$XQFTTSZorba//*:context-property}</context-properties>
      )
    }

    </implementation>

    <syntax>XQuery</syntax>

    <test-run dateRun="2011-09-23">
      <test-suite version="current"/>
      <transformation>
Standard
</transformation>
      <comparison>
Standard
</comparison>
      <otherComments>
XQFTTS taken from W3C CVS as of 2011-09-21.
</otherComments>
    </test-run>

    {
      for $test in $ctests/*:Site/*:Testing/*:Test
      let $testname := fn:tokenize(fn:data($test/*:Name), "/")[last()]
      order by $testname
      return
      <test-case
        name="{$testname}"
        result="{fn:substring(fn:data($test/@Status), 0, 5)}"
      />
     }
  </test-suite-result>
}


Combined with changes to index.py this now massively simplifies views down to a couple of boilerplate lines, and then HTML. This example demonstrates it.

declare default element namespace "http://www.w3.org/1999/xhtml";

import module namespace log="http://cefn.com/readinglog/log" at "lib/xq/log.xq";

log:webpage(
    for $doc in $log:collection return $doc//h1
)

declare default element namespace "http://www.w3.org/1999/xhtml";

declare namespace log="http://cefn.com/readinglog/log" ;

declare variable $filepaths as xs:string external;

declare variable $collection := for $token in tokenize($filepaths, ',') return doc(resolve-uri($token));

(: Returns all the document nodes of the XHTML note files :)
declare function log:menu(){

Item1

Item2

};

(: templates a webpage, including the nodes specified :)
declare function log:webpage($nodes){

		    <meta content="text/html; charset=utf-16" http-equiv="content-type"></meta>
			<link href="/style.css" rel="stylesheet" type="text/css"></link>

						Log

						{log:menu()}

						<form action="/search.xq">

									<input type="text" name="text" />
									<input type="submit" value="Search"/>

						</form>

								{$nodes}

};

log:webpage(
    for $doc in $collection return $doc//h1
)


renamed functions (run -> get, _ -> gen); overview format-param

module namespace crday  = "http://aac.ac.at/content_repository/data-ay";

import module namespace repo-utils =  "http://aac.ac.at/content_repository/utils" at  "repo-utils.xqm";
import module namespace diag =  "http://www.loc.gov/zing/srw/diagnostic/" at  "modules/diagnostics/diagnostics.xqm";

import module namespace xdb="http://exist-db.org/xquery/xmldb";
(:import module namespace diag =  "http://www.loc.gov/zing/srw/diagnostic/" at  "modules/diagnostics/diagnostics.xqm";
import module namespace util="http://exist-db.org/xquery/util";
import module namespace kwic="http://exist-db.org/xquery/kwic";
:)
declare namespace sru = "http://www.loc.gov/zing/srw/";
declare namespace fcs = "http://clarin.eu/fcs/1.0";
declare namespace cmd = "http://www.clarin.eu/cmd/";
(:declare namespace tei = "http://www.tei-c.org/ns/1.0";:)

declare variable $crday:docTypeTerms := "Terms";
declare variable $crday:defaultMaxDepth:= 8;

(:~ overload function with default format-param = htmlpage:)
declare function crday:display-overview($config-path as xs:string) as item()* {
 crday:display-overview($config-path, 'htmlpage')
};

(:~ creates a html-overview of the datasets based on the defined mappings (as linked to from config)

@param config-path path to the confing-file
@param format [raw, htmlpage, html] - raw: return only the produced table, html* :
@returns a html-table with overview of the datasets
:)
declare function crday:display-overview($config-path as xs:string, $format as xs:string ) as item()* {

       let $config := doc($config-path),
           $mappings := doc(repo-utils:config-value($config, 'mappings')),
           $baseadminurl := repo-utils:config-value($config, 'admin.url')

        let $opt := util:declare-option("exist:serialize", "media-type=text/html method=xhtml")

(:    {for $target in $config//target return {xs:string($target/@key)}	}
:)
let $overview :=

collection	path	size	ns	root-elem	base-elem	indexes	tests	struct

           { for $map in $mappings//map[@key]
                    let $map-key := $map/xs:string(@key),
                        $map-dbcoll-path := $map/xs:string(@path),
(:                        $map-dbcoll:= if ($map-dbcoll-path ne '' and xmldb:collection-available (($map-dbcoll-path,"")[1])) then collection($map-dbcoll-path) else (),                      :)
                          $map-dbcoll:= repo-utils:context-to-collection($map-key, $config),
                        $root-elems := for $elem in distinct-values($map-dbcoll/*/name()) return $elem,
                        $ns-uris := for $ns in distinct-values($map-dbcoll/namespace-uri(*)) return $ns,
                        $queries-doc-name := crday:check-queries-doc-name($config, $map-key),
                        $sturct-doc-name := repo-utils:gen-cache-id("structure", ($map-key,""), xs:string($crday:defaultMaxDepth)),
                        $invoke-href := concat($baseadminurl,'?x-context=', $map-key ,'&config=', $config-path, '&operation=' ),
                        $queries := if (repo-utils:is-in-cache($queries-doc-name, $config)) then
                                                view
                                              else (),
                        $structure := if (repo-utils:is-in-cache($sturct-doc-name, $config)) then
                                                view
                                              else ()
                    return

                        {$map-key}
                        {$map-dbcoll-path}
                        {count($map-dbcoll)}
                        {$ns-uris}
                        {$root-elems}
                        {$map/xs:string(@base_elem)}
                        {count($map/index)}
                        {$queries} [run]
                        {$structure} [run]

                        }

       return if ($format eq 'raw') then
                   $overview
                else
                   repo-utils:serialise-as($overview, $format, 'html', $config, ())
};

(: run or view (if available)
calls:
crday:query-internal($queries, $context as node()+, $result-path as xs:string, $result-filename as xs:string ) as item()* {
:)
declare function crday:get-query-internal($config as node(), $x-context as xs:string, $run-flag as xs:boolean) as item()* {

    let $testset := doc(repo-utils:config-value($config, 'tests.path')),

        $cache-path := repo-utils:config-value($config, 'cache.path'),
        $queries-doc-name := crday:check-queries-doc-name($config, $x-context),

  (: get the the results from cache, or create :)
  $result := if (exists($testset)) then
                if (repo-utils:is-in-cache($queries-doc-name, $config) and not($run-flag)) then
                    repo-utils:get-from-cache($queries-doc-name, $config)
                  else
                    let $context := repo-utils:context-to-collection($x-context, $config)
                    return if (exists($context)) then
                            crday:gen-query-internal($testset, $context, $x-context, $cache-path, $queries-doc-name)
                            (: no need to store, because already continuously stored during querying
                                 return repo-utils:store-in-cache($index-doc-name , $data, $config) :)
                           else
                            diag:diagnostics("general-error", concat("run-check-queries: no context: ", $x-context))
               else
                diag:diagnostics("general-error", concat("run-check-queries: no testset available: ", repo-utils:config-value($config, 'tests.path')))

(:  return $result:)
  return repo-utils:serialise-as($result, 'htmlpage', 'table', $config, ())
};

(:~ evaluates queries against given context and stores the result in aresult-file

@param $queries list of <xpath>-elements
@param $context nodeset to evaluate the queries against ($context shall be used in the queries)
@param $x-context string-key identifying the context
:)
declare function crday:gen-query-internal($queries, $context as node()*, $x-context as xs:string+, $result-path as xs:string, $result-filename as xs:string ) as item()* {

    (: collect the xpaths from the queries-list before fiddling with the namespace :)
    let $xpaths := $queries//xpath
    (:    let $context := repo-utils:context-to-collection($x-context, $config)
	   $context:= collection("/db/mdrepo-data/cmdi-providers"),	   :)

    let $result-store := xmldb:store($result-path ,  $result-filename, <result test="{$queries//test/xs:string(@id)}" context="{$x-context}" ></result>),
        $result-doc:= doc($result-store)

    let $ns-uri := namespace-uri($context[1]/*)
      (: dynamically declare a default namespace for the xpath-evaluation, if one is defined in current context
      WATCHME: this is not very reliable, mainly meant to handle default-ns: cmd :)
(:      $dummy := if (exists($ns-uri)) then util:declare-namespace("",$ns-uri) else () :)
    let $dummy := util:declare-namespace("",xs:anyURI($ns-uri))

    let $start-time := util:system-dateTime()
    let $upd-dummy :=
        for $xpath in $xpaths
            let $start-time := util:system-dateTime()
            let $answer := util:eval($xpath/text())
            let $duration := util:system-dateTime() - $start-time
           return update insert <xpath key="{$xpath/@key}" label="{$xpath/@label}" dur="{$duration}">{$answer}</xpath> into $result-doc/result

    return $result-doc
};

(:~ wrapper for the ay-xml function cares for storing the result or fetching a stored one
:)
declare function crday:get-ay-xml($config as node(), $x-context as xs:string+, $init-xpath as xs:string, $max-depth as xs:integer, $run-flag as xs:boolean ) as item()? {

  let $name := repo-utils:gen-cache-id("structure", ($x-context, $init-xpath), xs:string($max-depth)),
    $result :=
    if (repo-utils:is-in-cache($name, $config) and not($run-flag)) then
        repo-utils:get-from-cache($name, $config)
    else
      let $context := repo-utils:context-to-collection($x-context, $config)
      return if (exists($context)) then
                    let $data := crday:gen-ay-xml($context, $init-xpath, $max-depth)
                    return repo-utils:store-in-cache($name, $data,$config)
                  else
                    diag:diagnostics("general-error", concat("run-ay-xml: no context: ", $x-context))

  return repo-utils:serialise-as($result, 'htmlpage', 'terms', $config, ())
};

(:~ analyzes the xml-structure - sub-elements and text-nodes
in the context of given collection, starting from given xpath

@param $context nodeset to analyze
@param $path if starts-with '/' or = '' start directly at the $context, else eval on f 'descendants-or-self'-axis
            if $path empty - diagnostics
calls elem-r for recursive processing

@returns xml-with paths and numbers
:)
declare function crday:gen-ay-xml($context as item()*, $path as xs:string, $depth as xs:integer ) as element() {

  (:let $collection := collection($cr:dataPath),
  if ($collections[1] eq $cr:collectionRoot) then
  util:eval(fn:concat("$collection/descendant::IsPartOf[ft:query(., <query><term>", xdb:decode($coll), "</term></query>)]/ancestor-or-self::CMD/descendant-or-self::", $path))
  :)
  if (not(exists($path))) then
        diag:diagnostics("general-error", "ay-xml: no starting path provided")
    else
        let $ns-uri := namespace-uri($context[1]/*),
            $qname := $context[1]/*/name(),
            $prefix := if (exists(prefix-from-QName($qname))) then prefix-from-QName($qname) else "",
            $dummy := if (exists($ns-uri)) then util:declare-namespace($prefix,$ns-uri) else ()

        let $full-path := if (starts-with($path,'/') or $path = '') then
                             fn:concat("$context", $path)
                            else     fn:concat("$context/descendant-or-self::", $path)

       let $path-nodes := util:eval($full-path )

       let $entries := crday:elem-r($path-nodes, $path, $ns-uri, $depth, $depth),
     (:      $coll-names-value := if (fn:empty($collections)) then () else attribute colls {fn:string-join($collections, ",")},:)
             $dummy-undeclare-ns := util:declare-namespace("",xs:anyURI("")),
     	  $result := element {$crday:docTypeTerms} {
     (:      		  $coll-names-value,:)
           		  attribute depth {$depth},
           		  attribute created {fn:current-dateTime()},
           		  $entries
     		}
         return $result

};

(:~ goes down the xml-structure recursively and creates a summary about it along the way

namespace aware (handles namespace: none, default, explicit)
:)
declare function crday:elem-r($path-nodes as node()*, $path as xs:string, $ns as xs:anyURI?, $max-depth as xs:integer, $depth as xs:integer) as element() {
      let $path-count := count($path-nodes),
	$child-elements := $path-nodes/child::element(),
	$child-ns-qnames := if (exists($child-elements)) then distinct-values($child-elements/concat(namespace-uri(), '|', name())) else (),
	$nodes-child-terminal := if (empty($child-elements)) then $path-nodes else () (: Maybe some selected elements $child-elements[not(element())] later on :),
	$text-nodes := $nodes-child-terminal/text(),
	$text-count := count($text-nodes),
	$text-count-distinct := count(distinct-values($text-nodes)),
	$dummy-undeclare-ns := util:declare-namespace("",xs:anyURI(""))
	return
(:	<Term path="{fn:concat("//", $path)}" name="{text:groups($path, "/([^/]+)$")[last()]}" count="{$path-count}" count_text="{$text-count}"  count_distinct_text="{$text-count-distinct}">{ :)
	<Term path="{fn:concat("", translate($path,'/','.'))}" name="{(text:groups($path, "/([^/]+)$")[last()],$path)[1] }" count="{$path-count}" count_text="{$text-count}"  count_distinct_text="{$text-count-distinct}">{
	   (attribute ns {$ns},
	  if ($depth > 0) then
	    for $ns-qname in $child-ns-qnames[. != '']
	       let $ns-uri := substring-before($ns-qname, '|'),
	           $qname := substring-after($ns-qname, '|'),
	           $prefix := if (exists(prefix-from-QName($qname))) then prefix-from-QName($qname) else "",
	           (: dynamically declare a namespace for the next step, if one is defined in current context :)
	           $dummy := if (exists($ns-uri)) then util:declare-namespace($prefix,$ns-uri) else ()
	           return
	           crday:elem-r(util:eval(concat("$path-nodes/", $qname)), concat($path, '/', $qname), $ns-uri, $max-depth, $depth - 1)
	  else 'maxdepth'
	)}</Term>
};

(:~ return doc-name out of context and testset (from config) or empty string if testset does not exist :)
declare function crday:check-queries-doc-name($config as node(), $x-context as xs:string) as xs:string {
let $testset := doc(repo-utils:config-value($config, 'tests.path')),
    $testset-name := if (exists($testset)) then util:document-name($testset) else (),
    $sanitized-xcontext := repo-utils:sanitize-name($x-context)
 return if (exists($testset)) then repo-utils:gen-cache-id("queries", ($sanitized-xcontext, $testset-name),"") else ""

};

module namespace crday  = "http://aac.ac.at/content_repository/data-ay";

import module namespace repo-utils =  "http://aac.ac.at/content_repository/utils" at  "repo-utils.xqm";
import module namespace diag =  "http://www.loc.gov/zing/srw/diagnostic/" at  "modules/diagnostics/diagnostics.xqm";

import module namespace xdb="http://exist-db.org/xquery/xmldb";
(:import module namespace diag =  "http://www.loc.gov/zing/srw/diagnostic/" at  "modules/diagnostics/diagnostics.xqm";
import module namespace util="http://exist-db.org/xquery/util";
import module namespace kwic="http://exist-db.org/xquery/kwic";
:)
declare namespace sru = "http://www.loc.gov/zing/srw/";
declare namespace fcs = "http://clarin.eu/fcs/1.0";
declare namespace cmd = "http://www.clarin.eu/cmd/";
(:declare namespace tei = "http://www.tei-c.org/ns/1.0";:)

declare variable $crday:docTypeTerms := "Terms";

(:~ creates a html-overview of the datasets based on the defined mappings (as linked to from config)

@param config-path path to the confing-file
:)
declare function crday:display-overview($config-path as xs:string) as item()* {

       let $config := doc($config-path),
           $mappings := doc(repo-utils:config-value($config, 'mappings'))

        let $opt := util:declare-option("exist:serialize", "media-type=text/html method=xhtml")

(:    {for $target in $config//target return {xs:string($target/@key)}	}
:)
let $overview :=

collection	path	size	ns	root-elem	base-elem	indexes	tests

           { for $map in $mappings//map[@key]
                    let $map-key := $map/xs:string(@key),
                        $map-dbcoll-path := $map/xs:string(@path),
(:                        $map-dbcoll:= if ($map-dbcoll-path ne '' and xmldb:collection-available (($map-dbcoll-path,"")[1])) then collection($map-dbcoll-path) else (),                      :)
                          $map-dbcoll:= repo-utils:context-to-collection($map-key, $config),
                        $root-elems := for $elem in distinct-values($map-dbcoll/*/name()) return $elem,
                        $ns-uris := for $ns in distinct-values($map-dbcoll/namespace-uri(*)) return $ns,
                        $queries-doc-name := crday:check-queries-doc-name($config, $map-key),
                        $invoke-check-queries-href := concat('?x-context=', repo-utils:sanitize-name($map-key) ,'&config=', $config-path, '&operation=' ),
                        $queries := if (repo-utils:is-in-cache($queries-doc-name, $config)) then
                                                view
                                              else ()
                    return

                        {$map-key}
                        {$map-dbcoll-path}
                        {count($map-dbcoll)}
                        {$ns-uris}
                        {$root-elems}
                        {$map/xs:string(@base_elem)}
                        {count($map/index)}
                        {$queries} [run]

                        }

       return repo-utils:serialise-as($overview, 'htmlpage', 'html', $config, ())
};

(: actually: run or view (if available)
calls:
crday:query-internal($queries, $context as node()+, $result-path as xs:string, $result-filename as xs:string ) as item()* {
:)
declare function crday:run-check-queries($config as node(), $x-context as xs:string, $run-flag as xs:boolean) as item()* {

    let $testset := doc(repo-utils:config-value($config, 'tests.path')),

        $cache-path := repo-utils:config-value($config, 'cache.path'),
        $queries-doc-name := crday:check-queries-doc-name($config, $x-context),

  (: get the the results from cache, or create :)
  $result := if (exists($testset)) then
                if (repo-utils:is-in-cache($queries-doc-name, $config) and not($run-flag)) then
                    repo-utils:get-from-cache($queries-doc-name, $config)
                  else
                    let $context := repo-utils:context-to-collection($x-context, $config)
                    return crday:query-internal($testset, $context, $x-context, $cache-path, $queries-doc-name)
                    (: no need to store, because already continuously stored during querying
                    return repo-utils:store-in-cache($index-doc-name , $data, $config) :)
               else
                diag:diagnostics("general-error", concat("run-check-queries: no testset available: ", repo-utils:config-value($config, 'tests.path')))

(:  return $result:)
  return repo-utils:serialise-as($result, 'htmlpage', 'table', $config, ())
};

(:~ evaluates queries against given context and stores the result in aresult-file

@param $queries list of <xpath>-elements
@param $context nodeset to evaluate the queries against ($context shall be used in the queries)
@param $x-context string-key identifying the context
:)
declare function crday:query-internal($queries, $context as node()+, $x-context as xs:string+, $result-path as xs:string, $result-filename as xs:string ) as item()* {

    (: collect the xpaths from the queries-list before fiddling with the namespace :)
    let $xpaths := $queries//xpath
    (:    let $context := repo-utils:context-to-collection($x-context, $config)
	   $context:= collection("/db/mdrepo-data/cmdi-providers"),	   :)

    let $result-store := xmldb:store($result-path ,  $result-filename, <result test="{$queries//test/xs:string(@id)}" context="{$x-context}" ></result>),
        $result-doc:= doc($result-store)

    let $ns-uri := namespace-uri($context[1]/*)
      (: dynamically declare a default namespace for the xpath-evaluation, if one is defined in current context
      WATCHME: this is not very reliable, mainly meant to handle default-ns: cmd :)
(:      $dummy := if (exists($ns-uri)) then util:declare-namespace("",$ns-uri) else () :)
    let $dummy := util:declare-namespace("",xs:anyURI($ns-uri))

    let $start-time := util:system-dateTime()
    let $upd-dummy :=
        for $xpath in $xpaths
            let $start-time := util:system-dateTime()
            let $answer := util:eval($xpath/text())
            let $duration := util:system-dateTime() - $start-time
           return update insert <xpath key="{$xpath/@key}" label="{$xpath/@label}" dur="{$duration}">{$answer}</xpath> into $result-doc/result

    return $result-doc

};

(:~ analyze xml-structure
  API function queryModel.
:)
(:declare function crday:ay-xml-wrap($init-xpath as xs:string, $collection as xs:string+, $max-depth as xs:integer) as item()? {

  let $name := repo-utils:gen-cache-id("model", ($collection, $cmd-index-path), xs:string($max-depth)),
    $doc :=
    if (repo-utils:is-in-cache($name)) then
      repo-utils:get-from-cache($name)
    else
      let $data := cr:elem($collection, $cmd-index-path, $max-depth)
        return repo-utils:store-in-cache($name, $data)

  return $doc
};
:)

(:~ analyzes the xml-structure - sub-elements and text-nodes
in the context of given collection, starting from given xpath

@param $context nodeset to analyze
@param $path if starts-with '/' or = '' start directly at the $context, else eval on f 'descendants-or-self'-axis
            if $path empty - diagnostics
calls elem-r for recursive processing

@returns xml-with paths and numbers
:)
declare function crday:ay-xml($context as item()*, $path as xs:string, $depth as xs:integer ) as element() {

  (:let $collection := collection($cr:dataPath),
  if ($collections[1] eq $cr:collectionRoot) then
  util:eval(fn:concat("$collection/descendant::IsPartOf[ft:query(., <query><term>", xdb:decode($coll), "</term></query>)]/ancestor-or-self::CMD/descendant-or-self::", $path))
  :)
  if (not(exists($path))) then
        diag:diagnostics("general-error", "ay-xml: no starting path provided")
    else
        let $ns-uri := namespace-uri($context[1]/*),
            $qname := $context[1]/*/name(),
            $prefix := if (exists(prefix-from-QName($qname))) then prefix-from-QName($qname) else "",
            $dummy := if (exists($ns-uri)) then util:declare-namespace($prefix,$ns-uri) else ()

        let $full-path := if (starts-with($path,'/') or $path = '') then
                             fn:concat("$context", $path)
                            else     fn:concat("$context/descendant-or-self::", $path)

       let $path-nodes := util:eval($full-path )

       let $entries := crday:elem-r($path-nodes, $path, $ns-uri, $depth, $depth),
     (:      $coll-names-value := if (fn:empty($collections)) then () else attribute colls {fn:string-join($collections, ",")},:)
             $dummy-undeclare-ns := util:declare-namespace("",xs:anyURI("")),
     	  $result := element {$crday:docTypeTerms} {
     (:      		  $coll-names-value,:)
           		  attribute depth {$depth},
           		  attribute created {fn:current-dateTime()},
           		  $entries
     		}
         return $result

};

(:~ goes down the xml-structure recursively and creates a summary about it along the way

namespace aware (handles namespace: none, default, explicit)
:)
declare function crday:elem-r($path-nodes as node()*, $path as xs:string, $ns as xs:anyURI?, $max-depth as xs:integer, $depth as xs:integer) as element() {
      let $path-count := count($path-nodes),
	$child-elements := $path-nodes/child::element(),
	$child-ns-qnames := if (exists($child-elements)) then distinct-values($child-elements/concat(namespace-uri(), '|', name())) else (),
	$nodes-child-terminal := if (empty($child-elements)) then $path-nodes else () (: Maybe some selected elements $child-elements[not(element())] later on :),
	$text-nodes := $nodes-child-terminal/text(),
	$text-count := count($text-nodes),
	$text-count-distinct := count(distinct-values($text-nodes)),
	$dummy-undeclare-ns := util:declare-namespace("",xs:anyURI(""))
	return
(:	<Term path="{fn:concat("//", $path)}" name="{text:groups($path, "/([^/]+)$")[last()]}" count="{$path-count}" count_text="{$text-count}"  count_distinct_text="{$text-count-distinct}">{ :)
	<Term path="{fn:concat("", translate($path,'/','.'))}" name="{(text:groups($path, "/([^/]+)$")[last()],$path)[1] }" count="{$path-count}" count_text="{$text-count}"  count_distinct_text="{$text-count-distinct}">{
	   (attribute ns {$ns},
	  if ($depth > 0) then
	    for $ns-qname in $child-ns-qnames[. != '']
	       let $ns-uri := substring-before($ns-qname, '|'),
	           $qname := substring-after($ns-qname, '|'),
	           $prefix := if (exists(prefix-from-QName($qname))) then prefix-from-QName($qname) else "",
	           (: dynamically declare a namespace for the next step, if one is defined in current context :)
	           $dummy := if (exists($ns-uri)) then util:declare-namespace($prefix,$ns-uri) else ()
	           return
	           crday:elem-r(util:eval(concat("$path-nodes/", $qname)), concat($path, '/', $qname), $ns-uri, $max-depth, $depth - 1)
	  else 'maxdepth'
	)}</Term>
};

(:~ return doc-name out of context and testset (from config) or empty string if testset does not exist :)
declare function crday:check-queries-doc-name($config as node(), $x-context as xs:string) as xs:string {
let $testset := doc(repo-utils:config-value($config, 'tests.path')),
    $testset-name := if (exists($testset)) then util:document-name($testset) else (),
    $sanitized-xcontext := repo-utils:sanitize-name($x-context)
 return if (exists($testset)) then repo-utils:gen-cache-id("queries", ($sanitized-xcontext, $testset-name),"") else ""

};


Added link to new sandbox for those who want to experiment.

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

xquery version "1.0";
(: $Id$ :)

declare namespace sandbox="http://exist-db.org/xquery/sandbox";
declare namespace system="http://exist-db.org/xquery/system";

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

declare option exist:serialize "method=xhtml indent=no";

(:~ Points to the location of the xml-highlight.xsl stylesheet stored in the database :)
declare variable $sandbox:XML_HIGHLIGHT_STYLE { "/db/sandbox/xml-highlight.xsl" };

(:~ The required stylesheets were not found in the db. Try to import them. :)
declare function sandbox:import-stylesheets() as xs:string* {
    let $home := system:get-exist-home()
    let $pathSep := util:system-property("file.separator")
    let $dir :=
			if (doc-available(concat("file:///", system:get-module-load-path(), "/stylesheets/xml-highlight.xsl")))
			then
				concat(system:get-module-load-path(), $pathSep, "stylesheets")
        	else if(ends-with($home, "WEB-INF")) then
        	    concat(substring-before($home, "WEB-INF"), "sandbox", $pathSep, "stylesheets")
        	else
               concat($home, $pathSep, "webapp", $pathSep, "sandbox", $pathSep, "stylesheets")
    let $col := xdb:create-collection("/db", "sandbox")
    return
        concat("Imported: ", xdb:store-files-from-pattern($col, $dir, "*.xsl", "text/xml"))
};

(:~ Check for stylesheets required for the application. Try to import them if they could not be found. :)
declare function sandbox:check-paths() as item()* {
    if (not(doc-available($sandbox:XML_HIGHLIGHT_STYLE))) then
        let $dummy := sandbox:import-stylesheets()
        return
            if (not(doc-available($sandbox:XML_HIGHLIGHT_STYLE))) then
                concat($sandbox:XML_HIGHLIGHT_STYLE, " not found! Please store this file into ",
                    "the database collection or the application will not work properly.")
            else ()
    else
        You can also try out an updated XQuery sandbox.
        It does not work with all browsers yet though.
};

declare function sandbox:init-slots() as element()+ {
    for $i in 1 to 10 return

[{$i}] --- empty ---

};

(:~ Export the current query results into a new document in the database. :)
declare function sandbox:export($docName as xs:string) as element() {
    let $collection := request:get-parameter("collection", ())
    let $wrapper0 := request:get-parameter("wrapper", ())
    let $wrapper := if ($wrapper0) then $wrapper0 else "exist:result"
    let $cached := session:get-attribute("cached")
    return
        if (empty($cached)) then
            <error>No query results to export!</error>
        else
            let $newDoc :=
                element { $wrapper } { $cached }
            return
                util:catch("java.lang.Exception",
                    (let $dummy := xdb:store($collection, $docName, $newDoc, "text/xml") return <ajax-response/>),
                    <error>{$util:exception-message}</error>
                )
};

(:~ Append the given query to the query examples file or update an existing old query. :)
declare function sandbox:save-query($query as xs:string, $description as xs:string) as element() {
    let $root0 := /example-queries
    let $root :=
        if ($root0) then
            $root0
        else
            xdb:store("/db", "examples.xml", <example-queries/>, "text/xml")
    let $existing := $root/query[description = $description][1]
    let $newEntry :=
            <query>
                <description>{$description}</description>
                {$query}
            </query>
    return (
        if ($existing) then
            update replace $existing with $newEntry
        else
            update insert $newEntry into $root,
        <ajax-response/>
    )
};

(:~ Check if the passed query string would correctly compile. :)
declare function sandbox:check-query($query as xs:string) as element() {
    util:declare-option("exist:serialize", "media-type=text/xml omit-xml-declaration=no"),
    <ajax-response>
        { util:compile($query) }
    </ajax-response>
};

(:~ Retrieve a single query result. :)
declare function sandbox:retrieve($num as xs:integer) as element() {
    util:declare-option("exist:serialize", "media-type=text/xml omit-xml-declaration=no indent=no"),
    let $cached := session:get-attribute("cached")
    let $item :=
        <item num="{$num}">
            {$cached[$num]}
        </item>
    return
        transform:transform($item, doc($sandbox:XML_HIGHLIGHT_STYLE), ())
};

(:~ Execute a query :)
declare function sandbox:exec-query($qu as xs:string) as element() {
    let $startTime := util:system-time()
    let $results := util:eval($qu)
    let $elapsed :=
		string(seconds-from-duration(util:system-time() - $startTime))
	let $elapsedStr := concat(substring-before($elapsed, '.'), '.',
			substring(substring-after($elapsed, '.'), 1, 3))
    return (
        session:set-attribute("cached", $results),
        <result hits="{count($results)}" elapsed="{$elapsedStr}"/>
    )
};

declare function sandbox:query($qu as xs:string) as element() {
    util:declare-option("exist:serialize", "media-type=text/xml omit-xml-declaration=no"),
    util:catch("org.exist.xquery.XPathException",
         sandbox:exec-query($qu),
         <error>{$util:exception-message}</error>
    )
 };

declare function sandbox:display-page() as element() {
    util:declare-option("exist:serialize", "media-type=text/html method=xhtml"),

            <title>XQuery Sandbox</title>
            <meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/>
            <link type="text/css" href="styles/sandbox.css" rel="stylesheet"/>

xquery version "1.0";
(: $Id$ :)

declare namespace sandbox="http://exist-db.org/xquery/sandbox";
declare namespace system="http://exist-db.org/xquery/system";

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

declare option exist:serialize "method=xhtml indent=no";

(:~ Points to the location of the xml-highlight.xsl stylesheet stored in the database :)
declare variable $sandbox:XML_HIGHLIGHT_STYLE { "/db/sandbox/xml-highlight.xsl" };

(:~ The required stylesheets were not found in the db. Try to import them. :)
declare function sandbox:import-stylesheets() as xs:string* {
    let $home := system:get-exist-home()
    let $pathSep := util:system-property("file.separator")
    let $dir :=
			if (doc-available(concat("file:///", system:get-module-load-path(), "/stylesheets/xml-highlight.xsl")))
			then
				concat(system:get-module-load-path(), $pathSep, "stylesheets")
        	else if(ends-with($home, "WEB-INF")) then
        	    concat(substring-before($home, "WEB-INF"), "sandbox", $pathSep, "stylesheets")
        	else
               concat($home, $pathSep, "webapp", $pathSep, "sandbox", $pathSep, "stylesheets")
    let $col := xdb:create-collection("/db", "sandbox")
    return
        concat("Imported: ", xdb:store-files-from-pattern($col, $dir, "*.xsl", "text/xml"))
};

(:~ Check for stylesheets required for the application. Try to import them if they could not be found. :)
declare function sandbox:check-paths() as xs:string* {
    if (not(doc-available($sandbox:XML_HIGHLIGHT_STYLE))) then
        let $dummy := sandbox:import-stylesheets()
        return
            if (not(doc-available($sandbox:XML_HIGHLIGHT_STYLE))) then
                concat($sandbox:XML_HIGHLIGHT_STYLE, " not found! Please store this file into ",
                    "the database collection or the application will not work properly.")
            else ()
    else ()
};

declare function sandbox:init-slots() as element()+ {
    for $i in 1 to 10 return

[{$i}] --- empty ---

};

(:~ Export the current query results into a new document in the database. :)
declare function sandbox:export($docName as xs:string) as element() {
    let $collection := request:get-parameter("collection", ())
    let $wrapper0 := request:get-parameter("wrapper", ())
    let $wrapper := if ($wrapper0) then $wrapper0 else "exist:result"
    let $cached := session:get-attribute("cached")
    return
        if (empty($cached)) then
            <error>No query results to export!</error>
        else
            let $newDoc :=
                element { $wrapper } { $cached }
            return
                util:catch("java.lang.Exception",
                    (let $dummy := xdb:store($collection, $docName, $newDoc, "text/xml") return <ajax-response/>),
                    <error>{$util:exception-message}</error>
                )
};

(:~ Append the given query to the query examples file or update an existing old query. :)
declare function sandbox:save-query($query as xs:string, $description as xs:string) as element() {
    let $root0 := /example-queries
    let $root :=
        if ($root0) then
            $root0
        else
            xdb:store("/db", "examples.xml", <example-queries/>, "text/xml")
    let $existing := $root/query[description = $description][1]
    let $newEntry :=
            <query>
                <description>{$description}</description>
                {$query}
            </query>
    return (
        if ($existing) then
            update replace $existing with $newEntry
        else
            update insert $newEntry into $root,
        <ajax-response/>
    )
};

(:~ Check if the passed query string would correctly compile. :)
declare function sandbox:check-query($query as xs:string) as element() {
    util:declare-option("exist:serialize", "media-type=text/xml omit-xml-declaration=no"),
    <ajax-response>
        { util:compile($query) }
    </ajax-response>
};

(:~ Retrieve a single query result. :)
declare function sandbox:retrieve($num as xs:integer) as element() {
    util:declare-option("exist:serialize", "media-type=text/xml omit-xml-declaration=no indent=no"),
    let $cached := session:get-attribute("cached")
    let $item :=
        <item num="{$num}">
            {$cached[$num]}
        </item>
    return
        transform:transform($item, doc($sandbox:XML_HIGHLIGHT_STYLE), ())
};

(:~ Execute a query :)
declare function sandbox:exec-query($qu as xs:string) as element() {
    let $startTime := util:system-time()
    let $results := util:eval($qu)
    let $elapsed :=
		string(seconds-from-duration(util:system-time() - $startTime))
	let $elapsedStr := concat(substring-before($elapsed, '.'), '.',
			substring(substring-after($elapsed, '.'), 1, 3))
    return (
        session:set-attribute("cached", $results),
        <result hits="{count($results)}" elapsed="{$elapsedStr}"/>
    )
};

declare function sandbox:query($qu as xs:string) as element() {
    util:declare-option("exist:serialize", "media-type=text/xml omit-xml-declaration=no"),
    util:catch("org.exist.xquery.XPathException",
         sandbox:exec-query($qu),
         <error>{$util:exception-message}</error>
    )
 };

declare function sandbox:display-page() as element() {
    util:declare-option("exist:serialize", "media-type=text/html method=xhtml"),

            <title>XQuery Sandbox</title>
            <meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/>
            <link type="text/css" href="styles/sandbox.css" rel="stylesheet"/>


- XQDoc Examples as copied in a location that is later on picked up by the new-website branch - XQDoc Schemas and actual code for the modules is generated as XML and is also picked up by the new-website branch

(:
 : Copyright 2006-2009 The FLWOR Foundation.
 :
 : 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.
:)
import module namespace file = "http://expath.org/ns/file";

import module namespace xqdoc       = "http://www.zorba-xquery.com/modules/xqdoc";
import module namespace batch       = "http://www.zorba-xquery.com/modules/xqdoc/batch";
import module namespace fetch = "http://www.zorba-xquery.com/modules/fetch";
import module namespace xqdoc-html  = "http://www.zorba-xquery.com/xqdoc-html" at "xqdoc-html.xqy";

declare namespace xqd = "http://www.xqdoc.org/1.0";
declare namespace z   = "http://zorba.io/manifest";
declare namespace xs  = "http://www.w3.org/2001/XMLSchema";

declare variable $zorbaManifestPath   as xs:string external;
declare variable $xhtmlRequisitesPath as xs:string external;
declare variable $xqdocBuildPath      as xs:string external;
declare variable $zorbaVersion        as xs:string external;

declare variable $slash := file:directory-separator();
declare variable $serXML:= <output:serialization-parameters xmlns:output="http://www.w3.org/2010/xslt-xquery-serialization">
                             <output:method   value="xml" />
                             <output:encoding value="UTF-8"/>
                           </output:serialization-parameters>;

declare %private function local:write-Doxygen(
  $content,
  $name as xs:string,
  $uri as xs:string?,
  $type as xs:string){
fn:serialize(<doxygen><compounddef id="{$name}-{$type}" kind="{$type}">
               <detaileddescription><para><h3>{concat("Content of ", $uri, " " , $type)}</h3><programlisting type="{$type}">{fn:serialize($content,$serXML)}</programlisting></para></detaileddescription>
             </compounddef></doxygen>,$serXML)
};

(: Delete previous version of the documentation :)
if(file:exists($xqdocBuildPath))
then file:delete($xqdocBuildPath);
else ();

(: Copy Schemas :)
file:create-directory($xqdocBuildPath || $slash ||  "schemas");
file:create-directory($xqdocBuildPath || $slash || "xml");
let $base := $xhtmlRequisitesPath || $slash || ".." || $slash || ".." || $slash || ".." || $slash
let $dest := $xqdocBuildPath || $slash || "xml"
for $schema in file:list($base, true(), "*.xsd")
where not(ends-with($schema, ".ent.xsd")) and not(ends-with($schema, ".dtd.xsd"))
let $schema-doc := doc($base || $slash || trace($schema, "schema"))
let $target-uri := $schema-doc/xs:schema/@targetNamespace/string()
let $name := replace(replace($target-uri, "http://", ""), "/", "_")
return {
  (file:write-text($xqdocBuildPath || $slash || "schemas" || $slash || $name || ".xsd", $schema-doc),
  file:write-text($dest || $slash || replace(replace($target-uri, "http://", ""), "/", "_") || "-schema.xml",
                  local:write-Doxygen($schema-doc, $name, $target-uri, "schema"))
  )
};

file:create-directory($xqdocBuildPath || $slash ||  "examples");
variable $manifest := parse-xml(file:read-text($zorbaManifestPath));
for $module in $manifest/z:manifest/z:module
let $uri := $module/z:uri/text()
let $xqdoc := xqdoc:xqdoc($uri)
let $module-name := tokenize($uri,"/")[last()]
return {
  (: Copy Examples :)
  for $example in $xqdoc//xqd:custom[@tag="example"]/text()
  let $source := $module/z:projectRoot/text() || $slash || $example
  let $test-name := trace(tokenize($source,"/")[last()], "example-name")
  let $destination := $xqdocBuildPath || $slash ||  "examples" || $slash || concat($module-name, "_", $test-name)
  let $dest := $xqdocBuildPath || $slash ||  "xml" || $slash || concat($module-name, "_", substring-before($test-name,".xq")) || "-example.xml"
  return {
    file:copy($source, $destination);
    (:
    file:write-text($dest,
                   local:write-Doxygen(file:read-text($source),substring-before($destination,".xq"), "example")); :)
  }
}

(: XQDoc Batch :)
let $static-folders := ("js", "css", "images")
let $static-folders := for $static in $static-folders return $xhtmlRequisitesPath || $slash || $static
let $template := parse-xml(file:read-text($xhtmlRequisitesPath || $slash || "template.xml"))/*
let $output-folder := $xqdocBuildPath
let $modules := xqdoc-html:modules($manifest)
return batch:build-xqdoc($output-folder, $static-folders, $template, $modules);

(: Copy modules :)
for $module in $manifest/z:manifest/z:module
let $uri := $module/z:uri/text()
let $module := fetch:content($uri, "MODULE")
return
  file:write-text($xqdocBuildPath || $slash || "xml" || $slash || replace(substring-after($uri, "http://"),"/","_") || "-module.xml",
                  local:write-Doxygen($module, tokenize($uri,"/")[last()], $uri, "module"));

trace("","XQDoc generated successfully!");

(:
 : Copyright 2006-2009 The FLWOR Foundation.
 :
 : 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.
:)
import module namespace file = "http://expath.org/ns/file";

import module namespace xqdoc       = "http://www.zorba-xquery.com/modules/xqdoc";
import module namespace batch       = "http://www.zorba-xquery.com/modules/xqdoc/batch";
import module namespace xqdoc-html  = "http://www.zorba-xquery.com/xqdoc-html" at "xqdoc-html.xqy";

declare namespace xqd = "http://www.xqdoc.org/1.0";
declare namespace z   = "http://zorba.io/manifest";
declare namespace xs  = "http://www.w3.org/2001/XMLSchema";

declare variable $zorbaManifestPath   as xs:string external;
declare variable $xhtmlRequisitesPath as xs:string external;
declare variable $xqdocBuildPath      as xs:string external;
declare variable $zorbaVersion        as xs:string external;

declare variable $slash := file:directory-separator();

(: Delete previous version of the documentation :)
if(file:exists($xqdocBuildPath))
then file:delete($xqdocBuildPath);
else ();

(: Copy Schemas :)
file:create-directory($xqdocBuildPath || $slash ||  "schemas");
let $base := $xhtmlRequisitesPath || $slash || ".." || $slash || ".." || $slash || ".." || $slash
for $schema in file:list($base, true(), "*.xsd")
where not(ends-with($schema, ".ent.xsd")) and not(ends-with($schema, ".dtd.xsd"))
let $schema-doc := doc($base || $slash || trace($schema, "schema"))
let $target-uri := $schema-doc/xs:schema/@targetNamespace/string()
return {
  file:write-text($xqdocBuildPath || $slash || "schemas" || $slash || replace(replace($target-uri, "http://", ""), "/", "_") || ".xsd", $schema-doc)
};

file:create-directory($xqdocBuildPath || $slash ||  "examples");
variable $manifest := parse-xml(file:read-text($zorbaManifestPath));
for $module in $manifest/z:manifest/z:module
let $uri := $module/z:uri/text()
let $xqdoc := xqdoc:xqdoc($uri)
let $module-name := tokenize($uri,"/")[last()]
return {
  (: Copy Examples :)
  for $example in $xqdoc//xqd:custom[@tag="example"]/text()
  let $source := $module/z:projectRoot/text() || $slash || $example
  let $test-name := trace(tokenize($source,"/")[last()], "example-name")
  let $destination := $xqdocBuildPath || $slash ||  "examples" || $slash || concat($module-name, "_", $test-name)
  let $base-dest := file:dir-name($destination)
  return {
    file:create-directory($base-dest);
    file:copy($source, $destination);
  }
}

(: XQDoc Batch :)
let $static-folders := ("js", "css", "images")
let $static-folders := for $static in $static-folders return $xhtmlRequisitesPath || $slash || $static
let $template := parse-xml(file:read-text($xhtmlRequisitesPath || $slash || "template.xml"))/*
let $output-folder := $xqdocBuildPath
let $modules := xqdoc-html:modules($manifest)
return batch:build-xqdoc($output-folder, $static-folders, $template, $modules);
trace("","XQDoc generated successfully!");


Fix the basex client module namespace.

Fix the basex client module namespace.

xquery version "3.0";
(:~
 : BaseX client module functions
 :
 : @see http://docs.basex.org/wiki/Client_Module
 :)
module namespace client = "http://basex.org/modules/client";

import module namespace a = "http://reecedunn.co.uk/xquery/annotations" at "res://reecedunn.co.uk/xquery/annotations.xqy";

declare %a:since("basex", "7.3") function client:connect($host as xs:string, $port as xs:integer, $user as xs:string, $password as xs:string) as xs:anyURI external;
declare %a:since("basex", "7.3") function client:execute($id as xs:anyURI, $command as xs:string) as xs:string external;
declare %a:since("basex", "7.5") function client:info($id as xs:anyURI) as xs:string external;
declare %a:since("basex", "7.3") function client:query($id as xs:anyURI, $query as xs:string) as item()* external;
declare %a:since("basex", "7.3") function client:query($id as xs:anyURI, $query as xs:string, $bindings (: as [7.3]map(*) [8.0]map(*)? :)) as item()* external;
declare %a:since("basex", "7.3") function client:close($id as xs:anyURI) as empty-sequence() external;

xquery version "3.0";
(:~
 : BaseX client module functions
 :
 : @see http://docs.basex.org/wiki/Client_Module
 :)
module namespace client = "http://basex.org/";

import module namespace a = "http://reecedunn.co.uk/xquery/annotations" at "res://reecedunn.co.uk/xquery/annotations.xqy";

declare %a:since("basex", "7.3") function client:connect($host as xs:string, $port as xs:integer, $user as xs:string, $password as xs:string) as xs:anyURI external;
declare %a:since("basex", "7.3") function client:execute($id as xs:anyURI, $command as xs:string) as xs:string external;
declare %a:since("basex", "7.5") function client:info($id as xs:anyURI) as xs:string external;
declare %a:since("basex", "7.3") function client:query($id as xs:anyURI, $query as xs:string) as item()* external;
declare %a:since("basex", "7.3") function client:query($id as xs:anyURI, $query as xs:string, $bindings (: as [7.3]map(*) [8.0]map(*)? :)) as item()* external;
declare %a:since("basex", "7.3") function client:close($id as xs:anyURI) as empty-sequence() external;


Updates to imaging library.

Updates to imaging library.

  * Changed the paint interface so that the functions clearly state that it is an error if a faulty color string is passed.

(:~
 : This module provides functions to handle basic painting operations on images.
 : These functions will not work on svg images.
 : Colors have to be in hexidecimal rgb  with leading '#', e.g. '#000000' for black.
 :
 : @author Daniel Thomas
 : @version 0.1
 :)
module namespace paint = 'http://www.zorba-xquery.com/modules/image/paint';
import module namespace paintschema = 'http://www.zorba-xquery.com/modules/image/paintschema';

(:~
 : Contains the definitions of the possible image types.
 :)
import schema namespace image = 'http://www.zorba-xquery.com/modules/image/image';

 (:~
  : Draws a line on the passed image from $start-x, start-y to $end-x, $end-y.
  : If no color is passed, then a black line is drawn.
  : Coordinates that in any way are not inside the image will generate a line to the hypothetical point beyond the border of the image that discontinues at the border.
  :
  :
  : @param $image is the image to paint a line to.
  : @param $start-x is the horizontal starting point of the line.
  : @param $start-y is the vertical starting point of the line.
  : @param $end-x is the horizontal end point of the line.
  : @param $end-y is the vertical end point of the line.
  : @param $stroke-color is the color with which the line should be painted (default: #000000, black).
  : @param $stroke-width is the width of the line that should be painted (default is 1).
  : @param $anti-aliasing defines if anti-aliasing should be used (default is false).
  : @return A new image with the line painted as specified.
  : @error If the passed xs:base64Binary is not a valid image.
  : @error If the passed color string  is not a valid color.
  :)
declare function paint:draw-line($image as xs:base64Binary, $start-x as xs:double, $start-y as xs:double, $end-x as xs:double, $end-y as xs:double, $stroke-color as xs:string?, $stroke-width as xs:double?, $anti-aliasing as xs:boolean?) as xs:base64Binary {
    paint:draw-poly-line($image, ($start-x, $end-x), ($start-y, $end-y), $stroke-color, $stroke-width, $anti-aliasing)
};

(:~
 : Draws a poly-line (different adjascent line segments) to the passed image with a specified color.
 : Make sure that both $x-values and $y-values have the same count, only coordinates that have an x and a y value will be included in the poly-line.
 : A line segment is painted always from $x-value[n], $y-value[n] to $x-value[n+1], $y-value[n+1], starting at $x-value[0], $y-value[0].
 : Passing only one x-value or y-value can lead to strange and rather unpredictable lines, whereas passing two x-values an y-values will just paint a simple line with the specified coordinates.
 :
 : @param $image is the image to paint a poly-line to.
 : @param $x-values are the horizontal values of the different line segment starting/ending points.
 : @param $y-values are the vertical values of the different line segment starting/ending points.
 : @param $stroke-color is the color with which the line should be painted (default: #000000, black).
 : @param $stroke-width is the width of the line that should be painted (default is 1, equal or smaller than 1 will result in the thinnest possible line drawn).
 : @param $anti-aliasing defines if anti-aliasing should be used (default is false).
 : @return A new image with the specified poly-line painted.
 : @error If the passed xs:base64Binary is not a valid image.
 : @error If the passed color string  is not a valid color.
 :)
declare function paint:draw-poly-line($image as xs:base64Binary, $x-values as xs:double+, $y-values as xs:double+, $stroke-color as xs:string?,  $stroke-width as xs:double?, $anti-aliasing as xs:boolean?)  as xs:base64Binary {
  paint:draw-stroked-poly-line($image, $x-values, $y-values, 1, 0, $stroke-color, $stroke-width, $anti-aliasing);
};

(:~
 : Draws a stroked poly-line (different adjascent line segments which are painted as short strokes of a specified width) with the specified color.
 : Make sure that both $x-values and $y-values have the same count.
 : A line segment is painted always from $x-value[n], $y-value[n] to $x-value[n+1], $y-value[n+1], starting at $x-value[0], $y-value[0].
 : If no color is passed, the default color for this image will be taken.
 :
 : @param $image is the image to paint a stroked poly-line to.
 : @param $x-values are the horizontal values of the different line segment starting/ending points.
 : @param $y-values are the vertical values of the different line segment starting/ending points.
 : @param $stroke-length is the length of the strokes with which the line segments are painted.
 : @param $gap-length is the length of the gaps between the strokes.
 : @param $stroke-color is the color with which the line should be painted (default: #000000, black)
 : @param $stroke-width is the width of the line that should be painted (default is 1, equal or smaller than 1 will result in the thinnest possible line drawn).
 : @param $anti-aliasing defines if anti-aliasing should be used (default is false).
 : @return A new image with the specified stroked poly-kube painted.
 : @error If the passed xs:base64Binary is not a valid image.
 : @error If the passed color string  is not a valid color.
 :)
declare function paint:draw-stroked-poly-line($image as xs:base64Binary, $x-values as xs:double+, $y-values as xs:double+, $stroke-length as xs:double, $gap-length as xs:double, $stroke-color as xs:string?, $stroke-width as xs:double?, $anti-aliasing as xs:boolean?) as xs:base64Binary {
  paintschema:draw-stroked-poly-line($image, $x-values, $y-values, $stroke-length, $gap-length, image:colorType($stroke-color), $stroke-width, $anti-aliasing)
};

(:~
 : Draws a rectangle to the passed image.
 : If no color is passed, the default color for this image will be taken.
 :
 : @param $image is the image to paint a rectangle to.
 : @param $upper-left-x is the horizontal value of the upper left corner of the rectangle.
 : @param $upper-left-y is the vertical value of the upper left corner of the rectangle.
 : @param $lower-right-x is the horizontal value of the lower right corner of the rectangle.
 : @param $lower-right-y is the vertical value of the lower right corner of the rectangle.
 : @param $stroke-color is the color with which the outer lines of the rectangle should be painted (default: #000000, black).
 : @param $fill-color is the color with which to fill the rectangle, if no color is passed then the rectangle isn't filled.
 : @param $stroke-width is the width of the outer lines of the rectangle that should be painted (default is 1, equal or smaller than 1 will result in the thinnest possible line drawn).
 : @param $anti-aliasing defines if anti-aliasing should be used (default is false).
 : @return A new image with the specified rectangle painted.
 : @error If the passed xs:base64Binary is not a valid image type.
 : @error If any of the passed color strings are not valid colors.
 :)
declare function paint:draw-rectangle($image as xs:base64Binary, $upper-left-x as xs:double, $upper-left-y as xs:double, $lower-right-x as xs:double, $lower-right-y as xs:double, $stroke-color as xs:string?, $fill-color as xs:string?, $stroke-width as xs:double?, $anti-aliasing as xs:boolean?) as xs:base64Binary {
  paint:draw-rounded-rectangle($image, $upper-left-x, $upper-left-y, $lower-right-x, $lower-right-y, 0, 0, $stroke-color, $fill-color, $stroke-width, $anti-aliasing);
};

 (:~
 : Draws a rounded rectangle to the passed image.
 :
 : @param $image is the image to paint a rectangle to.
 : @param $upper-left-x is the horizontal value of the upper left corner of the rectangle.
 : @param $upper-left-y is the vertical value of the upper left corner of the rectangle.
 : @param $lower-right-x is the horizontal value of the lower right corner of the rectangle.
 : @param $lower-right-y is the vertical value of the lower right corner of the rectangle.
 : @param $corner-with is the width a corner should have for the rounded corners.
 : @param $corner-height is the height a corner should have for the rounded corners.
 : @param $stroke-color is the color with which the line of the rounded rectangle should be painted (default: #000000, black).
 : @param $fill-color is the color with which to fill the rectangle, if no color is passed then the rectangle isn't filled.
 : @param $stroke-width is the width of the outer lines of the rectangle that should be painted (default is 1, equal or smaller than 1 will result in the thinnest possible line drawn).
 : @param $anti-aliasing defines if anti-aliasing should be used (default is false).
 : @return A new image with the specified rectangle painted.
 : @error If the passed xs:base64Binary is not a valid image type.
 : @error If any of the passed color strings are not valid colors.
 :)
declare function paint:draw-rounded-rectangle($image as xs:base64Binary, $upper-left-x as xs:double, $upper-left-y as xs:double, $lower-right-x as xs:double, $lower-right-y as xs:double, $corner-width as xs:double, $corner-height as xs:double, $stroke-color as xs:string?, $fill-color as xs:string?, $stroke-width as xs:double?, $anti-aliasing as xs:boolean?) as xs:base64Binary {
  paintschema:draw-rounded-rectangle($image, $upper-left-x, $upper-left-y, $lower-right-x, $lower-right-y, $corner-width, $corner-height, image:colorType($stroke-color), image:colorType($fill-color), $stroke-width, $anti-aliasing)
};

(:~
 : Draw a circle to the passed image.
 :
 : @param $image is the image to paint a circle to.
 : @param $origin-x is the horizontal value of the center of this circle.
 : @param $origin-y is the vertical value of the center of this circle.
 : @param $perimeter is the perimeter of this circle.
 : @param $stroke-color is the color with which the line of the circle should be painted (default: #000000, black).
 : @param $fill-color is the color with which to fill the rectangle, if no color is passed then the circle isn't filled.
 : @param $stroke-width is the width of the outer lines of the circle that should be painted (default is 1, equal or smaller than 1 will result in the thinnest possible line drawn).
 : @param $anti-aliasing defines if anti-aliasing should be used (default is false).
 : @return A new image with the specified circle painted.
 : @error If the passed xs:base64Binary is not a valid image type.
 : @error If any of the passed color strings are not valid colors.
 :)
declare function paint:draw-circle($image as xs:base64Binary, $origin-x as xs:double, $origin-y as xs:double, $perimeter as xs:double,  $stroke-color as xs:string?, $fill-color as xs:string?, $stroke-width as xs:double?, $anti-aliasing as xs:boolean?) as xs:base64Binary {
    paint:draw-ellipse($image, $origin-x, $origin-y, $perimeter, $perimeter, $stroke-color, $fill-color, $stroke-width, $anti-aliasing)
};

(:~
 : Draw an ellipse to the passed image.
 :
 : @param $image is the image to paint a ellipse to.
 : @param $origin-x is the horizontal value of the center of this ellipse.
 : @param $origin-y is the vertical value of the center of this ellipse.
 : @param $perimeter-x is the horizontal perimeter of this ellipse.
 : @param $perimeter-y is the vertical perimeter of this ellipse.
 : @param $stroke-color is the color with which the line of the ellipse should be painted (default: #000000, black).
 : @param $fill-color is the color with which to fill the rectangle, if no color is passed then the ellipse isn't filled.
 : @param $stroke-width is the width of the outer lines of the ellipse that should be painted (default is 1, equal or smaller than 1 will result in the thinnest possible line drawn).
 : @param $anti-aliasing defines if anti-aliasing should be used (default is false).
 : @return A new image with the specified circle painted.
 : @error If the passed xs:base64Binary is not a valid image type.
 : @error If any of the passed color strings are not valid colors.
 :)
declare function paint:draw-ellipse($image as xs:base64Binary, $origin-x as xs:double, $origin-y as xs:double, $perimeter-x as xs:double, $perimeter-y as xs:double,  $stroke-color as xs:string?, $fill-color as xs:string?, $stroke-width as xs:double?, $anti-aliasing as xs:boolean?) as xs:base64Binary {
    paint:draw-arc($image, $origin-x, $origin-y, $perimeter-x, $perimeter-y, 0, 360, $stroke-color, $fill-color, $stroke-width, $anti-aliasing)
};

(:~
 : Draw an arc to the passed image.
 :
 : @param $image is the image to paint a ellipse to.
 : @param $origin-x is the horizontal value of the center of this ellipse.
 : @param $origin-y is the vertical value of the center of this ellipse.
 : @param $perimeter-x is the horizontal perimeter of this ellipse.
 : @param $perimeter-y is the vertical perimeter of this ellipse.
 : @param $start-degrees is the start of the arc in degrees.
 : @param $end-degrees is the end of the arc in degrees.
 : @param $stroke-color is the color with which the line of the arc should be painted (default: #000000, black).
 : @param $fill-color is the color with which to fill the arc, if no color is passed then the arc isn't filled.
 : @param $stroke-width is the width of the outer lines of the arc that should be painted (default is 1, equal or smaller than 1 will result in the thinnest possible line drawn).
 : @param $anti-aliasing defines if anti-aliasing should be used (default is false).
 : @return A new image with the specified circle painted.
 : @error If the passed xs:base64Binary is not a valid image type.
 : @error If any of the passed color strings are not valid colors.
 :)
declare function paint:draw-arc($image as xs:base64Binary, $origin-x as xs:double, $origin-y as xs:double, $perimeter-x as xs:double, $perimeter-y as xs:double, $start-degrees as xs:double, $end-degrees as xs:double,  $stroke-color as xs:string?, $fill-color as xs:string?, $stroke-width as xs:double?, $anti-aliasing as xs:boolean?) as xs:base64Binary {
  paintschema:draw-arc($image, $origin-x, $origin-y, $perimeter-x, $perimeter-y, $start-degrees, $end-degrees, image:colorType($stroke-color), image:colorType($fill-color), $stroke-width, $anti-aliasing)
};

(:~
 : Draws a polygon to the passed image. This is similar to a poly-line, however the end-points are connected with the starting points.
 : Make sure that both $x-values and $y-values have the same count, only coordinates that have an x and a y value will be included in the poly-line.
 : A line segment is painted always from $x-value[n], $y-value[n] to $x-value[n+1], $y-value[n+1], starting at $x-value[0], $y-value[0].
 : Passing only one x-value or y-value can lead to strange and rather unpredictable lines, whereas passing two x-values an y-values will just paint a simple line with the specified coordinates.
 :
 : @param $image is the image to which a polygon should be painted.
 : @param $x-values are the horizontal values of the different line segment starting/ending points.
 : @param $y-values are the vertical values of the different line segment starting/ending points.
 : @param $stroke-color is the color with which the line of the polygon should be painted (default: #000000, black).
 : @param $fill-color is the color with which to fill the polygon, if no color is passed then the polygon isn't filled.
 : @param $stroke-width is the width of the outer lines of the polygon that should be painted (default is 1, equal or smaller than 1 will result in the thinnest possible line drawn).
 : @param $anti-aliasing defines if anti-aliasing should be used (default is false).
 : @return A new image with the specified polygon painted.
 : @error If the passed xs:base64Binary is not a valid image type.
 : @error If any of the passed color strings are not valid colors.
 :)
declare function paint:draw-polygon($image as xs:base64Binary, $x-values as xs:double+, $y-values as xs:double+, $stroke-color as xs:string?, $fill-color as xs:string?, $stroke-width as xs:double?, $anti-aliasing as xs:boolean?) as xs:base64Binary {
  paintschema:draw-polygon($image, $x-values, $y-values, image:colorType($stroke-color), image:colorType($fill-color), $stroke-width, $anti-aliasing)
};

(:~
 : Draws the specified text to the passed image.
 :
 : @param $image is the image to paint the text to.
 : @param $text it the text to paint.
 : @param $x is the horizontal location of the text.
 : @param $y is the vertical location of the text.
 : @param $font-family is the font with which to paint the text (default is Arial, if font family is passed that is not known to the system, then Arial is used).
 : @param $font-size is the size of the text to be painted (default is 12).
 : @param $text-color is a color with which the text should be painted (default is '#000000', black).
 : @return A new image with the specified text.
 : @error If the passed xs:base64Binary is not a valid image type.
 : @error If the passed color string  is not a valid color.
 :)
declare function paint:draw-text($image as xs:base64Binary, $text as xs:string, $x as xs:double, $y as xs:double, $font-family as xs:string, $font-size as xs:double?,  $text-color as xs:string?) as xs:base64Binary {
  paintschema:draw-text($image, $text, $x, $y, $font-family, $font-size, image:colorType($text-color))
};

(:~
 : This module provides functions to handle basic painting operations on images.
 : These functions will not work on svg images.
 : Colors have to be in hexidecimal rgb  with leading '#', e.g. '#000000' for black.
 :
 : @author Daniel Thomas
 : @version 0.1
 :)
module namespace paint = 'http://www.zorba-xquery.com/modules/image/paint';
import module namespace paintschema = 'http://www.zorba-xquery.com/modules/image/paintschema';

(:~
 : Contains the definitions of the possible image types.
 :)
import schema namespace image = 'http://www.zorba-xquery.com/modules/image/image';

 (:~
  : Draws a line on the passed image from $start-x, start-y to $end-x, $end-y.
  : If no color is passed, then a black line is drawn.
  : Coordinates that in any way are not inside the image will generate a line to the hypothetical point beyond the border of the image that discontinues at the border.
  :
  :
  : @param $image is the image to paint a line to.
  : @param $start-x is the horizontal starting point of the line.
  : @param $start-y is the vertical starting point of the line.
  : @param $end-x is the horizontal end point of the line.
  : @param $end-y is the vertical end point of the line.
  : @param $stroke-color is the color with which the line should be painted (default: #000000, black).
  : @param $stroke-width is the width of the line that should be painted (default is 1).
  : @param $anti-aliasing defines if anti-aliasing should be used (default is false).
  : @return A new image with the line painted as specified.
  : @error If the passed xs:base64Binary is not a valid image.
  :)
declare function paint:draw-line($image as xs:base64Binary, $start-x as xs:double, $start-y as xs:double, $end-x as xs:double, $end-y as xs:double, $stroke-color as xs:string?, $stroke-width as xs:double?, $anti-aliasing as xs:boolean?) as xs:base64Binary {
    paint:draw-poly-line($image, ($start-x, $end-x), ($start-y, $end-y), $stroke-color, $stroke-width, $anti-aliasing)
};

(:~
 : Draws a poly-line (different adjascent line segments) to the passed image with a specified color.
 : Make sure that both $x-values and $y-values have the same count, only coordinates that have an x and a y value will be included in the poly-line.
 : A line segment is painted always from $x-value[n], $y-value[n] to $x-value[n+1], $y-value[n+1], starting at $x-value[0], $y-value[0].
 : Passing only one x-value or y-value can lead to strange and rather unpredictable lines, whereas passing two x-values an y-values will just paint a simple line with the specified coordinates.
 :
 : @param $image is the image to paint a poly-line to.
 : @param $x-values are the horizontal values of the different line segment starting/ending points.
 : @param $y-values are the vertical values of the different line segment starting/ending points.
 : @param $stroke-color is the color with which the line should be painted (default: #000000, black).
 : @param $stroke-width is the width of the line that should be painted (default is 1, equal or smaller than 1 will result in the thinnest possible line drawn).
 : @param $anti-aliasing defines if anti-aliasing should be used (default is false).
 : @return A new image with the specified poly-line painted.
 : @error If the passed xs:base64Binary is not a valid image.
 :)
declare function paint:draw-poly-line($image as xs:base64Binary, $x-values as xs:double+, $y-values as xs:double+, $stroke-color as xs:string?,  $stroke-width as xs:double?, $anti-aliasing as xs:boolean?)  as xs:base64Binary {
  paint:draw-stroked-poly-line($image, $x-values, $y-values, 1, 0, $stroke-color, $stroke-width, $anti-aliasing);
};

(:~
 : Draws a stroked poly-line (different adjascent line segments which are painted as short strokes of a specified width) with the specified color.
 : Make sure that both $x-values and $y-values have the same count.
 : A line segment is painted always from $x-value[n], $y-value[n] to $x-value[n+1], $y-value[n+1], starting at $x-value[0], $y-value[0].
 : If no color is passed, the default color for this image will be taken.
 :
 : @param $image is the image to paint a stroked poly-line to.
 : @param $x-values are the horizontal values of the different line segment starting/ending points.
 : @param $y-values are the vertical values of the different line segment starting/ending points.
 : @param $stroke-length is the length of the strokes with which the line segments are painted.
 : @param $gap-length is the length of the gaps between the strokes.
 : @param $stroke-color is the color with which the line should be painted (default: #000000, black)
 : @param $stroke-width is the width of the line that should be painted (default is 1, equal or smaller than 1 will result in the thinnest possible line drawn).
 : @param $anti-aliasing defines if anti-aliasing should be used (default is false).
 : @return A new image with the specified stroked poly-kube painted.
 : @error If the passed xs:base64Binary is not a valid image.
 :)
declare function paint:draw-stroked-poly-line($image as xs:base64Binary, $x-values as xs:double+, $y-values as xs:double+, $stroke-length as xs:double, $gap-length as xs:double, $stroke-color as xs:string?, $stroke-width as xs:double?, $anti-aliasing as xs:boolean?) as xs:base64Binary {
  paintschema:draw-stroked-poly-line($image, $x-values, $y-values, $stroke-length, $gap-length, image:colorType($stroke-color), $stroke-width, $anti-aliasing)
};

(:~
 : Draws a rectangle to the passed image.
 : If no color is passed, the default color for this image will be taken.
 :
 : @param $image is the image to paint a rectangle to.
 : @param $upper-left-x is the horizontal value of the upper left corner of the rectangle.
 : @param $upper-left-y is the vertical value of the upper left corner of the rectangle.
 : @param $lower-right-x is the horizontal value of the lower right corner of the rectangle.
 : @param $lower-right-y is the vertical value of the lower right corner of the rectangle.
 : @param $stroke-color is the color with which the outer lines of the rectangle should be painted (default: #000000, black).
 : @param $fill-color is the color with which to fill the rectangle, if no color is passed then the rectangle isn't filled.
 : @param $stroke-width is the width of the outer lines of the rectangle that should be painted (default is 1, equal or smaller than 1 will result in the thinnest possible line drawn).
 : @param $anti-aliasing defines if anti-aliasing should be used (default is false).
 : @return A new image with the specified rectangle painted.
 : @error If the passed xs:base64Binary is not a valid image type.
 :)
declare function paint:draw-rectangle($image as xs:base64Binary, $upper-left-x as xs:double, $upper-left-y as xs:double, $lower-right-x as xs:double, $lower-right-y as xs:double, $stroke-color as xs:string?, $fill-color as xs:string?, $stroke-width as xs:double?, $anti-aliasing as xs:boolean?) as xs:base64Binary {
  paint:draw-rounded-rectangle($image, $upper-left-x, $upper-left-y, $lower-right-x, $lower-right-y, 0, 0, $stroke-color, $fill-color, $stroke-width, $anti-aliasing);
};

 (:~
 : Draws a rounded rectangle to the passed image.
 :
 : @param $image is the image to paint a rectangle to.
 : @param $upper-left-x is the horizontal value of the upper left corner of the rectangle.
 : @param $upper-left-y is the vertical value of the upper left corner of the rectangle.
 : @param $lower-right-x is the horizontal value of the lower right corner of the rectangle.
 : @param $lower-right-y is the vertical value of the lower right corner of the rectangle.
 : @param $corner-with is the width a corner should have for the rounded corners.
 : @param $corner-height is the height a corner should have for the rounded corners.
 : @param $stroke-color is the color with which the line of the rounded rectangle should be painted (default: #000000, black).
 : @param $fill-color is the color with which to fill the rectangle, if no color is passed then the rectangle isn't filled.
 : @param $stroke-width is the width of the outer lines of the rectangle that should be painted (default is 1, equal or smaller than 1 will result in the thinnest possible line drawn).
 : @param $anti-aliasing defines if anti-aliasing should be used (default is false).
 : @return A new image with the specified rectangle painted.
 : @error If the passed xs:base64Binary is not a valid image type.
 :)
declare function paint:draw-rounded-rectangle($image as xs:base64Binary, $upper-left-x as xs:double, $upper-left-y as xs:double, $lower-right-x as xs:double, $lower-right-y as xs:double, $corner-width as xs:double, $corner-height as xs:double, $stroke-color as xs:string?, $fill-color as xs:string?, $stroke-width as xs:double?, $anti-aliasing as xs:boolean?) as xs:base64Binary {
  paintschema:draw-rounded-rectangle($image, $upper-left-x, $upper-left-y, $lower-right-x, $lower-right-y, $corner-width, $corner-height, image:colorType($stroke-color), image:colorType($fill-color), $stroke-width, $anti-aliasing)
};

(:~
 : Draw a circle to the passed image.
 :
 : @param $image is the image to paint a circle to.
 : @param $origin-x is the horizontal value of the center of this circle.
 : @param $origin-y is the vertical value of the center of this circle.
 : @param $perimeter is the perimeter of this circle.
 : @param $stroke-color is the color with which the line of the circle should be painted (default: #000000, black).
 : @param $fill-color is the color with which to fill the rectangle, if no color is passed then the circle isn't filled.
 : @param $stroke-width is the width of the outer lines of the circle that should be painted (default is 1, equal or smaller than 1 will result in the thinnest possible line drawn).
 : @param $anti-aliasing defines if anti-aliasing should be used (default is false).
 : @return A new image with the specified circle painted.
 : @error If the passed xs:base64Binary is not a valid image type.
 :)
declare function paint:draw-circle($image as xs:base64Binary, $origin-x as xs:double, $origin-y as xs:double, $perimeter as xs:double,  $stroke-color as xs:string?, $fill-color as xs:string?, $stroke-width as xs:double?, $anti-aliasing as xs:boolean?) as xs:base64Binary {
    paint:draw-ellipse($image, $origin-x, $origin-y, $perimeter, $perimeter, $stroke-color, $fill-color, $stroke-width, $anti-aliasing)
};

(:~
 : Draw an ellipse to the passed image.
 :
 : @param $image is the image to paint a ellipse to.
 : @param $origin-x is the horizontal value of the center of this ellipse.
 : @param $origin-y is the vertical value of the center of this ellipse.
 : @param $perimeter-x is the horizontal perimeter of this ellipse.
 : @param $perimeter-y is the vertical perimeter of this ellipse.
 : @param $stroke-color is the color with which the line of the ellipse should be painted (default: #000000, black).
 : @param $fill-color is the color with which to fill the rectangle, if no color is passed then the ellipse isn't filled.
 : @param $stroke-width is the width of the outer lines of the ellipse that should be painted (default is 1, equal or smaller than 1 will result in the thinnest possible line drawn).
 : @param $anti-aliasing defines if anti-aliasing should be used (default is false).
 : @return A new image with the specified circle painted.
 : @error If the passed xs:base64Binary is not a valid image type.
 :)
declare function paint:draw-ellipse($image as xs:base64Binary, $origin-x as xs:double, $origin-y as xs:double, $perimeter-x as xs:double, $perimeter-y as xs:double,  $stroke-color as xs:string?, $fill-color as xs:string?, $stroke-width as xs:double?, $anti-aliasing as xs:boolean?) as xs:base64Binary {
    paint:draw-arc($image, $origin-x, $origin-y, $perimeter-x, $perimeter-y, 0, 360, $stroke-color, $fill-color, $stroke-width, $anti-aliasing)
};

(:~
 : Draw an arc to the passed image.
 :
 : @param $image is the image to paint a ellipse to.
 : @param $origin-x is the horizontal value of the center of this ellipse.
 : @param $origin-y is the vertical value of the center of this ellipse.
 : @param $perimeter-x is the horizontal perimeter of this ellipse.
 : @param $perimeter-y is the vertical perimeter of this ellipse.
 : @param $start-degrees is the start of the arc in degrees.
 : @param $end-degrees is the end of the arc in degrees.
 : @param $stroke-color is the color with which the line of the arc should be painted (default: #000000, black).
 : @param $fill-color is the color with which to fill the arc, if no color is passed then the arc isn't filled.
 : @param $stroke-width is the width of the outer lines of the arc that should be painted (default is 1, equal or smaller than 1 will result in the thinnest possible line drawn).
 : @param $anti-aliasing defines if anti-aliasing should be used (default is false).
 : @return A new image with the specified circle painted.
 : @error If the passed xs:base64Binary is not a valid image type.
 :)
declare function paint:draw-arc($image as xs:base64Binary, $origin-x as xs:double, $origin-y as xs:double, $perimeter-x as xs:double, $perimeter-y as xs:double, $start-degrees as xs:double, $end-degrees as xs:double,  $stroke-color as xs:string?, $fill-color as xs:string?, $stroke-width as xs:double?, $anti-aliasing as xs:boolean?) as xs:base64Binary {
  paintschema:draw-arc($image, $origin-x, $origin-y, $perimeter-x, $perimeter-y, $start-degrees, $end-degrees, image:colorType($stroke-color), image:colorType($fill-color), $stroke-width, $anti-aliasing)
};

(:~
 : Draws a polygon to the passed image. This is similar to a poly-line, however the end-points are connected with the starting points.
 : Make sure that both $x-values and $y-values have the same count, only coordinates that have an x and a y value will be included in the poly-line.
 : A line segment is painted always from $x-value[n], $y-value[n] to $x-value[n+1], $y-value[n+1], starting at $x-value[0], $y-value[0].
 : Passing only one x-value or y-value can lead to strange and rather unpredictable lines, whereas passing two x-values an y-values will just paint a simple line with the specified coordinates.
 :
 : @param $image is the image to which a polygon should be painted.
 : @param $x-values are the horizontal values of the different line segment starting/ending points.
 : @param $y-values are the vertical values of the different line segment starting/ending points.
 : @param $stroke-color is the color with which the line of the polygon should be painted (default: #000000, black).
 : @param $fill-color is the color with which to fill the polygon, if no color is passed then the polygon isn't filled.
 : @param $stroke-width is the width of the outer lines of the polygon that should be painted (default is 1, equal or smaller than 1 will result in the thinnest possible line drawn).
 : @param $anti-aliasing defines if anti-aliasing should be used (default is false).
 : @return A new image with the specified polygon painted.
 : @error If the passed xs:base64Binary is not a valid image type.
 :)
declare function paint:draw-polygon($image as xs:base64Binary, $x-values as xs:double+, $y-values as xs:double+, $stroke-color as xs:string?, $fill-color as xs:string?, $stroke-width as xs:double?, $anti-aliasing as xs:boolean?) as xs:base64Binary {
  paintschema:draw-polygon($image, $x-values, $y-values, image:colorType($stroke-color), image:colorType($fill-color), $stroke-width, $anti-aliasing)
};

(:~
 : Draws the specified text to the passed image.
 :
 : @param $image is the image to paint the text to.
 : @param $text it the text to paint.
 : @param $x is the horizontal location of the text.
 : @param $y is the vertical location of the text.
 : @param $font-family is the font with which to paint the text (default is Arial, if font family is passed that is not known to the system, then Arial is used).
 : @param $font-size is the size of the text to be painted (default is 12).
 : @param $text-color is a color with which the text should be painted (default is '#000000', black).
 : @return A new image with the specified text.
 : @error If the passed xs:base64Binary is not a valid image type.
 :)
declare function paint:draw-text($image as xs:base64Binary, $text as xs:string, $x as xs:double, $y as xs:double, $font-family as xs:string, $font-size as xs:double?,  $text-color as xs:string?) as xs:base64Binary {
  paintschema:draw-text($image, $text, $x, $y, $font-family, $font-size, image:colorType($text-color))
};