relax the evaluation conditions for filtering by otherID

(:~
: This is the Care Services Discovery base XQuery module
: @version 1.0
: @see http://ihe.net
:
:)

module namespace csd = "https://github.com/openhie/openinfoman/csd_bl";
import module namespace functx = "http://www.functx.com";

declare default element  namespace   "urn:ihe:iti:csd:2013";

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

};

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

};

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

};

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

};

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

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

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

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

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

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

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

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

(:~
 : this function accepts a list of items to filter by their  by their <otherId/> child elements
 :
 : @param $items - a list of items to filter by their id
 : @param $id - an otherIDI, if specified, to filter the $items list by their @code and @assigningAuthorityName attributes any child <otherID> elements by performing an exact, case-insensitive match of the @code and @assigningAuthorityName attributes of $id.
 : @return all items in $items which match as above
 : @since 1.0
 :
:)
declare function csd:filter_by_other_id($items as item()*,$id as item()) as item()*
{
       if (exists($id))
       then
           let $aaName := fn:upper-case($id/@assigningAuthorityName	)
           let $code := fn:upper-case($id/@code)
	   let $val := fn:upper-case($id/text())
           return
	     if (not(functx:all-whitespace($aaName)) and not(functx:all-whitespace($code)) and not(functx:all-whitespace($id)))
	       $items[
                 otherID[
                 fn:upper-case(@assigningAuthorityName)=$aaName
                 and fn:upper-case(@code)=$code
		 and fn:upper-case(./text()) = $val
                 ]]
	     else if (not(functx:all-whitespace($aaName)) and not(functx:all-whitespace($val)))
	       (:if we are here, we know that $code is blank :)
	       $items[
                 otherID[
                 fn:upper-case(@assigningAuthorityName)=$aaName
		 and fn:upper-case(./text()) = $val
                 ]]
	     else if (not(functx:all-whitespace($aaName)) and not(functx:all-whitespace($code)))
	       (:if we are here, we know that $val is blank :)
	       $items[
                 otherID[
                 fn:upper-case(@assigningAuthorityName)=$aaName
		 and fn:upper-case(@code)=$code
                 ]]
	     else if (not(functx:all-whitespace($val)) and not(functx:all-whitespace($code)))
	       (:if we are here, we know that $aaName is blank :)
	       $items[
                 otherID[
	       	 and fn:upper-case(./text()) = $val
		 and fn:upper-case(@code)=$code
                 ]]
	     else if (not(functx:all-whitespace($val)))
	       (:if we are here, we know that $val is only non-blank :)
	       $items[  otherID[ fn:upper-case(./text()) = $val]]
	     else if (not(functx:all-whitespace($code)))
	       (:if we are here, we know that $code is only non-blank :)
	       $items[  otherID[ fn:upper-case(@code)=$code]]
	     else if (not(functx:all-whitespace($aaName)))
	       (:if we are here, we know that $aaName is only non-blank :)
	       $items[  otherID[ fn:upper-case(@assigningAuthorityName)=$aaName]]
	     else $items (:it's all blank so don't filter:)
        else $items
};

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

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

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

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

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

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

};

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

 };

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

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

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

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

};

declare function csd:filter_by_languages($items as item()*,$langs as item()*) as item()*
{
    if (count($langs) = 0
       or (not ($langs[1]/@code) )
       or (not ($langs[1]/@codingScheme))
       )
    then $items
    else
           let $code := upper-case($langs[1]/@code)
           let $codingScheme := upper-case($langs[1]/@codingScheme)
           return csd:filter_by_languages(
	     $items[./language[upper-case(@code) = $code and upper-case(@codingScheme) = $codingScheme]],
	     fn:subsequence($langs,2))

};

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

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

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

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

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

(:~
: This is the Care Services Discovery base XQuery module
: @version 1.0
: @see http://ihe.net
:
:)

module namespace csd = "https://github.com/openhie/openinfoman/csd_bl";
import module namespace functx = "http://www.functx.com";

declare default element  namespace   "urn:ihe:iti:csd:2013";

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

};

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

};

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

};

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

};

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

};

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

 };

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

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

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

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

};

declare function csd:filter_by_languages($items as item()*,$langs as item()*) as item()*
{
    if (count($langs) = 0
       or (not ($langs[1]/@code) )
       or (not ($langs[1]/@codingScheme))
       )
    then $items
    else
           let $code := upper-case($langs[1]/@code)
           let $codingScheme := upper-case($langs[1]/@codingScheme)
           return csd:filter_by_languages(
	     $items[./language[upper-case(@code) = $code and upper-case(@codingScheme) = $codingScheme]],
	     fn:subsequence($langs,2))

};

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

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

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

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

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


Fixed bugs in CSS matchers

Fixed bugs in CSS matchers

xquery version "3.0";

(:~
 : Origami transformers.
 :
 : @version 0.3
 : @author Marc van Grootel
 : @see https://github.com/xokomola/origami
 :)

module namespace xf = 'http://xokomola.com/xquery/origami/xform';

(:~
 : Transforms input, using the specified templates.
 :)
declare function xf:transform($templates as map(*)*, $input as node()) as node() {
    xf:transform($templates)($input)
};

(:~
 : Returns a node transformation function.
 :)
declare function xf:transform($templates as map(*)*) as function(*) {
    function ($nodes as item()*) as item()* {
        xf:apply($nodes, $templates)
    }
};

(:~
 : Identity transformer.
 :)
declare function xf:transform() { xf:transform(()) };

(:~
 : Extracts nodes from input, using the specified selectors.
 :)
declare function xf:extract($selectors as map(*)*, $input as node()) as node() {
    xf:extract($selectors)($input)
};

(:~
 : Returns an extractor function that only returns selected nodes.
 :)
declare function xf:extract($selectors as map(*)*) as function(*) {
    function ($nodes as item()*) as item()* {
        xf:select($nodes, $selectors)
    }
};

(:~
 : Defines a template.
 :
 : A template takes a selector string or function and
 : a node transformation function or the items to return as
 : the template body.
 : Providing invalid matcher returns empty sequence.
 :)
declare function xf:template($match, $body) as map(*)? {
    let $match :=
        typeswitch ($match)
        case xs:string return xf:css-matches(?, xf:css-matcher($match))
        case function(item()) as xs:boolean return $match
        default return ()
    let $body :=
        typeswitch ($body)
        case empty-sequence() return function($node) { () }
        case function(item()) as item()* return $body
        case function(*)* return ()
        default return function($node) { $body }
    where $match instance of function(*) and $body instance of function(*)
    return
        map {
            'match': $match,
            'fn': $body
        }
};

declare function xf:select($match) as map(*)? {
    let $match :=
        typeswitch ($match)
        case xs:string return xf:css-matches(?, $match)
        case function(item()) as xs:boolean return $match
        default return ()
    where $match instance of function(*)
    return
        map {
            'match': $match,
            'fn': function($node) { $node }
        }
};

(:~
 : Copies nodes to output, and calls apply for
 : nodes that are wrapped inside <xf:apply>.
 :)
declare %private function xf:copy($nodes as item()*, $xform as map(*)*)
    as item()* {
    for $node in $nodes
    return
        if ($node/self::xf:apply) then
            xf:apply(($node/@*,$node/node()), $xform)
        else if ($node instance of element()) then
            element { node-name($node) } {
                $node/@*,
                xf:copy($node/node(), $xform)
            }
        else if ($node instance of document-node()) then
            document {
                xf:copy($node/node(), $xform)
            }
        else
            $node
};

(:~
 : Applies node transformations to nodes.
 :)
declare %private function xf:apply($nodes as item()*, $xform as map(*)*)
    as item()* {
    for $node in $nodes
    let $fn := xf:match($node, $xform)
    return
        if ($fn instance of function(*)) then
            xf:copy($fn($node), $xform)
        else if ($node instance of element()) then
            element { node-name($node) } {
                xf:apply($node/@*, $xform),
                xf:apply($node/node(), $xform)
            }
        else if ($node instance of document-node()) then
            document {
                xf:apply($node/node(), $xform)
            }
        else
            $node
};

(:~
 : Apply to be used from within templates.
 :)
declare function xf:apply($nodes as item()*)
    as element(xf:apply) {
    <xf:apply>{ $nodes }</xf:apply>
};

(:~
 : Look for nodes that match
 :)
declare %private function xf:select($nodes as item()*, $selectors as map(*)*)
    as item()* {
    for $node in $nodes
    let $fn := xf:match($node, $selectors)
    return
        if ($fn instance of function(*)) then
            xf:copy($fn($node), $selectors)
        else if ($node instance of element()) then
            xf:select($node/node(), $selectors)
        else if ($node instance of document-node()) then
            document {
                xf:select($node/node(), $selectors)
            }
        else
            ()
};

(:~
 : Find the first matching template for a node and return
 : it's node transformation function.
 :)
declare %private function xf:match($node as item(), $xform as map(*)*)
    as function(*)? {
    hof:until(
        function($templates as map(*)*) {
            let $is-match := head($templates)
            return
                empty($is-match) or
                not($is-match instance of map(*))
        },
        function($templates as map(*)*) {
            let $template := head($templates)
            return
                (
                    if ($template('match')($node)) then
                        $template('fn')
                    else
                        ()
                    ,
                    tail($templates)
                )
        },
        $xform
    )[1]
};

(:~
 : Returns true if the string expression matches the $node.
 :)
declare function xf:matches($node as item(), $expr as xs:string) as xs:boolean {
    typeswitch ($node)
    case element() return not($node/self::xf:*) and $expr = (name($node),'*')
    case attribute() return substring-after($expr, '@') = (name($node), '*')
    default return false()
};

(:~
 : Returns true if the css matcher matches the $node.
 : TODO: add class matching
 :)
declare function xf:css-matches($node as item(), $css-matcher as map(*)) as xs:boolean {
    typeswitch ($node)
    case element()
    return
        not($node/self::xf:*) and
        $css-matcher('el') = (name($node),'*') and
        ( not($css-matcher('id')) or $css-matcher('id') = $node/@id ) and
        ( not($css-matcher('att')) or $css-matcher('att') = $node/@*/name() ) and
        ( not($css-matcher('class') or $node/@class) or
            ( every $cls in $css-matcher('class')
            satisfies contains(concat(' ',$node/@class,' '), concat(' ',$cls,' ')) ))
    case attribute()
    return
        not($css-matcher('att')) or $css-matcher('att') = (name($node),'*')
    default return false()
};

(:~
 : Build a CSS style matcher map.
 : TODO: fine-tune regexp
 : TODO: make it work for multiple expressions
 :)
declare function xf:css-matcher($expr) as map(*)* {
    for $expr in tokenize($expr,'\s+')[1]
    let $parsed :=
        for $token in analyze-string($expr, '[@#.]?[^@#.]+')/fn:match
        return
            string($token)
    return
         map {
            'att': for $att in $parsed[starts-with(.,'@')][1] return substring-after($att,'@'),
            'el': $parsed[not(starts-with(.,'.') or starts-with(.,'#') or starts-with(.,'@'))],
            'class': for $cls in $parsed[starts-with(.,'.')] return substring-after($cls,'.'),
            'id': for $id in $parsed[starts-with(.,'#')][1] return substring-after($id,'#')
        }
};

xquery version "3.0";

(:~
 : Origami transformers.
 :
 : @version 0.3
 : @author Marc van Grootel
 : @see https://github.com/xokomola/origami
 :)

module namespace xf = 'http://xokomola.com/xquery/origami/xform';

(:~
 : Transforms input, using the specified templates.
 :)
declare function xf:transform($templates as map(*)*, $input as node()) as node() {
    xf:transform($templates)($input)
};

(:~
 : Returns a node transformation function.
 :)
declare function xf:transform($templates as map(*)*) as function(*) {
    function ($nodes as item()*) as item()* {
        xf:apply($nodes, $templates)
    }
};

(:~
 : Identity transformer.
 :)
declare function xf:transform() { xf:transform(()) };

(:~
 : Extracts nodes from input, using the specified selectors.
 :)
declare function xf:extract($selectors as map(*)*, $input as node()) as node() {
    xf:extract($selectors)($input)
};

(:~
 : Returns an extractor function that only returns selected nodes.
 :)
declare function xf:extract($selectors as map(*)*) as function(*) {
    function ($nodes as item()*) as item()* {
        xf:select($nodes, $selectors)
    }
};

(:~
 : Defines a template.
 :
 : A template takes a selector string or function and
 : a node transformation function or the items to return as
 : the template body.
 : Providing invalid matcher returns empty sequence.
 :)
declare function xf:template($match, $body) as map(*)? {
    let $match :=
        typeswitch ($match)
        case xs:string return xf:css-matches(?, xf:css-matcher($match))
        case function(item()) as xs:boolean return $match
        default return ()
    let $body :=
        typeswitch ($body)
        case empty-sequence() return function($node) { () }
        case function(item()) as item()* return $body
        case function(*)* return ()
        default return function($node) { $body }
    where $match instance of function(*) and $body instance of function(*)
    return
        map {
            'match': $match,
            'fn': $body
        }
};

declare function xf:select($match) as map(*)? {
    let $match :=
        typeswitch ($match)
        case xs:string return xf:css-matches(?, $match)
        case function(item()) as xs:boolean return $match
        default return ()
    where $match instance of function(*)
    return
        map {
            'match': $match,
            'fn': function($node) { $node }
        }
};

(:~
 : Copies nodes to output, and calls apply for
 : nodes that are wrapped inside <xf:apply>.
 :)
declare %private function xf:copy($nodes as item()*, $xform as map(*)*)
    as item()* {
    for $node in $nodes
    return
        if ($node/self::xf:apply) then
            xf:apply(($node/@*,$node/node()), $xform)
        else if ($node instance of element()) then
            element { node-name($node) } {
                $node/@*,
                xf:copy($node/node(), $xform)
            }
        else if ($node instance of document-node()) then
            document {
                xf:copy($node/node(), $xform)
            }
        else
            $node
};

(:~
 : Applies node transformations to nodes.
 :)
declare %private function xf:apply($nodes as item()*, $xform as map(*)*)
    as item()* {
    for $node in $nodes
    let $fn := xf:match($node, $xform)
    return
        if ($fn instance of function(*)) then
            xf:copy($fn($node), $xform)
        else if ($node instance of element()) then
            element { node-name($node) } {
                xf:apply($node/@*, $xform),
                xf:apply($node/node(), $xform)
            }
        else if ($node instance of document-node()) then
            document {
                xf:apply($node/node(), $xform)
            }
        else
            $node
};

(:~
 : Apply to be used from within templates.
 :)
declare function xf:apply($nodes as item()*)
    as element(xf:apply) {
    <xf:apply>{ $nodes }</xf:apply>
};

(:~
 : Look for nodes that match
 :)
declare %private function xf:select($nodes as item()*, $selectors as map(*)*)
    as item()* {
    for $node in $nodes
    let $fn := xf:match($node, $selectors)
    return
        if ($fn instance of function(*)) then
            xf:copy($fn($node), $selectors)
        else if ($node instance of element()) then
            xf:select($node/node(), $selectors)
        else if ($node instance of document-node()) then
            document {
                xf:select($node/node(), $selectors)
            }
        else
            ()
};

(:~
 : Find the first matching template for a node and return
 : it's node transformation function.
 :)
declare %private function xf:match($node as item(), $xform as map(*)*)
    as function(*)? {
    hof:until(
        function($templates as map(*)*) {
            let $is-match := head($templates)
            return
                empty($is-match) or
                not($is-match instance of map(*))
        },
        function($templates as map(*)*) {
            let $template := head($templates)
            return
                (
                    if ($template('match')($node)) then
                        $template('fn')
                    else
                        ()
                    ,
                    tail($templates)
                )
        },
        $xform
    )[1]
};

(:~
 : Returns true if the string expression matches the $node.
 :)
declare function xf:matches($node as item(), $expr as xs:string) as xs:boolean {
    typeswitch ($node)
    case element() return not($node/self::xf:*) and $expr = (name($node),'*')
    case attribute() return substring-after($expr, '@') = (name($node), '*')
    default return false()
};

(:~
 : Returns true if the css matcher matches the $node.
 : TODO: add class matching
 :)
declare function xf:css-matches($node as item(), $css-matcher as map(*)) as xs:boolean {
    typeswitch ($node)
    case element()
    return
        not($node/self::xf:*) and
        $css-matcher('el') = (local-name($node),'*') and
        ( not($css-matcher('id')) or $css-matcher('id') = trace($node/@id,'ID: ') ) and
        ( not($css-matcher('att')) or $css-matcher('att') = $node/@*/local-name() ) and
        ( not($css-matcher('class') or $node/@class) or
            ( every $cls in trace($css-matcher('class'),'CLS: ')
            satisfies contains(concat(' ',$node/@class,' '), concat(' ',$cls,' ')) ))
    case attribute()
    return
        not($css-matcher('att')) or $css-matcher('att') = local-name($node)
    default return false()
};

(:~
 : Build a CSS style matcher map.
 : TODO: fine-tune regexp
 : TODO: make it work for multiple expressions
 :)
declare function xf:css-matcher($expr) as map(*)* {
    for $expr in tokenize($expr,'\s+')[1]
    let $parsed :=
        for $token in analyze-string($expr, '[@#.]?[^@#.]+')/fn:match
        return
            string($token)
    return
         map {
            'att': for $att in $parsed[starts-with(.,'@')][1] return substring-after($att,'@'),
            'el': $parsed[not(starts-with(.,'.') or starts-with(.,'#') or starts-with(.,'@'))],
            'class': for $cls in $parsed[starts-with(.,'.')] return substring-after($cls,'.'),
            'id': for $id in $parsed[starts-with(.,'#')][1] return substring-after($id,'#')
        }
};


JSONify random module.

JSONify random module.

jsoniq version "1.0";

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

(:~
 : This module provides several functions for generating (pseudo-)random
 : numbers and strings.
 :
 : @author Matthias Brantner, Sorin Nasoi
 : @project Zorba/XQuery Data Model/Atomic/Random
 :
 :)
module namespace r = "http://zorba.io/modules/random";

declare namespace an = "http://www.zorba-xquery.com/annotations";
declare namespace zerr = "http://zorba.io/modules/zorba-errors";

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

(:~
 : This function generates an arbitrary number of pseudo-random numbers.
 : The sequence is repeatable by calling the function with the same
 : seed.
 :
 :
The function is based on posix function <tt>srand()</tt> and
 : <tt>rand()</tt>. Specifically, it invokes <tt>srand($seed)</tt>
 : and then returns the values returned by invoking <tt>rand()</tt>
 : <tt>$num</tt>-times.

 :
 :
Sequences returned by this function are not thread-safe (i.e.
 : if multiple XQuery programs invoking this function are executed
 : concurrently in several threads). This is because the function is
 : based on <tt>srand()</tt> and <tt>rand()</tt>.

 :
 : @param $seed the initial seed value for the sequence
 : @param $num the length of the sequence returned
 : @return <tt>$num</tt> pseudo-random integers, or the empty
 :  sequence if <tt>$num</tt> is negative.
 :
 : @error zerr:ZQXD0004 if the given seed is negative or great
 :  than the max value of <tt>unsigned int</tt> on the given platform.
 :)
declare function r:seeded-random(
  $seed as integer,
  $num as integer
) as integer* external;

(:~
 : This function generates an arbitrary number of random numbers.
 : The function is nondeterministic because the sequence is
 : not repeatable.
 :
 :
However, the function is based on posix function <tt>srand()</tt> and
 : <tt>rand()</tt>. Specifically, it invokes <tt>srand()</tt>
 : with some random number based on the current time
 : and then returns the values returned by invoking
 : <tt>rand()</tt> <tt>$num</tt>-times.

 :
 : @param $num the length of the sequence returned
 : @return <tt>$num</tt> random integers, or the empty
 :  sequence if <tt>$num</tt> is negative.
 :)
declare %an:nondeterministic function r:random(
  $num as integer
) as integer* external;

(:~
 : This function generates one random number.
 : The function is nondeterministic.
 :
 :
The function is based on <tt>r:random#1</tt>. Specifically, it
 : returns the value of invoking <tt>r:random(1)</tt>.

 :
 : @return a random integer
 :)
declare %an:nondeterministic function r:random() as integer
{
  r:random(1)
};

(:~
 : This function generates an arbitrary number of pseudo-random numbers
 : within a given range. The sequence is repeatable by calling the
 : function with the same seed and boundaries.
 :
 :
The function is based on the function <tt>r:seeded-random#2</tt>.
 : Specifically, it's result is repeatable if called with the
 : same arguments.

 :
 : @param $seed the initial seed value for the sequence
 : @param $lower the lower bound for every value within the sequence
 : @param $upper the upper bound for every value within the sequence
 : @param $num the length of the sequence returned
 : @return <tt>$num</tt> pseudo-random integers within (and including) the
 :    range specified by <tt>$lower</tt> and <tt>$upper</tt>. It returns
 :     <tt>$num</tt>-times <tt>$lower</tt> if <tt>$lower</tt> is
 :     equal to <tt>$upper</tt> and the empty sequence if <tt>$num</tt>
 :     is negative.
 :
 : @error zerr:ZQXD0004 if the given seed is negative or great
 :  than the max value of <tt>unsigned int</tt> on the given platform.
 : @error r:invalid-arg if <tt>$lower</tt> is greater than <tt>$upper</tt>
 :)
declare function r:seeded-random-between(
  $seed as integer,
  $lower as integer,
  $upper as integer,
  $num as integer
) as integer*
{
  if ( $lower eq $upper ) then
    $lower
  else
    if ( $lower gt $upper ) then
      fn:error(
        fn:QName("http://zorba.io/modules/random", "invalid-arg"),
        "$lower must be smaller or equal than $upper",
        ($lower, $upper)
      )
    else
      for $i in r:seeded-random( $seed, $num )
      return
        if ( ( $upper - $lower ) lt 10000 ) then
          integer( fn:round( double( $i mod 10000 ) div 10000 * ( $upper - $lower) ) + $lower )
        else
          integer( fn:round( double( $i ) mod ( $upper - $lower ) ) + $lower )
};

(:~
 : This function generates an arbitrary number of random numbers
 : within a given range. The function is nondeterministic because
 : the sequence is not repeatable.
 :
 : @param $lower the lower bound for every value within the sequence
 : @param $upper the upper bound for every value within the sequence
 : @param $num the length of the sequence returned
 : @return <tt>$num</tt> pseudo-random integers within (and including) the
 :    range specified by <tt>$lower</tt> and <tt>$upper</tt>. It returns
 :     <tt>$num</tt>-times <tt>$lower</tt> if <tt>$lower</tt> is
 :     equal to <tt>$upper</tt> and the empty sequence if <tt>$num</tt>
 :     is negative.
 :
 : @error r:invalid-arg if <tt>$lower</tt> is greater than <tt>$upper</tt>
 :)
declare %an:nondeterministic function r:random-between(
  $lower as integer,
  $upper as integer,
  $num as integer) as integer*
{
  if ( $lower eq $upper ) then
    $lower
  else
    if ( $lower gt $upper ) then
      fn:error(
        fn:QName("http://zorba.io/modules/random", "invalid-arg"),
        "$lower must be smaller or equal than $upper",
        ($lower, $upper)
      )
    else
      for $i in r:random( $num )
      return
        if ( ( $upper - $lower ) lt 10000 ) then
          integer( fn:round( double( $i mod 10000 ) div 10000 * ( $upper - $lower) ) + $lower )
        else
          integer( fn:round( double( $i ) mod ( $upper - $lower ) ) + $lower )
};

(:~
 : This function generates one random number within a given range.
 : The function is nondeterministic.
 :
 :
The function is based on <tt>r:random-between#3</tt>.
 : Specifically, it returns the value of invoking
 : <tt>r:random-betwen($lower, $upper, 1)</tt>.

 :
 : @param $lower the lower bound for the random number
 : @param $upper the upper bound for the random number
 : @return a random integer within the given range
 :)
declare %an:nondeterministic function r:random-between(
  $lower as integer,
  $upper as integer
) as integer
{
  r:random-between($lower, $upper, 1)
};

(:~
 : This function returns a uuid. Note, that the function is not stable,
 : that is, it returns a different UUID everytime the function is invoked.
 :
 : @return the generated UUID as string
:)
declare %an:nondeterministic function r:uuid() as string external;

xquery version "3.0";

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

(:~
 : This module provides several functions for generating (pseudo-)random
 : numbers and strings.
 :
 : @author Matthias Brantner, Sorin Nasoi
 : @project Zorba/XQuery Data Model/Atomic/Random
 :
 :)
module namespace r = "http://zorba.io/modules/random";

declare namespace an = "http://www.zorba-xquery.com/annotations";
declare namespace zerr = "http://zorba.io/modules/zorba-errors";

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

(:~
 : This function generates an arbitrary number of pseudo-random numbers.
 : The sequence is repeatable by calling the function with the same
 : seed.
 :
 :
The function is based on posix function <tt>srand()</tt> and
 : <tt>rand()</tt>. Specifically, it invokes <tt>srand($seed)</tt>
 : and then returns the values returned by invoking <tt>rand()</tt>
 : <tt>$num</tt>-times.

 :
 :
Sequences returned by this function are not thread-safe (i.e.
 : if multiple XQuery programs invoking this function are executed
 : concurrently in several threads). This is because the function is
 : based on <tt>srand()</tt> and <tt>rand()</tt>.

 :
 : @param $seed the initial seed value for the sequence
 : @param $num the length of the sequence returned
 : @return <tt>$num</tt> pseudo-random integers, or the empty
 :  sequence if <tt>$num</tt> is negative.
 :
 : @error zerr:ZQXD0004 if the given seed is negative or great
 :  than the max value of <tt>unsigned int</tt> on the given platform.
 :)
declare function r:seeded-random(
  $seed as xs:integer,
  $num as xs:integer
) as xs:integer* external;

(:~
 : This function generates an arbitrary number of random numbers.
 : The function is nondeterministic because the sequence is
 : not repeatable.
 :
 :
However, the function is based on posix function <tt>srand()</tt> and
 : <tt>rand()</tt>. Specifically, it invokes <tt>srand()</tt>
 : with some random number based on the current time
 : and then returns the values returned by invoking
 : <tt>rand()</tt> <tt>$num</tt>-times.

 :
 : @param $num the length of the sequence returned
 : @return <tt>$num</tt> random integers, or the empty
 :  sequence if <tt>$num</tt> is negative.
 :)
declare %an:nondeterministic function r:random(
  $num as xs:integer
) as xs:integer* external;

(:~
 : This function generates one random number.
 : The function is nondeterministic.
 :
 :
The function is based on <tt>r:random#1</tt>. Specifically, it
 : returns the value of invoking <tt>r:random(1)</tt>.

 :
 : @return a random integer
 :)
declare %an:nondeterministic function r:random() as xs:integer
{
  r:random(1)
};

(:~
 : This function generates an arbitrary number of pseudo-random numbers
 : within a given range. The sequence is repeatable by calling the
 : function with the same seed and boundaries.
 :
 :
The function is based on the function <tt>r:seeded-random#2</tt>.
 : Specifically, it's result is repeatable if called with the
 : same arguments.

 :
 : @param $seed the initial seed value for the sequence
 : @param $lower the lower bound for every value within the sequence
 : @param $upper the upper bound for every value within the sequence
 : @param $num the length of the sequence returned
 : @return <tt>$num</tt> pseudo-random integers within (and including) the
 :    range specified by <tt>$lower</tt> and <tt>$upper</tt>. It returns
 :     <tt>$num</tt>-times <tt>$lower</tt> if <tt>$lower</tt> is
 :     equal to <tt>$upper</tt> and the empty sequence if <tt>$num</tt>
 :     is negative.
 :
 : @error zerr:ZQXD0004 if the given seed is negative or great
 :  than the max value of <tt>unsigned int</tt> on the given platform.
 : @error r:invalid-arg if <tt>$lower</tt> is greater than <tt>$upper</tt>
 :)
declare function r:seeded-random-between(
  $seed as xs:integer,
  $lower as xs:integer,
  $upper as xs:integer,
  $num as xs:integer
) as xs:integer*
{
  if ( $lower eq $upper ) then
    $lower
  else
    if ( $lower > $upper ) then
      fn:error(
        fn:QName("http://zorba.io/modules/random", "invalid-arg"),
        "$lower must be smaller or equal than $upper",
        ($lower, $upper)
      )
    else
      for $i in r:seeded-random( $seed, $num )
      return
        if ( ( $upper - $lower ) lt 10000 ) then
          xs:integer( fn:round( xs:double( $i mod 10000 ) div 10000 * ( $upper - $lower) ) + $lower )
        else
          xs:integer( fn:round( xs:double( $i ) mod ( $upper - $lower ) ) + $lower )
};

(:~
 : This function generates an arbitrary number of random numbers
 : within a given range. The function is nondeterministic because
 : the sequence is not repeatable.
 :
 : @param $lower the lower bound for every value within the sequence
 : @param $upper the upper bound for every value within the sequence
 : @param $num the length of the sequence returned
 : @return <tt>$num</tt> pseudo-random integers within (and including) the
 :    range specified by <tt>$lower</tt> and <tt>$upper</tt>. It returns
 :     <tt>$num</tt>-times <tt>$lower</tt> if <tt>$lower</tt> is
 :     equal to <tt>$upper</tt> and the empty sequence if <tt>$num</tt>
 :     is negative.
 :
 : @error r:invalid-arg if <tt>$lower</tt> is greater than <tt>$upper</tt>
 :)
declare %an:nondeterministic function r:random-between(
  $lower as xs:integer,
  $upper as xs:integer,
  $num as xs:integer) as xs:integer*
{
  if ( $lower eq $upper ) then
    $lower
  else
    if ( $lower > $upper ) then
      fn:error(
        fn:QName("http://zorba.io/modules/random", "invalid-arg"),
        "$lower must be smaller or equal than $upper",
        ($lower, $upper)
      )
    else
      for $i in r:random( $num )
      return
        if ( ( $upper - $lower ) lt 10000 ) then
          xs:integer( fn:round( xs:double( $i mod 10000 ) div 10000 * ( $upper - $lower) ) + $lower )
        else
          xs:integer( fn:round( xs:double( $i ) mod ( $upper - $lower ) ) + $lower )
};

(:~
 : This function generates one random number within a given range.
 : The function is nondeterministic.
 :
 :
The function is based on <tt>r:random-between#3</tt>.
 : Specifically, it returns the value of invoking
 : <tt>r:random-betwen($lower, $upper, 1)</tt>.

 :
 : @param $lower the lower bound for the random number
 : @param $upper the upper bound for the random number
 : @return a random integer within the given range
 :)
declare %an:nondeterministic function r:random-between(
  $lower as xs:integer,
  $upper as xs:integer
) as xs:integer
{
  r:random-between($lower, $upper, 1)
};

(:~
 : This function returns a uuid. Note, that the function is not stable,
 : that is, it returns a different UUID everytime the function is invoked.
 :
 : @return the generated UUID as xs:string
:)
declare %an:nondeterministic function r:uuid() as xs:string external;