Updated documentation of datetime modules errors.

xquery version "3.0";

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

(:~
 :
This module provides functions to retrieve the current dateTime and to
 : parse dates and times.

 :

 :
In contrast to the current-dateTime functions specified in
 : XQuery Functions and
 : Operators, the functions in this module are nondeterministic, that is,
 : they do not return the current dateTime from the dynamic context, but return
 : the actual value.

 :

 :
Dates and times are parsed according to the format given by
 : strptime.

 :
However, date and time values must be "complete."

 :
For a date, the year and either month and day or day of the year must have
 : been parsed.

 :
For a time, the hour must have been parsed.
 : (If either the minute, second, or timezone has not been parsed, they default
 : to 0.)

 :
For a dateTime, the parsing requirements of both date and time must be met.

 :

 :
When a locale is given,
 : it must be of the form {lang}[{sep}{country}[{encoding}]] where
 : {lang} is an ISO 639-1 2-letter or 639-2 3-letter language code,
 : {sep} is either '-' or '_',
 : {country} is an ISO 3166-1 2-letter country code,
 : and {encoding} is any string that begins with a '.'.

 :
The {sep}, {country}, and {encoding} are optional;
 : {encoding} is always ignored.

 :
Examples include: de, en-US, fr_CA, ru_RU.UTF-8.

 :
 : @author Matthias Brantner
 : @author Paul J. Lucas
 : @see http://www.w3.org/TR/xpath-functions/#context
 : @project Zorba/XQuery Data Model/Atomic/Datetime
 :
 :)
module namespace datetime = "http://zorba.io/modules/datetime";

declare namespace an = "http://zorba.io/annotations";
declare namespace zerr = "http://zorba.io/errors";

declare namespace ver = "http://zorba.io/options/versioning";
declare option ver:module-version "2.0";

(:~
 :
Gets the current date value in Universal time.

 :
Note that this function is not stable: it returns the value of the date when
 : the function is invoked.

 :
 : @return the non-stable date value
 :)
declare %an:nondeterministic function datetime:current-date()
  as xs:date external;

(:~
 :
Gets the current dateTime value in Universal time.

 :
Note that this function is not stable: it returns the value of the date and
 : time when the function is invoked.

 :
 : @return the non-stable datetime value
 :)
declare %an:nondeterministic function datetime:current-dateTime()
  as xs:dateTimeStamp external;

(:~
 :
Return the current time value in Universal time.

 :
Note that this function is not stable: it returns the value of the time when
 : the function is invoked.

 :
 : @return the non-stable time value
 :)
declare %an:nondeterministic function datetime:current-time()
  as xs:time external;

(:~
 :
Parses a date from a string in the current locale.

 :
 : @param $input The string to parse.
 : @param $format The format string containing zero or more conversion
 : specifications and ordinary characters.  All ordinary characters are matched
 : exactly with the buffer; all whitespace characters match any amount of
 : whitespace in the buffer.
 : @return Returns an xs:date.
 : @error zerr:ZDTP0001_INVALID_SPECIFICATION if $format contains an invalid conversion specification.
 : @error zerr:ZDTP0002_INSUFFICIENT_BUFFER if $input is insufficient for $format.
 : @error zerr:ZDTP0003_INVALID_VALUE if $input contains an invalid value for a conversion
 : specification.
 : @error zerr:ZDTP0004_LITERAL_MISMATCH if there is a literal characer mismatch between $input
 : and $format.
 : @error zerr:ZDTP0005_INCOMPLETE_DATE_OR_TIME if the date is incomplete.
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-date-uD-1.xq
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-date-uF-1.xq
 :)
declare function datetime:parse-date(
  $input as xs:string,
  $format as xs:string
) as xs:date external;

(:~
 :
Parses a date from a string in the given locale.

 :
 : @param $input The string to parse.
 : @param $format The format string containing zero or more conversion
 : specifications and ordinary characters.  All ordinary characters are matched
 : exactly with the buffer; all whitespace characters match any amount of
 : whitespace in the buffer.
 : @param $locale The locale to use.
 : @return Returns an xs:date.
 : @error zerr:ZDTP0001_INVALID_SPECIFICATION if $format contains an invalid conversion specification.
 : @error zerr:ZDTP0002_INSUFFICIENT_BUFFER if $input is insufficient for $format.
 : @error zerr:ZDTP0003_INVALID_VALUE if $input contains an invalid value for a conversion
 : specification.
 : @error zerr:ZDTP0004_LITERAL_MISMATCH if there is a literal characer mismatch between $input
 : and $format.
 : @error zerr:ZDTP0005_INCOMPLETE_DATE_OR_TIME if the date is incomplete.
 : @error zerr:ZXQP0011_INVALID_LOCALE if $locale is in an invalid format.
 : @error zerr:ZXQP0012_UNKNOWN_LOCALE if $locale is unknown.
 : @error zerr:ZOSE0007_UNSUPPORTED_LOCALE if $locale is unsupported by the operating system.
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-date-la-uD-1.xq
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-date-uA-uD-2.xq
 :)
declare function datetime:parse-date(
  $input as xs:string,
  $format as xs:string,
  $locale as xs:string
) as xs:date external;

(:~
 :
Parses a dateTime from a string in the current locale.

 :
 : @param $input The string to parse.
 : @param $format The format string containing zero or more conversion
 : specifications and ordinary characters.  All ordinary characters are matched
 : exactly with the buffer; all whitespace characters match any amount of
 : whitespace in the buffer.
 : @return Returns an xs:dateTime.
 : @error zerr:ZDTP0001_INVALID_SPECIFICATION if $format contains an invalid conversion specification.
 : @error zerr:ZDTP0002_INSUFFICIENT_BUFFER if $input is insufficient for $format.
 : @error zerr:ZDTP0003_INVALID_VALUE if $input contains an invalid value for a conversion
 : specification.
 : @error zerr:ZDTP0004_LITERAL_MISMATCH if there is a literal characer mismatch between $input
 : and $format.
 : @error zerr:ZDTP0005_INCOMPLETE_DATE_OR_TIME if either the date or time is incomplete.
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-dateTime-uFTZ-1.xq
 :)
declare function datetime:parse-dateTime(
  $input as xs:string,
  $format as xs:string
) as xs:dateTime external;

(:~
 :
Parses a dateTime from a string in the given locale.

 :
 : @param $input The string to parse.
 : @param $format The format string containing zero or more conversion
 : specifications and ordinary characters.  All ordinary characters are matched
 : exactly with the buffer; all whitespace characters match any amount of
 : whitespace in the buffer.
 : @param $locale The locale to use.
 : @return Returns an xs:dateTime.
 : @error zerr:ZDTP0001_INVALID_SPECIFICATION if $format contains an invalid conversion specification.
 : @error zerr:ZDTP0002_INSUFFICIENT_BUFFER if $input is insufficient for $format.
 : @error zerr:ZDTP0003_INVALID_VALUE if $input contains an invalid value for a conversion
 : specification.
 : @error zerr:ZDTP0004_LITERAL_MISMATCH if there is a literal characer mismatch between $input
 : and $format.
 : @error zerr:ZDTP0005_INCOMPLETE_DATE_OR_TIME if either the date or time is incomplete.
 : @error zerr:ZXQP0011_INVALID_LOCALE if $locale is in an invalid format.
 : @error zerr:ZXQP0012_UNKNOWN_LOCALE if $locale is unknown.
 : @error zerr:ZOSE0007_UNSUPPORTED_LOCALE if $locale is unsupported by the operating system.
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-dateTime-uAB-ld-uYTZ-1.xq
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-dateTime-uAB-ld-uYTZ-2.xq
 :)
declare function datetime:parse-dateTime(
  $input as xs:string,
  $format as xs:string,
  $locale as xs:string
) as xs:dateTime external;

(:~
 :
Parses a time from a string in the current locale.

 :
 : @param $input The string to parse.
 : @param $format The format string containing zero or more conversion
 : specifications and ordinary characters.  All ordinary characters are matched
 : exactly with the buffer; all whitespace characters match any amount of
 : whitespace in the buffer.
 : @return Returns an xs:time.
 : @error zerr:ZDTP0001_INVALID_SPECIFICATION if $format contains an invalid conversion specification.
 : @error zerr:ZDTP0002_INSUFFICIENT_BUFFER if $input is insufficient for $format.
 : @error zerr:ZDTP0003_INVALID_VALUE if $input contains an invalid value for a conversion
 : specification.
 : @error zerr:ZDTP0004_LITERAL_MISMATCH if there is a literal characer mismatch between $input
 : and $format.
 : @error zerr:ZDTP0005_INCOMPLETE_DATE_OR_TIME if the hour has not been parsed.
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-time-uH-1.xq
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-time-uIMS-1.xq
 :)
declare function datetime:parse-time(
  $input as xs:string,
  $format as xs:string
) as xs:time external;

(:~
 :
Parses a time from a string in the given locale.

 :
 : @param $input The string to parse.
 : @param $format The format string containing zero or more conversion
 : specifications and ordinary characters.  All ordinary characters are matched
 : exactly with the buffer; all whitespace characters match any amount of
 : whitespace in the buffer.
 : @param $locale The locale to use.
 : @return Returns an xs:time.
 : @error zerr:ZDTP0001_INVALID_SPECIFICATION if $format contains an invalid conversion specification.
 : @error zerr:ZDTP0002_INSUFFICIENT_BUFFER if $input is insufficient for $format.
 : @error zerr:ZDTP0003_INVALID_VALUE if $input contains an invalid value for a conversion
 : specification.
 : @error zerr:ZDTP0004_LITERAL_MISMATCH if there is a literal characer mismatch between $input
 : and $format.
 : @error zerr:ZDTP0005_INCOMPLETE_DATE_OR_TIME if the hour has not been parsed.
 : @error zerr:ZXQP0011_INVALID_LOCALE if $locale is in an invalid format.
 : @error zerr:ZXQP0012_UNKNOWN_LOCALE if $locale is unknown.
 : @error zerr:ZOSE0007_UNSUPPORTED_LOCALE if $locale is unsupported by the operating system.
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-time-lr-1.xq
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-time-lr-2.xq
 :)
declare function datetime:parse-time(
  $input as xs:string,
  $format as xs:string,
  $locale as xs:string
) as xs:time external;

(:~
 :
Converts the given number of milliseconds since epoch into its corresponding
 : xs:dateTime.

 :
 : @param $millis The number of milliseconds since epoch.
 : @return Returns an xs:dateTime.
 : @example test/rbkt/Queries/zorba/datetime/datetime-millis-to-dateTime-1.xq
 :)
declare function datetime:millis-to-dateTime( $millis as xs:long )
  as xs:dateTime external;

(:~
 :
Gets the the number of milliseconds since epoch.

 :
 : @return the said number of milliseconds.
 :)
declare %an:nondeterministic function datetime:timestamp()
  as xs:long external;

(:~
 :
Gets the offset of the current timezone from Universal time.

 :
 : @return the offset in seconds with positive values being east of the prime
 : meridian.
 :)
declare %an:nondeterministic function datetime:utc-offset()
  as xs:long external;

(: vim:set et sw=2 ts=2: :)

xquery version "3.0";

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

(:~
 :
This module provides functions to retrieve the current dateTime and to
 : parse dates and times.

 :

 :
In contrast to the current-dateTime functions specified in
 : XQuery Functions and
 : Operators, the functions in this module are nondeterministic, that is,
 : they do not return the current dateTime from the dynamic context, but return
 : the actual value.

 :

 :
Dates and times are parsed according to the format given by
 : strptime.

 :
However, date and time values must be "complete."

 :
For a date, the year and either month and day or day of the year must have
 : been parsed.

 :
For a time, the hour must have been parsed.
 : (If either the minute, second, or timezone has not been parsed, they default
 : to 0.)

 :
For a dateTime, the parsing requirements of both date and time must be met.

 :

 :
When a locale is given,
 : it must be of the form {lang}[{sep}{country}[{encoding}]] where
 : {lang} is an ISO 639-1 2-letter or 639-2 3-letter language code,
 : {sep} is either '-' or '_',
 : {country} is an ISO 3166-1 2-letter country code,
 : and {encoding} is any string that begins with a '.'.

 :
The {sep}, {country}, and {encoding} are optional;
 : {encoding} is always ignored.

 :
Examples include: de, en-US, fr_CA, ru_RU.UTF-8.

 :
 : @author Matthias Brantner
 : @author Paul J. Lucas
 : @see http://www.w3.org/TR/xpath-functions/#context
 : @project Zorba/XQuery Data Model/Atomic/Datetime
 :
 :)
module namespace datetime = "http://zorba.io/modules/datetime";

declare namespace an = "http://zorba.io/annotations";
declare namespace zerr = "http://zorba.io/errors";

declare namespace ver = "http://zorba.io/options/versioning";
declare option ver:module-version "2.0";

(:~
 :
Gets the current date value in Universal time.

 :
Note that this function is not stable: it returns the value of the date when
 : the function is invoked.

 :
 : @return the non-stable date value
 :)
declare %an:nondeterministic function datetime:current-date()
  as xs:date external;

(:~
 :
Gets the current dateTime value in Universal time.

 :
Note that this function is not stable: it returns the value of the date and
 : time when the function is invoked.

 :
 : @return the non-stable datetime value
 :)
declare %an:nondeterministic function datetime:current-dateTime()
  as xs:dateTimeStamp external;

(:~
 :
Return the current time value in Universal time.

 :
Note that this function is not stable: it returns the value of the time when
 : the function is invoked.

 :
 : @return the non-stable time value
 :)
declare %an:nondeterministic function datetime:current-time()
  as xs:time external;

(:~
 :
Parses a date from a string in the current locale.

 :
 : @param $input The string to parse.
 : @param $format The format string containing zero or more conversion
 : specifications and ordinary characters.  All ordinary characters are matched
 : exactly with the buffer; all whitespace characters match any amount of
 : whitespace in the buffer.
 : @return Returns an xs:date.
 : @error zerr:ZDTP0001 if $format contains an invalid conversion specification.
 : @error zerr:ZDTP0002 if $input is insufficient for $format.
 : @error zerr:ZDTP0003 if $input contains an invalid value for a conversion
 : specification.
 : @error zerr:ZDTP0004 if there is a literal characer mismatch between $input
 : and $format.
 : @error zerr:ZDTP0005 if the date is incomplete.
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-date-uD-1.xq
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-date-uF-1.xq
 :)
declare function datetime:parse-date(
  $input as xs:string,
  $format as xs:string
) as xs:date external;

(:~
 :
Parses a date from a string in the given locale.

 :
 : @param $input The string to parse.
 : @param $format The format string containing zero or more conversion
 : specifications and ordinary characters.  All ordinary characters are matched
 : exactly with the buffer; all whitespace characters match any amount of
 : whitespace in the buffer.
 : @param $locale The locale to use.
 : @return Returns an xs:date.
 : @error zerr:ZDTP0001 if $format contains an invalid conversion specification.
 : @error zerr:ZDTP0002 if $input is insufficient for $format.
 : @error zerr:ZDTP0003 if $input contains an invalid value for a conversion
 : specification.
 : @error zerr:ZDTP0004 if there is a literal characer mismatch between $input
 : and $format.
 : @error zerr:ZDTP0005 if the date is incomplete.
 : @error zerr:ZXQP0011 if $locale is in an invalid format.
 : @error zerr:ZXQP0012 if $locale is unknown.
 : @error zerr:ZOSE0007 if $locale is unsupported by the operating system.
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-date-la-uD-1.xq
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-date-uA-uD-2.xq
 :)
declare function datetime:parse-date(
  $input as xs:string,
  $format as xs:string,
  $locale as xs:string
) as xs:date external;

(:~
 :
Parses a dateTime from a string in the current locale.

 :
 : @param $input The string to parse.
 : @param $format The format string containing zero or more conversion
 : specifications and ordinary characters.  All ordinary characters are matched
 : exactly with the buffer; all whitespace characters match any amount of
 : whitespace in the buffer.
 : @return Returns an xs:dateTime.
 : @error zerr:ZDTP0001 if $format contains an invalid conversion specification.
 : @error zerr:ZDTP0002 if $input is insufficient for $format.
 : @error zerr:ZDTP0003 if $input contains an invalid value for a conversion
 : specification.
 : @error zerr:ZDTP0004 if there is a literal characer mismatch between $input
 : and $format.
 : @error zerr:ZDTP0005 if either the date or time is incomplete.
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-dateTime-uFTZ-1.xq
 :)
declare function datetime:parse-dateTime(
  $input as xs:string,
  $format as xs:string
) as xs:dateTime external;

(:~
 :
Parses a dateTime from a string in the given locale.

 :
 : @param $input The string to parse.
 : @param $format The format string containing zero or more conversion
 : specifications and ordinary characters.  All ordinary characters are matched
 : exactly with the buffer; all whitespace characters match any amount of
 : whitespace in the buffer.
 : @param $locale The locale to use.
 : @return Returns an xs:dateTime.
 : @error zerr:ZDTP0001 if $format contains an invalid conversion specification.
 : @error zerr:ZDTP0002 if $input is insufficient for $format.
 : @error zerr:ZDTP0003 if $input contains an invalid value for a conversion
 : specification.
 : @error zerr:ZDTP0004 if there is a literal characer mismatch between $input
 : and $format.
 : @error zerr:ZDTP0005 if either the date or time is incomplete.
 : @error zerr:ZXQP0011 if $locale is in an invalid format.
 : @error zerr:ZXQP0012 if $locale is unknown.
 : @error zerr:ZOSE0007 if $locale is unsupported by the operating system.
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-dateTime-uAB-ld-uYTZ-1.xq
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-dateTime-uAB-ld-uYTZ-2.xq
 :)
declare function datetime:parse-dateTime(
  $input as xs:string,
  $format as xs:string,
  $locale as xs:string
) as xs:dateTime external;

(:~
 :
Parses a time from a string in the current locale.

 :
 : @param $input The string to parse.
 : @param $format The format string containing zero or more conversion
 : specifications and ordinary characters.  All ordinary characters are matched
 : exactly with the buffer; all whitespace characters match any amount of
 : whitespace in the buffer.
 : @return Returns an xs:time.
 : @error zerr:ZDTP0001 if $format contains an invalid conversion specification.
 : @error zerr:ZDTP0002 if $input is insufficient for $format.
 : @error zerr:ZDTP0003 if $input contains an invalid value for a conversion
 : specification.
 : @error zerr:ZDTP0004 if there is a literal characer mismatch between $input
 : and $format.
 : @error zerr:ZDTP0005 if the hour has not been parsed.
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-time-uH-1.xq
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-time-uIMS-1.xq
 :)
declare function datetime:parse-time(
  $input as xs:string,
  $format as xs:string
) as xs:time external;

(:~
 :
Parses a time from a string in the given locale.

 :
 : @param $input The string to parse.
 : @param $format The format string containing zero or more conversion
 : specifications and ordinary characters.  All ordinary characters are matched
 : exactly with the buffer; all whitespace characters match any amount of
 : whitespace in the buffer.
 : @param $locale The locale to use.
 : @return Returns an xs:time.
 : @error zerr:ZDTP0001 if $format contains an invalid conversion specification.
 : @error zerr:ZDTP0002 if $input is insufficient for $format.
 : @error zerr:ZDTP0003 if $input contains an invalid value for a conversion
 : specification.
 : @error zerr:ZDTP0004 if there is a literal characer mismatch between $input
 : and $format.
 : @error zerr:ZDTP0005 if the hour has not been parsed.
 : @error zerr:ZXQP0011 if $locale is in an invalid format.
 : @error zerr:ZXQP0012 if $locale is unknown.
 : @error zerr:ZOSE0007 if $locale is unsupported by the operating system.
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-time-lr-1.xq
 : @example test/rbkt/Queries/zorba/datetime/datetime-parse-time-lr-2.xq
 :)
declare function datetime:parse-time(
  $input as xs:string,
  $format as xs:string,
  $locale as xs:string
) as xs:time external;

(:~
 :
Converts the given number of milliseconds since epoch into its corresponding
 : xs:dateTime.

 :
 : @param $millis The number of milliseconds since epoch.
 : @return Returns an xs:dateTime.
 : @example test/rbkt/Queries/zorba/datetime/datetime-millis-to-dateTime-1.xq
 :)
declare function datetime:millis-to-dateTime( $millis as xs:long )
  as xs:dateTime external;

(:~
 :
Gets the the number of milliseconds since epoch.

 :
 : @return the said number of milliseconds.
 :)
declare %an:nondeterministic function datetime:timestamp()
  as xs:long external;

(:~
 :
Gets the offset of the current timezone from Universal time.

 :
 : @return the offset in seconds with positive values being east of the prime
 : meridian.
 :)
declare %an:nondeterministic function datetime:utc-offset()
  as xs:long external;

(: vim:set et sw=2 ts=2: :)


Fixed display: elapsed query time

Fixed display: elapsed query time

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

xquery version "1.0";

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

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

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

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

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

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

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

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

};

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

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

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

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

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

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

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

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

xquery version "1.0";

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

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

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

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

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

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

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

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

};

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

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

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

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

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

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

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

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


[ignore] fixed type error in kwic script.

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

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

declare variable $kwic:CHARS_SUMMARY := 120;
declare variable $kwic:CHARS_KWIC := 40;

(:~
	Retrieve the following and preceding text chunks for a given match.

	@param $match the text node containing the match
	@param $mode the selection mode: either "previous" or "following"
:)
declare function kwic:get-context($match as element(exist:match), $mode as xs:string) as node()* {
	let $sibs :=
		if ($mode eq 'previous') then
			$match/preceding::text()
		else
			$match/text()/following::text()
	for $sib in $sibs
	return
		if ($sib/parent::exist:match) then
			{$sib}
		else
			$sib
};

(:~
	Like fn:substring, but takes a node argument. If the node is an element,
	a new element is created with the same node-name as the old one and the
	shortened text content.
:)
declare function kwic:substring($node as node(), $start as xs:int, $count as xs:int) as item()? {
	let $str := substring($node, $start, $count)
	return
		if ($node instance of element()) then
			element { node-name($node) } { $str }
		else
			$str
};

(:~
	Generate the left-hand context of the match. Returns a sequence of nodes
	and strings, whose total string length is less than or equal to $max characters.

	Note: this function calls itself recursively until $nodes is empty or
	the returned sequence has the desired total string length.
:)
declare function kwic:truncate-previous($nodes as node()*, $truncated as item()*,
	$max as xs:int, $chars as xs:int) {
	if ($nodes) then
		let $next := $nodes[last()]
		return
			if ($chars + string-length($next) gt $max) then
				let $remaining := $max - $chars
				return
					("...", kwic:substring($next, string-length($next) - $remaining, $remaining), $truncated)
			else
				kwic:truncate-previous(subsequence($nodes, 1, count($nodes) - 1), ($next, $truncated),
					$max, $chars + string-length($next))
	else
		$truncated
};

(:~
	Generate the right-hand context of the match. Returns a sequence of nodes
	and strings, whose total string length is less than or equal to $max characters.

	Note: this function calls itself recursively until $nodes is empty or
	the returned sequence has the desired total string length.
:)
declare function kwic:truncate-following($nodes as node()*, $truncated as item()*,
	$max as xs:int, $chars as xs:int) {
	if ($nodes) then
		let $next := $nodes[1]
		return
			if ($chars + string-length($next) gt $max) then
				let $remaining := $max - $chars
				return
					($truncated, kwic:substring($next, 1, $remaining), "...")
			else
				kwic:truncate-following(subsequence($nodes, 2), ($truncated, $next),
					$max, $chars + string-length($next))
	else
		$truncated
};

(:~
	Computes the total string length of the nodes in the argument sequence
:)
declare function kwic:string-length($nodes as item()*) as xs:integer {
	if (exists($nodes)) then
		sum(for $n in $nodes return string-length($n))
	else
		0
};

(:~
	Print a summary of the match in $node. Output a predefined amount of text to
	the left and the right of the match.

	@param $root the root element containing the match. This is the original element
		   stored in the database.
	@param $node the exist:match element to process.
	@param $config configuration element which determines the behaviour of the function
:)
declare function kwic:get-summary($root as node(), $node as element(exist:match),
	$config as element(config)) as element() {
	let $chars := xs:int($config/@width)
	let $table := $config/@table = ('yes', 'true')
	let $prev := kwic:get-context($node, 'previous')
	let $prevTrunc := kwic:truncate-previous($prev, (), $chars, 0)
	let $remain :=
		if (not($table)) then
			$chars * 2 - kwic:string-length($prevTrunc)
		else
			$chars
	let $following := kwic:get-context($node, 'following')
	let $followingTrunc := kwic:truncate-following($following, (), $remain, 0)
	return
		if (not($table)) then

				{$prevTrunc}
				{
					if ($config/@link) then
						{ $node/text() }
					else
						{ $node/text() }
				}
				{$followingTrunc}

		else

				{$prevTrunc}

				{
					if ($config/@link) then
						{$node/text()}
					else
						$node/text()
				}

				{$followingTrunc}

};

(:~
	Main function of the KWIC module: takes the passed element and returns an
	XHTML fragment containing a chunk of text before and after the first full text
	match in the node.

	The optional config parameter is used to configure the behaviour of the function:

	<config width="character width" table="yes|no" link="URL to which the match is linked"/>

	By default, kwic:summarize returns an XHTML fragment with the following structure:

	<p xmlns="http://www.w3.org/1999/xhtml">
		<span class="previous">Text before match</span>
		<a href="passed URL if any" class="hi">The highlighted term</a>
		<span class="following">Text after match</span>
	</p>

	If table=yes is passed with the config element, a tr table row will be returned instead
	of a span (using the same class names).

	@param $hit an arbitrary XML element which has been selected by one of the full text
		operations or an ngram search.
	@param $config configuration element to configure the behaviour of the function
:)
declare function kwic:summarize($hit as element(), $config as element(config))
as element()* {
	let $expanded := util:expand($hit)
	for $match in $expanded//exist:match[1]
	return
		kwic:get-summary($hit, $match, $config)
};

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

declare variable $kwic:CHARS_SUMMARY := 120;
declare variable $kwic:CHARS_KWIC := 40;

(:~
	Retrieve the following and preceding text chunks for a given match.

	@param $match the text node containing the match
	@param $mode the selection mode: either "previous" or "following"
:)
declare function kwic:get-context($match as element(exist:match), $mode as xs:string) as node()* {
	let $sibs :=
		if ($mode eq 'previous') then
			$match/preceding::text()
		else
			$match/text()/following::text()
	for $sib in $sibs
	return
		if ($sib/parent::exist:match) then
			{$sib}
		else
			$sib
};

(:~
	Like fn:substring, but takes a node argument. If the node is an element,
	a new element is created with the same node-name as the old one and the
	shortened text content.
:)
declare function kwic:substring($node as node(), $start as xs:int, $count as xs:int) as item()? {
	let $str := substring($node, $start, $count)
	return
		if ($node instance of element()) then
			element { node-name($node) } { $str }
		else
			$str
};

(:~
	Generate the left-hand context of the match. Returns a sequence of nodes
	and strings, whose total string length is less than or equal to $max characters.

	Note: this function calls itself recursively until $nodes is empty or
	the returned sequence has the desired total string length.
:)
declare function kwic:truncate-previous($nodes as node()*, $truncated as item()*,
	$max as xs:int, $chars as xs:int) {
	if ($nodes) then
		let $next := $nodes[last()]
		return
			if ($chars + string-length($next) gt $max) then
				let $remaining := $max - $chars
				return
					("...", kwic:substring($next, string-length($next) - $remaining, $remaining), $truncated)
			else
				kwic:truncate-previous(subsequence($nodes, 1, count($nodes) - 1), ($next, $truncated),
					$max, $chars + string-length($next))
	else
		$truncated
};

(:~
	Generate the right-hand context of the match. Returns a sequence of nodes
	and strings, whose total string length is less than or equal to $max characters.

	Note: this function calls itself recursively until $nodes is empty or
	the returned sequence has the desired total string length.
:)
declare function kwic:truncate-following($nodes as node()*, $truncated as item()*,
	$max as xs:int, $chars as xs:int) {
	if ($nodes) then
		let $next := $nodes[1]
		return
			if ($chars + string-length($next) gt $max) then
				let $remaining := $max - $chars
				return
					($truncated, kwic:substring($next, 1, $remaining), "...")
			else
				kwic:truncate-following(subsequence($nodes, 2), ($truncated, $next),
					$max, $chars + string-length($next))
	else
		$truncated
};

(:~
	Computes the total string length of the nodes in the argument sequence
:)
declare function kwic:string-length($nodes as item()*) as xs:int {
	if (exists($nodes)) then
		sum(for $n in $nodes return string-length($n))
	else
		0
};

(:~
	Print a summary of the match in $node. Output a predefined amount of text to
	the left and the right of the match.

	@param $root the root element containing the match. This is the original element
		   stored in the database.
	@param $node the exist:match element to process.
	@param $config configuration element which determines the behaviour of the function
:)
declare function kwic:get-summary($root as node(), $node as element(exist:match),
	$config as element(config)) as element() {
	let $chars := xs:int($config/@width)
	let $table := $config/@table = ('yes', 'true')
	let $prev := kwic:get-context($node, 'previous')
	let $prevTrunc := kwic:truncate-previous($prev, (), $chars, 0)
	let $remain :=
		if (not($table)) then
			$chars * 2 - kwic:string-length($prevTrunc)
		else
			$chars
	let $following := kwic:get-context($node, 'following')
	let $followingTrunc := kwic:truncate-following($following, (), $remain, 0)
	return
		if (not($table)) then

				{$prevTrunc}
				{
					if ($config/@link) then
						{ $node/text() }
					else
						{ $node/text() }
				}
				{$followingTrunc}

		else

				{$prevTrunc}

				{
					if ($config/@link) then
						{$node/text()}
					else
						$node/text()
				}

				{$followingTrunc}

};

(:~
	Main function of the KWIC module: takes the passed element and returns an
	XHTML fragment containing a chunk of text before and after the first full text
	match in the node.

	The optional config parameter is used to configure the behaviour of the function:

	<config width="character width" table="yes|no" link="URL to which the match is linked"/>

	By default, kwic:summarize returns an XHTML fragment with the following structure:

	<p xmlns="http://www.w3.org/1999/xhtml">
		<span class="previous">Text before match</span>
		<a href="passed URL if any" class="hi">The highlighted term</a>
		<span class="following">Text after match</span>
	</p>

	If table=yes is passed with the config element, a tr table row will be returned instead
	of a span (using the same class names).

	@param $hit an arbitrary XML element which has been selected by one of the full text
		operations or an ngram search.
	@param $config configuration element to configure the behaviour of the function
:)
declare function kwic:summarize($hit as element(), $config as element(config))
as element()* {
	let $expanded := util:expand($hit)
	for $match in $expanded//exist:match[1]
	return
		kwic:get-summary($hit, $match, $config)
};


added POST endpoint  <URI>csr/<DOC>/careServicesRequest/<STORED QUERY URN>


SVS -  add support to insert from not a file

(:~
: This is the Care Services Discovery stored query registry
: @version 1.0
: @see https://github.com/openhie/openinfoman
:
:)
module namespace svs_lsvs = "https://github.com/openhie/openinfoman/svs_lsvs";
import module namespace file = "http://expath.org/ns/file";
import module namespace functx = "http://www.functx.com";
declare namespace svs = "urn:ihe:iti:svs:2008";

(:WARNING: ValueSet have @id while DesribedValueSet has @ID:)

declare variable $svs_lsvs:vers := "1.1";
declare variable $svs_lsvs:base_path := concat(file:current-dir() ,'../resources/shared_value_sets/');
declare variable $svs_lsvs:valuesets_doc := "DescribedSharedValueSets.xml";
declare variable $svs_lsvs:sample_value_set_list := svs_lsvs:get_sample_value_set_list();
declare variable $svs_lsvs:blank_valuesets :=  <DescribedValueSets version="{$svs_lsvs:vers}"/>;

declare updating function svs_lsvs:init_store($db) {
  if (not(db:is-xml($db,$svs_lsvs:valuesets_doc))) then
    db:add($db, $svs_lsvs:blank_valuesets,$svs_lsvs:valuesets_doc)
  else
    ()
};

declare function svs_lsvs:store_exists($db) {
  db:is-xml($db,$svs_lsvs:valuesets_doc)
};

declare function svs_lsvs:sample_sets() {
  for $file in file:list($svs_lsvs:base_path,true(),'*.xml')
  return file:resolve-path(concat($svs_lsvs:base_path,"/",$file))
};

declare function svs_lsvs:get_sample_value_set_list() {
<DescribedValueSets version="{$svs_lsvs:vers}">
  {
  for $file in svs_lsvs:sample_sets()
  let $value_set_doc := doc($file)
  let $id :=text{$value_set_doc/svs:ValueSet/@id} (:ValueSet have @id while DesribedValueSet has @ID:)
  let $displayName :=text{$value_set_doc/svs:ValueSet/@displayName}
  let $version :=text{$value_set_doc/svs:ValueSet/@version}
  return
    if ($id)
      then
      <svs:DescribedValueSet ID="{$id}" file="{$file}" displayName="{$displayName}" version="{$version}"/>
    else (<noID>{$file}</noID>)
  }
</DescribedValueSets>
};

declare function svs_lsvs:get_all_value_set_list($db) {
  let $vsets := db:open($db,$svs_lsvs:valuesets_doc)
  let $existing_ids := distinct-values($vsets//svs:DescribedValueSet/@ID)
  let $available_ids := $svs_lsvs:sample_value_set_list//svs:DescribedValueSet/@ID
  return <DescribedValueSets version="{$svs_lsvs:vers}">
  {
    (
      for $id in $existing_ids
      return if ($id = $available_ids)
	then   $svs_lsvs:sample_value_set_list/svs:DescribedValueSet[@ID=$id]
      else  <svs:DescribedValueSet
	ID="{$id}"
	displayName="{$vsets//svs:DescribedValueSet[@ID = $id]/@displayName}"
	version="{$vsets//svs:DescribedValueSet[@ID = $id]/@version}"/>
      ,
      for $id in $available_ids
      where not($id = $existing_ids)
      return    $svs_lsvs:sample_value_set_list/svs:DescribedValueSet[@ID=$id]
      )
  }
  </DescribedValueSets>
};

declare function svs_lsvs:get_document_source($id) {
  text{$svs_lsvs:sample_value_set_list/svs:DescribedValueSet[@ID=$id]/@file}
};

declare function svs_lsvs:exists($db,$id) {
  svs_lsvs:store_exists($db)
  and
  exists(db:open($db,$svs_lsvs:valuesets_doc)//svs:DescribedValueSet[@ID = $id])
};

declare updating function svs_lsvs:load($db,$id) {
  if (not(svs_lsvs:exists($db,$id)))  then
    let $doc_source := svs_lsvs:get_document_source($id)
    return if (not($doc_source))
      then  ()
    else
      let $svs_sets := db:open($db,$svs_lsvs:valuesets_doc)/DescribedValueSets
      let $svs := parse-xml(file:read-text($doc_source))
      for $value_set in $svs//svs:ValueSet
      return svs_lsvs:insert($db,$value_set)
  else
    ()
};

declare updating function svs_lsvs:insert($db,$value_set) {
  let $vsets := db:open($db,$svs_lsvs:valuesets_doc)
  let $id := $value_set/@id
  let $version := $value_set/@version
  let $existing :=  $vsets//svs:DescribedValueSet[@ID = $id and @version = $version]
  let $described_val_set :=
    <svs:DescribedValueSet ID="{$id}" displayName="{$value_set/@displayName}" version="{$version}">
      {$value_set/*}
    </svs:DescribedValueSet>
  return
        if (exists($existing)) then
	  (
	    for $node in $existing return  delete node $node,
	    insert node $described_val_set into $vsets
	  )
      else
	insert node $described_val_set into $vsets
};

declare updating function svs_lsvs:reload($db,$id) {
  svs_lsvs:load($db,$id)
};

declare function svs_lsvs:get_multiple_described_value_sets($db,$filter) {
  let $dvs0 := db:open($db,$svs_lsvs:valuesets_doc)//svs:DescribedValueSet
  let $dvs1 := if (not($filter/@ID = '')) then $dvs0[@ID = $filter/@ID] else $dvs0
  let $dvs2 := if (not($filter/@DisplayNameContains = '')) then $dvs1[contains(@displayName,$filter/@DisplayNameContains)] else $dvs1
  let $dvs3 := if (not($filter/@SourceContains = '')) then $dvs2[contains(./svs:Source,$filter/@SourceContains)] else $dvs2
  let $dvs4 := if (not($filter/@PurposeContains = '')) then $dvs3[contains(./svs:Purpose,$filter/@PurposeContains)] else $dvs3
  let $dvs5 := if (not($filter/@DefinitionContains = '')) then $dvs4[contains(./svs:Definition,$filter/@DefinitionContains)] else $dvs4
  let $dvs6 := if (not($filter/@GroupContains = '')) then $dvs5[contains(./svs:Group,$filter/@GroupContains)] else $dvs5
  let $dvs7 := if (not($filter/@GroupOID = '')) then $dvs6[./svs:Group = $filter/@GroupOID] else $dvs6
  let $dvs8 := if (not($filter/@EffectiveDateBefore = '')) then $dvs7[./svs:EffectiveDate < @EffectiveDateBefore] else $dvs7
  let $dvs9 := if (not($filter/@EffectiveDateAfter = '')) then $dvs8[./svs:EffectiveDate > @EffectiveDateAfter] else $dvs8
  let $dvs10 := if (not($filter/@ExpirationDateBefore = '')) then $dvs9[./svs:ExpirationDate < @ExpirationDateBefore] else $dvs9
  let $dvs11 := if (not($filter/@ExpirationDateAfter = '')) then $dvs10[./svs:ExpirationDate > @ExpirationDateAfter] else $dvs10
  let $dvs12 := if (not($filter/@CreationDateBefore = '')) then $dvs11[./svs:CreationDate < @CreationDateBefore] else $dvs11
  let $dvs13 := if (not($filter/@CreationDateAfter = '')) then $dvs12[./svs:CreationDate > @CreationDateAfter] else $dvs12
  let $dvs14 := if (not($filter/@RevisionDateBefore = '')) then $dvs13[./svs:RevisionDate < @RevisionDateBefore] else $dvs13
  let $dvs15 := if (not($filter/@RevisionDateAfter = '')) then $dvs14[./svs:RevisionDate > @RevisionDateAfter] else $dvs14

  return  <svs:RetrieveMultipleValueSetsResponse >{$dvs15} </svs:RetrieveMultipleValueSetsResponse>

};

declare function svs_lsvs:get_single_version_value_set($db,$id) {
  svs_lsvs:get_single_version_value_set($db,$id,false())
};

declare function svs_lsvs:get_single_version_value_set($db,$id,$version) {
  svs_lsvs:get_single_version_value_set($db,$id,$version,false)
};

declare function svs_lsvs:get_single_version_value_set($db,$id, $version,$lang) {
  let $vs0 := db:open($db,$svs_lsvs:valuesets_doc)//svs:DescribedValueSet[@ID=$id]
  let $vers := if ($version)
     then $version
     else   functx:max-string ($vs0/@version)  (:NEEDS TO CHANGE:)
  let $vs1:= $vs0[@version = $vers]

  let $concept_lists :=
    if ($lang )
      then
      $vs1/svs:ConceptList[@xml:lang = $lang]
    else
      $vs1/svs:ConceptList

  return
  <svs:RetrieveValueSetResponse version="{$vers}" id="{$id}">
    {
      for $concept_list in $concept_lists
      let $val_set := $concept_list/..
      return
	(:ValueSet have @id while DesribedValueSet has @ID:)
	<svs:ValueSet id="{$val_set/@ID}" displayName="{$val_set/@displayName}" version="{$val_set/@version}">
	  {$concept_list}
	</svs:ValueSet>

    }
  </svs:RetrieveValueSetResponse>
};

declare function svs_lsvs:lookup_code($db,$code,$codeSystem) {
  svs_lsvs:lookup_code($db,$code,$codeSystem, false)
};

declare function svs_lsvs:lookup_code($db,$code,$codeSystem, $lang) {
  let $vs0 := db:open($db,$svs_lsvs:valuesets_doc)//svs:DescribedValueSet

  let $concept_lists :=
    if ($lang)
      then
      $vs0/svs:ConceptList[@xml:lang = $lang]
    else
      $vs0/svs:ConceptList

  let $concept :=  ($concept_lists/svs:Concept[@code = $code and @codeSystem = $codeSystem])[1]
  return string($concept/@displayName)

};

declare function svs_lsvs:get_single_version_code($db,$code,$id) {
  svs_lsvs:get_single_version_code($db,$code,$id, false())
};

declare function svs_lsvs:get_single_version_code($db,$code,$id, $version) {
  svs_lsvs:get_single_version_code($db,$code,$id, $version,false())
};

declare function svs_lsvs:get_single_version_code($db,$code,$id, $version,$lang) {
  let $vs0 := db:open($db,$svs_lsvs:valuesets_doc)//svs:DescribedValueSet[@ID=$id]
  let $vers := if (not($version = '')) then $version else max(xs:int($vs0/@version))
  let $vs1:= $vs0[@version = $vers]

  let $concept_lists :=
    if ($lang)
      then
      $vs1/svs:ConceptList[@xml:lang = $lang]
    else
      $vs1/svs:ConceptList

  let $concepts :=  $concept_lists/svs:Concept[@code = $code]

  return <RetrieveValueSetCodeResponse> (:Not to SVS standard :)
  {
    for $concept in $concepts
    let $concept_list := $concept/..
    let $val_set := $concept_list/..
    return
      (:ValueSet have @id while DesribedValueSet has @ID:)
    <svs:ValueSet id="{$val_set/@ID}" displayName="{$val_set/@displayName}" version="{$val_set/@version}">
      <svs:ConceptList xml:lang="$concept_list/@xml:lang">
	{$concept}
      </svs:ConceptList>
    </svs:ValueSet>
  }
  </RetrieveValueSetCodeResponse>
};

(:~
: This is the Care Services Discovery stored query registry
: @version 1.0
: @see https://github.com/openhie/openinfoman
:
:)
module namespace svs_lsvs = "https://github.com/openhie/openinfoman/svs_lsvs";
import module namespace file = "http://expath.org/ns/file";
declare namespace svs = "urn:ihe:iti:svs:2008";

(:WARNING: ValueSet have @id while DesribedValueSet has @ID:)

declare variable $svs_lsvs:vers := "1.1";
declare variable $svs_lsvs:base_path := concat(file:current-dir() ,'../resources/shared_value_sets/');
declare variable $svs_lsvs:valuesets_doc := "DescribedSharedValueSets.xml";
declare variable $svs_lsvs:sample_value_set_list := svs_lsvs:get_sample_value_set_list();
declare variable $svs_lsvs:blank_valuesets :=  <DescribedValueSets version="{$svs_lsvs:vers}"/>;

declare updating function svs_lsvs:init_store($db) {
  if (not(db:is-xml($db,$svs_lsvs:valuesets_doc))) then
    db:add($db, $svs_lsvs:blank_valuesets,$svs_lsvs:valuesets_doc)
  else
    ()
};

declare function svs_lsvs:store_exists($db) {
  db:is-xml($db,$svs_lsvs:valuesets_doc)
};

declare function svs_lsvs:sample_sets() {
  for $file in file:list($svs_lsvs:base_path,true(),'*.xml')
  return file:resolve-path(concat($svs_lsvs:base_path,"/",$file))
};

declare function svs_lsvs:get_sample_value_set_list() {
<DescribedValueSets version="{$svs_lsvs:vers}">
  {
  for $file in svs_lsvs:sample_sets()
  let $value_set_doc := doc($file)
  let $id :=text{$value_set_doc/svs:ValueSet/@id} (:ValueSet have @id while DesribedValueSet has @ID:)
  let $displayName :=text{$value_set_doc/svs:ValueSet/@displayName}
  let $version :=text{$value_set_doc/svs:ValueSet/@version}
  return
    if ($id)
      then
      <svs:DescribedValueSet ID="{$id}" file="{$file}" displayName="{$displayName}" version="{$version}"/>
    else (<noID>{$file}</noID>)
  }
</DescribedValueSets>
};

declare function svs_lsvs:get_all_value_set_list($db) {
  let $vsets := db:open($db,$svs_lsvs:valuesets_doc)
  let $existing_ids := $vsets//svs:DescribedValueSet/@ID
  let $available_ids := $svs_lsvs:sample_value_set_list//svs:DescribedValueSet/@ID
  return <DescribedValueSets version="{$svs_lsvs:vers}">
  {
    (
      for $id in $existing_ids
      return if ($id = $available_ids)
	then   $svs_lsvs:sample_value_set_list/svs:DescribedValueSet[@ID=$id]
      else  <svs:DescribedValueSet
	ID="{$id}"
	displayName="{$vsets//svs:DescribedValueSet[@ID = $id]/@displayName}"
	version="{$vsets//svs:DescribedValueSet[@ID = $id]/@version}"/>
      ,
      for $id in $available_ids
      where not($id = $existing_ids)
      return    $svs_lsvs:sample_value_set_list/svs:DescribedValueSet[@ID=$id]
      )
  }
  </DescribedValueSets>
};

declare function svs_lsvs:get_document_source($id) {
  text{$svs_lsvs:sample_value_set_list/svs:DescribedValueSet[@ID=$id]/@file}
};

declare function svs_lsvs:exists($db,$id) {
  svs_lsvs:store_exists($db)
  and
  exists(db:open($db,$svs_lsvs:valuesets_doc)//svs:DescribedValueSet[@ID = $id])
};

declare updating function svs_lsvs:load($db,$id) {
  if (not(svs_lsvs:exists($db,$id)))  then
    let $doc_source := svs_lsvs:get_document_source($id)
    return if (not($doc_source))
      then  ()
    else
      let $svs_sets := db:open($db,$svs_lsvs:valuesets_doc)/DescribedValueSets
      let $svs := parse-xml(file:read-text($doc_source))
      for $val_set in $svs//svs:ValueSet
      let $described_val_set :=
      <svs:DescribedValueSet ID="{$val_set/@id}" displayName="{$val_set/@displayName}" version="{$val_set/@version}">
	{$val_set/*}
      </svs:DescribedValueSet>
      return insert node $described_val_set into $svs_sets
  else
    ()
};

declare updating function svs_lsvs:reload($db,$id) {
  let $vsets := db:open($db,$svs_lsvs:valuesets_doc)
  let $existing := $vsets//svs:DescribedValueSet[@ID = $id]
  return
    if (exists($existing))
      then
        (delete node $existing,
	svs_lsvs:load($db,$id))
      else
	svs_lsvs:load($db,$id)
};

declare function svs_lsvs:get_multiple_described_value_sets($db,$filter) {
  let $dvs0 := db:open($db,$svs_lsvs:valuesets_doc)//svs:DescribedValueSet
  let $dvs1 := if (not($filter/@ID = '')) then $dvs0[@ID = $filter/@ID] else $dvs0
  let $dvs2 := if (not($filter/@DisplayNameContains = '')) then $dvs1[contains(@displayName,$filter/@DisplayNameContains)] else $dvs1
  let $dvs3 := if (not($filter/@SourceContains = '')) then $dvs2[contains(./svs:Source,$filter/@SourceContains)] else $dvs2
  let $dvs4 := if (not($filter/@PurposeContains = '')) then $dvs3[contains(./svs:Purpose,$filter/@PurposeContains)] else $dvs3
  let $dvs5 := if (not($filter/@DefinitionContains = '')) then $dvs4[contains(./svs:Definition,$filter/@DefinitionContains)] else $dvs4
  let $dvs6 := if (not($filter/@GroupContains = '')) then $dvs5[contains(./svs:Group,$filter/@GroupContains)] else $dvs5
  let $dvs7 := if (not($filter/@GroupOID = '')) then $dvs6[./svs:Group = $filter/@GroupOID] else $dvs6
  let $dvs8 := if (not($filter/@EffectiveDateBefore = '')) then $dvs7[./svs:EffectiveDate < @EffectiveDateBefore] else $dvs7
  let $dvs9 := if (not($filter/@EffectiveDateAfter = '')) then $dvs8[./svs:EffectiveDate > @EffectiveDateAfter] else $dvs8
  let $dvs10 := if (not($filter/@ExpirationDateBefore = '')) then $dvs9[./svs:ExpirationDate < @ExpirationDateBefore] else $dvs9
  let $dvs11 := if (not($filter/@ExpirationDateAfter = '')) then $dvs10[./svs:ExpirationDate > @ExpirationDateAfter] else $dvs10
  let $dvs12 := if (not($filter/@CreationDateBefore = '')) then $dvs11[./svs:CreationDate < @CreationDateBefore] else $dvs11
  let $dvs13 := if (not($filter/@CreationDateAfter = '')) then $dvs12[./svs:CreationDate > @CreationDateAfter] else $dvs12
  let $dvs14 := if (not($filter/@RevisionDateBefore = '')) then $dvs13[./svs:RevisionDate < @RevisionDateBefore] else $dvs13
  let $dvs15 := if (not($filter/@RevisionDateAfter = '')) then $dvs14[./svs:RevisionDate > @RevisionDateAfter] else $dvs14

  return  <svs:RetrieveMultipleValueSetsResponse >{$dvs15} </svs:RetrieveMultipleValueSetsResponse>

};

declare function svs_lsvs:get_single_version_value_set($db,$id) {
  svs_lsvs:get_single_version_value_set($db,$id,'')
};

declare function svs_lsvs:get_single_version_value_set($db,$id,$version) {
  svs_lsvs:get_single_version_value_set($db,$id,$version,'')
};

declare function svs_lsvs:get_single_version_value_set($db,$id, $version,$lang) {
  let $vs0 := db:open($db,$svs_lsvs:valuesets_doc)//svs:DescribedValueSet[@ID=$id]
  let $vers := if (not($version = '')) then $version else max(xs:int($vs0/@version))
  let $vs1:= $vs0[@version = $vers]

  let $concept_lists :=
    if (not($lang = ''))
      then
      $vs1/svs:ConceptList[@xml:lang = $lang]
    else
      $vs1/svs:ConceptList

  return
  <svs:RetrieveValueSetResponse version="{$vers}" id="{$id}">
    {
      for $concept_list in $concept_lists
      let $val_set := $concept_list/..
      return
	(:ValueSet have @id while DesribedValueSet has @ID:)
	<svs:ValueSet id="{$val_set/@ID}" displayName="{$val_set/@displayName}" version="{$val_set/@version}">
	  {$concept_list}
	</svs:ValueSet>

    }
  </svs:RetrieveValueSetResponse>
};

declare function svs_lsvs:lookup_code($db,$code,$codeSystem) {
  svs_lsvs:lookup_code($db,$code,$codeSystem, '')
};

declare function svs_lsvs:lookup_code($db,$code,$codeSystem, $lang) {
  let $vs0 := db:open($db,$svs_lsvs:valuesets_doc)//svs:DescribedValueSet

  let $concept_lists :=
    if (not($lang = ''))
      then
      $vs0/svs:ConceptList[@xml:lang = $lang]
    else
      $vs0/svs:ConceptList

  let $concept :=  ($concept_lists/svs:Concept[@code = $code and @codeSystem = $codeSystem])[1]
  return string($concept/@displayName)

};

declare function svs_lsvs:get_single_version_code($db,$code,$id) {
  svs_lsvs:get_single_version_code($db,$code,$id, '')
};

declare function svs_lsvs:get_single_version_code($db,$code,$id, $version) {
  svs_lsvs:get_single_version_code($db,$code,$id, $version,'')
};

declare function svs_lsvs:get_single_version_code($db,$code,$id, $version,$lang) {
  let $vs0 := db:open($db,$svs_lsvs:valuesets_doc)//svs:DescribedValueSet[@ID=$id]
  let $vers := if (not($version = '')) then $version else max(xs:int($vs0/@version))
  let $vs1:= $vs0[@version = $vers]

  let $concept_lists :=
    if (not($lang = ''))
      then
      $vs1/svs:ConceptList[@xml:lang = $lang]
    else
      $vs1/svs:ConceptList

  let $concepts :=  $concept_lists/svs:Concept[@code = $code]

  return <RetrieveValueSetCodeResponse> (:Not to SVS standard :)
  {
    for $concept in $concepts
    let $concept_list := $concept/..
    let $val_set := $concept_list/..
    return
      (:ValueSet have @id while DesribedValueSet has @ID:)
    <svs:ValueSet id="{$val_set/@ID}" displayName="{$val_set/@displayName}" version="{$val_set/@version}">
      <svs:ConceptList xml:lang="$concept_list/@xml:lang">
	{$concept}
      </svs:ConceptList>
    </svs:ValueSet>
  }
  </RetrieveValueSetCodeResponse>
};


Update BaseX CSV module functions for version 9.4.

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

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

declare option o:requires "basex/7.7.2";

declare %a:restrict-until("return", "basex", "7.8", "element(csv)")
        %a:restrict-until("return", "basex", "9.1", "document-node(element(csv))")
        %a:restrict-until("$string", "basex", "9.1", "xs:string")
        %a:since("basex", "7.7.2") function csv:parse($string as xs:string?) as item()? external;
declare %a:restrict-until("return", "basex", "7.8", "element(csv)")
        %a:restrict-until("return", "basex", "9.1", "document-node(element(csv))")
        %a:restrict-until("$string", "basex", "9.1", "xs:string")
        %a:restrict-since("$options", "basex", "8.2.1", "map(xs:string, item())")
        %a:restrict-since("$options", "basex", "8.6.7", "map(*)")
        %a:since("basex", "7.7.2") function csv:parse($string as xs:string?, $options as item()) as item()? external;
declare %a:restrict-until("$input", "basex", "8.6.7", "node()")
        %a:since("basex", "7.7.2") function csv:serialize($input as item()?) as xs:string external;
declare %a:restrict-until("$input", "basex", "8.6.7", "node()")
        %a:restrict-since("$options", "basex", "8.2.1", "map(xs:string, item())")
        %a:restrict-since("$options", "basex", "8.6.7", "map(*)")
        %a:since("basex", "7.7.2") function csv:serialize($input as item()?, $options as item()) as xs:string external;
declare %a:since("basex", "9.4") function csv:doc($uri as xs:string?) as item()? external;
declare %a:since("basex", "9.4") function csv:doc($uri as xs:string?, $options as map(*)?) as item()? external;


[ignore] fix typo in comment

[ignore] fix typo in comment

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

xquery version "1.0";

declare namespace op="http://exist-db.org/xquery/biblio/operations";

declare namespace request="http://exist-db.org/xquery/request";
declare namespace response="http://exist-db.org/xquery/response";
declare namespace util="http://exist-db.org/xquery/util";
declare namespace xmldb="http://exist-db.org/xquery/xmldb";

declare variable $rwx------ := 448;
declare variable $rwxrwx--- := 504;
declare variable $rwxrwxrwx := 511;

declare function op:create-collection($parent as xs:string, $name as xs:string) as element(status) {
    let $collection := xmldb:create-collection($parent, $name) return
        <status id="created">{$collection}</status>
};

declare function op:move-collection($parent as xs:string, $path as xs:string) as element(status) {
    let $null := xmldb:move($parent, $path) return
        <status id="moved" from="{$parent}">{$path}</status>
};

declare function op:remove-collection($collection as xs:string) as element(status) {
    let $null := xmldb:remove($collection) return
        <status id="removed">{$collection}</status>
};

declare function op:update-collection-permissions($collection as xs:string, $restriction as xs:string, $user-group as xs:string?) as element(status) {
    let $null := if($restriction eq "user") then
        (
            (: onlu this user can access, so restrict full access to user :)
            let $current-group := xmldb:get-group($collection) return
                xmldb:set-collection-permissions($collection, request:get-attribute("xquery.user"), $current-group, $rwx------)
        )
        else if($restriction eq "group")then
        (
            (: anyone in the group can access, so restrict full access to group :)
            let $current-owner := xmldb:get-owner($collection) return
                xmldb:set-collection-permissions($collection, $current-owner, $user-group, $rwxrwx---)
        )
        else
        (
            (: anyone can access, so allow full access to everyone :)
            let $current-owner := xmldb:get-owner($collection),
            $current-group := xmldb:get-group($collection) return
                xmldb:set-collection-permissions($collection, $current-owner, $current-group, $rwxrwxrwx)
        )
    return
        <status id="permissions">{$restriction}{if($restriction eq "group")then(concat(": ", $user-group))else()}</status>
};

declare function op:unknown-action($action as xs:string) {
        response:set-status-code(403),

Unknown action: {$action}.

};

let $action := request:get-parameter("action", ()),
$collection := request:get-parameter("collection", ())
return
    if($action eq "create-collection")then
        op:create-collection($collection, request:get-parameter("name",()))
    else if($action eq "move-collection")then
        op:move-collection($collection, request:get-parameter("path",()))
    else if($action eq "remove-collection")then
        op:remove-collection($collection)
    else if($action eq "update-collection-permissions")then
        op:update-collection-permissions($collection, request:get-parameter("restriction", ()), request:get-parameter("userGroup",()))
    else
        op:unknown-action($action)

xquery version "1.0";

declare namespace op="http://exist-db.org/xquery/biblio/operations";

declare namespace request="http://exist-db.org/xquery/request";
declare namespace response="http://exist-db.org/xquery/response";
declare namespace util="http://exist-db.org/xquery/util";
declare namespace xmldb="http://exist-db.org/xquery/xmldb";

declare variable $rwx------ := 448;
declare variable $rwxrwx--- := 504;
declare variable $rwxrwxrwx := 511;

declare function op:create-collection($parent as xs:string, $name as xs:string) as element(status) {
    let $collection := xmldb:create-collection($parent, $name) return
        <status id="created">{$collection}</status>
};

declare function op:move-collection($parent as xs:string, $path as xs:string) as element(status) {
    let $null := xmldb:move($parent, $path) return
        <status id="moved" from="{$parent}">{$path}</status>
};

declare function op:remove-collection($collection as xs:string) as element(status) {
    let $null := xmldb:remove($collection) return
        <status id="removed">{$collection}</status>
};

declare function op:update-collection-permissions($collection as xs:string, $restriction as xs:string, $user-group as xs:string?) as element(status) {
    let $null := if($restriction eq "user") then
        (
            (: onlu this user can access, so restrict full access to user :)
            let $current-group := xmldb:get-group($collection) return
                xmldb:set-collection-permissions($collection, request:get-attribute("xquery.user"), $current-group, $rwx------)
        )
        else if($restriction eq "group")then
        (
            (: anyone in the group can access, so restrict full access to group :)
            let $current-owner := xmldb:get-owner($collection) return
                xmldb:set-collection-permissions($collection, $current-owner, $user-group, $rwxrwx---)
        )
        else
        (
            (: anyone can access, so allow full access to everyone group :)
            let $current-owner := xmldb:get-owner($collection),
            $current-group := xmldb:get-group($collection) return
                xmldb:set-collection-permissions($collection, $current-owner, $current-group, $rwxrwxrwx)
        )
    return
        <status id="permissions">{$restriction}{if($restriction eq "group")then(concat(": ", $user-group))else()}</status>
};

declare function op:unknown-action($action as xs:string) {
        response:set-status-code(403),

Unknown action: {$action}.

};

let $action := request:get-parameter("action", ()),
$collection := request:get-parameter("collection", ())
return
    if($action eq "create-collection")then
        op:create-collection($collection, request:get-parameter("name",()))
    else if($action eq "move-collection")then
        op:move-collection($collection, request:get-parameter("path",()))
    else if($action eq "remove-collection")then
        op:remove-collection($collection)
    else if($action eq "update-collection-permissions")then
        op:update-collection-permissions($collection, request:get-parameter("restriction", ()), request:get-parameter("userGroup",()))
    else
        op:unknown-action($action)


webhook can be GET or POST, mediatype of webhook is application/json.  removed %rest:produces

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

(:Import other namespaces.  :)
import module namespace csd_webconf =  "https://github.com/openhie/openinfoman/csd_webconf";
import module namespace csr_proc = "https://github.com/openhie/openinfoman/csr_proc";
import module namespace csd_dm = "https://github.com/openhie/openinfoman/csd_dm";
import module namespace csd_mcs = "https://github.com/openhie/openinfoman/csd_mcs";
import module namespace functx = "http://www.functx.com";
import module namespace json = "http://basex.org/modules/json";
import module namespace request = "http://exquery.org/ns/request";

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

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

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

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

RapidPro Operations on {$doc_name}

        {
          if ($actions = 'WebHookGET')
	  then

WebHook  -- GET

	     {
	       let $url := concat($csd_webconf:baseurl, "CSD/csr/" , $doc_name , "/careServicesRequest/",$search_name, "/adapter/rap/createDXF")
	       return
WebHook defined at {$url}

	     }

	  else ()
	}
        {
          if ($actions = 'WebHookPOST')
	  then

WebHook  -- POST

	     {
	       let $url := concat($csd_webconf:baseurl, "CSD/csr/" , $doc_name , "/careServicesRequest/",$search_name, "/adapter/rap/createDXF")
	       return
WebHook defined at {$url}

	     }

	  else ()
	}

      return csd_webconf:wrapper($contents)
};

declare
  %rest:path("/CSD/csr/{$doc_name}/careServicesRequest/{$search_name}/adapter/rapidpro/WebHook")
  %rest:query-param("event","{$event}")
  %rest:query-param("relayer","{$relayer}")
  %rest:query-param("relayer_phone","{$relayer_phone}")
  %rest:query-param("phone","{$phone}")
  %rest:query-param("flow","{$flow}")
  %rest:query-param("step","{$step}")
  %rest:query-param("values","{$values}")
  %output:media-type("application/json")
  %rest:POST
  %rest:GET
  function page:webhook($search_name,$doc_name,$event,$relayer,$relayer_phone,$phone,$flow,$step,$values)
{
  if (not(page:is_rapidpro($search_name)) )
    then ('Not a RapidPro Compatible stored function'    )
  else
    let $doc :=  csd_dm:open_document($csd_webconf:db,$doc_name)
    let $function := csr_proc:get_function_definition($csd_webconf:db,$search_name)

    let $careServicesRequest :=
      <csd:careServicesRequest>
       <csd:function urn="{$search_name}" resource="{$doc_name}" base_url="{$csd_webconf:baseurl}">
         <csd:requestParams >
	   <event type="{$event}"/>
	   <relayer id="{$relayer}"/>
	   <relayer_phone number="{$relayer_phone}"/>
	   <phone number="{$phone}"/>
	   <flow id="{$flow}"/>
	   <step id="{$step}"/>
           <values>
	     {
	       if ($values)
	       then    json:parse($values,map{'format':'attributes'})/json/*
	       else ()
	     }
	   </values>
	   {
	     for $param in request:parameter-names()
	     return <query name="{$param}">{request:parameter($param)}</query>
	   }
         </csd:requestParams>
       </csd:function>
      </csd:careServicesRequest>
    return csr_proc:process_CSR_stored_results($csd_webconf:db, $doc,$careServicesRequest)
};

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

(:Import other namespaces.  :)
import module namespace csd_webconf =  "https://github.com/openhie/openinfoman/csd_webconf";
import module namespace csr_proc = "https://github.com/openhie/openinfoman/csr_proc";
import module namespace csd_dm = "https://github.com/openhie/openinfoman/csd_dm";
import module namespace csd_mcs = "https://github.com/openhie/openinfoman/csd_mcs";
import module namespace functx = "http://www.functx.com";
import module namespace json = "http://basex.org/modules/json";
import module namespace request = "http://exquery.org/ns/request";

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

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

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

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

RapidPro Operations on {$doc_name}

        {
          if ($actions = 'WebHookGET')
	  then

WebHook  -- GET

	     {
	       let $url := concat($csd_webconf:baseurl, "CSD/csr/" , $doc_name , "/careServicesRequest/",$search_name, "/adapter/rap/createDXF")
	       return
WebHook defined at {$url}

	     }

	  else ()
	}
        {
          if ($actions = 'WebHookPOST')
	  then

WebHook  -- POST

	     {
	       let $url := concat($csd_webconf:baseurl, "CSD/csr/" , $doc_name , "/careServicesRequest/",$search_name, "/adapter/rap/createDXF")
	       return
WebHook defined at {$url}

	     }

	  else ()
	}

      return csd_webconf:wrapper($contents)
};

declare
  %rest:path("/CSD/csr/{$doc_name}/careServicesRequest/{$search_name}/adapter/rapidpro/WebHook")
  %rest:query-param("event","{$event}")
  %rest:query-param("relayer","{$relayer}")
  %rest:query-param("relayer_phone","{$relayer_phone}")
  %rest:query-param("phone","{$phone}")
  %rest:query-param("flow","{$flow}")
  %rest:query-param("step","{$step}")
  %rest:query-param("values","{$values}")
  %rest:produces("application/json")
  %rest:POST
  function page:webhook($search_name,$doc_name,$event,$relayer,$relayer_phone,$phone,$flow,$step,$values)
{
  if (not(page:is_rapidpro($search_name)) )
    then ('Not a RapidPro Compatible stored function'    )
  else
    let $doc :=  csd_dm:open_document($csd_webconf:db,$doc_name)
    let $function := csr_proc:get_function_definition($csd_webconf:db,$search_name)

    let $careServicesRequest :=
      <csd:careServicesRequest>
       <csd:function urn="{$search_name}" resource="{$doc_name}" base_url="{$csd_webconf:baseurl}">
         <csd:requestParams >
	   <event type="{$event}"/>
	   <relayer id="{$relayer}"/>
	   <relayer_phone number="{$relayer_phone}"/>
	   <phone number="{$phone}"/>
	   <flow id="{$flow}"/>
	   <step id="{$step}"/>
           <values>
	     {
	       if ($values)
	       then    json:parse($values,map{'format':'attributes'})/json/*
	       else ()
	     }
	   </values>
	   {
	     for $param in request:parameter-names()
	     return <query name="{$param}">{request:parameter($param)}</query>
	   }
         </csd:requestParams>
       </csd:function>
      </csd:careServicesRequest>
    return csr_proc:process_CSR_stored_results($csd_webconf:db, $doc,$careServicesRequest)
};


[bugfix] prevent login html admin client if 1st time username is mistyped (copy of parameters)

git-svn-id: 1623499149f5af833cfad2814dce82e821210f6f@14995 8784284e-840f-0410-bd5a-a6a6012a0d1a

xquery version "1.0";
(: $Id$ :)
(:
    Main module of the database administration interface.
:)

declare namespace admin = "http://exist-db.org/xquery/admin-interface";

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";
declare namespace xdb = "http://exist-db.org/xquery/xmldb";

import module namespace status = "http://exist-db.org/xquery/admin-interface/status" at "status.xqm";
import module namespace browse = "http://exist-db.org/xquery/admin-interface/browse" at "browse.xqm";
import module namespace users = "http://exist-db.org/xquery/admin-interface/users" at "users.xqm";
import module namespace xqueries = "http://exist-db.org/xquery/admin-interface/xqueries" at "xqueries.xqm";
import module namespace shut = "http://exist-db.org/xquery/admin-interface/shutdown" at "shutdown.xqm";
import module namespace setup = "http://exist-db.org/xquery/admin-interface/setup" at "setup.xqm";
import module namespace rev="http://exist-db.org/xquery/admin-interface/revisions" at "versions.xqm";
import module namespace backup="http://exist-db.org/xquery/admin-interface/backup" at "backup.xqm";
import module namespace prof="http://exist-db.org/xquery/profiling" at "trace.xqm";
import module namespace grammar="http://exist-db.org/xquery/admin-interface/grammar" at "grammar.xqm";
import module namespace install="http://exist-db.org/xquery/install-tools" at "install.xqm";
import module namespace fundocs="http://exist-db.org/xquery/admin/fundocs" at "fundocs.xqm";

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

(:
    Display the version, SVN revision and user info in the top right corner
:)
declare function admin:info-header() as element()
{

Version: { util:system-property( "product-version" ) }

SVN Revision: { util:system-property( "svn-revision" ) }

Build: {util:system-property("product-build")}

User: { xdb:get-current-user() }

};

(:
    Select the page to show. Every page is defined in its own module
:)
declare function admin:panel() as element()
{
    let $panel := request:get-parameter("panel", "status") return
        if($panel eq "browse") then
        (
            browse:main()
        )
        else if($panel eq "users") then
        (
            users:main()
        )
         else if($panel eq "xqueries") then
        (
            xqueries:main()
        )
        else if($panel eq "shutdown") then
        (
            shut:main()
        )
        else if($panel eq "setup") then
        (
            setup:main()
        )
        else if ($panel eq "fundocs") then
        (
            fundocs:main()
        )
		else if ($panel eq "revisions") then
		(
			rev:main()
		)
		else if ($panel eq "backup") then
		(
		    backup:main()
		)
	    else if ($panel eq "trace") then
	    (
	        prof:main()
        )
        else if ($panel eq "grammar") then
	    (
	        grammar:main()
        )
        else if ($panel eq "install") then
        (
            install:main()
        )
        else
        (
            status:main()
        )
};

declare function admin:panel-header() {
    let $panel := request:get-parameter("panel", "status")
    return
        if ($panel eq "install") then
            install:header()
        else
            <xf:model xmlns:xf="http://www.w3.org/2002/xforms">
            </xf:model>
};

(:~
    Display the login form.
:)
declare function admin:display-login-form() as element()
{

Login

This is a protected resource. Only registered database users can log
        in. If you have not set up any users, login as "admin" and leave the
        password field empty. Note that the "guest" user is not permitted access.

        <form action="{session:encode-url(request:get-uri())}" method="post">

                    Please Login

                    Username:
                    <input name="user" type="text" size="20"/>

                    Password:
                    <input name="pass" type="password" size="20"/>

                    <input type="submit"/>

            {
                for $param in request:get-parameter-names()
                return
                    if ( $param = ("user","pass") ) then
                        ()
                    else
                        <input type="hidden" name="{$param}" value="{request:get-parameter($param, ())}"/>

            }
        </form>

};

(: main entry point :)
let $isLoggedIn :=  if(xdb:get-current-user() eq "guest")then
    (
        (: is this a login attempt? :)
        if(request:get-parameter("user", ()) and not(empty(request:get-parameter("pass", ()))))then
        (
            if(request:get-parameter("user", ()) eq "guest")then
            (
                (: prevent the guest user from accessing the admin webapp :)
                false()
            )
            else
            (
                (: try and log the user in :)
                xdb:login( "/db", request:get-parameter("user", ()), request:get-parameter("pass", () ), true() )
            )
        )
        else
        (
            (: prevent the guest user from accessing the admin webapp :)
            false()
        )
    )
    else
    (
        (: if we are already logged in, are we logging out - i.e. set permissions back to guest :)
        if(request:get-parameter("logout",()))then
        (
        	let $null  := xdb:login("/db", "guest", "guest")
            let $inval := session:invalidate()

            return false()
        )
        else
        (
             (: we are already logged in and we are not the guest user :)
            true()
        )
    )
return (
    <?css-conversion no?>,

            <title>eXist Database Administration</title>
            <link type="text/css" href="admin.css" rel="stylesheet"/>
			<link type="text/css" href="styles/prettify.css" rel="stylesheet"/>
			<link type="text/css" href="../scripts/yui/yui-skin.css" rel="stylesheet"/>
            <link rel="shortcut icon" href="../resources/exist_icon_16x16.ico"/>
			<link rel="icon" href="../resources/exist_icon_16x16.png" type="image/png"/>

			{ admin:panel-header() }

                {admin:info-header()}

Select a Page

                    {
                        let $link := session:encode-url(request:get-uri())
                        return

Home

System Status

Browse Collections

User Management

View Running Jobs

Examples Setup

Install Tools

Install Documentation

Backups

Query Profiling

Grammar cache

Shutdown

Logout

                    }

                        Logged in as: {xdb:get-current-user()}

                {
                    if($isLoggedIn)then
                    (
                        admin:panel()
                    )
                    else
                    (
                        admin:display-login-form()
                    )
                }

)

xquery version "1.0";
(: $Id$ :)
(:
    Main module of the database administration interface.
:)

declare namespace admin = "http://exist-db.org/xquery/admin-interface";

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";
declare namespace xdb = "http://exist-db.org/xquery/xmldb";

import module namespace status = "http://exist-db.org/xquery/admin-interface/status" at "status.xqm";
import module namespace browse = "http://exist-db.org/xquery/admin-interface/browse" at "browse.xqm";
import module namespace users = "http://exist-db.org/xquery/admin-interface/users" at "users.xqm";
import module namespace xqueries = "http://exist-db.org/xquery/admin-interface/xqueries" at "xqueries.xqm";
import module namespace shut = "http://exist-db.org/xquery/admin-interface/shutdown" at "shutdown.xqm";
import module namespace setup = "http://exist-db.org/xquery/admin-interface/setup" at "setup.xqm";
import module namespace rev="http://exist-db.org/xquery/admin-interface/revisions" at "versions.xqm";
import module namespace backup="http://exist-db.org/xquery/admin-interface/backup" at "backup.xqm";
import module namespace prof="http://exist-db.org/xquery/profiling" at "trace.xqm";
import module namespace grammar="http://exist-db.org/xquery/admin-interface/grammar" at "grammar.xqm";
import module namespace install="http://exist-db.org/xquery/install-tools" at "install.xqm";
import module namespace fundocs="http://exist-db.org/xquery/admin/fundocs" at "fundocs.xqm";

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

(:
    Display the version, SVN revision and user info in the top right corner
:)
declare function admin:info-header() as element()
{

Version: { util:system-property( "product-version" ) }

SVN Revision: { util:system-property( "svn-revision" ) }

Build: {util:system-property("product-build")}

User: { xdb:get-current-user() }

};

(:
    Select the page to show. Every page is defined in its own module
:)
declare function admin:panel() as element()
{
    let $panel := request:get-parameter("panel", "status") return
        if($panel eq "browse") then
        (
            browse:main()
        )
        else if($panel eq "users") then
        (
            users:main()
        )
         else if($panel eq "xqueries") then
        (
            xqueries:main()
        )
        else if($panel eq "shutdown") then
        (
            shut:main()
        )
        else if($panel eq "setup") then
        (
            setup:main()
        )
        else if ($panel eq "fundocs") then
        (
            fundocs:main()
        )
		else if ($panel eq "revisions") then
		(
			rev:main()
		)
		else if ($panel eq "backup") then
		(
		    backup:main()
		)
	    else if ($panel eq "trace") then
	    (
	        prof:main()
        )
        else if ($panel eq "grammar") then
	    (
	        grammar:main()
        )
        else if ($panel eq "install") then
        (
            install:main()
        )
        else
        (
            status:main()
        )
};

declare function admin:panel-header() {
    let $panel := request:get-parameter("panel", "status")
    return
        if ($panel eq "install") then
            install:header()
        else
            <xf:model xmlns:xf="http://www.w3.org/2002/xforms">
            </xf:model>
};

(:~
    Display the login form.
:)
declare function admin:display-login-form() as element()
{

Login

This is a protected resource. Only registered database users can log
        in. If you have not set up any users, login as "admin" and leave the
        password field empty. Note that the "guest" user is not permitted access.

        <form action="{session:encode-url(request:get-uri())}" method="post">

                    Please Login

                    Username:
                    <input name="user" type="text" size="20"/>

                    Password:
                    <input name="pass" type="password" size="20"/>

                    <input type="submit"/>

            {
                for $param in request:get-parameter-names()
                return
                    <input type="hidden" name="{$param}"
                        value="{request:get-parameter($param, ())}"/>
            }
        </form>

};

(: main entry point :)
let $isLoggedIn :=  if(xdb:get-current-user() eq "guest")then
    (
        (: is this a login attempt? :)
        if(request:get-parameter("user", ()) and not(empty(request:get-parameter("pass", ()))))then
        (
            if(request:get-parameter("user", ()) eq "guest")then
            (
                (: prevent the guest user from accessing the admin webapp :)
                false()
            )
            else
            (
                (: try and log the user in :)
                xdb:login( "/db", request:get-parameter("user", ()), request:get-parameter("pass", () ), true() )
            )
        )
        else
        (
            (: prevent the guest user from accessing the admin webapp :)
            false()
        )
    )
    else
    (
        (: if we are already logged in, are we logging out - i.e. set permissions back to guest :)
        if(request:get-parameter("logout",()))then
        (
        	let $null  := xdb:login("/db", "guest", "guest")
            let $inval := session:invalidate()

            return false()
        )
        else
        (
             (: we are already logged in and we are not the guest user :)
            true()
        )
    )
return (
    <?css-conversion no?>,

            <title>eXist Database Administration</title>
            <link type="text/css" href="admin.css" rel="stylesheet"/>
			<link type="text/css" href="styles/prettify.css" rel="stylesheet"/>
			<link type="text/css" href="../scripts/yui/yui-skin.css" rel="stylesheet"/>
            <link rel="shortcut icon" href="../resources/exist_icon_16x16.ico"/>
			<link rel="icon" href="../resources/exist_icon_16x16.png" type="image/png"/>

			{ admin:panel-header() }

                {admin:info-header()}

Select a Page

                    {
                        let $link := session:encode-url(request:get-uri())
                        return

Home

System Status

Browse Collections

User Management

View Running Jobs

Examples Setup

Install Tools

Install Documentation

Backups

Query Profiling

Grammar cache

Shutdown

Logout

                    }

                        Logged in as: {xdb:get-current-user()}

                {
                    if($isLoggedIn)then
                    (
                        admin:panel()
                    )
                    else
                    (
                        admin:display-login-form()
                    )
                }

)


Now also escaping \.

Now also escaping \.

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

import module namespace util = "http://www.zorba-xquery.com/diagnostic/util" at "diagnostic_util.xq";

declare function local:make-dict( $doc ) as xs:string*
{
  for $entry in ( $doc//diagnostic, $doc//entry )
  let $key :=
    typeswitch ( $entry )
      case element(diagnostic)
        return $entry/@code
      case $e as element(entry)
        return
          (
            (: raise an error if sub-message contains $1 as parameter :)
            if ( contains ( $e/value, "$1" ) )
            then
              error(
                fn:QName("http://www.zorba-xquery.com/error", "submessage"),
                concat(
                  "sub-entry must not contain parameter named $1: ", $e/value
                )
              )
            else
              (),
            if ( $e/parent::diagnostic )
            then concat( "~", $e/parent::diagnostic/@code, "_", $entry/@key )
            else concat( "~", $entry/@key )
          )
      default
        return error()
  let $value := replace( replace( $entry/value, '\\', '\\\\' ), '"', '\\"' )
  let $if := $entry/@if
  order by $key
  return (
    if ( $if )
    then concat( "#if ", $if )
    else (),
    concat( '  { "', $key, '", "', $value, '" },' ),
    if ( $if )
    then "#endif"
    else ()
  )
};

declare variable $input external;

let $lang := $input/diagnostic-list/@lang
return string-join(
  ( util:copyright(),
    '#include "stdafx.h"',
    '#include "zorba/config.h"',
    '#include "diagnostics/dict_impl.h"',
    '',
    'namespace zorba {',
    'namespace diagnostic {',
    'namespace dict {',
    '',
    concat( 'extern entry const dict_', $lang, '[] = {' ),
    local:make-dict( $input ),
    '};',
    concat( 'DEF_DICT_END(', $lang, ');' ),
    '',
    '} // namespace dict',
    '} // namespace diagnostic',
    '} // namespace zorba',
    '/*',
    ' * Local variables:',
    ' * mode: c++',
    ' * End:',
    ' */'
  ),
  $util:newline
),
$util:newline

(: vim:set syntax=xquery et sw=2 ts=2: :)

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

import module namespace util = "http://www.zorba-xquery.com/diagnostic/util" at "diagnostic_util.xq";

declare function local:make-dict( $doc ) as xs:string*
{
  for $entry in ( $doc//diagnostic, $doc//entry )
  let $key :=
    typeswitch ( $entry )
      case element(diagnostic)
        return $entry/@code
      case $e as element(entry)
        return
          (
            (: raise an error if sub-message contains $1 as parameter :)
            if ( contains ( $e/value, "$1" ) )
            then
              error(
                fn:QName("http://www.zorba-xquery.com/error", "submessage"),
                concat(
                  "sub-entry must not contain parameter named $1: ", $e/value
                )
              )
            else
              (),
            if ( $e/parent::diagnostic )
            then concat( "~", $e/parent::diagnostic/@code, "_", $entry/@key )
            else concat( "~", $entry/@key )
          )
      default
        return error()
  let $value := replace( $entry/value, '"', '\\"' )
  let $if := $entry/@if
  order by $key
  return (
    if ( $if )
    then concat( "#if ", $if )
    else (),
    concat( '  { "', $key, '", "', $value, '" },' ),
    if ( $if )
    then "#endif"
    else ()
  )
};

declare variable $input external;

let $lang := $input/diagnostic-list/@lang
return string-join(
  ( util:copyright(),
    '#include "stdafx.h"',
    '#include "zorba/config.h"',
    '#include "diagnostics/dict_impl.h"',
    '',
    'namespace zorba {',
    'namespace diagnostic {',
    'namespace dict {',
    '',
    concat( 'extern entry const dict_', $lang, '[] = {' ),
    local:make-dict( $input ),
    '};',
    concat( 'DEF_DICT_END(', $lang, ');' ),
    '',
    '} // namespace dict',
    '} // namespace diagnostic',
    '} // namespace zorba',
    '/*',
    ' * Local variables:',
    ' * mode: c++',
    ' * End:',
    ' */'
  ),
  $util:newline
),
$util:newline

(: vim:set syntax=xquery et sw=2 ts=2: :)