matching on entityID is now case insensitive

(:~
: This is the Care Services Discovery base XQuery module
: @version 1.0
: @see http://ihe.net
:
:)
module namespace csd = "https://github.com/openhie/openinfoman/csd_bl";
declare default element  namespace   "urn:ihe:iti:csd:2013";

import module namespace random = "http://basex.org/modules/random";

(:Utility methods:)
declare function csd:wrap_providers($providers)
{
<CSD xmlns:csd="urn:ihe:iti:csd:2013"  >
  <organizationDirectory/>
  <serviceDirectory/>
  <facilityDirectory/>
  <providerDirectory>
  {$providers}
  </providerDirectory>
</CSD>

};

declare function csd:wrap_organizations($organizations)
{
<CSD xmlns:csd="urn:ihe:iti:csd:2013"  >
  <organizationDirectory>
  {$organizations}
  </organizationDirectory>
  <serviceDirectory/>
  <facilityDirectory/>
  <providerDirectory/>
</CSD>

};

declare function csd:wrap_facilities($facilities)
{
<CSD xmlns:csd="urn:ihe:iti:csd:2013"  >
  <organizationDirectory/>
  <serviceDirectory/>
  <facilityDirectory>
  {$facilities}
  </facilityDirectory>
  <providerDirectory/>
</CSD>

};

declare function csd:wrap_services($services)
{
<CSD xmlns:csd="urn:ihe:iti:csd:2013"  >
  <organizationDirectory/>
  <serviceDirectory>
    {$services}
  </serviceDirectory>
  <facilityDirectory/>
  <providerDirectory/>
</CSD>

};

(:~
 :Generate UUID as OID according to http://www.itu.int/ITU-T/asn1/uuid.html
 :)
declare function csd:uuid_as_oid() {
  let $zero := convert:binary-to-bytes('0')
  let $nine := convert:binary-to-bytes('9')
  let $a := convert:binary-to-bytes('A')
  let $e := convert:binary-to-bytes('E')
  let $uuid := convert:binary-to-bytes(upper-case(translate(random:uuid(),'-','')))
  let $uuid_dec := $uuid
    ! xs:decimal(if ( (. >= $zero and . <= $nine)) then (.  - $zero) else if ( (. >= $a and . <= $e)) then (. - $a + 10) else ())
  return concat('2.25.',   fold-left($uuid_dec, 0, function($a, $b) { $a * 16 + $b }) )
};

(:~
 : this function accepts a list of items to filter by address
 :
 : @param $items - a list of items to filter by their <address/> child elements
 : @param $components - a list of address component values.  Each item should have an @component attribute indicating the component type. The text content is the component value.
 : @return all items in $items which have address/addressLine which matches exactly (case insensitive) on each of the given components.
 : @since 1.0
 :
:)
declare function csd:filter_by_address($items as item()*,$components as item()*) as item()*
{
    if (count($components) = 0
       or not ($components[1]/@component)
       or not ($components[1]/text())
    )
    then  $items
    else
           let $comp := $components[1]/@component
           let $val := fn:upper-case($components[1]/text())
           return csd:filter_by_address(
	     $items[address/addressLine[@component = $comp and fn:upper-case(text()) = $val]],
	     fn:subsequence($components,2))
};

(:~
 : this function accepts a list of items to filter by address
 :
 : @param $items - a list of items to filter by their <address/> child elements
 : @param $components - a list of address component values.  Each item should have an @component attribute indicating the component type. The text content is the component value.
 : @return all items in $items which have address/addressLine which matches exactly (case insensitive) on each of the given components.
 : @since 1.0
 :
:)
declare function csd:filter_by_demographic_address($items as item()*,$components as item()*) as item()*
{
    if (count($components) = 0
       or not ($components[1]/@component)
       or not ($components[1]/text())
    )
    then  $items
    else
           let $comp := $components[1]/@component
           let $val := fn:upper-case($components[1]/text())
           return csd:filter_by_address(
	     $items[demographic/address/addressLine[@component = $comp and fn:upper-case(text()) = $val]],
	     fn:subsequence($components,2))
};

(:~
 : this function accepts a list of items to filter by type
 :
 : @param $items - a list of items to filter by their <codedType/> child elements
 : @param $codedtype - a coded type, if specified, to filter the $items list by type.  A @code attribute, if present, results in selecting those $items with matching codedType/@code (case-insensitive) exactly.  Text content, if present,  results in selecting the $items whose codedType/text() contains that value (case-insensitive) with the given @codingScheme (case-insensitive)
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_coded_type($items as item()*, $codedtype as item()) as item()*
{
     if (exists($codedtype/@code) and exists($codedtype/@codingScheme))
     then
        let $code := fn:upper-case($codedtype/@code)
	    let $cScheme := $codedtype/@codingScheme
        return $items[codedType[
                @code = $code
 	            and
                @codingScheme = $cScheme
                ]
            ]
     else $items
};

(:~
 : this function accepts a list of items to filter by their primary name
 :
 : @param $items - a list of items to filter by their <primaryName/> child elements
 : @param $primaryName - a name, if specified, to filter the $items list by their <primaryName/> child elements.  The text content of $primaryName, if present, results in selecting those $items containing that content. Case-insenisitive.
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_primary_name($items as item()*,$primaryName as item()) as item()*
{

      if (not($primaryName = ''))
      then
          let $u_primaryName := fn:upper-case($primaryName)
          return $items[contains(fn:upper-case(./primaryName) , $u_primaryName)]
      else $items
};

(:~
 : this function accepts a list of items to filter by their primary name or other name
 :
 : @param $items - a list of items to filter by their <primaryName/> and <otherName/> child elements
 : @param $name - a name, if specified, to filter the $items list by either their <primaryName/> or <otherName/> child elements .  The text content of $name, if present, results in selecting those $items containing that content. Case-insenisitive.
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_name($items as item()*,$name as item()) as item()*
{
  if (not($name = ''))
    then
    let $u_name:= fn:upper-case($name)
    for $item in $items
      let $matches0:=
        for $name in $item/otherName
	return if (contains(upper-case($name),$u_name)) then ($name) else ()
      let $matches1 := ($matches0, $item[contains(upper-case(primaryName),$u_name)])
      where  count($matches1) > 0
     return $item
  else $items
};

(:~
 : this function accepts a list of items to filter by their primary id
 :
 : @param $items - a list of items to filter by their primary id
 : @param $id - a uniqueID, if present with an non-empty @urn attribute then it is used to filter the $items list by their @entityID attributes by performing an exact match of the @entityID $id.
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_primary_id($items as item()*,$id as item()) as item()*
{
       if ($id/@entityID)
       then
         let $entityID := upper-case($id/@entityID)
         return $items[upper-case(@entityID) =$entityID]
       else $items
};

(:~
 : this function accepts a list of items to filter by their  by their <otherId/> child elements
 :
 : @param $items - a list of items to filter by their id
 : @param $id - an otherIDI, if specified, to filter the $items list by their @code and @assigningAuthorityName attributes any child <otherID> elements by performing an exact, case-insensitive match of the @code and @assigningAuthorityName attributes of $id.
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_other_id($items as item()*,$id as item()) as item()*
{
       if ($id/@assigningAuthorityName)
       then
           let $aaName := fn:upper-case($id/@assigningAuthorityName	)
           let $code := fn:upper-case($id/@code)
           return $items[
                          otherID[
                            fn:upper-case(@assigningAuthorityName)=$aaName
                            and
 			   fn:upper-case(@code)=$code
                         ]
                        ]
        else $items
};

(:~
 : this function accepts a list of items to filter by their common name
 :
 : @param $items - a list of items to filter by their common name
 : @param $name - an xs:string, if specified, to filter the $items list selecting those whose child demographic/name/commonName child-element whose text content contains the text content of $name (case insensitive)
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_common_name($items as item()*, $name as item()) as item()*
{
       if (not($name = ''))
	 then
	 let $u_name:= fn:upper-case($name)
	 for $item in $items
	 let $matches:=
	   for $name in $item/demographic/name/commonName
	     return if (contains(upper-case($name),$u_name)) then ($name) else ()
	 where count($matches) > 0
	 return $item
       else $items
};

(:~
 : this function accepts a list of items to filter by their surname
 :
 : @param $items - a list of items to filter by their surname
 : @param $name - an xs:string, if specified, to filter the $items list selecting those whose child demographic/name/surname child-element whose text content contains the text content of $name (case insensitive)
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_surname($items as item()*, $name as item()) as item()*
{
       if (not($name = ''))
       then
	 let $u_name:= fn:upper-case($name)
	 for $item in $items
	 let $matches:=
	   for $name in $item/demographic/name/surname
	     return if (contains(upper-case($name),$u_name)) then ($name) else ()
	 where count($matches) > 0
	 return $item
       else $items
};

(:~
 : this function accepts a list of items to filter by the start of their surname
 :
 : @param $items - a list of items to filter by their surname
 : @param $name - an xs:string, if specified, to filter the $items list selecting those whose child demographic/name/surname child-element whose text content starts with the text content of $name (case insensitive)
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_surname_starts_with($items as item()*, $name as item()) as item()*
{
       if (not($name = ''))
       then
	 let $u_name:= fn:upper-case($name)
	 for $item in $items
	 let $matches:=
	   for $name in $item/demographic/name/surname
	     return if (starts-with(upper-case($name),$u_name)) then ($name) else ()
	 where count($matches) > 0
	 return $item
       else $items
};

(:~
 : this function accepts a list of items to filter by their forename
 :
 : @param $items - a list of items to filter by their forename
 : @param $name - an xs:string, if specified, to filter the $items list selecting those whose child demographic/name/forename child-element whose text content contains the text content of $name (case insensitive)
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_forename($items as item()*, $name as item()) as item()*
{
       if (not($name = ''))
       then
	 let $u_name:= fn:upper-case($name)
	 for $item in $items
	 let $matches:=
	   for $name in $item/demographic/name/forename
	     return if (contains(upper-case($name),$u_name)) then ($name) else ()
	 where count($matches) > 0
	 return $item
       else $items
};

(:~
 : this function accepts a list of items to filter by the start of their forename
 :
 : @param $items - a list of items to filter by their forename
 : @param $name - an xs:string, if specified, to filter the $items list selecting those whose child demographic/name/forename child-element whose text content starts with the text content of $name (case insensitive)
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_forename_starts_with($items as item()*, $name as item()) as item()*
{
       if (not($name =''))
       then
	 let $u_name:= fn:upper-case($name)
	 for $item in $items
	 let $matches:=
	   for $name in $item/demographic/name/forename
	     return if (starts-with(upper-case($name),$u_name)) then ($name) else ()
	 where count($matches) > 0
	 return $item
       else $items
};

(:~
 : this function accepts a list of items to filter by their record details
 :
 : @param $items - a list of items to filter by their record details
 : @param $record - a csd:record, if specified, to filter the $items list selecting those whose child record/@status matches $record/@status exactly (case insensitive) if $record/@status is presnet non-empty and record/@updated is at least $record/@updated if the later is present and non-empty
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_record($items as item()*, $record as item()) as item()*
{
    let $items1:=
        if (not($record/@status) )
        then $items
        else
             let $status:= $record/@status
             return $items[record/@status = $status]
    return
        if (not($record/@updated) )
        then $items1
        else $items1[record/@updated >= $record/@updated ]

};

(:~
 : this function accepts a list of items to limit to a subset
 :
 : @param $items - a list of items to limit
 : @param $start - a start index for limiting the item list.  If not specified then defaults to 1
 : @param $max - a maximum number of results to return.  If negattive or not specified returns all restults.
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:limit_items($items as item()*, $start as item(),$max as item()) as item()*
{
        if (not(fn:number($start)) or xs:integer($start) < 1)
        then if (not(fn:number($max)) or xs:integer($max) < 0)
            then $items
            else $items[position() <= xs:integer($max)]
        else if (fn:number($max) and xs:integer($max) >= 0)
        then $items[position() >= xs:integer($start) and position() < (xs:integer($start) + xs:integer($max))]
        else $items[position() >= xs:integer($start)]

 };

(:~
 : filters by the parent entities (applicable only to oragnization)
 :
 : @param $items - a list of items to filter by their record details
 : @param $orgs - a list of organizations that to filter $items against.  A member of $items is kept if there is at least one member of $orgs to which it is associated to
 : @return all items in $items which match as above
 : @since 1.0
 :
:)

declare function csd:filter_by_parent($items as item()*,$parent as item()*) as item()*
{
  let $entityID:= upper-case($parent/@entityID)
  return
    if (not(exists($entityID)))
    then $items
    else $items[./parent[upper-case(@entityID) = $entityID]]
};

(:~
 : this function accepts a list of items to filter against a list of organizations
 :
 : @param $items - a list of items to filter by their record details
 : @param $orgs - a list of organizations that to filter $items against.  A member of $items is kept if there is at least one member of $orgs to which it is associated to
 : @return all items in $items which match as above
 : @since 1.0
 :
:)

declare function csd:filter_by_organizations($items as item()*,$orgs as item()*) as item()*
{
    if (count($orgs) = 0
       or not ($orgs[1]/text())
    )
    then  $items
    else
           let $org := upper-case($orgs[1]/text())
           return csd:filter_by_organizations(
	     $items[organizations/organization[upper-case(@entityID) = $org]],
	     fn:subsequence($orgs,2))

};

(:~
 : this function accepts a list of items to filter against a list of facilities
 :
 : @param $items - a list of items to filter by their record details
 : @param $orgs - a list of facilities that to filter $items against.  A member of $items is kept if there is at least one member of $facs to which it is associated to
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_facilities($items as item()*,$facs as item()*) as item()*
{
    if (count($facs) = 0
       or not ($facs[1]/text())
    )
    then  $items
    else
           let $fac := upper-case($facs[1]/text())
           return csd:filter_by_facilities(
	     $items[facilities/facility[upper-case(@entityID) = $fac]],
	     fn:subsequence($facs,2))
};

(:~
 : this function accepts a list of organizations and augments it to invclude all (grand-)*child organizations that are present within the given organization directory
 : @param $orgs - a list of organizations
 : @param $orgdir - the organization directory we are looking within to find (grand-)*child organizations
 : @return all organizations of $orgdir which are (grand-)*child organization of the list or given organizations $orgs. includes $orgs.
:)
declare function csd:join_child_organizations($orgs as item()*,$orgdir as item()) as item()*
{
     if (count($orgs) = 0)
     then ()
     else
        csd:get_child_organizations($orgs[1],$orgdir)
        union
        csd:join_child_organizations(fn:subsequence($orgs,2),$orgdir)
};

(:~
 : this function returns a list of all (grand-)*child organizations of a given organization with the given organization directory
 : @param $org - an organization
 : @param $orgdir - the organization directory we are looking within to find (grand-)*child organizations
 : @return all organizations of $orgdir which are (grand-)*child organization of the list or given organization $org. includes $org.
:)
declare function csd:get_child_organizations($org as item(),$orgdir as item()) as item()*
{
    if (not($org))
    then ()
    else
       let $root := fn:upper-case($org/@root)
       let $extension := fn:upper-case($org/@extension)
       let $child_orgs := $orgdir/organization[
                               fn:upper-case(parent/@root)=$root
                               and fn:upper-case(parent/@extension)=$extension
                               ]
       return ($org,csd:join_child_organizations($child_orgs,$orgdir))
};

(:~
 : this function returns a list of all (grand-)*parent organizations of a given organization with the given organization directory
 : @param $org - an organization
 : @param $orgdir - the organization directory we are looking within to find (grand-)*parent organizations
 : @return all organizations of $orgdir which are (grand-)*parent organization of the list or given organization $org. includes $org.
:)
declare function csd:get_parent_organizations($org as item(),$orgdir as item()) as item()*
{
    if (not($org/parent/@root))
    then $org
    else
       let $root := fn:upper-case($org/parent/@root)
       let $extension := fn:upper-case($org/parent/@extension)
       return (
                $org ,
               csd:get_parent_organizations(
                    $orgdir/organization[
                        fn:upper-case(@root)=$root and fn:upper-case(@extension)=$extension
                        ],
                    $orgdir
                    )
               )
};

(:~
 : this function accepts a list of organizations and augments it to invclude all (grand-)*parent organizations that are present within the given organization directory
 : @param $orgs - a list of organizations
 : @param $orgdir - the organization directory we are looking within to find (grand-)*parent organizations
 : @return all organizations of $orgdir which are (grand-)*parent organization of the list or given organizations $orgs. includes $orgs.
:)
declare function csd:join_parent_organizations($orgs as item()*,$orgdir as item()) as item()*
{
     if (count($orgs) = 0)
     then ()
     else
        csd:get_parent_organizations($orgs[1],$orgdir)
        union
        csd:join_parent_organizations(fn:subsequence($orgs,2),$orgdir)
};

(:~
: This is the Care Services Discovery base XQuery module
: @version 1.0
: @see http://ihe.net
:
:)
module namespace csd = "https://github.com/openhie/openinfoman/csd_bl";
declare default element  namespace   "urn:ihe:iti:csd:2013";

import module namespace random = "http://basex.org/modules/random";

(:Utility methods:)
declare function csd:wrap_providers($providers)
{
<CSD xmlns:csd="urn:ihe:iti:csd:2013"  >
  <organizationDirectory/>
  <serviceDirectory/>
  <facilityDirectory/>
  <providerDirectory>
  {$providers}
  </providerDirectory>
</CSD>

};

declare function csd:wrap_organizations($organizations)
{
<CSD xmlns:csd="urn:ihe:iti:csd:2013"  >
  <organizationDirectory>
  {$organizations}
  </organizationDirectory>
  <serviceDirectory/>
  <facilityDirectory/>
  <providerDirectory/>
</CSD>

};

declare function csd:wrap_facilities($facilities)
{
<CSD xmlns:csd="urn:ihe:iti:csd:2013"  >
  <organizationDirectory/>
  <serviceDirectory/>
  <facilityDirectory>
  {$facilities}
  </facilityDirectory>
  <providerDirectory/>
</CSD>

};

declare function csd:wrap_services($services)
{
<CSD xmlns:csd="urn:ihe:iti:csd:2013"  >
  <organizationDirectory/>
  <serviceDirectory>
    {$services}
  </serviceDirectory>
  <facilityDirectory/>
  <providerDirectory/>
</CSD>

};

(:~
 :Generate UUID as OID according to http://www.itu.int/ITU-T/asn1/uuid.html
 :)
declare function csd:uuid_as_oid() {
  let $zero := convert:binary-to-bytes('0')
  let $nine := convert:binary-to-bytes('9')
  let $a := convert:binary-to-bytes('A')
  let $e := convert:binary-to-bytes('E')
  let $uuid := convert:binary-to-bytes(upper-case(translate(random:uuid(),'-','')))
  let $uuid_dec := $uuid
    ! xs:decimal(if ( (. >= $zero and . <= $nine)) then (.  - $zero) else if ( (. >= $a and . <= $e)) then (. - $a + 10) else ())
  return concat('2.25.',   fold-left($uuid_dec, 0, function($a, $b) { $a * 16 + $b }) )
};

(:~
 : this function accepts a list of items to filter by address
 :
 : @param $items - a list of items to filter by their <address/> child elements
 : @param $components - a list of address component values.  Each item should have an @component attribute indicating the component type. The text content is the component value.
 : @return all items in $items which have address/addressLine which matches exactly (case insensitive) on each of the given components.
 : @since 1.0
 :
:)
declare function csd:filter_by_address($items as item()*,$components as item()*) as item()*
{
    if (count($components) = 0
       or not ($components[1]/@component)
       or not ($components[1]/text())
    )
    then  $items
    else
           let $comp := $components[1]/@component
           let $val := fn:upper-case($components[1]/text())
           return csd:filter_by_address(
	     $items[address/addressLine[@component = $comp and fn:upper-case(text()) = $val]],
	     fn:subsequence($components,2))
};

(:~
 : this function accepts a list of items to filter by address
 :
 : @param $items - a list of items to filter by their <address/> child elements
 : @param $components - a list of address component values.  Each item should have an @component attribute indicating the component type. The text content is the component value.
 : @return all items in $items which have address/addressLine which matches exactly (case insensitive) on each of the given components.
 : @since 1.0
 :
:)
declare function csd:filter_by_demographic_address($items as item()*,$components as item()*) as item()*
{
    if (count($components) = 0
       or not ($components[1]/@component)
       or not ($components[1]/text())
    )
    then  $items
    else
           let $comp := $components[1]/@component
           let $val := fn:upper-case($components[1]/text())
           return csd:filter_by_address(
	     $items[demographic/address/addressLine[@component = $comp and fn:upper-case(text()) = $val]],
	     fn:subsequence($components,2))
};

(:~
 : this function accepts a list of items to filter by type
 :
 : @param $items - a list of items to filter by their <codedType/> child elements
 : @param $codedtype - a coded type, if specified, to filter the $items list by type.  A @code attribute, if present, results in selecting those $items with matching codedType/@code (case-insensitive) exactly.  Text content, if present,  results in selecting the $items whose codedType/text() contains that value (case-insensitive) with the given @codingScheme (case-insensitive)
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_coded_type($items as item()*, $codedtype as item()) as item()*
{
     if (exists($codedtype/@code) and exists($codedtype/@codingScheme))
     then
        let $code := fn:upper-case($codedtype/@code)
	    let $cScheme := $codedtype/@codingScheme
        return $items[codedType[
                @code = $code
 	            and
                @codingScheme = $cScheme
                ]
            ]
     else $items
};

(:~
 : this function accepts a list of items to filter by their primary name
 :
 : @param $items - a list of items to filter by their <primaryName/> child elements
 : @param $primaryName - a name, if specified, to filter the $items list by their <primaryName/> child elements.  The text content of $primaryName, if present, results in selecting those $items containing that content. Case-insenisitive.
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_primary_name($items as item()*,$primaryName as item()) as item()*
{

      if (not($primaryName = ''))
      then
          let $u_primaryName := fn:upper-case($primaryName)
          return $items[contains(fn:upper-case(./primaryName) , $u_primaryName)]
      else $items
};

(:~
 : this function accepts a list of items to filter by their primary name or other name
 :
 : @param $items - a list of items to filter by their <primaryName/> and <otherName/> child elements
 : @param $name - a name, if specified, to filter the $items list by either their <primaryName/> or <otherName/> child elements .  The text content of $name, if present, results in selecting those $items containing that content. Case-insenisitive.
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_name($items as item()*,$name as item()) as item()*
{
  if (not($name = ''))
    then
    let $u_name:= fn:upper-case($name)
    for $item in $items
      let $matches0:=
        for $name in $item/otherName
	return if (contains(upper-case($name),$u_name)) then ($name) else ()
      let $matches1 := ($matches0, $item[contains(upper-case(primaryName),$u_name)])
      where  count($matches1) > 0
     return $item
  else $items
};

(:~
 : this function accepts a list of items to filter by their primary id
 :
 : @param $items - a list of items to filter by their primary id
 : @param $id - a uniqueID, if present with an non-empty @urn attribute then it is used to filter the $items list by their @entityID attributes by performing an exact match of the @entityID $id.
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_primary_id($items as item()*,$id as item()) as item()*
{
       if ($id/@entityID)
       then $items[@entityID =$id/@entityID]
       else $items
};

(:~
 : this function accepts a list of items to filter by their  by their <otherId/> child elements
 :
 : @param $items - a list of items to filter by their id
 : @param $id - an otherIDI, if specified, to filter the $items list by their @code and @assigningAuthorityName attributes any child <otherID> elements by performing an exact, case-insensitive match of the @code and @assigningAuthorityName attributes of $id.
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_other_id($items as item()*,$id as item()) as item()*
{
       if ($id/@assigningAuthorityName)
       then
           let $aaName := fn:upper-case($id/@assigningAuthorityName	)
           let $code := fn:upper-case($id/@code)
           return $items[
                          otherID[
                            fn:upper-case(@assigningAuthorityName)=$aaName
                            and
 			   fn:upper-case(@code)=$code
                         ]
                        ]
        else $items
};

(:~
 : this function accepts a list of items to filter by their common name
 :
 : @param $items - a list of items to filter by their common name
 : @param $name - an xs:string, if specified, to filter the $items list selecting those whose child demographic/name/commonName child-element whose text content contains the text content of $name (case insensitive)
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_common_name($items as item()*, $name as item()) as item()*
{
       if (not($name = ''))
	 then
	 let $u_name:= fn:upper-case($name)
	 for $item in $items
	 let $matches:=
	   for $name in $item/demographic/name/commonName
	     return if (contains(upper-case($name),$u_name)) then ($name) else ()
	 where count($matches) > 0
	 return $item
       else $items
};

(:~
 : this function accepts a list of items to filter by their surname
 :
 : @param $items - a list of items to filter by their surname
 : @param $name - an xs:string, if specified, to filter the $items list selecting those whose child demographic/name/surname child-element whose text content contains the text content of $name (case insensitive)
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_surname($items as item()*, $name as item()) as item()*
{
       if (not($name = ''))
       then
	 let $u_name:= fn:upper-case($name)
	 for $item in $items
	 let $matches:=
	   for $name in $item/demographic/name/surname
	     return if (contains(upper-case($name),$u_name)) then ($name) else ()
	 where count($matches) > 0
	 return $item
       else $items
};

(:~
 : this function accepts a list of items to filter by the start of their surname
 :
 : @param $items - a list of items to filter by their surname
 : @param $name - an xs:string, if specified, to filter the $items list selecting those whose child demographic/name/surname child-element whose text content starts with the text content of $name (case insensitive)
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_surname_starts_with($items as item()*, $name as item()) as item()*
{
       if (not($name = ''))
       then
	 let $u_name:= fn:upper-case($name)
	 for $item in $items
	 let $matches:=
	   for $name in $item/demographic/name/surname
	     return if (starts-with(upper-case($name),$u_name)) then ($name) else ()
	 where count($matches) > 0
	 return $item
       else $items
};

(:~
 : this function accepts a list of items to filter by their forename
 :
 : @param $items - a list of items to filter by their forename
 : @param $name - an xs:string, if specified, to filter the $items list selecting those whose child demographic/name/forename child-element whose text content contains the text content of $name (case insensitive)
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_forename($items as item()*, $name as item()) as item()*
{
       if (not($name = ''))
       then
	 let $u_name:= fn:upper-case($name)
	 for $item in $items
	 let $matches:=
	   for $name in $item/demographic/name/forename
	     return if (contains(upper-case($name),$u_name)) then ($name) else ()
	 where count($matches) > 0
	 return $item
       else $items
};

(:~
 : this function accepts a list of items to filter by the start of their forename
 :
 : @param $items - a list of items to filter by their forename
 : @param $name - an xs:string, if specified, to filter the $items list selecting those whose child demographic/name/forename child-element whose text content starts with the text content of $name (case insensitive)
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_forename_starts_with($items as item()*, $name as item()) as item()*
{
       if (not($name =''))
       then
	 let $u_name:= fn:upper-case($name)
	 for $item in $items
	 let $matches:=
	   for $name in $item/demographic/name/forename
	     return if (starts-with(upper-case($name),$u_name)) then ($name) else ()
	 where count($matches) > 0
	 return $item
       else $items
};

(:~
 : this function accepts a list of items to filter by their record details
 :
 : @param $items - a list of items to filter by their record details
 : @param $record - a csd:record, if specified, to filter the $items list selecting those whose child record/@status matches $record/@status exactly (case insensitive) if $record/@status is presnet non-empty and record/@updated is at least $record/@updated if the later is present and non-empty
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_record($items as item()*, $record as item()) as item()*
{
    let $items1:=
        if (not($record/@status) )
        then $items
        else
             let $status:= $record/@status
             return $items[record/@status = $status]
    return
        if (not($record/@updated) )
        then $items1
        else $items1[record/@updated >= $record/@updated ]

};

(:~
 : this function accepts a list of items to limit to a subset
 :
 : @param $items - a list of items to limit
 : @param $start - a start index for limiting the item list.  If not specified then defaults to 1
 : @param $max - a maximum number of results to return.  If negattive or not specified returns all restults.
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:limit_items($items as item()*, $start as item(),$max as item()) as item()*
{
        if (not(fn:number($start)) or xs:integer($start) < 1)
        then if (not(fn:number($max)) or xs:integer($max) < 0)
            then $items
            else $items[position() <= xs:integer($max)]
        else if (fn:number($max) and xs:integer($max) >= 0)
        then $items[position() >= xs:integer($start) and position() < (xs:integer($start) + xs:integer($max))]
        else $items[position() >= xs:integer($start)]

 };

(:~
 : filters by the parent entities (applicable only to oragnization)
 :
 : @param $items - a list of items to filter by their record details
 : @param $orgs - a list of organizations that to filter $items against.  A member of $items is kept if there is at least one member of $orgs to which it is associated to
 : @return all items in $items which match as above
 : @since 1.0
 :
:)

declare function csd:filter_by_parent($items as item()*,$parent as item()*) as item()*
{
  let $entityID:= $parent/@entityID
  return
    if (not(exists($entityID)))
    then $items
    else $items[./parent[@entityID = $entityID]]
};

(:~
 : this function accepts a list of items to filter against a list of organizations
 :
 : @param $items - a list of items to filter by their record details
 : @param $orgs - a list of organizations that to filter $items against.  A member of $items is kept if there is at least one member of $orgs to which it is associated to
 : @return all items in $items which match as above
 : @since 1.0
 :
:)

declare function csd:filter_by_organizations($items as item()*,$orgs as item()*) as item()*
{
    if (count($orgs) = 0
       or not ($orgs[1]/text())
    )
    then  $items
    else
           let $org := $orgs[1]/text()
           return csd:filter_by_organizations(
	     $items[organizations/organization[@entityID = $org]],
	     fn:subsequence($orgs,2))

};

(:~
 : this function accepts a list of items to filter against a list of facilities
 :
 : @param $items - a list of items to filter by their record details
 : @param $orgs - a list of facilities that to filter $items against.  A member of $items is kept if there is at least one member of $facs to which it is associated to
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_facilities($items as item()*,$facs as item()*) as item()*
{
    if (count($facs) = 0
       or not ($facs[1]/text())
    )
    then  $items
    else
           let $fac := $facs[1]/text()
           return csd:filter_by_facilities(
	     $items[facilities/facility[@entityID = $fac]],
	     fn:subsequence($facs,2))
};

(:~
 : this function accepts a list of organizations and augments it to invclude all (grand-)*child organizations that are present within the given organization directory
 : @param $orgs - a list of organizations
 : @param $orgdir - the organization directory we are looking within to find (grand-)*child organizations
 : @return all organizations of $orgdir which are (grand-)*child organization of the list or given organizations $orgs. includes $orgs.
:)
declare function csd:join_child_organizations($orgs as item()*,$orgdir as item()) as item()*
{
     if (count($orgs) = 0)
     then ()
     else
        csd:get_child_organizations($orgs[1],$orgdir)
        union
        csd:join_child_organizations(fn:subsequence($orgs,2),$orgdir)
};

(:~
 : this function returns a list of all (grand-)*child organizations of a given organization with the given organization directory
 : @param $org - an organization
 : @param $orgdir - the organization directory we are looking within to find (grand-)*child organizations
 : @return all organizations of $orgdir which are (grand-)*child organization of the list or given organization $org. includes $org.
:)
declare function csd:get_child_organizations($org as item(),$orgdir as item()) as item()*
{
    if (not($org))
    then ()
    else
       let $root := fn:upper-case($org/@root)
       let $extension := fn:upper-case($org/@extension)
       let $child_orgs := $orgdir/organization[
                               fn:upper-case(parent/@root)=$root
                               and fn:upper-case(parent/@extension)=$extension
                               ]
       return ($org,csd:join_child_organizations($child_orgs,$orgdir))
};

(:~
 : this function returns a list of all (grand-)*parent organizations of a given organization with the given organization directory
 : @param $org - an organization
 : @param $orgdir - the organization directory we are looking within to find (grand-)*parent organizations
 : @return all organizations of $orgdir which are (grand-)*parent organization of the list or given organization $org. includes $org.
:)
declare function csd:get_parent_organizations($org as item(),$orgdir as item()) as item()*
{
    if (not($org/parent/@root))
    then $org
    else
       let $root := fn:upper-case($org/parent/@root)
       let $extension := fn:upper-case($org/parent/@extension)
       return (
                $org ,
               csd:get_parent_organizations(
                    $orgdir/organization[
                        fn:upper-case(@root)=$root and fn:upper-case(@extension)=$extension
                        ],
                    $orgdir
                    )
               )
};

(:~
 : this function accepts a list of organizations and augments it to invclude all (grand-)*parent organizations that are present within the given organization directory
 : @param $orgs - a list of organizations
 : @param $orgdir - the organization directory we are looking within to find (grand-)*parent organizations
 : @return all organizations of $orgdir which are (grand-)*parent organization of the list or given organizations $orgs. includes $orgs.
:)
declare function csd:join_parent_organizations($orgs as item()*,$orgdir as item()) as item()*
{
     if (count($orgs) = 0)
     then ()
     else
        csd:get_parent_organizations($orgs[1],$orgdir)
        union
        csd:join_parent_organizations(fn:subsequence($orgs,2),$orgdir)
};


these changes seem to fix
bug #1393682 "PF: tests q0{1,4,9} fail in tests/XMark/opt/{MIL,XQ}".

Peter,
could you please check, whether my changes are OK
(i.e., do not compromise you optimization intensions)?

module namespace xmark = "http://www.cwi.nl/~boncz/xmark/opt/";

declare function xmark:convert($v as xs:decimal?) as xs:decimal?
{
  2.20371 * $v (: convert Dfl to Euro :)
};

declare function xmark:q01($doc as xs:string, $id as xs:string) as xs:anyNode*
{
  for $b in doc($doc)/descendant::person[@id=$id]
  return $b/name/text()
};

declare function xmark:q02($doc as xs:string) as xs:anyNode*
{
  for $b in doc($doc)/descendant::open_auction
  return <increase> { $b/bidder[1]/increase/text() } </increase>
};

declare function xmark:q03($doc as xs:string) as xs:anyNode*
{
  for $b in doc($doc)/descendant::open_auction
  where exactly-one($b/bidder[1]/increase/text()) * 2 <= $b/bidder[last()]/increase/text()
  return <increase first="{ $b/bidder[1]/increase/text() }"
                   last="{ $b/bidder[last()]/increase/text() }"/>
};

declare function xmark:q04($doc as xs:string, $person1 as xs:string, $person2 as xs:string) as xs:anyNode*
{
  for $b in doc($doc)/descendant::open_auction
  where some $pr1 in ($b/descendant::personref)[@person=$person1],
             $pr2 in ($b/descendant::personref)[@person=$person2] satisfies $pr1 << $pr2
  return <history> { $b/reserve/text() } </history>
};

declare function xmark:q05($doc as xs:string, $min as xs:double) as xs:integer
{
  count(for $i in doc($doc)/descendant::closed_auction
        where  $i/price/text() >= $min
        return $i/price)
};

declare function xmark:q06($doc as xs:string) as xs:integer*
{
  for $b in doc($doc)/descendant::regions
  return count($b//item)
};

declare function xmark:q07($doc as xs:string) as xs:integer*
{
  for $p in doc($doc)/descendant::site
  return count($p/descendant::description) + count($p/descendant::annotation) + count($p/descendant::emailaddress)
};

declare function xmark:q08($doc as xs:string) as xs:anyNode*
{
  let $auction := doc($doc)
  for $p in $auction/descendant::person
  let $a := for $t in $auction/descendant::closed_auction
            where $t/buyer/@person = $p/@id
            return $t
  return <item person="{ $p/name/text() }"> { count($a) } </item>
};

declare function xmark:q09($doc as xs:string) as xs:anyNode*
{
  let $auction := doc($doc)
  let $ca := $auction/descendant::closed_auction
  let $ei := $auction/descendant::europe/item
  for $p in $auction/descendant::person
  let $a :=
    for $t in $ca
    where $p/@id = $t/buyer/@person
    return
      let $n :=
        for $t2 in $ei
        where $t/itemref/@item = $t2/@id
        return $t2
      return <item>{$n/name/text()}</item>
  return <person name="{$p/name/text()}">{$a}</person>
};

declare function xmark:q10($doc as xs:string) as xs:anyNode*
{
  let $auction := doc($doc)
  for $i in distinct-values($auction/descendant::interest/@category)
  let $p :=
    for $t in $auction/descendant::person
    where $t/profile/interest/@category = $i
    return <personne>
  <statistiques>
    <sexe> { $t/profile/gender/text() } </sexe>
    <age> { $t/profile/age/text() } </age>
    <education> { $t/profile/education/text() } </education>
    <revenu> { fn:data($t/profile/@income) } </revenu>
  </statistiques>
  <coordonnees>
    <nom> { $t/name/text() } </nom>
    <rue> { $t/address/street/text() } </rue>
    <ville> { $t/address/city/text() } </ville>
    <pays> { $t/address/country/text() } </pays>
    <reseau>
      <courrier> { $t/emailaddress/text() } </courrier>
      <pagePerso> { $t/homepage/text() } </pagePerso>
    </reseau>
  </coordonnees>
  <cartePaiement> { $t/creditcard/text() } </cartePaiement>
</personne>
  return <categorie>
  <id> { $i } </id>
  { $p }
</categorie>
};

declare function xmark:q11($doc as xs:string, $factor as xs:integer) as xs:anyNode*
{
  let $auction := doc($doc)
  for $p in $auction/descendant::person
  let $l := for $i in $auction/descendant::initial
            where $p/profile/@income > ($factor * exactly-one($i/text()))
            return $i
  return <items name="{ $p/name/text() }"> { count($l) } </items>
};

declare function xmark:q12($doc as xs:string, $factor as xs:integer, $min as xs:double) as xs:anyNode*
{
  let $auction := doc($doc)
  for $p in $auction/descendant::person
  let $l := for $i in $auction/descendant::initial
            where $p/profile/@income > ($factor * exactly-one($i/text()))
            return $i
  where  $p/profile/@income > $min
  return <items person="{ $p/profile/@income }"> { count($l) } </items>
};

declare function xmark:q13($doc as xs:string) as xs:anyNode*
{
  for $i in doc($doc)/descendant::australia/item
  return <item name="{ $i/name/text() }"> { $i/description } </item>
};

declare function xmark:q14($doc as xs:string, $kind as xs:string) as xs:anyNode*
{
  for $i in doc($doc)/descendant::item
  where contains(string(exactly-one($i/description)),$kind)
  return $i/name/text()
};

declare function xmark:q15($doc as xs:string) as xs:anyNode*
{
  for $a in doc($doc)/descendant::closed_auction/annotation/description/parlist/listitem/parlist/listitem/text/emph/keyword/text()
   return <text> { $a } </text>
};

declare function xmark:q16($doc as xs:string) as xs:anyNode*
{
  for $a in doc($doc)/descendant::closed_auction
  where not(empty($a/annotation/description/parlist/listitem/parlist/listitem/text/emph/keyword/text()))
  return <person id="{ $a/seller/@person }"/>
};

declare function xmark:q17($doc as xs:string) as xs:anyNode*
{
  for $p in doc($doc)/descendant::person
  where empty($p/homepage/text())
  return <person name="{ $p/name/text() }"/>
};

declare function xmark:q18($doc as xs:string) as xs:decimal*
{
  for $i in doc($doc)/descendant::open_auction
  return xmark:convert(fn:zero-or-one($i/reserve))
};

declare function xmark:q19($doc as xs:string) as xs:anyNode*
{
  for $b in doc($doc)/descendant::item
  let $k := $b/name/text()
  order by zero-or-one($b/location)
  return <item name="{ $k }"> { $b/location/text() } </item>
};

declare function xmark:q20($doc as xs:string, $lo as xs:double, $hi as xs:double) as xs:anyNode*
{
  let $auction := doc($doc)
  return <result>
  <preferred>
    { count($auction/descendant::profile[@income >= $hi]) }
  </preferred>
  <standard>
    { count($auction/descendant::profile[@income < $hi and @income >= $lo]) }
  </standard>
  <challenge>
    { count($auction/descendant::profile[@income < $lo]) }
  </challenge>
  <na>
    { count(for $p in $auction/descendant::person
            where  empty($p/profile/@income)
            return $p) }
  </na>
</result>
};

module namespace xmark = "http://www.cwi.nl/~boncz/xmark/opt/";

declare function xmark:convert($v as xs:decimal?) as xs:decimal?
{
  2.20371 * $v (: convert Dfl to Euro :)
};

declare function xmark:q01($doc as xs:string, $id as xs:string) as xs:string*
{
  for $b in doc($doc)/descendant::person[@id=$id]
  return $b/name/text()
};

declare function xmark:q02($doc as xs:string) as xs:anyNode*
{
  for $b in doc($doc)/descendant::open_auction
  return <increase> { $b/bidder[1]/increase/text() } </increase>
};

declare function xmark:q03($doc as xs:string) as xs:anyNode*
{
  for $b in doc($doc)/descendant::open_auction
  where exactly-one($b/bidder[1]/increase/text()) * 2 <= $b/bidder[last()]/increase/text()
  return <increase first="{ $b/bidder[1]/increase/text() }"
                   last="{ $b/bidder[last()]/increase/text() }"/>
};

declare function xmark:q04($doc as xs:string, $person1 as xs:string, $person2 as xs:string) as xs:anyNode*
{
  for $b in doc($doc)/descendant::open_auction
  where some $pr1 in $b/descendant::personref[@person=$person1],
             $pr2 in $b/descendant::personref[@person=$person2] satisfies $pr1 << $pr2
  return <history> { $b/reserve/text() } </history>
};

declare function xmark:q05($doc as xs:string, $min as xs:double) as xs:integer
{
  count(for $i in doc($doc)/descendant::closed_auction
        where  $i/price/text() >= $min
        return $i/price)
};

declare function xmark:q06($doc as xs:string) as xs:integer*
{
  for $b in doc($doc)/descendant::regions
  return count($b//item)
};

declare function xmark:q07($doc as xs:string) as xs:integer*
{
  for $p in doc($doc)/descendant::site
  return count($p/descendant::description) + count($p/descendant::annotation) + count($p/descendant::emailaddress)
};

declare function xmark:q08($doc as xs:string) as xs:anyNode*
{
  let $auction := doc($doc)
  for $p in $auction/descendant::person
  let $a := for $t in $auction/descendant::closed_auction
            where $t/buyer/@person = $p/@id
            return $t
  return <item person="{ $p/name/text() }"> { count($a) } </item>
};

declare function xmark:q09($doc as xs:string) as xs:anyNode*
{
  let $auction := doc($doc)
  let $ca := $auction/s/closed_auction
  let $ei := $auction/descendant::item
  for $p in $auction/descendant::person
  let $a :=
    for $t in $ca
    where $p/@id = $t/buyer/@person
    return
      let $n :=
        for $t2 in $ei
        where $t/itemref/@item = $t2/@id
        return $t2
      return <item>{$n/name/text()}</item>
  return <person name="{$p/name/text()}">{$a}</person>
};

declare function xmark:q10($doc as xs:string) as xs:anyNode*
{
  let $auction := doc($doc)
  for $i in distinct-values($auction/descendant::interest/@category)
  let $p :=
    for $t in $auction/descendant::person
    where $t/profile/interest/@category = $i
    return <personne>
  <statistiques>
    <sexe> { $t/profile/gender/text() } </sexe>
    <age> { $t/profile/age/text() } </age>
    <education> { $t/profile/education/text() } </education>
    <revenu> { fn:data($t/profile/@income) } </revenu>
  </statistiques>
  <coordonnees>
    <nom> { $t/name/text() } </nom>
    <rue> { $t/address/street/text() } </rue>
    <ville> { $t/address/city/text() } </ville>
    <pays> { $t/address/country/text() } </pays>
    <reseau>
      <courrier> { $t/emailaddress/text() } </courrier>
      <pagePerso> { $t/homepage/text() } </pagePerso>
    </reseau>
  </coordonnees>
  <cartePaiement> { $t/creditcard/text() } </cartePaiement>
</personne>
  return <categorie>
  <id> { $i } </id>
  { $p }
</categorie>
};

declare function xmark:q11($doc as xs:string, $factor as xs:integer) as xs:anyNode*
{
  let $auction := doc($doc)
  for $p in $auction/descendant::person
  let $l := for $i in $auction/descendant::initial
            where $p/profile/@income > ($factor * exactly-one($i/text()))
            return $i
  return <items name="{ $p/name/text() }"> { count($l) } </items>
};

declare function xmark:q12($doc as xs:string, $factor as xs:integer, $min as xs:double) as xs:anyNode*
{
  let $auction := doc($doc)
  for $p in $auction/descendant::person
  let $l := for $i in $auction/descendant::initial
            where $p/profile/@income > ($factor * exactly-one($i/text()))
            return $i
  where  $p/profile/@income > $min
  return <items person="{ $p/profile/@income }"> { count($l) } </items>
};

declare function xmark:q13($doc as xs:string) as xs:anyNode*
{
  for $i in doc($doc)/descendant::australia/item
  return <item name="{ $i/name/text() }"> { $i/description } </item>
};

declare function xmark:q14($doc as xs:string, $kind as xs:string) as xs:anyNode*
{
  for $i in doc($doc)/descendant::item
  where contains(string(exactly-one($i/description)),$kind)
  return $i/name/text()
};

declare function xmark:q15($doc as xs:string) as xs:anyNode*
{
  for $a in doc($doc)/descendant::closed_auction/annotation/description/parlist/listitem/parlist/listitem/text/emph/keyword/text()
   return <text> { $a } </text>
};

declare function xmark:q16($doc as xs:string) as xs:anyNode*
{
  for $a in doc($doc)/descendant::closed_auction
  where not(empty($a/annotation/description/parlist/listitem/parlist/listitem/text/emph/keyword/text()))
  return <person id="{ $a/seller/@person }"/>
};

declare function xmark:q17($doc as xs:string) as xs:anyNode*
{
  for $p in doc($doc)/descendant::person
  where empty($p/homepage/text())
  return <person name="{ $p/name/text() }"/>
};

declare function xmark:q18($doc as xs:string) as xs:decimal*
{
  for $i in doc($doc)/descendant::open_auction
  return xmark:convert(fn:zero-or-one($i/reserve))
};

declare function xmark:q19($doc as xs:string) as xs:anyNode*
{
  for $b in doc($doc)/descendant::item
  let $k := $b/name/text()
  order by zero-or-one($b/location)
  return <item name="{ $k }"> { $b/location/text() } </item>
};

declare function xmark:q20($doc as xs:string, $lo as xs:double, $hi as xs:double) as xs:anyNode*
{
  let $auction := doc($doc)
  return <result>
  <preferred>
    { count($auction/descendant::profile[@income >= $hi]) }
  </preferred>
  <standard>
    { count($auction/descendant::profile[@income < $hi and @income >= $lo]) }
  </standard>
  <challenge>
    { count($auction/descendant::profile[@income < $lo]) }
  </challenge>
  <na>
    { count(for $p in $auction/descendant::person
            where  empty($p/profile/@income)
            return $p) }
  </na>
</result>
};


[ignore] Added test for serializing mixed type sequence

xquery version "3.1";

module namespace ser="http://exist-db.org/xquery/test/serialize";

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

declare variable $ser:adaptive-opts :=
    <output:serialization-parameters
           xmlns:output="http://www.w3.org/2010/xslt-xquery-serialization">
        <output:method value="adaptive"/>
      </output:serialization-parameters>;

declare variable $ser:atomic :=
    <atomic:root xmlns:atomic="http://www.w3.org/XQueryTest" xmlns:foo="http://www.example.com/foo"
xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">
      <atomic:duration>P1Y2M3DT10H30M</atomic:duration>
      <atomic:dateTime>2002-04-02T12:00:00Z</atomic:dateTime>
      <atomic:time>13:20:10.5Z</atomic:time>
      <atomic:date>2000-01-01+05:00</atomic:date>
      <atomic:gYearMonth>2001-12</atomic:gYearMonth>
      <atomic:gYear>2001</atomic:gYear>
      <atomic:gMonthDay>--12-17</atomic:gMonthDay>
      <atomic:gDay>---17</atomic:gDay>
      <atomic:gMonth>--12</atomic:gMonth>
      <atomic:boolean>true</atomic:boolean>
      <atomic:base64Binary>R0lGODlhcgGSALMAAAQCAEMmCZtuMFQxDS8b</atomic:base64Binary>
      <atomic:hexBinary>A9FD64E12C</atomic:hexBinary>
      <atomic:float>1267.43233E12</atomic:float>
      <atomic:double>1267.43233E12</atomic:double>
      <atomic:anyURI>http://www.example.com</atomic:anyURI>
      <atomic:NCName atomic:attr="aNCname">aNCname</atomic:NCName>
      <atomic:QName atomic:attr="foo:aQname">foo:aQname</atomic:QName>
      <atomic:string>A String Function</atomic:string>
      <atomic:normalizedString>aNormalizedString</atomic:normalizedString>
      <atomic:language>EN</atomic:language>
      <atomic:decimal atomic:attr="12678967.543233">12678967.543233</atomic:decimal>
      <atomic:integer>12678967543233</atomic:integer>
      <atomic:nonPositiveInteger>-1</atomic:nonPositiveInteger>
      <atomic:long>12678967543233</atomic:long>
      <atomic:nonNegativeInteger>12678967543233</atomic:nonNegativeInteger>
      <atomic:negativeInteger>-12678967543233</atomic:negativeInteger>
      <atomic:int>126789675</atomic:int>
      <atomic:unsignedLong>12678967543233</atomic:unsignedLong>
      <atomic:positiveInteger>12678967543233</atomic:positiveInteger>
      <atomic:short>12678</atomic:short>
      <atomic:unsignedInt>1267896754</atomic:unsignedInt>
      <atomic:byte>126</atomic:byte>
      <atomic:unsignedShort>12678</atomic:unsignedShort>
      <atomic:unsignedByte>126</atomic:unsignedByte>
      <atomic:id1>id1</atomic:id1>
      <atomic:id2>id2</atomic:id2>
      <atomic:idrefs atomic:attr="id1 id2">id1 id2</atomic:idrefs>
    </atomic:root>;

declare variable $ser:test-xml := document {
    <?pi?>,
    <elem a="abc">123</elem>
};

declare variable $ser:collection-name := "serialization-test";

declare variable $ser:collection := "/db/" || $ser:collection-name;

declare
    %test:setUp
function ser:setup() {
    xmldb:create-collection("/db", $ser:collection-name),
    xmldb:store($ser:collection, "test.xml", $ser:test-xml)
};

declare
    %test:tearDown
function ser:teardown() {
    xmldb:remove($ser:collection)
};

declare
    %test:assertXPath("contains($result,'atomic')")
function ser:serialize-element() {
    serialize($ser:atomic)
};

declare
    %test:assertError
function ser:serialize-attribute() {
    serialize(($ser:atomic//@*)[1])
};

declare
    %test:assertXPath("contains($result,'atomic')")
function ser:serialize-with-params() {
    let $params :=
      <output:serialization-parameters
           xmlns:output="http://www.w3.org/2010/xslt-xquery-serialization">
        <output:method value="xml"/>
        <output:indent value="yes"/>
      </output:serialization-parameters>
    return serialize($ser:atomic, $params)
};

declare
    %test:assertXPath("contains($result,'atomic')")
function ser:serialize-no-method() {
    let $params :=
        <output:serialization-parameters xmlns:output="http://www.w3.org/2010/xslt-xquery-serialization">
            <output:indent value="yes"/>
        </output:serialization-parameters>
    return serialize($ser:atomic, $params)
};

declare
    %test:assertXPath("contains($result,'atomic')")
function ser:serialize-empty-params() {
    let $params := ()
    return serialize($ser:atomic, $params)
};

declare
    %test:assertEquals("aaa bbb")
function ser:serialize-atomic() {
    let $nodes := ("aaa", "bbb")
    return
        serialize($nodes)
};

declare
    %test:assertEquals("")
function ser:serialize-empty-sequence() {
    let $nodes := ()
    return
        serialize($nodes)
};

declare
    %test:args(1234)
    %test:assertEquals('"1234"')
    %test:args('Hello "world"!')
    %test:assertEquals('"Hello ""world""!"')
function ser:adaptive-simple-atomic($atomic as xs:anyAtomicType) {
    serialize($atomic, $ser:adaptive-opts)
};

declare
    %test:assertEquals("fn:substring#3
math:pi#0
fn:exists#1
Q{http://exist-db.org/xquery/lucene}query#2
(anonymous-function)#1
Q{http://exist-db.org/xquery/test/serialize}adaptive-simple-atomic#1")
function ser:adaptive-function-item() {
    let $input := (
        substring#3,
        math:pi#0,
        Q{http://www.w3.org/2005/xpath-functions}exists#1,
        ft:query#2,
        function ($a) { $a },
        ser:adaptive-simple-atomic#1
    )
    return
        serialize($input, $ser:adaptive-opts)
};

declare
    %test:assertEquals('<?pi?><elem a="abc">123</elem>
<elem a="abc">123</elem>
a="abc"
')
function ser:adaptive-xml() {
    let $input := ($ser:test-xml, $ser:test-xml/elem, $ser:test-xml/elem/@a, $ser:test-xml/elem/comment())
    return
        serialize($input, $ser:adaptive-opts)
};

declare
    %test:assertEquals('<?pi?><elem a="abc">123</elem>
<elem a="abc">123</elem>
a="abc"
')
function ser:adaptive-xml-stored() {
    let $doc := doc($ser:collection || "/test.xml")
    let $input := ($doc, $doc/elem, $doc/elem/@a, $doc/elem/comment())
    return
        serialize($input, $ser:adaptive-opts)
};

declare
    %test:assertEquals('xmlns:foo="http://exist-db.org/foo"')
function ser:adaptive-xml-namespace() {
    let $input := namespace foo { "http://exist-db.org/foo" }
    return
        serialize($input, $ser:adaptive-opts)
};

declare
    %test:assertEquals("Q{http://exist.sourceforge.net/NS/exist}test")
function ser:adaptive-qname() {
    serialize(xs:QName("exist:test"), $ser:adaptive-opts)
};

declare
    %test:assertEquals('[(1,2,3),"hello ""world""!",true(),false()]')
function ser:adaptive-array() {
    let $input := [(1 to 3), 'hello "world"!', true(), 1 = 0]
    return
        serialize($input, $ser:adaptive-opts)
};

declare
    %test:assertEquals('map{"k1":(1,2,3),"k2":map{"k3":a="abc","k4":[1,2]}}')
function ser:adaptive-map() {
    let $input := map {
        "k1": 1 to 3,
        "k2": map { "k3": $ser:test-xml/elem/@a, "k4": array { 1 to 2 } }
    }
    return
        serialize($input, $ser:adaptive-opts)
};

declare
    %test:assertEquals('1.0e0
3.141592653589793e0
2.543e1')
function ser:adaptive-double() {
    let $input := (xs:double(1), xs:double(math:pi()), xs:double(2.543e1))
    return
        serialize($input, $ser:adaptive-opts)
};

declare
    %test:assertEquals('a="abc"
["a",2,<b>123</b>,()]
3.141592653589793e0
math:pi#0
"hello"
"""quoted"""
true()
map{"k":()}')
function ser:adaptive-mixed() {
    let $input := (
        $ser:test-xml/elem/@a,
        ["a", 2, $ser:test-xml/elem/b, ()],
        xs:double(math:pi()),
        math:pi#0,
        "hello",
        '"quoted"',
        2 = 1+1,
        map:entry("k", ())
    )
    return
        serialize($input, $ser:adaptive-opts)
};


merging adapter updated to requestParams

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

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

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

declare function page:redirect($redirect as xs:string) as element(restxq:redirect)
{
  <restxq:redirect>{ $redirect }</restxq:redirect>
};

declare function page:nocache($response) {
(<http:response status="200" message="OK">

  <http:header name="Cache-Control" value="must-revalidate,no-cache,no-store"/>
</http:response>,
$response)
};

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

declare
  %rest:path("/CSD/csr/{$doc_name}/careServicesRequest/{$search_name}/adapter/merge")
  %output:method("xhtml")
  %rest:GET
  function page:show_endpoints($search_name,$doc_name)
{
    if (not(page:is_merge($search_name)) )
      then concat('Not a stored function for a merge: ' , $search_name    )
    else
      let $action := concat("/CSD/csr/",$doc_name,"/careServicesRequest/",$search_name, "/adapter/merge")
      let $ufunction := csr_proc:get_updating_function_definition($csd_webconf:db,$search_name)
      let $contents :=

Merge into {$doc_name}

Merge Cached Service Directoriesn

{$ufunction/csd:description}

	      <form method='POST' action="{$action}">
		{
		  let $docs := csd_dm:registered_documents($csd_webconf:db)
		  return

		    {
		      for $doc in $docs
		      where not($doc = $doc_name)
		      return (<input type='checkbox'  name="merge" value="{$doc}">{$doc}</input>,
)
		    }

		    <input type='submit' value='Merge'/>

		}
	      </form>

      return csd_webconf:wrapper($contents)
};

declare updating
  %rest:path("/CSD/csr/{$doc_name}/careServicesRequest/{$search_name}/adapter/merge")
(:  %output:method("xhtml") :)
  %rest:query-param("merge", "{$merge}")
  %rest:POST
  function page:perform_merge($search_name,$doc_name,$merge)
{
  let $doc :=  csd_dm:open_document($csd_webconf:db,$doc_name)
  let $function := csr_proc:get_function_definition($csd_webconf:db,$search_name)
  let $action := concat("/CSD/csr/",$doc_name,"/careServicesRequest/",$search_name, "/adapter/merge")
  let $requestParams :=
    <csd:requestParams function="{$search_name}" resource="{$doc_name}" base_url="{$csd_webconf:baseurl}">
      <documents >
	{
          for $name in $merge
	  where not ($name = $doc_name)
	  return  <document resource="{$name}"/>
	}
      </documents>
    </csd:requestParams >

    return
      (
	csr_proc:process_updating_CSR_stored_results($csd_webconf:db, $doc,$requestParams)
	,
	() (: db:output(page:redirect(concat($csd_webconf:baseurl,$action)))  :)
      )
};

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

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

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

declare function page:redirect($redirect as xs:string) as element(restxq:redirect)
{
  <restxq:redirect>{ $redirect }</restxq:redirect>
};

declare function page:nocache($response) {
(<http:response status="200" message="OK">

  <http:header name="Cache-Control" value="must-revalidate,no-cache,no-store"/>
</http:response>,
$response)
};

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

declare
  %rest:path("/CSD/csr/{$doc_name}/careServicesRequest/{$search_name}/adapter/merge")
  %output:method("xhtml")
  %rest:GET
  function page:show_endpoints($search_name,$doc_name)
{
    if (not(page:is_merge($search_name)) )
      then concat('Not a stored function for a merge: ' , $search_name    )
    else
      let $action := concat("/CSD/csr/",$doc_name,"/careServicesRequest/",$search_name, "/adapter/merge")
      let $ufunction := csr_proc:get_updating_function_definition($csd_webconf:db,$search_name)
      let $contents :=

Merge into {$doc_name}

Merge Cached Service Directoriesn

{$ufunction/csd:description}

	      <form method='POST' action="{$action}">
		{
		  let $docs := csd_dm:registered_documents($csd_webconf:db)
		  return

		    {
		      for $doc in $docs
		      where not($doc = $doc_name)
		      return (<input type='checkbox'  name="merge" value="{$doc}">{$doc}</input>,
)
		    }

		    <input type='submit' value='Merge'/>

		}
	      </form>

      return csd_webconf:wrapper($contents)
};

declare updating
  %rest:path("/CSD/csr/{$doc_name}/careServicesRequest/{$search_name}/adapter/merge")
  %output:method("xhtml")
  %rest:query-param("merge", "{$merge}")
  %rest:POST
  function page:perform_merge($search_name,$doc_name,$merge)
{
  let $doc :=  csd_dm:open_document($csd_webconf:db,$doc_name)
  let $function := csr_proc:get_function_definition($csd_webconf:db,$search_name)
  let $action := concat("/CSD/csr/",$doc_name,"/careServicesRequest/",$search_name, "/adapter/merge")
  let $careServicesRequest :=
    <csd:careServicesRequest>
      <csd:function urn="{$search_name}" resource="{$doc_name}" base_url="{$csd_webconf:baseurl}">
        <csd:requestParams >
	  <documents >
	    {
              for $name in $merge
	      where not ($name = $doc_name)
	      return  <document resource="{$name}"/>
	    }
	  </documents>
        </csd:requestParams >
      </csd:function>
    </csd:careServicesRequest>

    return
      (
	csr_proc:process_updating_CSR_stored_results($csd_webconf:db, $doc,$careServicesRequest)
	,
	db:output(page:redirect(concat($csd_webconf:baseurl,$action)))
      )
};


[bugfix] There are now more functions in XQSuite, update the test

xquery version "3.1";

module namespace lxm="http://exist-db.org/xquery/test/load-xquery-module";

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

declare variable $lxm:MYVAR := lxm:func("ok");

declare variable $lxm:EXTERNAL external := "external var";

declare variable $lxm:EXTERNAL_TYPED as xs:integer external := 123;

declare variable $lxm:EXTERNAL_EXPR as xs:string external := $lxm:MYVAR;

declare variable $lxm:EXTERNAL_CONTEXT as xs:string := upper-case(.);

declare variable $lxm:EXTERNAL_NO_DEFAULT external;

declare function lxm:func($arg as xs:string) {
    upper-case($arg)
};

declare function lxm:func($arg1 as xs:string, $arg2 as xs:string) {
    lxm:func($arg1) || lxm:func($arg2)
};

declare
    %test:assertEquals(4)
function lxm:import-standard() {
    let $module := load-xquery-module("http://www.w3.org/2005/xpath-functions")
    for $funcByName in $module?functions(xs:QName("fn:min"))?1
    return
        $funcByName((9, 8, 4))
};

declare
    %test:assertEquals(14, 2, "OK", "OK", 6, "OK")
function lxm:import-with-location() {
    let $module := load-xquery-module("http://exist-db.org/xquery/test/load-xquery-module", map {
        "location-hints": "load-xquery-module.xql",
        "xquery-version": 3.1,
        "variables": map { xs:QName("lxm:EXTERNAL_NO_DEFAULT"): "OK" }
    })
    let $fn := $module?functions(xs:QName("lxm:func"))
    return (
        map:size($module?functions),
        map:size($fn),
        $fn?1("ok"),
        $fn?2("o", "k"),
        map:size($module?variables),
        $module?variables(xs:QName("lxm:MYVAR"))
    )
};

declare
    %test:assertError("err:FOQM0003")
function lxm:import-wrong-version() {
    let $module := load-xquery-module("http://exist-db.org/xquery/test/load-xquery-module", map {
        "location-hints": "load-xquery-module.xql",
        "xquery-version": 3.0,
        "variables": map { xs:QName("lxm:EXTERNAL_NO_DEFAULT"): "OK" }
    })
    return
        map:size($module?functions)
};

declare
    %test:assertEquals(7)
function lxm:import-from-classpath() {
    let $module := load-xquery-module("http://exist-db.org/xquery/xqsuite", map {
        "location-hints": "resource:org/exist/xquery/lib/xqsuite/xqsuite.xql"
    })
    return
        map:size($module?functions)
};

declare
    %test:assertError("err:FOQM0002")
function lxm:import-not-found1() {
    let $module := load-xquery-module("http://exist-db.org/xquery/does-not-exist")
    return
        map:size($module?functions)
};

declare
    %test:assertError("err:FOQM0002")
function lxm:import-not-found2() {
    let $module := load-xquery-module("http://exist-db.org/xquery/does-not-exist", map {
        "location-hints": "does-not-exist.xql"
    })
    return
        map:size($module?functions)
};

declare
    %test:assertEquals("external var")
function lxm:import-with-external-var-default() {
    let $module := load-xquery-module("http://exist-db.org/xquery/test/load-xquery-module", map {
        "location-hints": "load-xquery-module.xql",
        "xquery-version": 3.1,
        "variables": map { xs:QName("lxm:EXTERNAL_NO_DEFAULT"): "OK" }
    })
    return
        $module?variables(xs:QName("lxm:EXTERNAL"))
};

declare
    %test:assertEquals("hello world")
function lxm:import-with-external-var-set() {
    let $module := load-xquery-module("http://exist-db.org/xquery/test/load-xquery-module", map {
        "location-hints": "load-xquery-module.xql",
        "xquery-version": 3.1,
        "variables": map {
            xs:QName("lxm:EXTERNAL"): "hello world",
            xs:QName("lxm:EXTERNAL_NO_DEFAULT"): "OK"
        }
    })
    return
        $module?variables(xs:QName("lxm:EXTERNAL"))
};

declare
    %test:assertEquals(999)
function lxm:import-with-external-var-set-typed() {
    let $module := load-xquery-module("http://exist-db.org/xquery/test/load-xquery-module", map {
        "location-hints": "load-xquery-module.xql",
        "xquery-version": 3.1,
        "variables": map {
            xs:QName("lxm:EXTERNAL"): 999,
            xs:QName("lxm:EXTERNAL_NO_DEFAULT"): "OK"
        }
    })
    return
        $module?variables(xs:QName("lxm:EXTERNAL"))
};

declare
    %test:assertEquals("OK")
function lxm:import-with-external-var-default-expr() {
    let $module := load-xquery-module("http://exist-db.org/xquery/test/load-xquery-module", map {
        "location-hints": "load-xquery-module.xql",
        "xquery-version": 3.1,
        "variables": map { xs:QName("lxm:EXTERNAL_NO_DEFAULT"): "OK" }
    })
    return
        $module?variables(xs:QName("lxm:EXTERNAL_EXPR"))
};

declare
    %test:assertEquals("OK")
function lxm:import-with-external-var-no-default() {
    let $module := load-xquery-module("http://exist-db.org/xquery/test/load-xquery-module", map {
        "location-hints": "load-xquery-module.xql",
        "variables": map { xs:QName("lxm:EXTERNAL_NO_DEFAULT"): "OK" }
    })
    return
        $module?variables(xs:QName("lxm:EXTERNAL_NO_DEFAULT"))
};

declare
    %test:assertError("err:FOQM0005")
function lxm:import-with-external-var-set-wrong-type() {
    let $module := load-xquery-module("http://exist-db.org/xquery/test/load-xquery-module", map {
        "location-hints": "load-xquery-module.xql",
        "xquery-version": 3.1,
        "variables": map {
            xs:QName("lxm:EXTERNAL_TYPED"): "hello world",
            xs:QName("lxm:EXTERNAL_NO_DEFAULT"): "OK"
        }
    })
    return
        $module?variables(xs:QName("lxm:EXTERNAL_TYPED"))
};

declare
    %test:assertEquals("OK")
function lxm:import-with-context-item() {
    let $module := load-xquery-module("http://exist-db.org/xquery/test/load-xquery-module", map {
        "location-hints": "load-xquery-module.xql",
        "xquery-version": 3.1,
        "context-item": "ok",
        "variables": map { xs:QName("lxm:EXTERNAL_NO_DEFAULT"): "OK" }
    })
    return
        $module?variables(xs:QName("lxm:EXTERNAL_CONTEXT"))
};

xquery version "3.1";

module namespace lxm="http://exist-db.org/xquery/test/load-xquery-module";

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

declare variable $lxm:MYVAR := lxm:func("ok");

declare variable $lxm:EXTERNAL external := "external var";

declare variable $lxm:EXTERNAL_TYPED as xs:integer external := 123;

declare variable $lxm:EXTERNAL_EXPR as xs:string external := $lxm:MYVAR;

declare variable $lxm:EXTERNAL_CONTEXT as xs:string := upper-case(.);

declare variable $lxm:EXTERNAL_NO_DEFAULT external;

declare function lxm:func($arg as xs:string) {
    upper-case($arg)
};

declare function lxm:func($arg1 as xs:string, $arg2 as xs:string) {
    lxm:func($arg1) || lxm:func($arg2)
};

declare
    %test:assertEquals(4)
function lxm:import-standard() {
    let $module := load-xquery-module("http://www.w3.org/2005/xpath-functions")
    for $funcByName in $module?functions(xs:QName("fn:min"))?1
    return
        $funcByName((9, 8, 4))
};

declare
    %test:assertEquals(14, 2, "OK", "OK", 6, "OK")
function lxm:import-with-location() {
    let $module := load-xquery-module("http://exist-db.org/xquery/test/load-xquery-module", map {
        "location-hints": "load-xquery-module.xql",
        "xquery-version": 3.1,
        "variables": map { xs:QName("lxm:EXTERNAL_NO_DEFAULT"): "OK" }
    })
    let $fn := $module?functions(xs:QName("lxm:func"))
    return (
        map:size($module?functions),
        map:size($fn),
        $fn?1("ok"),
        $fn?2("o", "k"),
        map:size($module?variables),
        $module?variables(xs:QName("lxm:MYVAR"))
    )
};

declare
    %test:assertError("err:FOQM0003")
function lxm:import-wrong-version() {
    let $module := load-xquery-module("http://exist-db.org/xquery/test/load-xquery-module", map {
        "location-hints": "load-xquery-module.xql",
        "xquery-version": 3.0,
        "variables": map { xs:QName("lxm:EXTERNAL_NO_DEFAULT"): "OK" }
    })
    return
        map:size($module?functions)
};

declare
    %test:assertEquals(5)
function lxm:import-from-classpath() {
    let $module := load-xquery-module("http://exist-db.org/xquery/xqsuite", map {
        "location-hints": "resource:org/exist/xquery/lib/xqsuite/xqsuite.xql"
    })
    return
        map:size($module?functions)
};

declare
    %test:assertError("err:FOQM0002")
function lxm:import-not-found1() {
    let $module := load-xquery-module("http://exist-db.org/xquery/does-not-exist")
    return
        map:size($module?functions)
};

declare
    %test:assertError("err:FOQM0002")
function lxm:import-not-found2() {
    let $module := load-xquery-module("http://exist-db.org/xquery/does-not-exist", map {
        "location-hints": "does-not-exist.xql"
    })
    return
        map:size($module?functions)
};

declare
    %test:assertEquals("external var")
function lxm:import-with-external-var-default() {
    let $module := load-xquery-module("http://exist-db.org/xquery/test/load-xquery-module", map {
        "location-hints": "load-xquery-module.xql",
        "xquery-version": 3.1,
        "variables": map { xs:QName("lxm:EXTERNAL_NO_DEFAULT"): "OK" }
    })
    return
        $module?variables(xs:QName("lxm:EXTERNAL"))
};

declare
    %test:assertEquals("hello world")
function lxm:import-with-external-var-set() {
    let $module := load-xquery-module("http://exist-db.org/xquery/test/load-xquery-module", map {
        "location-hints": "load-xquery-module.xql",
        "xquery-version": 3.1,
        "variables": map {
            xs:QName("lxm:EXTERNAL"): "hello world",
            xs:QName("lxm:EXTERNAL_NO_DEFAULT"): "OK"
        }
    })
    return
        $module?variables(xs:QName("lxm:EXTERNAL"))
};

declare
    %test:assertEquals(999)
function lxm:import-with-external-var-set-typed() {
    let $module := load-xquery-module("http://exist-db.org/xquery/test/load-xquery-module", map {
        "location-hints": "load-xquery-module.xql",
        "xquery-version": 3.1,
        "variables": map {
            xs:QName("lxm:EXTERNAL"): 999,
            xs:QName("lxm:EXTERNAL_NO_DEFAULT"): "OK"
        }
    })
    return
        $module?variables(xs:QName("lxm:EXTERNAL"))
};

declare
    %test:assertEquals("OK")
function lxm:import-with-external-var-default-expr() {
    let $module := load-xquery-module("http://exist-db.org/xquery/test/load-xquery-module", map {
        "location-hints": "load-xquery-module.xql",
        "xquery-version": 3.1,
        "variables": map { xs:QName("lxm:EXTERNAL_NO_DEFAULT"): "OK" }
    })
    return
        $module?variables(xs:QName("lxm:EXTERNAL_EXPR"))
};

declare
    %test:assertEquals("OK")
function lxm:import-with-external-var-no-default() {
    let $module := load-xquery-module("http://exist-db.org/xquery/test/load-xquery-module", map {
        "location-hints": "load-xquery-module.xql",
        "variables": map { xs:QName("lxm:EXTERNAL_NO_DEFAULT"): "OK" }
    })
    return
        $module?variables(xs:QName("lxm:EXTERNAL_NO_DEFAULT"))
};

declare
    %test:assertError("err:FOQM0005")
function lxm:import-with-external-var-set-wrong-type() {
    let $module := load-xquery-module("http://exist-db.org/xquery/test/load-xquery-module", map {
        "location-hints": "load-xquery-module.xql",
        "xquery-version": 3.1,
        "variables": map {
            xs:QName("lxm:EXTERNAL_TYPED"): "hello world",
            xs:QName("lxm:EXTERNAL_NO_DEFAULT"): "OK"
        }
    })
    return
        $module?variables(xs:QName("lxm:EXTERNAL_TYPED"))
};

declare
    %test:assertEquals("OK")
function lxm:import-with-context-item() {
    let $module := load-xquery-module("http://exist-db.org/xquery/test/load-xquery-module", map {
        "location-hints": "load-xquery-module.xql",
        "xquery-version": 3.1,
        "context-item": "ok",
        "variables": map { xs:QName("lxm:EXTERNAL_NO_DEFAULT"): "OK" }
    })
    return
        $module?variables(xs:QName("lxm:EXTERNAL_CONTEXT"))
};


[tweak]  need to init /db/system/repo for repo admin to work!

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

xquery version "1.0";

module namespace repomanager="http://exist-db.org/xquery/admin-interface/repo";

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

declare function repomanager:upload() as element()
{
    let $name := request:get-parameter("name", ()),
    $repocol :=  if (collection('/db/system/repo')) then () else xmldb:create-collection('/db/system','repo'),
    $docName := if($name) then $name else request:get-uploaded-file-name("upload"),
    $file := request:get-uploaded-file-data("upload") return

Actions:

                {
                if (contains($docName,'.xar')) then
                    (
uploaded package: {$docName}
,

                    xdb:decode-uri(xs:anyURI(xdb:store('/db/system/repo', xdb:encode-uri($docName), $file)))
                    )
                else

Error uploading - Must be a valid Package archive (.xar file extension)

                }

};

declare function repomanager:activate() as element()
{
    let $name := request:get-parameter("name", ()),
    $hostname := request:get-hostname(),            (:  pkg-repo.jar needs http or file scheme :)
    $port := request:get-server-port()
     return

Actions:

activated package: {$name}

                {
                    repo:install(concat('http://',$hostname,':',$port,'/exist/rest/db/system/repo/',$name,'.xar'))
                }

};

declare function repomanager:deactivate() as element()
{
    let $name := request:get-parameter("name", ())
     return

Actions:

deactivated package: {$name}

                {
                    repo:remove($name)
                }

};

declare function repomanager:remove() as element()
{
    let $name := request:get-parameter("name", ())
     return

Actions:

removed package: {$name}

                {xmldb:remove('/db/system/repo',concat($name,'.xar'))}

};

declare function repomanager:process-action() as element()*
{
    let $action := request:get-parameter("action", ()) return
        util:catch("java.lang.Exception",
            if($action eq "remove") then
            (
                repomanager:remove()
            )
            else if($action eq "activate") then
            (
                repomanager:activate()
            )
            else if($action eq "deactivate") then
            (
                repomanager:deactivate()
            )
            else if($action eq "Upload Package") then
            (
                repomanager:upload()
            )else(),

                An error occurred while processing the action:

                {$util:exception-message}

        )
};

declare function repomanager:main() as element() {
    let $action := lower-case(request:get-parameter("action", "refresh"))

    return

Package Repository

            <form method="POST" enctype="multipart/form-data">

         { repomanager:process-action() }

                Package
                Date installed
                Installed
                Action

        {
         let $files := collection('/db/system/repo')/util:document-name(.)
         let $repos := repo:list()
         return

            for $file in $files
            let $package-name := substring-before($file,'.xar')
            let $installed := exists($repos[. eq $package-name])
            return

                {$package-name}
                {xmldb:last-modified('/db/system/repo', concat($package-name,'.xar'))}

                {if ($installed) then
                    {$installed}
                else
                    {$installed}
                }

                {
                if($installed) then
                  deactivate

                 else
                 ( activate,' | ',
                 remove
                 )
                }

            }

                        <input type="submit" name="action" value="Upload Package"/>
                        <input type="file" size="30" name="upload"/>

 You can find example .xar packages located under webapp/repo/packages

Note: link to eXist-db own public package repository coming soon ....

          </form>

};

xquery version "1.0";

module namespace repomanager="http://exist-db.org/xquery/admin-interface/repo";

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

declare function repomanager:upload() as element()
{
    let $name := request:get-parameter("name", ()),
    $docName := if($name) then $name else request:get-uploaded-file-name("upload"),
    $file := request:get-uploaded-file-data("upload") return

Actions:

                {
                if (contains($docName,'.xar')) then
                    (
uploaded package: {$docName}
,

                    xdb:decode-uri(xs:anyURI(xdb:store('/db/system/repo', xdb:encode-uri($docName), $file)))
                    )
                else

Error uploading - Must be a valid Package archive (.xar file extension)

                }

};

declare function repomanager:activate() as element()
{
    let $name := request:get-parameter("name", ()),
    $hostname := request:get-hostname(),            (:  pkg-repo.jar needs http or file scheme :)
    $port := request:get-server-port()
     return

Actions:

activated package: {$name}

                {
                    repo:install(concat('http://',$hostname,':',$port,'/exist/rest/db/system/repo/',$name,'.xar'))
                }

};

declare function repomanager:deactivate() as element()
{
    let $name := request:get-parameter("name", ())
     return

Actions:

deactivated package: {$name}

                {
                    repo:remove($name)
                }

};

declare function repomanager:remove() as element()
{
    let $name := request:get-parameter("name", ())
     return

Actions:

removed package: {$name}

                {xmldb:remove('/db/system/repo',concat($name,'.xar'))}

};

declare function repomanager:process-action() as element()*
{
    let $action := request:get-parameter("action", ()) return
        util:catch("java.lang.Exception",
            if($action eq "remove") then
            (
                repomanager:remove()
            )
            else if($action eq "activate") then
            (
                repomanager:activate()
            )
            else if($action eq "deactivate") then
            (
                repomanager:deactivate()
            )
            else if($action eq "Upload Package") then
            (
                repomanager:upload()
            )else(),

                An error occurred while processing the action:

                {$util:exception-message}

        )
};

declare function repomanager:main() as element() {
    let $action := lower-case(request:get-parameter("action", "refresh"))

    return

Package Repository

            <form method="POST" enctype="multipart/form-data">

         { repomanager:process-action() }

                Package
                Date installed
                Installed
                Action

        {
         let $files := collection('/db/system/repo')/util:document-name(.)
         let $repos := repo:list()
         return

            for $file in $files
            let $package-name := substring-before($file,'.xar')
            let $installed := exists($repos[. eq $package-name])
            return

                {$package-name}
                {xmldb:last-modified('/db/system/repo', concat($package-name,'.xar'))}

                {if ($installed) then
                    {$installed}
                else
                    {$installed}
                }

                {
                if($installed) then
                  deactivate

                 else
                 ( activate,' | ',
                 remove
                 )
                }

            }

                        <input type="submit" name="action" value="Upload Package"/>
                        <input type="file" size="30" name="upload"/>

 You can find example .xar packages located under webapp/repo/packages

Note: link to eXist-db own public package repository coming soon ....

          </form>

};


Added the correct categories for the modules that appear as part of the left menu tree of the XQDoc documentation.

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

(:~
 : Reflection Module for Zorba.
 :
 : @author Nicolae Brinza
 : @project reflection
 :
 :)

module namespace reflection = "http://www.zorba-xquery.com/modules/reflection";

(:~
 : The invoke function allows to dynamically call a function given its QName
 : and parameters. It is possible to invoke a function who's name is not known
 : at compilation time -- it can be computed, passed through an external
 : variable, taken from a file, etc. The first parameter must always be a
 : QName identifying a known function. The rest of the parameters will be
 : passed to the function that is called.
 :
 : invoke comes in three flavours:
 : invoke-simple() - for the invocation of functions that are non-updating and
 :                   non-side effecting
 : invoke-updating() - for the invocation of updating functions
 : invoke-sequential() - for the invocation of sequential functions
 :
 :

 : Example usage :
 reflection:invoke-simple ( xs:QName("fn:max"),
 :                                                  (1,2,3) )

 :

 : Returns :
 3

 :
 : @param $name the QName of the function that is to be called.
 : @return the result that is returned by the invoked function.
 :)
declare %non-deterministic %variadic function reflection:invoke-simple($name as xs:QName) as item()* external;

(:~
 : invoke-updating()
 :
 : @param $name the QName of the function that is to be called.
 : @return the result that is returned by the invoked function.
 :)
declare %variadic updating function reflection:invoke-updating($name as xs:QName) external;

(:~
 : invoke-sequential()
 :
 : @param $name the QName of the function that is to be called.
 : @return the result that is returned by the invoked function.
 :)
declare %variadic %sequential function reflection:invoke-sequential($name as xs:QName) as item()* external;

(:~
 : Eval
 :
 : @param $query the query string to be evaluated.
 : @return the result of evaluating the query (the result is not supposed to
 :         contain any PUL).
 :)
declare function reflection:eval-simple(
    $query as xs:string
) as item()* external;

(:~
 : Eval
 :
 : @param $query the query string to be evaluated.
 : @return the PUL resulting from evaluating the query
 :)
declare updating function reflection:eval-updating(
    $query as xs:string
) external;

(:~
 : Eval
 :
 : @param $query the query string to be evaluated.
 : @return the result of evaluating the query (the result is not supposed to
 :         contain any PUL).
 :)
declare %sequential function reflection:eval-sequential(
    $query as xs:string
) as item()* external;

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

(:~
 : Reflection Module for Zorba.
 :
 : @author Nicolae Brinza
 :
 :)

module namespace reflection = "http://www.zorba-xquery.com/modules/reflection";

(:~
 : The invoke function allows to dynamically call a function given its QName
 : and parameters. It is possible to invoke a function who's name is not known
 : at compilation time -- it can be computed, passed through an external
 : variable, taken from a file, etc. The first parameter must always be a
 : QName identifying a known function. The rest of the parameters will be
 : passed to the function that is called.
 :
 : invoke comes in three flavours:
 : invoke-simple() - for the invocation of functions that are non-updating and
 :                   non-side effecting
 : invoke-updating() - for the invocation of updating functions
 : invoke-sequential() - for the invocation of sequential functions
 :
 :

 : Example usage :
 reflection:invoke-simple ( xs:QName("fn:max"),
 :                                                  (1,2,3) )

 :

 : Returns :
 3

 :
 : @param $name the QName of the function that is to be called.
 : @return the result that is returned by the invoked function.
 :)
declare %non-deterministic %variadic function reflection:invoke-simple($name as xs:QName) as item()* external;

(:~
 : invoke-updating()
 :
 : @param $name the QName of the function that is to be called.
 : @return the result that is returned by the invoked function.
 :)
declare %variadic updating function reflection:invoke-updating($name as xs:QName) external;

(:~
 : invoke-sequential()
 :
 : @param $name the QName of the function that is to be called.
 : @return the result that is returned by the invoked function.
 :)
declare %variadic %sequential function reflection:invoke-sequential($name as xs:QName) as item()* external;

(:~
 : Eval
 :
 : @param $query the query string to be evaluated.
 : @return the result of evaluating the query (the result is not supposed to
 :         contain any PUL).
 :)
declare function reflection:eval-simple(
    $query as xs:string
) as item()* external;

(:~
 : Eval
 :
 : @param $query the query string to be evaluated.
 : @return the PUL resulting from evaluating the query
 :)
declare updating function reflection:eval-updating(
    $query as xs:string
) external;

(:~
 : Eval
 :
 : @param $query the query string to be evaluated.
 : @return the result of evaluating the query (the result is not supposed to
 :         contain any PUL).
 :)
declare %sequential function reflection:eval-sequential(
    $query as xs:string
) as item()* external;