Adjusted static context as required by specific XQTS tests

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

xquery version "1.0";

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

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

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

(: $Id$ :)

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

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

     Setup:

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

        (: Don't know how to compare :)
      else
        <test-case name="{$case/@name}" result="error" dateRun="{util:system-time()}" print="unknown-comparison-method">
          <error test="{$case/@name}">Unknown comparison method: {$output/@compare}.</error>
          <query>{$query}</query>
	</test-case>
    (: Use this let clause to get an update insert failure from the 5314th
       test and onward in xqts:report-progress(). in-memory-temp-frag corrpution
       reproducible in xqts, who could imagine... /ljo :)
    (: let $passed := $all-results//test-case[@result eq 'pass'] :)
    let $passed :=
      if (fn:exists($all-results[2])) then
	let $result-frag := concat("<f>", fn:string-join($all-results, ""), "</f>")
	let $results-doc := doc(xdb:store("/db", "temp-res.xml", $result-frag, "text/xml"))
        return $results-doc//test-case[@result eq 'pass']
      else ()
    return
      if (fn:exists($passed)) then
	$passed[1]
      else if (fn:exists($all-results[1])) then
	$all-results[1]
      else
        (: Expected runtime-exception, but got a result :)
      if (fn:exists($case//catalog:expected-error) and fn:empty($case//catalog:output-file) and $case/@scenario eq "runtime-error") then
        <test-case name="{$case/@name}" result="fail" dateRun="{util:system-time()}" print="expected-error-and-no-output">
          <expected-error>{string-join($case/catalog:expected-error/text(), ";")}</expected-error>
          <result>{$result}</result>
          <query>{$query}</query>
        </test-case>
      else
	let $log-all := util:log("DEBUG", ("Unhandled error, no result for: ", xs:string($case/@name)))
	return
	  <test-case name="{$case/@name}" result="error" dateRun="{util:system-time()}" print="unhandled-error">
    	    <error test="{$case/@name}">Cannot handle: {$case/@name}.</error>
            <query>{$query}</query>
          </test-case>

};

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

declare function xqts:run-test-case( $testCase as element(catalog:test-case)) as item()* {
   let $query := xqts:get-query($testCase)
   let $result :=
       util:catch("java.lang.Exception",
			let $context :=
				<static-context>
				    { xqts:compute-specific-static-context(string($testCase/@name)) }
           			{
               			for $input in $testCase/catalog:input-file
               			return
                   			<variable name="{$input/@variable}">{xqts:get-input-value($input)}</variable>,
                		for $var in $testCase/catalog:input-query
                		return
                    		<variable name="{$var/@variable}">
                        		{xqts:get-variable($testCase, $var/@name)}
                    		</variable>
           			}
       			</static-context>
           let $result :=
               util:eval-with-context($query, $context, false(), xqts:get-context-item($testCase/catalog:contextItem))
           return
               xqts:check-output($query, $result, $testCase),
	     (: Only expected exception and got exception.
	        No check on if it is the right exception, though. :)
           if (fn:exists($testCase//catalog:expected-error) and fn:empty($testCase//catalog:output-file)) then
               <test-case name="{$testCase/@name}" result="pass" dateRun="{util:system-time()}" print="expected-exception-got-exception">
                   <exception>{$util:exception-message}</exception>
                   <expected-error>{string-join($testCase//catalog:expected-error/text(),";")}</expected-error>
                   <query>{$query}</query>
               </test-case>
           else
	     (: Expected either output or exception. :)
	     if (fn:exists($testCase//catalog:expected-error) and fn:exists($testCase//catalog:output-file)) then
               <test-case name="{$testCase/@name}" result="pass" dateRun="{util:system-time()}" print="exception-or-output">
                   <exception>{$util:exception-message}</exception>
                   <expected-error>{string-join($testCase//catalog:expected-error/text(),";")}</expected-error>
		   {
		     for $output in $testCase//catalog:output-file
		     return <expected>{
                     let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $testCase/@FilePath, $output/text())
                     return util:file-read($filePath, "UTF-8")
                     }</expected>
		   }
                   <query>{$query}</query>
               </test-case>
           else if (fn:empty($testCase//catalog:expected-error) and fn:exists($testCase//catalog:output-file)) then
 	     (: Expected output, but got exception. :)
               <test-case name="{$testCase/@name}" result="fail" dateRun="{util:system-time()}" print="expected-output-got-exception">
                   <exception>{$util:exception-message}</exception>
		   {
		     for $output in $testCase//catalog:output-file
		     return <expected>{
                     let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $testCase/@FilePath, $output/text())
                     return util:file-read($filePath, "UTF-8")
                     }</expected>
		   }
                   <query>{$query}</query>
               </test-case>
	     else
 	     (: Don't know what is expected but got here anyway. :)
               <test-case name="{$testCase/@name}" result="fail" dateRun="{util:system-time()}" print="unhandled-result">
                   <exception>{$util:exception-message}</exception>
                   <expected-error>{string-join($testCase//catalog:expected-error/text(),";")}</expected-error>
		   {
		     if (fn:exists($testCase//catalog:output-file)) then
		     for $output in $testCase//catalog:output-file
		     return <expected>{
                     let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $testCase/@FilePath, $output/text())
                     return util:file-read($filePath, "UTF-8")
                     }</expected>
		     else ()
		   }
                   <query>{$query}</query>
               </test-case>
       )
       let $log := if (fn:empty($result)) then util:log("DEBUG", ("FAILURE in-memory-frag in test: ", xs:string($testCase/@name))) else ()
   return $result
};

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

declare function xqts:run-single-test-case($case as element(catalog:test-case),
    $resultRoot as element()?) as empty() {
    let $result := xqts:run-test-case($case)
    return (
        update insert $result into $resultRoot,
        let $added := $resultRoot/test-case[@name = $case/@name]
       let $log := if (fn:empty($added)) then util:log("DEBUG", ("FAILURE in-memory-frag in test: ", xs:string($case/@name))) else ()
        return
            if ($added) then xqts:report-progress($added)
            else ()
    )
};

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

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

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

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

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

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

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

declare function xqts:compute-specific-static-context($testCaseName as xs:string) as element()* {
    (
        if ($testCaseName eq "fn-current-time-4") then
            (: arbitrary date :)
            <current-dateTime value="2005-12-05T13:38:03.455-05:00"/>
        else if ($testCaseName eq "fn-current-time-6") then
            (: arbitrary date :)
            <current-dateTime value="2005-12-05T13:38:18.059-05:00"/>
        else if ($testCaseName eq "fn-current-time-7") then
            (: arbitrary date :)
            <current-dateTime value="2005-12-05T13:38:18.059-05:00"/>
        else if ($testCaseName eq "fn-current-time-10") then
            (: arbitrary date :)
            <current-dateTime value="2005-12-05T13:38:18.09-05:00"/>
        else if (starts-with($testCaseName, "fn-current-time-")) then
            (: arbitrary date :)
            <current-dateTime value="2005-12-05T10:15:03.408-05:00"/>
        else if ($testCaseName eq "fn-current-dateTime-6") then
            <current-dateTime value="2005-12-05T17:10:00.312-05:00"/>
        (: bloody lower-case ! :)
        else if ($testCaseName eq "fn-current-datetime-7") then
            <current-dateTime value="2005-12-05T17:10:00.312-05:00"/>
        else if ($testCaseName eq "fn-current-dateTime-10") then
            <current-dateTime value="2005-12-05T17:10:00.344-05:00"/>
        else if ($testCaseName eq "fn-current-dateTime-21") then
            <current-dateTime value="2005-12-05T17:10:00.453-05:00"/>
        else if ($testCaseName eq "fn-current-dateTime-24") then
            <current-dateTime value="2005-12-05T17:10:00.469-05:00"/>
        else
            <current-dateTime value="2005-12-05T17:10:00.203-05:00"/>
    ,
        if (matches($testCaseName,"^fn-implicit-timezone-.*$") or
            matches($testCaseName,"^K-ContextImplicitTimezoneFunc-.*$")) then
            <implicit-timezone value="-PT5H"/>
        else
            ()
    )
};

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

xquery version "1.0";

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

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

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

(: $Id$ :)

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

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

     Setup:

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

        (: Don't know how to compare :)
      else
        <test-case name="{$case/@name}" result="error" dateRun="{util:system-time()}" print="unknown-comparison-method">
          <error test="{$case/@name}">Unknown comparison method: {$output/@compare}.</error>
          <query>{$query}</query>
	</test-case>
    (: Use this let clause to get an update insert failure from the 5314th
       test and onward in xqts:report-progress(). in-memory-temp-frag corrpution
       reproducible in xqts, who could imagine... /ljo :)
    (: let $passed := $all-results//test-case[@result eq 'pass'] :)
    let $passed :=
      if (fn:exists($all-results[2])) then
	let $result-frag := concat("<f>", fn:string-join($all-results, ""), "</f>")
	let $results-doc := doc(xdb:store("/db", "temp-res.xml", $result-frag, "text/xml"))
        return $results-doc//test-case[@result eq 'pass']
      else ()
    return
      if (fn:exists($passed)) then
	$passed[1]
      else if (fn:exists($all-results[1])) then
	$all-results[1]
      else
        (: Expected runtime-exception, but got a result :)
      if (fn:exists($case//catalog:expected-error) and fn:empty($case//catalog:output-file) and $case/@scenario eq "runtime-error") then
        <test-case name="{$case/@name}" result="fail" dateRun="{util:system-time()}" print="expected-error-and-no-output">
          <expected-error>{string-join($case/catalog:expected-error/text(), ";")}</expected-error>
          <result>{$result}</result>
          <query>{$query}</query>
        </test-case>
      else
	let $log-all := util:log("DEBUG", ("Unhandled error, no result for: ", xs:string($case/@name)))
	return
	  <test-case name="{$case/@name}" result="error" dateRun="{util:system-time()}" print="unhandled-error">
    	    <error test="{$case/@name}">Cannot handle: {$case/@name}.</error>
            <query>{$query}</query>
          </test-case>

};

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

declare function xqts:run-test-case( $testCase as element(catalog:test-case)) as item()* {
   let $query := xqts:get-query($testCase)
   let $result :=
       util:catch("java.lang.Exception",
			let $context :=
				<static-context>
				    {
        				if (starts-with($testCase/@name, "fn-current-time-")) then
                            <current-dateTime value="2005-12-05T10:15:03.408-05:00"/>
                        else
                            <current-dateTime value="2005-12-05T17:10:00.203-05:00"/>
                    }
                    {
                        if (not(matches($testCase/@name,"^K-Adj.*ToTimezoneFunc-.*$"))) then
				            <implicit-timezone value="-PT5H"/>
				           else
				            ()
				    }
           			{
               			for $input in $testCase/catalog:input-file
               			return
                   			<variable name="{$input/@variable}">{xqts:get-input-value($input)}</variable>,
                		for $var in $testCase/catalog:input-query
                		return
                    		<variable name="{$var/@variable}">
                        		{xqts:get-variable($testCase, $var/@name)}
                    		</variable>
           			}
       			</static-context>
           let $result :=
               util:eval-with-context($query, $context, false(), xqts:get-context-item($testCase/catalog:contextItem))
           return
               xqts:check-output($query, $result, $testCase),
	     (: Only expected exception and got exception.
	        No check on if it is the right exception, though. :)
           if (fn:exists($testCase//catalog:expected-error) and fn:empty($testCase//catalog:output-file)) then
               <test-case name="{$testCase/@name}" result="pass" dateRun="{util:system-time()}" print="expected-exception-got-exception">
                   <exception>{$util:exception-message}</exception>
                   <expected-error>{string-join($testCase//catalog:expected-error/text(),";")}</expected-error>
                   <query>{$query}</query>
               </test-case>
           else
	     (: Expected either output or exception. :)
	     if (fn:exists($testCase//catalog:expected-error) and fn:exists($testCase//catalog:output-file)) then
               <test-case name="{$testCase/@name}" result="pass" dateRun="{util:system-time()}" print="exception-or-output">
                   <exception>{$util:exception-message}</exception>
                   <expected-error>{string-join($testCase//catalog:expected-error/text(),";")}</expected-error>
		   {
		     for $output in $testCase//catalog:output-file
		     return <expected>{
                     let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $testCase/@FilePath, $output/text())
                     return util:file-read($filePath, "UTF-8")
                     }</expected>
		   }
                   <query>{$query}</query>
               </test-case>
           else if (fn:empty($testCase//catalog:expected-error) and fn:exists($testCase//catalog:output-file)) then
 	     (: Expected output, but got exception. :)
               <test-case name="{$testCase/@name}" result="fail" dateRun="{util:system-time()}" print="expected-output-got-exception">
                   <exception>{$util:exception-message}</exception>
		   {
		     for $output in $testCase//catalog:output-file
		     return <expected>{
                     let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $testCase/@FilePath, $output/text())
                     return util:file-read($filePath, "UTF-8")
                     }</expected>
		   }
                   <query>{$query}</query>
               </test-case>
	     else
 	     (: Don't know what is expected but got here anyway. :)
               <test-case name="{$testCase/@name}" result="fail" dateRun="{util:system-time()}" print="unhandled-result">
                   <exception>{$util:exception-message}</exception>
                   <expected-error>{string-join($testCase//catalog:expected-error/text(),";")}</expected-error>
		   {
		     if (fn:exists($testCase//catalog:output-file)) then
		     for $output in $testCase//catalog:output-file
		     return <expected>{
                     let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $testCase/@FilePath, $output/text())
                     return util:file-read($filePath, "UTF-8")
                     }</expected>
		     else ()
		   }
                   <query>{$query}</query>
               </test-case>
       )
       let $log := if (fn:empty($result)) then util:log("DEBUG", ("FAILURE in-memory-frag in test: ", xs:string($testCase/@name))) else ()
   return $result
};

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

declare function xqts:run-single-test-case($case as element(catalog:test-case),
    $resultRoot as element()?) as empty() {
    let $result := xqts:run-test-case($case)
    return (
        update insert $result into $resultRoot,
        let $added := $resultRoot/test-case[@name = $case/@name]
       let $log := if (fn:empty($added)) then util:log("DEBUG", ("FAILURE in-memory-frag in test: ", xs:string($case/@name))) else ()
        return
            if ($added) then xqts:report-progress($added)
            else ()
    )
};

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

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

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

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

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

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

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

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


Fixing geoproj.xq with new math namespace

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

(:~
 : Geographic projection module.

 : Forward and inverse projection from WGS84 lat-long coordinates to Oblique Mercator x-y projection.

 : Oblique Mercator projection is a sphere to cylinder projection.

 : This projection results in a conformal output, meaning the shape of small areas is preserved,
 : no matter the distance from the origin. But it is not equal area, meaning the area size increases heavily
 : when getting closer to North or South. The area size increases with the same amount on x and y axes,
 : so the relative shape remains almost the same.

 : Mercator projection is the oldest projection, and it is still widely used because it produces a rectangular map.
 : This projection is used in Google Maps because of its conformal output.

 : For military or measurements purposes the UTM projection is used (or variants). This splits the Earth into small
 : areas and computes the cartesian coordinates relative to each area.

 :

 : Here we use Oblique Mercator projection. Its advantage over the normal Mercator is that you can set the tangent point
 : between the cylinder and the sphere to be anywhere on Earth. So you can set the center of the map to be close
 : to the area you want projected and be able to measure accurately the distances between points and lines.
 : The map deformation is minimal close to the center point and close to the "equator" line.

 : The advantage over the UTM projection is that it can also produce a global rectangular map, like Mercator,
 : which is great for viewing.

 : The disadvantage over Mercator is that it needs more processing power.

 :

 : WGS84 is the ellipsoid aproximation of the Earth, with big radius of 6,378,137 m and small radius of 6,356,752.3 m.
 : The geographic coordinates expressed for this ellipsoid are widely used today in maps and gps coordinates.
 : It is the default standard for representing geographic coordinates.

 :

 : The purpose of this module is to provide convertion from polar to cartesian coordinates, so you can
 : process the geographic data with the Simple Features API functions implemented in the geo module.
 : That module works only with cartesian coordinates, but most maps have polar coordinates.

 :

 : The projection formulas are taken from lib_proj library and implemented in XQuery.
 :
 : @author Daniel Turcanu
 :)
module namespace geoproj = "http://www.zorba-xquery.com/modules/geoproj";

(:~
 : Import module for checking if geoproj parameters are validated.
 :)
import module namespace zorba-schema = "http://www.zorba-xquery.com/modules/schema";

(:~
 : Contains the definitions of the geoproj parameters.
:)
import schema namespace geoproj-param = "http://www.zorba-xquery.com/modules/geoproj-param";

declare namespace gml="http://www.opengis.net/gml";

(:~
 : Convert angle from degrees to radians.

 : The parameter is first reduced to value range of (-360, 360).
 :
 : @param $deg angle in  degrees
 : @return value in radians (-2PI, 2PI)
 :)
declare function geoproj:deg-to-rad($deg as xs:double) as xs:double
{
  ($deg mod 360) * 2 * math:pi() div 360
};

(:~
 : Convert angle from radians to degrees.

 :
 : @param $rad value in radians
 : @return value in degrees (-360, 360)
 :)
declare function geoproj:rad-to-deg($rad as xs:double) as xs:double
{
  ($rad * 360 div 2 div math:pi()) mod 360
};

(:~
 : Compute the isometric latitude of $phi latitude.
 :
 : @param $phi a latitude
 : @return isometric latitude in radians
 :)
declare %private function geoproj:proj-tsfn($phi as xs:double) as xs:double
{
   let $e as xs:double := 0.0818192E0
   return
   math:tan(math:pi() div 4 - $phi div 2) div math:pow((1 - $e * math:sin($phi)) div (1 + $e * math:sin($phi)), $e div 2)
};

declare %private function geoproj:wgs84-to-omerc-validated(
                                         $lat_0 as xs:double,
                                         $long_c as xs:double,
                                         $k0 as xs:double,
                                         $lat_long_degrees as element(geoproj-param:latlong, geoproj-param:latlongType)*) as element(geoproj-param:coord)*
{
  let $e as xs:double := 0.0818192E0
  let $e2 := $e*$e
  let $phi0 := geoproj:deg-to-rad($lat_0)
  let $lambda0 := geoproj:deg-to-rad($long_c)
  let $sin_phi0 := math:sin($phi0)
  let $sin2_phi0 := $sin_phi0 * $sin_phi0
  let $cos_phi0 := math:cos($phi0)
  let $aphi0 := abs($phi0)
  let $B := if ($aphi0 gt 1e-10) then math:sqrt(1 + $e2 div (1 - $e2) * math:pow($cos_phi0, 4)) else math:sqrt(1 - $e2)
  let $A := if ($aphi0 gt 1e-10) then $B * $k0 * math:sqrt(1 - $e2) div (1 - $e2*$sin2_phi0) else $k0
  let $t0 := geoproj:proj-tsfn($phi0)
  let $D := if ($aphi0 gt 1e-10) then $B * math:sqrt(1 - $e2) div ($cos_phi0 * math:sqrt(1 - $e2*$sin2_phi0)) else 1
  let $D := if ($D*$D < 1) then 1 else $D
  let $F := if ($aphi0 gt 1e-10) then if ($phi0 < 0) then $D - math:sqrt($D*$D - 1) else $D + math:sqrt($D*$D - 1) else 1
  let $E := if ($aphi0 gt 1e-10) then math:pow($t0, $B) * $F else 1

  let $G := ($F - 1 div $F) div 2
  let $uc := abs($A div $B * math:atan2(math:sqrt($D*$D - 1), 1))
  let $uc := if ($phi0 < 0) then -$uc else $uc

  for $latlong in $lat_long_degrees
  let $phi := geoproj:deg-to-rad($latlong/*:lat)
  let $lambda := geoproj:deg-to-rad($latlong/*:long)
  let $V := math:sin($B * ($lambda - $lambda0))
	return
    	if (abs($phi) lt (math:pi() div 2 - 1.e-10)) then
    	  let $Q := $E div math:pow(geoproj:proj-tsfn($phi) , $B)
    	  let $S := ($Q - 1 div $Q) div 2
    	  let $T := ($Q + 1 div $Q) div 2
    	  let $U := -$V div $T
          let $v := if (abs($U) ne 1) then $A div (2 * $B) * math:log((1 - $U) div (1 + $U)) else 1 div 0
          let $M := math:cos($B * ($lambda - $lambda0))
          let $u := if ($M gt 1e-7) then $A div $B * math:atan2($S, $M) else $A*$B*($lambda - $lambda0)
          let $u := $u - $uc
          let $x := $v
          let $x := $x * 6378137
          let $y := $u
          let $y := $y * 6378137
          return <geoproj-param:coord><geoproj-param:x>{$x}</geoproj-param:x> <geoproj-param:y>{$y}</geoproj-param:y></geoproj-param:coord>
        else
          let $v := $A div $B * -4.2897288031186085136750723197195
          let $u := $phi * $A div $B
          let $u := $u - $uc
          let $x := $v
          let $x := $x * 6378137
          let $y := $u
          let $y := $y * 6378137
          return <geoproj-param:coord><geoproj-param:x>{$x}</geoproj-param:x> <geoproj-param:y>{$y}</geoproj-param:y></geoproj-param:coord>
};

(:~
 : Forward projection from geographic coordinates lat-long on WGS84 ellipsoid to Oblique Mercator cylinder.

 : The Oblique Mercator projection is like the standard Mercator projection, but you can choose the point of origin.

 : Specify the coordinates of the center point somewhere near the points being projected,
 : so the projection deformation is small.

 : The azimuth in the center point, alpha, is hardcoded to zero, so the true north is preserved.
 : This is a simplification of the standard Oblique Mercator projection.

 : Gamma, the azimuth of the rectified bearing of center line is also zero, calculated from alpha.

 :

 : The radius of the Earth in WGS84 is 6378137 m.

 : Reverse flatening 298.257223563.

 : Eccentricity e 0.0818192.

 :

 : @param $lat_0 is the latitude for center point, in degrees (-90, 90)
 : @param $long_c is the longitude for center point, in degrees (-180, 180)
 : @param $k0 is the scale in the center point. The scale will increase when going far to north and south.
 :        Use value 1 to get the true distances between points, in meters.
 :        At equator, the distance for 1 degree is aproximately 110 km.
 : @param $lat_long_degrees a sequence of nodes of type

 :   <latlong><lat>latitude degree</lat><long>longitude degree</long></latlong>

 :   in namespace "http://www.zorba-xquery.com/modules/geoproj-param"
 : @return a sequence of x-y coordinates in format

 :   <coord><x>x</x><y>y</y></coord>

 :   in namespace "http://www.zorba-xquery.com/modules/geoproj-param"

 :   Note that the x coordinate corresponds to the longitude, and y coordinate to the latitude.

 :   The coordinates are expressed in meters.

 :   The coordinates are relative to the center point.
  @example rbkt/Queries/zorba/geo/geoproj1.xq
  @example rbkt/Queries/zorba/geo/geoproj5.xq
  @example rbkt/Queries/zorba/geo/geoproj6.xq
  @example rbkt/Queries/zorba/geo/geoproj8.xq
  @example rbkt/Queries/zorba/geo/geoproj9.xq
  @example rbkt/Queries/zorba/geo/geoproj10.xq
  @example rbkt/Queries/zorba/geo/geoproj12.xq
 :)
declare function geoproj:wgs84-to-omerc( $lat-0 as xs:double,
                                         $long-c as xs:double,
                                         $k0 as xs:double,
                                         $lat-long-degrees as element(geoproj-param:latlong)*) as element(geoproj-param:coord)*
{
  let $validated-lat-long :=
  (for $lat-long-degree in $lat-long-degrees
  return
    if(empty($lat-long-degree)) then
      $lat-long-degrees
    else
      validate{$lat-long-degree} )
  return
  geoproj:wgs84-to-omerc-validated($lat-0, $long-c, $k0, $validated-lat-long)
};

(:~
 : Forward projection from geographic coordinates lat-long on WGS84 ellipsoid to Oblique Mercator cylinder.

 : This is an intermediate function for wgs84-to-omerc.

 : The difference is that it returns the x-y coordinates in gml:pos format,
 : gml being the prefix for the GML namespace "http://www.opengis.net/gml".

 :

 : @param $lat_0 is the latitude for center point, in degrees (-90, 90)
 : @param $long_c is the longitude for center point, in degrees (-180, 180)
 : @param $k0 is the scale in the center point.
 : @param $lat_long_degrees a sequence of nodes of type

 :   <latlong><lat>latitude degree</lat><long>longitude degree</long></latlong>

 :   in namespace "http://www.zorba-xquery.com/modules/geoproj-param"
 : @return a sequence of x-y coordinates in format

 :   <gml:pos>x y</gml:pos>

 :   in namespace "http://www.opengis.net/gml"
  @example rbkt/Queries/zorba/geo/geoproj3.xq
 :)
declare function geoproj:wgs84-to-omerc-gmlpos( $lat-0 as xs:double,
                                         $long-c as xs:double,
                                         $k0 as xs:double,
                                         $lat-long-degrees as element(geoproj-param:latlong)*) as element(gml:pos)*
{
  let $validated-lat-long :=
  (for $lat-long-degree in $lat-long-degrees
  return
    if(empty($lat-long-degree)) then
      $lat-long-degrees
    else
      validate{$lat-long-degree} )
  return
  geoproj:wgs84-to-omerc-gmlpos-validated($lat-0, $long-c, $k0, $validated-lat-long);
};

declare %private function geoproj:wgs84-to-omerc-gmlpos-validated( $lat_0 as xs:double,
                                         $long_c as xs:double,
                                         $k0 as xs:double,
                                         $lat_long_degrees as element(geoproj-param:latlong, geoproj-param:latlongType)*) as element(gml:pos)*
{
  for $coord in geoproj:wgs84-to-omerc($lat_0, $long_c, $k0, $lat_long_degrees)
  return
    <gml:pos>{string($coord/*:x)}{" "}{string($coord/*:y)}</gml:pos>
};

(:~
 : Function for iterative computing of the inverse isometric latitude.
 :
 : @param $i the maximum iterations
 : @param $ts precomputed value
 : @param $e the Earth eccentricity. For WGS84 is hardcoded to 0.0818192.
 : @param $prev_phi previous computed inverse isometric latitude
 : @return isometric latitude in radians
 :)
declare %private function geoproj:proj-phi2-helper($i as xs:integer,
                                          $ts as xs:double , $e as xs:double,
                                          $prev_phi as xs:double) as xs:double
{
    if($i eq 0) then
      $prev_phi
    else
      let $phi := math:pi() div 2 - 2 * math:atan($ts * math:pow((1 - $e * math:sin($prev_phi[1])) div (1 + $e * math:sin($prev_phi[1])), $e div 2))
      return
        if (abs($prev_phi - $phi) le 1.0e-10) then
          $phi
        else
          geoproj:proj-phi2-helper($i - 1, $ts, $e, $phi)
};

(:~
 : Function for computing the inverse isometric latitude.
 :
 : @param $ts precomputed value, based on an initial latitude.
 : @param $e the Earth eccentricity. For WGS84 is hardcoded to 0.0818192.
 : @return inverse isometric latitude in radians
 :)
declare %private function geoproj:proj-phi2($ts as xs:double, $e as xs:double) as xs:double
{
  let $phi := math:pi() div 2 - 2 * math:atan($ts)
  return
     geoproj:proj-phi2-helper(15, $ts, $e, ($phi))
};

(:~
 : Inverse projection from cartesian coordinates on Oblique Mercator cylinder
 : to geographic coordinates lat-long on WGS84 ellipsoid.

 : The parameters for center point and scale should be the same as for the initial forward projection,
 : otherwise you will get wrong results.

 :

 :

 : @param $lat_0 is the latitude for center point, in degrees (-90, 90)
 : @param $long_c is the longitude for center point, in degrees (-180, 180)
 : @param $k0 is the scale in the center point.
 : @param $coords a sequence of nodes of type

 :   <coord><x>x</x><y>y</y></coord>

 :   in namespace "http://www.zorba-xquery.com/modules/geoproj-param"

 :   The coordinates are expressed in meters.
 : @return a sequence of geographic coordinates in format

 :   <latlong><lat>latitude degree</lat><long>longitude degree</long></latlong>

 :   in namespace "http://www.zorba-xquery.com/modules/geoproj-param"

 :   Note that the longitude corresponds to the x coordinate, and the latitude to the y coordinate.

  @example rbkt/Queries/zorba/geo/geoproj2.xq
  @example rbkt/Queries/zorba/geo/geoproj7.xq
  @example rbkt/Queries/zorba/geo/geoproj11.xq
 :)
declare function geoproj:omerc-to-wgs84($lat-0 as xs:double,
                                         $long-c as xs:double,
                                         $k0 as xs:double,
                                         $coords as element(geoproj-param:coord)*) as element(geoproj-param:latlong)*
{
  let $validated-coords :=
  (for $coord in $coords
  return
    if(empty($coords)) then
      $coord
    else
      validate{$coord} )
  return
  geoproj:omerc-to-wgs84-validated($lat-0, $long-c, $k0, $validated-coords);
};

declare %private function geoproj:omerc-to-wgs84-validated($lat_0 as xs:double,
                                         $long_c as xs:double,
                                         $k0 as xs:double,
                                         $coords as element(geoproj-param:coord, geoproj-param:coordType)*) as element(geoproj-param:latlong)*
{
  let $e as xs:double := 0.0818192E0
  let $e2 := $e*$e
  let $phi0 := geoproj:deg-to-rad($lat_0)
  let $lambda0 := geoproj:deg-to-rad($long_c)
  let $sin_phi0 := math:sin($phi0)
  let $sin2_phi0 := $sin_phi0 * $sin_phi0
  let $cos_phi0 := math:cos($phi0)
  let $aphi0 := abs($phi0)
  let $B := if ($aphi0 gt 1.e-10) then math:sqrt(1 + $e2 div (1 - $e2) * math:pow($cos_phi0, 4)) else math:sqrt(1 - $e2)
  let $A := if ($aphi0 gt 1.e-10) then $B * $k0 * math:sqrt(1 - $e2) div (1 - $e2*$sin2_phi0) else $k0
  let $t0 := geoproj:proj-tsfn($phi0)
  let $D := if ($aphi0 gt 1.e-10) then $B * math:sqrt(1 - $e2) div ($cos_phi0 * math:sqrt(1 - $e2*$sin2_phi0)) else 1
  let $D := if ($D*$D < 1) then 1 else $D
  let $F := if ($aphi0 gt 1.e-10) then if ($phi0 < 0) then $D - math:sqrt($D*$D - 1) else $D + math:sqrt($D*$D - 1) else 1
  let $E := if ($aphi0 gt 1.e-10) then math:pow($t0, $B) * $F else 1

  let $G := ($F - 1 div $F) div 2
  let $uc := abs($A div $B * math:atan2(math:sqrt($D*$D - 1), 1))
  let $uc := if ($phi0 < 0) then -$uc else $uc

  for $coord in $coords
  let $x := $coord/*:x div 6378137
  let $y := $coord/*:y div 6378137
  let $v := $x
  let $u := $y + $uc
  let $Qp := math:exp(-$B * $v div $A)
  let $Sp := ($Qp - 1 div $Qp) div 2
  let $Tp := ($Qp + 1 div $Qp) div 2
  let $Vp := math:sin($B * $u div $A)
  let $Up := $Vp div $Tp
  return
    if(abs(abs($Up) - 1) lt 1e-10) then
      if ($Up gt 0) then
        <geoproj-param:latlong><geoproj-param:lat>90</geoproj-param:lat> <geoproj-param:long>{$long_c}</geoproj-param:long></geoproj-param:latlong>
      else
        <geoproj-param:latlong><geoproj-param:lat>-90</geoproj-param:lat> <geoproj-param:long>{$long_c}</geoproj-param:long></geoproj-param:latlong>
    else
      let $phi := $E div math:sqrt((1 + $Up) div (1 - $Up))
      let $phi := geoproj:proj-phi2(math:pow($phi, 1 div $B), $e)
      let $lambda := - 1 div $B * math:atan2($Sp, math:cos($B * $u div $A))
      return
        <geoproj-param:latlong><geoproj-param:lat>{geoproj:rad-to-deg($phi)}</geoproj-param:lat> <geoproj-param:long>{geoproj:rad-to-deg($lambda+$lambda0)}</geoproj-param:long></geoproj-param:latlong>
};

(:~
 : Inverse projection from cartesian coordinates on Oblique Mercator cylinder
 : to geographic coordinates lat-long on WGS84 ellipsoid.

 : This is an intermediate function for omerc-to-wgs84.

 : The difference is that it works with coordinates in gml:pos format,
 : gml being the prefix for the GML namespace "http://www.opengis.net/gml".

 :

 : @param $lat_0 is the latitude for center point, in degrees (-90, 90)
 : @param $long_c is the longitude for center point, in degrees (-180, 180)
 : @param $k0 is the scale in the center point.
 : @param $gmlposs a sequence of nodes of type

 :   <gml:pos>x y</gml:pos>

 :   in namespace "http://www.opengis.net/gml"
 : @return a sequence of geographic coordinates in format
v
 :   <latlong><lat>latitude degree</lat><long>longitude degree</long></latlong>

 :   in namespace "http://www.zorba-xquery.com/modules/geoproj-param"
  @example rbkt/Queries/zorba/geo/geoproj4.xq
 :)
declare function geoproj:omerc-gmlpos-to-wgs84($lat_0 as xs:double,
                                         $long_c as xs:double,
                                         $k0 as xs:double,
                                         $gmlposs as element(gml:pos)*) as element(geoproj-param:latlong)*
{
  geoproj:omerc-to-wgs84($lat_0, $long_c, $k0,
                  (for $gmlpos in $gmlposs
                  let $xystring := normalize-space(fn:string($gmlpos))
                  let $xy := tokenize($xystring, "[ \t\r\n]+")
                  let $x := $xy[1]
                  let $y := $xy[2]
                  return <geoproj-param:coord><geoproj-param:x>{$x}</geoproj-param:x><geoproj-param:y>{$y}</geoproj-param:y></geoproj-param:coord>))
};

(:~
 : Convertion from Degrees-Minutes-Seconds (DMS) to Degrees.

 : The values for DMS can be like 11d12'13", meaning 11 degrees, 12 minutes and 13 seconds.

 : One degree has 60 minutes, and one minute has 60 seconds.

 : The separator for degrees can be one of the characters [dDoO].

 : The separator for minutes can be one of the characters ['m].

 : The separator for seconds can be " or nothing.

 : The seconds can be a floating point number.

 :

 : The seconds can be missing, and if it is missing, the minutes can be missing too.

 : The negative value can be expressed as -11d12'13" or 11d12'13"S or 11d12'13"W.
 : Values for N (North) and E (East) are positive, and S (South) and W (West) are negative.
 :

 : @param $dms the degree-minutes-seconds string expressed in the format described above
 : @return the value in degrees
  @example rbkt/Queries/zorba/geo/dms1.xq
 :)
declare function geoproj:dms-to-deg($dms as xs:string) as xs:double
{
  let $dms := normalize-space($dms)
  let $dtok := tokenize($dms, "([DdOo])|([SNEW]$)")
  let $d := $dtok[1] cast as xs:double
  let $dsign := if($d < 0) then -1 else 1
  let $d := abs($d)
  return
    if(count($dtok) eq 1) then
      $dsign*$d
    else
      if(string-length($dtok[2]) eq 0) then
        if(matches($dms, "[SW]$")) then
          -$d
        else
          $dsign*$d
      else
        let $ms := substring($dms, string-length($dtok[1]) + 1 + 1)
        let $mtok := tokenize($ms, "(['m])|([SNEW]$)")
        let $m := abs($mtok[1] cast as xs:double)
        let $d := $d + $m div 60
        return
        if(count($mtok) eq 1) then
          $dsign*$d
        else
          if(string-length($mtok[2]) eq 0) then
            if(matches($dms, "[SW]$")) then
              -$d
            else
              $dsign*$d
          else
            let $ss := substring($ms, string-length($mtok[1]) + 1 + 1)
            let $stok := tokenize($ss, '"|([SNEW]$)')
            let $s := abs($stok[1] cast as xs:double)
            let $d := $d + $s div 3600
            return
              if(matches($dms, "[SW]$")) then
                -$d
              else
                $dsign*$d
};

(:~
 : Convertion from Degrees to Degrees-Minutes-Seconds (DMS).

 :

 : @param $deg the degree value
 : @return the value in DMS format, [-]degreedminutes'seconds
  @example rbkt/Queries/zorba/geo/dms2.xq
 :)
declare function geoproj:deg-to-dms($deg as xs:double) as xs:string
{
  let $d := $deg cast as xs:integer
  let $ms := abs($deg - $d) * 60
  let $m := $ms cast as xs:integer
  let $s := $ms - $m
  let $s := $s * 60
  let $m := if($s ge (60 - 1e-10)) then $m + 1 else $m
  let $d := if($m ge (60 - 1e-10)) then $d + 1 else $d
  let $m := if($m ge (60 - 1e-10)) then $m - 60 else $m
  let $s := if($s ge (60 - 1e-10)) then 0 else $s
  return
    concat($d, "d", $m, "'", $s)
};

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

(:~
 : Geographic projection module.

 : Forward and inverse projection from WGS84 lat-long coordinates to Oblique Mercator x-y projection.

 : Oblique Mercator projection is a sphere to cylinder projection.

 : This projection results in a conformal output, meaning the shape of small areas is preserved,
 : no matter the distance from the origin. But it is not equal area, meaning the area size increases heavily
 : when getting closer to North or South. The area size increases with the same amount on x and y axes,
 : so the relative shape remains almost the same.

 : Mercator projection is the oldest projection, and it is still widely used because it produces a rectangular map.
 : This projection is used in Google Maps because of its conformal output.

 : For military or measurements purposes the UTM projection is used (or variants). This splits the Earth into small
 : areas and computes the cartesian coordinates relative to each area.

 :

 : Here we use Oblique Mercator projection. Its advantage over the normal Mercator is that you can set the tangent point
 : between the cylinder and the sphere to be anywhere on Earth. So you can set the center of the map to be close
 : to the area you want projected and be able to measure accurately the distances between points and lines.
 : The map deformation is minimal close to the center point and close to the "equator" line.

 : The advantage over the UTM projection is that it can also produce a global rectangular map, like Mercator,
 : which is great for viewing.

 : The disadvantage over Mercator is that it needs more processing power.

 :

 : WGS84 is the ellipsoid aproximation of the Earth, with big radius of 6,378,137 m and small radius of 6,356,752.3 m.
 : The geographic coordinates expressed for this ellipsoid are widely used today in maps and gps coordinates.
 : It is the default standard for representing geographic coordinates.

 :

 : The purpose of this module is to provide convertion from polar to cartesian coordinates, so you can
 : process the geographic data with the Simple Features API functions implemented in the geo module.
 : That module works only with cartesian coordinates, but most maps have polar coordinates.

 :

 : The projection formulas are taken from lib_proj library and implemented in XQuery.
 :
 : @author Daniel Turcanu
 :)
module namespace geoproj = "http://www.zorba-xquery.com/modules/geoproj";
import module namespace math = "http://www.zorba-xquery.com/modules/math";

(:~
 : Import module for checking if geoproj parameters are validated.
 :)
import module namespace zorba-schema = "http://www.zorba-xquery.com/modules/schema";

(:~
 : Contains the definitions of the geoproj parameters.
:)
import schema namespace geoproj-param = "http://www.zorba-xquery.com/modules/geoproj-param";

declare namespace gml="http://www.opengis.net/gml";

(:~
 : Convert angle from degrees to radians.

 : The parameter is first reduced to value range of (-360, 360).
 :
 : @param $deg angle in  degrees
 : @return value in radians (-2PI, 2PI)
 :)
declare function geoproj:deg-to-rad($deg as xs:double) as xs:double
{
  ($deg mod 360) * 2 * math:pi() div 360
};

(:~
 : Convert angle from radians to degrees.

 :
 : @param $rad value in radians
 : @return value in degrees (-360, 360)
 :)
declare function geoproj:rad-to-deg($rad as xs:double) as xs:double
{
  ($rad * 360 div 2 div math:pi()) mod 360
};

(:~
 : Compute the isometric latitude of $phi latitude.
 :
 : @param $phi a latitude
 : @return isometric latitude in radians
 :)
declare %private function geoproj:proj-tsfn($phi as xs:double) as xs:double
{
   let $e as xs:double := 0.0818192E0
   return
   math:tan(math:pi() div 4 - $phi div 2) div math:pow((1 - $e * math:sin($phi)) div (1 + $e * math:sin($phi)), $e div 2)
};

declare %private function geoproj:wgs84-to-omerc-validated(
                                         $lat_0 as xs:double,
                                         $long_c as xs:double,
                                         $k0 as xs:double,
                                         $lat_long_degrees as element(geoproj-param:latlong, geoproj-param:latlongType)*) as element(geoproj-param:coord)*
{
  let $e as xs:double := 0.0818192E0
  let $e2 := $e*$e
  let $phi0 := geoproj:deg-to-rad($lat_0)
  let $lambda0 := geoproj:deg-to-rad($long_c)
  let $sin_phi0 := math:sin($phi0)
  let $sin2_phi0 := $sin_phi0 * $sin_phi0
  let $cos_phi0 := math:cos($phi0)
  let $aphi0 := abs($phi0)
  let $B := if ($aphi0 gt 1e-10) then math:sqrt(1 + $e2 div (1 - $e2) * math:pow($cos_phi0, 4)) else math:sqrt(1 - $e2)
  let $A := if ($aphi0 gt 1e-10) then $B * $k0 * math:sqrt(1 - $e2) div (1 - $e2*$sin2_phi0) else $k0
  let $t0 := geoproj:proj-tsfn($phi0)
  let $D := if ($aphi0 gt 1e-10) then $B * math:sqrt(1 - $e2) div ($cos_phi0 * math:sqrt(1 - $e2*$sin2_phi0)) else 1
  let $D := if ($D*$D < 1) then 1 else $D
  let $F := if ($aphi0 gt 1e-10) then if ($phi0 < 0) then $D - math:sqrt($D*$D - 1) else $D + math:sqrt($D*$D - 1) else 1
  let $E := if ($aphi0 gt 1e-10) then math:pow($t0, $B) * $F else 1

  let $G := ($F - 1 div $F) div 2
  let $uc := abs($A div $B * math:atan2(math:sqrt($D*$D - 1), 1))
  let $uc := if ($phi0 < 0) then -$uc else $uc

  for $latlong in $lat_long_degrees
  let $phi := geoproj:deg-to-rad($latlong/*:lat)
  let $lambda := geoproj:deg-to-rad($latlong/*:long)
  let $V := math:sin($B * ($lambda - $lambda0))
	return
    	if (abs($phi) lt (math:pi() div 2 - 1.e-10)) then
    	  let $Q := $E div math:pow(geoproj:proj-tsfn($phi) , $B)
    	  let $S := ($Q - 1 div $Q) div 2
    	  let $T := ($Q + 1 div $Q) div 2
    	  let $U := -$V div $T
          let $v := if (abs($U) ne 1) then $A div (2 * $B) * math:log((1 - $U) div (1 + $U)) else 1 div 0
          let $M := math:cos($B * ($lambda - $lambda0))
          let $u := if ($M gt 1e-7) then $A div $B * math:atan2($S, $M) else $A*$B*($lambda - $lambda0)
          let $u := $u - $uc
          let $x := $v
          let $x := $x * 6378137
          let $y := $u
          let $y := $y * 6378137
          return <geoproj-param:coord><geoproj-param:x>{$x}</geoproj-param:x> <geoproj-param:y>{$y}</geoproj-param:y></geoproj-param:coord>
        else
          let $v := $A div $B * -4.2897288031186085136750723197195
          let $u := $phi * $A div $B
          let $u := $u - $uc
          let $x := $v
          let $x := $x * 6378137
          let $y := $u
          let $y := $y * 6378137
          return <geoproj-param:coord><geoproj-param:x>{$x}</geoproj-param:x> <geoproj-param:y>{$y}</geoproj-param:y></geoproj-param:coord>
};

(:~
 : Forward projection from geographic coordinates lat-long on WGS84 ellipsoid to Oblique Mercator cylinder.

 : The Oblique Mercator projection is like the standard Mercator projection, but you can choose the point of origin.

 : Specify the coordinates of the center point somewhere near the points being projected,
 : so the projection deformation is small.

 : The azimuth in the center point, alpha, is hardcoded to zero, so the true north is preserved.
 : This is a simplification of the standard Oblique Mercator projection.

 : Gamma, the azimuth of the rectified bearing of center line is also zero, calculated from alpha.

 :

 : The radius of the Earth in WGS84 is 6378137 m.

 : Reverse flatening 298.257223563.

 : Eccentricity e 0.0818192.

 :

 : @param $lat_0 is the latitude for center point, in degrees (-90, 90)
 : @param $long_c is the longitude for center point, in degrees (-180, 180)
 : @param $k0 is the scale in the center point. The scale will increase when going far to north and south.
 :        Use value 1 to get the true distances between points, in meters.
 :        At equator, the distance for 1 degree is aproximately 110 km.
 : @param $lat_long_degrees a sequence of nodes of type

 :   <latlong><lat>latitude degree</lat><long>longitude degree</long></latlong>

 :   in namespace "http://www.zorba-xquery.com/modules/geoproj-param"
 : @return a sequence of x-y coordinates in format

 :   <coord><x>x</x><y>y</y></coord>

 :   in namespace "http://www.zorba-xquery.com/modules/geoproj-param"

 :   Note that the x coordinate corresponds to the longitude, and y coordinate to the latitude.

 :   The coordinates are expressed in meters.

 :   The coordinates are relative to the center point.
  @example rbkt/Queries/zorba/geo/geoproj1.xq
  @example rbkt/Queries/zorba/geo/geoproj5.xq
  @example rbkt/Queries/zorba/geo/geoproj6.xq
  @example rbkt/Queries/zorba/geo/geoproj8.xq
  @example rbkt/Queries/zorba/geo/geoproj9.xq
  @example rbkt/Queries/zorba/geo/geoproj10.xq
  @example rbkt/Queries/zorba/geo/geoproj12.xq
 :)
declare function geoproj:wgs84-to-omerc( $lat-0 as xs:double,
                                         $long-c as xs:double,
                                         $k0 as xs:double,
                                         $lat-long-degrees as element(geoproj-param:latlong)*) as element(geoproj-param:coord)*
{
  let $validated-lat-long :=
  (for $lat-long-degree in $lat-long-degrees
  return
    if(empty($lat-long-degree)) then
      $lat-long-degrees
    else
      validate{$lat-long-degree} )
  return
  geoproj:wgs84-to-omerc-validated($lat-0, $long-c, $k0, $validated-lat-long)
};

(:~
 : Forward projection from geographic coordinates lat-long on WGS84 ellipsoid to Oblique Mercator cylinder.

 : This is an intermediate function for wgs84-to-omerc.

 : The difference is that it returns the x-y coordinates in gml:pos format,
 : gml being the prefix for the GML namespace "http://www.opengis.net/gml".

 :

 : @param $lat_0 is the latitude for center point, in degrees (-90, 90)
 : @param $long_c is the longitude for center point, in degrees (-180, 180)
 : @param $k0 is the scale in the center point.
 : @param $lat_long_degrees a sequence of nodes of type

 :   <latlong><lat>latitude degree</lat><long>longitude degree</long></latlong>

 :   in namespace "http://www.zorba-xquery.com/modules/geoproj-param"
 : @return a sequence of x-y coordinates in format

 :   <gml:pos>x y</gml:pos>

 :   in namespace "http://www.opengis.net/gml"
  @example rbkt/Queries/zorba/geo/geoproj3.xq
 :)
declare function geoproj:wgs84-to-omerc-gmlpos( $lat-0 as xs:double,
                                         $long-c as xs:double,
                                         $k0 as xs:double,
                                         $lat-long-degrees as element(geoproj-param:latlong)*) as element(gml:pos)*
{
  let $validated-lat-long :=
  (for $lat-long-degree in $lat-long-degrees
  return
    if(empty($lat-long-degree)) then
      $lat-long-degrees
    else
      validate{$lat-long-degree} )
  return
  geoproj:wgs84-to-omerc-gmlpos-validated($lat-0, $long-c, $k0, $validated-lat-long);
};

declare %private function geoproj:wgs84-to-omerc-gmlpos-validated( $lat_0 as xs:double,
                                         $long_c as xs:double,
                                         $k0 as xs:double,
                                         $lat_long_degrees as element(geoproj-param:latlong, geoproj-param:latlongType)*) as element(gml:pos)*
{
  for $coord in geoproj:wgs84-to-omerc($lat_0, $long_c, $k0, $lat_long_degrees)
  return
    <gml:pos>{string($coord/*:x)}{" "}{string($coord/*:y)}</gml:pos>
};

(:~
 : Function for iterative computing of the inverse isometric latitude.
 :
 : @param $i the maximum iterations
 : @param $ts precomputed value
 : @param $e the Earth eccentricity. For WGS84 is hardcoded to 0.0818192.
 : @param $prev_phi previous computed inverse isometric latitude
 : @return isometric latitude in radians
 :)
declare %private function geoproj:proj-phi2-helper($i as xs:integer,
                                          $ts as xs:double , $e as xs:double,
                                          $prev_phi as xs:double) as xs:double
{
    if($i eq 0) then
      $prev_phi
    else
      let $phi := math:pi() div 2 - 2 * math:atan($ts * math:pow((1 - $e * math:sin($prev_phi[1])) div (1 + $e * math:sin($prev_phi[1])), $e div 2))
      return
        if (abs($prev_phi - $phi) le 1.0e-10) then
          $phi
        else
          geoproj:proj-phi2-helper($i - 1, $ts, $e, $phi)
};

(:~
 : Function for computing the inverse isometric latitude.
 :
 : @param $ts precomputed value, based on an initial latitude.
 : @param $e the Earth eccentricity. For WGS84 is hardcoded to 0.0818192.
 : @return inverse isometric latitude in radians
 :)
declare %private function geoproj:proj-phi2($ts as xs:double, $e as xs:double) as xs:double
{
  let $phi := math:pi() div 2 - 2 * math:atan($ts)
  return
     geoproj:proj-phi2-helper(15, $ts, $e, ($phi))
};

(:~
 : Inverse projection from cartesian coordinates on Oblique Mercator cylinder
 : to geographic coordinates lat-long on WGS84 ellipsoid.

 : The parameters for center point and scale should be the same as for the initial forward projection,
 : otherwise you will get wrong results.

 :

 :

 : @param $lat_0 is the latitude for center point, in degrees (-90, 90)
 : @param $long_c is the longitude for center point, in degrees (-180, 180)
 : @param $k0 is the scale in the center point.
 : @param $coords a sequence of nodes of type

 :   <coord><x>x</x><y>y</y></coord>

 :   in namespace "http://www.zorba-xquery.com/modules/geoproj-param"

 :   The coordinates are expressed in meters.
 : @return a sequence of geographic coordinates in format

 :   <latlong><lat>latitude degree</lat><long>longitude degree</long></latlong>

 :   in namespace "http://www.zorba-xquery.com/modules/geoproj-param"

 :   Note that the longitude corresponds to the x coordinate, and the latitude to the y coordinate.

  @example rbkt/Queries/zorba/geo/geoproj2.xq
  @example rbkt/Queries/zorba/geo/geoproj7.xq
  @example rbkt/Queries/zorba/geo/geoproj11.xq
 :)
declare function geoproj:omerc-to-wgs84($lat-0 as xs:double,
                                         $long-c as xs:double,
                                         $k0 as xs:double,
                                         $coords as element(geoproj-param:coord)*) as element(geoproj-param:latlong)*
{
  let $validated-coords :=
  (for $coord in $coords
  return
    if(empty($coords)) then
      $coord
    else
      validate{$coord} )
  return
  geoproj:omerc-to-wgs84-validated($lat-0, $long-c, $k0, $validated-coords);
};

declare %private function geoproj:omerc-to-wgs84-validated($lat_0 as xs:double,
                                         $long_c as xs:double,
                                         $k0 as xs:double,
                                         $coords as element(geoproj-param:coord, geoproj-param:coordType)*) as element(geoproj-param:latlong)*
{
  let $e as xs:double := 0.0818192E0
  let $e2 := $e*$e
  let $phi0 := geoproj:deg-to-rad($lat_0)
  let $lambda0 := geoproj:deg-to-rad($long_c)
  let $sin_phi0 := math:sin($phi0)
  let $sin2_phi0 := $sin_phi0 * $sin_phi0
  let $cos_phi0 := math:cos($phi0)
  let $aphi0 := abs($phi0)
  let $B := if ($aphi0 gt 1.e-10) then math:sqrt(1 + $e2 div (1 - $e2) * math:pow($cos_phi0, 4)) else math:sqrt(1 - $e2)
  let $A := if ($aphi0 gt 1.e-10) then $B * $k0 * math:sqrt(1 - $e2) div (1 - $e2*$sin2_phi0) else $k0
  let $t0 := geoproj:proj-tsfn($phi0)
  let $D := if ($aphi0 gt 1.e-10) then $B * math:sqrt(1 - $e2) div ($cos_phi0 * math:sqrt(1 - $e2*$sin2_phi0)) else 1
  let $D := if ($D*$D < 1) then 1 else $D
  let $F := if ($aphi0 gt 1.e-10) then if ($phi0 < 0) then $D - math:sqrt($D*$D - 1) else $D + math:sqrt($D*$D - 1) else 1
  let $E := if ($aphi0 gt 1.e-10) then math:pow($t0, $B) * $F else 1

  let $G := ($F - 1 div $F) div 2
  let $uc := abs($A div $B * math:atan2(math:sqrt($D*$D - 1), 1))
  let $uc := if ($phi0 < 0) then -$uc else $uc

  for $coord in $coords
  let $x := $coord/*:x div 6378137
  let $y := $coord/*:y div 6378137
  let $v := $x
  let $u := $y + $uc
  let $Qp := math:exp(-$B * $v div $A)
  let $Sp := ($Qp - 1 div $Qp) div 2
  let $Tp := ($Qp + 1 div $Qp) div 2
  let $Vp := math:sin($B * $u div $A)
  let $Up := $Vp div $Tp
  return
    if(abs(abs($Up) - 1) lt 1e-10) then
      if ($Up gt 0) then
        <geoproj-param:latlong><geoproj-param:lat>90</geoproj-param:lat> <geoproj-param:long>{$long_c}</geoproj-param:long></geoproj-param:latlong>
      else
        <geoproj-param:latlong><geoproj-param:lat>-90</geoproj-param:lat> <geoproj-param:long>{$long_c}</geoproj-param:long></geoproj-param:latlong>
    else
      let $phi := $E div math:sqrt((1 + $Up) div (1 - $Up))
      let $phi := geoproj:proj-phi2(math:pow($phi, 1 div $B), $e)
      let $lambda := - 1 div $B * math:atan2($Sp, math:cos($B * $u div $A))
      return
        <geoproj-param:latlong><geoproj-param:lat>{geoproj:rad-to-deg($phi)}</geoproj-param:lat> <geoproj-param:long>{geoproj:rad-to-deg($lambda+$lambda0)}</geoproj-param:long></geoproj-param:latlong>
};

(:~
 : Inverse projection from cartesian coordinates on Oblique Mercator cylinder
 : to geographic coordinates lat-long on WGS84 ellipsoid.

 : This is an intermediate function for omerc-to-wgs84.

 : The difference is that it works with coordinates in gml:pos format,
 : gml being the prefix for the GML namespace "http://www.opengis.net/gml".

 :

 : @param $lat_0 is the latitude for center point, in degrees (-90, 90)
 : @param $long_c is the longitude for center point, in degrees (-180, 180)
 : @param $k0 is the scale in the center point.
 : @param $gmlposs a sequence of nodes of type

 :   <gml:pos>x y</gml:pos>

 :   in namespace "http://www.opengis.net/gml"
 : @return a sequence of geographic coordinates in format
v
 :   <latlong><lat>latitude degree</lat><long>longitude degree</long></latlong>

 :   in namespace "http://www.zorba-xquery.com/modules/geoproj-param"
  @example rbkt/Queries/zorba/geo/geoproj4.xq
 :)
declare function geoproj:omerc-gmlpos-to-wgs84($lat_0 as xs:double,
                                         $long_c as xs:double,
                                         $k0 as xs:double,
                                         $gmlposs as element(gml:pos)*) as element(geoproj-param:latlong)*
{
  geoproj:omerc-to-wgs84($lat_0, $long_c, $k0,
                  (for $gmlpos in $gmlposs
                  let $xystring := normalize-space(fn:string($gmlpos))
                  let $xy := tokenize($xystring, "[ \t\r\n]+")
                  let $x := $xy[1]
                  let $y := $xy[2]
                  return <geoproj-param:coord><geoproj-param:x>{$x}</geoproj-param:x><geoproj-param:y>{$y}</geoproj-param:y></geoproj-param:coord>))
};

(:~
 : Convertion from Degrees-Minutes-Seconds (DMS) to Degrees.

 : The values for DMS can be like 11d12'13", meaning 11 degrees, 12 minutes and 13 seconds.

 : One degree has 60 minutes, and one minute has 60 seconds.

 : The separator for degrees can be one of the characters [dDoO].

 : The separator for minutes can be one of the characters ['m].

 : The separator for seconds can be " or nothing.

 : The seconds can be a floating point number.

 :

 : The seconds can be missing, and if it is missing, the minutes can be missing too.

 : The negative value can be expressed as -11d12'13" or 11d12'13"S or 11d12'13"W.
 : Values for N (North) and E (East) are positive, and S (South) and W (West) are negative.
 :

 : @param $dms the degree-minutes-seconds string expressed in the format described above
 : @return the value in degrees
  @example rbkt/Queries/zorba/geo/dms1.xq
 :)
declare function geoproj:dms-to-deg($dms as xs:string) as xs:double
{
  let $dms := normalize-space($dms)
  let $dtok := tokenize($dms, "([DdOo])|([SNEW]$)")
  let $d := $dtok[1] cast as xs:double
  let $dsign := if($d < 0) then -1 else 1
  let $d := abs($d)
  return
    if(count($dtok) eq 1) then
      $dsign*$d
    else
      if(string-length($dtok[2]) eq 0) then
        if(matches($dms, "[SW]$")) then
          -$d
        else
          $dsign*$d
      else
        let $ms := substring($dms, string-length($dtok[1]) + 1 + 1)
        let $mtok := tokenize($ms, "(['m])|([SNEW]$)")
        let $m := abs($mtok[1] cast as xs:double)
        let $d := $d + $m div 60
        return
        if(count($mtok) eq 1) then
          $dsign*$d
        else
          if(string-length($mtok[2]) eq 0) then
            if(matches($dms, "[SW]$")) then
              -$d
            else
              $dsign*$d
          else
            let $ss := substring($ms, string-length($mtok[1]) + 1 + 1)
            let $stok := tokenize($ss, '"|([SNEW]$)')
            let $s := abs($stok[1] cast as xs:double)
            let $d := $d + $s div 3600
            return
              if(matches($dms, "[SW]$")) then
                -$d
              else
                $dsign*$d
};

(:~
 : Convertion from Degrees to Degrees-Minutes-Seconds (DMS).

 :

 : @param $deg the degree value
 : @return the value in DMS format, [-]degreedminutes'seconds
  @example rbkt/Queries/zorba/geo/dms2.xq
 :)
declare function geoproj:deg-to-dms($deg as xs:double) as xs:string
{
  let $d := $deg cast as xs:integer
  let $ms := abs($deg - $d) * 60
  let $m := $ms cast as xs:integer
  let $s := $ms - $m
  let $s := $s * 60
  let $m := if($s ge (60 - 1e-10)) then $m + 1 else $m
  let $d := if($m ge (60 - 1e-10)) then $d + 1 else $d
  let $m := if($m ge (60 - 1e-10)) then $m - 60 else $m
  let $s := if($s ge (60 - 1e-10)) then 0 else $s
  return
    concat($d, "d", $m, "'", $s)
};


fixed displaying the value meanings for corresponding permissible values

xquery version "1.0";

(: ~
 : Module Name:             Value domain webpage
 :
 : Module Version           3.0
 :
 : Date                     27th September 2006
 :
 : Copyright                The cagrid consortium
 :
 : Module overview          Renders both types of value domain for viewing by the user of the metadata repository
 :
 :)

(:~
 :
 :    @author Steve Harris
 :    @version 1.0
 :
 :    @author Rakesh Dhaval
 :    @version 3.0
~ :)

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

import module namespace
   lib-rendering="http://www.cagrid.org/xquery/library/rendering"
   at "../web/m-lib-rendering.xquery";

import module namespace
  value-meaning="http://www.cagrid.org/xquery/library/value-meaning"
  at "../library/m-value-meaning.xquery";

  import module namespace
  value-domain="http://www.cagrid.org/xquery/library/value-domain"
  at "../library/m-value-domain.xquery";

import module namespace
   administered-item="http://www.cagrid.org/xquery/library/administered-item"
   at "../library/m-administered-item.xquery";

import module namespace
  permissible-value="http://www.cagrid.org/xquery/library/permissible-value"
  at "../library/m-permissible-value.xquery";

import module namespace
  value="http://www.cagrid.org/xquery/library/value"
  at "../library/m-value.xquery";

declare namespace openMDR = "http://www.cagrid.org/schema/openMDR";
declare namespace ISO11179= "http://www.cagrid.org/schema/ISO11179";
declare namespace request="http://exist-db.org/xquery/request";
declare namespace session="http://exist-db.org/xquery/session";
declare namespace util="http://exist-db.org/xquery/util";
(: Using eXist-predefined namespace: xmldb :)

declare option exist:serialize "media-type=text/html method=xhtml doctype-public=-//W3C//DTD XHTML 1.0 Transitional//EN doctype-system=http://www.w3.org/TR/2002/REC-xhtml1-20020801/DTD/xhtml1-transitional.dtd";

session:create(),

let $compound_id := request:get-parameter("compound_id", "")
let $administered_item := lib-util:mdrElement("value_domain", $compound_id)

   (:
   let $log := util:log-system-err($administered_item)
   let $log := util:log-system-err(permissible-value:contained_in($administered_item))
   let $log := util:log-system-err(permissible_value/openMDR:contained_in/text())/openMDR:value_meaning_description :)
return
    if (request:get-parameter("as-xml",()))
    then (lib-rendering:as-xml($administered_item))
   else(
      let $administered_item_name := administered-item:preferred-name($administered_item)
      let $representation_class_id := xs:string($administered_item//openMDR:typed_by)
      let $conceptual_domain_id := $administered_item//openMDR:representing/text()
      let $conceptual_domain := lib-util:mdrElement("conceptual_domain", $conceptual_domain_id)
      let $values := $administered_item//openMDR:value_item
      let $permissible_value_begin_date := $administered_item//openMDR:permissible_value_begin_date
      let $title:=concat('Value Domain: ',$administered_item_name)

      let $content :=
  {
            lib-rendering:render_administered_item($administered_item),
            if (lower-case(local-name($administered_item))='non_enumerated_value_domain') then
            ()
            else
            (

Permissible values

                    {

permissible value

value meaning

begin date

                            {

                               if ($conceptual_domain//openMDR:value_meaning_description > '')
                               then
                               (
                                    for $meaning at $pos in $conceptual_domain//openMDR:value_meaning_description
                                    return (

                                          {$values[$pos]}
                                          {$meaning}
                                          {$permissible_value_begin_date[$pos]/text()}

                                    )
                               )
                               else ()

                            }

                    }

            ),

         lib-rendering:render_value_domain_common_properties($administered_item),
         lib-rendering:related-administered-items($administered_item),
         lib-rendering:value_domain_used_in_data_elements($compound_id)
      }

      return
         lib-rendering:txfrm-webpage($title, $content, true(),  true(), $compound_id, 'value_domain.xquery','../edit/editValueDomain.xquery')
   )

xquery version "1.0";

(: ~
 : Module Name:             Value domain webpage
 :
 : Module Version           3.0
 :
 : Date                     27th September 2006
 :
 : Copyright                The cagrid consortium
 :
 : Module overview          Renders both types of value domain for viewing by the user of the metadata repository
 :
 :)

(:~
 :
 :    @author Steve Harris
 :    @version 1.0
~ :)

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

import module namespace
   lib-rendering="http://www.cagrid.org/xquery/library/rendering"
   at "../web/m-lib-rendering.xquery";

import module namespace
  value-meaning="http://www.cagrid.org/xquery/library/value-meaning"
  at "../library/m-value-meaning.xquery";

  import module namespace
  value-domain="http://www.cagrid.org/xquery/library/value-domain"
  at "../library/m-value-domain.xquery";

import module namespace
   administered-item="http://www.cagrid.org/xquery/library/administered-item"
   at "../library/m-administered-item.xquery";

import module namespace
  permissible-value="http://www.cagrid.org/xquery/library/permissible-value"
  at "../library/m-permissible-value.xquery";

import module namespace
  value="http://www.cagrid.org/xquery/library/value"
  at "../library/m-value.xquery";

declare namespace openMDR = "http://www.cagrid.org/schema/openMDR";
declare namespace ISO11179= "http://www.cagrid.org/schema/ISO11179";
declare namespace request="http://exist-db.org/xquery/request";
declare namespace session="http://exist-db.org/xquery/session";
(: Using eXist-predefined namespace: xmldb :)

declare option exist:serialize "media-type=text/html method=xhtml doctype-public=-//W3C//DTD XHTML 1.0 Transitional//EN doctype-system=http://www.w3.org/TR/2002/REC-xhtml1-20020801/DTD/xhtml1-transitional.dtd";

session:create(),

let $compound_id := request:get-parameter("compound_id", "")

let $administered_item := lib-util:mdrElement("value_domain", $compound_id)

return
    if (request:get-parameter("as-xml",()))
    then (lib-rendering:as-xml($administered_item))
   else(
      let $administered_item_name := administered-item:preferred-name($administered_item)
      let $representation_class_id := xs:string($administered_item//openMDR:typed_by)
      let $conceptual_domain_id := $administered_item//openMDR:representing/text()

      let $title:=concat('Value Domain: ',$administered_item_name)

      let $content :=
  {
            lib-rendering:render_administered_item($administered_item),
            if (lower-case(local-name($administered_item))='non_enumerated_value_domain') then
            ()
            else
            (

Permissible values

                    {

permissible value

value meaning

begin date

                            {
                               for $permissible_value  in permissible-value:contained_in($administered_item)
                                  let $value := value:used_in($permissible_value)
                                  order by $value
                                  return

                                             {if ($value) then value:item($value) else ()}

                                             {
                                               string-join(
                                                   for $meaning in value-meaning:value-meaning($permissible_value/openMDR:contained_in/text())/openMDR:value_meaning_description
                                                   order by $meaning ascending
                                                   return $meaning, (: The sorting gives deterministic behaviour that is good for regression testing :)
                                                   " | "
                                               )
                                             }

                                           {permissible-value:begin_date($permissible_value)}

                      }

                    }

            ),

         lib-rendering:render_value_domain_common_properties($administered_item),
         lib-rendering:related-administered-items($administered_item),
         lib-rendering:value_domain_used_in_data_elements($compound_id)
      }

      return
         lib-rendering:txfrm-webpage($title, $content, true(),  true(), $compound_id, 'value_domain.xquery','../edit/editValueDomain.xquery')
   )