added @see support for module description, and made @see for both module and function links (more variants of @see are yet to be implemented, i.e. @see http://xqdoc.org/xqdoc_comments_doc.html)

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

xquery version "1.0";

(: $Id$ :)

(:~
    Main XQuery script for the RESTful function docs application.

    The parameters passed in from controller.xql are:
        basepath: Used as base path for URLs
        module:   Module name
        function: Function name

    The controller.xql intercepts URLs like
        http://exist-db.org/exist/functions/xmldb/login
    and parses and passes these parameters transparently to the script:
        basepath: /exist/functions/
        module:   xmldb
        function: login
:)

(: eXist module namespaces :)
declare namespace request="http://exist-db.org/xquery/request";
declare namespace text="http://exist-db.org/xquery/text";
declare namespace util="http://exist-db.org/xquery/util";

(: Document namespaces :)
declare namespace xq="http://www.xqdoc.org/1.0";

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

(: App root URL, passed in from controller.xql.  Used as base path for URLs. :)
declare variable $basepath := request:get-parameter('basepath', ());

(: Render a function or a set of functions :)
declare function local:render-function( $functionNode as element(xq:function)+, $showlinks as xs:boolean) as element() {
    let $parentModule := $functionNode/ancestor::xq:xqdoc/xq:module/xq:uri/text()
    let $parentModuleName := $functionNode/ancestor::xq:xqdoc/xq:module/xq:name/text()
    let $functionName := $functionNode/xq:name/text()
    let $functionSignature := $functionNode/xq:signature/text()
    let $functionDeprecated := $functionNode/xq:comment/xq:deprecated/text()
    let $functionDescription := $functionNode/xq:comment/xq:description/text()
    let $functionVersion := $functionNode/xq:comment/xq:version/text()
    let $functionParameters := $functionNode/xq:comment/xq:param
    let $functionSees := $functionNode/xq:comment/xq:see
    let $functionReturns := $functionNode/xq:comment/xq:return/text()
    let $authors := $functionNode/xq:comment/xq:author
    let $sinces := $functionNode/xq:comment/xq:since
    return

{
                if ($showlinks) then
                    {$functionName}
                else $functionName
            }

{
                if (not(starts-with($functionSignature, $parentModuleName))) then
                    concat($parentModuleName, ':', $functionSignature)
                else
                    $functionSignature
            }

{$functionDescription}

{
                for $author in $authors
                return
                    {$author}
            }

            {
            if (string-length($functionVersion) > 0) then

Version {$functionVersion}

            else ()
            }

{
                if (empty($sinces)) then ()
                else

Since {string-join($sinces, ", ")}

            }

{
                for $see in $functionSees
                return

See {$see/text()}

            }

{
                    for $parameter in $functionParameters
                    let $split := text:groups(normalize-space($parameter), "^(\$[^ ]+) (.*)$")
                    return

                            {$split[2]}
                            {$split[3]}

                }

            {
            if (string-length($functionReturns) > 0) then

Returns {$functionReturns}

            else (),
            if (string-length($functionDeprecated) > 0) then

Deprecated: {$functionDeprecated}

            else ()
            }

};

(: Render a module or set of modules :)
(: TODO add moduleSees, other standard XQDoc comments :)
declare function local:render-module($moduleURIs as xs:string+, $functionName as xs:string?, $showlinks as xs:boolean) as element()+ {
    for $moduleURI in $moduleURIs
	let $moduleDocs := /xq:xqdoc[xq:module/xq:uri eq $moduleURI]
	let $moduleName := if ($moduleURI = 'http://www.w3.org/2005/xpath-functions') then 'fn' else $moduleDocs/xq:module/xq:name/text()
	let $moduleDescription := $moduleDocs/xq:module/xq:comment/xq:description/node()
    let $moduleSees := $moduleDocs/xq:module/xq:comment/xq:see
	order by $moduleURI
	return

{
                  if ($showlinks) then
                     {$moduleName}
                  else
                     $moduleName
               }

{$moduleURI}

{$moduleDescription}

{
                    for $see in $moduleSees
                    return

See {$see/text()}

               }

{
	           (: Decide whether to render a single function or to render them all :)
	           if ($functionName) then
	               for $functionNode in $moduleDocs/xq:functions/xq:function[xq:name eq $functionName]
                   return local:render-function($functionNode, $showlinks)
               else
    	           for $functionNode in $moduleDocs/xq:functions/xq:function
    	           return local:render-function($functionNode, $showlinks)
	       }

};

(:
 : URL handling functions
 :)

(: Constructs a URL from a module URI :)
declare function local:moduleURI-to-URL($moduleURI as xs:string) as xs:string {
    if ($moduleURI = 'http://www.w3.org/2005/xpath-functions') then
        concat($basepath, 'fn')
    else
        concat($basepath, /xq:xqdoc/xq:module[xq:uri eq $moduleURI]/xq:name/text())
};

(: Constructs a URL from a module :)
declare function local:module-to-URL($module as xs:string) as xs:string {
    concat($basepath, $module)
};

(: Constructs a URL from a function :)
declare function local:function-to-URL($moduleURI as xs:string, $function as xs:string) {
    concat(local:moduleURI-to-URL($moduleURI), '/', $function)
};

(: Derives the module name from the module URI :)
declare function local:moduleURI-to-module($moduleURI as xs:string) as xs:string {
    if ($moduleURI = 'http://www.w3.org/2005/xpath-functions') then
        'fn'
    else
        /xq:xqdoc/xq:module[xq:uri eq $moduleURI]/xq:name/text()
};

(: Lists all modules :)
declare function local:list-modules($moduleURIs) {
    (

Reload documentation
        (click here if you enabled/disabled additional modules)

    ,

(eXist version: {util:system-property("product-version")},
        build: {util:system-property("product-build")}, functions: {count(//xq:function)}.)
        Modules have to be enabled in conf.xml to appear here.

    ,

Expand All or select a single module:

    ,

Name	Description	Namespace URI

{
            for $moduleURI in $moduleURIs
            let $moduleDocs := /xq:xqdoc[xq:module/xq:uri eq $moduleURI]
        	let $moduleName :=
        	   if ($moduleURI eq 'http://www.w3.org/2005/xpath-functions') then
        	       (: note: the xq:name for the xpath functions module is empty
        	        : since it's the default function namespace, but we need a name
        	        : for the link, so we just use 'fn' :)
        	       'fn'
               else $moduleDocs/xq:module/xq:name/text()
        	let $moduleDescription := string-join(data($moduleDocs/xq:module/xq:comment/xq:description/node()), '')
        	let $moduleDescription := if (string-length($moduleDescription) lt 90) then $moduleDescription else concat(substring($moduleDescription, 1, 90), '...')
        	order by $moduleName
            return

                    {$moduleName}
                    {if ($moduleDescription) then $moduleDescription else No description present}
                    {$moduleURI}

        }

    )
};

(: Breadcrumbs for the page :)
declare function local:breadcrumbs($module, $function, $viewall) {

        Modules
        {
        if ($viewall) then
            ' > All Modules and Functions'
        else if ($module and not($function)) then
            (
            ' > '
            ,
            {$module}
            )
        else if ($module and $function) then
            (
            ' > '
            ,
            {$module}
            ,
            ' > '
            ,
            {$function}
            )
        else
            ' > Home'
        }

};

(: Footer-like 'return to home' link :)
declare function local:return-to-main() as element() {

        Return to list of all modules

};

(: Business logic :)
declare function local:main() {
    (: Get URL parameters :)
    let $module := request:get-parameter('module', ())
    let $function := request:get-parameter('function', ())
    let $showlinks := request:get-parameter('showlinks', 1) cast as xs:boolean
    let $q := request:get-parameter('q', ())

    (: Catch a request for 'all', i.e. the complete listing :)
    let $viewall := $module eq 'all'

    (: Derive module URIs based on URL parameter $module :)
    let $allModuleURIs := /xq:xqdoc/xq:module/xq:uri
    let $matchingModuleURIs := if ($module) then
        if ($module = 'fn') then
            'http://www.w3.org/2005/xpath-functions'
        else
            $allModuleURIs[following-sibling::xq:name eq $module]
        else ()
    let $moduleURIs := if ($matchingModuleURIs) then $matchingModuleURIs else $allModuleURIs

    return
        (
        (: Show documentation for all modules:)
        if ($viewall) then
            (
            local:breadcrumbs($module, $function, $viewall)
            ,
            local:render-module($moduleURIs, (), $showlinks)
            ,
            local:return-to-main()
            )
        (: Show just the list of modules :)
        else if (not($module)) then
            (
            local:breadcrumbs($module, $function, $viewall)
            ,
            local:list-modules($moduleURIs)
            )
        (: Show a single module :)
        else if ($module and $matchingModuleURIs) then
            if (count($matchingModuleURIs) gt 1) then
                (: TODO: Add handling for resolving modules with the same 'name' :)
                (
                local:breadcrumbs($module, $function, $viewall)
                ,
                local:render-module($moduleURIs, $function, $showlinks)
                ,
                local:return-to-main()
                )
            else
                (
                local:breadcrumbs($module, $function, $viewall)
                ,
                local:render-module($moduleURIs, $function, $showlinks)
                ,
                local:return-to-main()
                )
        (: Handle cases where there are no exact matching modules :)
        else
            (: else if ($module and not($matchingModules)) :)
            (: TODO add a fuzzy search :)
            (
            local:breadcrumbs((), (), $viewall)
            ,

Sorry, there are no modules that match "{$module}."  Please choose from the list below:

            ,
            local:list-modules($moduleURIs)
            )
        )

};

(: Module body :)
<book>
    <bookinfo>
        <graphic fileref="logo.jpg"/>
        <productname>Open Source Native XML Database</productname>
        <title>eXist Function Modules</title>
        <link rel="shortcut icon" href="../resources/exist_icon_16x16.ico"/>
		<link rel="icon" href="../resources/exist_icon_16x16.png" type="image/png"/>

    </bookinfo>

        <xi:include xmlns:xi="http://www.w3.org/2001/XInclude" href="../sidebar.xml"/>

    <chapter>
        <title>A RESTful browser for eXist Function Modules</title>
        { local:main() }
    </chapter>
</book>

xquery version "1.0";

(: $Id$ :)

(:~
    Main XQuery script for the RESTful function docs application.

    The parameters passed in from controller.xql are:
        basepath: Used as base path for URLs
        module:   Module name
        function: Function name

    The controller.xql intercepts URLs like
        http://exist-db.org/exist/functions/xmldb/login
    and parses and passes these parameters transparently to the script:
        basepath: /exist/functions/
        module:   xmldb
        function: login
:)

(: eXist module namespaces :)
declare namespace request="http://exist-db.org/xquery/request";
declare namespace text="http://exist-db.org/xquery/text";
declare namespace util="http://exist-db.org/xquery/util";

(: Document namespaces :)
declare namespace xq="http://www.xqdoc.org/1.0";

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

(: App root URL, passed in from controller.xql.  Used as base path for URLs. :)
declare variable $basepath := request:get-parameter('basepath', ());

(: Render a function or a set of functions :)
declare function local:render-function( $functionNode as element(xq:function)+, $showlinks as xs:boolean) as element() {
    let $parentModule := $functionNode/ancestor::xq:xqdoc/xq:module/xq:uri/text()
    let $parentModuleName := $functionNode/ancestor::xq:xqdoc/xq:module/xq:name/text()
    let $functionName := $functionNode/xq:name/text()
    let $functionSignature := $functionNode/xq:signature/text()
    let $functionDeprecated := $functionNode/xq:comment/xq:deprecated/text()
    let $functionDescription := $functionNode/xq:comment/xq:description/text()
    let $functionVersion := $functionNode/xq:comment/xq:version/text()
    let $functionParameters := $functionNode/xq:comment/xq:param
    let $functionSees := $functionNode/xq:comment/xq:see
    let $functionReturns := $functionNode/xq:comment/xq:return/text()
    let $authors := $functionNode/xq:comment/xq:author
    let $sinces := $functionNode/xq:comment/xq:since
    return

{
                if ($showlinks) then
                    {$functionName}
                else $functionName
            }

{
                if (not(starts-with($functionSignature, $parentModuleName))) then
                    concat($parentModuleName, ':', $functionSignature)
                else
                    $functionSignature
            }

{$functionDescription}

{
                for $author in $authors
                return
                    {$author}
            }

            {
            if (string-length($functionVersion) > 0) then

Version {$functionVersion}

            else ()
            }

{
                if (empty($sinces)) then ()
                else

Since {string-join($sinces, ", ")}

            }

{
                for $see in $functionSees
                return

See {$see}

            }

{
                    for $parameter in $functionParameters
                    let $split := text:groups(normalize-space($parameter), "^(\$[^ ]+) (.*)$")
                    return

                            {$split[2]}
                            {$split[3]}

                }

            {
            if (string-length($functionReturns) > 0) then

Returns {$functionReturns}

            else (),
            if (string-length($functionDeprecated) > 0) then

Deprecated: {$functionDeprecated}

            else ()
            }

};

(: Render a module or set of modules :)
(: TODO add moduleSees, other standard XQDoc comments :)
declare function local:render-module($moduleURIs as xs:string+, $functionName as xs:string?, $showlinks as xs:boolean) as element()+ {
    for $moduleURI in $moduleURIs
	let $moduleDocs := /xq:xqdoc[xq:module/xq:uri eq $moduleURI]
	let $moduleName := if ($moduleURI = 'http://www.w3.org/2005/xpath-functions') then 'fn' else $moduleDocs/xq:module/xq:name/text()
	let $moduleDescription := $moduleDocs/xq:module/xq:comment/xq:description/node()
	order by $moduleURI
	return

{
                  if ($showlinks) then
                     {$moduleName}
                  else
                     $moduleName
               }

{$moduleURI}

{$moduleDescription}

{
	           (: Decide whether to render a single function or to render them all :)
	           if ($functionName) then
	               for $functionNode in $moduleDocs/xq:functions/xq:function[xq:name eq $functionName]
                   return local:render-function($functionNode, $showlinks)
               else
    	           for $functionNode in $moduleDocs/xq:functions/xq:function
    	           return local:render-function($functionNode, $showlinks)
	       }

};

(:
 : URL handling functions
 :)

(: Constructs a URL from a module URI :)
declare function local:moduleURI-to-URL($moduleURI as xs:string) as xs:string {
    if ($moduleURI = 'http://www.w3.org/2005/xpath-functions') then
        concat($basepath, 'fn')
    else
        concat($basepath, /xq:xqdoc/xq:module[xq:uri eq $moduleURI]/xq:name/text())
};

(: Constructs a URL from a module :)
declare function local:module-to-URL($module as xs:string) as xs:string {
    concat($basepath, $module)
};

(: Constructs a URL from a function :)
declare function local:function-to-URL($moduleURI as xs:string, $function as xs:string) {
    concat(local:moduleURI-to-URL($moduleURI), '/', $function)
};

(: Derives the module name from the module URI :)
declare function local:moduleURI-to-module($moduleURI as xs:string) as xs:string {
    if ($moduleURI = 'http://www.w3.org/2005/xpath-functions') then
        'fn'
    else
        /xq:xqdoc/xq:module[xq:uri eq $moduleURI]/xq:name/text()
};

(: Lists all modules :)
declare function local:list-modules($moduleURIs) {
    (

Reload documentation
        (click here if you enabled/disabled additional modules)

    ,

(eXist version: {util:system-property("product-version")},
        build: {util:system-property("product-build")}, functions: {count(//xq:function)}.)
        Modules have to be enabled in conf.xml to appear here.

    ,

Expand All or select a single module:

    ,

Name	Description	Namespace URI

{
            for $moduleURI in $moduleURIs
            let $moduleDocs := /xq:xqdoc[xq:module/xq:uri eq $moduleURI]
        	let $moduleName :=
        	   if ($moduleURI eq 'http://www.w3.org/2005/xpath-functions') then
        	       (: note: the xq:name for the xpath functions module is empty
        	        : since it's the default function namespace, but we need a name
        	        : for the link, so we just use 'fn' :)
        	       'fn'
               else $moduleDocs/xq:module/xq:name/text()
        	let $moduleDescription := string-join(data($moduleDocs/xq:module/xq:comment/xq:description/node()), '')
        	let $moduleDescription := if (string-length($moduleDescription) lt 90) then $moduleDescription else concat(substring($moduleDescription, 1, 90), '...')
        	order by $moduleName
            return

                    {$moduleName}
                    {if ($moduleDescription) then $moduleDescription else No description present}
                    {$moduleURI}

        }

    )
};

(: Breadcrumbs for the page :)
declare function local:breadcrumbs($module, $function, $viewall) {

        Modules
        {
        if ($viewall) then
            ' > All Modules and Functions'
        else if ($module and not($function)) then
            (
            ' > '
            ,
            {$module}
            )
        else if ($module and $function) then
            (
            ' > '
            ,
            {$module}
            ,
            ' > '
            ,
            {$function}
            )
        else
            ' > Home'
        }

};

(: Footer-like 'return to home' link :)
declare function local:return-to-main() as element() {

        Return to list of all modules

};

(: Business logic :)
declare function local:main() {
    (: Get URL parameters :)
    let $module := request:get-parameter('module', ())
    let $function := request:get-parameter('function', ())
    let $showlinks := request:get-parameter('showlinks', 1) cast as xs:boolean
    let $q := request:get-parameter('q', ())

    (: Catch a request for 'all', i.e. the complete listing :)
    let $viewall := $module eq 'all'

    (: Derive module URIs based on URL parameter $module :)
    let $allModuleURIs := /xq:xqdoc/xq:module/xq:uri
    let $matchingModuleURIs := if ($module) then
        if ($module = 'fn') then
            'http://www.w3.org/2005/xpath-functions'
        else
            $allModuleURIs[following-sibling::xq:name eq $module]
        else ()
    let $moduleURIs := if ($matchingModuleURIs) then $matchingModuleURIs else $allModuleURIs

    return
        (
        (: Show documentation for all modules:)
        if ($viewall) then
            (
            local:breadcrumbs($module, $function, $viewall)
            ,
            local:render-module($moduleURIs, (), $showlinks)
            ,
            local:return-to-main()
            )
        (: Show just the list of modules :)
        else if (not($module)) then
            (
            local:breadcrumbs($module, $function, $viewall)
            ,
            local:list-modules($moduleURIs)
            )
        (: Show a single module :)
        else if ($module and $matchingModuleURIs) then
            if (count($matchingModuleURIs) gt 1) then
                (: TODO: Add handling for resolving modules with the same 'name' :)
                (
                local:breadcrumbs($module, $function, $viewall)
                ,
                local:render-module($moduleURIs, $function, $showlinks)
                ,
                local:return-to-main()
                )
            else
                (
                local:breadcrumbs($module, $function, $viewall)
                ,
                local:render-module($moduleURIs, $function, $showlinks)
                ,
                local:return-to-main()
                )
        (: Handle cases where there are no exact matching modules :)
        else
            (: else if ($module and not($matchingModules)) :)
            (: TODO add a fuzzy search :)
            (
            local:breadcrumbs((), (), $viewall)
            ,

Sorry, there are no modules that match "{$module}."  Please choose from the list below:

            ,
            local:list-modules($moduleURIs)
            )
        )

};

(: Module body :)
<book>
    <bookinfo>
        <graphic fileref="logo.jpg"/>
        <productname>Open Source Native XML Database</productname>
        <title>eXist Function Modules</title>
        <link rel="shortcut icon" href="../resources/exist_icon_16x16.ico"/>
		<link rel="icon" href="../resources/exist_icon_16x16.png" type="image/png"/>

    </bookinfo>

        <xi:include xmlns:xi="http://www.w3.org/2001/XInclude" href="../sidebar.xml"/>

    <chapter>
        <title>A RESTful browser for eXist Function Modules</title>
        { local:main() }
    </chapter>
</book>


Changed XQTS mail address

Changed XQTS mail address

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

declare option exist:serialize "method=xml indent=yes";
declare option exist:output-size-limit "-1";
declare namespace response="http://exist-db.org/xquery/response";
declare namespace empty="";

let $product-version := util:system-property("product-version")
let $product-build := util:system-property("product-build")
let $test-suite := doc('/db/XQTS/XQTSCatalog.xml')/*:test-suite/@version
let $dummy := response:set-header("Content-Disposition", concat(
	"attachment; filename="results_XQTS-" , $test-suite , "_eXist-" ,
	$product-version , '_' , $product-build , ".xml"" ) )

let $cases := fn:collection(  '/db/XQTS' )//test-case
return
<test-suite-result xmlns="http://www.w3.org/2005/02/query-test-XQTSResult">
        <implementation name="eXist-{$product-version}" version="{$product-build}" anonymous-result-column="false">

                <organization name="eXist Open Source native XML database"  website="http://www.exist-db.org" anonymous="false"/>

                <submittor name="eXist XQTS testsuite runner" email="eXistAdmin@gmail.com"/>

                <description>

eXist is an Open Source native XML database featuring efficient,
                        index-based XQuery processing, automatic indexing, extensions for full-text
                        search,  XUpdate  support and tight integration with existing XML development tools.

                </description>

                <implementation-defined-items>

                </implementation-defined-items>

                <features>

                <feature name="Minimal Conformance" supported="true"/>
                <feature name="Schema Import" supported="false"/>
                <feature name="Schema Validation" supported="false"/>
                <feature name="Static Typing" supported="false"/>
                <feature name="Static Typing Extensions" supported="false"/>
                <feature name="Full Axis" supported="true"/>
                <feature name="Module" supported="true"/>
                <feature name="Serialization" supported="true"/>
                <feature name="Trivial XML Embedding" supported="false"/>
						  </features>

                <context-properties>

                </context-properties>

        </implementation>

        <syntax>XQuery</syntax>

        <test-run dateRun="{fn:current-dateTime()}">
                <test-suite version="{$test-suite}"/>
                <transformation>

No unusual transformations.

                </transformation>
                <comparison>

No unusual comparisons

                </comparison>
                <otherComments>

The test run took n seconds.

                </otherComments>
        </test-run>

{
		(: for $case in fn:collection(  '/db/XQTS' )//*:test-case :)
    for $case in $cases
    order by $case/@name
    return <test-case name="{$case/@name}" result="{$case/@result}" />
}
</test-suite-result>

declare option exist:serialize "method=xml indent=yes";
declare option exist:output-size-limit "-1";
declare namespace response="http://exist-db.org/xquery/response";
declare namespace empty="";

let $product-version := util:system-property("product-version")
let $product-build := util:system-property("product-build")
let $test-suite := doc('/db/XQTS/XQTSCatalog.xml')/*:test-suite/@version
let $dummy := response:set-header("Content-Disposition", concat(
	"attachment; filename="results_XQTS-" , $test-suite , "_eXist-" ,
	$product-version , '_' , $product-build , ".xml"" ) )

let $cases := fn:collection(  '/db/XQTS' )//test-case
return
<test-suite-result xmlns="http://www.w3.org/2005/02/query-test-XQTSResult">
        <implementation name="eXist-{$product-version}" version="{$product-build}" anonymous-result-column="false">

                <organization name="eXist Open Source native XML database"  website="http://www.exist-db.org" anonymous="false"/>

                <submittor name="eXist XQTS testsuite runner" email="xqts@exist-db.org"/>

                <description>

eXist is an Open Source native XML database featuring efficient,
                        index-based XQuery processing, automatic indexing, extensions for full-text
                        search,  XUpdate  support and tight integration with existing XML development tools.

                </description>

                <implementation-defined-items>

                </implementation-defined-items>

                <features>

                <feature name="Minimal Conformance" supported="true"/>
                <feature name="Schema Import" supported="false"/>
                <feature name="Schema Validation" supported="false"/>
                <feature name="Static Typing" supported="false"/>
                <feature name="Static Typing Extensions" supported="false"/>
                <feature name="Full Axis" supported="true"/>
                <feature name="Module" supported="true"/>
                <feature name="Serialization" supported="true"/>
                <feature name="Trivial XML Embedding" supported="false"/>
						  </features>

                <context-properties>

                </context-properties>

        </implementation>

        <syntax>XQuery</syntax>

        <test-run dateRun="{fn:current-dateTime()}">
                <test-suite version="{$test-suite}"/>
                <transformation>

No unusual transformations.

                </transformation>
                <comparison>

No unusual comparisons

                </comparison>
                <otherComments>

The test run took n seconds.

                </otherComments>
        </test-run>

{
		(: for $case in fn:collection(  '/db/XQTS' )//*:test-case :)
    for $case in $cases
    order by $case/@name
    return <test-case name="{$case/@name}" result="{$case/@result}" />
}
</test-suite-result>


Fixed lp:1123843.

Fixed lp:1123843.

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

(:~
 : Zorba FOTS driver evaluate
 : @author Sorin Nasoi
 :)

module namespace eval =
  "http://www.zorba-xquery.com/fots-driver/evaluate";

import schema namespace output =
  "http://www.w3.org/2010/xslt-xquery-serialization";

import module namespace xqxq =
  "http://www.zorba-xquery.com/modules/xqxq";
import module namespace schema =
  "http://www.zorba-xquery.com/modules/schema";

import module namespace fots-err =
  "http://www.zorba-xquery.com/fots-driver/errors" at "errors.xq";
import module namespace util =
  "http://www.zorba-xquery.com/fots-driver/util" at "util.xq";

declare namespace err =
  "http://www.w3.org/2005/xqt-errors";
declare namespace fots =
  "http://www.w3.org/2010/09/qt-fots-catalog";

declare namespace ann =
  "http://www.zorba-xquery.com/annotations";

(:~
 : Checks if the result matches the assertions.
 : @param $result actual result.
 : @param $expResult expected result.
 : @return the results of assertion evaluations.
 :)
declare %ann:sequential function eval:result(
  $result     as item()*,
  $expResult  as element()
) as element()*
{
  let $err := eval:check-assertion($result,
                                   $expResult,
                                   (),
                                   "")
  return if (empty($err))
  then ()
  else
    <fots:info>
      <fots:expected-result>{$expResult}</fots:expected-result>
      <fots:result>{$result}</fots:result>
      <fots:errors>{$err}</fots:errors>
    </fots:info>
};

(:~
 : Checks if the error found matches the expected error (if any).
 : @param $result actual result.
 : @param $expResult expected result.
 : @param $code err:code.
 : @param $errorDescription err:description.
 : @return the results of error evaluation.
 :)
declare %ann:sequential function eval:error(
  $result           as item()*,
  $expResult        as element(),
  $code             as xs:QName?,
  $errorDescription as xs:string?
) as element()*
{
  if (empty($result))
  then
    let $err := eval:error-code($code,
                                $errorDescription,
                                $expResult)
    return
      if (empty($err))
      then ()
      else
        <fots:info>
          <fots:expected-result>{$expResult}</fots:expected-result>
          <fots:result>{$result}</fots:result>
          <fots:errors>{$err}</fots:errors>
        </fots:info>
  else
    <fots:info>
      <fots:expected-result>{$expResult}</fots:expected-result>
      <fots:result>{$result}</fots:result>
      <fots:errors>{concat("Expected error [",
                           data($expResult/@code),
                           "], found result.")}</fots:errors>
    </fots:info>
};

declare %private %ann:sequential function eval:error-code(
  $code             as xs:QName?,
  $errorDescription as xs:string?,
  $expResult        as element()
) as xs:string*
{
  let $assertName := local-name($expResult)
  return
  if ( $assertName = "error")
  then
    if (exists($expResult[@code = "*"]) or
        exists($expResult[@code = local-name-from-QName($code)]))
    then ()
    else if (exists($code))
    then concat("Expected error: ",
                data($expResult/@code),
                ". Found error: ",
                local-name-from-QName($code))
    else concat("Expected error: ",
                data($expResult/@code),
                ". Found empty result.")
  else if (($assertName = "any-of") or ($assertName = "all-of"))
  then eval:check-assertion((),
                            $expResult,
                            $code,
                            $errorDescription)
  else concat("Expected result, found error ",
              local-name-from-QName($code),
              " - ",
              $errorDescription)
};

declare %private %ann:sequential function eval:check-assertion(
  $result           as item()*,
  $expResult        as element(),
  $code             as xs:QName?,
  $errorDescription as xs:string?
) as xs:string*
{
  let $test := local-name($expResult)
  return switch($test)
    case 'all-of'
      return eval:assert-all-of($result,
                                $expResult,
                                $code,
                                $errorDescription)
    case 'any-of'
      return eval:assert-any-of($result,
                                $expResult,
                                $code,
                                $errorDescription)
    case 'assert'
      return eval:assert($result,
                         $expResult)
    case 'assert-count'
      return eval:assert-count($result,
                               $expResult)
    case 'assert-deep-eq'
      return eval:assert-deep-eq($result,
                                 $expResult)
    case 'assert-empty'
      return eval:assert-empty($result)
    case 'assert-eq'
      return eval:assert-eq($result,
                            $expResult)
    case 'assert-false'
      return eval:assert-false($result)
    case 'assert-permutation'
      return eval:assert-permutation($result,
                                     $expResult)
    case 'assert-xml'
      return eval:assert-xml($result,
                             $expResult)
    case 'assert-serialization-error'
      return eval:assert-serialization-error($result,
                                             $expResult)
    case 'assert-string-value'
      return eval:assert-string-value($result,
                                      $expResult)
    case 'assert-true'
      return eval:assert-true($result)
    case 'assert-type'
      return eval:assert-type($result,
                              $expResult)
    case 'serialization-matches'
      return eval:serialization-matches($result,
                                        $expResult)
    case 'error'
      return eval:error($result,
                        $expResult,
                        $code,
                        $errorDescription)
    default
      return error($fots-err:errNA,
                   "
The requested assertion type is not implemented.")
};

(: http://dev.w3.org/2011/QT3-test-suite/catalog-schema.html#elem_any-of :)
declare %private %ann:sequential function eval:assert-any-of(
  $result           as item()*,
  $expResult        as element(),
  $code             as xs:QName?,
  $errorDescription as xs:string?
) as xs:string?
{
  let $results :=
    for $tmp in $expResult/*
    return <result>{
      for $r in eval:check-assertion($result,
                                     $tmp,
                                     $code,
                                     $errorDescription)
      return <item>{$r}</item>
    } </result>
  where every $result in $results satisfies $result/item
  return concat("'Assert-any-of' returned: ",
                string-join(util:serialize-result($results/data(item)), ' '))
};

(: http://dev.w3.org/2011/QT3-test-suite/catalog-schema.html#elem_all-of :)
declare %private %ann:sequential function eval:assert-all-of(
  $result           as item()*,
  $expResult        as element(),
  $code             as xs:QName?,
  $errorDescription as xs:string?
) as xs:string*
{
  for $tmp in $expResult/*
  return eval:check-assertion($result,
                              $tmp,
                              $code,
                              $errorDescription)
};

(: http://dev.w3.org/2011/QT3-test-suite/catalog-schema.html#elem_assert :)
declare %private %ann:sequential function eval:assert(
  $result    as item()*,
  $expResult as element()
) as xs:string?
{
  try {
  {
    variable $queryText := concat(
      "xquery version '3.0';",
      "declare namespace o = 'http://www.zorba-xquery.com/options/features';",
      "declare option o:enable 'hof';",
      "declare variable $result external; ",
      xs:string($expResult));
    variable $queryKey := xqxq:prepare-main-module($queryText),
             $queryKeyResult := xqxq:bind-variable($queryKey,
                                                  xs:QName('result'),
                                                  $result),
             $queryResult := xqxq:evaluate($queryKey);

   if ($queryResult)
   then ()
   else concat("Assertion ", $expResult, " failed.")
  }
  } catch * {
    concat("'assert' returned: fail with error ",
           $err:code, " : ", $err:description)
  }
};

(: http://dev.w3.org/2011/QT3-test-suite/catalog-schema.html#elem_assert-count :)
declare %private function eval:assert-count(
  $result    as item()*,
  $expResult as element()
) as xs:string?
{
  if (count($result) eq xs:integer($expResult))
  then ()
  else "'assert-count' returned: actual number of items is different than the expected number of items."
};

(: http://dev.w3.org/2011/QT3-test-suite/catalog-schema.html#elem_assert-deep-eq :)
declare %private %ann:sequential function eval:assert-deep-eq(
  $result    as item()*,
  $expResult as element()
) as xs:string?
{
  try {
  {
    variable $queryText := concat(
      "xquery version '3.0';",
      "declare namespace o = 'http://www.zorba-xquery.com/options/features';",
      "declare option o:enable 'hof';",
      "declare variable $x external;",
      "let $y := (",string(data($expResult)),") return ",
      "every $i in 1 to max((count($x),count($y))) satisfies deep-equal($x[$i],$y[$i])");
    variable $queryKey := xqxq:prepare-main-module($queryText),
             $queryKeyResult := xqxq:bind-variable($queryKey,
                                                   xs:QName('x'),
                                                   $result),
             $queryResult := xqxq:evaluate($queryKey);
    if ($queryResult)
    then ()
    else "'assert-deep-eq' returned: actual result is not deep-equal to expected result."
  }
  } catch * {
    concat("'assert-deep-eq' returned: fail with error ",
            $err:code, " : ", $err:description)
  }
};

(: http://dev.w3.org/2011/QT3-test-suite/catalog-schema.html#elem_assert-empty :)
declare %private function eval:assert-empty(
  $result    as item()*
) as xs:string?
{
  if (empty($result))
  then ()
  else "'assert-empty' returned: result is not empty as expected."
};

(: http://dev.w3.org/2011/QT3-test-suite/catalog-schema.html#elem_assert-eq :)
declare %private %ann:sequential function eval:assert-eq(
  $result    as item()*,
  $expResult as element()
) as xs:string?
{
  try {
  {
    variable $type := if (empty($result[1]) or (count($result) gt 1))
                      then ()
                      else
                        let $tmp := xs:string(schema:schema-type($result[1]))
(: add exception for the types defined in schemas available in the environment of the tests :)
                        return
                          if (starts-with($tmp, 'xs:'))
                          then $tmp
                          else ();
    variable  $queryText := concat(
      "declare variable $x external;",
      "$x eq ",
      if (starts-with(data($expResult), $type))
      then data($expResult)
      else concat($type,"(", data($expResult), ")"));
    variable  $queryKey := xqxq:prepare-main-module($queryText);

    xqxq:bind-variable($queryKey,
                      xs:QName('x'),
                      $result);
    variable $queryResult := xqxq:evaluate($queryKey);
    if ($queryResult)
    then ()
    else "'assert-eq' returned: result doesn't match expected result."
  }
  } catch * {
    concat("'assert-eq' returned: comparison failed with error ",
           $err:code, " : ", $err:description)
  }
};

(: http://dev.w3.org/2011/QT3-test-suite/catalog-schema.html#elem_assert-true :)
declare %private function eval:assert-true(
  $result as item()*
) as xs:string?
{
  if ($result eq fn:true())
  then ()
  else "'assert-true' returned: query doesn't evaluate to true."
};

(: http://dev.w3.org/2011/QT3-test-suite/catalog-schema.html#elem_assert-false :)
declare %private function eval:assert-false(
  $result as item()*
) as xs:string?
{
  if ($result eq fn:false())
  then ()
  else "'assert-false' returned: query doesn't evaluate to false."
};

(: http://dev.w3.org/2011/QT3-test-suite/catalog-schema.html#elem_assert-permutation :)
declare %private %ann:sequential function eval:assert-permutation(
  $result    as item()*,
  $expResult as element()
) as xs:string?
{
  try {
  {
    variable $queryText := concat(
      "declare variable $x external;",
      "declare function local:order-string-values($items){ for $item in $items order by xs:string($item) return $item};",
      "let $y := (",string(data($expResult)),") return ",
      "deep-equal(local:order-string-values($x), local:order-string-values($y)) or
       deep-equal(reverse($x), $y)");
    variable $queryKey := xqxq:prepare-main-module($queryText),
             $queryKeyResult := xqxq:bind-variable($queryKey,
                                                  xs:QName('x'),
                                                  $result),
             $queryResult := xqxq:evaluate($queryKey);
    if ($queryResult)
    then ()
    else "'assert-permutation' returned: result isn't a permutation of expected result."
  }
  } catch * {
    concat("'assert-permutation' returned: fail with error ",
            $err:code, " : ", $err:description)
  }
};

(: http://dev.w3.org/2011/QT3-test-suite/catalog-schema.html#elem_assert-xml :)
declare %private function eval:assert-xml(
  $result    as item()*,
  $expResult as element()
)
{
(:TODO call xml-canonicalization after bug #1076919 is implemented.:)
  try {
    let $serRes := util:serialize-result($result),
        $result1 as xs:string := string-join($serRes,''),
        $result2 as xs:string := string-join($serRes,' ')
    return
      if ((normalize-space($result1) eq normalize-space(string($expResult))) or
         (normalize-space($result2) eq normalize-space(string($expResult))))
      then ()
      else "'assert-xml' returned: result is different from the expected result."
  } catch * {
    concat("'assert-xml' returned: fail with error ",
            $err:code, " : ", $err:description)
  }
};

(: http://dev.w3.org/2011/QT3-test-suite/catalog-schema.html#elem_assert-serialization-error :)
declare %private %ann:sequential function eval:assert-serialization-error(
  $result    as item()*,
  $expResult as element()
) as xs:string?
{
  try {
  let $serializedResult as xs:string := string-join(
                                            util:serialize-result($result), '')
  return
   "'assert-serialization-error' returned: expected serialization error but got result."
  } catch * {
    eval:error((),
              $expResult,
              $err:code,
              $err:description)
  }
};

(: http://dev.w3.org/2011/QT3-test-suite/catalog-schema.html#elem_serialization-matches :)
declare %private function eval:serialization-matches(
  $result    as item()*,
  $expResult as element()
) as xs:string?
{
  try {
  let $serResult := string-join(util:serialize-result($result,
                                                      $util:serParamXml),
                                ''),
      $serExpResult := string-join(util:serialize-result(data($expResult),
                                                        $util:serParamXml),
                                  '')
  let $matchesFlags := data($expResult/@flags)
  return
    if (exists($matchesFlags))
    then
      if (matches($serResult, $serExpResult, $matchesFlags))
      then ()
      else concat("'serialization-matches' returned: result does not match expected result with flags '",
                  $matchesFlags,
                  "'.")
    else
      if (matches($serResult, $serExpResult))
      then ()
      else "'serialization-matches' returned: result does not match expected result."
  } catch * {
    concat("'serialization-matches' returned: fail with error ",
            $err:code, " : ", $err:description)
  }
};

(: http://dev.w3.org/2011/QT3-test-suite/catalog-schema.html#elem_assert-string-value :)
declare %private function eval:assert-string-value(
  $result    as item()*,
  $expResult as element()
) as xs:string?
{
  try {
    let $serRes := string-join(util:serialize-result($result), ' '),
        $res := if (empty($expResult[@normalize-space="true"]))
                then $serRes
                else normalize-space($serRes),
        $expRes :=  if (empty($expResult[@normalize-space="true"]))
                    then xs:string($expResult)
                    else normalize-space(xs:string($expResult))
    return
      if ($res eq $expRes)
      then ()
      else "'assert-string-value' returned: result different from expected result."
  } catch * {
    concat("'assert-string-value' returned: failed with error ",
           $err:code, " : ", $err:description)
  }
};

(: http://dev.w3.org/2011/QT3-test-suite/catalog-schema.html#elem_assert-type :)
declare %private %ann:sequential function eval:assert-type(
  $result    as item()*,
  $expResult as element()
) as xs:string?
{
  try {
  {
    variable $queryText := concat( "declare variable $x external; $x instance of ",
                                  data($expResult));
    variable $queryKey := xqxq:prepare-main-module($queryText),
             $queryKeyResult := xqxq:bind-variable($queryKey,
                                                  xs:QName('x'),
                                                  $result),
             $queryResult := xqxq:evaluate($queryKey);
    if ($queryResult)
    then ()
    else concat("'assert-type' returned: result doesn't have type '",
                data($expResult), "'")
  }
  } catch * {
    concat("'assert-type' returned: failed with error ",
           $err:code, " : ", $err:description)
  }
};

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

(:~
 : Zorba FOTS driver evaluate
 : @author Sorin Nasoi
 :)

module namespace eval =
  "http://www.zorba-xquery.com/fots-driver/evaluate";

import schema namespace output =
  "http://www.w3.org/2010/xslt-xquery-serialization";

import module namespace xqxq =
  "http://www.zorba-xquery.com/modules/xqxq";
import module namespace schema =
  "http://www.zorba-xquery.com/modules/schema";

import module namespace fots-err =
  "http://www.zorba-xquery.com/fots-driver/errors" at "errors.xq";
import module namespace util =
  "http://www.zorba-xquery.com/fots-driver/util" at "util.xq";

declare namespace err =
  "http://www.w3.org/2005/xqt-errors";
declare namespace fots =
  "http://www.w3.org/2010/09/qt-fots-catalog";

declare namespace ann =
  "http://www.zorba-xquery.com/annotations";

(:~
 : Checks if the result matches the assertions.
 : @param $result actual result.
 : @param $expResult expected result.
 : @return the results of assertion evaluations.
 :)
declare %ann:sequential function eval:result(
  $result     as item()*,
  $expResult  as element()
) as element()*
{
  let $err := eval:check-assertion($result,
                                   $expResult,
                                   (),
                                   "")
  return if (empty($err))
  then ()
  else
    <fots:info>
      <fots:expected-result>{$expResult}</fots:expected-result>
      <fots:result>{$result}</fots:result>
      <fots:errors>{$err}</fots:errors>
    </fots:info>
};

(:~
 : Checks if the error found matches the expected error (if any).
 : @param $result actual result.
 : @param $expResult expected result.
 : @param $code err:code.
 : @param $errorDescription err:description.
 : @return the results of error evaluation.
 :)
declare %ann:sequential function eval:error(
  $result           as item()*,
  $expResult        as element(),
  $code             as xs:QName?,
  $errorDescription as xs:string?
) as element()*
{
  if (empty($result))
  then
    let $err := eval:error-code($code,
                                $errorDescription,
                                $expResult)
    return
      if (empty($err))
      then ()
      else
        <fots:info>
          <fots:expected-result>{$expResult}</fots:expected-result>
          <fots:result>{$result}</fots:result>
          <fots:errors>{$err}</fots:errors>
        </fots:info>
  else
    <fots:info>
      <fots:expected-result>{$expResult}</fots:expected-result>
      <fots:result>{$result}</fots:result>
      <fots:errors>{concat("Expected error [",
                           data($expResult/@code),
                           "], found result.")}</fots:errors>
    </fots:info>
};

declare %private %ann:sequential function eval:error-code(
  $code             as xs:QName?,
  $errorDescription as xs:string?,
  $expResult        as element()
) as xs:string*
{
  let $assertName := local-name($expResult)
  return
  if ( $assertName = "error")
  then
    if (exists($expResult[@code = "*"]) or
        exists($expResult[@code = local-name-from-QName($code)]))
    then ()
    else if (exists($code))
    then concat("Expected error: ",
                data($expResult/@code),
                ". Found error: ",
                local-name-from-QName($code))
    else concat("Expected error: ",
                data($expResult/@code),
                ". Found empty result.")
  else if (($assertName = "any-of") or ($assertName = "all-of"))
  then eval:check-assertion((),
                            $expResult,
                            $code,
                            $errorDescription)
  else concat("Expected result, found error ",
              local-name-from-QName($code),
              " - ",
              $errorDescription)
};

declare %private %ann:sequential function eval:check-assertion(
  $result           as item()*,
  $expResult        as element(),
  $code             as xs:QName?,
  $errorDescription as xs:string?
) as xs:string*
{
  let $test := local-name($expResult)
  return switch($test)
    case 'all-of'
      return eval:assert-all-of($result,
                                $expResult,
                                $code,
                                $errorDescription)
    case 'any-of'
      return eval:assert-any-of($result,
                                $expResult,
                                $code,
                                $errorDescription)
    case 'assert'
      return eval:assert($result,
                         $expResult)
    case 'assert-count'
      return eval:assert-count($result,
                               $expResult)
    case 'assert-deep-eq'
      return eval:assert-deep-eq($result,
                                 $expResult)
    case 'assert-empty'
      return eval:assert-empty($result)
    case 'assert-eq'
      return eval:assert-eq($result,
                            $expResult)
    case 'assert-false'
      return eval:assert-false($result)
    case 'assert-permutation'
      return eval:assert-permutation($result,
                                     $expResult)
    case 'assert-xml'
      return eval:assert-xml($result,
                             $expResult)
    case 'assert-serialization-error'
      return eval:assert-serialization-error($result,
                                             $expResult)
    case 'assert-string-value'
      return eval:assert-string-value($result,
                                      $expResult)
    case 'assert-true'
      return eval:assert-true($result)
    case 'assert-type'
      return eval:assert-type($result,
                              $expResult)
    case 'serialization-matches'
      return eval:serialization-matches($result,
                                        $expResult)
    case 'error'
      return eval:error($result,
                        $expResult,
                        $code,
                        $errorDescription)
    default
      return error($fots-err:errNA,
                   "
The requested assertion type is not implemented.")
};

(: http://dev.w3.org/2011/QT3-test-suite/catalog-schema.html#elem_any-of :)
declare %private %ann:sequential function eval:assert-any-of(
  $result           as item()*,
  $expResult        as element(),
  $code             as xs:QName?,
  $errorDescription as xs:string?
) as xs:string?
{
  let $results :=
    for $tmp in $expResult/*
    return <result>{
      for $r in eval:check-assertion($result,
                                     $tmp,
                                     $code,
                                     $errorDescription)
      return <item>{$r}</item>
    } </result>
  where every $result in $results satisfies $result/item
  return concat("'Assert-any-of' returned: ",
                string-join(util:serialize-result($results/data(item)), ' '))
};

(: http://dev.w3.org/2011/QT3-test-suite/catalog-schema.html#elem_all-of :)
declare %private %ann:sequential function eval:assert-all-of(
  $result           as item()*,
  $expResult        as element(),
  $code             as xs:QName?,
  $errorDescription as xs:string?
) as xs:string*
{
  for $tmp in $expResult/*
  return eval:check-assertion($result,
                              $tmp,
                              $code,
                              $errorDescription)
};

(: http://dev.w3.org/2011/QT3-test-suite/catalog-schema.html#elem_assert :)
declare %private %ann:sequential function eval:assert(
  $result    as item()*,
  $expResult as element()
) as xs:string?
{
  try {
  {
    variable $queryText := concat(
      "xquery version '3.0';",
      "declare namespace o = 'http://www.zorba-xquery.com/options/features';",
      "declare option o:enable 'hof';",
      "declare variable $result external; ",
      xs:string($expResult));
    variable $queryKey := xqxq:prepare-main-module($queryText),
             $queryKeyResult := xqxq:bind-variable($queryKey,
                                                  xs:QName('result'),
                                                  $result),
             $queryResult := xqxq:evaluate($queryKey);

   if ($queryResult)
   then ()
   else concat("Assertion ", $expResult, " failed.")
  }
  } catch * {
    concat("'assert' returned: fail with error ",
           $err:code, " : ", $err:description)
  }
};

(: http://dev.w3.org/2011/QT3-test-suite/catalog-schema.html#elem_assert-count :)
declare %private function eval:assert-count(
  $result    as item()*,
  $expResult as element()
) as xs:string?
{
  if (count($result) eq xs:integer($expResult))
  then ()
  else "'assert-count' returned: actual number of items is different than the expected number of items."
};

(: http://dev.w3.org/2011/QT3-test-suite/catalog-schema.html#elem_assert-deep-eq :)
declare %private %ann:sequential function eval:assert-deep-eq(
  $result    as item()*,
  $expResult as element()
) as xs:string?
{
  try {
  {
    variable $queryText := concat(
      "xquery version '3.0';",
      "declare namespace o = 'http://www.zorba-xquery.com/options/features';",
      "declare option o:enable 'hof';",
      "declare variable $x external;",
      "let $y := (",string(data($expResult)),") return ",
      "every $i in 1 to max((count($x),count($y))) satisfies deep-equal($x[$i],$y[$i])");
    variable $queryKey := xqxq:prepare-main-module($queryText),
             $queryKeyResult := xqxq:bind-variable($queryKey,
                                                   xs:QName('x'),
                                                   $result),
             $queryResult := xqxq:evaluate($queryKey);
    if ($queryResult)
    then ()
    else "'assert-deep-eq' returned: actual result is not deep-equal to expected result."
  }
  } catch * {
    concat("'assert-deep-eq' returned: fail with error ",
            $err:code, " : ", $err:description)
  }
};

(: http://dev.w3.org/2011/QT3-test-suite/catalog-schema.html#elem_assert-empty :)
declare %private function eval:assert-empty(
  $result    as item()*
) as xs:string?
{
  if (empty($result))
  then ()
  else "'assert-empty' returned: result is not empty as expected."
};

(: http://dev.w3.org/2011/QT3-test-suite/catalog-schema.html#elem_assert-eq :)
declare %private %ann:sequential function eval:assert-eq(
  $result    as item()*,
  $expResult as element()
) as xs:string?
{
  try {
  {
    variable $type := if (empty($result[1]) or (count($result) gt 1))
                      then ()
                      else
                        let $tmp := xs:string(schema:schema-type($result[1]))
(: add exception for the types defined in schemas available in the environment of the tests :)
                        return
                          if (starts-with($tmp, 'xs:'))
                          then $tmp
                          else ();
    variable  $queryText := concat(
      "declare variable $x external;",
      "$x eq ",
      if (starts-with(data($expResult), $type))
      then data($expResult)
      else concat($type,"(", data($expResult), ")"));
    variable  $queryKey := xqxq:prepare-main-module($queryText);

    xqxq:bind-variable($queryKey,
                      xs:QName('x'),
                      $result);
    variable $queryResult := xqxq:evaluate($queryKey);
    if ($queryResult)
    then ()
    else "'assert-eq' returned: result doesn't match expected result."
  }
  } catch * {
    concat("'assert-eq' returned: comparison failed with error ",
           $err:code, " : ", $err:description)
  }
};

(: http://dev.w3.org/2011/QT3-test-suite/catalog-schema.html#elem_assert-true :)
declare %private function eval:assert-true(
  $result as item()*
) as xs:string?
{
  if ($result eq fn:true())
  then ()
  else "'assert-true' returned: query doesn't evaluate to true."
};

(: http://dev.w3.org/2011/QT3-test-suite/catalog-schema.html#elem_assert-false :)
declare %private function eval:assert-false(
  $result as item()*
) as xs:string?
{
  if ($result eq fn:false())
  then ()
  else "'assert-false' returned: query doesn't evaluate to false."
};

(: http://dev.w3.org/2011/QT3-test-suite/catalog-schema.html#elem_assert-permutation :)
declare %private %ann:sequential function eval:assert-permutation(
  $result    as item()*,
  $expResult as element()
) as xs:string?
{
  try {
  {
    variable $queryText := concat(
      "xquery version '3.0';",
      "declare namespace o = 'http://www.zorba-xquery.com/options/features';",
      "declare option o:enable 'hof';",
      "declare variable $x external;",
      "let $y := (",string(data($expResult)),") return ",
      (: if count(intersection(M1,M2)) = count(union(M1,M2)) = count(M1) then the sequences are identical :)
      "(count(distinct-values($x[ . = $y])) = count(distinct-values(($x, $y)))) = count(distinct-values($x))");
    variable $queryKey := xqxq:prepare-main-module($queryText),
             $queryKeyResult := xqxq:bind-variable($queryKey,
                                                  xs:QName('x'),
                                                  $result),
             $queryResult := xqxq:evaluate($queryKey);
    if ($queryResult)
    then ()
    else "'assert-permutation' returned: result isn't a permutation of expected result."
  }
  } catch * {
    concat("'assert-permutation' returned: fail with error ",
            $err:code, " : ", $err:description)
  }
};

(: http://dev.w3.org/2011/QT3-test-suite/catalog-schema.html#elem_assert-xml :)
declare %private function eval:assert-xml(
  $result    as item()*,
  $expResult as element()
)
{
(:TODO call xml-canonicalization after bug #1076919 is implemented.:)
  try {
    let $serRes := util:serialize-result($result),
        $result1 as xs:string := string-join($serRes,''),
        $result2 as xs:string := string-join($serRes,' ')
    return
      if ((normalize-space($result1) eq normalize-space(string($expResult))) or
         (normalize-space($result2) eq normalize-space(string($expResult))))
      then ()
      else "'assert-xml' returned: result is different from the expected result."
  } catch * {
    concat("'assert-xml' returned: fail with error ",
            $err:code, " : ", $err:description)
  }
};

(: http://dev.w3.org/2011/QT3-test-suite/catalog-schema.html#elem_assert-serialization-error :)
declare %private %ann:sequential function eval:assert-serialization-error(
  $result    as item()*,
  $expResult as element()
) as xs:string?
{
  try {
  let $serializedResult as xs:string := string-join(
                                            util:serialize-result($result), '')
  return
   "'assert-serialization-error' returned: expected serialization error but got result."
  } catch * {
    eval:error((),
              $expResult,
              $err:code,
              $err:description)
  }
};

(: http://dev.w3.org/2011/QT3-test-suite/catalog-schema.html#elem_serialization-matches :)
declare %private function eval:serialization-matches(
  $result    as item()*,
  $expResult as element()
) as xs:string?
{
  try {
  let $serResult := string-join(util:serialize-result($result,
                                                      $util:serParamXml),
                                ''),
      $serExpResult := string-join(util:serialize-result(data($expResult),
                                                        $util:serParamXml),
                                  '')
  let $matchesFlags := data($expResult/@flags)
  return
    if (exists($matchesFlags))
    then
      if (matches($serResult, $serExpResult, $matchesFlags))
      then ()
      else concat("'serialization-matches' returned: result does not match expected result with flags '",
                  $matchesFlags,
                  "'.")
    else
      if (matches($serResult, $serExpResult))
      then ()
      else "'serialization-matches' returned: result does not match expected result."
  } catch * {
    concat("'serialization-matches' returned: fail with error ",
            $err:code, " : ", $err:description)
  }
};

(: http://dev.w3.org/2011/QT3-test-suite/catalog-schema.html#elem_assert-string-value :)
declare %private function eval:assert-string-value(
  $result    as item()*,
  $expResult as element()
) as xs:string?
{
  try {
    let $serRes := string-join(util:serialize-result($result), ' '),
        $res := if (empty($expResult[@normalize-space="true"]))
                then $serRes
                else normalize-space($serRes),
        $expRes :=  if (empty($expResult[@normalize-space="true"]))
                    then xs:string($expResult)
                    else normalize-space(xs:string($expResult))
    return
      if ($res eq $expRes)
      then ()
      else "'assert-string-value' returned: result different from expected result."
  } catch * {
    concat("'assert-string-value' returned: failed with error ",
           $err:code, " : ", $err:description)
  }
};

(: http://dev.w3.org/2011/QT3-test-suite/catalog-schema.html#elem_assert-type :)
declare %private %ann:sequential function eval:assert-type(
  $result    as item()*,
  $expResult as element()
) as xs:string?
{
  try {
  {
    variable $queryText := concat( "declare variable $x external; $x instance of ",
                                  data($expResult));
    variable $queryKey := xqxq:prepare-main-module($queryText),
             $queryKeyResult := xqxq:bind-variable($queryKey,
                                                  xs:QName('x'),
                                                  $result),
             $queryResult := xqxq:evaluate($queryKey);
    if ($queryResult)
    then ()
    else concat("'assert-type' returned: result doesn't have type '",
                data($expResult), "'")
  }
  } catch * {
    concat("'assert-type' returned: failed with error ",
           $err:code, " : ", $err:description)
  }
};


fixed issue with request params at {}/careServicesReqUEST/{}

module namespace page = 'http://basex.org/modules/web-page';

import module namespace csr_proc = "https://github.com/openhie/openinfoman/csr_proc";
import module namespace csd_dm = "https://github.com/openhie/openinfoman/csd_dm";
import module namespace csd_webconf =  "https://github.com/openhie/openinfoman/csd_webconf";

declare   namespace   csd = "urn:ihe:iti:csd:2013";
declare default element  namespace   "urn:ihe:iti:csd:2013";

declare variable $page:csd_docs := csd_dm:registered_documents($csd_webconf:db);

declare
  %rest:path("/CSD/csr/{$name}/careServicesRequest")
  %rest:POST("{$careServicesRequest}")
  function page:csr($name,$careServicesRequest)
{
if (csd_dm:document_source_exists($csd_webconf:db,$name)) then
 csr_proc:process_CSR($csd_webconf:db,$careServicesRequest/careServicesRequest,$name,$csd_webconf:baseurl)
else
  (:need appropriate error handling:)
  ()

};

declare
  %rest:path("/CSD/csr/{$name}/careServicesRequest/{$search}")
  %rest:consumes("application/xml", "text/xml", "multipart/form-data")
  %rest:POST("{$requestParams}")
  function page:csr2($name,$requestParams,$search)
{
let $careServicesRequest :=
  <csd:careServicesRequest>
    <csd:function urn="{$search}">{$requestParams}</csd:function>
  </csd:careServicesRequest>
return
  if (csd_dm:document_source_exists($csd_webconf:db,$name)) then
    csr_proc:process_CSR($csd_webconf:db,$careServicesRequest,$name,$csd_webconf:baseurl)
  else
    (:need appropriate error handling:)
  ()

};

declare updating
  %rest:path("/CSD/csr/{$name}/careServicesRequest/update")
  %rest:consumes("application/xml", "text/xml", "multipart/form-data")
  %rest:POST("{$careServicesRequest}")
  function page:csr_updating($name,$careServicesRequest)
{
  if (csd_dm:document_source_exists($csd_webconf:db,$name)) then
    csr_proc:process_updating_CSR($csd_webconf:db,$careServicesRequest/careServicesRequest,$name,$csd_webconf:baseurl)
  else
    (:need appropriate error handling:)
    ()
};

declare updating
  %rest:path("/CSD/csr/{$name}/careServicesRequest/update/{$search}")
  %rest:consumes("application/xml", "text/xml", "multipart/form-data")
  %rest:POST("{$requestParams}")
  function page:csr_updating($name,$requestParams,$search)
{
let $careServicesRequest :=
  <csd:careServicesRequest>
    <csd:function urn="{$search}">{$requestParams}</csd:function>
  </csd:careServicesRequest>
return
if (csd_dm:document_source_exists($csd_webconf:db,$name)) then
 csr_proc:process_updating_CSR($csd_webconf:db,$careServicesRequest/careServicesRequest,$name,$csd_webconf:baseurl)
else
  (:need appropriate error handling:)
  ()

};

declare
  %rest:path("/CSD/csr/{$name}/adhoc")
  %rest:consumes("application/xml", "text/xml", "multipart/form-data")
  %rest:POST
  %rest:form-param("adhoc","{$adhoc}")
  %rest:form-param("content", "{$content}","application/xml")
function page:adhoc($name,$adhoc,$content) {
if (csd_dm:document_source_exists($csd_webconf:db,$name)) then
let  $adhoc_doc := csr_proc:create_adhoc_doc(string($adhoc),$content)
  return  csr_proc:process_CSR($csd_webconf:db, $adhoc_doc,$name,$csd_webconf:baseurl)
else
  (:need appropriate error handling:)
  ()

};

declare
  %rest:path("/CSD/csr")
  %rest:GET
  %output:method("xhtml")
  function page:csr_list()
{
let $response := page:endpoints()
return csd_webconf:wrapper($response)
};

declare function page:endpoints() {

Care Services Request - Endpoints

      {
	for $name in $page:csd_docs
	return

	  Submit Care Services Request for {$name} at:

{$csd_webconf:baseurl}CSD/csr/{$name}/careServicesRequest

	  Submit ad-hoc query:
	  <form method='post' action="/CSD/csr/{$name}/adhoc"  enctype="multipart/form-data">
	    Ad-Hoc Query<textarea  rows="10" cols="80" name="adhoc" >{$page:sample}</textarea>

	    Content Type<input    cols="80" name="content" value="text/html"/>

	    <input type="submit" value="submit"/>
	  </form>

      }

};

declare variable $page:sample :=
"declare namespace csd = 'urn:ihe:iti:csd:2013';

You have {count(/csd:CSD/csd:providerDirectory/*)} providers.

You have {count(/csd:CSD/csd:facilityDirectory/*)} facilities.

You have {count(/csd:CSD/csd:organizationDirectory/*)} organizations.

You have {count(/csd:CSD/csd:serviceDirectory/*)} services.

";

module namespace page = 'http://basex.org/modules/web-page';

import module namespace csr_proc = "https://github.com/openhie/openinfoman/csr_proc";
import module namespace csd_dm = "https://github.com/openhie/openinfoman/csd_dm";
import module namespace csd_webconf =  "https://github.com/openhie/openinfoman/csd_webconf";

declare   namespace   csd = "urn:ihe:iti:csd:2013";
declare default element  namespace   "urn:ihe:iti:csd:2013";

declare variable $page:csd_docs := csd_dm:registered_documents($csd_webconf:db);

declare
  %rest:path("/CSD/csr/{$name}/careServicesRequest")
  %rest:POST("{$careServicesRequest}")
  function page:csr($name,$careServicesRequest)
{
if (csd_dm:document_source_exists($csd_webconf:db,$name)) then
 csr_proc:process_CSR($csd_webconf:db,$careServicesRequest/careServicesRequest,$name,$csd_webconf:baseurl)
else
  (:need appropriate error handling:)
  ()

};

declare
  %rest:path("/CSD/csr/{$name}/careServicesRequest/{$search}")
  %rest:consumes("application/xml", "text/xml", "multipart/form-data")
  %rest:POST("{$requestParams}")
  function page:csr2($name,$requestParams,$search)
{
let $careServicesRequest :=
  <csd:careServicesRequest>
    <csd:function urn="{$search}"><requestParams>{$requestParams}</requestParams></csd:function>
  </csd:careServicesRequest>
return
  if (csd_dm:document_source_exists($csd_webconf:db,$name)) then
    csr_proc:process_CSR($csd_webconf:db,$careServicesRequest,$name,$csd_webconf:baseurl)
  else
    (:need appropriate error handling:)
  ()

};

declare updating
  %rest:path("/CSD/csr/{$name}/careServicesRequest/update")
  %rest:consumes("application/xml", "text/xml", "multipart/form-data")
  %rest:POST("{$careServicesRequest}")
  function page:csr_updating($name,$careServicesRequest)
{
  if (csd_dm:document_source_exists($csd_webconf:db,$name)) then
    csr_proc:process_updating_CSR($csd_webconf:db,$careServicesRequest/careServicesRequest,$name,$csd_webconf:baseurl)
  else
    (:need appropriate error handling:)
    ()
};

declare updating
  %rest:path("/CSD/csr/{$name}/careServicesRequest/update/{$search}")
  %rest:consumes("application/xml", "text/xml", "multipart/form-data")
  %rest:POST("{$requestParams}")
  function page:csr_updating($name,$requestParams,$search)
{
let $careServicesRequest :=
  <csd:careServicesRequest>
    <csd:function urn="{$search}"><requestParams>{$requestParams}</requestParams></csd:function>
  </csd:careServicesRequest>
return
if (csd_dm:document_source_exists($csd_webconf:db,$name)) then
 csr_proc:process_updating_CSR($csd_webconf:db,$careServicesRequest/careServicesRequest,$name,$csd_webconf:baseurl)
else
  (:need appropriate error handling:)
  ()

};

declare
  %rest:path("/CSD/csr/{$name}/adhoc")
  %rest:consumes("application/xml", "text/xml", "multipart/form-data")
  %rest:POST
  %rest:form-param("adhoc","{$adhoc}")
  %rest:form-param("content", "{$content}","application/xml")
function page:adhoc($name,$adhoc,$content) {
if (csd_dm:document_source_exists($csd_webconf:db,$name)) then
let  $adhoc_doc := csr_proc:create_adhoc_doc(string($adhoc),$content)
  return  csr_proc:process_CSR($csd_webconf:db, $adhoc_doc,$name,$csd_webconf:baseurl)
else
  (:need appropriate error handling:)
  ()

};

declare
  %rest:path("/CSD/csr")
  %rest:GET
  %output:method("xhtml")
  function page:csr_list()
{
let $response := page:endpoints()
return csd_webconf:wrapper($response)
};

declare function page:endpoints() {

Care Services Request - Endpoints

      {
	for $name in $page:csd_docs
	return

	  Submit Care Services Request for {$name} at:

{$csd_webconf:baseurl}CSD/csr/{$name}/careServicesRequest

	  Submit ad-hoc query:
	  <form method='post' action="/CSD/csr/{$name}/adhoc"  enctype="multipart/form-data">
	    Ad-Hoc Query<textarea  rows="10" cols="80" name="adhoc" >{$page:sample}</textarea>

	    Content Type<input    cols="80" name="content" value="text/html"/>

	    <input type="submit" value="submit"/>
	  </form>

      }

};

declare variable $page:sample :=
"declare namespace csd = 'urn:ihe:iti:csd:2013';

You have {count(/csd:CSD/csd:providerDirectory/*)} providers.

You have {count(/csd:CSD/csd:facilityDirectory/*)} facilities.

You have {count(/csd:CSD/csd:organizationDirectory/*)} organizations.

You have {count(/csd:CSD/csd:serviceDirectory/*)} services.

";


webui API updates

webui API updates

module namespace page = 'http://basex.org/modules/web-page';

(:Import other namespaces.  :)
import module namespace csd_webconf =  "https://github.com/openhie/openinfoman/csd_webconf";
import module namespace csd_webui =  "https://github.com/openhie/openinfoman/csd_webui";
import module namespace csr_proc = "https://github.com/openhie/openinfoman/csr_proc";
import module namespace csd_dm = "https://github.com/openhie/openinfoman/csd_dm";

declare namespace csd = "urn:ihe:iti:csd:2013";

declare function page:is_whomds($search_name) {
  let $function := csr_proc:get_function_definition($csd_webconf:db,$search_name)
  let $ext := $function//csd:extension[  @urn='urn:openhie.org:openinfoman:adapter' and @type='whomds']
  return (count($ext) > 0)
};

declare function page:get_actions($search_name) {
  let $function := csr_proc:get_function_definition($csd_webconf:db,$search_name)
  return
    (
    for $act in $function//csd:extension[  @urn='urn:openhie.org:openinfoman:adapter:whomds:action']/@type
    return string($act)
  )
};

declare
  %rest:path("/CSD/csr/{$doc_name}/careServicesRequest/{$search_name}/adapter/whomds")
  %output:method("xhtml")
  function page:show_endpoints($search_name,$doc_name)
{
    if (not(page:is_whomds($search_name)) )
      then ('Not a WHO MDS Compatible stored function'    )
    else
      let $actions := page:get_actions($search_name)
      let $contents :=

WHO MDS Operations on {$doc_name}

        {
          if ($actions = 'completeness')
	  then

Completeness Report

	     {
	       let $url := concat(csd_webui:generateURL( "CSD/csr/" , $doc_name , "/careServicesRequest/",$search_name, "/adapter/whomds/completeness"))
	       return
Get the  Completness Report

	     }

	  else ()
	}

      return csd_webui:wrapper($contents)
};

declare
  %rest:path("/CSD/csr/{$doc_name}/careServicesRequest/{$search_name}/adapter/whomds/completeness")
  function page:completness($search_name,$doc_name)
{
  if (not(page:is_whomds($search_name)) )
    then ('Not a WHO MDS Compatible stored function'    )
  else
    let $doc :=  csd_dm:open_document($csd_webconf:db,$doc_name)
    let $function := csr_proc:get_function_definition($csd_webconf:db,$search_name)

    let $careServicesRequest :=
      <csd:careServicesRequest>
       <csd:function urn="{$search_name}" resource="{$doc_name}" base_url="{csd_webui:generateURL()}">
         <csd:requestParams/>
       </csd:function>
      </csd:careServicesRequest>
    let $stats := csr_proc:process_CSR_stored_results($csd_webconf:db, $doc,$careServicesRequest)
    let $output := $function/@content-type
    let $mime :=
      if (exists($output))
      then string($output)
      else "text/html"
    let $content :=
      if (not($output = 'text/html'))
      then $stats
      else
        csd_webui:wrapper(

WHO MDS Completeness Report For {$doc_name}

	    {$stats}

	)
    return
    (
      <rest:response>
	<http:response status="200" >
          <http:header name='Content-Type' value="{$mime}"/>
	</http:response>
      </rest:response>
      ,$content
    )

};

module namespace page = 'http://basex.org/modules/web-page';

(:Import other namespaces.  :)
import module namespace csd_webconf =  "https://github.com/openhie/openinfoman/csd_webconf";
import module namespace csr_proc = "https://github.com/openhie/openinfoman/csr_proc";
import module namespace csd_dm = "https://github.com/openhie/openinfoman/csd_dm";

declare namespace csd = "urn:ihe:iti:csd:2013";

declare function page:is_whomds($search_name) {
  let $function := csr_proc:get_function_definition($csd_webconf:db,$search_name)
  let $ext := $function//csd:extension[  @urn='urn:openhie.org:openinfoman:adapter' and @type='whomds']
  return (count($ext) > 0)
};

declare function page:get_actions($search_name) {
  let $function := csr_proc:get_function_definition($csd_webconf:db,$search_name)
  return
    (
    for $act in $function//csd:extension[  @urn='urn:openhie.org:openinfoman:adapter:whomds:action']/@type
    return string($act)
  )
};

declare
  %rest:path("/CSD/csr/{$doc_name}/careServicesRequest/{$search_name}/adapter/whomds")
  %output:method("xhtml")
  function page:show_endpoints($search_name,$doc_name)
{
    if (not(page:is_whomds($search_name)) )
      then ('Not a WHO MDS Compatible stored function'    )
    else
      let $actions := page:get_actions($search_name)
      let $contents :=

WHO MDS Operations on {$doc_name}

        {
          if ($actions = 'completeness')
	  then

Completeness Report

	     {
	       let $url := concat($csd_webconf:baseurl, "CSD/csr/" , $doc_name , "/careServicesRequest/",$search_name, "/adapter/whomds/completeness")
	       return
Get the  Completness Report

	     }

	  else ()
	}

      return csd_webconf:wrapper($contents)
};

declare
  %rest:path("/CSD/csr/{$doc_name}/careServicesRequest/{$search_name}/adapter/whomds/completeness")
  function page:completness($search_name,$doc_name)
{
  if (not(page:is_whomds($search_name)) )
    then ('Not a WHO MDS Compatible stored function'    )
  else
    let $doc :=  csd_dm:open_document($csd_webconf:db,$doc_name)
    let $function := csr_proc:get_function_definition($csd_webconf:db,$search_name)

    let $careServicesRequest :=
      <csd:careServicesRequest>
       <csd:function urn="{$search_name}" resource="{$doc_name}" base_url="{$csd_webconf:baseurl}">
         <csd:requestParams/>
       </csd:function>
      </csd:careServicesRequest>
    let $stats := csr_proc:process_CSR_stored_results($csd_webconf:db, $doc,$careServicesRequest)
    let $output := $function/@content-type
    let $mime :=
      if (exists($output))
      then string($output)
      else "text/html"
    let $content :=
      if (not($output = 'text/html'))
      then $stats
      else
        csd_webconf:wrapper(

WHO MDS Completeness Report For {$doc_name}

	    {$stats}

	)
    return
    (
      <rest:response>
	<http:response status="200" >
          <http:header name='Content-Type' value="{$mime}"/>
	</http:response>
      </rest:response>
      ,$content
    )

};


fixed submission of multi-part SOAP requests

(:~
: This is the Care Services Discovery stored query registry
: @version 1.0
: @see https://github.com/his-interop/openinfoman
:
:)
module namespace csd_psd = "https://github.com/his-interop/openinfoman/csd_psd";
import module namespace csd_qus =  "https://github.com/his-interop/openinfoman/csd_qus" at "csd_query_updated_services.xqm";
declare namespace http = "http://expath.org/ns/http-client" ;
declare namespace soap = "http://www.w3.org/2003/05/soap-envelope";
declare namespace csd = "urn:ihe:iti:csd:2013";

declare variable $csd_psd:services_library :=
<serviceDirectoryLibrary>
   <serviceDirectory
        name='rhea_simple_provider'
        url='http://rhea-pr.ihris.org/providerregistry/getUpdatedServices'
	/>
</serviceDirectoryLibrary>
;

declare function csd_psd:get_services() {
  $csd_psd:services_library//serviceDirectory/text{@name}
};

declare function csd_psd:get_service_directory_url($name) {
 text{ $csd_psd:services_library//serviceDirectory[@name=$name]/@url}
};

declare function csd_psd:poll_service_directory($name,$mtime)
{
  let $soap := csd_psd:poll_service_directory_soap_response($name,$mtime)
  return  if ($soap) then
     $soap/soap:Envelope/soap:Body/csd:getModificationsResponse/csd:CSD
  else
    ()
};

declare function csd_psd:poll_service_directory_soap_response($name,$mtime)
{
  let $url := csd_psd:get_service_directory_url($name)
  let $boundary := concat("----------------", random:uuid())
  let $request := <http:request
      href='{$url}'
      method='post' >
      <http:multipart media-type='multipart/form-data' boundary="{$boundary}">
	<http:header name="Content-Disposition" value='form-data; name="file"; filename="soap.xml"'/>
	<http:header name="Content-Type" value="application/xml; charset=utf-8"/>
        <http:body  media-type='application/xml; charset=utf-8' method='xml'>
 	 {csd_qus:create_last_update_request($mtime)}
        </http:body>
      </http:multipart>
    </http:request>
  let $response := http:send-request($request)
  let $status := text{$response[1]/@status}
  return if ($status = "200")
  then
    $response[2]
  else
    ()

};

(:~
: This is the Care Services Discovery stored query registry
: @version 1.0
: @see https://github.com/his-interop/openinfoman
:
:)
module namespace csd_psd = "https://github.com/his-interop/openinfoman/csd_psd";
import module namespace csd_qus =  "https://github.com/his-interop/openinfoman/csd_qus" at "csd_query_updated_services.xqm";
declare namespace http = "http://expath.org/ns/http-client" ;
declare namespace soap = "http://www.w3.org/2003/05/soap-envelope";
declare namespace csd = "urn:ihe:iti:csd:2013";

declare variable $csd_psd:services_library :=
<serviceDirectoryLibrary>
   <serviceDirectory
        name='rhea_simple_provider'
        url='http://rhea-pr.ihris.org/providerregistry/getUpdatedServices'
	/>
</serviceDirectoryLibrary>
;

declare function csd_psd:get_services() {
  $csd_psd:services_library//serviceDirectory/text{@name}
};

declare function csd_psd:get_service_directory_url($name) {
 text{ $csd_psd:services_library//serviceDirectory[@name=$name]/@url}
};

declare function csd_psd:poll_service_directory($name,$mtime)
{
  let $soap := csd_psd:poll_service_directory_soap_response($name,$mtime)
  return  if ($soap) then
     $soap/soap:Envelope/soap:Body/csd:getModificationsResponse/csd:CSD
  else
    ()
};

declare function csd_psd:poll_service_directory_soap_response($name,$mtime)
{
  let $url := csd_psd:get_service_directory_url($name)
  let $request := <http:request
      href='{$url}'
      mime-type="multipart/form-data"
      method='post' >
      <http:body media-type='application/xml; charset=utf-8'>
	{csd_qus:create_last_update_request($mtime)}
      </http:body>
    </http:request>
  let $response := http:send-request($request)
  let $status := text{$response[1]/@status}
  return if ($status = "200")
  then
    $response[2]
  else
    ()

};


Displays definition of concepts in the search window

xquery version "1.0";
(: ~
: Module Name:             Reference URI search popup
:
: Module Version           1.0
:
: Date                     08 Jul 2008
:
: Copyright                The cagrid consortium
:
: Module overview          Finds a reference uri for an administered item
:
:)

(:~
:    @author Andrew Tsui
:    @version 1.0
~ :)
declare namespace request="http://exist-db.org/xquery/request";
declare namespace session="http://exist-db.org/xquery/session";
declare namespace rs="http://cagrid.org/schema/result-set";

import module namespace
      lib-qs="http://www.cagrid.org/xquery/library/query_service"
      at "../connector/m-lib-qs.xquery";

declare function local:action-button($value as xs:string, $control as xs:string, $text as xs:string, $name as xs:string) as node()
{
   element input {
      attribute class {"cgButton"},
      attribute type {"submit"},
      attribute name {"update"},
      attribute value {$text},
      attribute onclick {
      concat("window.opener.document.getElementById('",$control,"').value='",$value,"';",
            "window.opener.document.getElementById('", $control, "-div').innerHTML='",$name,"';",
            "self.close();")}
      }

};

declare option exist:serialize "media-type=text/html";

session:create(),
let $resource as xs:string := xs:string(request:get-parameter("resource", "EVS-DescLogicConcept"))
let $element as xs:string := xs:string(request:get-parameter("element", ""))
let $form-name as xs:string := xs:string(request:get-parameter("form-name", ""))
let $phrase as xs:string := xs:string(request:get-parameter("phrase", ""))
let $start as xs:int := xs:int(request:get-parameter("start", 0))
let $count as xs:int := xs:int(request:get-parameter("count", 100))

let $concepts := if ($phrase)
                            then lib-qs:query($resource, (), $phrase, $start, $count)//rs:concept
                            else ()

return

          <title>Searching for a reference uri</title>
          <link rel="stylesheet" href="../web/stylesheets/main.css" type="text/css"/>
          <link rel="stylesheet" href="../web/stylesheets/mdr.css" type="text/css"/>
          <link rel="stylesheet" href="../web/stylesheets/cagrid-style.css" type="text/css"/>
          <link rel="stylesheet" href="../classification/stylesheets/treeview.css" type="text/css"/>

         <form name='select-item' class='cagridForm' action='popup-search-reference-uri.xquery'>
            <input type='hidden' name='element' value='{$element}'/>

                  Search

                      <input type='text' name='phrase' value='{$phrase}'/>
                      <select name="resource">
                           {lib-qs:selectResource-form('CONCEPT')}
                      </select>

                  <input type="submit" value="Submit query" class="cgButton"/>

         </form>

            {
                  for $concept in $concepts
                  let $id :=
                      if (starts-with($concept/rs:names/rs:id, 'US-NCICB-CACORE-EVS-DESCLOGICCONCEPT'))
                      then concat("urn:lsid:ncicb.nci.nih.gov:nci-thesaurus:", tokenize($concept/rs:names/rs:id, '-')[last()])
                      else $concept/rs:names/rs:id
                  let $name := $concept/rs:names/rs:preferred
                  let $definition := $concept/rs:definition

                  return

                         {$id}
                          {$name}: {$definition}
                          {local:action-button($id, $element, "use this term", $name)}

             }

xquery version "1.0";
(: ~
: Module Name:             Reference URI search popup
:
: Module Version           1.0
:
: Date                     08 Jul 2008
:
: Copyright                The cagrid consortium
:
: Module overview          Finds a reference uri for an administered item
:
:)

(:~
:    @author Andrew Tsui
:    @version 1.0
~ :)
declare namespace request="http://exist-db.org/xquery/request";
declare namespace session="http://exist-db.org/xquery/session";
declare namespace rs="http://cagrid.org/schema/result-set";

import module namespace
      lib-qs="http://www.cagrid.org/xquery/library/query_service"
      at "../connector/m-lib-qs.xquery";

declare function local:action-button($value as xs:string, $control as xs:string, $text as xs:string, $name as xs:string) as node()
{
   element input {
      attribute class {"cgButton"},
      attribute type {"submit"},
      attribute name {"update"},
      attribute value {$text},
      attribute onclick {
      concat("window.opener.document.getElementById('",$control,"').value='",$value,"';",
            "window.opener.document.getElementById('", $control, "-div').innerHTML='",$name,"';",
            "self.close();")}
      }

};

declare option exist:serialize "media-type=text/html";

session:create(),
let $resource as xs:string := xs:string(request:get-parameter("resource", "EVS-DescLogicConcept"))
let $element as xs:string := xs:string(request:get-parameter("element", ""))
let $form-name as xs:string := xs:string(request:get-parameter("form-name", ""))
let $phrase as xs:string := xs:string(request:get-parameter("phrase", ""))
let $start as xs:int := xs:int(request:get-parameter("start", 0))
let $count as xs:int := xs:int(request:get-parameter("count", 10))

let $concepts := if ($phrase)
                            then lib-qs:query($resource, (), $phrase, $start, $count)//rs:concept
                            else ()

return

          <title>Searching for a reference uri</title>
          <link rel="stylesheet" href="../web/stylesheets/main.css" type="text/css"/>
          <link rel="stylesheet" href="../web/stylesheets/mdr.css" type="text/css"/>
          <link rel="stylesheet" href="../web/stylesheets/cagrid-style.css" type="text/css"/>
          <link rel="stylesheet" href="../classification/stylesheets/treeview.css" type="text/css"/>

         <form name='select-item' class='cagridForm' action='popup-search-reference-uri.xquery'>
            <input type='hidden' name='element' value='{$element}'/>

                  Search

                      <input type='text' name='phrase' value='{$phrase}'/>
                      <select name="resource">
                           {lib-qs:selectResource-form('CONCEPT')}
                      </select>

                  <input type="submit" value="Submit query" class="cgButton"/>

         </form>

            {
                  for $concept in $concepts
                  let $id :=
                      if (starts-with($concept/rs:names/rs:id, 'US-NCICB-CACORE-EVS-DESCLOGICCONCEPT'))
                      then concat("urn:lsid:ncicb.nci.nih.gov:nci-thesaurus:", tokenize($concept/rs:names/rs:id, '-')[last()])
                      else $concept/rs:names/rs:id
                  let $name := $concept/rs:names/rs:preferred
                  return

                          {$id}
                          {$name}
                          {local:action-button($id, $element, "use this term", $name)}

             }


belonging to the previous committ

belonging to the previous committ

import module namespace xqd = "http://www.zorba-xquery.com/modules/xqdoc";
import schema namespace xqds = "http://www.xqdoc.org/1.0" at "xqdoc-1.0.xsd";

declare sequential function local:remove-date($xqdoc)
{
  delete node $xqdoc//xqds:param[1];
  exit returning $xqdoc;
};

let $xqdoc as document-node (schema-element(xqds:xqdoc)) :=
  validate lax {
    xqd:xqdoc("gdata.xqlib")
  }
return
  local:remove-date($xqdoc)

import module namespace xqd = "http://www.zorba-xquery.com/modules/xqdoc";
import schema namespace xqds = "http://www.xqdoc.org/1.0" at "xqdoc-1.0.xsd";

declare sequential function local:remove-date($xqdoc)
{
  delete node $xqdoc//xqds:date;
  exit returning $xqdoc;
};

let $xqdoc as document-node (schema-element(xqds:xqdoc)) := validate lax { xqd:xqdoc("gdata.xqlib") }
return local:remove-date($xqdoc)