in base library, fixed typo when limiting by a start and max

(:~
: This is the Care Services Discovery base XQuery module
: @version 1.0
: @see http://ihe.net
:
:)
module namespace csd = "urn:ihe:iti:csd:2013" ;
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 @codingSchema (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/@codingSchema))
     then
        let $code := fn:upper-case($codedtype/@code)
	    let $cSchema := $codedtype/@codingSchema
        return $items[codedType[
                @code = $code
 	            and
                @codingSchema = $cSchema
                ]
            ]
     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 @oid attribute then it is used to filter the $items list by their @oid attributes by performing an exact match of the @oid $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/@oid)
       then $items[@oid =$id/@oid]
       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)]

 };

(:~
 : 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 )
    then  ()
    else
    	$items[organizations/organization/@oid = $orgs[1]/@oid ]
        union
        csd:filter_by_organizations($items, 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 )
    then  ()
    else
    	$items[facilities/facility/@oid  = $facs[1]/@oid]
        union
        csd:filter_by_facilities($items, 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 = "urn:ihe:iti:csd:2013" ;
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 @codingSchema (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/@codingSchema))
     then
        let $code := fn:upper-case($codedtype/@code)
	    let $cSchema := $codedtype/@codingSchema
        return $items[codedType[
                @code = $code
 	            and
                @codingSchema = $cSchema
                ]
            ]
     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 @oid attribute then it is used to filter the $items list by their @oid attributes by performing an exact match of the @oid $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/@oid)
       then $items[@oid =$id/@oid]
       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)]

 };

(:~
 : 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 )
    then  ()
    else
    	$items[organizations/organization/@oid = $orgs[1]/@oid ]
        union
        csd:filter_by_organizations($items, 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 )
    then  ()
    else
    	$items[facilities/facility/@oid  = $facs[1]/@oid]
        union
        csd:filter_by_facilities($items, 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)
};


Add support for function name overrides in the ML docs (fixes function name of toJSON)

xquery version "1.0-ml";

declare variable $xml external;
let $xml := xdmp:unquote("<wrap>" || $xml || "</wrap>")

let $definition := xdmp:xslt-eval(
  <xsl:stylesheet version="2.0" exclude-result-prefixes="#all" xmlns:xsl="http://www.w3.org/1999/XSL/Transform" xmlns:apidoc="http://marklogic.com/xdmp/apidoc" xmlns:local="local">

    <xsl:output method="text" indent="yes" omit-xml-declaration="yes"/>

    <xsl:template match="@*|node()" mode="#all">
      <xsl:copy>
        <xsl:apply-templates select="@*|node()" mode="#current"/>
      </xsl:copy>
    </xsl:template>

    <xsl:template match="apidoc:function" mode="#all">
      <xsl:param name="use-function-keyword" select="false()"/>
      <xsl:param name="use-declare-keyword" select="false()"/>

      <xsl:text>    /** </xsl:text>
      <xsl:value-of select="normalize-space(apidoc:summary)"/>
      <xsl:text> **/
</xsl:text>

      <xsl:text>  </xsl:text>
      <xsl:if test="$use-declare-keyword">
        <xsl:text>declare </xsl:text>
      </xsl:if>
      <xsl:if test="$use-function-keyword">
        <xsl:text>function </xsl:text>
      </xsl:if>

      <!--
      The function name can usually be derived by convetion. But in some cases (well, one case - toJSON), an override
      is provided in the documentation. In those cases, the override should be used. This is also how this is handled
      in RunDMC in api:javascript-name
      (https://github.com/marklogic-community/RunDMC/blob/master/src/apidoc/model/data-access.xqy#L407).
      -->
      <xsl:variable name="function-name">
        <xsl:value-of>
          <xsl:variable name="name-override" select="apidoc:name[@class eq 'javascript']/text()"/>
          <xsl:choose>
            <xsl:when test="exists($name-override)">
              <!-- an override exists, use it -->
              <xsl:value-of select="$name-override"/>
            </xsl:when>
            <xsl:otherwise>
              <!-- no override exists, follow convention in local:fixName -->
              <xsl:value-of select="local:fixName(@name)"/>
            </xsl:otherwise>
          </xsl:choose>
        </xsl:value-of>
      </xsl:variable>

      <xsl:value-of select="$function-name"/>
      <xsl:text>(</xsl:text>
      <xsl:for-each select="apidoc:params/apidoc:param">
        <xsl:variable name="is-multi" select="matches(@type, ',\.\.\.$')"/>
        <xsl:if test="$is-multi">...</xsl:if>
        <xsl:value-of select="local:fixName(@name)"/>
        <xsl:if test="preceding-sibling::apidoc:param[@name = current()/@name]">2</xsl:if>
        <xsl:if test="not($is-multi) and string(@optional) = 'true'">?</xsl:if>
        <xsl:text>: </xsl:text>
        <xsl:value-of select="local:fixType(@type, true())"/>
        <xsl:if test="$is-multi">[]</xsl:if>
        <xsl:if test="not($is-multi) and string(@optional) = 'true'">|null|undefined</xsl:if>
        <xsl:if test="not(position() = last())">, </xsl:if>
      </xsl:for-each>
      <xsl:text>): </xsl:text>
      <xsl:value-of select="local:fixType(string(apidoc:return), false())"/>
      <xsl:text>;

</xsl:text>
    </xsl:template>

    <xsl:template match="/wrap">
      <xsl:variable name="root" select="."/>

      <xsl:text>// Type definitions for </xsl:text><xsl:value-of select="apidoc:module[exists(apidoc:function)]/@name"/><xsl:text>
</xsl:text>
      <xsl:text>// Definitions: </xsl:text><xsl:value-of select="base-uri(.)"/><xsl:text>

</xsl:text>

        <xsl:for-each select="distinct-values(((//apidoc:module[exists(apidoc:function)]/@lib, 'xdmp')[1], //apidoc:function/@lib))">
          <xsl:sort/>
          <xsl:variable name="lib" select="."/>
          <xsl:variable name="name" select="string-join(local:fixName($lib), '')"/>
          <xsl:variable name="functions" select="$root//apidoc:function[@lib = $lib]"/>
          <xsl:variable name="module" select="$functions/.."/>

          <xsl:text>
/**
</xsl:text>
          <xsl:value-of select="$module/apidoc:summary"/>
          <xsl:text>
**/

</xsl:text>

          <xsl:choose>
          <xsl:when test="$name = 'GlobalObject'">
            <xsl:apply-templates select="$functions">
              <xsl:sort select="@name" />
              <xsl:with-param name="use-function-keyword" select="true()"/>
              <xsl:with-param name="use-declare-keyword" select="true()"/>
            </xsl:apply-templates>
          </xsl:when>
          <xsl:when test="$name = 'alert'">
            <xsl:text>declare module </xsl:text>
            <xsl:value-of select="$name"/>
            <xsl:text> {{

</xsl:text>

            <xsl:apply-templates select="$functions">
              <xsl:sort select="@name" />
              <xsl:with-param name="use-function-keyword" select="true()"/>
            </xsl:apply-templates>

            <xsl:text>}}
</xsl:text>
          </xsl:when>
          <xsl:otherwise>
            <xsl:text>interface </xsl:text>
            <xsl:value-of select="$name"/>
            <xsl:text>Functions {{

</xsl:text>

            <xsl:apply-templates select="$functions">
              <xsl:sort select="@name" />
            </xsl:apply-templates>

            <xsl:text>}}
</xsl:text>

            <xsl:text>declare var </xsl:text>
            <xsl:value-of select="$name"/>
            <xsl:text>:</xsl:text>
            <xsl:value-of select="$name"/>
            <xsl:text>Functions
</xsl:text>
          </xsl:otherwise>
          </xsl:choose>
        </xsl:for-each>
    </xsl:template>

    <xsl:function name="local:fixType">
      <xsl:param name="fullType"/>
      <xsl:param name="isForParameter"/>

      <xsl:variable name="fullType" select="translate($fullType, ' ', '')"/>
      <xsl:variable name="type" select="replace(replace($fullType, ',\.\.\.$', ''), '([?*+]|\[\])$', '')"/>
      <xsl:variable name="cardinality" select="substring($fullType, string-length($type) + 1)"/>
      <xsl:variable name="isArray" select="matches($cardinality, '^([*+]|\[\])')"/>
      <xsl:variable name="type" select="if (substring($type, 1, 1) = '(') then substring($type, 2, string-length($type) - 2) else $type"/>

      <xsl:value-of select="local:fixEachType($type, $isArray, $isForParameter)"/>
    </xsl:function>

    <xsl:function name="local:fixEachType">
      <xsl:param name="typeUnion"/>
      <xsl:param name="isArray"/>
      <xsl:param name="isForParameter"/>

      <xsl:variable name="type" select="substring-before(concat($typeUnion,'|'),'|')"/>
      <xsl:variable name="type" select="replace($type, '([?*+]|\[\])$', '')"/>

      <xsl:choose>
        <xsl:when test="matches($type, '^function\(.*\)as(.+)$')">
          <xsl:value-of select="local:fixFunctionType($type, $isArray)"/>
        </xsl:when>
        <xsl:when test="$isArray">
          <xsl:choose>
            <xsl:when test="$type = ('document-node()', 'binary()', 'element()', 'node()')">
              <xsl:value-of select="local:fixArrayType('any', $isForParameter)"/>
            </xsl:when>
            <xsl:otherwise>
              <xsl:value-of select="local:fixArrayType(string-join(local:fixSingleType($type, $isForParameter), ''), $isForParameter)"/>
            </xsl:otherwise>
          </xsl:choose>
        </xsl:when>
        <xsl:otherwise>
          <xsl:value-of select="local:fixSingleType($type, $isForParameter)"/>
        </xsl:otherwise>
      </xsl:choose>

      <xsl:if test="contains($typeUnion, '|')">
        <xsl:value-of select="concat('|', string-join(local:fixEachType(substring-after($typeUnion, '|'), $isArray, $isForParameter), ''))"/>
      </xsl:if>
    </xsl:function>

    <xsl:function name="local:fixArrayType">
      <xsl:param name="type"/>
      <xsl:param name="isForParameter"/>
      <xsl:value-of select="concat(concat(if($isForParameter) then 'MLArray<' else 'Sequence<', $type), '>')"/>
    </xsl:function>

    <xsl:function name="local:fixSingleType">
      <xsl:param name="type"/>
      <xsl:param name="isForParameter"/>
      <xsl:choose>
        <!-- workarounds for docs bugs -->
        <xsl:when test="$type = 'query-results-serialize($results)'">MLNode<any></xsl:when>
        <xsl:when test="$type = 'option'">Sequence<any></xsl:when>
        <xsl:when test="$type = 'genericDateTimeArg'">xs.GenericDateTimeArg</xsl:when>
        <xsl:when test="$type = 'rdf:collatedString'">sql.CollatedString</xsl:when>

        <xsl:when test="$type = 'any[]'">Array<any></xsl:when>
        <xsl:when test="$type = ('ValueIterator', 'Sequence')">Sequence<any></xsl:when>
        <xsl:when test="$type = 'document-node()'">DocumentNode<any></xsl:when>
        <xsl:when test="$type = ('binary()')">MLNode<any></xsl:when>
        <xsl:when test="$type = ('element()', 'node()')">
          <xsl:choose>
            <xsl:when test="$isForParameter">MLNodeOrObject<any></xsl:when>
            <xsl:otherwise>MLNode<any></xsl:otherwise>
          </xsl:choose>
        </xsl:when>
        <xsl:when test="$type = ('empty-seq', 'empty-sequence', 'empty-sequence()', 'null', 'Null')">null</xsl:when>
        <xsl:when test="$type = ('String', 'xs:anyURI', 'xs:NCName', 'xs:string', 'xs:time', 'xs:duration', 'xs:dayTimeDuration')">string</xsl:when>
        <xsl:when test="$type = ('json:array', 'Array')">Array<any></xsl:when>
        <xsl:when test="$type = ('json:object', 'map:map', 'Options')">{[key:string]:any}</xsl:when>
        <xsl:when test="$type = ('function()', 'xdmp:function', 'function(*', 'function(*)', 'function')">() => any</xsl:when>
        <xsl:when test="$type = 'xs:boolean'">boolean</xsl:when>
        <xsl:when test="$type = ('any', 'xs:anyAtomicType', 'item()')">any</xsl:when>
        <xsl:when test="$type = ('xs:dateTime', 'xs:date')">Date</xsl:when>
        <xsl:when test="$type = ('Int', 'double', 'xs:numeric', 'numeric', 'xs:decimal', 'xs:double', 'xs:unsigned', 'xs:unsingedLong', 'xs:unsignedLong', 'xs:int', 'xs:float', 'xs:integer', 'xs:long', 'xs:nonNegativeInteger', 'xs:positiveInteger', 'xs:unsignedInt')">number</xsl:when>
        <xsl:when test="matches($type, '^(schema-)?[Ee]lement\([^)]+\)')">
          <xsl:choose>
            <!-- TODO: Can we perform generics on this? -->
            <xsl:when test="$isForParameter">MLNodeOrObject<any></xsl:when>
            <xsl:otherwise>MLNode<any></xsl:otherwise>
          </xsl:choose>
        </xsl:when>
        <xsl:otherwise>
          <xsl:variable name="local-name" select="replace($type, '^([^:.]+[:.])?([^\(\)]+)\(?\)?$', '$2')"/>
          <xsl:variable name="fixed-local-name" select="string-join(local:fixName($local-name), '')"/>
          <xsl:variable name="type-name" select="concat(upper-case(substring($fixed-local-name, 1, 1)), substring($fixed-local-name, 2))"/>
          <xsl:choose>
            <xsl:when test="contains($type, ':') or contains($type, '.')">
              <xsl:variable name="prefix-name" select="replace($type, '^([^:.]+[:.])?(.+)$', '$1')"/>
              <xsl:value-of select="concat(substring($prefix-name, 1, string-length($prefix-name) - 1), concat('.', $type-name))"/>
            </xsl:when>
            <xsl:otherwise>
              <xsl:value-of select="$type-name"/>
            </xsl:otherwise>
          </xsl:choose>
        </xsl:otherwise>
      </xsl:choose>
    </xsl:function>

    <xsl:function name="local:fixFunctionType">
      <xsl:param name="type"/>
      <xsl:param name="isArray"/>
      <xsl:text>(</xsl:text>
      <xsl:if test="matches($type, '^function\((.+)\)as(.+)$')">
        <xsl:value-of select="local:fixParameters(replace($type, '^function\((.+)\)as(.+)$', '$1'), 1)"/>
      </xsl:if>
      <xsl:text>)=></xsl:text>
      <xsl:variable name="returnType" select="local:fixType(replace($type, '^function\(.*\)as(.+)$', '$1'), false())"/>
      <xsl:choose>
        <xsl:when test="$isArray">
          <xsl:value-of select="local:fixArrayType($returnType, false())"/>
        </xsl:when>
        <xsl:otherwise>
          <xsl:value-of select="$returnType"/>
        </xsl:otherwise>
      </xsl:choose>
    </xsl:function>

    <xsl:function name="local:fixParameters">
      <xsl:param name="parameters"/>
      <xsl:param name="number"/>
      <xsl:value-of select="concat(concat('p', $number), ':')"/>
      <xsl:variable name="type" select="substring-before(concat($parameters,','),',')"/>
      <xsl:value-of select="local:fixType($type, true())"/>
      <xsl:if test="contains($parameters, ',')">
        <xsl:value-of select="concat(',', string-join(local:fixParameters(substring-after($parameters, ','), $number + 1), ''))"/>
      </xsl:if>
    </xsl:function>

    <xsl:function name="local:fixName">
      <xsl:param name="name"/>

      <xsl:choose>
        <xsl:when test="$name = 'default'">defaultVal</xsl:when>
        <xsl:when test="$name = 'function'">functionArg</xsl:when>
        <xsl:when test="$name = 'in'">input</xsl:when>
        <xsl:when test="$name = 'else'">else_</xsl:when>
        <xsl:when test="$name = 'new'">new_</xsl:when>
        <xsl:when test="$name = 'class'">class_</xsl:when>
        <xsl:when test="$name = 'delete'">delete_</xsl:when>
        <xsl:otherwise>
          <xsl:analyze-string select="replace($name, ' ', '_')" regex="-([a-zA-Z])">

            <xsl:matching-substring>
              <xsl:value-of select="upper-case(regex-group(1))"/>
            </xsl:matching-substring>

            <xsl:non-matching-substring>
              <xsl:value-of select="translate(., '-', '')"/>
            </xsl:non-matching-substring>

          </xsl:analyze-string>
        </xsl:otherwise>
      </xsl:choose>
    </xsl:function>

  </xsl:stylesheet>, $xml)

return $definition

xquery version "1.0-ml";

declare variable $xml external;
let $xml := xdmp:unquote("<wrap>" || $xml || "</wrap>")

let $definition := xdmp:xslt-eval(
  <xsl:stylesheet version="2.0" exclude-result-prefixes="#all" xmlns:xsl="http://www.w3.org/1999/XSL/Transform" xmlns:apidoc="http://marklogic.com/xdmp/apidoc" xmlns:local="local">

    <xsl:output method="text" indent="yes" omit-xml-declaration="yes"/>

    <xsl:template match="@*|node()" mode="#all">
      <xsl:copy>
        <xsl:apply-templates select="@*|node()" mode="#current"/>
      </xsl:copy>
    </xsl:template>

    <xsl:template match="apidoc:function" mode="#all">
      <xsl:param name="use-function-keyword" select="false()"/>
      <xsl:param name="use-declare-keyword" select="false()"/>

      <xsl:text>    /** </xsl:text>
      <xsl:value-of select="normalize-space(apidoc:summary)"/>
      <xsl:text> **/
</xsl:text>

      <xsl:text>  </xsl:text>
      <xsl:if test="$use-declare-keyword">
        <xsl:text>declare </xsl:text>
      </xsl:if>
      <xsl:if test="$use-function-keyword">
        <xsl:text>function </xsl:text>
      </xsl:if>
      <xsl:value-of select="local:fixName(@name)"/>
      <xsl:text>(</xsl:text>
      <xsl:for-each select="apidoc:params/apidoc:param">
        <xsl:variable name="is-multi" select="matches(@type, ',\.\.\.$')"/>
        <xsl:if test="$is-multi">...</xsl:if>
        <xsl:value-of select="local:fixName(@name)"/>
        <xsl:if test="preceding-sibling::apidoc:param[@name = current()/@name]">2</xsl:if>
        <xsl:if test="not($is-multi) and string(@optional) = 'true'">?</xsl:if>
        <xsl:text>: </xsl:text>
        <xsl:value-of select="local:fixType(@type, true())"/>
        <xsl:if test="$is-multi">[]</xsl:if>
        <xsl:if test="not($is-multi) and string(@optional) = 'true'">|null|undefined</xsl:if>
        <xsl:if test="not(position() = last())">, </xsl:if>
      </xsl:for-each>
      <xsl:text>): </xsl:text>
      <xsl:value-of select="local:fixType(string(apidoc:return), false())"/>
      <xsl:text>;

</xsl:text>
    </xsl:template>

    <xsl:template match="/wrap">
      <xsl:variable name="root" select="."/>

      <xsl:text>// Type definitions for </xsl:text><xsl:value-of select="apidoc:module[exists(apidoc:function)]/@name"/><xsl:text>
</xsl:text>
      <xsl:text>// Definitions: </xsl:text><xsl:value-of select="base-uri(.)"/><xsl:text>

</xsl:text>

        <xsl:for-each select="distinct-values(((//apidoc:module[exists(apidoc:function)]/@lib, 'xdmp')[1], //apidoc:function/@lib))">
          <xsl:sort/>
          <xsl:variable name="lib" select="."/>
          <xsl:variable name="name" select="string-join(local:fixName($lib), '')"/>
          <xsl:variable name="functions" select="$root//apidoc:function[@lib = $lib]"/>
          <xsl:variable name="module" select="$functions/.."/>

          <xsl:text>
/**
</xsl:text>
          <xsl:value-of select="$module/apidoc:summary"/>
          <xsl:text>
**/

</xsl:text>

          <xsl:choose>
          <xsl:when test="$name = 'GlobalObject'">
            <xsl:apply-templates select="$functions">
              <xsl:sort select="@name" />
              <xsl:with-param name="use-function-keyword" select="true()"/>
              <xsl:with-param name="use-declare-keyword" select="true()"/>
            </xsl:apply-templates>
          </xsl:when>
          <xsl:when test="$name = 'alert'">
            <xsl:text>declare module </xsl:text>
            <xsl:value-of select="$name"/>
            <xsl:text> {{

</xsl:text>

            <xsl:apply-templates select="$functions">
              <xsl:sort select="@name" />
              <xsl:with-param name="use-function-keyword" select="true()"/>
            </xsl:apply-templates>

            <xsl:text>}}
</xsl:text>
          </xsl:when>
          <xsl:otherwise>
            <xsl:text>interface </xsl:text>
            <xsl:value-of select="$name"/>
            <xsl:text>Functions {{

</xsl:text>

            <xsl:apply-templates select="$functions">
              <xsl:sort select="@name" />
            </xsl:apply-templates>

            <xsl:text>}}
</xsl:text>

            <xsl:text>declare var </xsl:text>
            <xsl:value-of select="$name"/>
            <xsl:text>:</xsl:text>
            <xsl:value-of select="$name"/>
            <xsl:text>Functions
</xsl:text>
          </xsl:otherwise>
          </xsl:choose>
        </xsl:for-each>
    </xsl:template>

    <xsl:function name="local:fixType">
      <xsl:param name="fullType"/>
      <xsl:param name="isForParameter"/>

      <xsl:variable name="fullType" select="translate($fullType, ' ', '')"/>
      <xsl:variable name="type" select="replace(replace($fullType, ',\.\.\.$', ''), '([?*+]|\[\])$', '')"/>
      <xsl:variable name="cardinality" select="substring($fullType, string-length($type) + 1)"/>
      <xsl:variable name="isArray" select="matches($cardinality, '^([*+]|\[\])')"/>
      <xsl:variable name="type" select="if (substring($type, 1, 1) = '(') then substring($type, 2, string-length($type) - 2) else $type"/>

      <xsl:value-of select="local:fixEachType($type, $isArray, $isForParameter)"/>
    </xsl:function>

    <xsl:function name="local:fixEachType">
      <xsl:param name="typeUnion"/>
      <xsl:param name="isArray"/>
      <xsl:param name="isForParameter"/>

      <xsl:variable name="type" select="substring-before(concat($typeUnion,'|'),'|')"/>
      <xsl:variable name="type" select="replace($type, '([?*+]|\[\])$', '')"/>

      <xsl:choose>
        <xsl:when test="matches($type, '^function\(.*\)as(.+)$')">
          <xsl:value-of select="local:fixFunctionType($type, $isArray)"/>
        </xsl:when>
        <xsl:when test="$isArray">
          <xsl:choose>
            <xsl:when test="$type = ('document-node()', 'binary()', 'element()', 'node()')">
              <xsl:value-of select="local:fixArrayType('any', $isForParameter)"/>
            </xsl:when>
            <xsl:otherwise>
              <xsl:value-of select="local:fixArrayType(string-join(local:fixSingleType($type, $isForParameter), ''), $isForParameter)"/>
            </xsl:otherwise>
          </xsl:choose>
        </xsl:when>
        <xsl:otherwise>
          <xsl:value-of select="local:fixSingleType($type, $isForParameter)"/>
        </xsl:otherwise>
      </xsl:choose>

      <xsl:if test="contains($typeUnion, '|')">
        <xsl:value-of select="concat('|', string-join(local:fixEachType(substring-after($typeUnion, '|'), $isArray, $isForParameter), ''))"/>
      </xsl:if>
    </xsl:function>

    <xsl:function name="local:fixArrayType">
      <xsl:param name="type"/>
      <xsl:param name="isForParameter"/>
      <xsl:value-of select="concat(concat(if($isForParameter) then 'MLArray<' else 'Sequence<', $type), '>')"/>
    </xsl:function>

    <xsl:function name="local:fixSingleType">
      <xsl:param name="type"/>
      <xsl:param name="isForParameter"/>
      <xsl:choose>
        <!-- workarounds for docs bugs -->
        <xsl:when test="$type = 'query-results-serialize($results)'">MLNode<any></xsl:when>
        <xsl:when test="$type = 'option'">Sequence<any></xsl:when>
        <xsl:when test="$type = 'genericDateTimeArg'">xs.GenericDateTimeArg</xsl:when>
        <xsl:when test="$type = 'rdf:collatedString'">sql.CollatedString</xsl:when>

        <xsl:when test="$type = 'any[]'">Array<any></xsl:when>
        <xsl:when test="$type = ('ValueIterator', 'Sequence')">Sequence<any></xsl:when>
        <xsl:when test="$type = 'document-node()'">DocumentNode<any></xsl:when>
        <xsl:when test="$type = ('binary()')">MLNode<any></xsl:when>
        <xsl:when test="$type = ('element()', 'node()')">
          <xsl:choose>
            <xsl:when test="$isForParameter">MLNodeOrObject<any></xsl:when>
            <xsl:otherwise>MLNode<any></xsl:otherwise>
          </xsl:choose>
        </xsl:when>
        <xsl:when test="$type = ('empty-seq', 'empty-sequence', 'empty-sequence()', 'null', 'Null')">null</xsl:when>
        <xsl:when test="$type = ('String', 'xs:anyURI', 'xs:NCName', 'xs:string', 'xs:time', 'xs:duration', 'xs:dayTimeDuration')">string</xsl:when>
        <xsl:when test="$type = ('json:array', 'Array')">Array<any></xsl:when>
        <xsl:when test="$type = ('json:object', 'map:map', 'Options')">{[key:string]:any}</xsl:when>
        <xsl:when test="$type = ('function()', 'xdmp:function', 'function(*', 'function(*)', 'function')">() => any</xsl:when>
        <xsl:when test="$type = 'xs:boolean'">boolean</xsl:when>
        <xsl:when test="$type = ('any', 'xs:anyAtomicType', 'item()')">any</xsl:when>
        <xsl:when test="$type = ('xs:dateTime', 'xs:date')">Date</xsl:when>
        <xsl:when test="$type = ('Int', 'double', 'xs:numeric', 'numeric', 'xs:decimal', 'xs:double', 'xs:unsigned', 'xs:unsingedLong', 'xs:unsignedLong', 'xs:int', 'xs:float', 'xs:integer', 'xs:long', 'xs:nonNegativeInteger', 'xs:positiveInteger', 'xs:unsignedInt')">number</xsl:when>
        <xsl:when test="matches($type, '^(schema-)?[Ee]lement\([^)]+\)')">
          <xsl:choose>
            <!-- TODO: Can we perform generics on this? -->
            <xsl:when test="$isForParameter">MLNodeOrObject<any></xsl:when>
            <xsl:otherwise>MLNode<any></xsl:otherwise>
          </xsl:choose>
        </xsl:when>
        <xsl:otherwise>
          <xsl:variable name="local-name" select="replace($type, '^([^:.]+[:.])?([^\(\)]+)\(?\)?$', '$2')"/>
          <xsl:variable name="fixed-local-name" select="string-join(local:fixName($local-name), '')"/>
          <xsl:variable name="type-name" select="concat(upper-case(substring($fixed-local-name, 1, 1)), substring($fixed-local-name, 2))"/>
          <xsl:choose>
            <xsl:when test="contains($type, ':') or contains($type, '.')">
              <xsl:variable name="prefix-name" select="replace($type, '^([^:.]+[:.])?(.+)$', '$1')"/>
              <xsl:value-of select="concat(substring($prefix-name, 1, string-length($prefix-name) - 1), concat('.', $type-name))"/>
            </xsl:when>
            <xsl:otherwise>
              <xsl:value-of select="$type-name"/>
            </xsl:otherwise>
          </xsl:choose>
        </xsl:otherwise>
      </xsl:choose>
    </xsl:function>

    <xsl:function name="local:fixFunctionType">
      <xsl:param name="type"/>
      <xsl:param name="isArray"/>
      <xsl:text>(</xsl:text>
      <xsl:if test="matches($type, '^function\((.+)\)as(.+)$')">
        <xsl:value-of select="local:fixParameters(replace($type, '^function\((.+)\)as(.+)$', '$1'), 1)"/>
      </xsl:if>
      <xsl:text>)=></xsl:text>
      <xsl:variable name="returnType" select="local:fixType(replace($type, '^function\(.*\)as(.+)$', '$1'), false())"/>
      <xsl:choose>
        <xsl:when test="$isArray">
          <xsl:value-of select="local:fixArrayType($returnType, false())"/>
        </xsl:when>
        <xsl:otherwise>
          <xsl:value-of select="$returnType"/>
        </xsl:otherwise>
      </xsl:choose>
    </xsl:function>

    <xsl:function name="local:fixParameters">
      <xsl:param name="parameters"/>
      <xsl:param name="number"/>
      <xsl:value-of select="concat(concat('p', $number), ':')"/>
      <xsl:variable name="type" select="substring-before(concat($parameters,','),',')"/>
      <xsl:value-of select="local:fixType($type, true())"/>
      <xsl:if test="contains($parameters, ',')">
        <xsl:value-of select="concat(',', string-join(local:fixParameters(substring-after($parameters, ','), $number + 1), ''))"/>
      </xsl:if>
    </xsl:function>

    <xsl:function name="local:fixName">
      <xsl:param name="name"/>

      <xsl:choose>
        <xsl:when test="$name = 'default'">defaultVal</xsl:when>
        <xsl:when test="$name = 'function'">functionArg</xsl:when>
        <xsl:when test="$name = 'in'">input</xsl:when>
        <xsl:when test="$name = 'else'">else_</xsl:when>
        <xsl:when test="$name = 'new'">new_</xsl:when>
        <xsl:when test="$name = 'class'">class_</xsl:when>
        <xsl:when test="$name = 'delete'">delete_</xsl:when>
        <xsl:otherwise>
          <xsl:analyze-string select="replace($name, ' ', '_')" regex="-([a-zA-Z])">

            <xsl:matching-substring>
              <xsl:value-of select="upper-case(regex-group(1))"/>
            </xsl:matching-substring>

            <xsl:non-matching-substring>
              <xsl:value-of select="translate(., '-', '')"/>
            </xsl:non-matching-substring>

          </xsl:analyze-string>
        </xsl:otherwise>
      </xsl:choose>
    </xsl:function>

  </xsl:stylesheet>, $xml)

return $definition


in Pathfidner, we say "do rename ... with ..." instead of "do rename ... as ..."

declare namespace nara = "http://www.anr.fr/nara";

for $e in doc("grant.xml")//*
where not (namespace-uri($e) eq "http://www.anr.fr/nara")
return
  do rename $e
      with QName("http://www.anr.fr/nara",
               concat("nara:",local-name($e)))

declare namespace nara = "http://www.anr.fr/nara";

for $e in doc("grant.xml")//*
where not (namespace-uri($e) eq "http://www.anr.fr/nara")
return
  do rename $e
      as QName("http://www.anr.fr/nara",
               concat("nara:",local-name($e)))


Updated for the reworked create group functionality in revision 12857

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

xquery version "1.0";

module namespace security="http://exist-db.org/mods/security";

import module namespace config="http://exist-db.org/mods/config" at "config.xqm";
declare namespace session="http://exist-db.org/xquery/session";
declare namespace xmldb="http://exist-db.org/xquery/xmldb";

declare variable $security:GUEST_CREDENTIALS := ("guest", "guest");
declare variable $security:SESSION_USER_ATTRIBUTE := "biblio.user";
declare variable $security:SESSION_PASSWORD_ATTRIBUTE := "biblio.password";

declare variable $security:biblio-users-group := "biblio.users";
declare variable $security:users-collection := fn:concat($config:mods-root, "/users");

(:~
: Authenticates a user and creates their mods home collection if it does not exist
:
: @param user The username of the user
: @param password The password of the user
:)
declare function security:login($user as xs:string, $password as xs:string?) as xs:boolean
{
    (: authenticate against eXist-db :)
    if(xmldb:login("/db", $user, $password))then
    (
        (: check if the users mods home collectin exists, if not create it (i.e. first login) :)
        if(security:home-collection-exists($user))then
            true()
        else
        (
            let $users-collection-uri := security:create-home-collection($user) return
                true()
        )
    ) else
        (: authentication failed:)
        false()
};

(:~
: Stores a users credentials for the mods app into the http session
:
: @param user The username
: @param password The password
:)
declare function security:store-user-credential-in-session($user as xs:string, $password as xs:string?) as empty()
{
    session:set-attribute($security:SESSION_USER_ATTRIBUTE, $user),
    session:set-attribute($security:SESSION_PASSWORD_ATTRIBUTE, $password)
};

(:~
: Retrieves a users credentials for the mods app from the http session
:
: @return The sequence (username as xs:string, password as xs:string)
: If there is no entry in the session, then the guest account credentials are returned
:)
declare function security:get-user-credential-from-session() as xs:string+
{
    let $user := session:get-attribute($security:SESSION_USER_ATTRIBUTE) return
        if($user)then
        (
            $user,
            session:get-attribute($security:SESSION_PASSWORD_ATTRIBUTE)
        )
        else
            $security:GUEST_CREDENTIALS
};

(:~
: Checks whether a users mods home collection exists
:
: @param user The username
:)
declare function security:home-collection-exists($user as xs:string) as xs:boolean
{
   xmldb:collection-available(security:get-home-collection-uri($user))
};

(:~
: Get the URI of a users mods home collection
:)
declare function security:get-home-collection-uri($user as xs:string) as xs:string
{
    fn:concat($security:users-collection, "/", $user)
};

(:~
: Creates a users mods home collection and sets permissions
:
: @return The uri of the users home collection or an empty sequence if it could not be created
:)
declare function security:create-home-collection($user as xs:string) as xs:string?
{
    if(xmldb:collection-available($security:users-collection))then
    (
        let $collection-uri := xmldb:create-collection($security:users-collection, $user) return
            if($collection-uri) then
            (
                let $null := xmldb:set-collection-permissions($collection-uri, $user, xmldb:get-user-primary-group($user), xmldb:string-to-permissions("rwu------")) return
                    $collection-uri
            ) else (
                $collection-uri
            )
    )else()
};

(:~
: Determines if a user has read access to a collection
:
: @param user The username
: @param collection The path of the collection
:)
declare function security:can-read-collection($user as xs:string, $collection as xs:string) as xs:boolean
{
    let $permissions := xmldb:permissions-to-string(xmldb:get-permissions($collection))
    let $owner := xmldb:get-owner($collection)
    let $group := xmldb:get-group($collection)
    let $users-groups := xmldb:get-user-groups($user)
    return
        if ($owner eq $user) then
            fn:substring($permissions, 1, 1) eq 'r'
        else if ($group = $users-groups) then
            fn:substring($permissions, 4, 1) eq 'r'
        else
            fn:substring($permissions, 7, 1) eq 'r'
};

(:~
: Determines if a user has write access to a collection
:
: @param user The username
: @param collection The path of the collection
:)
declare function security:can-write-collection($user as xs:string, $collection as xs:string) as xs:boolean
{
    let $permissions := xmldb:permissions-to-string(xmldb:get-permissions($collection))
    let $owner := xmldb:get-owner($collection)
    let $group := xmldb:get-group($collection)
    let $users-groups := xmldb:get-user-groups($user)
    return
        if ($owner eq $user) then
            fn:substring($permissions, 2, 1) eq 'w'
        else if ($group = $users-groups) then
            fn:substring($permissions, 5, 1) eq 'w'
        else
            fn:substring($permissions, 8, 1) eq 'w'
};

(:~
: Determines if a group has read access to a collection
:
: @param group The group name
: @param collection The path of the collection
:)
declare function security:group-can-read-collection($group as xs:string, $collection as xs:string) as xs:boolean
{
    let $permissions := xmldb:permissions-to-string(xmldb:get-permissions($collection))
    let $owner-group := xmldb:get-group($collection)
    return
        ($group eq $owner-group and fn:substring($permissions, 4, 1) eq 'r')
};

(:~
: Determines if a group has write access to a collection
:
: @param group The group name
: @param collection The path of the collection
:)
declare function security:group-can-write-collection($group as xs:string, $collection as xs:string) as xs:boolean
{
    let $permissions := xmldb:permissions-to-string(xmldb:get-permissions($collection))
    let $owner-group := xmldb:get-group($collection)
    return
        ($group eq $owner-group and fn:substring($permissions, 5, 1) eq 'w')
};

(:~
: Determines if everyone has read access to a collection
:
: @param collection The path of the collection
:)
declare function security:other-can-read-collection($collection as xs:string) as xs:boolean
{
    let $permissions := xmldb:permissions-to-string(xmldb:get-permissions($collection))
    return
        fn:substring($permissions, 7, 1) eq 'r'
};

(:~
: Determines if everyone has write access to a collection
:
: @param collection The path of the collection
:)
declare function security:other-can-write-collection($collection as xs:string) as xs:boolean
{
    let $permissions := xmldb:permissions-to-string(xmldb:get-permissions($collection))
    return
        fn:substring($permissions, 8, 1) eq 'w'
};

(:~
: Determines if the user is the collection owner
:
: @param user The username
: @param collection The path of the collection
:)
declare function security:is-collection-owner($user as xs:string, $collection as xs:string) as xs:boolean
{
    let $owner := xmldb:get-owner($collection) return
        $user eq $owner
};

(:~
: Gets the users for a group
:
: @param the group name
: @return The list of users in the group
:)
declare function security:get-group-members($group as xs:string) as xs:string*
{
    xmldb:get-users($group)
};

(:~
: Gets a list of other biblio users
:)
declare function security:get-other-biblio-users() as xs:string*
{
    security:get-group-members($security:biblio-users-group)[. ne security:get-user-credential-from-session()[1]]
};

declare function security:get-group($collection as xs:string) as xs:string?
{
    if(xmldb:collection-available($collection))then
    (
        xmldb:get-group($collection)
    ) else()
};

declare function security:set-other-can-read-collection($collection, $read as xs:boolean) as xs:boolean
{
    let $permissions := xmldb:permissions-to-string(xmldb:get-permissions($collection)) return
        let $new-permissions := if($read)then(
            fn:replace($permissions, "(......)(.)(..)", "$1r$3")
        ) else (
           fn:replace($permissions, "(......)(.)(..)", "$1-$3")
        )
        return
            xmldb:set-collection-permissions($collection, xmldb:get-owner($collection), xmldb:get-group($collection), xmldb:string-to-permissions($new-permissions)),

            true()
};

declare function security:set-other-can-write-collection($collection, $write as xs:boolean) as xs:boolean
{
    let $permissions := xmldb:permissions-to-string(xmldb:get-permissions($collection)) return
        let $new-permissions := if($write)then(
            fn:replace($permissions, "(.......)(.)(.)", "$1w$3")
        ) else (
           fn:replace($permissions, "(.......)(.)(.)", "$1-$3")
        )
        return
            xmldb:set-collection-permissions($collection, xmldb:get-owner($collection), xmldb:get-group($collection), xmldb:string-to-permissions($new-permissions)),

            true()
};

declare function security:set-group-can-read-collection($collection, $read as xs:boolean) as xs:boolean
{
    security:set-group-can-write-collection($collection, xmldb:get-group($collection), $read)
};

declare function security:set-group-can-write-collection($collection, $write as xs:boolean) as xs:boolean
{
    security:set-group-can-write-collection($collection, xmldb:get-group($collection), $write)
};

declare function security:set-group-can-read-collection($collection, $group as xs:string, $read as xs:boolean) as xs:boolean
{
    let $permissions := xmldb:permissions-to-string(xmldb:get-permissions($collection)) return
        let $new-permissions := if($read)then(
            fn:replace($permissions, "(...)(.)(.....)", "$1r$3")
        ) else (
           fn:replace($permissions, "(...)(.)(.....)", "$1-$3")
        )
        return
            xmldb:set-collection-permissions($collection, xmldb:get-owner($collection), $group, xmldb:string-to-permissions($new-permissions)),

            true()
};

declare function security:set-group-can-write-collection($collection, $group as xs:string, $write as xs:boolean) as xs:boolean
{
    let $permissions := xmldb:permissions-to-string(xmldb:get-permissions($collection)) return
        let $new-permissions := if($write)then(
            fn:replace($permissions, "(....)(.)(....)", "$1w$3")
        ) else (
           fn:replace($permissions, "(....)(.)(....)", "$1-$3")
        )
        return
            xmldb:set-collection-permissions($collection, xmldb:get-owner($collection), $group, xmldb:string-to-permissions($new-permissions)),

            true()
};

declare function security:create-group($group-name as xs:string, $group-member as xs:string*) as xs:boolean
{
    xmldb:create-group($group-name, $group-member)
};

declare function security:set-group-can-read-resource($group-name as xs:string, $resource as xs:string, $read as xs:boolean) as xs:boolean
{
    let $collection-uri := fn:replace($resource, "(.*)/.*", "$1"),
    $resource-uri := fn:replace($resource, ".*/", ""),
    $permissions := xmldb:permissions-to-string(xmldb:get-permissions($collection-uri, $resource-uri)) return
        let $new-permissions := if($read)then(
            fn:replace($permissions, "(...)(.)(.....)", "$1r$3")
        ) else (
           fn:replace($permissions, "(...)(.)(.....)", "$1-$3")
        )
        return
            xmldb:set-resource-permissions($collection-uri, $resource-uri, xmldb:get-owner($collection-uri, $resource-uri), $group-name, xmldb:string-to-permissions($new-permissions)),

            true()
};

xquery version "1.0";

module namespace security="http://exist-db.org/mods/security";

import module namespace config="http://exist-db.org/mods/config" at "config.xqm";
declare namespace session="http://exist-db.org/xquery/session";
declare namespace xmldb="http://exist-db.org/xquery/xmldb";

declare variable $security:GUEST_CREDENTIALS := ("guest", "guest");
declare variable $security:SESSION_USER_ATTRIBUTE := "biblio.user";
declare variable $security:SESSION_PASSWORD_ATTRIBUTE := "biblio.password";

declare variable $security:biblio-users-group := "biblio.users";
declare variable $security:users-collection := fn:concat($config:mods-root, "/users");

(:~
: Authenticates a user and creates their mods home collection if it does not exist
:
: @param user The username of the user
: @param password The password of the user
:)
declare function security:login($user as xs:string, $password as xs:string?) as xs:boolean
{
    (: authenticate against eXist-db :)
    if(xmldb:login("/db", $user, $password))then
    (
        (: check if the users mods home collectin exists, if not create it (i.e. first login) :)
        if(security:home-collection-exists($user))then
            true()
        else
        (
            let $users-collection-uri := security:create-home-collection($user) return
                true()
        )
    ) else
        (: authentication failed:)
        false()
};

(:~
: Stores a users credentials for the mods app into the http session
:
: @param user The username
: @param password The password
:)
declare function security:store-user-credential-in-session($user as xs:string, $password as xs:string?) as empty()
{
    session:set-attribute($security:SESSION_USER_ATTRIBUTE, $user),
    session:set-attribute($security:SESSION_PASSWORD_ATTRIBUTE, $password)
};

(:~
: Retrieves a users credentials for the mods app from the http session
:
: @return The sequence (username as xs:string, password as xs:string)
: If there is no entry in the session, then the guest account credentials are returned
:)
declare function security:get-user-credential-from-session() as xs:string+
{
    let $user := session:get-attribute($security:SESSION_USER_ATTRIBUTE) return
        if($user)then
        (
            $user,
            session:get-attribute($security:SESSION_PASSWORD_ATTRIBUTE)
        )
        else
            $security:GUEST_CREDENTIALS
};

(:~
: Checks whether a users mods home collection exists
:
: @param user The username
:)
declare function security:home-collection-exists($user as xs:string) as xs:boolean
{
   xmldb:collection-available(security:get-home-collection-uri($user))
};

(:~
: Get the URI of a users mods home collection
:)
declare function security:get-home-collection-uri($user as xs:string) as xs:string
{
    fn:concat($security:users-collection, "/", $user)
};

(:~
: Creates a users mods home collection and sets permissions
:
: @return The uri of the users home collection or an empty sequence if it could not be created
:)
declare function security:create-home-collection($user as xs:string) as xs:string?
{
    if(xmldb:collection-available($security:users-collection))then
    (
        let $collection-uri := xmldb:create-collection($security:users-collection, $user) return
            if($collection-uri) then
            (
                let $null := xmldb:set-collection-permissions($collection-uri, $user, xmldb:get-user-primary-group($user), xmldb:string-to-permissions("rwu------")) return
                    $collection-uri
            ) else (
                $collection-uri
            )
    )else()
};

(:~
: Determines if a user has read access to a collection
:
: @param user The username
: @param collection The path of the collection
:)
declare function security:can-read-collection($user as xs:string, $collection as xs:string) as xs:boolean
{
    let $permissions := xmldb:permissions-to-string(xmldb:get-permissions($collection))
    let $owner := xmldb:get-owner($collection)
    let $group := xmldb:get-group($collection)
    let $users-groups := xmldb:get-user-groups($user)
    return
        if ($owner eq $user) then
            fn:substring($permissions, 1, 1) eq 'r'
        else if ($group = $users-groups) then
            fn:substring($permissions, 4, 1) eq 'r'
        else
            fn:substring($permissions, 7, 1) eq 'r'
};

(:~
: Determines if a user has write access to a collection
:
: @param user The username
: @param collection The path of the collection
:)
declare function security:can-write-collection($user as xs:string, $collection as xs:string) as xs:boolean
{
    let $permissions := xmldb:permissions-to-string(xmldb:get-permissions($collection))
    let $owner := xmldb:get-owner($collection)
    let $group := xmldb:get-group($collection)
    let $users-groups := xmldb:get-user-groups($user)
    return
        if ($owner eq $user) then
            fn:substring($permissions, 2, 1) eq 'w'
        else if ($group = $users-groups) then
            fn:substring($permissions, 5, 1) eq 'w'
        else
            fn:substring($permissions, 8, 1) eq 'w'
};

(:~
: Determines if a group has read access to a collection
:
: @param group The group name
: @param collection The path of the collection
:)
declare function security:group-can-read-collection($group as xs:string, $collection as xs:string) as xs:boolean
{
    let $permissions := xmldb:permissions-to-string(xmldb:get-permissions($collection))
    let $owner-group := xmldb:get-group($collection)
    return
        ($group eq $owner-group and fn:substring($permissions, 4, 1) eq 'r')
};

(:~
: Determines if a group has write access to a collection
:
: @param group The group name
: @param collection The path of the collection
:)
declare function security:group-can-write-collection($group as xs:string, $collection as xs:string) as xs:boolean
{
    let $permissions := xmldb:permissions-to-string(xmldb:get-permissions($collection))
    let $owner-group := xmldb:get-group($collection)
    return
        ($group eq $owner-group and fn:substring($permissions, 5, 1) eq 'w')
};

(:~
: Determines if everyone has read access to a collection
:
: @param collection The path of the collection
:)
declare function security:other-can-read-collection($collection as xs:string) as xs:boolean
{
    let $permissions := xmldb:permissions-to-string(xmldb:get-permissions($collection))
    return
        fn:substring($permissions, 7, 1) eq 'r'
};

(:~
: Determines if everyone has write access to a collection
:
: @param collection The path of the collection
:)
declare function security:other-can-write-collection($collection as xs:string) as xs:boolean
{
    let $permissions := xmldb:permissions-to-string(xmldb:get-permissions($collection))
    return
        fn:substring($permissions, 8, 1) eq 'w'
};

(:~
: Determines if the user is the collection owner
:
: @param user The username
: @param collection The path of the collection
:)
declare function security:is-collection-owner($user as xs:string, $collection as xs:string) as xs:boolean
{
    let $owner := xmldb:get-owner($collection) return
        $user eq $owner
};

(:~
: Gets the users for a group
:
: @param the group name
: @return The list of users in the group
:)
declare function security:get-group-members($group as xs:string) as xs:string*
{
    xmldb:get-users($group)
};

(:~
: Gets a list of other biblio users
:)
declare function security:get-other-biblio-users() as xs:string*
{
    security:get-group-members($security:biblio-users-group)[. ne security:get-user-credential-from-session()[1]]
};

declare function security:get-group($collection as xs:string) as xs:string?
{
    if(xmldb:collection-available($collection))then
    (
        xmldb:get-group($collection)
    ) else()
};

declare function security:set-other-can-read-collection($collection, $read as xs:boolean) as xs:boolean
{
    let $permissions := xmldb:permissions-to-string(xmldb:get-permissions($collection)) return
        let $new-permissions := if($read)then(
            fn:replace($permissions, "(......)(.)(..)", "$1r$3")
        ) else (
           fn:replace($permissions, "(......)(.)(..)", "$1-$3")
        )
        return
            xmldb:set-collection-permissions($collection, xmldb:get-owner($collection), xmldb:get-group($collection), xmldb:string-to-permissions($new-permissions)),

            true()
};

declare function security:set-other-can-write-collection($collection, $write as xs:boolean) as xs:boolean
{
    let $permissions := xmldb:permissions-to-string(xmldb:get-permissions($collection)) return
        let $new-permissions := if($write)then(
            fn:replace($permissions, "(.......)(.)(.)", "$1w$3")
        ) else (
           fn:replace($permissions, "(.......)(.)(.)", "$1-$3")
        )
        return
            xmldb:set-collection-permissions($collection, xmldb:get-owner($collection), xmldb:get-group($collection), xmldb:string-to-permissions($new-permissions)),

            true()
};

declare function security:set-group-can-read-collection($collection, $read as xs:boolean) as xs:boolean
{
    security:set-group-can-write-collection($collection, xmldb:get-group($collection), $read)
};

declare function security:set-group-can-write-collection($collection, $write as xs:boolean) as xs:boolean
{
    security:set-group-can-write-collection($collection, xmldb:get-group($collection), $write)
};

declare function security:set-group-can-read-collection($collection, $group as xs:string, $read as xs:boolean) as xs:boolean
{
    let $permissions := xmldb:permissions-to-string(xmldb:get-permissions($collection)) return
        let $new-permissions := if($read)then(
            fn:replace($permissions, "(...)(.)(.....)", "$1r$3")
        ) else (
           fn:replace($permissions, "(...)(.)(.....)", "$1-$3")
        )
        return
            xmldb:set-collection-permissions($collection, xmldb:get-owner($collection), $group, xmldb:string-to-permissions($new-permissions)),

            true()
};

declare function security:set-group-can-write-collection($collection, $group as xs:string, $write as xs:boolean) as xs:boolean
{
    let $permissions := xmldb:permissions-to-string(xmldb:get-permissions($collection)) return
        let $new-permissions := if($write)then(
            fn:replace($permissions, "(....)(.)(....)", "$1w$3")
        ) else (
           fn:replace($permissions, "(....)(.)(....)", "$1-$3")
        )
        return
            xmldb:set-collection-permissions($collection, xmldb:get-owner($collection), $group, xmldb:string-to-permissions($new-permissions)),

            true()
};

declare function security:create-group($group-name as xs:string, $group-member as xs:string*) as xs:boolean
{
    if(xmldb:create-group($group-name))then
    (
        let $results:= for $gm in $group-member return
            xmldb:add-user-to-group($gm, $group-name)
        return
            not($results = false())
    )
    else
    (
        false()
    )
};

declare function security:set-group-can-read-resource($group-name as xs:string, $resource as xs:string, $read as xs:boolean) as xs:boolean
{
    let $collection-uri := fn:replace($resource, "(.*)/.*", "$1"),
    $resource-uri := fn:replace($resource, ".*/", ""),
    $permissions := xmldb:permissions-to-string(xmldb:get-permissions($collection-uri, $resource-uri)) return
        let $new-permissions := if($read)then(
            fn:replace($permissions, "(...)(.)(.....)", "$1r$3")
        ) else (
           fn:replace($permissions, "(...)(.)(.....)", "$1-$3")
        )
        return
            xmldb:set-resource-permissions($collection-uri, $resource-uri, xmldb:get-owner($collection-uri, $resource-uri), $group-name, xmldb:string-to-permissions($new-permissions)),

            true()
};


Fixed &

Fixed &

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

xquery version "1.0";

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

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

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

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

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

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

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

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

};

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

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

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

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

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

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

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

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

xquery version "1.0";

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

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

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

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

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

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

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

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

};

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

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

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

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

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

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

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

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