fixed bug where filtering by codedType was returning all elements

(:~
: 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";

(:~
 : 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 := fn:upper-case($components[1]/@component)
           let $val := fn:upper-case($components[1]/text())
           return csd:filter_by_address(
              $items[address/addressLine[fn:upper-case(@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 $u_status:= fn:upper-case($record/@status)
             return $items[fn:upper-case(record/@status) = $u_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";

(:~
 : 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 := fn:upper-case($components[1]/@component)
           let $val := fn:upper-case($components[1]/text())
           return csd:filter_by_address(
              $items[address/addressLine[fn:upper-case(@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 ($codedtype/@code and $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 $u_status:= fn:upper-case($record/@status)
             return $items[fn:upper-case(record/@status) = $u_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)
};


fixed action for create directory form

fixed action for create directory form

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

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

declare updating
  %rest:path("/CSD/createDirectory")
  %rest:POST
  %rest:form-param("directory","{$directory}")
  %output:method("xhtml")
  function page:create_directory($directory)
{
   (
     if (not (csd_dm:document_source_exists($csd_webconf:db,$directory))) then
       csd_dm:empty($csd_webconf:db,$directory)
     else ()
     ,
   csd_webui:redirect_out("CSD")
  )
};

declare
  %rest:path("/CSD")
  %rest:GET
  %output:method("xhtml")
  function page:list_functionality()
{
  let $what_is_dm :=

    The document manger registers documents to perform  careServicesRequests and getUpdatedServices requests  against.  Registered documents can be any of:

Local cache of a remote service directory -- this is useful for turning a Care Services Directory into an Open Info Manager

Sample Directories -- these loaded from an XML source file on the system and are useful for testing

The merged result of remote service directories

  let $csd :=

    {$what_is_dm}

      {let $docs := csd_dm:registered_documents($csd_webconf:db)
      return (
	  "You have ", count($docs) , " registered document(s) available: ",

	    {
	      for $doc in $docs
	      return

		 {$doc}
		 [
		   Empty
		  /  Delete
		  ]

	    }

	  )
      }

Create Blank Directory

      <form method='post' action="{csd_webui:generateURL(('CSD/createDirectory/'))}">
	<input name='directory' type='text'/>
	<input type='submit' value='Create'/>
      </form>

  let $svs :=

    In addition, there is some initial support for use of terminologies using the Sharing Value Sets(SVS) profile from IHE:

load Shared Value Sets

available Shared Value Sets

  let $adapters :=

        {
	  let $docs := csd_dm:registered_documents($csd_webconf:db)
	  return (
	    "You have ", count($docs) , " registered document(s) available: ",

	      {
		for $doc in $docs
		return

		   {$doc}
		  [
		   View Stored Functions
		  ]

	      }

	  )
	}

List of all API  adapters for stored functions: CSD Adapters

  let $generic :=

These the top-level endpoints are exposed

Manage Stored Functions

Load and Register Sample Service Directories

Register and Poll Remote Service Service directories

Execute Ad-Hoc Care Services Requests and View Care Service Request Endpoints for Registered Documents

Endpoints for submitting getUpdatedServices Soap Request for Registered Documents

Manage duplicate record identifiers

  return csd_webui:nocache(page:wrapper($csd,$svs,$adapters,$generic))
};

declare
  %rest:path("/CSD/getDirectory/{$name}")
  %rest:GET
  function page:get_directory($name)
{
  csd_dm:open_document($csd_webconf:db,$name)
};

declare updating
  %rest:path("/CSD/emptyDirectory/{$name}")
  %rest:GET
  function page:empty_directory($name)
{
  (
    csd_dm:empty($csd_webconf:db,$name)
    ,csd_webui:redirect_out("CSD")
  )
};

declare updating
  %rest:path("/CSD/deleteDirectory/{$name}")
  %rest:GET
  function page:delete_directory($name)
{
  (
    csd_dm:delete($csd_webconf:db,$name)
    ,csd_webui:redirect_out("CSD")
  )
};

declare function page:wrapper($csd,$svs,$adapters) {
  page:wrapper($csd,$svs,$adapters,())
};

declare function page:wrapper($csd,$svs,$adapters,$generic_csd) {
  let $generic :=

OpenInfoMan has been developed as part of OpenHIE and is intended to be the engine behind the CSD compliant Health Worker Registry and to be incorporated in OpenHIM.

    Source code is on github

  let $headers :=  (
    <link rel="stylesheet" type="text/css" media="screen"   href="{csd_webui:generateURL('static/bootstrap/js/tab.js')}"/>
    ,

    )
    let $content := (

Introduction

Server Managment

Terminolgies

Documents

      ,

Welcome to OpenInfoMan

		  OpenInfoMan is an XQuery and RESTXQ based implementation of the Care Services Directory (CSD) profile from IHE which implements the following actors and transactions:

		    Info Manager :

		    Find Matching Services (Ad-Hoc and Stored) [ITI-73]

		    Query for  Updated Services Transaction [ITI-74]

		    Services Directory :

Query for  Updated Services Transaction [ITI-74]

		{$generic}

	      {$generic}
	      {$generic_csd}

	      {$csd}

	      {$generic}

	      {$svs}

	      {$generic}

	      {$adapters}

      )

  return csd_webui:wrapper($content,$headers)
};

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

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

declare updating
  %rest:path("/CSD/createDirectory")
  %rest:POST
  %rest:form-param("directory","{$directory}")
  %output:method("xhtml")
  function page:create_directory($directory)
{
   (
     if (not (csd_dm:document_source_exists($csd_webconf:db,$directory))) then
       csd_dm:empty($csd_webconf:db,$directory)
     else ()
     ,
   csd_webui:redirect_out("CSD")
  )
};

declare
  %rest:path("/CSD")
  %rest:GET
  %output:method("xhtml")
  function page:list_functionality()
{
  let $what_is_dm :=

    The document manger registers documents to perform  careServicesRequests and getUpdatedServices requests  against.  Registered documents can be any of:

Local cache of a remote service directory -- this is useful for turning a Care Services Directory into an Open Info Manager

Sample Directories -- these loaded from an XML source file on the system and are useful for testing

The merged result of remote service directories

  let $csd :=

    {$what_is_dm}

      {let $docs := csd_dm:registered_documents($csd_webconf:db)
      return (
	  "You have ", count($docs) , " registered document(s) available: ",

	    {
	      for $doc in $docs
	      return

		 {$doc}
		 [
		   Empty
		  /  Delete
		  ]

	    }

	  )
      }

Create Blank Directory

      <form method='post' action="{csd_webui:generateURL(('CSD/getDirectory/'))}">
	<input name='directory' type='text'/>
	<input type='submit' value='Create'/>
      </form>

  let $svs :=

    In addition, there is some initial support for use of terminologies using the Sharing Value Sets(SVS) profile from IHE:

load Shared Value Sets

available Shared Value Sets

  let $adapters :=

        {
	  let $docs := csd_dm:registered_documents($csd_webconf:db)
	  return (
	    "You have ", count($docs) , " registered document(s) available: ",

	      {
		for $doc in $docs
		return

		   {$doc}
		  [
		   View Stored Functions
		  ]

	      }

	  )
	}

List of all API  adapters for stored functions: CSD Adapters

  let $generic :=

These the top-level endpoints are exposed

Manage Stored Functions

Load and Register Sample Service Directories

Register and Poll Remote Service Service directories

Execute Ad-Hoc Care Services Requests and View Care Service Request Endpoints for Registered Documents

Endpoints for submitting getUpdatedServices Soap Request for Registered Documents

Manage duplicate record identifiers

  return csd_webui:nocache(page:wrapper($csd,$svs,$adapters,$generic))
};

declare
  %rest:path("/CSD/getDirectory/{$name}")
  %rest:GET
  function page:get_directory($name)
{
  csd_dm:open_document($csd_webconf:db,$name)
};

declare updating
  %rest:path("/CSD/emptyDirectory/{$name}")
  %rest:GET
  function page:empty_directory($name)
{
  (
    csd_dm:empty($csd_webconf:db,$name)
    ,csd_webui:redirect_out("CSD")
  )
};

declare updating
  %rest:path("/CSD/deleteDirectory/{$name}")
  %rest:GET
  function page:delete_directory($name)
{
  (
    csd_dm:delete($csd_webconf:db,$name)
    ,csd_webui:redirect_out("CSD")
  )
};

declare function page:wrapper($csd,$svs,$adapters) {
  page:wrapper($csd,$svs,$adapters,())
};

declare function page:wrapper($csd,$svs,$adapters,$generic_csd) {
  let $generic :=

OpenInfoMan has been developed as part of OpenHIE and is intended to be the engine behind the CSD compliant Health Worker Registry and to be incorporated in OpenHIM.

    Source code is on github

  let $headers :=  (
    <link rel="stylesheet" type="text/css" media="screen"   href="{csd_webui:generateURL('static/bootstrap/js/tab.js')}"/>
    ,

    )
    let $content := (

Introduction

Server Managment

Terminolgies

Documents

      ,

Welcome to OpenInfoMan

		  OpenInfoMan is an XQuery and RESTXQ based implementation of the Care Services Directory (CSD) profile from IHE which implements the following actors and transactions:

		    Info Manager :

		    Find Matching Services (Ad-Hoc and Stored) [ITI-73]

		    Query for  Updated Services Transaction [ITI-74]

		    Services Directory :

Query for  Updated Services Transaction [ITI-74]

		{$generic}

	      {$generic}
	      {$generic_csd}

	      {$csd}

	      {$generic}

	      {$svs}

	      {$generic}

	      {$adapters}

      )

  return csd_webui:wrapper($content,$headers)
};


Whoose. Mispelled multivalue.

Whoose. Mispelled multivalue.

xquery version "3.1" encoding "UTF-8";

declare namespace output = "http://www.w3.org/2010/xslt-xquery-serialization";
declare namespace map = "http://www.w3.org/2005/xpath-functions/map";
declare namespace array = "http://www.w3.org/2005/xpath-functions/array";
declare namespace mapping = "http://docs.rackspace.com/identity/api/ext/MappingRules";
declare namespace xs = "http://www.w3.org/2001/XMLSchema";

declare option output:method "json";
declare option output:indent "yes";

declare function mapping:convertAttributeList($in as xs:string) as array(xs:string) {
  let $inStrings := for $s in tokenize($in, ' ') return replace($s,' ',' ')
  return array {$inStrings}
};

declare function mapping:convertAttributeMap($elem as element(), $multiValueAttribs as xs:string*) as map(*) {
  let $attribs := $elem/@*[namespace-uri(.) != 'http://www.w3.org/2001/XMLSchema-instance']
  return map:merge(for $attrib in $attribs return map:entry(local-name($attrib),
    if (local-name($attrib) = $multiValueAttribs) then mapping:convertAttributeList(string($attrib))
    else string($attrib)))
};

declare function mapping:convertLocalGroup($local as element()) as map(*) {
  let $elems := $local/element()
  return map:merge(for $elem in $elems return map:entry(local-name($elem),
  let $multiAttribs := (
    if ((local-name($elem) = 'roles') and (local-name($elem/..) = 'user') and count(tokenize($elem/@value,' ')) > 1) then "value" else (),
      if (exists($elem/@multiValue) and xs:boolean($elem/@multiValue) and count(tokenize($elem/@value,' ')) > 1) then "value" else ())
        return if ($elem/@*[name(.) = ('type','multiValue')]) then mapping:convertAttributeMap($elem, $multiAttribs) else
          if ($multiAttribs) then mapping:convertAttributeList (string($elem/@value)) else string($elem/@value)))
};

declare function mapping:convertLocalGroups($local as element()) as map(*) {
  let $elems := $local/element()
  return map:merge(for $elem in $elems return map:entry(local-name($elem),mapping:convertLocalGroup($elem)))
};

declare function mapping:convertRemote($remote as element()) as array(*) {
  let $elems := $remote/element()
  return array {for $elem in $elems return mapping:convertAttributeMap($elem,('blacklist','whitelist','notAnyOf','anyOneOf'))}
};

let $rules := for $rule in /mapping:rules/mapping:rule return map:merge((
  map:entry("local",mapping:convertLocalGroups($rule/mapping:local)),
  if (exists($rule/mapping:remote)) then map:entry("remote",mapping:convertRemote($rule/mapping:remote)) else ()))
return map {"rules" : array{$rules}}

xquery version "3.1" encoding "UTF-8";

declare namespace output = "http://www.w3.org/2010/xslt-xquery-serialization";
declare namespace map = "http://www.w3.org/2005/xpath-functions/map";
declare namespace array = "http://www.w3.org/2005/xpath-functions/array";
declare namespace mapping = "http://docs.rackspace.com/identity/api/ext/MappingRules";
declare namespace xs = "http://www.w3.org/2001/XMLSchema";

declare option output:method "json";
declare option output:indent "yes";

declare function mapping:convertAttributeList($in as xs:string) as array(xs:string) {
  let $inStrings := for $s in tokenize($in, ' ') return replace($s,' ',' ')
  return array {$inStrings}
};

declare function mapping:convertAttributeMap($elem as element(), $multiValueAttribs as xs:string*) as map(*) {
  let $attribs := $elem/@*[namespace-uri(.) != 'http://www.w3.org/2001/XMLSchema-instance']
  return map:merge(for $attrib in $attribs return map:entry(local-name($attrib),
    if (local-name($attrib) = $multiValueAttribs) then mapping:convertAttributeList(string($attrib))
    else string($attrib)))
};

declare function mapping:convertLocalGroup($local as element()) as map(*) {
  let $elems := $local/element()
  return map:merge(for $elem in $elems return map:entry(local-name($elem),
  let $multiAttribs := (
    if ((local-name($elem) = 'roles') and (local-name($elem/..) = 'user') and count(tokenize($elem/@value,' ')) > 1) then "value" else (),
      if (exists($elem/@multiValue) and xs:boolean($elem/@multiValue) and count(tokenize($elem/@value,' ')) > 1) then "value" else ())
        return if ($elem/@*[name(.) = ('type','multivalue')]) then mapping:convertAttributeMap($elem, $multiAttribs) else
          if ($multiAttribs) then mapping:convertAttributeList (string($elem/@value)) else string($elem/@value)))
};

declare function mapping:convertLocalGroups($local as element()) as map(*) {
  let $elems := $local/element()
  return map:merge(for $elem in $elems return map:entry(local-name($elem),mapping:convertLocalGroup($elem)))
};

declare function mapping:convertRemote($remote as element()) as array(*) {
  let $elems := $remote/element()
  return array {for $elem in $elems return mapping:convertAttributeMap($elem,('blacklist','whitelist','notAnyOf','anyOneOf'))}
};

let $rules := for $rule in /mapping:rules/mapping:rule return map:merge((
  map:entry("local",mapping:convertLocalGroups($rule/mapping:local)),
  if (exists($rule/mapping:remote)) then map:entry("remote",mapping:convertRemote($rule/mapping:remote)) else ()))
return map {"rules" : array{$rules}}


Extensive API changes in notes library

Extensive API changes in notes library

module namespace notes="http://cefn.com/readinglog/notes";

import module namespace template="http://cefn.com/readinglog/template" at "/home/cefn/Documents/highwire/participatory firmware design/readinglog/scripts/server/xquery/lib/template.xq";

declare namespace ann = "http://www.zorba-xquery.com/annotations";

declare default element namespace "http://www.w3.org/1999/xhtml";

declare variable $notes:authors := "Authors";
declare variable $notes:concepts := "Concepts";
declare variable $notes:headings := (
	$notes:authors,
	$notes:concepts,
	'Methodology',
	'Field of Study',
	'Quotations',
	'References'
);
declare variable $notes:errorlink := '/error';

(: Introspects the noted document's unique id from any doc or contained note node :)
(: TODO CH this should be generalised to permit URLs and ISBNs to be listed.
 Powells books seems a promising way to link to ISBNs e.g. http://www.powells.com/biblio/9781449342685
 though amazon may be able to do something similar with 10 digit ISBNs
 there is a visually identical unicode character to the forward slash with Unicode 0x2044 (fraction slash)
 :)
declare function notes:paperid($node){
	replace(base-uri(notes:paperroot($node)),".*/([^/]+)\.[^/]+$", "$1")
};

declare function notes:papertitle($node){
	notes:paperroot($node)//h1/string(.)
};

declare function notes:paperroot($node){
	typeswitch($node)
		case document-node() return $node
		default return root($node)
};

declare %ann:nondeterministic function notes:allnotes(){
	template:loadhtml("public/notes/")
};

declare %ann:nondeterministic function notes:notesoftype($type){
	notes:filterbytype(notes:allnotes()//*,$type)
};

declare function notes:filterbytype($nodes,$type){
	$nodes[not(self::h2)][not(self::br)][preceding::h2[1]//text()[contains(.,$type)]][not(normalize-space(string(.))='')]
};

declare function notes:gettype($node){
	if($node/ancestor::h1) then
			'Titles'
		else
			normalize-space(string-join($node/(preceding::h2[1])/text(),""))
};

declare function notes:followingheader($nodes,$title){
	$nodes//*[preceding-sibling::h2[1][text()[normalize-space(.)=$title]]]
};

(: Returns the type of a given item, either 'pdf', 'book' or 'url' :)
declare function notes:sourcetype($item){
	let $id := notes:paperid($item)
	return
		if(starts-with($id,'isbn-')) then
			'book'
		else if(starts-with($id, 'http://')) then
			'url'
		else
			'pdf'
};

(: Accepts either hash values or nodes from within the noted paper :)
declare function notes:paperlinks($item){
	let $id := 	if($item instance of xs:string) then
						$item
					else
						notes:paperid($item),
		$source := notes:sourcetype($item),
		$link := switch ($source)
					case 'book'	return concat('http://www.powells.com/biblio/', replace($id,'(isbn|-)',''))
					case 'url'	return $id
					case 'pdf' return concat('papers/',$id,'.pdf')
					default return $notes:errorlink
	return

			[{$source} notes]

};

(: Indicates a priority order for individual note types e.g. in search results:)
declare function notes:typepriority($type){
	let $priorities := ('Titles','Notes','Concepts','Quotations'),
		$matches := index-of(reverse($priorities),$type)
	return if(count($matches)) then $matches[1] else 0
};

module namespace notes="http://cefn.com/readinglog/notes";

import module namespace template="http://cefn.com/readinglog/template" at "/home/cefn/Documents/highwire/participatory firmware design/readinglog/scripts/server/xquery/lib/template.xq";

declare namespace ann = "http://www.zorba-xquery.com/annotations";

declare default element namespace "http://www.w3.org/1999/xhtml";

declare variable $notes:allnotes := template:loadhtml("public/notes/");
declare variable $notes:papertitles := $notes:allnotes//h1;

declare variable $notes:authors := "Authors";
declare variable $notes:concepts := "Concepts";
declare variable $notes:headings := (
	$notes:authors,
	$notes:concepts,
	'Methodology',
	'Field of Study',
	'Quotations',
	'References'
);

(: Introspects the noted document's unique id from any note element :)
declare function notes:paperhash($node){
	root($node)//comment()[contains(string(.),"UNIQUE HASH")]/replace(string(.)," UNIQUE HASH ([\w]+) ", "$1")
};

declare %ann:nondeterministic function notes:notesoftype($type){
	$notes:allnotes//*[not(self::h2)][preceding::h2[1]//text()[contains(.,$type)]]
};

declare function notes:type($node){
	if($node/ancestor::h1) then
			'Titles'
		else
			normalize-space(string-join($node/(preceding::h2[1])/text(),""))
};

declare function notes:followingheader($nodes,$title){
	$nodes//*[preceding-sibling::h2[1][text()[normalize-space(.)=$title]]]
};

declare function notes:paperlinks($hash as xs:string){

		[notes pdf load]

};

(: Indicates a priority order for individual note types e.g. in search results:)
declare function notes:typepriority($type){
	let $priorities := ('Titles','Notes','Concepts','Quotations'),
		$matches := index-of(reverse($priorities),$type)
	return if(count($matches)) then $matches[1] else 0
};


Reverted additional unnecessary test modification

import module namespace ddl = "http://www.zorba-xquery.com/modules/store/dynamic/collections/ddl";
import module namespace dml = "http://www.zorba-xquery.com/modules/store/dynamic/collections/dml";

declare namespace ann = "http://zorba.io/annotations";

declare variable $col := xs:QName("myCollection");

declare %ann:sequential function local:test3()
{
  ddl:create($col, (,));

  for $x in dml:collection($col)
  return
    {
      dml:insert-nodes-last($col, <c></c>);
    }

  dml:collection($col)
};

local:test3()

import module namespace ddl = "http://www.zorba-xquery.com/modules/store/dynamic/collections/ddl";
import module namespace dml = "http://www.zorba-xquery.com/modules/store/dynamic/collections/dml";

declare namespace ann = "http://zorba.io/annotations";
declare namespace ext = "http://zorba.io/extensions";

declare variable $col := xs:QName("myCollection");

declare %ann:sequential function local:test3()
{
  ddl:create($col, (,));

  for $x in dml:collection($col)
  return
    {
      dml:insert-nodes-last($col, <c></c>);
    }

  dml:collection($col)
};

local:test3()


[MIN] DBA Fix

[MIN] DBA Fix

(:~
 : Users page.
 :
 : @author Christian Grün, BaseX Team, 2014-16
 :)
module namespace dba = 'dba/jobs-users';

import module namespace Sessions = 'http://basex.org/modules/sessions';
import module namespace Session = 'http://basex.org/modules/session';
import module namespace cons = 'dba/cons' at '../modules/cons.xqm';
import module namespace html = 'dba/html' at '../modules/html.xqm';
import module namespace tmpl = 'dba/tmpl' at '../modules/tmpl.xqm';
import module namespace util = 'dba/util' at '../modules/util.xqm';

(:~ Top category :)
declare variable $dba:CAT := 'jobs-users';

(:~
 : Jobs and users page.
 : @param  $sort   table sort key
 : @param  $error  error message
 : @param  $info   info message
 : @return page
 :)
declare
  %rest:GET
  %rest:path("/dba/jobs-users")
  %rest:query-param("sort", "{$sort}", "")
  %rest:query-param("error", "{$error}")
  %rest:query-param("info",  "{$info}")
  %output:method("html")
function dba:jobs-users(
  $sort   as xs:string,
  $error  as xs:string?,
  $info   as xs:string?
) as element() {
  cons:check(),

  (: request data in a single step :)
  let $data := try {
    element result {
      element users { user:list-details() },
      element sessions { admin:sessions() },
      element jobs { jobs:list-details() },
      element current-job { jobs:current() }
    }
  } catch * {
    element error { $err:description }
  }
  let $error := head(($data/self::error, $error))

  return tmpl:wrap(map { 'top': $dba:CAT, 'info': $info, 'error': $error },

        <form action="{ $dba:CAT }" method="post" class="update">

Jobs

        {
          let $rows :=
            let $curr := $data/current-job
            for $job in $data/jobs/job
            let $id := $job/@id
            let $ms := xs:dayTimeDuration($job/@duration) div xs:dayTimeDuration('PT0.001S')
            let $you := if($id = $curr) then '✓' else '–'
            order by $ms descending
            return <row id='{ $id }' type='{ $job/@type }' state='{ $job/@state }'
                        user='{ $job/@user }' sec='{ $ms div 1000 }' start='{ $job/@start}'
                        end='{ $job/@end }' you='{ $you }'/>
          let $headers := (
            <id>ID</id>,
            <type>Type</type>,
            <state>State</state>,
            <user>User</user>,
            <sec type='number' order='desc'>Seconds</sec>,
            <start type='dateTime' order='desc'>Start</start>,
            <end type='dateTime' order='desc'>End</end>,
            <you>You</you>
          )
          let $buttons := (
            html:button('stop-job', 'Stop', true())
          )
          return html:table($headers, $rows, $buttons, map {}, map { 'sort': $sort })
        }
        </form>
        <form action="{ $dba:CAT }" method="post" class="update">

Server Sessions

        {
          let $rows :=
            for $id in Sessions:ids()
            let $access := Sessions:accessed($id)
            let $you := if(Session:id() = $id) then '✓' else '–'
            for $name in Sessions:names($id)
            let $value := try {
              Sessions:get($id, $name)
            } catch bxerr:BXSE0002 {
              (: non-XQuery session value :)
            }
            let $string := util:chop(serialize($value, map { 'method': 'basex' }), 20)
            return <row id='{ $id || '|' || $name }' name='{ $name }' value='{ $string }'
                        access='{ $access }' you='{ $you }'/>
          let $headers := (
            <id type='id'>ID</id>,
            <name>Name</name>,
            <value>Value</value>,
            <access type='dateTime' order='desc'>Last Access</access>,
            <you>You</you>
          )
          let $buttons := (
            html:button('kill-session', 'Kill', true())
          )
          return html:table($headers, $rows, $buttons, map {}, map {})
        }
        </form>

Database Clients

        {
          let $rows :=
            for $session in $data/sessions/session
            return <row address='{ $session/@address }' user='{ $session/@user }'/>
          let $headers := (
            <address>Address</address>,
            <user>User</user>
          )
          return html:table($headers, $rows, (), map {}, map {})
        }

        <form action="{ $dba:CAT }" method="post" class="update">

Users

        {
          let $rows :=
            for $user in $data/users/user
            let $name := string($user/@name)
            let $you := if($cons:SESSION-VALUE = $name) then '✓' else '–'
            return <row name='{ $name }' perm='{ $user/@permission }' you='{ $you }'/>
          let $headers := (
            <name>Name</name>,
            <perm>Permission</perm>,
            <you>You</you>
          )
          let $buttons := (
            html:button('create-user', 'Create…'),
            html:button('drop-user', 'Drop', true())
          )
          let $link := function($value) { 'user' }
          return html:table($headers, $rows, $buttons, map {}, map { 'link': $link })
        }
        </form>

  )
};

(:~
 : Redirects to the specified action.
 : @param  $action  action to perform
 : @param  $names   names of users
 : @param  $ids     ids
 :)
declare
  %rest:POST
  %rest:path("/dba/jobs-users")
  %rest:query-param("action", "{$action}")
  %rest:query-param("name",   "{$names}")
  %rest:query-param("id",     "{$ids}")
  %output:method("html")
function dba:jobs-users-redirect(
  $action  as xs:string,
  $names   as xs:string*,
  $ids     as xs:string*
) as element(rest:response) {
  web:redirect($action,
    if($action = 'create-user') then map { }
    else if($action = ('kill-session', 'stop-job')) then map { 'id': $ids }
    else map { 'name': $names, 'redirect': $dba:CAT }
  )
};

(:~
 : Users page.
 :
 : @author Christian Grün, BaseX Team, 2014-16
 :)
module namespace dba = 'dba/jobs-users';

import module namespace Sessions = 'http://basex.org/modules/sessions';
import module namespace Session = 'http://basex.org/modules/session';
import module namespace cons = 'dba/cons' at '../modules/cons.xqm';
import module namespace html = 'dba/html' at '../modules/html.xqm';
import module namespace tmpl = 'dba/tmpl' at '../modules/tmpl.xqm';
import module namespace util = 'dba/util' at '../modules/util.xqm';

(:~ Top category :)
declare variable $dba:CAT := 'jobs-users';

(:~
 : Jobs and users page.
 : @param  $sort   table sort key
 : @param  $error  error message
 : @param  $info   info message
 : @return page
 :)
declare
  %rest:GET
  %rest:path("/dba/jobs-users")
  %rest:query-param("sort", "{$sort}", "")
  %rest:query-param("error", "{$error}")
  %rest:query-param("info",  "{$info}")
  %output:method("html")
function dba:jobs-users(
  $sort   as xs:string,
  $error  as xs:string?,
  $info   as xs:string?
) as element() {
  cons:check(),

  (: request data in a single step :)
  let $data := try {
    element result {
      element users { user:list-details() },
      element sessions { admin:sessions() },
      element jobs { jobs:list-details() },
      element current-job { jobs:current() }
    }
  } catch * {
    element error { $err:description }
  }
  let $error := head(($data/self::error, $error))

  return tmpl:wrap(map { 'top': $dba:CAT, 'info': $info, 'error': $error },

        <form action="{ $dba:CAT }" method="post" class="update">

Jobs

        {
          let $rows :=
            let $curr := $data/current-job
            for $job in $data/jobs/job
            let $id := $job/@id
            let $ms := xs:dayTimeDuration($job/@duration) div xs:dayTimeDuration('PT0.001S')
            let $you := if($id = $curr) then '✓' else '–'
            order by $ms descending
            return <row id='{ $id }' type='{ $job/@type }' state='{ $job/@state }'
                        user='{ $job/@user }' sec='{ $ms div 1000 }' start='{ $job/@start}'
                        end='{ $job/@end }' you='{ $you }'/>
          let $headers := (
            <id>ID</id>,
            <type>Type</type>,
            <state>State</state>,
            <user>User</user>,
            <sec type='number' order='desc'>Seconds</sec>,
            <start type='dateTime' order='desc'>Start</start>,
            <end type='dateTime' order='desc'>End</end>,
            <you>You</you>
          )
          let $buttons := (
            html:button('stop-job', 'Stop', true())
          )
          return html:table($headers, $rows, $buttons, map {}, map { 'sort': $sort })
        }
        </form>
        <form action="{ $dba:CAT }" method="post" class="update">

Server Sessions

        {
          let $rows :=
            for $id in Sessions:ids()
            let $access := Sessions:accessed($id)
            let $you := if(Session:id() = $id) then '✓' else '–'
            for $name in Sessions:names($id)
            let $value := Sessions:get($id, $name)
            let $string := util:chop(serialize($value, map { 'method': 'basex' }), 20)
            return <row id='{ $id || '|' || $name }' name='{ $name }' value='{ $string }'
                        access='{ $access }' you='{ $you }'/>
          let $headers := (
            <id type='id'>ID</id>,
            <name>Name</name>,
            <value>Value</value>,
            <access type='dateTime' order='desc'>Last Access</access>,
            <you>You</you>
          )
          let $buttons := (
            html:button('kill-session', 'Kill', true())
          )
          return html:table($headers, $rows, $buttons, map {}, map {})
        }
        </form>

Database Clients

        {
          let $rows :=
            for $session in $data/sessions/session
            return <row address='{ $session/@address }' user='{ $session/@user }'/>
          let $headers := (
            <address>Address</address>,
            <user>User</user>
          )
          return html:table($headers, $rows, (), map {}, map {})
        }

        <form action="{ $dba:CAT }" method="post" class="update">

Users

        {
          let $rows :=
            for $user in $data/users/user
            let $name := string($user/@name)
            let $you := if($cons:SESSION-VALUE = $name) then '✓' else '–'
            return <row name='{ $name }' perm='{ $user/@permission }' you='{ $you }'/>
          let $headers := (
            <name>Name</name>,
            <perm>Permission</perm>,
            <you>You</you>
          )
          let $buttons := (
            html:button('create-user', 'Create…'),
            html:button('drop-user', 'Drop', true())
          )
          let $link := function($value) { 'user' }
          return html:table($headers, $rows, $buttons, map {}, map { 'link': $link })
        }
        </form>

  )
};

(:~
 : Redirects to the specified action.
 : @param  $action  action to perform
 : @param  $names   names of users
 : @param  $ids     ids
 :)
declare
  %rest:POST
  %rest:path("/dba/jobs-users")
  %rest:query-param("action", "{$action}")
  %rest:query-param("name",   "{$names}")
  %rest:query-param("id",     "{$ids}")
  %output:method("html")
function dba:jobs-users-redirect(
  $action  as xs:string,
  $names   as xs:string*,
  $ids     as xs:string*
) as element(rest:response) {
  web:redirect($action,
    if($action = 'create-user') then map { }
    else if($action = ('kill-session', 'stop-job')) then map { 'id': $ids }
    else map { 'name': $names, 'redirect': $dba:CAT }
  )
};