[ignore] small fix in controller.xql to pass webdav.xml through the stylesheets again

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

(: 	This is the main controller for the web application. It is called from the
	XQueryURLRewrite filter configured in web.xml. :)
xquery version "1.0";

declare namespace c="http://exist-db.org/xquery/controller";

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

declare function c:admin($path as xs:string, $name as xs:string) {
    if (starts-with($path, "/admin/backups")) then
        let $user := xdb:get-current-user()
        return
            if (not(xdb:is-admin-user($user))) then
                <dispatch xmlns="http://exist.sourceforge.net/NS/exist">
        			<redirect url="../admin.xql"/>
        		</dispatch>
        	else
                <dispatch xmlns="http://exist.sourceforge.net/NS/exist">
                    <forward url="/admin/retrieve-backup.xql">
                        <add-parameter name="archive" value="{$name}"/>
                    </forward>
                </dispatch>
    else if (matches($path, "admin/?$")) then
        <dispatch xmlns="http://exist.sourceforge.net/NS/exist">
			<redirect url="admin.xql"/>
		</dispatch>
    else if ($name eq "admin.xql") then
	    <dispatch xmlns="http://exist.sourceforge.net/NS/exist">
	        <forward url="/admin/admin.xql"/>
	    </dispatch>
    else
        <ignore xmlns="http://exist.sourceforge.net/NS/exist">
            <cache-control cache="yes"/>
		</ignore>
};

let $uri := request:get-uri()
let $context := request:get-context-path()
let $path := substring-after($uri, $context)
let $name := replace($uri, '^.*/([^/]+)$', '$1')
let $query := request:get-parameter("q", ())
return
	(: redirect webapp root to index.xml :)
    if ($path eq '/') then
		<dispatch xmlns="http://exist.sourceforge.net/NS/exist">
			<redirect url="index.xml"/>
		</dispatch>
	(: /rest and /webdav will be ignored :)
	else if (matches($path, "/(rest|servlet|webdav/|cocoon|test.xml)")) then
		<ignore xmlns="http://exist.sourceforge.net/NS/exist">
            <cache-control cache="yes"/>
		</ignore>
	(: redirect sandbox root to sandbox.xql :)
	else if (matches($uri, "sandbox/?$")) then
		<dispatch xmlns="http://exist.sourceforge.net/NS/exist">
			<redirect url="sandbox.xql"/>
		</dispatch>
	else if (starts-with($path, "/admin")) then
	    c:admin($path, $name)
	else if ($name = ('search.xql', 'functions.xql', 'svnlog.xql')) then
		<dispatch xmlns="http://exist.sourceforge.net/NS/exist">
			<forward url="{$path}">
				<!-- query results are passed to XSLT servlet via request attribute -->
				<set-attribute name="xquery.attribute"
					value="xslt.model"/>
			</forward>
			<view>
				<forward servlet="XSLTServlet">
					<set-attribute name="xslt.input"
						value="xslt.model"/>
					<set-attribute name="xslt.stylesheet"
						value="stylesheets/db2html.xsl"/>
				</forward>
			</view>
		</dispatch>
	else if ($name eq 'acronyms.xql') then
		<dispatch xmlns="http://exist.sourceforge.net/NS/exist">
			<!-- query results are passed to XSLT servlet via request attribute -->
			<set-attribute name="xquery.attribute"
				value="xslt.model"/>
			<view>
				<forward servlet="XSLTServlet">
					<set-attribute name="xslt.input"
						value="xslt.model"/>
					<set-attribute name="xslt.stylesheet"
						value="xquery/stylesheets/acronyms.xsl"/>
				</forward>
				<forward servlet="XSLTServlet">
					<set-attribute name="xslt.input"
						value=""/>
					<set-attribute name="xslt.stylesheet"
						value="stylesheets/db2html.xsl"/>
				</forward>
			</view>
		</dispatch>
	else if ($name eq 'biblio.xql') then
		let $display := request:get-parameter("display", "overview")
		let $xsl :=
			if ($display eq "details") then "detailed.xsl" else "overview.xsl"
		return
			<dispatch xmlns="http://exist.sourceforge.net/NS/exist">
				<set-attribute name="xquery.attribute" value="xslt.model"/>
				<view>
				<forward servlet="XSLTServlet">
					<set-attribute name="xslt.input"
						value="xslt.model"/>
					<set-attribute name="xslt.stylesheet"
						value="xquery/stylesheets/{$xsl}"/>
				</forward>
				<forward servlet="XSLTServlet">
					<set-attribute name="xslt.input"
						value=""/>
					<set-attribute name="xslt.stylesheet"
						value="stylesheets/doc2html-2.xsl"/>
				</forward>

				</view>
			</dispatch>

	else if ($name eq 'twitter.xql') then
	    <dispatch xmlns="http://exist.sourceforge.net/NS/exist">
	        <view>
	            <forward url="twitter-view.xql"/>
            </view>
	    </dispatch>

	else if ($name eq 'applications.xml') then
		<dispatch xmlns="http://exist.sourceforge.net/NS/exist">
			<!-- query results are passed to XSLT servlet via request attribute -->
			<set-attribute name="xquery.attribute"
				value="xslt.model"/>
			<view>
				<forward servlet="XSLTServlet">
					<set-attribute name="xslt.input"
						value="xslt.model"/>
					<set-attribute name="xslt.stylesheet"
						value="apps/applications.xsl"/>
				</forward>
				<forward servlet="XSLTServlet">
					<set-attribute name="xslt.input"
						value=""/>
					<set-attribute name="xslt.stylesheet"
						value="stylesheets/db2html.xsl"/>
				</forward>
			</view>
		</dispatch>

	else if ($name eq 'articles') then
		<dispatch xmlns="http://exist.sourceforge.net/NS/exist">
			<forward url="/xquery/exist-articles.xql">
				<!-- query results are passed to XSLT servlet via request attribute -->
				<set-attribute name="xquery.attribute"
					value="xslt.model"/>
			</forward>
			<view>
				<forward servlet="XSLTServlet">
					<set-attribute name="xslt.input"
						value="xslt.model"/>
					<set-attribute name="xslt.stylesheet"
						value="stylesheets/db2html.xsl"/>
				</forward>
			</view>
		</dispatch>

	(: the following xml files use different stylesheets :)
	else if ($name = ('index.xml', 'roadmap.xml', 'facts.xml', 'biblio.xml')
	    or $path = '/examples.xml') then
		let $stylesheet :=
			if ($name eq 'roadmap.xml') then
				"stylesheets/roadmap.xsl"
			else if ($name eq "facts.xml") then
				"stylesheets/facts.xsl"
			else
				"stylesheets/doc2html-2.xsl"
		return
			<dispatch xmlns="http://exist.sourceforge.net/NS/exist">
				<view>
					<forward servlet="XSLTServlet">
						<set-attribute name="xslt.stylesheet"
							value="{$stylesheet}"/>
					</forward>
				</view>
				<cache-control cache="yes"/>
			</dispatch>
	else if (ends-with($uri, '.xml')) then
		(: 	check if the requested document was selected from a query result.
			if yes, pass it to docs.xql to get the match highlighting. :)
		if ($query) then
			let $docName := replace($uri, '^.*/([^/]+)$', '$1')
			return
				<dispatch xmlns="http://exist.sourceforge.net/NS/exist">
					<forward url="docs.xql">
						<add-parameter name="path" value="/db/xqdocs/{$docName}"/>
					</forward>
				</dispatch>
		else
			<dispatch xmlns="http://exist.sourceforge.net/NS/exist">
				<view>
					<forward servlet="XSLTServlet">
						<set-attribute name="xslt.stylesheet"
							value="stylesheets/db2html.xsl"/>
					</forward>
				</view>
            	<cache-control cache="no"/>
			</dispatch>
	else if ($path = "/xproc") then
	    <dispatch xmlns="http://exist.sourceforge.net/NS/exist">
    		<redirect url="xproc/examples.xml"/>
    	</dispatch>
	else if (ends-with($uri, '.xproc')) then
	    let $docName := replace($uri, '^.*/([^/]+)$', '$1')
	    return
    	    <dispatch xmlns="http://exist.sourceforge.net/NS/exist">
    			<forward url="/rest/db/xproc/run.xql">
    				<add-parameter name="xproc" value="/db/xproc/{$docName}"/>
    			</forward>
    		</dispatch>
    else if ($name = ('default-style.css', 'niftycube.js', 'niftyCorners.css', 'sh-min.js')) then
        let $newPath :=
            if ($name eq 'sh-min.js') then
                '/scripts/syntax/sh-min.js'
            else
                replace($path, '^.*/([^/]+/[^/]+)$', '/$1')
        return
        <dispatch xmlns="http://exist.sourceforge.net/NS/exist">
			<forward url="{$newPath}"/>
			<cache-control cache="yes"/>
		</dispatch>
	else
		<ignore xmlns="http://exist.sourceforge.net/NS/exist">
            <cache-control cache="yes"/>
		</ignore>

(: 	This is the main controller for the web application. It is called from the
	XQueryURLRewrite filter configured in web.xml. :)
xquery version "1.0";

declare namespace c="http://exist-db.org/xquery/controller";

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

declare function c:admin($path as xs:string, $name as xs:string) {
    if (starts-with($path, "/admin/backups")) then
        let $user := xdb:get-current-user()
        return
            if (not(xdb:is-admin-user($user))) then
                <dispatch xmlns="http://exist.sourceforge.net/NS/exist">
        			<redirect url="../admin.xql"/>
        		</dispatch>
        	else
                <dispatch xmlns="http://exist.sourceforge.net/NS/exist">
                    <forward url="/admin/retrieve-backup.xql">
                        <add-parameter name="archive" value="{$name}"/>
                    </forward>
                </dispatch>
    else if (matches($path, "admin/?$")) then
        <dispatch xmlns="http://exist.sourceforge.net/NS/exist">
			<redirect url="admin.xql"/>
		</dispatch>
    else if ($name eq "admin.xql") then
	    <dispatch xmlns="http://exist.sourceforge.net/NS/exist">
	        <forward url="/admin/admin.xql"/>
	    </dispatch>
    else
        <ignore xmlns="http://exist.sourceforge.net/NS/exist">
            <cache-control cache="yes"/>
		</ignore>
};

let $uri := request:get-uri()
let $context := request:get-context-path()
let $path := substring-after($uri, $context)
let $name := replace($uri, '^.*/([^/]+)$', '$1')
let $query := request:get-parameter("q", ())
return
	(: redirect webapp root to index.xml :)
    if ($path eq '/') then
		<dispatch xmlns="http://exist.sourceforge.net/NS/exist">
			<redirect url="index.xml"/>
		</dispatch>
	(: /rest and /webdav will be ignored :)
	else if (matches($path, "/(rest|servlet|webdav|cocoon|test.xml)")) then
		<ignore xmlns="http://exist.sourceforge.net/NS/exist">
            <cache-control cache="yes"/>
		</ignore>
	(: redirect sandbox root to sandbox.xql :)
	else if (matches($uri, "sandbox/?$")) then
		<dispatch xmlns="http://exist.sourceforge.net/NS/exist">
			<redirect url="sandbox.xql"/>
		</dispatch>
	else if (starts-with($path, "/admin")) then
	    c:admin($path, $name)
	else if ($name = ('search.xql', 'functions.xql', 'svnlog.xql')) then
		<dispatch xmlns="http://exist.sourceforge.net/NS/exist">
			<forward url="{$path}">
				<!-- query results are passed to XSLT servlet via request attribute -->
				<set-attribute name="xquery.attribute"
					value="xslt.model"/>
			</forward>
			<view>
				<forward servlet="XSLTServlet">
					<set-attribute name="xslt.input"
						value="xslt.model"/>
					<set-attribute name="xslt.stylesheet"
						value="stylesheets/db2html.xsl"/>
				</forward>
			</view>
		</dispatch>
	else if ($name eq 'acronyms.xql') then
		<dispatch xmlns="http://exist.sourceforge.net/NS/exist">
			<!-- query results are passed to XSLT servlet via request attribute -->
			<set-attribute name="xquery.attribute"
				value="xslt.model"/>
			<view>
				<forward servlet="XSLTServlet">
					<set-attribute name="xslt.input"
						value="xslt.model"/>
					<set-attribute name="xslt.stylesheet"
						value="xquery/stylesheets/acronyms.xsl"/>
				</forward>
				<forward servlet="XSLTServlet">
					<set-attribute name="xslt.input"
						value=""/>
					<set-attribute name="xslt.stylesheet"
						value="stylesheets/db2html.xsl"/>
				</forward>
			</view>
		</dispatch>
	else if ($name eq 'biblio.xql') then
		let $display := request:get-parameter("display", "overview")
		let $xsl :=
			if ($display eq "details") then "detailed.xsl" else "overview.xsl"
		return
			<dispatch xmlns="http://exist.sourceforge.net/NS/exist">
				<set-attribute name="xquery.attribute" value="xslt.model"/>
				<view>
				<forward servlet="XSLTServlet">
					<set-attribute name="xslt.input"
						value="xslt.model"/>
					<set-attribute name="xslt.stylesheet"
						value="xquery/stylesheets/{$xsl}"/>
				</forward>
				<forward servlet="XSLTServlet">
					<set-attribute name="xslt.input"
						value=""/>
					<set-attribute name="xslt.stylesheet"
						value="stylesheets/doc2html-2.xsl"/>
				</forward>

				</view>
			</dispatch>

	else if ($name eq 'twitter.xql') then
	    <dispatch xmlns="http://exist.sourceforge.net/NS/exist">
	        <view>
	            <forward url="twitter-view.xql"/>
            </view>
	    </dispatch>

	else if ($name eq 'applications.xml') then
		<dispatch xmlns="http://exist.sourceforge.net/NS/exist">
			<!-- query results are passed to XSLT servlet via request attribute -->
			<set-attribute name="xquery.attribute"
				value="xslt.model"/>
			<view>
				<forward servlet="XSLTServlet">
					<set-attribute name="xslt.input"
						value="xslt.model"/>
					<set-attribute name="xslt.stylesheet"
						value="apps/applications.xsl"/>
				</forward>
				<forward servlet="XSLTServlet">
					<set-attribute name="xslt.input"
						value=""/>
					<set-attribute name="xslt.stylesheet"
						value="stylesheets/db2html.xsl"/>
				</forward>
			</view>
		</dispatch>

	else if ($name eq 'articles') then
		<dispatch xmlns="http://exist.sourceforge.net/NS/exist">
			<forward url="/xquery/exist-articles.xql">
				<!-- query results are passed to XSLT servlet via request attribute -->
				<set-attribute name="xquery.attribute"
					value="xslt.model"/>
			</forward>
			<view>
				<forward servlet="XSLTServlet">
					<set-attribute name="xslt.input"
						value="xslt.model"/>
					<set-attribute name="xslt.stylesheet"
						value="stylesheets/db2html.xsl"/>
				</forward>
			</view>
		</dispatch>

	(: the following xml files use different stylesheets :)
	else if ($name = ('index.xml', 'roadmap.xml', 'facts.xml', 'biblio.xml')
	    or $path = '/examples.xml') then
		let $stylesheet :=
			if ($name eq 'roadmap.xml') then
				"stylesheets/roadmap.xsl"
			else if ($name eq "facts.xml") then
				"stylesheets/facts.xsl"
			else
				"stylesheets/doc2html-2.xsl"
		return
			<dispatch xmlns="http://exist.sourceforge.net/NS/exist">
				<view>
					<forward servlet="XSLTServlet">
						<set-attribute name="xslt.stylesheet"
							value="{$stylesheet}"/>
					</forward>
				</view>
				<cache-control cache="yes"/>
			</dispatch>
	else if (ends-with($uri, '.xml')) then
		(: 	check if the requested document was selected from a query result.
			if yes, pass it to docs.xql to get the match highlighting. :)
		if ($query) then
			let $docName := replace($uri, '^.*/([^/]+)$', '$1')
			return
				<dispatch xmlns="http://exist.sourceforge.net/NS/exist">
					<forward url="docs.xql">
						<add-parameter name="path" value="/db/xqdocs/{$docName}"/>
					</forward>
				</dispatch>
		else
			<dispatch xmlns="http://exist.sourceforge.net/NS/exist">
				<view>
					<forward servlet="XSLTServlet">
						<set-attribute name="xslt.stylesheet"
							value="stylesheets/db2html.xsl"/>
					</forward>
				</view>
            	<cache-control cache="no"/>
			</dispatch>
	else if ($path = "/xproc") then
	    <dispatch xmlns="http://exist.sourceforge.net/NS/exist">
    		<redirect url="xproc/examples.xml"/>
    	</dispatch>
	else if (ends-with($uri, '.xproc')) then
	    let $docName := replace($uri, '^.*/([^/]+)$', '$1')
	    return
    	    <dispatch xmlns="http://exist.sourceforge.net/NS/exist">
    			<forward url="/rest/db/xproc/run.xql">
    				<add-parameter name="xproc" value="/db/xproc/{$docName}"/>
    			</forward>
    		</dispatch>
    else if ($name = ('default-style.css', 'niftycube.js', 'niftyCorners.css', 'sh-min.js')) then
        let $newPath :=
            if ($name eq 'sh-min.js') then
                '/scripts/syntax/sh-min.js'
            else
                replace($path, '^.*/([^/]+/[^/]+)$', '/$1')
        return
        <dispatch xmlns="http://exist.sourceforge.net/NS/exist">
			<forward url="{$newPath}"/>
			<cache-control cache="yes"/>
		</dispatch>
	else
		<ignore xmlns="http://exist.sourceforge.net/NS/exist">
            <cache-control cache="yes"/>
		</ignore>


Update doc.

Update doc.

xquery version "3.0";

(:
 : Copyright 2006-2012 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.
:)

(:~
 : This module provides functions for processing URIs and URLs.
 :
 : @author Matthias Brantner, Luis Rodriguez Gonzalez
 : @project XDM/atomic
 :
 :)
module namespace uri = "http://www.zorba-xquery.com/modules/uri";

declare namespace zerr = "http://www.zorba-xquery.com/errors";
declare namespace ver = "http://www.zorba-xquery.com/options/versioning";
declare option ver:module-version "1.0";

(:~
 : Percent-decodes (aka URL decoding) the given string.
 :
 : All percent encoded octets will be translated into their
 : decoded UTF-8 representation.
 :
 : Please note that the percent encoding guarantees that a string
 : consists of ASCII characters only. Passing a string that contains
 : non-ASCII characters results in undefined behavior.
 :
 : @param $s the string to decode
 :
 : @return the percent decoded string
 :)
declare function uri:decode($u as xs:string) as xs:string
{
  uri:decode($u, fn:false())
};

(:~
 : Percent-decodes (aka URL decoding) the given string.
 :
 : All percent encoded octets will be translated into their
 : decoded UTF-8 representation.
 :
 : If $decode-plus is specified all occurrences of the char '+'
 : will be replaced with a space ' ' before the percent decoding
 : happens.
 :
 : Please note that the percent encoding guarantees that a string
 : consists of ASCII characters only. Passing a string that contains
 : non-ASCII characters results in undefined behavior.
 :
 : @param $s the string to decode
 : @param $decode-plus whether '+' chars will be replaced with spaces
 :
 : @return the percent decoded string
 :)
declare function uri:decode(
  $u as xs:string,
  $decode-plus as xs:boolean) as xs:string
{
  uri:decode($u, $decode-plus, "UTF-8")
};

(:~
 : Percent-decodes (aka URL decoding) the given string.
 :
 : All percent encoded octets will be translated into their
 : decoded UTF-8 representation.
 :
 : If $decode-plus is specified all occurrences of the char '+'
 : will be replaced with a space ' ' before the percent decoding
 : happens.
 :
 : The $charset parameter specifies the source charset after precent
 : decoding. It is used to convert the decoded string into UTF-8.
 :
 : Please note that the percent encoding guarantees that a string
 : consists of ASCII characters only. Passing a string that contains
 : non-ASCII characters results in undefined behavior.
 :
 : @param $s the string to decode
 : @param $decode-plus whether '+' chars will be replaced with spaces
 : @param $charset the source charset of the string after percent decoding
 :
 : @return the percent decoded string
 :
 : @error zerr:ZXQP0006 if the given charset is unknown or not supported
 :
 : @error zerr:ZOSE0006 if there is an error transcoding the string
 :)
declare function uri:decode(
  $s as xs:string,
  $decode-plus as xs:boolean,
  $charset as xs:string) as xs:string external;

(:~
 : Parses the URI passed as xs:string into a uri JSONiq object.
 :
 : @param $uri the URI as string to parse
 :
 : @return the URI JSONiq object
 :
 :)
declare function uri:parse(
  $uri as xs:string) as object() external;

(:~
 : Serialize the URI passed as JSONiq object into a URI represented as xs:string.
 :
 : @param $uri the URI JSONiq object
 :
 : @return the URI as xs:string
 :
 : @error zerr:ZURI0001 if opaque part is specified in conjuntion with
 : host/port/path/user-info/query.
 :
 : @error zerr:ZURI0002 if opaque part is present but no scheme is present at the
 : same time.
 :
 : @error zerr:ZURI0003 if a path component for an absolute URI doesn't start with
 : "/".
 :
 :)
declare function uri:serialize(
  $uri as object()) as xs:string external;

xquery version "3.0";

(:
 : Copyright 2006-2012 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.
:)

(:~
 : This module provides string related and URI related functions.
 :
 : @author Matthias Brantner
 : @project XDM/atomic
 :
 :)
module namespace uri = "http://www.zorba-xquery.com/modules/uri";

declare namespace zerr = "http://www.zorba-xquery.com/errors";
declare namespace ver = "http://www.zorba-xquery.com/options/versioning";
declare option ver:module-version "1.0";

(:~
 : Percent-decodes (aka URL decoding) the given string.
 :
 : All percent encoded octets will be translated into their
 : decoded UTF-8 representation.
 :
 : Please note that the percent encoding guarantees that a string
 : consists of ASCII characters only. Passing a string that contains
 : non-ASCII characters results in undefined behavior.
 :
 : @param $s the string to decode
 :
 : @return the percent decoded string
 :)
declare function uri:decode($u as xs:string) as xs:string
{
  uri:decode($u, fn:false())
};

(:~
 : Percent-decodes (aka URL decoding) the given string.
 :
 : All percent encoded octets will be translated into their
 : decoded UTF-8 representation.
 :
 : If $decode-plus is specified all occurrences of the char '+'
 : will be replaced with a space ' ' before the percent decoding
 : happens.
 :
 : Please note that the percent encoding guarantees that a string
 : consists of ASCII characters only. Passing a string that contains
 : non-ASCII characters results in undefined behavior.
 :
 : @param $s the string to decode
 : @param $decode-plus whether '+' chars will be replaced with spaces
 :
 : @return the percent decoded string
 :)
declare function uri:decode(
  $u as xs:string,
  $decode-plus as xs:boolean) as xs:string
{
  uri:decode($u, $decode-plus, "UTF-8")
};

(:~
 : Percent-decodes (aka URL decoding) the given string.
 :
 : All percent encoded octets will be translated into their
 : decoded UTF-8 representation.
 :
 : If $decode-plus is specified all occurrences of the char '+'
 : will be replaced with a space ' ' before the percent decoding
 : happens.
 :
 : The $charset parameter specifies the source charset after precent
 : decoding. It is used to convert the decoded string into UTF-8.
 :
 : Please note that the percent encoding guarantees that a string
 : consists of ASCII characters only. Passing a string that contains
 : non-ASCII characters results in undefined behavior.
 :
 : @param $s the string to decode
 : @param $decode-plus whether '+' chars will be replaced with spaces
 : @param $charset the source charset of the string after percent decoding
 :
 : @return the percent decoded string
 :
 : @error zerr:ZXQP0006 if the given charset is unknown or not supported
 :
 : @error zerr:ZOSE0006 if there is an error transcoding the string
 :)
declare function uri:decode(
  $s as xs:string,
  $decode-plus as xs:boolean,
  $charset as xs:string) as xs:string external;

(:~
 : Parses the URI passed as xs:string into a uri JSONiq object.
 :
 : @param $uri the URI as string to parse
 :
 : @return the URI JSONiq object
 :
 :)
declare function uri:parse(
  $uri as xs:string) as object() external;

(:~
 : Serialize the URI passed as JSONiq object into a URI represented as xs:string.
 :
 : @param $uri the URI JSONiq object
 :
 : @return the URI as xs:string
 :
 : @error zerr:ZURI0001 if opaque part is specified in conjuntion with
 : host/port/path/user-info/query.
 :
 : @error zerr:ZURI0002 if opaque part is present but no scheme is present at the
 : same time.
 :
 : @error zerr:ZURI0003 if a path component for an absolute URI doesn't start with
 : "/".
 :
 :)
declare function uri:serialize(
  $uri as object()) as xs:string external;


[website] Fixed broken twitter feed display: do not cache feed in db, use cache module instead.

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

xquery version "1.0";

(: -----------------------------------------------------------------------
   A simple twitter client. This is the main script which is called from
   controller.xql. It retrieves an atom feed from twitter and caches
   it in the xmldb. The data is then passed to twitter-view.xql for
   formatting and display.
   -----------------------------------------------------------------------:)

declare namespace tc="http://exist-db.org/xquery/twitter-client";
declare namespace atom="http://www.w3.org/2005/Atom";
declare namespace html="http://www.w3.org/1999/xhtml";

import module namespace httpclient="http://exist-db.org/xquery/httpclient"
    at "java:org.exist.xquery.modules.httpclient.HTTPClientModule";
import module namespace cache="http://exist-db.org/xquery/cache" at "java:org.exist.xquery.modules.cache.CacheModule";

(: To access more than just the tweets posted by a single user (e.g. its friends timeline),
   you need to authenticate with a valid twitter account. Enter the username/password pair
   below. :)
declare variable $tc:login := ( "user", "password" );

declare variable $tc:update-frequency := xs:dayTimeDuration("PT5M");

(: Create the HTTP basic authentication header if user credentials available :)
declare function tc:get-headers($credentials as xs:string*) {
    if (empty($credentials)) then
        ()
    else
        let $auth := concat('Basic ', util:string-to-binary(concat($credentials[1], ':', $credentials[2])))
        return
            <headers>
                <header name="Authorization" value="{$auth}"/>
            </headers>
};

(: Send an HTTP request to twitter to retrieve the timeline in Atom format :)
declare function tc:get-timeline($credentials as xs:string*, $userId as xs:string, $view as xs:string) {
    let $uri := xs:anyURI(
        concat("http://twitter.com/statuses/", $view, "_timeline/", $userId, ".atom")
    )
    let $headers := tc:get-headers($credentials)
    let $response := httpclient:get($uri, false(), $headers)
    return
        if ($response/@statusCode eq "200") then
            $response/httpclient:body/*
        else if ($response/httpclient:body//error) then
            $response/httpclient:body//error/string()
        else
            concat("Twitter reported an error. Code: ", $response/@statusCode)
};

(: Retrieve the timeline and store it into the db cache :)
declare function tc:update-timeline($credentials as xs:string*, $userId as xs:string, $view as xs:string) {
    let $tl := tc:get-timeline($credentials, $userId, $view)
    let $cache := cache:cache("twitter")
    let $cached := cache:put($cache, $userId, $tl)
    return
        $tl
};

(: Main function: returns the timeline in atom format. The data is cached within the database
   and will be renewed every few minutes. :)
declare function tc:timeline($credentials as xs:string*, $userId as xs:string, $view as xs:string) {
    let $feed := cache:get("twitter", $userId)
    return
        if (exists($feed) and
            (xs:dateTime($feed/atom:updated) + $tc:update-frequency) > current-dateTime()) then
            $feed
        else
            tc:update-timeline($credentials, $userId, $view)
};

(: This script will just retrieve the feed, then forward it to
   twitter-view.xql, using a request attribute. The forwarding is done
   through controller.xql :)
let $user := request:get-parameter("user", "existdb")
let $view := request:get-parameter("view", "user")
let $feed :=
    if ($user) then
        tc:timeline(
            if ($tc:login[1] eq 'user') then () else $tc:login,
            $user, $view
        )
    else ()
return
    request:set-attribute("twitter.feed", $feed)

xquery version "1.0";

(: -----------------------------------------------------------------------
   A simple twitter client. This is the main script which is called from
   controller.xql. It retrieves an atom feed from twitter and caches
   it in the xmldb. The data is then passed to twitter-view.xql for
   formatting and display.
   -----------------------------------------------------------------------:)

declare namespace tc="http://exist-db.org/xquery/twitter-client";
declare namespace atom="http://www.w3.org/2005/Atom";
declare namespace html="http://www.w3.org/1999/xhtml";

import module namespace httpclient="http://exist-db.org/xquery/httpclient"
    at "java:org.exist.xquery.modules.httpclient.HTTPClientModule";
import module namespace xdb="http://exist-db.org/xquery/xmldb";

(: To access more than just the tweets posted by a single user (e.g. its friends timeline),
   you need to authenticate with a valid twitter account. Enter the username/password pair
   below. :)
declare variable $tc:login := ( "user", "password" );

declare variable $tc:update-frequency := xs:dayTimeDuration("PT5M");

(: Create the HTTP basic authentication header if user credentials available :)
declare function tc:get-headers($credentials as xs:string*) {
    if (empty($credentials)) then
        ()
    else
        let $auth := concat('Basic ', util:string-to-binary(concat($credentials[1], ':', $credentials[2])))
        return
            <headers>
                <header name="Authorization" value="{$auth}"/>
            </headers>
};

(: Send an HTTP request to twitter to retrieve the timeline in Atom format :)
declare function tc:get-timeline($credentials as xs:string*, $userId as xs:string, $view as xs:string) {
    let $uri := xs:anyURI(
        concat("http://twitter.com/statuses/", $view, "_timeline/", $userId, ".atom")
    )
    let $headers := tc:get-headers($credentials)
    let $response := httpclient:get($uri, false(), $headers)
    return
        if ($response/@statusCode eq "200") then
            $response/httpclient:body/*
        else if ($response/httpclient:body//error) then
            $response/httpclient:body//error/string()
        else
            concat("Twitter reported an error. Code: ", $response/@statusCode)
};

(: Retrieve the timeline and store it into the db :)
declare function tc:update-timeline($credentials as xs:string*, $userId as xs:string, $view as xs:string) {
    let $null := xdb:create-collection("/db", "twitter")
    let $feed := tc:get-timeline($credentials, $userId, $view)
    return
        if (empty($feed) or $feed instance of xs:string) then
            $feed
        else
            let $docPath := xdb:store("/db/twitter", concat($userId, "_", $view, ".xml"), $feed)
            return
                doc($docPath)/atom:feed
};

(: Main function: returns the timeline in atom format. The data is cached within the database
   and will be renewed every few minutes. :)
declare function tc:timeline($credentials as xs:string*, $userId as xs:string, $view as xs:string) {
    let $feed := doc(concat("/db/twitter/", $userId, "_", $view, ".xml"))/atom:feed
    return
        if (exists($feed) and
            (xs:dateTime($feed/atom:updated) + $tc:update-frequency) > current-dateTime()) then
            $feed
        else
            tc:update-timeline($credentials, $userId, $view)
};

(: This script will just retrieve the feed, then forward it to
   twitter-view.xql, using a request attribute. The forwarding is done
   through controller.xql :)
let $user := request:get-parameter("user", ())
let $view := request:get-parameter("view", "user")
let $feed :=
    if ($user) then
        tc:timeline(
            if ($tc:login[1] eq 'user') then () else $tc:login,
            $user, $view
        )
    else ()
return
    request:set-attribute("twitter.feed", $feed)


[testsuite] Add test cases to check reported line numbers if there are newlines in string literals, constructors or comments.

xquery version "3.1";

(:~
 : Tests to check if the reported line numbers for errors are correct:
 :
 : * if a function is called dynamically. In previous eXist versions, the
 : line number always pointed to the place where the function item was created,
 : not the actual function body
 : * if newlines occur in string literals, constructors or comments
 :)
module namespace et="http://exist-db.org/xquery/test/error-test";

declare namespace test="http://exist-db.org/xquery/xqsuite";

(: Causes an error when called :)
declare function et:test($a) {
    $a + "bla"
};

(: May cause an error when called :)
declare function et:test2($a) {
    $a/foo
};

declare
    %test:assertEquals(17)
function et:dynamically-called-function() {
    let $fn := function-lookup(xs:QName("et:test"), 1)
    return
        try {
            $fn(1)
        } catch * {
            $err:line-number
        }
};

declare
    %test:assertEquals(22)
function et:dynamically-called-function-path-expr() {
    let $fn := function-lookup(xs:QName("et:test2"), 1)
    return
        try {
            $fn(1)
        } catch * {
            $err:line-number
        }
};

declare
    %test:assertEquals(53)
function et:inline-function-call() {
    let $fn := function($a) {
        $a + "bla"
    }
    return
        try {
            $fn(1)
        } catch * {
            $err:line-number
        }
};

declare
    %test:assertEquals(17)
function et:function-reference-call() {
    let $fn := et:test#1
    return
        try {
            $fn(1)
        } catch * {
            $err:line-number
        }
};

declare
    %test:assertEquals(87)
function et:nl-in-string-literal() {
    try {
        let $foo := "bar

        "
        return
            element x {
                attribute y { "1" },
                (: next line will generate dynamic error :)
                element z { sum($foo) }
            }
    } catch * {
        $err:line-number
    }
};

declare
    %test:assertEquals(106)
function et:nl-in-string-constructor() {
    try {
        let $foo := ``[bar

        ]``
        return
            element x {
                attribute y { "1" },
                (: next line will generate dynamic error :)
                element z { sum($foo) }
            }
    } catch * {
        $err:line-number
    }
};

declare
    %test:assertEquals(124)
function et:nl-in-element-constructor() {
    try {
        let $foo :=
            <test>
                <p>foo

                </p>
            </test>
        return
            "abc"/node()
    } catch * {
        $err:line-number
    }
};

declare
    %test:assertEquals(137)
function et:nl-in-comment() {
    try {
        (: This is a

        multiline comment :)
        "abc"/node()
    } catch * {
        $err:line-number
    }
};

xquery version "3.0";

(:~
 : Tests to check if the reported line numbers for errors are correct
 : if a function is called dynamically. In previous eXist versions, the
 : line number always pointed to the place where the function item was created,
 : not the actual function body.
 :)
module namespace et="http://exist-db.org/xquery/test/error-test";

declare namespace test="http://exist-db.org/xquery/xqsuite";

(: Causes an error when called :)
declare function et:test($a) {
    $a + "bla"
};

(: May cause an error when called :)
declare function et:test2($a) {
    $a/foo
};

declare
    %test:assertEquals(15)
function et:dynamically-called-function() {
    let $fn := function-lookup(xs:QName("et:test"), 1)
    return
        try {
            $fn(1)
        } catch * {
            $err:line-number
        }
};

declare
    %test:assertEquals(20)
function et:dynamically-called-function-path-expr() {
    let $fn := function-lookup(xs:QName("et:test2"), 1)
    return
        try {
            $fn(1)
        } catch * {
            $err:line-number
        }
};

declare
    %test:assertEquals(51)
function et:inline-function-call() {
    let $fn := function($a) {
        $a + "bla"
    }
    return
        try {
            $fn(1)
        } catch * {
            $err:line-number
        }
};

declare
    %test:assertEquals(15)
function et:function-reference-call() {
    let $fn := et:test#1
    return
        try {
            $fn(1)
        } catch * {
            $err:line-number
        }
};


Annotate the BaseX json functions with versioned type restrictions.

xquery version "3.1";
(:~
 : BaseX JSON Module functions
 :
 : @see http://docs.basex.org/wiki/JSON_Module
 :)
module namespace json = "http://basex.org/modules/json";

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

declare option o:requires "basex/7.0";

declare %a:restrict-until("return", "basex", "9.1", "element(json)")
        %a:restrict-since("return", "basex", "9.1", "item()?")
        %a:restrict-until("$string", "basex", "9.1", "xs:string")
        %a:since("basex", "7.0") function json:parse($string as xs:string?) as (element(json)|item()?) external;
declare %a:restrict-until("return", "basex", "9.1", "item()")
        %a:restrict-until("$string", "basex", "9.1", "xs:string")
        %a:restrict-until("$options", "basex", "8.2.1", "item()")
        %a:restrict-until("$options", "basex", "8.2.3", "map(xs:string, xs:string)")
        %a:restrict-until("$options", "basex", "8.6.7", "map(*)")
        %a:restrict-since("$options", "basex", "8.6.7", "map(*)?")
        %a:since("basex", "7.7.2") function json:parse($string as xs:string?, $options as item()?) as item()? external;
declare %a:since("basex", "7.0") function json:serialize($input as item()?) as xs:string external;
declare %a:restrict-until("$options", "basex", "8.2.1", "item()")
        %a:restrict-until("$options", "basex", "8.2.3", "map(xs:string, xs:string)")
        %a:restrict-until("$options", "basex", "8.6.7", "map(*)")
        %a:restrict-since("$options", "basex", "8.6.7", "map(*)?")
        %a:since("basex", "7.7.2") function json:serialize($input as item()?, $options as item()?) as xs:string external;
declare %a:since("basex", "7.0") %a:deprecated("basex", "7.7.2") function json:serialize-ml($input as node()) as xs:string external;
declare %a:since("basex", "7.0") %a:deprecated("basex", "7.7.2") function json:parse-ml($input as xs:string) as element() external;

xquery version "3.1";
(:~
 : BaseX JSON Module functions
 :
 : @see http://docs.basex.org/wiki/JSON_Module
 :)
module namespace json = "http://basex.org/modules/json";

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

declare option o:requires "basex/7.0";

declare %a:since("basex", "7.0") function json:parse($string (: as [basex/7.0]xs:string [basex/9.1]xs:string? :)) (: as [basex/7.0]element(json) [basex/9.1]item()? :) external;
declare %a:since("basex", "7.7.2") function json:parse($string (: as [basex/7.0]xs:string [basex/9.1]xs:string? :), $options (: as [basex/7.7.2]item() [basex/8.2.1]map(xs:string, xs:string) [basex/8.2.3]map(*) [basex/8.6.7]map(*)? :)) (: as [basex/7.7.2]item() [basex/9.1]item()? :) external;
declare %a:since("basex", "7.0") function json:serialize($input as item()?) as xs:string external;
declare %a:since("basex", "7.7.2") function json:serialize($input as item()?, $options (: as [basex/7.7.2]item() [basex/8.2.1]map(xs:string, xs:string) [basex/8.2.3]map(*) [basex/8.6.7]map(*)? :)) as xs:string external;
declare %a:since("basex", "7.0") %a:deprecated("basex", "7.7.2") function json:serialize-ml($input as node()) as xs:string external;
declare %a:since("basex", "7.0") %a:deprecated("basex", "7.7.2") function json:parse-ml($input as xs:string) as element() external;


Declaring the element namespace

Declaring the element namespace

import module namespace csd_lsc = "https://github.com/openhie/openinfoman/csd_lsc";
import module namespace csd_dm = "https://github.com/openhie/openinfoman/csd_dm";
import module namespace csd_webconf =  "https://github.com/openhie/openinfoman/csd_webconf";
import module namespace functx = "http://www.functx.com";
declare default element  namespace   "urn:ihe:iti:csd:2013";
declare namespace csd  =  "urn:ihe:iti:csd:2013";

declare variable $careServicesRequest as item() external;

let $dest_doc := /.
let $dest := $careServicesRequest/@resource
for $doc in $careServicesRequest/documents/document
  let $insertNew :=
    if (exists($doc/insertNew/@value))
    then ($doc/insertNew/@value = 1)
    else true()

  let $name := string($doc/@resource)
  let $src_doc :=
    if (not (functx:all-whitespace($name)))
    then if (not ($name = $dest)) then csd_dm:open_document( $name) else ()
    else $doc
  return
    (
    let $src_dir := $src_doc/csd:CSD/csd:organizationDirectory
    let $dest_dir := $dest_doc/csd:CSD/csd:organizationDirectory
    return
      for $e in $src_dir/csd:organization
      let $existing := $dest_dir/csd:organization[@entityID = $e/@entityID]
      return
	if (exists($existing))
        then
          let $new :=
	    <csd:organization entityID="{$e/@entityID}">
	      {$existing/csd:otherID}
	      {$e/*}
	    </csd:organization>
	  return replace node $existing with $new
        else if ($insertNew) then insert node $e into $dest_dir else ()
    ,
    let $src_dir := $src_doc/csd:CSD/csd:providerDirectory
    let $dest_dir := $dest_doc/csd:CSD/csd:providerDirectory
    return
      for $e in $src_dir/csd:provider
      let $existing := $dest_dir/csd:provider[@entityID = $e/@entityID]
      return
	if (exists($existing))
	then
          let $new :=
	    <csd:provider entityID="{$e/@entityID}">
	      {$existing/csd:otherID}
	      {$e/*}
	    </csd:provider>
	  return replace node $existing with $new
        else if ($insertNew) then insert node $e into $dest_dir else ()
    ,
    let $src_dir := $src_doc/csd:CSD/csd:serviceDirectory
    let $dest_dir := $dest_doc/csd:CSD/csd:serviceDirectory
    return
      for $e in $src_dir/csd:service
      let $existing := $dest_dir/csd:service[@entityID = $e/@entityID]
      return
	if (exists($existing))
	then
          let $new :=
	    <csd:service entityID="{$e/@entityID}">
	      {$existing/csd:otherID}
	      {$e/*}
	    </csd:service>
	  return replace node $existing with $new
        else if ($insertNew) then insert node $e into $dest_dir else ()
    ,
    let $src_dir := $src_doc/csd:CSD/csd:facilityDirectory
    let $dest_dir := $dest_doc/csd:CSD/csd:facilityDirectory
    return
      for $e in $src_dir/csd:facility
      let $existing := $dest_dir/csd:facility[@entityID = $e/@entityID]
      return
	if (exists($existing))
	then
          let $new :=
	    <csd:facility entityID="{$e/@entityID}">
	      {$existing/csd:otherID}
	      {$e/*}
	    </csd:facility>
	  return replace node $existing with $new
        else if ($insertNew) then insert node $e into $dest_dir else ()

    )

import module namespace csd_lsc = "https://github.com/openhie/openinfoman/csd_lsc";
import module namespace csd_dm = "https://github.com/openhie/openinfoman/csd_dm";
import module namespace csd_webconf =  "https://github.com/openhie/openinfoman/csd_webconf";
import module namespace functx = "http://www.functx.com";
declare namespace csd  =  "urn:ihe:iti:csd:2013";

declare variable $careServicesRequest as item() external;

let $dest_doc := /.
let $dest := $careServicesRequest/@resource
for $doc in $careServicesRequest/documents/document
  let $insertNew :=
    if (exists($doc/insertNew/@value))
    then ($doc/insertNew/@value = 1)
    else true()

  let $name := string($doc/@resource)
  let $src_doc :=
    if (not (functx:all-whitespace($name)))
    then if (not ($name = $dest)) then csd_dm:open_document( $name) else ()
    else $doc
  return
    (
    let $src_dir := $src_doc/csd:CSD/csd:organizationDirectory
    let $dest_dir := $dest_doc/csd:CSD/csd:organizationDirectory
    return
      for $e in $src_dir/csd:organization
      let $existing := $dest_dir/csd:organization[@entityID = $e/@entityID]
      return
	if (exists($existing))
        then
          let $new :=
	    <csd:organization entityID="{$e/@entityID}">
	      {$existing/csd:otherID}
	      {$e/*}
	    </csd:organization>
	  return replace node $existing with $new
        else if ($insertNew) then insert node $e into $dest_dir else ()
    ,
    let $src_dir := $src_doc/csd:CSD/csd:providerDirectory
    let $dest_dir := $dest_doc/csd:CSD/csd:providerDirectory
    return
      for $e in $src_dir/csd:provider
      let $existing := $dest_dir/csd:provider[@entityID = $e/@entityID]
      return
	if (exists($existing))
	then
          let $new :=
	    <csd:provider entityID="{$e/@entityID}">
	      {$existing/csd:otherID}
	      {$e/*}
	    </csd:provider>
	  return replace node $existing with $new
        else if ($insertNew) then insert node $e into $dest_dir else ()
    ,
    let $src_dir := $src_doc/csd:CSD/csd:serviceDirectory
    let $dest_dir := $dest_doc/csd:CSD/csd:serviceDirectory
    return
      for $e in $src_dir/csd:service
      let $existing := $dest_dir/csd:service[@entityID = $e/@entityID]
      return
	if (exists($existing))
	then
          let $new :=
	    <csd:service entityID="{$e/@entityID}">
	      {$existing/csd:otherID}
	      {$e/*}
	    </csd:service>
	  return replace node $existing with $new
        else if ($insertNew) then insert node $e into $dest_dir else ()
    ,
    let $src_dir := $src_doc/csd:CSD/csd:facilityDirectory
    let $dest_dir := $dest_doc/csd:CSD/csd:facilityDirectory
    return
      for $e in $src_dir/csd:facility
      let $existing := $dest_dir/csd:facility[@entityID = $e/@entityID]
      return
	if (exists($existing))
	then
          let $new :=
	    <csd:facility entityID="{$e/@entityID}">
	      {$existing/csd:otherID}
	      {$e/*}
	    </csd:facility>
	  return replace node $existing with $new
        else if ($insertNew) then insert node $e into $dest_dir else ()

    )


Fixed DTS Error Handling

Fixed DTS Error Handling

(:
 : Copyright (C) [2013] [The FURTHeR Project]
 :
 : 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.
 :)
xquery version "3.0";
module namespace frt = "http://further.utah.edu/result-translation";

(: Import FURTHeR Module :)
(: import module namespace further = "http://further.utah.edu/xquery-functions-module"
    at "further.xq"; :)
import module namespace further = 'http://further.utah.edu/xquery-functions-module'
    at '${server.mdr.ws}${path.mdr.ws.resource.path}/fqe/further/xq/further.xq';

(: Import FURTHeR Constants Module :)
(: import module namespace const = 'http://further.utah.edu/constants'
    at 'constants.xq'; :)
import module namespace const = 'http://further.utah.edu/constants'
    at '${server.mdr.ws}${path.mdr.ws.resource.path}/fqe/further/xq/constants.xq';

(: ALWAYS Define Namespaces in XQUERY PROLOG! :)
declare namespace fn  = 'http://www.w3.org/2005/xpath-functions';
declare namespace fq = "http://further.utah.edu/core/query";
declare namespace dts = 'http://further.utah.edu/dts';
declare namespace mdr = "http://further.utah.edu/mdr";
declare namespace xs = "http://www.w3.org/2001/XMLSchema";
declare namespace xsi = "http://www.w3.org/2001/XMLSchema-instance";
declare namespace fqe = 'http://further.utah.edu/fqe';
(: DO NOT USE DEFAULT NAMESPACE, it may conflict with the response Namespaces :)

(: Global CONSTANTS, Always Translating FROM FURTHeR Namespace ID :)
declare variable $frt:FURTHER as xs:string := '32769';
declare variable $frt:FURTHeR as xs:string := 'FURTHeR';

(: We are using SNOMED (Namespace ID 30) for ObservationType Values :)
declare variable $frt:SNOMED as xs:string := '30';

(: DTS Terminology Namespace IDs :)
declare variable $frt:OMOP-V2 as xs:string := '32868';
declare variable $frt:ICD-9 as xs:string := '10';
declare variable $frt:LOINC as xs:string := '5102';

(: Empty String Value for Substituting Empty Arguments to Functions :)
declare variable $frt:EMPTY as xs:string := '';

(: Mark Criterias that got Skipped :)
declare variable $frt:SKIP as xs:string := 'S';

(: Yes Value Used for Translation Flag transFlag :)
declare variable $frt:YES as xs:string := 'Y';

(: No Value Used for Translation Flag transFlag :)
declare variable $frt:NO as xs:string := 'N';

(: ERROR Value Used for Translation Flag transFlag :)
declare variable $frt:ERROR as xs:string := 'E';

(: Placeholder in case preTranslation Fails :)
declare variable $frt:ZERO as xs:string := '0';

(: DELIMITER :)
declare variable $frt:DELIMITER as xs:string := '^';

(: MDR Static Property Names CASE SENSITIVE! :)
declare variable $frt:ATTR_TRANS_FUNC as xs:string := 'ATTR_TRANS_FUNC';
declare variable $frt:ATTR_VALUE_TRANS_FUNC as xs:string := 'ATTR_VALUE_TRANS_FUNC';
declare variable $frt:ATTR_VALUE_TRANS_TO_DATA_TYPE as xs:string := 'ATTR_VALUE_TRANS_TO_DATA_TYPE';
declare variable $frt:CODING_SYSTEM as xs:string := 'CODING_SYSTEM';
declare variable $frt:EXT_PERSON as xs:string := 'EXT_PERSON';
declare variable $frt:EXT_ROOT_ID_ATTR as xs:string := 'EXT_ROOT_ID_ATTR';

declare variable $frt:pickMe as xs:string := 'pickMe';
declare variable $frt:skipATTR as xs:string := 'skipAttr';
declare variable $frt:translateCode as xs:string := 'translateCode';
declare variable $frt:ageToBirthYear as xs:string := 'ageToBirthYear';

(: DTS Static Property Names CASE SENSITIVE! :)
declare variable $frt:CodeInSource as xs:string := 'Code in Source';
declare variable $frt:LocalCode as xs:string := 'Local Code';

(:==================================================================:)
(: Main Translate Result Function                                   :)
(: Our Goal here is to construct the Target Central Model           :)
(:==================================================================:)
declare function frt:transResult($inputXML as document-node(),
                                 $extNmspcId as xs:string,
                                 $dataSetId as xs:string)
{

  (: Get the Namespace Name Using the Namespace ID :)
  let $extNmspcName := further:getNamespaceName($extNmspcId)

  (: Must Keep this Order of Processing :)

  (: Create Empty Person Template :)
  let $emptyPerson := frt:createPersonTemplate($extNmspcName)

  (: Initialize Empty Person Template with MDR Properties :)
  let $mdrPerson := frt:initPersonTemplate($emptyPerson,$extNmspcName)

  return

    (: Validate Initialized Template :)
    if ($mdrPerson/*[@extRootObject=$frt:ERROR]) then

		  (: Error Handling :)
		  frt:validateTemplate($mdrPerson,$extNmspcName)

    else (: Continue Processing :)

		  (: Read the Input File from External Result for Processing :)
		  let $transResult := frt:process($mdrPerson,$inputXML,$extNmspcId,$dataSetId)

		  (: Error Handling :)
		  let $validated := frt:validate($transResult,$extNmspcName)

		  (: Call cleanup Transformation :)
		  let $cleaned := frt:cleanup($validated)

		  (: Return Final Cleaned Version :)
		  return $cleaned

};

(:==================================================================:)
(: createPersonTemplate = Create Person Template XML Format         :)
(:==================================================================:)
declare function frt:createPersonTemplate($extNmspcName as xs:string)
as document-node()
{

(: Create a Document Type Here! :)
document
{
  <Person centralRootObject="{$frt:EMPTY}" extRootObject="{$frt:EMPTY}">
    <id></id>
    <administrativeGenderNamespaceId>{$frt:SNOMED}</administrativeGenderNamespaceId>
    <administrativeGender extPath="{$frt:EMPTY}" dtsTerm="{$frt:SNOMED}" dtsFlag="{$frt:EMPTY}"></administrativeGender>
    <raceNamespaceId>{$frt:SNOMED}</raceNamespaceId>
    <race extPath="{$frt:EMPTY}" dtsTerm="{$frt:SNOMED}" dtsFlag="{$frt:EMPTY}"></race>
    <ethnicityNamespaceId>{$frt:SNOMED}</ethnicityNamespaceId>
    <ethnicity extPath="{$frt:EMPTY}" dtsTerm="{$frt:SNOMED}" dtsFlag="{$frt:EMPTY}"></ethnicity>
    <dateOfBirth extPath="{$frt:EMPTY}"></dateOfBirth>
    <birthYear extPath="{$frt:EMPTY}"></birthYear>
    <birthMonth extPath="{$frt:EMPTY}"></birthMonth>
    <birthDay extPath="{$frt:EMPTY}"></birthDay>
    <educationLevel extPath="{$frt:EMPTY}"></educationLevel>
    <primaryLanguageNamespaceId>{$frt:SNOMED}</primaryLanguageNamespaceId>
    <primaryLanguage extPath="{$frt:EMPTY}" dtsTerm="{$frt:SNOMED}" dtsFlag="{$frt:EMPTY}"></primaryLanguage>
    <maritalStatusNamespaceId>{$frt:SNOMED}</maritalStatusNamespaceId>
    <maritalStatus extPath="{$frt:EMPTY}" dtsTerm="{$frt:SNOMED}" dtsFlag="{$frt:EMPTY}"></maritalStatus>
    <religionNamespaceId>{$frt:SNOMED}</religionNamespaceId>
    <religion extPath="{$frt:EMPTY}" dtsTerm="{$frt:SNOMED}" dtsFlag="{$frt:EMPTY}"></religion>
    <multipleBirthIndicator extPath="{$frt:EMPTY}"></multipleBirthIndicator>
    <multipleBirthIndicatorOrderNumber extPath="{$frt:EMPTY}"></multipleBirthIndicatorOrderNumber>
    <causeOfDeathNamespaceId>{$frt:SNOMED}</causeOfDeathNamespaceId>
    <causeOfDeath extPath="{$frt:EMPTY}" dtsTerm="{$frt:SNOMED}" dtsFlag="{$frt:EMPTY}"></causeOfDeath>
    <dateOfDeath extPath="{$frt:EMPTY}"></dateOfDeath>
    <deathYear extPath="{$frt:EMPTY}"></deathYear>
    <pedigreeQuality extPath="{$frt:EMPTY}"></pedigreeQuality>
  </Person>
}

(: END Function :)
};

(:==================================================================:)
(: initPersonTemplate = Create Person Template XML Format           :)
(:==================================================================:)
declare function frt:initPersonTemplate($emptyPerson as document-node(),
                                        $extNmspcName as xs:string)
as document-node()
{

(: BEGIN XQUERY TRANSFORMATION :)
(: Make a copy of the entire Document :)
copy $inputCopy := $emptyPerson
modify (

  (: Find the Central Root Object :)
  (: The Name of the Root Element is the Name of the Central Root Object :)
  let $centralRootObject := fn:name($inputCopy/child::node())
  return (

    (: Set the Central Root Object XML Attribute :)
    replace value of node $inputCopy//@centralRootObject with $centralRootObject

    , (: DO MORE STUFF :)

    (: Find the External Root Object to Use as a Reference Point for External XML Doc :)
    let $extRootObject := frt:getExtRootObject($centralRootObject,$extNmspcName)
    return
      replace value of node $inputCopy//@extRootObject with $extRootObject

    , (: DO MORE STUFF :)

    (: Populate the extPath XML Attributes in the Template from MDR :)
    for $centralAttr in $inputCopy//*[@extPath=$frt:EMPTY]
      let $extPath := frt:getExtPath(name($centralAttr),$frt:FURTHeR,$extNmspcName)
      return replace value of node $centralAttr/@extPath with $extPath

    , (: DO MORE STUFF :)

    (: Set DTS Translation Instruction from MDR :)
    for $dtsAttr in $inputCopy//*[@dtsFlag]
      let $dtsFlag := frt:getDTSFlag(name($dtsAttr),$frt:FURTHeR,$extNmspcName)
      return replace value of node $dtsAttr/@dtsFlag with $dtsFlag

  ) (: End Return :)

) (: End Modify :)
return $inputCopy

(: END Function :)
};

(:==================================================================:)
(: validateTemplate (Error Handling)                                :)
(:==================================================================:)
declare function frt:validateTemplate($inputXML,$srcNmspcName as xs:string)
as document-node()
{

(: BEGIN XQUERY TRANSFORMATION :)
(: Make a copy of the entire Document :)
copy $inputCopy := $inputXML
modify (

  if ($inputCopy/*[@extRootObject=$frt:ERROR]) then

    (: Get Name of the XML Root Node (Central Root Object) :)
    let $attrName := fn:name($inputCopy/*[@extRootObject=$frt:ERROR])
    return
    (: replace ONLY Works when we are Referring to a Document Type (NOT Element Type) :)
    replace node $inputCopy/*
       with
       <error xmlns="http://further.utah.edu/core/ws">
         MDR_RESULT_TRANSLATION_ERROR
         <message>MDR Association for [ {$srcNmspcName}.{$attrName} ] May be Missing</message>
       </error>

  else ()

) (: End Modify :)
return $inputCopy

(: END Function :)
};

(:==================================================================:)
(: process = Processing Function                                    :)
(:==================================================================:)
declare function frt:process($mdrPerson,$extXML,$extNmspcId,$dataSetId)
{

  (: High Level WorkFlow
	  1) Find the rootObject in the External Model by using the extRootObject Attribute Hint
	  2) For each rootObject in the External Model, create a mdrPerson Node and populate it with DTS Translated Data
	  3) Replace the <id> node with getPersonId function
	  4) Place the full result in a <ResultList> node
  :)

  (: Get External Root Object :)
  let $extRootObject := fn:substring-before($mdrPerson//@extRootObject,$frt:DELIMITER)

  (: Loop to Return ALL External Root Objects :)
  return
  <ResultList>
    {
      for $extRoot at $i in $extXML/ResultList/*[fn:name()=$extRootObject]
      (: debug
         return $extRootObject :)
      return frt:transPerson($mdrPerson,$extRoot,$extNmspcId,$dataSetId)
    }
  </ResultList>

(: END Function :)
};

(:==================================================================:)
(: transPerson = Translate Single Person                            :)
(:==================================================================:)
declare function frt:transPerson($mdrPerson,$extPerson,$extNmspcId,$dataSetId)
as document-node()
{

(:
1) Get Data from External Input File and Populate our Template
2) Get DTS Translated Data if necessary
3) Replace the <id> node with getPersonId function
:)

(: BEGIN XQUERY TRANSFORMATION :)
copy $transFields := $mdrPerson
modify (

  (: Get Data from External Person :)
  for $field in $transFields//*[@extPath != $frt:EMPTY]
    (: Get the External Field Value using Dynamic Evaluation Function :)
    (: Full Path should be starting from under the rootObject node :)
    (: Create a String to represent the Full Document Path :)
    let $s := concat("$doc",$field/@extPath)
    (: Evaluate the String with a mapping to the document/element :)
    (: Took long time to figure this out, it is amazing when it works! :)
    let $extValue := xquery:eval($s,map {"doc" := $extPerson})
    let $cnt := fn:count($extValue)
    return (
	    if ( $cnt > 1 ) then
		    insert node attribute multiError {$cnt} into $field
	      else
        replace value of node $field with $extValue
    )

) (: End Modify :)
return

(: BEGIN XQUERY TRANSFORMATION :)
copy $transDTS := $transFields
modify (

  (: Get Data from External Person :)
  for $field in $transDTS//*[@dtsFlag=$frt:translateCode]

    let $dtsSrcPropVal := $field/text()
    let $tgTerm := $field/@dtsTerm

    (: Call DTS :)
    let $dtsResponse := further:getTranslatedConcept($extNmspcId,
                                                     $frt:LocalCode,
                                                     $dtsSrcPropVal,
                                                     $tgTerm,
                                                     $frt:CodeInSource)
    (: DEBUG DTS URL :)
    (: let $dtsURL := further:getConceptTranslationRestUrl($extNmspcId,
                                                        $frt:LocalCode,
                                                        $dtsSrcPropVal,
                                                        $tgTerm,
                                                        $frt:CodeInSource) :)

    (: Get Translated Value :)
    let $translatedPropVal := further:getConceptPropertyValue($dtsResponse)

    return
      if ($translatedPropVal) then (
        replace value of node $field with $translatedPropVal
        ,
        replace value of node $field/@dtsFlag with $frt:YES
      )
      else
        (: Always return Error if there is no DTS Mapping :)
        replace value of node $field/@dtsFlag with $frt:ERROR

) (: End Modify :)
return

(: BEGIN XQUERY TRANSFORMATION :)
copy $transRootId := $transDTS
modify (

  (: Find the External Root Object & Root Object Attr :)
  let $extRootObject := fn:substring-before($transRootId//@extRootObject,$frt:DELIMITER)
  let $extRootObjectAttr := fn:substring-after($transRootId//@extRootObject,$frt:DELIMITER)
  return
    replace node $transRootId//id
       with frt:getPersonId($extNmspcId,$extPerson,$extRootObject,$extRootObjectAttr,$dataSetId)

) (: End Modify :)
return $transRootId

(: END Function :)
};

(:==================================================================:)
(: Validate (Error Handling)                                        :)
(:==================================================================:)
declare function frt:validate($inputXML,$srcNmspcName as xs:string)
{
(: BEGIN XQUERY TRANSFORMATION :)
(: Make a copy of the entire Document :)
copy $inputCopy := $inputXML
modify (

  (: Error out ONLY the FIRST criteria AttributeName :)
  (: This will ensure that the output xml is valid since there is no outter <errors> node at this time :)
  (: It will also prevent us from having a very long list of errors :)
  (: Within the for statement, be sure to use the parentheses after the in clause.
     Therefore, the position predicate[1] will function properly.
     if we take out the parentheses and the [1], we will list the all criterias with error.
     which we may want in the future. :)

  if ($inputCopy//*[@dtsFlag=$frt:ERROR]) then (

    (: Return the First Criteria that Errored so we do not have a long list of Errors :)
    for $field in ($inputCopy//*[@dtsFlag=$frt:ERROR])[1]
    let $attrName := fn:name($field)
      return
      replace node $inputCopy/*
         with
         <error xmlns="http://further.utah.edu/core/ws">
           DTS_RESULT_TRANSLATION_ERROR
           <message>DTS Mapping for [ {$srcNmspcName}.{$attrName} ] May be Missing</message>
         </error>
  )
  else(
    (: Remove ALL Nodes that have been Marked to be SKIPPED :)
    delete node $inputCopy//*[@extPath=$frt:SKIP]
  ) (: End IF-Else Statement :)

) (: End Modify :)
return $inputCopy

(: END Function :)
};

(:==================================================================:)
(: Cleanup                                                          :)
(:==================================================================:)
declare function frt:cleanup($inputXML)
{

(: BEGIN XQUERY TRANSFORMATION :)
copy $inputCopy1 := $inputXML
modify (

  (: Remove ALL Empty Data Nodes :)
  for $node in $inputCopy1//*[@extPath=$frt:EMPTY]
    return delete node $node

  , (: Delete ALL tranFlag Attributes on SUCCESS :)
  delete node $inputCopy1//@extRootObject,
  delete node $inputCopy1//@centralRootObject,
  delete node $inputCopy1//@extPath,
  delete node $inputCopy1//@dtsTerm,
  delete node $inputCopy1//@dtsFlag

) (: End Modify :)
return

(: BEGIN XQUERY TRANSFORMATION :)
copy $inputCopy2 := $inputCopy1
modify (

  (: Remove ALL Empty Namespace Nodes :)
	(: Loop through Each Person rootObject :)
	for $person in $inputCopy2/Person

	  (: For ALL Namespace Nodes :)
	  for $nmspcNode in $person//*[fn:contains(fn:name(),'NamespaceId')]

	    (: Get the coresponding data node name :)
	    let $dataNodeName := fn:substring-before(fn:name($nmspcNode),'NamespaceId')

	    return (:insert node attribute debug {$dataNodeName} into $nmspcNode:)
	      (: Remove ALL Namespace Nodes if coresponding dataNode does NOT exist :)
        if (fn:not(fn:exists($person//*[fn:name()=$dataNodeName]))) then
	        delete node $nmspcNode
	      else()

) (: End Modify :)
return $inputCopy2

(: END Function :)
};

(:=====================================================================:)
(: Sanitize SINGLE & DOUBLE Quotes to Prevent XQuery Injection Attacks :)
(:=====================================================================:)
declare function frt:sanitize($inputXML as document-node())
as document-node()
{

(: Ideally, I want to replace all '&' characters with '&'
   However, BaseX does not allow me to have this character in the xml file or output.
   So I am skipping this for now :)

(: Transformation to replace Single Quotes with ''' :)
copy $inputCopy := $inputXML
modify (

  for $node at $i in $inputCopy//*[contains(text(),'''')]
  return
    replace value of node $node with replace($node, '''','&apos;')

) (: End Modify :)

return
(: Starting another Transformation, so the replace node will not conflict :)
(: Transformation to replace Double Quotes with '"' :)
copy $inputCopy2 := $inputCopy
modify (

  for $node at $i in $inputCopy2//*[contains(text(),"""")]
  return
    replace value of node $node with replace($node, """",'&quot;')

) (: End Modify :)
return $inputCopy2

}; (: END OF FUNCTION frt:sanitize :)

(:=====================================================================:)
(: getPersonId = Construct the group of Person ID Tags                 :)
(:=====================================================================:)
declare function frt:getPersonId($extNmspcId,$extPerson,$extRootObject,$extRootObjectAttr,$dataSetId)
{
  (: Get the External ID Value :)
  let $s := concat("$doc/",$extRootObjectAttr)

  (: Evaluate the String with a mapping to the document/element :)
  (: Took long time to figure this out, it is amazing when it works! :)
  let $extIdValue := xquery:eval($s,map {"doc" := $extPerson})

  let $cnt := fn:count($extIdValue)
  return (
	  if ( $cnt > 1 ) then
      <id multiError='{$cnt}'/>
	  else
		  (: Call Identity Resolution Service :)
		  (:
		    REST CAll FORMAT

		    http://demo.further.utah.edu:9000/fqe/mpi/rest/id/generate/
		    {target_object}/{target_attribute}/{source_namespace_id}/
		    {source_object}/{source_attribute}/{source_id_value}/{queryId}

		    Note:
		    For Result Translation, Target is always the Central Model (FURTHER Model)
		    The Source is the External Data Source Models

		    Examples:
http://demo.further.utah.edu:9000/fqe/mpi/rest/id/generate/PERSON/FPERSON_ID/32868/PERSON/PERSONID/12345/862c9130-0e89-11e3-bb9f-f23c91aec05e
http://demo.further.utah.edu:9000/fqe/mpi/rest/id/generate/PERSON/FPERSON_ID/32776/PATIENT/PAT_DE_ID/12345/862c9130-0e89-11e3-bb9f-f23c91aec05e
		  :)

      (: Built the REST URL :)
		  let $baseURL := fn:concat($const:fqeRestServer,'/mpi/rest/id/generate/PERSON/FPERSON_ID/')
		  let $docUrl := fn:concat($baseURL, $extNmspcId, '/', $extRootObject, '/' , $extRootObjectAttr , '/', $extIdValue , '/', $dataSetId)

		  (: Prevent XQuery Injection Attacks :)
		  let $parsedDocUrl := iri-to-uri($docUrl)
		  let $result := doc($parsedDocUrl)

		  (: Strip out the Person ID from the Result :)
		  (: let $resolvedPersonId := $result//fqe:value/text() :)
		  let $resolvedPersonId := $result/fqe:id/fqe:value/text()

		  return (

        (: DEBUG with trace :)
        (: trace($resolvedPersonId, 'ResolvedPersonID'), :)

				<id>
				  <datasetId>{$dataSetId}</datasetId>
		      <id>{$resolvedPersonId}</id>
			  </id>
			  ,
			  <compositeId>{$dataSetId}:{$resolvedPersonId}</compositeId>
		  )

  ) (: End of Return :)

}; (: END OF FUNCTION :)

(:==================================================================:)
(: getLeftAssoc = Get Left Assocation from MDR                      :)
(:==================================================================:)
declare function frt:getLeftAssoc(
                 $leftAttrName as xs:string,
                 $leftNmspcName as xs:string,
                 $rightNmspcName as xs:string)
{
  (: EXAMPLE: ${server.dts.ws}/mdr/rest/asset/association/left/translatesTo/genderConceptId :)
  (:          ${server.dts.ws}/mdr/rest/asset/association/left/translatesTo/{sourceAttr} :)
  (:          http://demo.further.utah.edu:9000/mdr/rest/asset/association/left/translatesTo/administrativeGender :)
  let $baseURL := fn:concat($const:fmdrRestServer,'/rest/asset/association/left/translatesTo/')
  let $docUrl := fn:concat( $baseURL, $leftAttrName )

  (: Prevent XQuery Injection Attacks :)
  let $parsedDocUrl := iri-to-uri( $docUrl )
  let $doc := doc($parsedDocUrl)

  (: Return the AssetAssociation for the Correct Namespaces :)
  return

    if (fn:count($doc//assetAssociation[rightNamespace=$rightNmspcName and leftNamespace=$leftNmspcName]) > 1) then
      $doc//assetAssociation[rightNamespace=$rightNmspcName and leftNamespace=$leftNmspcName and properties/entry/value=$frt:pickMe]
    else
      $doc//assetAssociation[rightNamespace=$rightNmspcName and leftNamespace=$leftNmspcName]

};

(:==================================================================:)
(: getExtPath = GET XPath of XML Element in External XML from MDR   :)
(:==================================================================:)
declare function frt:getExtPath(
                 $leftAttrName as xs:string,
                 $leftNmspcName as xs:string,
                 $rightNmspcName as xs:string)
{
  let $leftAssoc := frt:getLeftAssoc($leftAttrName,$leftNmspcName,$rightNmspcName)

  (: Extract Out the External XPath Value :)
  for $entry in $leftAssoc/properties/entry[key='RESULT_PATH']
  return
    if ($entry) then $entry/value
    else $frt:EMPTY

};

(:==================================================================:)
(: getDTSFlag = GET DTS Instruction for External XML from MDR       :)
(:==================================================================:)
declare function frt:getDTSFlag(
                 $leftAttrName as xs:string,
                 $leftNmspcName as xs:string,
                 $rightNmspcName as xs:string)
{
  let $leftAssoc := frt:getLeftAssoc($leftAttrName,$leftNmspcName,$rightNmspcName)

  (: Extract Out the External XPath Value :)
  for $entry in $leftAssoc/properties/entry[key=$frt:ATTR_VALUE_TRANS_FUNC]
  return
    if ($entry) then $entry/value
    else $frt:EMPTY

};

(:==================================================================:)
(: getExtRootObject = GET External rootObject from MDR              :)
(:==================================================================:)
declare function frt:getExtRootObject(
                 $centralRootObject as xs:string,
                 $extNmspcName as xs:string
                 )
{

  let $leftAssoc := frt:getLeftAssoc($centralRootObject,$frt:FURTHeR,$extNmspcName)

  return

    (: if there is an Association Result :)
    if ($leftAssoc/properties/entry[key=$frt:EXT_ROOT_ID_ATTR]) then

      (: Get the External Root Object:)
      let $extRootObject := $leftAssoc/rightAsset/text()

      (: Get the External Root Object ID Attribute :)
      let $extRootObjectAttr :=
        for $entry in $leftAssoc/properties/entry[key=$frt:EXT_ROOT_ID_ATTR]
          return $entry/value/text()

      (: Return Concatenated String :)
      return concat($extRootObject,$frt:DELIMITER,$extRootObjectAttr)

    else $frt:ERROR

};

(:==================================================================:)
(: printDebug = Print Debug Variable to Query Info Screen           :)
(:==================================================================:)
declare function frt:printDebug($debugVar,$msg as xs:string?)
{
  let $var := $debugVar
  return fn:trace( $var,concat('DEBUG ', $msg, '=') )
};

(:==================================================================:)
(: ageToBirthYear = Translate Age to BirthYear                      :)
(:==================================================================:)
declare function frt:ageToBirthYear($age)
{
  (: Get Current Year :)
  let $curYear := year-from-date(current-date())

  (: Subtract Age from CurrentYear to Get BirthYear :)
  return $curYear - $age
};

(: END OF MODULE :)

(:
 : Copyright (C) [2013] [The FURTHeR Project]
 :
 : 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.
 :)
xquery version "3.0";
module namespace frt = "http://further.utah.edu/result-translation";

(: Import FURTHeR Module :)
(: import module namespace further = "http://further.utah.edu/xquery-functions-module"
    at "further.xq"; :)
import module namespace further = 'http://further.utah.edu/xquery-functions-module'
    at '${server.mdr.ws}${path.mdr.ws.resource.path}/fqe/further/xq/further.xq';

(: Import FURTHeR Constants Module :)
(: import module namespace const = 'http://further.utah.edu/constants'
    at 'constants.xq'; :)
import module namespace const = 'http://further.utah.edu/constants'
    at '${server.mdr.ws}${path.mdr.ws.resource.path}/fqe/further/xq/constants.xq';

(: ALWAYS Define Namespaces in XQUERY PROLOG! :)
declare namespace fn  = 'http://www.w3.org/2005/xpath-functions';
declare namespace fq = "http://further.utah.edu/core/query";
declare namespace dts = 'http://further.utah.edu/dts';
declare namespace mdr = "http://further.utah.edu/mdr";
declare namespace xs = "http://www.w3.org/2001/XMLSchema";
declare namespace xsi = "http://www.w3.org/2001/XMLSchema-instance";
declare namespace fqe = 'http://further.utah.edu/fqe';
(: DO NOT USE DEFAULT NAMESPACE, it may conflict with the response Namespaces :)

(: Global CONSTANTS, Always Translating FROM FURTHeR Namespace ID :)
declare variable $frt:FURTHER as xs:string := '32769';
declare variable $frt:FURTHeR as xs:string := 'FURTHeR';

(: We are using SNOMED (Namespace ID 30) for ObservationType Values :)
declare variable $frt:SNOMED as xs:string := '30';

(: DTS Terminology Namespace IDs :)
declare variable $frt:OMOP-V2 as xs:string := '32868';
declare variable $frt:ICD-9 as xs:string := '10';
declare variable $frt:LOINC as xs:string := '5102';

(: Empty String Value for Substituting Empty Arguments to Functions :)
declare variable $frt:EMPTY as xs:string := '';

(: Mark Criterias that got Skipped :)
declare variable $frt:SKIP as xs:string := 'S';

(: Yes Value Used for Translation Flag transFlag :)
declare variable $frt:YES as xs:string := 'Y';

(: No Value Used for Translation Flag transFlag :)
declare variable $frt:NO as xs:string := 'N';

(: ERROR Value Used for Translation Flag transFlag :)
declare variable $frt:ERROR as xs:string := 'E';

(: Placeholder in case preTranslation Fails :)
declare variable $frt:ZERO as xs:string := '0';

(: DELIMITER :)
declare variable $frt:DELIMITER as xs:string := '^';

(: MDR Static Property Names CASE SENSITIVE! :)
declare variable $frt:ATTR_TRANS_FUNC as xs:string := 'ATTR_TRANS_FUNC';
declare variable $frt:ATTR_VALUE_TRANS_FUNC as xs:string := 'ATTR_VALUE_TRANS_FUNC';
declare variable $frt:ATTR_VALUE_TRANS_TO_DATA_TYPE as xs:string := 'ATTR_VALUE_TRANS_TO_DATA_TYPE';
declare variable $frt:CODING_SYSTEM as xs:string := 'CODING_SYSTEM';
declare variable $frt:EXT_PERSON as xs:string := 'EXT_PERSON';
declare variable $frt:EXT_ROOT_ID_ATTR as xs:string := 'EXT_ROOT_ID_ATTR';

declare variable $frt:pickMe as xs:string := 'pickMe';
declare variable $frt:skipATTR as xs:string := 'skipAttr';
declare variable $frt:translateCode as xs:string := 'translateCode';
declare variable $frt:ageToBirthYear as xs:string := 'ageToBirthYear';

(: DTS Static Property Names CASE SENSITIVE! :)
declare variable $frt:CodeInSource as xs:string := 'Code in Source';
declare variable $frt:LocalCode as xs:string := 'Local Code';

(:==================================================================:)
(: Main Translate Result Function                                   :)
(: Our Goal here is to construct the Target Central Model           :)
(:==================================================================:)
declare function frt:transResult($inputXML as document-node(),
                                 $extNmspcId as xs:string,
                                 $dataSetId as xs:string)
{

  (: Get the Namespace Name Using the Namespace ID :)
  let $extNmspcName := further:getNamespaceName($extNmspcId)

  (: Must Keep this Order of Processing :)

  (: Create Empty Person Template :)
  let $emptyPerson := frt:createPersonTemplate($extNmspcName)

  (: Initialize Empty Person Template with MDR Properties :)
  let $mdrPerson := frt:initPersonTemplate($emptyPerson,$extNmspcName)

  return

    (: Validate Initialized Template :)
    if ($mdrPerson/*[@extRootObject=$frt:ERROR]) then

		  (: Error Handling :)
		  frt:validateTemplate($mdrPerson,$extNmspcName)

    else (: Continue Processing :)

		  (: Read the Input File from External Result for Processing :)
		  let $transResult := frt:process($mdrPerson,$inputXML,$extNmspcId,$dataSetId)

		  (: Error Handling :)
		  let $validated := frt:validate($transResult,$extNmspcName)

		  (: Call cleanup Transformation :)
		  let $cleaned := frt:cleanup($validated)

		  (: Return Final Cleaned Version :)
		  return $cleaned

};

(:==================================================================:)
(: createPersonTemplate = Create Person Template XML Format         :)
(:==================================================================:)
declare function frt:createPersonTemplate($extNmspcName as xs:string)
as document-node()
{

(: Create a Document Type Here! :)
document
{
  <Person centralRootObject="{$frt:EMPTY}" extRootObject="{$frt:EMPTY}">
    <id></id>
    <administrativeGenderNamespaceId>{$frt:SNOMED}</administrativeGenderNamespaceId>
    <administrativeGender extPath="{$frt:EMPTY}" dtsTerm="{$frt:SNOMED}" dtsFlag="{$frt:EMPTY}"></administrativeGender>
    <raceNamespaceId>{$frt:SNOMED}</raceNamespaceId>
    <race extPath="{$frt:EMPTY}" dtsTerm="{$frt:SNOMED}" dtsFlag="{$frt:EMPTY}"></race>
    <ethnicityNamespaceId>{$frt:SNOMED}</ethnicityNamespaceId>
    <ethnicity extPath="{$frt:EMPTY}" dtsTerm="{$frt:SNOMED}" dtsFlag="{$frt:EMPTY}"></ethnicity>
    <dateOfBirth extPath="{$frt:EMPTY}"></dateOfBirth>
    <birthYear extPath="{$frt:EMPTY}"></birthYear>
    <birthMonth extPath="{$frt:EMPTY}"></birthMonth>
    <birthDay extPath="{$frt:EMPTY}"></birthDay>
    <educationLevel extPath="{$frt:EMPTY}"></educationLevel>
    <primaryLanguageNamespaceId>{$frt:SNOMED}</primaryLanguageNamespaceId>
    <primaryLanguage extPath="{$frt:EMPTY}" dtsTerm="{$frt:SNOMED}" dtsFlag="{$frt:EMPTY}"></primaryLanguage>
    <maritalStatusNamespaceId>{$frt:SNOMED}</maritalStatusNamespaceId>
    <maritalStatus extPath="{$frt:EMPTY}" dtsTerm="{$frt:SNOMED}" dtsFlag="{$frt:EMPTY}"></maritalStatus>
    <religionNamespaceId>{$frt:SNOMED}</religionNamespaceId>
    <religion extPath="{$frt:EMPTY}" dtsTerm="{$frt:SNOMED}" dtsFlag="{$frt:EMPTY}"></religion>
    <multipleBirthIndicator extPath="{$frt:EMPTY}"></multipleBirthIndicator>
    <multipleBirthIndicatorOrderNumber extPath="{$frt:EMPTY}"></multipleBirthIndicatorOrderNumber>
    <causeOfDeathNamespaceId>{$frt:SNOMED}</causeOfDeathNamespaceId>
    <causeOfDeath extPath="{$frt:EMPTY}" dtsTerm="{$frt:SNOMED}" dtsFlag="{$frt:EMPTY}"></causeOfDeath>
    <dateOfDeath extPath="{$frt:EMPTY}"></dateOfDeath>
    <deathYear extPath="{$frt:EMPTY}"></deathYear>
    <pedigreeQuality extPath="{$frt:EMPTY}"></pedigreeQuality>
  </Person>
}

(: END Function :)
};

(:==================================================================:)
(: initPersonTemplate = Create Person Template XML Format           :)
(:==================================================================:)
declare function frt:initPersonTemplate($emptyPerson as document-node(),
                                        $extNmspcName as xs:string)
as document-node()
{

(: BEGIN XQUERY TRANSFORMATION :)
(: Make a copy of the entire Document :)
copy $inputCopy := $emptyPerson
modify (

  (: Find the Central Root Object :)
  (: The Name of the Root Element is the Name of the Central Root Object :)
  let $centralRootObject := fn:name($inputCopy/child::node())
  return (

    (: Set the Central Root Object XML Attribute :)
    replace value of node $inputCopy//@centralRootObject with $centralRootObject

    , (: DO MORE STUFF :)

    (: Find the External Root Object to Use as a Reference Point for External XML Doc :)
    let $extRootObject := frt:getExtRootObject($centralRootObject,$extNmspcName)
    return
      replace value of node $inputCopy//@extRootObject with $extRootObject

    , (: DO MORE STUFF :)

    (: Populate the extPath XML Attributes in the Template from MDR :)
    for $centralAttr in $inputCopy//*[@extPath=$frt:EMPTY]
      let $extPath := frt:getExtPath(name($centralAttr),$frt:FURTHeR,$extNmspcName)
      return replace value of node $centralAttr/@extPath with $extPath

    , (: DO MORE STUFF :)

    (: Set DTS Translation Instruction from MDR :)
    for $dtsAttr in $inputCopy//*[@dtsFlag]
      let $dtsFlag := frt:getDTSFlag(name($dtsAttr),$frt:FURTHeR,$extNmspcName)
      return replace value of node $dtsAttr/@dtsFlag with $dtsFlag

  ) (: End Return :)

) (: End Modify :)
return $inputCopy

(: END Function :)
};

(:==================================================================:)
(: validateTemplate (Error Handling)                                :)
(:==================================================================:)
declare function frt:validateTemplate($inputXML,$srcNmspcName as xs:string)
as document-node()
{

(: BEGIN XQUERY TRANSFORMATION :)
(: Make a copy of the entire Document :)
copy $inputCopy := $inputXML
modify (

  if ($inputCopy/*[@extRootObject=$frt:ERROR]) then

    (: Get Name of the XML Root Node (Central Root Object) :)
    let $attrName := fn:name($inputCopy/*[@extRootObject=$frt:ERROR])
    return
    (: replace ONLY Works when we are Referring to a Document Type (NOT Element Type) :)
    replace node $inputCopy/*
       with
       <error xmlns="http://further.utah.edu/core/ws">
         MDR_RESULT_TRANSLATION_ERROR
         <message>MDR Association for [ {$srcNmspcName}.{$attrName} ] May be Missing</message>
       </error>

  else ()

) (: End Modify :)
return $inputCopy

(: END Function :)
};

(:==================================================================:)
(: process = Processing Function                                    :)
(:==================================================================:)
declare function frt:process($mdrPerson,$extXML,$extNmspcId,$dataSetId)
{

  (: High Level WorkFlow
	  1) Find the rootObject in the External Model by using the extRootObject Attribute Hint
	  2) For each rootObject in the External Model, create a mdrPerson Node and populate it with DTS Translated Data
	  3) Replace the <id> node with getPersonId function
	  4) Place the full result in a <ResultList> node
  :)

  (: Get External Root Object :)
  let $extRootObject := fn:substring-before($mdrPerson//@extRootObject,$frt:DELIMITER)

  (: Loop to Return ALL External Root Objects :)
  return
  <ResultList>
    {
      for $extRoot at $i in $extXML/ResultList/*[fn:name()=$extRootObject]
      (: debug
         return $extRootObject :)
      return frt:transPerson($mdrPerson,$extRoot,$extNmspcId,$dataSetId)
    }
  </ResultList>

(: END Function :)
};

(:==================================================================:)
(: transPerson = Translate Single Person                            :)
(:==================================================================:)
declare function frt:transPerson($mdrPerson,$extPerson,$extNmspcId,$dataSetId)
as document-node()
{

(:
1) Get Data from External Input File and Populate our Template
2) Get DTS Translated Data if necessary
3) Replace the <id> node with getPersonId function
:)

(: BEGIN XQUERY TRANSFORMATION :)
copy $transFields := $mdrPerson
modify (

  (: Get Data from External Person :)
  for $field in $transFields//*[@extPath != $frt:EMPTY]
    (: Get the External Field Value using Dynamic Evaluation Function :)
    (: Full Path should be starting from under the rootObject node :)
    (: Create a String to represent the Full Document Path :)
    let $s := concat("$doc",$field/@extPath)
    (: Evaluate the String with a mapping to the document/element :)
    (: Took long time to figure this out, it is amazing when it works! :)
    let $extValue := xquery:eval($s,map {"doc" := $extPerson})
    let $cnt := fn:count($extValue)
    return (
	    if ( $cnt > 1 ) then
		    insert node attribute multiError {$cnt} into $field
	      else
        replace value of node $field with $extValue
    )

) (: End Modify :)
return

(: BEGIN XQUERY TRANSFORMATION :)
copy $transDTS := $transFields
modify (

  (: Get Data from External Person :)
  for $field in $transDTS//*[@dtsFlag=$frt:translateCode]

    let $dtsSrcPropVal := $field/text()
    let $tgTerm := $field/@dtsTerm

    (: Call DTS :)
    let $dtsResponse := further:getTranslatedConcept($extNmspcId,
                                                     $frt:LocalCode,
                                                     $dtsSrcPropVal,
                                                     $tgTerm,
                                                     $frt:CodeInSource)
    (: DEBUG DTS URL :)
    (: let $dtsURL := further:getConceptTranslationRestUrl($extNmspcId,
                                                        $frt:LocalCode,
                                                        $dtsSrcPropVal,
                                                        $tgTerm,
                                                        $frt:CodeInSource) :)

    (: Get Translated Value :)
    let $translatedPropVal := further:getConceptPropertyValue($dtsResponse)

    return
      if ($translatedPropVal) then (
        replace value of node $field with $translatedPropVal
        ,
        replace value of node $field/@dtsFlag with $frt:YES
      )
      else
        (: Always return Error if there is no DTS Mapping :)
        replace value of node $field/@dtsFlag with $frt:ERROR

) (: End Modify :)
return

(: BEGIN XQUERY TRANSFORMATION :)
copy $transRootId := $transDTS
modify (

  (: Find the External Root Object & Root Object Attr :)
  let $extRootObject := fn:substring-before($transRootId//@extRootObject,$frt:DELIMITER)
  let $extRootObjectAttr := fn:substring-after($transRootId//@extRootObject,$frt:DELIMITER)
  return
    replace node $transRootId//id
       with frt:getPersonId($extNmspcId,$extPerson,$extRootObject,$extRootObjectAttr,$dataSetId)

) (: End Modify :)
return $transRootId

(: END Function :)
};

(:==================================================================:)
(: Validate (Error Handling)                                        :)
(:==================================================================:)
declare function frt:validate($inputXML,$srcNmspcName as xs:string)
{
(: BEGIN XQUERY TRANSFORMATION :)
(: Make a copy of the entire Document :)
copy $inputCopy := $inputXML
modify (

  (: Error out ONLY the FIRST criteria AttributeName :)
  (: This will ensure that the output xml is valid since there is no outter <errors> node at this time :)
  (: It will also prevent us from having a very long list of errors :)
  (: Within the for statement, be sure to use the parentheses after the in clause.
     Therefore, the position predicate[1] will function properly.
     if we take out the parentheses and the [1], we will list the all criterias with error.
     which we may want in the future. :)

  if ($inputCopy//*[@dtsFlag=$frt:ERROR]) then (

    (: Return the First Criteria that Errored so we do not have a long list of Errors :)
    for $field in ($inputCopy//*[@dtsFlag=$frt:NO])[1]
    let $attrName := fn:name($field)
      return
      replace node $inputCopy/*
         with
         <error xmlns="http://further.utah.edu/core/ws">
           DTS_RESULT_TRANSLATION_ERROR
           <message>DTS Mapping for [ {$srcNmspcName}.{$attrName} ] May be Missing</message>
         </error>
  )
  else(
    (: Remove ALL Nodes that have been Marked to be SKIPPED :)
    delete node $inputCopy//*[@extPath=$frt:SKIP]
  ) (: End IF-Else Statement :)

) (: End Modify :)
return $inputCopy

(: END Function :)
};

(:==================================================================:)
(: Cleanup                                                          :)
(:==================================================================:)
declare function frt:cleanup($inputXML)
{

(: BEGIN XQUERY TRANSFORMATION :)
copy $inputCopy1 := $inputXML
modify (

  (: Remove ALL Empty Data Nodes :)
  for $node in $inputCopy1//*[@extPath=$frt:EMPTY]
    return delete node $node

  , (: Delete ALL tranFlag Attributes on SUCCESS :)
  delete node $inputCopy1//@extRootObject,
  delete node $inputCopy1//@centralRootObject,
  delete node $inputCopy1//@extPath,
  delete node $inputCopy1//@dtsTerm,
  delete node $inputCopy1//@dtsFlag

) (: End Modify :)
return

(: BEGIN XQUERY TRANSFORMATION :)
copy $inputCopy2 := $inputCopy1
modify (

  (: Remove ALL Empty Namespace Nodes :)
	(: Loop through Each Person rootObject :)
	for $person in $inputCopy2/Person

	  (: For ALL Namespace Nodes :)
	  for $nmspcNode in $person//*[fn:contains(fn:name(),'NamespaceId')]

	    (: Get the coresponding data node name :)
	    let $dataNodeName := fn:substring-before(fn:name($nmspcNode),'NamespaceId')

	    return (:insert node attribute debug {$dataNodeName} into $nmspcNode:)
	      (: Remove ALL Namespace Nodes if coresponding dataNode does NOT exist :)
        if (fn:not(fn:exists($person//*[fn:name()=$dataNodeName]))) then
	        delete node $nmspcNode
	      else()

) (: End Modify :)
return $inputCopy2

(: END Function :)
};

(:=====================================================================:)
(: Sanitize SINGLE & DOUBLE Quotes to Prevent XQuery Injection Attacks :)
(:=====================================================================:)
declare function frt:sanitize($inputXML as document-node())
as document-node()
{

(: Ideally, I want to replace all '&' characters with '&'
   However, BaseX does not allow me to have this character in the xml file or output.
   So I am skipping this for now :)

(: Transformation to replace Single Quotes with ''' :)
copy $inputCopy := $inputXML
modify (

  for $node at $i in $inputCopy//*[contains(text(),'''')]
  return
    replace value of node $node with replace($node, '''','&apos;')

) (: End Modify :)

return
(: Starting another Transformation, so the replace node will not conflict :)
(: Transformation to replace Double Quotes with '"' :)
copy $inputCopy2 := $inputCopy
modify (

  for $node at $i in $inputCopy2//*[contains(text(),"""")]
  return
    replace value of node $node with replace($node, """",'&quot;')

) (: End Modify :)
return $inputCopy2

}; (: END OF FUNCTION frt:sanitize :)

(:=====================================================================:)
(: getPersonId = Construct the group of Person ID Tags                 :)
(:=====================================================================:)
declare function frt:getPersonId($extNmspcId,$extPerson,$extRootObject,$extRootObjectAttr,$dataSetId)
{
  (: Get the External ID Value :)
  let $s := concat("$doc/",$extRootObjectAttr)

  (: Evaluate the String with a mapping to the document/element :)
  (: Took long time to figure this out, it is amazing when it works! :)
  let $extIdValue := xquery:eval($s,map {"doc" := $extPerson})

  let $cnt := fn:count($extIdValue)
  return (
	  if ( $cnt > 1 ) then
      <id multiError='{$cnt}'/>
	  else
		  (: Call Identity Resolution Service :)
		  (:
		    REST CAll FORMAT

		    http://demo.further.utah.edu:9000/fqe/mpi/rest/id/generate/
		    {target_object}/{target_attribute}/{source_namespace_id}/
		    {source_object}/{source_attribute}/{source_id_value}/{queryId}

		    Note:
		    For Result Translation, Target is always the Central Model (FURTHER Model)
		    The Source is the External Data Source Models

		    Examples:
http://demo.further.utah.edu:9000/fqe/mpi/rest/id/generate/PERSON/FPERSON_ID/32868/PERSON/PERSONID/12345/862c9130-0e89-11e3-bb9f-f23c91aec05e
http://demo.further.utah.edu:9000/fqe/mpi/rest/id/generate/PERSON/FPERSON_ID/32776/PATIENT/PAT_DE_ID/12345/862c9130-0e89-11e3-bb9f-f23c91aec05e
		  :)

      (: Built the REST URL :)
		  let $baseURL := fn:concat($const:fqeRestServer,'/mpi/rest/id/generate/PERSON/FPERSON_ID/')
		  let $docUrl := fn:concat($baseURL, $extNmspcId, '/', $extRootObject, '/' , $extRootObjectAttr , '/', $extIdValue , '/', $dataSetId)

		  (: Prevent XQuery Injection Attacks :)
		  let $parsedDocUrl := iri-to-uri($docUrl)
		  let $result := doc($parsedDocUrl)

		  (: Strip out the Person ID from the Result :)
		  (: let $resolvedPersonId := $result//fqe:value/text() :)
		  let $resolvedPersonId := $result/fqe:id/fqe:value/text()

		  return (

        (: DEBUG with trace :)
        (: trace($resolvedPersonId, 'ResolvedPersonID'), :)

				<id>
				  <datasetId>{$dataSetId}</datasetId>
		      <id>{$resolvedPersonId}</id>
			  </id>
			  ,
			  <compositeId>{$dataSetId}:{$resolvedPersonId}</compositeId>
		  )

  ) (: End of Return :)

}; (: END OF FUNCTION :)

(:==================================================================:)
(: getLeftAssoc = Get Left Assocation from MDR                      :)
(:==================================================================:)
declare function frt:getLeftAssoc(
                 $leftAttrName as xs:string,
                 $leftNmspcName as xs:string,
                 $rightNmspcName as xs:string)
{
  (: EXAMPLE: ${server.dts.ws}/mdr/rest/asset/association/left/translatesTo/genderConceptId :)
  (:          ${server.dts.ws}/mdr/rest/asset/association/left/translatesTo/{sourceAttr} :)
  (:          http://demo.further.utah.edu:9000/mdr/rest/asset/association/left/translatesTo/administrativeGender :)
  let $baseURL := fn:concat($const:fmdrRestServer,'/rest/asset/association/left/translatesTo/')
  let $docUrl := fn:concat( $baseURL, $leftAttrName )

  (: Prevent XQuery Injection Attacks :)
  let $parsedDocUrl := iri-to-uri( $docUrl )
  let $doc := doc($parsedDocUrl)

  (: Return the AssetAssociation for the Correct Namespaces :)
  return

    if (fn:count($doc//assetAssociation[rightNamespace=$rightNmspcName and leftNamespace=$leftNmspcName]) > 1) then
      $doc//assetAssociation[rightNamespace=$rightNmspcName and leftNamespace=$leftNmspcName and properties/entry/value=$frt:pickMe]
    else
      $doc//assetAssociation[rightNamespace=$rightNmspcName and leftNamespace=$leftNmspcName]

};

(:==================================================================:)
(: getExtPath = GET XPath of XML Element in External XML from MDR   :)
(:==================================================================:)
declare function frt:getExtPath(
                 $leftAttrName as xs:string,
                 $leftNmspcName as xs:string,
                 $rightNmspcName as xs:string)
{
  let $leftAssoc := frt:getLeftAssoc($leftAttrName,$leftNmspcName,$rightNmspcName)

  (: Extract Out the External XPath Value :)
  for $entry in $leftAssoc/properties/entry[key='RESULT_PATH']
  return
    if ($entry) then $entry/value
    else $frt:EMPTY

};

(:==================================================================:)
(: getDTSFlag = GET DTS Instruction for External XML from MDR       :)
(:==================================================================:)
declare function frt:getDTSFlag(
                 $leftAttrName as xs:string,
                 $leftNmspcName as xs:string,
                 $rightNmspcName as xs:string)
{
  let $leftAssoc := frt:getLeftAssoc($leftAttrName,$leftNmspcName,$rightNmspcName)

  (: Extract Out the External XPath Value :)
  for $entry in $leftAssoc/properties/entry[key=$frt:ATTR_VALUE_TRANS_FUNC]
  return
    if ($entry) then $entry/value
    else $frt:EMPTY

};

(:==================================================================:)
(: getExtRootObject = GET External rootObject from MDR              :)
(:==================================================================:)
declare function frt:getExtRootObject(
                 $centralRootObject as xs:string,
                 $extNmspcName as xs:string
                 )
{

  let $leftAssoc := frt:getLeftAssoc($centralRootObject,$frt:FURTHeR,$extNmspcName)

  return

    (: if there is an Association Result :)
    if ($leftAssoc/properties/entry[key=$frt:EXT_ROOT_ID_ATTR]) then

      (: Get the External Root Object:)
      let $extRootObject := $leftAssoc/rightAsset/text()

      (: Get the External Root Object ID Attribute :)
      let $extRootObjectAttr :=
        for $entry in $leftAssoc/properties/entry[key=$frt:EXT_ROOT_ID_ATTR]
          return $entry/value/text()

      (: Return Concatenated String :)
      return concat($extRootObject,$frt:DELIMITER,$extRootObjectAttr)

    else $frt:ERROR

};

(:==================================================================:)
(: printDebug = Print Debug Variable to Query Info Screen           :)
(:==================================================================:)
declare function frt:printDebug($debugVar,$msg as xs:string?)
{
  let $var := $debugVar
  return fn:trace( $var,concat('DEBUG ', $msg, '=') )
};

(:==================================================================:)
(: ageToBirthYear = Translate Age to BirthYear                      :)
(:==================================================================:)
declare function frt:ageToBirthYear($age)
{
  (: Get Current Year :)
  let $curYear := year-from-date(current-date())

  (: Subtract Age from CurrentYear to Get BirthYear :)
  return $curYear - $age
};

(: END OF MODULE :)


Fixed test.

Fixed test.

declare construction strip;

import schema namespace ft =  "http://zorba.io/modules/full-text";
import module namespace schema = "http://www.zorba-xquery.com/modules/schema";

let $x := validate {<ft:compare-options
                           case="case sensitive"
                           diacritics="diacritics sensitive"
                           stemming="stemming"/>}
let $y:= (<a> { $x } </a>)/*
return
   schema:schema-type($y/@case)

declare construction strip;

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

let $x := validate {<ft:compare-options
                           case="case sensitive"
                           diacritics="diacritics sensitive"
                           stemming="stemming"/>}
let $y:= (<a> { $x } </a>)/*
return
   schema:schema-type($y/@case)


Fixing bug on number of parameters

Fixing bug on number of parameters