[integrate.xproc] integrating Dannes new validation funcs ... looks good, but still testing

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

xquery version "1.0" encoding "UTF-8";
module namespace opt = "http://xproc.net/xproc/opt";
(: -------------------------------------------------------------------------------------

	opt.xqm - Implements all xproc optional steps.

---------------------------------------------------------------------------------------- :)

(: XProc Namespace Declaration :)
declare namespace p="http://www.w3.org/ns/xproc";
declare namespace c="http://www.w3.org/ns/xproc-step";
declare namespace err="http://www.w3.org/ns/xproc-error";
declare namespace comp="http://xproc.net/xproc/comp";
declare namespace xproc = "http://xproc.net/xproc";

(: Module Imports :)
import module namespace u = "http://xproc.net/xproc/util";
import module namespace const = "http://xproc.net/xproc/const";
(: import module namespace xslfo = "http://exist-db.org/xquery/xslfo"; (: for p:xsl-formatter :) :)

(: -------------------------------------------------------------------------- :)

(: Module Vars :)
declare variable $opt:exec := util:function(xs:QName("opt:exec"), 3);
declare variable $opt:hash := util:function(xs:QName("opt:hash"), 3);
declare variable $opt:uuid := util:function(xs:QName("opt:uuid"), 3);
declare variable $opt:www-form-urldecode := util:function(xs:QName("opt:www-form-urldecode"), 3);
declare variable $opt:www-form-urlencode := util:function(xs:QName("opt:www-form-urlencode"), 3);
declare variable $opt:validate-with-xml-schema := util:function(xs:QName("opt:validate-with-xml-schema"), 3);
declare variable $opt:validate-with-schematron := util:function(xs:QName("opt:validate-with-schematron"), 3);
declare variable $opt:validate-with-relax-ng := util:function(xs:QName("opt:validate-with-relax-ng"), 3);
declare variable $opt:xquery := util:function(xs:QName("opt:xquery"), 3);
declare variable $opt:xsl-formatter :=util:function(xs:QName("opt:xsl-formatter"), 3);

(: -------------------------------------------------------------------------- :)
declare function opt:exec($primary,$secondary,$options) {
(: -------------------------------------------------------------------------- :)
    u:outputResultElement(<test3/>)
};

(: -------------------------------------------------------------------------- :)
declare function opt:hash($primary,$secondary,$options) {
(: -------------------------------------------------------------------------- :)
let $v := u:get-primary($primary)
let $match := u:get-option('match',$options,$v)
let $version := u:get-option('version',$options,$v)
let $algorithm := u:get-option('algorithm',$options,$v)
let $value := u:get-option('value',$options,$v)
return
	$v
};

(: -------------------------------------------------------------------------- :)
declare function opt:uuid($primary,$secondary,$options) {
(: -------------------------------------------------------------------------- :)
let $v := u:get-primary($primary)
let $match := u:get-option('match',$options,$v)
let $matchresult := u:evalXPATH(string($match), $v)
let $version := u:get-option('version',$options,$v)
let $attribute := 'xproc:uuid'
let $label := u:uuid()
let $replace := 'true'
return
	u:label-matching-elements($v/*,$matchresult,$attribute,$label,$replace)

};

(: -------------------------------------------------------------------------- :)
declare function opt:www-form-urldecode($primary,$secondary,$options) {
(: -------------------------------------------------------------------------- :)
let $v := u:get-primary($primary)
return
	$v
};

(: -------------------------------------------------------------------------- :)
declare function opt:www-form-urlencode($primary,$secondary,$options) {
(: -------------------------------------------------------------------------- :)
let $v := u:get-primary($primary)
return
	$v
};

(: -------------------------------------------------------------------------- :)
declare function opt:validate-with-xml-schema($primary,$secondary,$options) {
(: -------------------------------------------------------------------------- :)
let $v := u:get-primary($primary)
let $schema := u:get-secondary('schema',$secondary)
return

    if(validation:jing($v,element {node-name($schema/node())}
          {$schema/@*,
    $schema/*/*
    })) then
        $v
    else
	    u:dynamicError('err:XC0053',concat(": invalid ",u:serialize($v,$const:TRACE_SERIALIZE)))

};

(: -------------------------------------------------------------------------- :)
declare function opt:validate-with-schematron($primary,$secondary,$options) {
(: -------------------------------------------------------------------------- :)
let $v := u:get-primary($primary)
let $schema := u:get-secondary('schema',$secondary)
return

    if(validation:jing($v,element {node-name($schema/node())}
          {$schema/@*,
    $schema/*/*
    })) then
        $v
    else
	    u:dynamicError('err:XC0053',concat(": invalid ",u:serialize($v,$const:TRACE_SERIALIZE)))

};

(: -------------------------------------------------------------------------- :)
declare function opt:validate-with-relax-ng($primary,$secondary,$options) {
(: -------------------------------------------------------------------------- :)
let $v := u:get-primary($primary)
let $schema := u:get-secondary('schema',$secondary)
return

    if(validation:jing($v,element {node-name($schema/node())}
          {$schema/@*,
    $schema/*/*
    })) then
        $v
    else
	    u:dynamicError('err:XC0053',concat(": invalid ",u:serialize($v,$const:TRACE_SERIALIZE)))

};

(: -------------------------------------------------------------------------- :)
declare function opt:xsl-formatter($primary,$secondary,$options) {
(: -------------------------------------------------------------------------- :)
let $v := u:get-primary($primary)
let $href-uri := u:get-option('href',$options,$v)
let $name := tokenize($href-uri, "/")[last()]
let $path := substring-before($href-uri,$name)
let $query := concat("xslfo:render(",u:serialize($v,$const:DEFAULT_SERIALIZE),",$const:pdf-mimetype,<parameters/>)")
let $pdf := u:eval($query)
let $store := if(starts-with($path,'file://')) then
				let $query := concat("file:serialize('",
									 $pdf,
								 	 "','",
									 substring-after($href-uri,'file://'),
									 "','method=text')")
				return
				(: u:eval($query) :)
				u:dynamicError('err:XC0050',"p:xsl-formatter cannot store pdf as xprocxq does not yet support file:// protocol yet (soon!).")

			  else
				xmldb:store($path,$name,$pdf)

return
	if($store) then
		u:outputResultElement(concat($path,$name))
	else
		u:dynamicError('err:XC0050',"p:xsl-formatter cannot store pdf.")
};

(: -------------------------------------------------------------------------- :)
declare function opt:xquery($primary,$secondary,$options) {
(: -------------------------------------------------------------------------- :)
u:assert(exists(u:get-secondary('query',$secondary)/c:query),'p:input query is required'),
(:TODO: need to sort out multiple c:query elements and implied cdata sections :)
	let $v := u:get-primary($primary)
    let $xquery := u:get-secondary('query',$secondary)/c:query
	let $query := if ($xquery/@xproc:escape = 'true') then
			u:serialize($xquery/node(),$const:TRACE_SERIALIZE)
		else
			$xquery/node()

    (: TODO - change to u:xquery :)
    let $result := u:evalXPATH($query,$v)
        return
            $result
            (:
            u:outputResultElement($result)
            :)
};

(: -------------------------------------------------------------------------- :)

xquery version "1.0" encoding "UTF-8";
module namespace opt = "http://xproc.net/xproc/opt";
(: -------------------------------------------------------------------------------------

	opt.xqm - Implements all xproc optional steps.

---------------------------------------------------------------------------------------- :)

(: XProc Namespace Declaration :)
declare namespace p="http://www.w3.org/ns/xproc";
declare namespace c="http://www.w3.org/ns/xproc-step";
declare namespace err="http://www.w3.org/ns/xproc-error";
declare namespace comp="http://xproc.net/xproc/comp";
declare namespace xproc = "http://xproc.net/xproc";
declare namespace validate ="http://exist-db.org/xquery/validation";

(: Module Imports :)
import module namespace u = "http://xproc.net/xproc/util";
import module namespace const = "http://xproc.net/xproc/const";
(: import module namespace xslfo = "http://exist-db.org/xquery/xslfo"; (: for p:xsl-formatter :) :)

(: -------------------------------------------------------------------------- :)

(: Module Vars :)
declare variable $opt:exec := util:function(xs:QName("opt:exec"), 3);
declare variable $opt:hash := util:function(xs:QName("opt:hash"), 3);
declare variable $opt:uuid := util:function(xs:QName("opt:uuid"), 3);
declare variable $opt:www-form-urldecode := util:function(xs:QName("opt:www-form-urldecode"), 3);
declare variable $opt:www-form-urlencode := util:function(xs:QName("opt:www-form-urlencode"), 3);
declare variable $opt:validate-with-xml-schema := util:function(xs:QName("opt:validate-with-xml-schema"), 3);
declare variable $opt:validate-with-schematron := util:function(xs:QName("opt:validate-with-schematron"), 3);
declare variable $opt:validate-with-relax-ng := util:function(xs:QName("opt:validate-with-relax-ng"), 3);
declare variable $opt:xquery := util:function(xs:QName("opt:xquery"), 3);
declare variable $opt:xsl-formatter :=util:function(xs:QName("opt:xsl-formatter"), 3);

(: -------------------------------------------------------------------------- :)
declare function opt:exec($primary,$secondary,$options) {
    u:outputResultElement(<test3/>)
};

(: -------------------------------------------------------------------------- :)
declare function opt:hash($primary,$secondary,$options) {
let $v := u:get-primary($primary)
let $match := u:get-option('match',$options,$v)
let $version := u:get-option('version',$options,$v)
let $algorithm := u:get-option('algorithm',$options,$v)
let $value := u:get-option('value',$options,$v)
return
	$v
};

(: -------------------------------------------------------------------------- :)
declare function opt:uuid($primary,$secondary,$options) {
let $v := u:get-primary($primary)
let $match := u:get-option('match',$options,$v)
let $matchresult := u:evalXPATH(string($match), $v)
let $version := u:get-option('version',$options,$v)
let $attribute := 'xproc:uuid'
let $label := u:uuid()
let $replace := 'true'
return
	u:label-matching-elements($v/*,$matchresult,$attribute,$label,$replace)

};

(: -------------------------------------------------------------------------- :)
declare function opt:www-form-urldecode($primary,$secondary,$options) {
let $v := u:get-primary($primary)
return
	$v
};

(: -------------------------------------------------------------------------- :)
declare function opt:www-form-urlencode($primary,$secondary,$options) {
let $v := u:get-primary($primary)
return
	$v
};

(: -------------------------------------------------------------------------- :)
declare function opt:validate-with-xml-schema($primary,$secondary,$options) {
let $v := u:get-primary($primary)
let $xproc:schema := u:get-option('schema',$options,$v)
return
	u:outputResultElement(validation:validate($v, xs:anyURI(string($xproc:schema))))
};

(: -------------------------------------------------------------------------- :)
declare function opt:validate-with-schematron($primary,$secondary,$options) {
let $v := u:get-primary($primary)
let $schema := u:get-secondary('schema',$secondary)
return
	validation:validate($v, $schema)
};

(: -------------------------------------------------------------------------- :)
declare function opt:validate-with-relax-ng($primary,$secondary,$options) {
let $v := u:get-primary($primary)
let $schema := u:get-secondary('schema',$secondary)
return
	validation:validate($v, $schema)
};

(: -------------------------------------------------------------------------- :)
declare function opt:xsl-formatter($primary,$secondary,$options) {

let $v := u:get-primary($primary)
let $href-uri := u:get-option('href',$options,$v)
let $name := tokenize($href-uri, "/")[last()]
let $path := substring-before($href-uri,$name)
let $query := concat("xslfo:render(",u:serialize($v,$const:DEFAULT_SERIALIZE),",$const:pdf-mimetype,<parameters/>)")
let $pdf := u:eval($query)
let $store := if(starts-with($path,'file://')) then
				let $query := concat("file:serialize('",
									 $pdf,
								 	 "','",
									 substring-after($href-uri,'file://'),
									 "','method=text')")
				return
				(: u:eval($query) :)
				u:dynamicError('err:XC0050',"p:xsl-formatter cannot store pdf as xprocxq does not yet support file:// protocol yet (soon!).")

			  else
				xmldb:store($path,$name,$pdf)

return
	if($store) then
		u:outputResultElement(concat($path,$name))
	else
		u:dynamicError('err:XC0050',"p:xsl-formatter cannot store pdf.")
};

(: -------------------------------------------------------------------------- :)
declare function opt:xquery($primary,$secondary,$options) {

u:assert(exists(u:get-secondary('query',$secondary)/c:query),'p:input query is required'),
(:TODO: need to sort out multiple c:query elements and implied cdata sections :)
	let $v := u:get-primary($primary)
    let $xquery := u:get-secondary('query',$secondary)/c:query
	let $query := if ($xquery/@xproc:escape = 'true') then
			u:serialize($xquery/node(),$const:TRACE_SERIALIZE)
		else
			$xquery/node()

    let $result := u:xquery($query,$v)
        return
            u:outputResultElement($result)
};

(: -------------------------------------------------------------------------- :)


Attempted update for the BaseX EXPath crypto functions - not sure about the annotation syntax at this point.

xquery version "3.0";
(:~
 : Cryptographic Module (EXPath Candidate Module 14 February 2015)
 :
 : @see https://web.archive.org/web/20170227073403/http://expath.org/spec/crypto/20150214
 : @see https://web.archive.org/web/20170227144046/http://expath.org/spec/crypto/20110810
 : @see http://docs.basex.org/wiki/Crypto_Module
 :)
module namespace crypto = "http://expath.org/ns/crypto";

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

declare option o:requires "expath-crypto/1.0-20110810";

declare option o:implements-module "basex/7.0 as expath-crypto/1.0-20110810";

declare %a:restrict-since("$key", "expath-crypto", "1.0-20110810", "xs:string")
        %a:restrict-until("$key", "basex", "8.6", "xs:string")
        %a:restrict-since("$key", "basex", "8.6", "(xs:string|xs:hexBinary|xs:base64Binary)")
        %a:restrict-since("$message", "basex", "9.3", "xs:anyAtomicType")
        %a:since("expath-crypto", "1.0-20110810") function crypto:hmac($message as xs:string, $key as xs:anyAtomicType, $algorithm as xs:string) as xs:base64Binary external;
declare %a:restrict-since("$key", "expath-crypto", "1.0-20110810", "xs:string")
        %a:restrict-until("$key", "basex", "8.6", "xs:string")
        %a:restrict-since("$key", "basex", "8.6", "(xs:string|xs:hexBinary|xs:base64Binary)")
        %a:restrict-since("$message", "basex", "9.3", "xs:anyAtomicType")
        %a:since("expath-crypto", "1.0-20110810") function crypto:hmac($message as xs:string, $key as xs:anyAtomicType, $algorithm as xs:string, $encoding as xs:string) as xs:base64Binary external;
declare %a:restrict-since("$input", "basex", "9.3", "xs:anyAtomicType")
        %a:restrict-since("$key", "basex", "9.3", "xs:anyAtomicType")
        %a:since("expath-crypto", "1.0-20110810") function crypto:encrypt($input as xs:string, $encoding as xs:string, $key as xs:string, $algorithm as xs:string) as xs:string external;
declare %a:restrict-since("$input", "basex", "9.3", "xs:anyAtomicType")
        %a:restrict-since("$key", "basex", "9.3", "xs:anyAtomicType")
        %a:since("expath-crypto", "1.0-20110810") function crypto:decrypt($input as xs:string, $type as xs:string, $key as xs:string, $algorithm as xs:string) as xs:string external;
declare %a:since("expath-crypto", "1.0-20110810") function crypto:generate-signature($input as node(), $canonicalization as xs:string, $digest as xs:string, $signature as xs:string, $prefix as xs:string, $type as xs:string) as node() external;
declare %a:since("expath-crypto", "1.0-20110810") function crypto:generate-signature($input as node(), $canonicalization as xs:string, $digest as xs:string, $signature as xs:string, $prefix as xs:string, $type as xs:string, $xpath as xs:string, $certificate as node()) as node() external;
declare %a:since("expath-crypto", "1.0-20110810") function crypto:generate-signature($input as node(), $canonicalization as xs:string, $digest as xs:string, $signature as xs:string, $prefix as xs:string, $type as xs:string, $xpath-or-certificate as (xs:string|node())) as node() external;
declare %a:since("expath-crypto", "1.0-20110810") function crypto:validate-signature($input-doc as node()) as xs:boolean external;

xquery version "3.0";
(:~
 : Cryptographic Module (EXPath Candidate Module 14 February 2015)
 :
 : @see https://web.archive.org/web/20170227073403/http://expath.org/spec/crypto/20150214
 : @see https://web.archive.org/web/20170227144046/http://expath.org/spec/crypto/20110810
 : @see http://docs.basex.org/wiki/Crypto_Module
 :)
module namespace crypto = "http://expath.org/ns/crypto";

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

declare option o:requires "expath-crypto/1.0-20110810";

declare option o:implements-module "basex/7.0 as expath-crypto/1.0-20110810";

declare %a:restrict-since("$key", "expath-crypto", "1.0-20110810", "xs:string")
        %a:restrict-until("$key", "basex", "8.6", "xs:string")
        %a:restrict-since("$key", "basex", "8.6", "(xs:string|xs:hexBinary|xs:base64Binary)")
        %a:since("expath-crypto", "1.0-20110810") function crypto:hmac($message as xs:string, $key as xs:anyAtomicType, $algorithm as xs:string) as xs:base64Binary external;
declare %a:restrict-since("$key", "expath-crypto", "1.0-20110810", "xs:string")
        %a:restrict-until("$key", "basex", "8.6", "xs:string")
        %a:restrict-since("$key", "basex", "8.6", "(xs:string|xs:hexBinary|xs:base64Binary)")
        %a:since("expath-crypto", "1.0-20110810") function crypto:hmac($message as xs:string, $key as xs:anyAtomicType, $algorithm as xs:string, $encoding as xs:string) as xs:base64Binary external;
declare %a:since("expath-crypto", "1.0-20110810") function crypto:encrypt($input as xs:string, $encoding as xs:string, $key as xs:string, $algorithm as xs:string) as xs:string external;
declare %a:since("expath-crypto", "1.0-20110810") function crypto:decrypt($input as xs:string, $type as xs:string, $key as xs:string, $algorithm as xs:string) as xs:string external;
declare %a:since("expath-crypto", "1.0-20110810") function crypto:generate-signature($input as node(), $canonicalization as xs:string, $digest as xs:string, $signature as xs:string, $prefix as xs:string, $type as xs:string) as node() external;
declare %a:since("expath-crypto", "1.0-20110810") function crypto:generate-signature($input as node(), $canonicalization as xs:string, $digest as xs:string, $signature as xs:string, $prefix as xs:string, $type as xs:string, $xpath as xs:string, $certificate as node()) as node() external;
declare %a:since("expath-crypto", "1.0-20110810") function crypto:generate-signature($input as node(), $canonicalization as xs:string, $digest as xs:string, $signature as xs:string, $prefix as xs:string, $type as xs:string, $xpath-or-certificate as (xs:string|node())) as node() external;
declare %a:since("expath-crypto", "1.0-20110810") function crypto:validate-signature($input-doc as node()) as xs:boolean external;


Added import module for xslfo

Added import module for xslfo

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

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

let $xsl-fo-document as document-node() := doc("fop-readme.xml")
let $media-type as xs:string := "application/pdf"
return
    response:stream-binary(
        xslfo:render($xsl-fo-document, $media-type, ()),
        $media-type,
        "output.pdf"
    )

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

let $xsl-fo-document as document-node() := doc("fop-readme.xml")
let $media-type as xs:string := "application/pdf"
return
    response:stream-binary(
        xslfo:render($xsl-fo-document, $media-type, ()),
        $media-type,
        "output.pdf"
    )


[bugfix] fixed XQTS runner to use file:read instead of deprecated util:file-read.

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

xquery version "1.0";

(: reuse webapp\xqts\xqts.xql :)

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

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

import module namespace util="http://exist-db.org/xquery/util";
import module namespace xdb="http://exist-db.org/xquery/xmldb";
import module namespace xdiff="http://exist-db.org/xquery/xmldiff"
at "java:org.exist.xquery.modules.xmldiff.XmlDiffModule";
import module namespace request="http://exist-db.org/xquery/request";
declare namespace system="http://exist-db.org/xquery/system";

declare option exist:output-size-limit "-1";

(: $Id: xqts.xql 7721 2008-05-07 15:36:39Z brihaye $ :)

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

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

     Setup:

     * Run EXIST_HOME/webapp/xqts/build.xml and follow the instructions.
     -------------------------------------------------------------------------- :)

declare variable $xqts:CONFIG := xqts:initialize();
declare variable $xqts:XQTS_HOME := xqts:path-to-uri(concat(system:get-exist-home(),"/",$xqts:CONFIG/basedir/text()));
declare variable $xqts:IN_MEMORY := ($xqts:CONFIG/mode/text() = "memory");

declare function xqts:initialize() as element() {
    let $home := system:get-exist-home()
    let $path := concat($home, "/webapp/xqts")
    let $collection := xdb:create-collection("/db", "XQTS")
    let $config0 := if (doc-available("/db/XQTS/config.xml")) then doc("/db/XQTS/config.xml")/config else ()
    let $config :=
        if ($config0) then
            $config0
        else
            let $stored := xdb:store-files-from-pattern("/db/XQTS", $path, "*.xml", "text/xml")
            return
                if (doc-available("/db/XQTS/config.xml")) then doc("/db/XQTS/config.xml")/config else ()
    let $xqtsHome := $config/basedir/text()
    let $catalog := doc("/db/XQTS/XQTSCatalog.xml")
    let $sources0 := collection("/db/XQTS/TestSources")
    let $sourceCol := xdb:create-collection("/db/XQTS", "TestSources")
    let $collection1 := xdb:create-collection("/db/XQTS/TestSources", "collection1")
    let $collection2 := xdb:create-collection("/db/XQTS/TestSources", "collection2")
    let $sources :=
        if ($sources0) then
            $sources0
        else
            xdb:store-files-from-pattern($sourceCol, concat($xqtsHome, "TestSources"), "*.xml", "text/xml")
    let $docs :=
        (
            (: since XQTS URIs are resolved against /db/XQTS/TestSources :)
            xdb:copy($sourceCol, "/db/XQTS/TestSources/collection1", "bib.xml"),
            xdb:copy($sourceCol, "/db/XQTS/TestSources/collection1", "reviews.xml"),
            xdb:copy($sourceCol, "/db/XQTS/TestSources/collection2", "bib.xml"),
            xdb:copy($sourceCol, "/db/XQTS/TestSources/collection2", "reviews.xml"),
            xdb:copy($sourceCol, "/db/XQTS/TestSources/collection2", "books.xml"),
            xdb:store($collection, "hacked-tests.xml",
                xs:anyURI(xqts:path-to-uri(
                        concat($home, "/test/src/org/exist/xquery/xqts/hacked-tests.xml")
                    )))
        )
    return
        $config
};

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

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

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

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

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

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

declare function xqts:get-variable($case as element(catalog:test-case), $varName as xs:string) as item()* {
    let $filePath := concat($xqts:XQTS_HOME, "Queries/XQuery/", $case/@FilePath, $varName, ".xq")
    let $xq-string := file:read($filePath, "UTF-8")
    return
        if (empty($xq-string)) then
            ()
        else
            util:eval($xq-string)
};

declare function xqts:compute-specific-static-context($testCaseName as xs:string) as element()* {
    (
        <unbind-namespace uri="http://exist.sourceforge.net/NS/exist"/>
    ,
        if ($testCaseName eq "ForExpr013") then
            <output-size-limit value="-1"/>
        else if ($testCaseName eq "fn-current-time-4") then
            (: arbitrary date :)
            <current-dateTime value="2005-12-05T13:38:03.455-05:00"/>
        else if ($testCaseName eq "fn-current-time-6") then
            (: arbitrary date :)
            <current-dateTime value="2005-12-05T13:38:18.059-05:00"/>
        else if ($testCaseName eq "fn-current-time-7") then
            (: arbitrary date :)
            <current-dateTime value="2005-12-05T13:38:18.059-05:00"/>
        else if ($testCaseName eq "fn-current-time-10") then
            (: arbitrary date :)
            <current-dateTime value="2005-12-05T13:38:18.09-05:00"/>
        else if (starts-with($testCaseName, "fn-current-time-")) then
            (: arbitrary date :)
            <current-dateTime value="2005-12-05T10:15:03.408-05:00"/>
        else if ($testCaseName eq "fn-current-dateTime-6") then
            <current-dateTime value="2005-12-05T17:10:00.312-05:00"/>
        (: bloody lower-case ! :)
        else if ($testCaseName eq "fn-current-datetime-7") then
            <current-dateTime value="2005-12-05T17:10:00.312-05:00"/>
        else if ($testCaseName eq "fn-current-dateTime-10") then
            <current-dateTime value="2005-12-05T17:10:00.344-05:00"/>
        else if ($testCaseName eq "fn-current-dateTime-21") then
            <current-dateTime value="2005-12-05T17:10:00.453-05:00"/>
        else if ($testCaseName eq "fn-current-dateTime-24") then
            <current-dateTime value="2005-12-05T17:10:00.469-05:00"/>
        else
            <current-dateTime value="2005-12-05T17:10:00.203-05:00"/>
    ,
        if (starts-with($testCaseName, "modules-") or starts-with($testCaseName, "K-ModuleImport-")) then
            (
            <mapModule namespace="http://www.w3.org/TestModules/test1"
                uri="{xs:anyURI('xmldb:exist:///db/XQTS/TestSources/test1-lib.xq')}"/>,
            <mapModule namespace="http://www.w3.org/TestModules/test2"
                uri="{xs:anyURI('xmldb:exist:///db/XQTS/TestSources/test2-lib.xq')}"/>,
            <mapModule namespace="http://www.w3.org/TestModules/module1"
                uri="{xs:anyURI('xmldb:exist:///db/XQTS/TestSources/module1-lib.xq')}"/>,
            <mapModule namespace="http://www.w3.org/TestModules/module2"
                uri="{xs:anyURI('xmldb:exist:///db/XQTS/TestSources/module2-lib.xq')}"/>,
            <mapModule namespace="http://www.w3.org/TestModules/defs"
                uri="{xs:anyURI('xmldb:exist:///db/XQTS/TestSources/moduleDefs-lib.xq')}"/>,
            <mapModule namespace="http://www.w3.org/TestModules/diffns"
                uri="{xs:anyURI('xmldb:exist:///db/XQTS/TestSources/modulesdiffns-lib.xq')}"/>
            )
        else
            ()
    ,
        if (matches($testCaseName,"^fn-implicit-timezone-.*$") or
            matches($testCaseName,"^K-ContextImplicitTimezoneFunc-.*$")) then
            <implicit-timezone value="-PT5H"/>
        else
            ()
    )
};

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

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

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

declare function xqts:normalize-and-expand($text as item()*) as xs:string {
	replace(replace(replace(xqts:normalize-text($text), "&amp;", "&", "m"), "&lt;", "<"),
		"&gt;", ">")
};

declare function xqts:get-expected-results($testCase as element(catalog:test-case), $inMemory as xs:boolean) as element()* {
    let $testName := $testCase/@name
    let $hackedTest := /hack:test-cases/hack:test-case[@name = $testName]
    return
    (
        for $output in $testCase/catalog:output-file
        return
            let $compare :=
                if (exists($hackedTest/@compare)) then
                    $hackedTest/@compare
                else if ($output/@compare eq "Inspect") then
                    (: "Text" by default. OK in most if not all the cases :)
                    "Text"
                else
                    $output/@compare
            let $outputFilePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $testCase/@FilePath,
                $output/text())
            return
                <expected-result compare="{$compare}">
                {
                    if ($compare eq "Text") then
                        xqts:normalize-and-expand(file:read($outputFilePath, "UTF-8"))
                    else if ($compare eq "UnnormalizedText") then
                        xqts:normalize-and-expand(file:read($outputFilePath, "UTF-8"))
                    else if ($compare eq "TextAsXML") then
                        xqts:normalize-and-expand(file:read($outputFilePath, "UTF-8"))
                    else if ($compare eq "XML") then
                        if ($inMemory) then
                            util:parse(file:read($outputFilePath, "UTF-8"))
                        else
                            util:catch(
                                "java.lang.Exception",
                                doc(xdb:store("/db/XQTS/temp", substring-before($output/text(), "."), xs:anyURI($outputFilePath), "text/xml")),
                                (: Handle unexpected exceptions :)
                                util:log("ERROR", concat("Exception while loading expected result: ", $util:exception-message))
                            )
                    else if ($compare eq "Fragment") then
                        let $xmlFrag := concat("<f>", file:read($outputFilePath, "UTF-8"), "</f>")
                        return
                            if ($inMemory) then
                                util:parse($xmlFrag)
                            else
                                util:catch(
                                    "java.lang.Exception",
                                    doc(xdb:store("/db/XQTS/temp", substring-before($output/text(), "."), $xmlFrag, "text/xml")),
                                    (: Handle unexpected exceptions :)
                                    util:log("ERROR", concat("Exception while loading expected result fragment: ", $util:exception-message))
                                )
                    else
                        util:log("ERROR", concat("Unknown comparison method: ", $compare))
                }
                </expected-result>
    ,
        (: due to a possible bug in the MemTreeBuilder, the parent element will be copied ! :)
        if (exists($hackedTest/hack:expected-result)) then
            $hackedTest/hack:expected-result
        else
            ()
    )
};

declare function xqts:execute-test-case($testCase as element(catalog:test-case), $inMemory as xs:boolean) as element()? {
    let $context :=
        <static-context>
            {
                xqts:compute-specific-static-context(string($testCase/@name))
            }
            {
                for $input in $testCase/catalog:input-file
                return
                    if ($inMemory) then
                        <variable name="{$input/@variable}" source="{xqts:get-input-value-uri($input)}"/>
                    else
                        <variable name="{$input/@variable}">{xqts:get-input-value($input)}</variable>,
                for $var in $testCase/catalog:input-query
                return
                    let $variable := xqts:get-variable($testCase, $var/@name)
                    return
                        <variable name="{$var/@variable}" type="{util:get-sequence-type($variable)}">{$variable}</variable>,
                for $input in $testCase/catalog:input-URI
                return
                    if ($input eq "works") then
                        <variable name="{$input/@variable}" type="xs:anyURI">{xs:anyURI("/db/XQTS/TestSources/works.xml")}</variable>
                    else if ($input eq "works-mod") then
                        <variable name="{$input/@variable}" type="xs:anyURI">{xs:anyURI("/db/XQTS/TestSources/works-mod.xml")}</variable>
                    else
                        <variable name="{$input/@variable}" type="xs:anyURI">{xs:anyURI(concat("/db/XQTS/TestSources/", $input))}</variable>
            }
            {
                for $input in $testCase/catalog:defaultCollection
                return
                    <staticallyKnownDocuments>{concat("/db/XQTS/TestSources/", $input)}</staticallyKnownDocuments>
            }
        </static-context>
    let $query := xqts:get-query($testCase)
    let $expectedResults := xqts:get-expected-results($testCase, $inMemory)
    let $formatedResult :=
        util:catch(
            "java.lang.Exception",
            let $raw_result := util:eval-with-context($query, $context, false(), xqts:get-context-item($testCase/catalog:contextItem))
            return
                xqts:compute-result($testCase, $query, $raw_result, $expectedResults),

            (: Exception processing :)
            (: Only expected exception and got exception. No check on if it is the right exception, though. :)
            if (fn:exists($testCase//catalog:expected-error) and empty($expectedResults)) then
               <test-case name="{$testCase/@name}" result="pass" dateRun="{util:system-time()}" print="expected-exception-got-exception">
                    (: TODO : check exception code :)
                    <exception>{$util:exception-message}</exception>
                    {
                        for $expected-error in $testCase//catalog:expected-error
                        return
                            <expected-error>{$expected-error/text()}</expected-error>
                    }
                    <query>{$query}</query>
               </test-case>
            (: Expected either output or exception. :)
            else if (fn:exists($testCase//catalog:expected-error) and fn:exists($expectedResults)) then
                <test-case name="{$testCase/@name}" result="pass" dateRun="{util:system-time()}" print="expected-exception-or-output">
                    (: TODO : check exception code :)
                    <exception>{$util:exception-message}</exception>
                    {
                        for $expectedResult in $expectedResults
                        return
                            $expectedResult
                    }
                    {
                        for $expected-error in $testCase//catalog:expected-error
                        return
                            <expected-error>{$expected-error/text()}</expected-error>
                    }
                    <query>{$query}</query>
                </test-case>
            (: Expected output, but got exception. :)
            else if (fn:empty($testCase//catalog:expected-error) and fn:exists($testCase//catalog:output-file)) then
                <test-case name="{$testCase/@name}" result="fail" dateRun="{util:system-time()}" print="expected-output-got-exception">
                    <exception>{$util:exception-message}</exception>
                    {
                        for $expectedResult in $expectedResults
                        return
                            $expectedResult
                    }
                    <query>{$query}</query>
                </test-case>
            (: Don't know what is expected but got here anyway. :)
            else
                <test-case name="{$testCase/@name}" result="fail" dateRun="{util:system-time()}" print="unhandled-error">
                    <exception>{$util:exception-message}</exception>
                    {
                        for $expectedResult in $expectedResults
                        return
                            $expectedResult
                    }
                    {
                        for $expected-error in $testCase//catalog:expected-error
                        return
                            <expected-error>{$expected-error/text()}</expected-error>
                    }
                    <query>{$query}</query>
                </test-case>
        )
        let $log :=
            if (fn:empty($formatedResult)) then
                util:log("DEBUG", ("Unable to generate a formated result: ", xs:string($testCase/@name)))
            else
                ()
    return $formatedResult
};

declare function xqts:compute-result($testCase as element(catalog:test-case), $query as xs:string, $result as item()*, $expectedResults as element()* ) {
    let $passed := some $expectedResultTest in (
        for $expectedResult in $expectedResults
        return
            let $comparisonMethod := $expectedResult/@compare
            return
                if ($comparisonMethod eq "Text") then
                    (: don't use text() because () neq "" :)
                    $expectedResult/string() eq xqts:normalize-text($result)
                else if ($comparisonMethod eq "UnnormalizedText") then
                    (: don't use text() because () neq "" :)
                    (: join the results in one single string :)
                    $expectedResult/string() eq string-join($result, "")
                else if ($comparisonMethod eq "TextAsXML") then
                    xdiff:compare($expectedResult/*, util:eval($result))
                else if ($comparisonMethod eq "XML") then
                    xdiff:compare($expectedResult/*, $result)
                else if ($comparisonMethod eq "Fragment") then
                    xdiff:compare($expectedResult/*, <f>{$result}</f>)
                (: unlikely :)
                else
                    false()
    ) satisfies $expectedResultTest
    return
        xqts:format-result($testCase, $passed, $query, $result, $expectedResults)
};

declare function xqts:format-result($testCase as element(catalog:test-case), $passed as xs:boolean, $query as xs:string,
    $result as item()*, $expectedResults as item()*) as element() {
    <test-case name="{$testCase/@name}" result="{if ($passed) then 'pass' else 'fail'}" dateRun="{util:system-time()}" print="result-without-exception">
        <result>{$result}</result>
        {
            for $expectedResult in $expectedResults
            return
                $expectedResult
        }
        {
            for $expected-error in $testCase//catalog:expected-error
            return
                <expected-error>{$expected-error/text()}</expected-error>
        }
        <query>{$query}</query>
    </test-case>
};

declare function xqts:run-single-test-case($case as element(catalog:test-case),
    $resultRoot as element()?, $inMemory as xs:boolean) as empty() {
    let $result := xqts:execute-test-case($case, $inMemory)
    return
        util:catch(
            "java.lang.Exception",
            update insert $result into $resultRoot,
            update insert <test-case name="{$case/@name}" result="fail" dateRun="{util:system-time()}" print="unhandled-error">
                    <exception>Caught late exception while inserting result: {$util:exception-message}</exception>
               </test-case> into $resultRoot
        ),
        let $added := $resultRoot/test-case[@name = $case/@name]
        let $log :=
            if (fn:empty($added)) then
                util:log("DEBUG", ("FAILURE in-memory-frag in test: ", xs:string($case/@name)))
            else
                ()
        return
            if ($added) then
                xqts:report-progress($added)
            else
                ()
};

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

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

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

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

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

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

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

declare variable $testGroup external;
declare variable $testCase external;

let $XQTSCatalog := xmldb:document('/db/XQTS/XQTSCatalog.xml'),
    $case := $XQTSCatalog//catalog:test-group[@name = $testGroup]/catalog:test-case[@name = $testCase]
return
xqts:execute-test-case($case, fn:true())

xquery version "1.0";

(: reuse webapp\xqts\xqts.xql :)

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

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

import module namespace util="http://exist-db.org/xquery/util";
import module namespace xdb="http://exist-db.org/xquery/xmldb";
import module namespace xdiff="http://exist-db.org/xquery/xmldiff"
at "java:org.exist.xquery.modules.xmldiff.XmlDiffModule";
import module namespace request="http://exist-db.org/xquery/request";
declare namespace system="http://exist-db.org/xquery/system";

declare option exist:output-size-limit "-1";

(: $Id: xqts.xql 7721 2008-05-07 15:36:39Z brihaye $ :)

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

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

     Setup:

     * Run EXIST_HOME/webapp/xqts/build.xml and follow the instructions.
     -------------------------------------------------------------------------- :)

declare variable $xqts:CONFIG := xqts:initialize();
declare variable $xqts:XQTS_HOME := xqts:path-to-uri(concat(system:get-exist-home(),"/",$xqts:CONFIG/basedir/text()));
declare variable $xqts:IN_MEMORY := ($xqts:CONFIG/mode/text() = "memory");

declare function xqts:initialize() as element() {
    let $home := system:get-exist-home()
    let $path := concat($home, "/webapp/xqts")
    let $collection := xdb:create-collection("/db", "XQTS")
    let $config0 := if (doc-available("/db/XQTS/config.xml")) then doc("/db/XQTS/config.xml")/config else ()
    let $config :=
        if ($config0) then
            $config0
        else
            let $stored := xdb:store-files-from-pattern("/db/XQTS", $path, "*.xml", "text/xml")
            return
                if (doc-available("/db/XQTS/config.xml")) then doc("/db/XQTS/config.xml")/config else ()
    let $xqtsHome := $config/basedir/text()
    let $catalog := doc("/db/XQTS/XQTSCatalog.xml")
    let $sources0 := collection("/db/XQTS/TestSources")
    let $sourceCol := xdb:create-collection("/db/XQTS", "TestSources")
    let $collection1 := xdb:create-collection("/db/XQTS/TestSources", "collection1")
    let $collection2 := xdb:create-collection("/db/XQTS/TestSources", "collection2")
    let $sources :=
        if ($sources0) then
            $sources0
        else
            xdb:store-files-from-pattern($sourceCol, concat($xqtsHome, "TestSources"), "*.xml", "text/xml")
    let $docs :=
        (
            (: since XQTS URIs are resolved against /db/XQTS/TestSources :)
            xdb:copy($sourceCol, "/db/XQTS/TestSources/collection1", "bib.xml"),
            xdb:copy($sourceCol, "/db/XQTS/TestSources/collection1", "reviews.xml"),
            xdb:copy($sourceCol, "/db/XQTS/TestSources/collection2", "bib.xml"),
            xdb:copy($sourceCol, "/db/XQTS/TestSources/collection2", "reviews.xml"),
            xdb:copy($sourceCol, "/db/XQTS/TestSources/collection2", "books.xml"),
            xdb:store($collection, "hacked-tests.xml",
                xs:anyURI(xqts:path-to-uri(
                        concat($home, "/test/src/org/exist/xquery/xqts/hacked-tests.xml")
                    )))
        )
    return
        $config
};

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

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

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

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

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

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

declare function xqts:get-variable($case as element(catalog:test-case), $varName as xs:string) as item()* {
    let $filePath := concat($xqts:XQTS_HOME, "Queries/XQuery/", $case/@FilePath, $varName, ".xq")
    let $xq-string := util:file-read($filePath, "UTF-8")
    return
        if (empty($xq-string)) then
            ()
        else
            util:eval($xq-string)
};

declare function xqts:compute-specific-static-context($testCaseName as xs:string) as element()* {
    (
        <unbind-namespace uri="http://exist.sourceforge.net/NS/exist"/>
    ,
        if ($testCaseName eq "ForExpr013") then
            <output-size-limit value="-1"/>
        else if ($testCaseName eq "fn-current-time-4") then
            (: arbitrary date :)
            <current-dateTime value="2005-12-05T13:38:03.455-05:00"/>
        else if ($testCaseName eq "fn-current-time-6") then
            (: arbitrary date :)
            <current-dateTime value="2005-12-05T13:38:18.059-05:00"/>
        else if ($testCaseName eq "fn-current-time-7") then
            (: arbitrary date :)
            <current-dateTime value="2005-12-05T13:38:18.059-05:00"/>
        else if ($testCaseName eq "fn-current-time-10") then
            (: arbitrary date :)
            <current-dateTime value="2005-12-05T13:38:18.09-05:00"/>
        else if (starts-with($testCaseName, "fn-current-time-")) then
            (: arbitrary date :)
            <current-dateTime value="2005-12-05T10:15:03.408-05:00"/>
        else if ($testCaseName eq "fn-current-dateTime-6") then
            <current-dateTime value="2005-12-05T17:10:00.312-05:00"/>
        (: bloody lower-case ! :)
        else if ($testCaseName eq "fn-current-datetime-7") then
            <current-dateTime value="2005-12-05T17:10:00.312-05:00"/>
        else if ($testCaseName eq "fn-current-dateTime-10") then
            <current-dateTime value="2005-12-05T17:10:00.344-05:00"/>
        else if ($testCaseName eq "fn-current-dateTime-21") then
            <current-dateTime value="2005-12-05T17:10:00.453-05:00"/>
        else if ($testCaseName eq "fn-current-dateTime-24") then
            <current-dateTime value="2005-12-05T17:10:00.469-05:00"/>
        else
            <current-dateTime value="2005-12-05T17:10:00.203-05:00"/>
    ,
        if (starts-with($testCaseName, "modules-") or starts-with($testCaseName, "K-ModuleImport-")) then
            (
            <mapModule namespace="http://www.w3.org/TestModules/test1"
                uri="{xs:anyURI('xmldb:exist:///db/XQTS/TestSources/test1-lib.xq')}"/>,
            <mapModule namespace="http://www.w3.org/TestModules/test2"
                uri="{xs:anyURI('xmldb:exist:///db/XQTS/TestSources/test2-lib.xq')}"/>,
            <mapModule namespace="http://www.w3.org/TestModules/module1"
                uri="{xs:anyURI('xmldb:exist:///db/XQTS/TestSources/module1-lib.xq')}"/>,
            <mapModule namespace="http://www.w3.org/TestModules/module2"
                uri="{xs:anyURI('xmldb:exist:///db/XQTS/TestSources/module2-lib.xq')}"/>,
            <mapModule namespace="http://www.w3.org/TestModules/defs"
                uri="{xs:anyURI('xmldb:exist:///db/XQTS/TestSources/moduleDefs-lib.xq')}"/>,
            <mapModule namespace="http://www.w3.org/TestModules/diffns"
                uri="{xs:anyURI('xmldb:exist:///db/XQTS/TestSources/modulesdiffns-lib.xq')}"/>
            )
        else
            ()
    ,
        if (matches($testCaseName,"^fn-implicit-timezone-.*$") or
            matches($testCaseName,"^K-ContextImplicitTimezoneFunc-.*$")) then
            <implicit-timezone value="-PT5H"/>
        else
            ()
    )
};

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

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

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

declare function xqts:normalize-and-expand($text as item()*) as xs:string {
	replace(replace(replace(xqts:normalize-text($text), "&amp;", "&", "m"), "&lt;", "<"),
		"&gt;", ">")
};

declare function xqts:get-expected-results($testCase as element(catalog:test-case), $inMemory as xs:boolean) as element()* {
    let $testName := $testCase/@name
    let $hackedTest := /hack:test-cases/hack:test-case[@name = $testName]
    return
    (
        for $output in $testCase/catalog:output-file
        return
            let $compare :=
                if (exists($hackedTest/@compare)) then
                    $hackedTest/@compare
                else if ($output/@compare eq "Inspect") then
                    (: "Text" by default. OK in most if not all the cases :)
                    "Text"
                else
                    $output/@compare
            let $outputFilePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $testCase/@FilePath,
                $output/text())
            return
                <expected-result compare="{$compare}">
                {
                    if ($compare eq "Text") then
                        xqts:normalize-and-expand(util:file-read($outputFilePath, "UTF-8"))
                    else if ($compare eq "UnnormalizedText") then
                        xqts:normalize-and-expand(util:file-read($outputFilePath, "UTF-8"))
                    else if ($compare eq "TextAsXML") then
                        xqts:normalize-and-expand(util:file-read($outputFilePath, "UTF-8"))
                    else if ($compare eq "XML") then
                        if ($inMemory) then
                            util:parse(util:file-read($outputFilePath, "UTF-8"))
                        else
                            util:catch(
                                "java.lang.Exception",
                                doc(xdb:store("/db/XQTS/temp", substring-before($output/text(), "."), xs:anyURI($outputFilePath), "text/xml")),
                                (: Handle unexpected exceptions :)
                                util:log("ERROR", concat("Exception while loading expected result: ", $util:exception-message))
                            )
                    else if ($compare eq "Fragment") then
                        let $xmlFrag := concat("<f>", util:file-read($outputFilePath, "UTF-8"), "</f>")
                        return
                            if ($inMemory) then
                                util:parse($xmlFrag)
                            else
                                util:catch(
                                    "java.lang.Exception",
                                    doc(xdb:store("/db/XQTS/temp", substring-before($output/text(), "."), $xmlFrag, "text/xml")),
                                    (: Handle unexpected exceptions :)
                                    util:log("ERROR", concat("Exception while loading expected result fragment: ", $util:exception-message))
                                )
                    else
                        util:log("ERROR", concat("Unknown comparison method: ", $compare))
                }
                </expected-result>
    ,
        (: due to a possible bug in the MemTreeBuilder, the parent element will be copied ! :)
        if (exists($hackedTest/hack:expected-result)) then
            $hackedTest/hack:expected-result
        else
            ()
    )
};

declare function xqts:execute-test-case($testCase as element(catalog:test-case), $inMemory as xs:boolean) as element()? {
    let $context :=
        <static-context>
            {
                xqts:compute-specific-static-context(string($testCase/@name))
            }
            {
                for $input in $testCase/catalog:input-file
                return
                    if ($inMemory) then
                        <variable name="{$input/@variable}" source="{xqts:get-input-value-uri($input)}"/>
                    else
                        <variable name="{$input/@variable}">{xqts:get-input-value($input)}</variable>,
                for $var in $testCase/catalog:input-query
                return
                    let $variable := xqts:get-variable($testCase, $var/@name)
                    return
                        <variable name="{$var/@variable}" type="{util:get-sequence-type($variable)}">{$variable}</variable>,
                for $input in $testCase/catalog:input-URI
                return
                    if ($input eq "works") then
                        <variable name="{$input/@variable}" type="xs:anyURI">{xs:anyURI("/db/XQTS/TestSources/works.xml")}</variable>
                    else if ($input eq "works-mod") then
                        <variable name="{$input/@variable}" type="xs:anyURI">{xs:anyURI("/db/XQTS/TestSources/works-mod.xml")}</variable>
                    else
                        <variable name="{$input/@variable}" type="xs:anyURI">{xs:anyURI(concat("/db/XQTS/TestSources/", $input))}</variable>
            }
            {
                for $input in $testCase/catalog:defaultCollection
                return
                    <staticallyKnownDocuments>{concat("/db/XQTS/TestSources/", $input)}</staticallyKnownDocuments>
            }
        </static-context>
    let $query := xqts:get-query($testCase)
    let $expectedResults := xqts:get-expected-results($testCase, $inMemory)
    let $formatedResult :=
        util:catch(
            "java.lang.Exception",
            let $raw_result := util:eval-with-context($query, $context, false(), xqts:get-context-item($testCase/catalog:contextItem))
            return
                xqts:compute-result($testCase, $query, $raw_result, $expectedResults),

            (: Exception processing :)
            (: Only expected exception and got exception. No check on if it is the right exception, though. :)
            if (fn:exists($testCase//catalog:expected-error) and empty($expectedResults)) then
               <test-case name="{$testCase/@name}" result="pass" dateRun="{util:system-time()}" print="expected-exception-got-exception">
                    (: TODO : check exception code :)
                    <exception>{$util:exception-message}</exception>
                    {
                        for $expected-error in $testCase//catalog:expected-error
                        return
                            <expected-error>{$expected-error/text()}</expected-error>
                    }
                    <query>{$query}</query>
               </test-case>
            (: Expected either output or exception. :)
            else if (fn:exists($testCase//catalog:expected-error) and fn:exists($expectedResults)) then
                <test-case name="{$testCase/@name}" result="pass" dateRun="{util:system-time()}" print="expected-exception-or-output">
                    (: TODO : check exception code :)
                    <exception>{$util:exception-message}</exception>
                    {
                        for $expectedResult in $expectedResults
                        return
                            $expectedResult
                    }
                    {
                        for $expected-error in $testCase//catalog:expected-error
                        return
                            <expected-error>{$expected-error/text()}</expected-error>
                    }
                    <query>{$query}</query>
                </test-case>
            (: Expected output, but got exception. :)
            else if (fn:empty($testCase//catalog:expected-error) and fn:exists($testCase//catalog:output-file)) then
                <test-case name="{$testCase/@name}" result="fail" dateRun="{util:system-time()}" print="expected-output-got-exception">
                    <exception>{$util:exception-message}</exception>
                    {
                        for $expectedResult in $expectedResults
                        return
                            $expectedResult
                    }
                    <query>{$query}</query>
                </test-case>
            (: Don't know what is expected but got here anyway. :)
            else
                <test-case name="{$testCase/@name}" result="fail" dateRun="{util:system-time()}" print="unhandled-error">
                    <exception>{$util:exception-message}</exception>
                    {
                        for $expectedResult in $expectedResults
                        return
                            $expectedResult
                    }
                    {
                        for $expected-error in $testCase//catalog:expected-error
                        return
                            <expected-error>{$expected-error/text()}</expected-error>
                    }
                    <query>{$query}</query>
                </test-case>
        )
        let $log :=
            if (fn:empty($formatedResult)) then
                util:log("DEBUG", ("Unable to generate a formated result: ", xs:string($testCase/@name)))
            else
                ()
    return $formatedResult
};

declare function xqts:compute-result($testCase as element(catalog:test-case), $query as xs:string, $result as item()*, $expectedResults as element()* ) {
    let $passed := some $expectedResultTest in (
        for $expectedResult in $expectedResults
        return
            let $comparisonMethod := $expectedResult/@compare
            return
                if ($comparisonMethod eq "Text") then
                    (: don't use text() because () neq "" :)
                    $expectedResult/string() eq xqts:normalize-text($result)
                else if ($comparisonMethod eq "UnnormalizedText") then
                    (: don't use text() because () neq "" :)
                    (: join the results in one single string :)
                    $expectedResult/string() eq string-join($result, "")
                else if ($comparisonMethod eq "TextAsXML") then
                    xdiff:compare($expectedResult/*, util:eval($result))
                else if ($comparisonMethod eq "XML") then
                    xdiff:compare($expectedResult/*, $result)
                else if ($comparisonMethod eq "Fragment") then
                    xdiff:compare($expectedResult/*, <f>{$result}</f>)
                (: unlikely :)
                else
                    false()
    ) satisfies $expectedResultTest
    return
        xqts:format-result($testCase, $passed, $query, $result, $expectedResults)
};

declare function xqts:format-result($testCase as element(catalog:test-case), $passed as xs:boolean, $query as xs:string,
    $result as item()*, $expectedResults as item()*) as element() {
    <test-case name="{$testCase/@name}" result="{if ($passed) then 'pass' else 'fail'}" dateRun="{util:system-time()}" print="result-without-exception">
        <result>{$result}</result>
        {
            for $expectedResult in $expectedResults
            return
                $expectedResult
        }
        {
            for $expected-error in $testCase//catalog:expected-error
            return
                <expected-error>{$expected-error/text()}</expected-error>
        }
        <query>{$query}</query>
    </test-case>
};

declare function xqts:run-single-test-case($case as element(catalog:test-case),
    $resultRoot as element()?, $inMemory as xs:boolean) as empty() {
    let $result := xqts:execute-test-case($case, $inMemory)
    return
        util:catch(
            "java.lang.Exception",
            update insert $result into $resultRoot,
            update insert <test-case name="{$case/@name}" result="fail" dateRun="{util:system-time()}" print="unhandled-error">
                    <exception>Caught late exception while inserting result: {$util:exception-message}</exception>
               </test-case> into $resultRoot
        ),
        let $added := $resultRoot/test-case[@name = $case/@name]
        let $log :=
            if (fn:empty($added)) then
                util:log("DEBUG", ("FAILURE in-memory-frag in test: ", xs:string($case/@name)))
            else
                ()
        return
            if ($added) then
                xqts:report-progress($added)
            else
                ()
};

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

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

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

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

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

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

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

declare variable $testGroup external;
declare variable $testCase external;

let $XQTSCatalog := xmldb:document('/db/XQTS/XQTSCatalog.xml'),
    $case := $XQTSCatalog//catalog:test-group[@name = $testGroup]/catalog:test-case[@name = $testCase]
return
xqts:execute-test-case($case, fn:true())


add functionality to call an updating function

(:~
: This is the Care Services Discovery RESTful document processor
: @version 1.0
: @see https://github.com/openhie/openinfoman
:
:)
module namespace csr_proc = "https://github.com/openhie/openinfoman/csr_proc";

import module namespace file = "http://expath.org/ns/file";
import module namespace csd_dm = "https://github.com/openhie/openinfoman/csd_dm";
import module namespace csd_mcs = "https://github.com/openhie/openinfoman/csd_mcs";

declare   namespace   csd = "urn:ihe:iti:csd:2013";
declare namespace xquery = "http://basex.org/modules/xquery";

(:this should proabably be moved to the database :)
declare variable $csr_proc:stored_query_dir := concat(file:current-dir() , "../resources/stored_query_definitions");
declare variable $csr_proc:stored_updating_query_dir := concat(file:current-dir() , "../resources/stored_updating_query_definitions");

declare variable $csr_proc:stored_functions_doc := 'stored_functions.xml';
declare variable $csr_proc:stored_updating_functions_doc := 'stored_updating_functions.xml';

declare function csr_proc:stored_functions($db) {
 db:open($db,$csr_proc:stored_functions_doc)/careServicesFunctions/csd:careServicesFunction
};

declare function csr_proc:stored_updating_functions($db) {
 db:open($db,$csr_proc:stored_updating_functions_doc)/careServicesFunctions/csd:careServicesFunction
};

declare updating function csr_proc:init($db) {
  (
    if (not (db:is-xml($db,$csr_proc:stored_updating_functions_doc))) then
      db:add($db, <careServicesFunctions/>,$csr_proc:stored_updating_functions_doc)
    else
      ()
      ,
    if (not (db:is-xml($db,$csr_proc:stored_functions_doc))) then
      db:add($db, <careServicesFunctions/>,$csr_proc:stored_functions_doc)
    else
      ()
  )
};

declare updating function csr_proc:clear_stored_functions($db) {
  (
    db:delete($db,$csr_proc:stored_functions_doc)
    ,db:delete($db,$csr_proc:stored_updating_functions_doc)
    ,csr_proc:init($db)
    )

};

declare updating function csr_proc:load_functions_from_files($db) {
  (
    if (file:is-dir($csr_proc:stored_query_dir)) then
      for $file in file:list($csr_proc:stored_query_dir,boolean('false'),"*.xml")
      let $func := doc(concat($csr_proc:stored_query_dir,'/',$file))/csd:careServicesFunction
      return if (exists($func)) then csr_proc:load_stored_function($db,$func) else ()
    else()
      ,
    if (file:is-dir($csr_proc:stored_updating_query_dir)) then
      for $file in file:list($csr_proc:stored_updating_query_dir,boolean('false'),"*.xml")
      let $func := doc(concat($csr_proc:stored_updating_query_dir,'/',$file))/csd:careServicesFunction
      return if (exists($func)) then csr_proc:load_stored_updating_function($db,$func) else ()
    else ()
  )
};

declare updating function csr_proc:delete_stored_function($db,$urn) {
  let $stored_updating_functions := db:open($db,$csr_proc:stored_updating_functions_doc)/careServicesFunctions/*
  let $stored_functions := db:open($db,$csr_proc:stored_functions_doc)/careServicesFunctions/*
  let $functions := ($stored_functions,$stored_updating_functions)

  let $old := $functions[@urn = $urn]
  return if ($old) then delete node $old else ()

};

declare updating function csr_proc:load_stored_updating_function($db,$func) {
  let $stored_updating_functions := db:open($db,$csr_proc:stored_updating_functions_doc)/careServicesFunctions
  let $urn := $func/@urn
  let $old := $stored_updating_functions/csd:careServicesFunction[@urn = $urn]
  return
    if (exists($urn)) then
      if (exists($old))
	then
	(delete node $old,
	insert node $func into $stored_updating_functions
	)
      else
	insert node $func into $stored_updating_functions
  else ()
};

declare updating function csr_proc:load_stored_function($db,$func) {
  let $stored_functions := db:open($db,$csr_proc:stored_functions_doc)/careServicesFunctions
  let $urn := $func/@urn
  let $old := $stored_functions/csd:careServicesFunction[@urn = $urn]
  return
    if (exists($urn) and exists($stored_functions)) then
      if (exists($old))
	then
	(delete node $old,
	insert node $func into $stored_functions
	)
      else
	insert node $func into $stored_functions
    else ()
};

declare function csr_proc:process_CSR($db,$careServicesRequest, $doc_name,$base_url)
{
csr_proc:process_CSR($db,$careServicesRequest, $doc_name, $base_url,map:new(()))
};

declare function csr_proc:process_CSR($db,$careServicesRequest, $doc_name,$base_url,$bindings as map(*))
{
let $function :=$careServicesRequest/csd:function
let $adhoc :=$careServicesRequest/csd:expression
return if (exists($function))
then
  let $urn := string($function/@urn)
  let $csr :=
  <csd:careServicesRequest>
    <csd:function urn="{$urn}" resource='{$doc_name}' base_url='{$base_url}'>
      <csd:requestParams >
	{
	  if ($function/csd:requestParams) then $function/csd:requestParams/*
	  else $function/requestParams/*
	}
      </csd:requestParams>
    </csd:function>
  </csd:careServicesRequest>

  return csr_proc:process_CSR_stored($db,$csr,$bindings)
else if (exists($adhoc))
then
  csr_proc:process_CSR_adhoc($db,$adhoc,$doc_name,$bindings)
else
 (:
  <rest:response>
    <http:response status="400" message="Invalid care services request.">
      <http:header name="Content-Language" value="en"/>
      <http:header name="Content-Type" value="text/html; charset=utf-8"/>
    </http:response>
  </rest:response>
  :)
  $careServicesRequest

};

declare function csr_proc:process_CSR_adhoc($db,$expression,$doc_name) {
   csr_proc:process_CSR_adhoc($expression,$doc_name,map:new(()))
};

declare function csr_proc:process_CSR_adhoc($db,$expression,$doc_name,$bindings as map(*))
{

let $doc :=  csd_dm:open_document($db,$doc_name)

let $expr :=string($expression)
return if ($expr) then
  let $result := xquery:eval($expr,map{"":=$doc},$bindings)
  return(
   <rest:response>
   <http:response status="200" >
      <http:header name="Content-Type" value="{$expression/@content-type}"/>
    </http:response>
  </rest:response>
  ,$result
 )
else
   <rest:response>
     <http:response status="400" message="No ad-hoc expression" />
  </rest:response>
};

declare function csr_proc:process_CSR_stored($db,$careServicesRequest)
{
  csr_proc:process_CSR_stored($db,$careServicesRequest,map:new())
};

declare function csr_proc:process_CSR_stored($db,$careServicesRequest,$bindings as map(*))
{
let $function :=$careServicesRequest/csd:function
let $stored_functions := csr_proc:stored_functions($db)
let $urn := string($function/@urn)
let $definition := ($stored_functions[@urn = $urn])[1]/csd:definition/text()
let $content_type := csr_proc:lookup_stored_content_type($db,$function/@urn)
let $doc_name := string($function/@resource)
let $doc :=  csd_dm:open_document($db,$doc_name)

let $results0 := csr_proc:process_CSR_stored_results($db,$doc,$careServicesRequest,$bindings)

return if (exists($definition)) then
  let $results1:=
    if ($function/@encapsulated) then
      csr_proc:wrap_result($results0,$content_type)
    else $results0
  return
    (
    <rest:response>
      <http:response status="200" >
	<http:header name="Content-Type" value="{$content_type}"/>
      </http:response>
    </rest:response>
    ,
    $results1
    )
else
  <rest:response>
    <http:response status="404" message="No registered function with URN='{$function/@urn}'.">
      <http:header name="Content-Language" value="en"/>
      <http:header name="Content-Type" value="text/html; charset=utf-8"/>
    </http:response>
  </rest:response>
};

declare function csr_proc:wrap_result($result,$content-type) {
 <csd:careServicesResponse content-type="{$content-type}"><csd:result>{$result}</csd:result></csd:careServicesResponse>
};

declare function csr_proc:process_CSR_stored_results($db,$doc,$careServicesRequest)
{
  csr_proc:process_CSR_stored_results($db,$doc,$careServicesRequest,map:new())
};

declare function csr_proc:process_CSR_stored_results($db,$doc,$careServicesRequest,$bindings as map(*))
{
let $function :=$careServicesRequest/csd:function
let $urn := string($function/@urn)
let $doc_name := string($function/@resource)
let $base_url := string($function/@base_url)

let $stored_functions := csr_proc:stored_functions($db)
let $definition := ($stored_functions[@urn = $urn])[1]/csd:definition/text()

let $options := csr_proc:lookup_stored_options($db,$function/@urn)

let $requestParams :=
 <csd:requestParams resource='{$doc_name}' function='{$urn}' base_url='{$base_url}'>
   {
     if ($function/csd:requestParams) then $function/csd:requestParams/*
   else $function/requestParams/*
   }
 </csd:requestParams>

let $csr_bindings :=  map{'':=$doc,'careServicesRequest':=$requestParams}
let $all_bindings :=  map:new(($csr_bindings, $bindings))

return if (exists($definition)) then
  xquery:eval($definition,$all_bindings,$options)
else ()
};

declare function csr_proc:create_adhoc_doc($adhoc_query,$content_type) {
let $content := if ($content_type) then $content_type else "application/xml"
return
 <csd:careServicesRequest xmlns:csd='urn:ihe:iti:csd:2013'>
  <csd:expression content-type='{$content}'>
  {$adhoc_query}
  </csd:expression>
</csd:careServicesRequest>

};

declare function csr_proc:get_function_definition($db,$urn) {
  csr_proc:stored_functions($db)[@urn = $urn][1]
};

declare function csr_proc:get_updating_function_definition($db,$urn) {
  csr_proc:stored_updating_functions($db)[@urn = $urn][1]
};

declare updating function csr_proc:process_updating_CSR($db,$function,$doc_name,$base_url)
{
  csr_proc:process_updating_CSR($db,$function,$doc_name,$base_url,map:new(()))
};

declare updating function csr_proc:process_updating_CSR_results($db,$function)
{
  csr_proc:process_updating_CSR_results($db,$function,map:new(()))
};

declare updating function csr_proc:process_updating_CSR_results($db,$careServicesRequest, $bindings as map(*)) {
let $function :=$careServicesRequest//csd:function
let $doc_name := string($function/@resource)
let $base_url := string($function/@base_url)
let $doc := csd_dm:open_document($db,$doc_name)
let $urn := $function/@urn
let $stored_updating_functions := csr_proc:stored_updating_functions($db)
let $definition := $stored_updating_functions[@urn = $urn][1]/csd:definition/text()
let $content_type := csr_proc:lookup_stored_content_type($db,$function/@urn)
let $requestParams := <csd:requestParams resource='{$doc_name}' function='{$urn}' base_url='{$base_url}'>
  {
    if ($function/csd:requestParams) then $function/csd:requestParams/*
    else $function/requestParams/*
  }
</csd:requestParams>

let $csr_bindings :=  map{'':=$doc,'careServicesRequest':=$requestParams}
let $all_bindings :=  map:new(($csr_bindings, $bindings))

let $options := csr_proc:lookup_stored_options($db,$function/@urn)

return if (exists($definition)) then
  (
  xquery:update($definition,$all_bindings,$options)
  )
else  ()

};

declare updating function csr_proc:process_updating_CSR($db,$careServicesRequest, $doc_name, $base_url,$bindings as map(*))
{
(:not allowing ad-hoc updates:)
let $doc := csd_dm:open_document($db,$doc_name)
let $function :=$careServicesRequest//csd:function
let $urn := $function/@urn
let $stored_updating_functions := csr_proc:stored_updating_functions($db)
let $definition := $stored_updating_functions[@urn = $urn][1]/csd:definition/text()
let $content_type := csr_proc:lookup_stored_content_type($db,$function/@urn)
let $requestParams := <csd:requestParams resource='{$doc_name}' function='{$urn}' base_url='{$base_url}'>
  {
    if ($function/csd:requestParams) then $function/csd:requestParams/*
    else $function/requestParams/*
  }
</csd:requestParams>

let $csr_bindings :=  map{'':=$doc,'careServicesRequest':=$requestParams}
let $all_bindings :=  map:new(($csr_bindings, $bindings))

let $options := csr_proc:lookup_stored_options($db,$function/@urn)

return if (exists($definition)) then
  xquery:update($definition,$all_bindings,$options)
else
    db:output(
    <rest:response>
      <http:response status="404" message="No registered updating function with URN='{$function/@urn}">
	<http:header name="Content-Language" value="en"/>
	<http:header name="Content-Type" value="text/html; charset=utf-8"/>
      </http:response>
    </rest:response>
       )
};

declare function csr_proc:lookup_stored_options($db,$urn)
{
  let $stored_updating_functions := csr_proc:stored_updating_functions($db)
  let $stored_functions := csr_proc:stored_functions($db)
  let $func := ($stored_functions[@urn = $urn], $stored_updating_functions[@urn = $urn])[1]
   return  ($func/csd:extension[@urn='urn:openhie.org:openinfoman:csr_processor' and  @type='xquery:options']/xquery:options)[1]
     (: See: http://docs.basex.org/wiki/XQuery_Module :)
};

declare function csr_proc:lookup_stored_content_type($db,$urn)
{
  let $stored_updating_functions := csr_proc:stored_updating_functions($db)
  let $stored_functions := csr_proc:stored_functions($db)
  return string(($stored_functions[@urn = $urn]/@content-type, $stored_updating_functions[@urn = $urn]/@content-type  , "text/xml")[1])
};

(:~
: This is the Care Services Discovery RESTful document processor
: @version 1.0
: @see https://github.com/openhie/openinfoman
:
:)
module namespace csr_proc = "https://github.com/openhie/openinfoman/csr_proc";

import module namespace file = "http://expath.org/ns/file";
import module namespace csd_dm = "https://github.com/openhie/openinfoman/csd_dm";
import module namespace csd_mcs = "https://github.com/openhie/openinfoman/csd_mcs";

declare   namespace   csd = "urn:ihe:iti:csd:2013";
declare namespace xquery = "http://basex.org/modules/xquery";

(:this should proabably be moved to the database :)
declare variable $csr_proc:stored_query_dir := concat(file:current-dir() , "../resources/stored_query_definitions");
declare variable $csr_proc:stored_updating_query_dir := concat(file:current-dir() , "../resources/stored_updating_query_definitions");

declare variable $csr_proc:stored_functions_doc := 'stored_functions.xml';
declare variable $csr_proc:stored_updating_functions_doc := 'stored_updating_functions.xml';

declare function csr_proc:stored_functions($db) {
 db:open($db,$csr_proc:stored_functions_doc)/careServicesFunctions/csd:careServicesFunction
};

declare function csr_proc:stored_updating_functions($db) {
 db:open($db,$csr_proc:stored_updating_functions_doc)/careServicesFunctions/csd:careServicesFunction
};

declare updating function csr_proc:init($db) {
  (
    if (not (db:is-xml($db,$csr_proc:stored_updating_functions_doc))) then
      db:add($db, <careServicesFunctions/>,$csr_proc:stored_updating_functions_doc)
    else
      ()
      ,
    if (not (db:is-xml($db,$csr_proc:stored_functions_doc))) then
      db:add($db, <careServicesFunctions/>,$csr_proc:stored_functions_doc)
    else
      ()
  )
};

declare updating function csr_proc:clear_stored_functions($db) {
  (
    db:delete($db,$csr_proc:stored_functions_doc)
    ,db:delete($db,$csr_proc:stored_updating_functions_doc)
    ,csr_proc:init($db)
    )

};

declare updating function csr_proc:load_functions_from_files($db) {
  (
    if (file:is-dir($csr_proc:stored_query_dir)) then
      for $file in file:list($csr_proc:stored_query_dir,boolean('false'),"*.xml")
      let $func := doc(concat($csr_proc:stored_query_dir,'/',$file))/csd:careServicesFunction
      return if (exists($func)) then csr_proc:load_stored_function($db,$func) else ()
    else()
      ,
    if (file:is-dir($csr_proc:stored_updating_query_dir)) then
      for $file in file:list($csr_proc:stored_updating_query_dir,boolean('false'),"*.xml")
      let $func := doc(concat($csr_proc:stored_updating_query_dir,'/',$file))/csd:careServicesFunction
      return if (exists($func)) then csr_proc:load_stored_updating_function($db,$func) else ()
    else ()
  )
};

declare updating function csr_proc:delete_stored_function($db,$urn) {
  let $stored_updating_functions := db:open($db,$csr_proc:stored_updating_functions_doc)/careServicesFunctions/*
  let $stored_functions := db:open($db,$csr_proc:stored_functions_doc)/careServicesFunctions/*
  let $functions := ($stored_functions,$stored_updating_functions)

  let $old := $functions[@urn = $urn]
  return if ($old) then delete node $old else ()

};

declare updating function csr_proc:load_stored_updating_function($db,$func) {
  let $stored_updating_functions := db:open($db,$csr_proc:stored_updating_functions_doc)/careServicesFunctions
  let $urn := $func/@urn
  let $old := $stored_updating_functions/csd:careServicesFunction[@urn = $urn]
  return
    if (exists($urn)) then
      if (exists($old))
	then
	(delete node $old,
	insert node $func into $stored_updating_functions
	)
      else
	insert node $func into $stored_updating_functions
  else ()
};

declare updating function csr_proc:load_stored_function($db,$func) {
  let $stored_functions := db:open($db,$csr_proc:stored_functions_doc)/careServicesFunctions
  let $urn := $func/@urn
  let $old := $stored_functions/csd:careServicesFunction[@urn = $urn]
  return
    if (exists($urn) and exists($stored_functions)) then
      if (exists($old))
	then
	(delete node $old,
	insert node $func into $stored_functions
	)
      else
	insert node $func into $stored_functions
    else ()
};

declare function csr_proc:process_CSR($db,$careServicesRequest, $doc_name,$base_url)
{
csr_proc:process_CSR($db,$careServicesRequest, $doc_name, $base_url,map:new(()))
};

declare function csr_proc:process_CSR($db,$careServicesRequest, $doc_name,$base_url,$bindings as map(*))
{
let $function :=$careServicesRequest/csd:function
let $adhoc :=$careServicesRequest/csd:expression
return if (exists($function))
then
  let $urn := string($function/@urn)
  let $csr :=
  <csd:careServicesRequest>
    <csd:function urn="{$urn}" resource='{$doc_name}' base_url='{$base_url}'>
      <csd:requestParams >
	{
	  if ($function/csd:requestParams) then $function/csd:requestParams/*
	  else $function/requestParams/*
	}
      </csd:requestParams>
    </csd:function>
  </csd:careServicesRequest>

  return csr_proc:process_CSR_stored($db,$csr,$bindings)
else if (exists($adhoc))
then
  csr_proc:process_CSR_adhoc($db,$adhoc,$doc_name,$bindings)
else
 (:
  <rest:response>
    <http:response status="400" message="Invalid care services request.">
      <http:header name="Content-Language" value="en"/>
      <http:header name="Content-Type" value="text/html; charset=utf-8"/>
    </http:response>
  </rest:response>
  :)
  $careServicesRequest

};

declare function csr_proc:process_CSR_adhoc($db,$expression,$doc_name) {
   csr_proc:process_CSR_adhoc($expression,$doc_name,map:new(()))
};

declare function csr_proc:process_CSR_adhoc($db,$expression,$doc_name,$bindings as map(*))
{

let $doc :=  csd_dm:open_document($db,$doc_name)

let $expr :=string($expression)
return if ($expr) then
  let $result := xquery:eval($expr,map{"":=$doc},$bindings)
  return(
   <rest:response>
   <http:response status="200" >
      <http:header name="Content-Type" value="{$expression/@content-type}"/>
    </http:response>
  </rest:response>
  ,$result
 )
else
   <rest:response>
     <http:response status="400" message="No ad-hoc expression" />
  </rest:response>
};

declare function csr_proc:process_CSR_stored($db,$careServicesRequest)
{
  csr_proc:process_CSR_stored($db,$careServicesRequest,map:new())
};

declare function csr_proc:process_CSR_stored($db,$careServicesRequest,$bindings as map(*))
{
let $function :=$careServicesRequest/csd:function
let $stored_functions := csr_proc:stored_functions($db)
let $urn := string($function/@urn)
let $definition := ($stored_functions[@urn = $urn])[1]/csd:definition/text()
let $content_type := csr_proc:lookup_stored_content_type($db,$function/@urn)
let $doc_name := string($function/@resource)
let $doc :=  csd_dm:open_document($db,$doc_name)

let $results0 := csr_proc:process_CSR_stored_results($db,$doc,$careServicesRequest,$bindings)

return if (exists($definition)) then
  let $results1:=
    if ($function/@encapsulated) then
      csr_proc:wrap_result($results0,$content_type)
    else $results0
  return
    (
    <rest:response>
      <http:response status="200" >
	<http:header name="Content-Type" value="{$content_type}"/>
      </http:response>
    </rest:response>
    ,
    $results1
    )
else
  <rest:response>
    <http:response status="404" message="No registered function with URN='{$function/@urn}'.">
      <http:header name="Content-Language" value="en"/>
      <http:header name="Content-Type" value="text/html; charset=utf-8"/>
    </http:response>
  </rest:response>
};

declare function csr_proc:wrap_result($result,$content-type) {
 <csd:careServicesResponse content-type="{$content-type}"><csd:result>{$result}</csd:result></csd:careServicesResponse>
};

declare function csr_proc:process_CSR_stored_results($db,$doc,$careServicesRequest)
{
  csr_proc:process_CSR_stored_results($db,$doc,$careServicesRequest,map:new())
};

declare function csr_proc:process_CSR_stored_results($db,$doc,$careServicesRequest,$bindings as map(*))
{
let $function :=$careServicesRequest/csd:function
let $urn := string($function/@urn)
let $doc_name := string($function/@resource)
let $base_url := string($function/@base_url)

let $stored_functions := csr_proc:stored_functions($db)
let $definition := ($stored_functions[@urn = $urn])[1]/csd:definition/text()

let $options := csr_proc:lookup_stored_options($db,$function/@urn)

let $requestParams :=
 <csd:requestParams resource='{$doc_name}' function='{$urn}' base_url='{$base_url}'>
   {
     if ($function/csd:requestParams) then $function/csd:requestParams/*
   else $function/requestParams/*
   }
 </csd:requestParams>

let $csr_bindings :=  map{'':=$doc,'careServicesRequest':=$requestParams}
let $all_bindings :=  map:new(($csr_bindings, $bindings))

return if (exists($definition)) then
  xquery:eval($definition,$all_bindings,$options)
else ()
};

declare function csr_proc:create_adhoc_doc($adhoc_query,$content_type) {
let $content := if ($content_type) then $content_type else "application/xml"
return
 <csd:careServicesRequest xmlns:csd='urn:ihe:iti:csd:2013'>
  <csd:expression content-type='{$content}'>
  {$adhoc_query}
  </csd:expression>
</csd:careServicesRequest>

};

declare function csr_proc:get_function_definition($db,$urn) {
  csr_proc:stored_functions($db)[@urn = $urn][1]
};

declare function csr_proc:get_updating_function_definition($db,$urn) {
  csr_proc:stored_updating_functions($db)[@urn = $urn][1]
};

declare updating function csr_proc:process_updating_CSR($db,$function,$doc_name,$base_url)
{
  csr_proc:process_updating_CSR($db,$function,$doc_name,$base_url,map:new(()))
};

declare updating function csr_proc:process_updating_CSR($db,$careServicesRequest, $doc_name, $base_url,$bindings as map(*))
{
(:not allowing ad-hoc updates:)
let $doc := csd_dm:open_document($db,$doc_name)
let $function :=$careServicesRequest//csd:function
let $urn := $function/@urn
let $stored_updating_functions := csr_proc:stored_updating_functions($db)
let $definition := $stored_updating_functions[@urn = $urn][1]/csd:definition/text()
let $content_type := csr_proc:lookup_stored_content_type($db,$function/@urn)
let $requestParams := <csd:requestParams resource='{$doc_name}' function='{$urn}' base_url='{$base_url}'>
  {
    if ($function/csd:requestParams) then $function/csd:requestParams/*
    else $function/requestParams/*
  }
</csd:requestParams>

let $csr_bindings :=  map{'':=$doc,'careServicesRequest':=$requestParams}
let $all_bindings :=  map:new(($csr_bindings, $bindings))

let $options := csr_proc:lookup_stored_options($db,$function/@urn)

return if (exists($definition)) then
  xquery:update($definition,$all_bindings,$options)
else
    db:output(
    <rest:response>
      <http:response status="404" message="No registered updating function with URN='{$function/@urn}">
	<http:header name="Content-Language" value="en"/>
	<http:header name="Content-Type" value="text/html; charset=utf-8"/>
      </http:response>
    </rest:response>
       )
};

declare function csr_proc:lookup_stored_options($db,$urn)
{
  let $stored_updating_functions := csr_proc:stored_updating_functions($db)
  let $stored_functions := csr_proc:stored_functions($db)
  let $func := ($stored_functions[@urn = $urn], $stored_updating_functions[@urn = $urn])[1]
   return  ($func/csd:extension[@urn='urn:openhie.org:openinfoman:csr_processor' and  @type='xquery:options']/xquery:options)[1]
     (: See: http://docs.basex.org/wiki/XQuery_Module :)
};

declare function csr_proc:lookup_stored_content_type($db,$urn)
{
  let $stored_updating_functions := csr_proc:stored_updating_functions($db)
  let $stored_functions := csr_proc:stored_functions($db)
  return string(($stored_functions[@urn = $urn]/@content-type, $stored_updating_functions[@urn = $urn]/@content-type  , "text/xml")[1])
};