load CSD documents into memory before processing

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

module namespace csd_bl = "https://github.com/openhie/openinfoman/csd_bl";
import module namespace functx = "http://www.functx.com";
import module namespace xquery = " http://basex.org/modules/xquery";

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

(:Utility methods:)
declare function csd_bl:get_parent_orgs($all_orgs,$org) {
  let $porg_id := $org/parent/@entityID
  let $porg :=
    if (functx:all-whitespace($porg_id))
    then ()
    else $all_orgs[@entityID = $porg_id]
  return
    if (not(exists($porg)))
    then ()
    else (csd_bl:get_parent_orgs($all_orgs,$porg),$porg)
};

declare function csd_bl:get_child_orgs($orgs,$org) {
  csd_bl:get_child_orgs($orgs,$org,())
};

declare function csd_bl:get_child_orgs($orgs,$org,$seen) {
  let $org_id := $org/@entityID
  return
    if ($org = $seen)
    then ()
    else
      if (functx:all-whitespace($org_id))
      then ()
      else
        let $c_orgs := $orgs[./parent[@entityID = $org_id]]
	return
  	  if (count($c_orgs) > 2)
  	  then
            let $c_org_funcs:=
              for $c_org in $c_orgs
  	      return function() {(   csd_bl:get_child_orgs($orgs,$c_org,($seen,$org)))}
            return ($c_orgs,xquery:fork-join($c_org_funcs))
          else
	    for $c_org in $c_orgs
	    return ($c_org,csd_bl:get_child_orgs($orgs,$c_org))

};

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

};

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

};

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

};

declare function csd_bl: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_bl: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_bl: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_bl: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_bl: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_bl: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_bl: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_bl:filter_by_primary_name($items as item()*,$primaryName as item()) as item()*
{
  let $u_primaryName := fn:upper-case($primaryName/text())
  return
    if (not(functx:all-whitespace($u_primaryName)))
      (: then $items[contains(fn:upper-case(./primaryName) , $u_primaryName)] :)
    then $items[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_bl: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_bl: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_bl: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))) then
	       $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))) then
	       (: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))) then
	       (: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))) then
	       (:if we are here, we know that $aaName is blank :)
	       $items[
                 otherID[
	       	 fn:upper-case(./text()) = $val
		 and fn:upper-case(@code)=$code
                 ]]
	     else if (not(functx:all-whitespace($val))) then
	       (: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))) then
	       (: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))) then
	       (: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_bl: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_bl: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_bl: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_bl: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_bl: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_bl: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_bl: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_bl: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) or functx:all-whitespace(./parent/@entityID) ]
    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_bl: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_bl:filter_by_organizations(
	     $items[organizations/organization[upper-case(@entityID) = $org]],
	     fn:subsequence($orgs,2))

};

declare function csd_bl: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_bl: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_bl: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_bl: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_bl:join_child_organizations($orgs as item()*,$orgdir as item()) as item()*
{
     if (count($orgs) = 0)
     then ()
     else
        csd_bl:get_child_organizations($orgs[1],$orgdir)
        union
        csd_bl: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_bl: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_bl: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_bl: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_bl: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_bl:join_parent_organizations($orgs as item()*,$orgdir as item()) as item()*
{
     if (count($orgs) = 0)
     then ()
     else
        csd_bl:get_parent_organizations($orgs[1],$orgdir)
        union
        csd_bl: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_bl = "https://github.com/openhie/openinfoman/csd_bl";
import module namespace functx = "http://www.functx.com";
import module namespace xquery = " http://basex.org/modules/xquery";

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

(:Utility methods:)
declare function csd_bl:get_parent_orgs($all_orgs,$org) {
  let $porg_id := $org/parent/@entityID
  let $porg :=
    if (functx:all-whitespace($porg_id))
    then ()
    else $all_orgs[@entityID = $porg_id]
  return
    if (not(exists($porg)))
    then ()
    else (csd_bl:get_parent_orgs($all_orgs,$porg),$porg)
};

declare function csd_bl:get_child_orgs($orgs,$org) {
  let $org_id := $org/@entityID

(:
  return
    if (functx:all-whitespace($org_id))
    then ()
    else
      let $c_orgs := $orgs[./parent[@entityID = $org_id]]
      let $c_org_funcs:=
        for $c_org in $c_orgs
	return function() {csd_bl:get_child_orgs($orgs,$c_org)}
      return ($c_orgs,xquery:fork-join($c_org_funcs))
:)

  let $c_orgs :=
    if (functx:all-whitespace($org_id))
    then ()
    else $orgs[./parent[@entityID = $org_id]]
  return
    for $c_org in $c_orgs
    return ($c_org,csd_bl:get_child_orgs($orgs,$c_org))

};

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

};

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

};

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

};

declare function csd_bl: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_bl: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_bl: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_bl: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_bl: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_bl: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_bl: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_bl:filter_by_primary_name($items as item()*,$primaryName as item()) as item()*
{
  let $u_primaryName := fn:upper-case($primaryName/text())
  return
    if (not(functx:all-whitespace($u_primaryName)))
      (: then $items[contains(fn:upper-case(./primaryName) , $u_primaryName)] :)
    then $items[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_bl: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_bl: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_bl: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))) then
	       $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))) then
	       (: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))) then
	       (: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))) then
	       (:if we are here, we know that $aaName is blank :)
	       $items[
                 otherID[
	       	 fn:upper-case(./text()) = $val
		 and fn:upper-case(@code)=$code
                 ]]
	     else if (not(functx:all-whitespace($val))) then
	       (: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))) then
	       (: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))) then
	       (: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_bl: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_bl: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_bl: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_bl: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_bl: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_bl: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_bl: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_bl: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) or functx:all-whitespace(./parent/@entityID) ]
    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_bl: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_bl:filter_by_organizations(
	     $items[organizations/organization[upper-case(@entityID) = $org]],
	     fn:subsequence($orgs,2))

};

declare function csd_bl: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_bl: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_bl: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_bl: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_bl:join_child_organizations($orgs as item()*,$orgdir as item()) as item()*
{
     if (count($orgs) = 0)
     then ()
     else
        csd_bl:get_child_organizations($orgs[1],$orgdir)
        union
        csd_bl: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_bl: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_bl: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_bl: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_bl: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_bl:join_parent_organizations($orgs as item()*,$orgdir as item()) as item()*
{
     if (count($orgs) = 0)
     then ()
     else
        csd_bl:get_parent_organizations($orgs[1],$orgdir)
        union
        csd_bl:join_parent_organizations(fn:subsequence($orgs,2),$orgdir)
};


serialize as xhtml

serialize as xhtml

module namespace repo-utils = "http://aac.ac.at/content_repository/utils";

import module namespace xdb="http://exist-db.org/xquery/xmldb";
import module namespace diag =  "http://www.loc.gov/zing/srw/diagnostic/" at  "modules/diagnostics/diagnostics.xqm";

(:~ HELPER functions - configuration, caching, data-access
:)

(:
: this all cannot be defined as global variable, because we want different configurations,
: thus the $config has to be sent as param everywhere
: declare variable $repo-utils:config := doc("config.xml");
: declare variable $repo-utils:mappings := doc(repo-utils:config-value('mappings'));
: declare variable $repo-utils:data-collection := collection(repo-utils:config-value('data.path'));
: declare variable $repo-utils:md-collection := collection(repo-utils:config-value('metadata.path'));
: declare variable $repo-utils:cachePath as xs:string := repo-utils:config-value('cache.path');
:)

declare variable $repo-utils:xmlExt as xs:string := ".xml";
declare variable $repo-utils:responseFormatXml as xs:string := "xml";
declare variable $repo-utils:responseFormatJSon as xs:string := "json";
declare variable $repo-utils:responseFormatText as xs:string := "text";
declare variable $repo-utils:responseFormatHTML as xs:string := "html";

declare function repo-utils:config-value($config, $key as xs:string) as xs:string* {
    $config//property[@key=$key]
};

(:~ Get value of a param based on a key, from config or from request-param (precedence) :)
declare function repo-utils:param-value($config, $key as xs:string, $default as xs:string) as xs:string* {

    let $param := request:get-parameter($key, $default)
    return if ($param) then $param else $config//property[@key=$key]
};

(:~ returns db-collection (as nodeset) based on the identifier in x-context, looked up in the mapping or default collection as defined in config

@returns nodeset of given context
 if no x-context match or no context provided returns default collection from the config (data.path )
 (if available, otherwise again empty result)

WATCHME: changed to lax handling of the context (if no match - go to default)
        gives better recall, but may confuse - alternatively: strict: empty result if x-context does not match
TODO: accept $x-context as xs:string*
:)
declare function repo-utils:context-to-collection($x-context as xs:string, $config) as node()* {
(:      let $mappings := doc(repo-utils:config-value($config, 'mappings')):)
      let $dbcoll-path := repo-utils:context-to-collection-path($x-context, $config)
    return if ($dbcoll-path eq "" ) then ()
                else collection($dbcoll-path)
};

(:~ returns path to db-collection (as nodeset) based on the identifier in x-context,
looked up in the mapping or default data.path as defined in config

@returns dbcoll-path of given context
 if no x-context match or no context provided returns default collection from the config (data.path )
 (if available, otherwise again empty result)

WATCHME: changed to lax handling of the context (if no match - go to default)
        gives better recall, but may confuse - alternatively: strict: empty result if x-context does not match
T
:)
declare function repo-utils:context-to-collection-path($x-context as xs:string, $config) as xs:string {
      let $mappings:= doc(repo-utils:config-value($config, 'mappings'))
    return    (: if ($x-context) then :)
            if (exists($mappings//map[xs:string(@key) eq $x-context]/@path)) then
                    $mappings//map[xs:string(@key) eq $x-context]/xs:string(@path)
                (: else "" :)
                  else if (exists(repo-utils:config-value($config, 'data.path'))) then
                        repo-utils:config-value($config, 'data.path')
                  else ""
};

(:~ Get the resource by PID/handle/URL or some known identifier.
  TODO: NOT ADAPTED YET! (taken from CMD)
  TODO: be clear about resource itself and metadata-record!
:)
(:declare function repo-utils:get-resource-by-id($id as xs:string) as node()* {
  let $collection := collection($cr:dataPath)
  return
    if ($id eq "" or $id eq $cr:collectionRoot) then
    $collection//IsPartOf[. = $cr:collectionRoot]/ancestor::CMD
  else
    util:eval(concat("$collection/ft:query(descendant::MdSelfLink, <term>", xdb:decode($id), "</term>)/ancestor::CMD"))
 (\: $collection/descendant::MdSelfLink[. = xdb:decode($id)]/ancestor::CMD :\)
};
:)

(:~ Checks whether the document is available or not.
  generic, currently not used
:)
declare function repo-utils:is-doc-available($collection as xs:string, $doc-name as xs:string) as xs:boolean {
  fn:doc-available(fn:concat($collection, "/", $doc-name))
};

declare function repo-utils:is-in-cache($doc-name as xs:string,$config) as xs:boolean {
  fn:doc-available(fn:concat(repo-utils:config-value($config, 'cache.path'), "/", $doc-name))
};

declare function repo-utils:get-from-cache($doc-name as xs:string,$config) as item()* {
      fn:doc(fn:concat(repo-utils:config-value($config, 'cache.path'), "/", $doc-name))
};

(:~ Store the data in cache. Uses own writer-account
:)
declare function repo-utils:store-in-cache($doc-name as xs:string, $data as node(),$config) as item()* {
  let $clarin-writer := fn:doc("/db/cr/writer.xml"),
  $cache-path := repo-utils:config-value($config, 'cache.path'),
  $dummy := xdb:login($cache-path, $clarin-writer//write-user/text(), $clarin-writer//write-user-cred/text()),
  $store := (: util:catch("org.exist.xquery.XPathException", :) xdb:store($cache-path, $doc-name, $data), (: , ()) :)
  $stored-doc := fn:doc(concat($cache-path, "/", $doc-name))
  return $stored-doc
(:  ():)
};

(:
this tries to create sub-collections in index for
individual data-collection - but it makes the retrieval etc. also more complicated
so rather encoding the data-collection also in the name

declare function repo-utils:store-in-cache($data-collection as item(), $doc-name as xs:string, $data as node()) as item()* {
    let $data-coll-name := collection-name($data-collection)
    let $index-coll-path := concat($repo-utils:cachePath, "/", $data-coll-name )
   let $create-coll := if (not(xmldb:collection-available($index-coll-path ))) then
                           xmldb:create-collection($repo-utils:cachePath, $data-collname) else ()
  let $store-result := repo-utils:store($index-coll-path, $doc-name, $data, true())

return $store-result
};
:)

(:<options><option key="update">yes</option></options>:)
declare function repo-utils:store($collection as xs:string, $doc-name as xs:string, $data as node(), $overwrite as xs:boolean) as item()* {
  let $clarin-writer := fn:doc("/db/cr/writer.xml"),
  $dummy := xdb:login($collection, $clarin-writer//write-user/text(), $clarin-writer//write-user-cred/text())

  let $rem := if ($overwrite and doc-available(concat($collection, $doc-name))) then xdb:remove($collection, $doc-name) else ()

  let $store := (: util:catch("org.exist.xquery.XPathException", :) xdb:store($collection, $doc-name, $data), (: , ()) :)
  $stored-doc := fn:doc(concat($collection, "/", $doc-name))
  return $stored-doc
};

(:~ Create document name with md5-hash for selected collections (or types) for reuse.
:)
declare function repo-utils:gen-cache-id($type-name as xs:string, $keys as xs:string+, $depth as xs:string) as xs:string {
  let $name-prefix := fn:concat($type-name, $depth),
       $sanitized-names := for $key in $keys return repo-utils:sanitize-name($key)
    return
(:    fn:concat($name-prefix, "-", util:hash(string-join($sorted-names, ""), "MD5"), $repo-utils:xmlExt):)
    fn:concat($name-prefix, "-", string-join($sanitized-names, "-"), $repo-utils:xmlExt)
};

(:~ wipes out problematic characters from names
:)
declare function repo-utils:sanitize-name($name as xs:string) as xs:string {
    translate($name, ":",'_')
};

(:~ transform result to HTML, JSON, or leave as XML - according to format parameter
:)
declare function repo-utils:serialise-as($item as node()?, $format as xs:string, $operation as xs:string, $config ) as item()? {
      if ($format eq $repo-utils:responseFormatJSon) then
	       let $option := util:declare-option("exist:serialize", "method=json media-type=application/json")
	       return $item
	    else if (contains($format, $repo-utils:responseFormatHTML)) then
	           let $xslDoc := doc(concat(repo-utils:config-value($config, 'scripts.path'), repo-utils:config-value($config, concat($operation, ".xsl"))) )
	           let $res := transform:transform($item,$xslDoc,
              			<parameters><param name="format" value="{$format}"/>
              			            <param name="x-context" value="{repo-utils:param-value($config, 'x-context', '' )}"/>
              			            <param name="base_url" value="{repo-utils:config-value($config, 'base.url')}"/>
              			            <param name="scripts_url" value="{repo-utils:config-value($config, 'scripts.url')}"/>
              			             <param name="site_name" value="{repo-utils:config-value($config, 'site.name')}"/>
              			</parameters>)
(:               let $option := util:declare-option("exist:serialize", "method=xml media-type=text/html"):)
let $option := util:declare-option("exist:serialize", "method=xhtml media-type=text/html")
	           return $res
	   else
	       let $option := util:declare-option("exist:serialize", "method=xml media-type=application/xml")
	    return $item
};
(: $repo-utils:responseFormatXml, $repo-utils:responseFormatText:)

	    (:let $option :=
	              if (contains($format, $repo-utils:responseFormatHTML)) then
	                  util:declare-option("exist:serialize", "method=xml media-type=text/xhtml")
	              else
    	              util:declare-option("exist:serialize", "method=xml media-type=application/xml")
:)

	          	(: $item :)

module namespace repo-utils = "http://aac.ac.at/content_repository/utils";

import module namespace xdb="http://exist-db.org/xquery/xmldb";
import module namespace diag =  "http://www.loc.gov/zing/srw/diagnostic/" at  "modules/diagnostics/diagnostics.xqm";

(:~ HELPER functions - configuration, caching, data-access
:)

(:
: this all cannot be defined as global variable, because we want different configurations,
: thus the $config has to be sent as param everywhere
: declare variable $repo-utils:config := doc("config.xml");
: declare variable $repo-utils:mappings := doc(repo-utils:config-value('mappings'));
: declare variable $repo-utils:data-collection := collection(repo-utils:config-value('data.path'));
: declare variable $repo-utils:md-collection := collection(repo-utils:config-value('metadata.path'));
: declare variable $repo-utils:cachePath as xs:string := repo-utils:config-value('cache.path');
:)

declare variable $repo-utils:xmlExt as xs:string := ".xml";
declare variable $repo-utils:responseFormatXml as xs:string := "xml";
declare variable $repo-utils:responseFormatJSon as xs:string := "json";
declare variable $repo-utils:responseFormatText as xs:string := "text";
declare variable $repo-utils:responseFormatHTML as xs:string := "html";

declare function repo-utils:config-value($config, $key as xs:string) as xs:string* {
    $config//property[@key=$key]
};

(:~ Get value of a param based on a key, from config or from request-param (precedence) :)
declare function repo-utils:param-value($config, $key as xs:string, $default as xs:string) as xs:string* {

    let $param := request:get-parameter($key, $default)
    return if ($param) then $param else $config//property[@key=$key]
};

(:~ returns db-collection (as nodeset) based on the identifier in x-context, looked up in the mapping or default collection as defined in config

@returns nodeset of given context
 if no x-context match or no context provided returns default collection from the config (data.path )
 (if available, otherwise again empty result)

WATCHME: changed to lax handling of the context (if no match - go to default)
        gives better recall, but may confuse - alternatively: strict: empty result if x-context does not match
TODO: accept $x-context as xs:string*
:)
declare function repo-utils:context-to-collection($x-context as xs:string, $config) as node()* {
(:      let $mappings := doc(repo-utils:config-value($config, 'mappings')):)
      let $dbcoll-path := repo-utils:context-to-collection-path($x-context, $config)
    return if ($dbcoll-path eq "" ) then ()
                else collection($dbcoll-path)
};

(:~ returns path to db-collection (as nodeset) based on the identifier in x-context,
looked up in the mapping or default data.path as defined in config

@returns dbcoll-path of given context
 if no x-context match or no context provided returns default collection from the config (data.path )
 (if available, otherwise again empty result)

WATCHME: changed to lax handling of the context (if no match - go to default)
        gives better recall, but may confuse - alternatively: strict: empty result if x-context does not match
T
:)
declare function repo-utils:context-to-collection-path($x-context as xs:string, $config) as xs:string {
      let $mappings:= doc(repo-utils:config-value($config, 'mappings'))
    return    (: if ($x-context) then :)
            if (exists($mappings//map[xs:string(@key) eq $x-context]/@path)) then
                    $mappings//map[xs:string(@key) eq $x-context]/xs:string(@path)
                (: else "" :)
                  else if (exists(repo-utils:config-value($config, 'data.path'))) then
                        repo-utils:config-value($config, 'data.path')
                  else ""
};

(:~ Get the resource by PID/handle/URL or some known identifier.
  TODO: NOT ADAPTED YET! (taken from CMD)
  TODO: be clear about resource itself and metadata-record!
:)
(:declare function repo-utils:get-resource-by-id($id as xs:string) as node()* {
  let $collection := collection($cr:dataPath)
  return
    if ($id eq "" or $id eq $cr:collectionRoot) then
    $collection//IsPartOf[. = $cr:collectionRoot]/ancestor::CMD
  else
    util:eval(concat("$collection/ft:query(descendant::MdSelfLink, <term>", xdb:decode($id), "</term>)/ancestor::CMD"))
 (\: $collection/descendant::MdSelfLink[. = xdb:decode($id)]/ancestor::CMD :\)
};
:)

(:~ Checks whether the document is available or not.
  generic, currently not used
:)
declare function repo-utils:is-doc-available($collection as xs:string, $doc-name as xs:string) as xs:boolean {
  fn:doc-available(fn:concat($collection, "/", $doc-name))
};

declare function repo-utils:is-in-cache($doc-name as xs:string,$config) as xs:boolean {
  fn:doc-available(fn:concat(repo-utils:config-value($config, 'cache.path'), "/", $doc-name))
};

declare function repo-utils:get-from-cache($doc-name as xs:string,$config) as item()* {
      fn:doc(fn:concat(repo-utils:config-value($config, 'cache.path'), "/", $doc-name))
};

(:~ Store the data in cache. Uses own writer-account
:)
declare function repo-utils:store-in-cache($doc-name as xs:string, $data as node(),$config) as item()* {
  let $clarin-writer := fn:doc("/db/cr/writer.xml"),
  $cache-path := repo-utils:config-value($config, 'cache.path'),
  $dummy := xdb:login($cache-path, $clarin-writer//write-user/text(), $clarin-writer//write-user-cred/text()),
  $store := (: util:catch("org.exist.xquery.XPathException", :) xdb:store($cache-path, $doc-name, $data), (: , ()) :)
  $stored-doc := fn:doc(concat($cache-path, "/", $doc-name))
  return $stored-doc
(:  ():)
};

(:
this tries to create sub-collections in index for
individual data-collection - but it makes the retrieval etc. also more complicated
so rather encoding the data-collection also in the name

declare function repo-utils:store-in-cache($data-collection as item(), $doc-name as xs:string, $data as node()) as item()* {
    let $data-coll-name := collection-name($data-collection)
    let $index-coll-path := concat($repo-utils:cachePath, "/", $data-coll-name )
   let $create-coll := if (not(xmldb:collection-available($index-coll-path ))) then
                           xmldb:create-collection($repo-utils:cachePath, $data-collname) else ()
  let $store-result := repo-utils:store($index-coll-path, $doc-name, $data, true())

return $store-result
};
:)

(:<options><option key="update">yes</option></options>:)
declare function repo-utils:store($collection as xs:string, $doc-name as xs:string, $data as node(), $overwrite as xs:boolean) as item()* {
  let $clarin-writer := fn:doc("/db/cr/writer.xml"),
  $dummy := xdb:login($collection, $clarin-writer//write-user/text(), $clarin-writer//write-user-cred/text())

  let $rem := if ($overwrite and doc-available(concat($collection, $doc-name))) then xdb:remove($collection, $doc-name) else ()

  let $store := (: util:catch("org.exist.xquery.XPathException", :) xdb:store($collection, $doc-name, $data), (: , ()) :)
  $stored-doc := fn:doc(concat($collection, "/", $doc-name))
  return $stored-doc
};

(:~ Create document name with md5-hash for selected collections (or types) for reuse.
:)
declare function repo-utils:gen-cache-id($type-name as xs:string, $keys as xs:string+, $depth as xs:string) as xs:string {
  let $name-prefix := fn:concat($type-name, $depth),
       $sanitized-names := for $key in $keys return repo-utils:sanitize-name($key)
    return
(:    fn:concat($name-prefix, "-", util:hash(string-join($sorted-names, ""), "MD5"), $repo-utils:xmlExt):)
    fn:concat($name-prefix, "-", string-join($sanitized-names, "-"), $repo-utils:xmlExt)
};

(:~ wipes out problematic characters from names
:)
declare function repo-utils:sanitize-name($name as xs:string) as xs:string {
    translate($name, ":",'_')
};

(:~ transform result to HTML, JSON, or leave as XML - according to format parameter
:)
declare function repo-utils:serialise-as($item as node()?, $format as xs:string, $operation as xs:string, $config ) as item()? {
      if ($format eq $repo-utils:responseFormatJSon) then
	       let $option := util:declare-option("exist:serialize", "method=json media-type=application/json")
	       return $item
	    else if (contains($format, $repo-utils:responseFormatHTML)) then
	           let $xslDoc := doc(concat(repo-utils:config-value($config, 'scripts.path'), repo-utils:config-value($config, concat($operation, ".xsl"))) )
	           let $res := transform:transform($item,$xslDoc,
              			<parameters><param name="format" value="{$format}"/>
              			            <param name="x-context" value="{repo-utils:param-value($config, 'x-context', '' )}"/>
              			            <param name="base_url" value="{repo-utils:config-value($config, 'base.url')}"/>
              			            <param name="scripts_url" value="{repo-utils:config-value($config, 'scripts.url')}"/>
              			</parameters>)
               let $option := util:declare-option("exist:serialize", "method=xml media-type=text/html")
	           return $res
	   else
	       let $option := util:declare-option("exist:serialize", "method=xml media-type=application/xml")
	    return $item
};
(: $repo-utils:responseFormatXml, $repo-utils:responseFormatText:)

	    (:let $option :=
	              if (contains($format, $repo-utils:responseFormatHTML)) then
	                  util:declare-option("exist:serialize", "method=xml media-type=text/xhtml")
	              else
    	              util:declare-option("exist:serialize", "method=xml media-type=application/xml")
:)

	          	(: $item :)


Don't copy link id to main menu

Don't copy link id to main menu

xquery version "1.0" encoding "utf-8";

module namespace calli = "http://callimachusproject.org/rdf/2009/framework#";

declare copy-namespaces preserve, inherit;
declare default element namespace "http://www.w3.org/1999/xhtml";

declare variable $calli:realm external;

(: template nodes :)
declare variable $calli:html-element := /html;

declare function calli:head-nodes() as node()* {
    $calli:html-element/head/node()
};
declare function calli:body-attributes() as attribute(*)* {
    $calli:html-element/body/@*
};
declare function calli:body-sidebar($div as element()) as element()? {
    let $sidebar := $calli:html-element/body/div[@id='sidebar'][1]
    return if ($sidebar) then
        element { node-name($div) } { $div/@*, $div/node(), $sidebar/node() }
    else
        $sidebar
};
declare function calli:body-hgroup() as element()? {
    ($calli:html-element/body/*[self::h1 or self::hgroup])[1]
};
declare function calli:body-nodes() as node()* {
    let $hgroup := ($calli:html-element/body/*[self::h1 or self::hgroup])[1]
    return $calli:html-element/body/node()[not(self::div[@id='sidebar']) and (not(self::h1 or self::hgroup) or preceding-sibling::h1 or preceding-sibling::hgroup)]
};
declare function calli:head-links($a as element(), $divider as element()) as element()* {
    let $links := $calli:html-element/head/link[@title and @href]
    return if ($links) then
        (
            for $link in $links
            return calli:add-href($a, $link, $link/@title),
            $divider
        )
    else
        $links
};
declare function calli:add-href($a as element(), $link as element(), $label as xs:string) {
    if (local-name($a)='a') then
        element {node-name($a)} {
            $a/@*[name()!='class'],
            for $attr in $link/@*[name()!='id']
            return if ($a/@*[name()=name($attr)]) then ()
            else $attr,
            if ($a/@class and $link/@class) then attribute class {concat($a/@class,' ',$link/@class)}
            else if ($a/@class) then $a/@class
            else (),
            $label
        }
    else if ($a/self::*) then
        element {node-name($a)} {
            $a/@*,
            for $node in $a/node()
            return calli:add-href($node, $link, $label)
        }
    else
        $a

};

(: static markup functions :)
declare function calli:styles-href($link as element()) as element() {
    element {node-name($link)} {
        attribute href {resolve-uri('../styles/callimachus.less?less')},
        $link/@*[name()!='href'],
        $link/node()
    }
};
declare function calli:scripts-src($script as element()) as element() {
    element {node-name($script)} {
        attribute src {resolve-uri('../../scripts.js')},
        $script/@*[name()!='src'],
        $script/node()
    }
};
declare function calli:lookup-form($placeholder as xs:string) as element(form) {
    <form class="form-search" method="GET" action="{$calli:realm}">
        <input type="text" name="q" class="search-query" placeholder="{$placeholder}" />
    </form>
};

declare function calli:breadcrumb-links($breadcrumb as element(), $divider as item(), $active as element()) as element(nav) {
    {$breadcrumb}{$divider}{$active}
};
declare function calli:breadcrumb-links($breadcrumb as item()*, $active as element()) as element(nav) {
    {$breadcrumb}{$active}
};
declare function calli:activate-nav($nav as node()*) as element(nav) {
    {$nav}
};
declare function calli:lastmod-time($time as element()) as element(div) {

{$time}

};
declare function calli:error-alert($div as element()) as element(div) {

{$div}

};
declare function calli:generator-p($p as element()) as element() {
    element { node-name($p) } {
        $p/@*,
        $p/node(),

    }
};

(: navigation links :)
declare function calli:home-href($a as element()) as element() {
    element {node-name($a)} {
        attribute href {$calli:realm},
        $a/@*[name()!='href'],
        $a/node()
    }
};
declare function calli:folder-href($a as element()) as element() {
    element {node-name($a)} {
        attribute href {concat($calli:realm,'?view')},
        $a/@*[name()!='href'],
        $a/node()
    }
};
declare function calli:changes-href($a as element()) as element() {
    element {node-name($a)} {
        attribute href {concat($calli:realm,'?changes')},
        $a/@*[name()!='href'],
        $a/node()
    }
};
declare function calli:view-href($a as element()) as element() {
    element {node-name($a)} {
        attribute href {"?view"},
        $a/@*[name()!='href'],
        $a/node()
    }
};
declare function calli:edit-href($a as element()) as element() {
    element {node-name($a)} {
        attribute href {"?edit"},
        $a/@*[name()!='href'],
        $a/node()
    }
};
declare function calli:discussion-href($a as element()) as element() {
    element {node-name($a)} {
        attribute href {"?discussion"},
        $a/@*[name()!='href'],
        $a/node()
    }
};
declare function calli:describe-href($a as element()) as element() {
    element {node-name($a)} {
        attribute href {"?describe"},
        $a/@*[name()!='href'],
        $a/node()
    }
};
declare function calli:history-href($a as element()) as element() {
    element {node-name($a)} {
        attribute href {"?history"},
        $a/@*[name()!='href'],
        $a/node()
    }
};
declare function calli:whatlinkshere-href($a as element()) as element() {
    element {node-name($a)} {
        attribute href {"?whatlinkshere"},
        $a/@*[name()!='href'],
        $a/node()
    }
};
declare function calli:relatedchanges-href($a as element()) as element() {
    element {node-name($a)} {
        attribute href {"?relatedchanges"},
        $a/@*[name()!='href'],
        $a/node()
    }
};
declare function calli:permissions-href($a as element()) as element() {
    element {node-name($a)} {
        attribute href {"?permissions"},
        $a/@*[name()!='href'],
        $a/node()
    }
};
declare function calli:introspect-href($a as element()) as element() {
    element {node-name($a)} {
        attribute href {"?introspect"},
        $a/@*[name()!='href'],
        $a/node()
    }
};
declare function calli:login-href($a as element()) as element() {
    element {node-name($a)} {
        attribute href {concat($calli:realm,'?login')},
        attribute id {"login-link"},
        $a/@*[name()!='href' and name()!='id'],
        $a/node()
    }
};
declare function calli:profile-href($a as element()) as element() {
    element {node-name($a)} {
        attribute href {concat($calli:realm,'?profile')},
        attribute id {"profile-link"},
        $a/@*[name()!='href' and name()!='id'],
        $a/node()
    }
};
declare function calli:logout-href($a as element()) as element() {
    element {node-name($a)} {
        attribute href {concat($calli:realm,'?logout')},
        attribute id {"logout-link"},
        $a/@*[name()!='href' and name()!='id'],
        $a/node()
    }
};

(: deprecated since 1.2 :)
declare function calli:breadcrumb-nav($breadcrumb as element()) as element(nav) {
    {$breadcrumb}
};

(: deprecated since 1.0.1 :)
declare function calli:styles() as element() {calli:styles-href(<link rel="stylesheet" />)};
declare function calli:scripts() as element() {calli:scripts-src(

xquery version "1.0" encoding "utf-8";

module namespace calli = "http://callimachusproject.org/rdf/2009/framework#";

declare copy-namespaces preserve, inherit;
declare default element namespace "http://www.w3.org/1999/xhtml";

declare variable $calli:realm external;

(: template nodes :)
declare variable $calli:html-element := /html;

declare function calli:head-nodes() as node()* {
    $calli:html-element/head/node()
};
declare function calli:body-attributes() as attribute(*)* {
    $calli:html-element/body/@*
};
declare function calli:body-sidebar($div as element()) as element()? {
    let $sidebar := $calli:html-element/body/div[@id='sidebar'][1]
    return if ($sidebar) then
        element { node-name($div) } { $div/@*, $div/node(), $sidebar/node() }
    else
        $sidebar
};
declare function calli:body-hgroup() as element()? {
    ($calli:html-element/body/*[self::h1 or self::hgroup])[1]
};
declare function calli:body-nodes() as node()* {
    let $hgroup := ($calli:html-element/body/*[self::h1 or self::hgroup])[1]
    return $calli:html-element/body/node()[not(self::div[@id='sidebar']) and (not(self::h1 or self::hgroup) or preceding-sibling::h1 or preceding-sibling::hgroup)]
};
declare function calli:head-links($a as element(), $divider as element()) as element()* {
    let $links := $calli:html-element/head/link[@title and @href]
    return if ($links) then
        (
            for $link in $links
            return calli:add-href($a, $link, $link/@title),
            $divider
        )
    else
        $links
};
declare function calli:add-href($a as element(), $link as element(), $label as xs:string) {
    if (local-name($a)='a') then
        element {node-name($a)} {
            $a/@*[name()!='class'],
            for $attr in $link/@*
            return if ($a/@*[name()=name($attr)]) then ()
            else $attr,
            if ($a/@class and $link/@class) then attribute class {concat($a/@class,' ',$link/@class)}
            else if ($a/@class) then $a/@class
            else (),
            $label
        }
    else if ($a/self::*) then
        element {node-name($a)} {
            $a/@*,
            for $node in $a/node()
            return calli:add-href($node, $link, $label)
        }
    else
        $a

};

(: static markup functions :)
declare function calli:styles-href($link as element()) as element() {
    element {node-name($link)} {
        attribute href {resolve-uri('../styles/callimachus.less?less')},
        $link/@*[name()!='href'],
        $link/node()
    }
};
declare function calli:scripts-src($script as element()) as element() {
    element {node-name($script)} {
        attribute src {resolve-uri('../../scripts.js')},
        $script/@*[name()!='src'],
        $script/node()
    }
};
declare function calli:lookup-form($placeholder as xs:string) as element(form) {
    <form class="form-search" method="GET" action="{$calli:realm}">
        <input type="text" name="q" class="search-query" placeholder="{$placeholder}" />
    </form>
};

declare function calli:breadcrumb-links($breadcrumb as element(), $divider as item(), $active as element()) as element(nav) {
    {$breadcrumb}{$divider}{$active}
};
declare function calli:breadcrumb-links($breadcrumb as item()*, $active as element()) as element(nav) {
    {$breadcrumb}{$active}
};
declare function calli:activate-nav($nav as node()*) as element(nav) {
    {$nav}
};
declare function calli:lastmod-time($time as element()) as element(div) {

{$time}

};
declare function calli:error-alert($div as element()) as element(div) {

{$div}

};
declare function calli:generator-p($p as element()) as element() {
    element { node-name($p) } {
        $p/@*,
        $p/node(),

    }
};

(: navigation links :)
declare function calli:home-href($a as element()) as element() {
    element {node-name($a)} {
        attribute href {$calli:realm},
        $a/@*[name()!='href'],
        $a/node()
    }
};
declare function calli:folder-href($a as element()) as element() {
    element {node-name($a)} {
        attribute href {concat($calli:realm,'?view')},
        $a/@*[name()!='href'],
        $a/node()
    }
};
declare function calli:changes-href($a as element()) as element() {
    element {node-name($a)} {
        attribute href {concat($calli:realm,'?changes')},
        $a/@*[name()!='href'],
        $a/node()
    }
};
declare function calli:view-href($a as element()) as element() {
    element {node-name($a)} {
        attribute href {"?view"},
        $a/@*[name()!='href'],
        $a/node()
    }
};
declare function calli:edit-href($a as element()) as element() {
    element {node-name($a)} {
        attribute href {"?edit"},
        $a/@*[name()!='href'],
        $a/node()
    }
};
declare function calli:discussion-href($a as element()) as element() {
    element {node-name($a)} {
        attribute href {"?discussion"},
        $a/@*[name()!='href'],
        $a/node()
    }
};
declare function calli:describe-href($a as element()) as element() {
    element {node-name($a)} {
        attribute href {"?describe"},
        $a/@*[name()!='href'],
        $a/node()
    }
};
declare function calli:history-href($a as element()) as element() {
    element {node-name($a)} {
        attribute href {"?history"},
        $a/@*[name()!='href'],
        $a/node()
    }
};
declare function calli:whatlinkshere-href($a as element()) as element() {
    element {node-name($a)} {
        attribute href {"?whatlinkshere"},
        $a/@*[name()!='href'],
        $a/node()
    }
};
declare function calli:relatedchanges-href($a as element()) as element() {
    element {node-name($a)} {
        attribute href {"?relatedchanges"},
        $a/@*[name()!='href'],
        $a/node()
    }
};
declare function calli:permissions-href($a as element()) as element() {
    element {node-name($a)} {
        attribute href {"?permissions"},
        $a/@*[name()!='href'],
        $a/node()
    }
};
declare function calli:introspect-href($a as element()) as element() {
    element {node-name($a)} {
        attribute href {"?introspect"},
        $a/@*[name()!='href'],
        $a/node()
    }
};
declare function calli:login-href($a as element()) as element() {
    element {node-name($a)} {
        attribute href {concat($calli:realm,'?login')},
        attribute id {"login-link"},
        $a/@*[name()!='href' and name()!='id'],
        $a/node()
    }
};
declare function calli:profile-href($a as element()) as element() {
    element {node-name($a)} {
        attribute href {concat($calli:realm,'?profile')},
        attribute id {"profile-link"},
        $a/@*[name()!='href' and name()!='id'],
        $a/node()
    }
};
declare function calli:logout-href($a as element()) as element() {
    element {node-name($a)} {
        attribute href {concat($calli:realm,'?logout')},
        attribute id {"logout-link"},
        $a/@*[name()!='href' and name()!='id'],
        $a/node()
    }
};

(: deprecated since 1.2 :)
declare function calli:breadcrumb-nav($breadcrumb as element()) as element(nav) {
    {$breadcrumb}
};

(: deprecated since 1.0.1 :)
declare function calli:styles() as element() {calli:styles-href(<link rel="stylesheet" />)};
declare function calli:scripts() as element() {calli:scripts-src(


Added some windows specific documentation to the xsl-fo module

(:
 : Copyright 2006-2009 The FLWOR Foundation.
 :
 : Licensed under the Apache License, Version 2.0 (the "License");
 : you may not use this file except in compliance with the License.
 : You may obtain a copy of the License at
 :
 : http://www.apache.org/licenses/LICENSE-2.0
 :
 : Unless required by applicable law or agreed to in writing, software
 : distributed under the License is distributed on an "AS IS" BASIS,
 : WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 : See the License for the specific language governing permissions and
 : limitations under the License.
:)
(:~
 : This module uses Apache-FOP to generate content from a xsl-fo. Apache-FOP supports
 : several output formats. See the Apache FOP
 : documentation for further information.
 :
 : Not for Windows users: Under Windows, this module won't work out of the box, since
 : this module uses Java and the Java VM dll is not in the system path by default. To make
 : this module work, you need to add the directory where the jvm.dll is located to the
 : system path. This dll is in JRE_DIR\bin\client. On a standard installation, this would
 : be something like "C:\Program Files\Java\jre6\bin\client".
 :
 : @author Markus Pilman
 :)
module namespace xsl-fo = "http://www.zorba-xquery.com/modules/xsl-fo";

import module namespace file = "http://www.zorba-xquery.com/modules/file";
import module namespace os = "http://www.zorba-xquery.com/modules/os";

(:~
 : This is the name of the error which gets thrown, if zorba is unable
 : to start a JVM.
 :)
declare variable $xsl-fo:VM001 as xs:QName := xs:QName("xsl-fo:VM001");
(:~
 : This is the name of the error which gets thrown, if Apache throws an exception
 : - the Java stack trace will be part of the description.
 :)
declare variable $xsl-fo:JAVA-EXCEPTION as xs:QName := xs:QName("xsl-fo:JAVA-EXCEPTION");
(:~
 : This is the name of the error which gets thrown, if zorba is unable to
 : find a required JAR library.
 :)
declare variable $xsl-fo:JAR-NOT-FOUND as xs:QName := xs:QName("xsl-fo:JAR_NOT_FOUND");

(:~
 : The mime type of IBMs AFP format.
 :)
declare variable $xsl-fo:AFP as xs:string := "application/x-afp";
(:~
 : The mime type of the EPS format.
 :)
declare variable $xsl-fo:EPS as xs:string := "application/postscript";
(:~
 : The mime type of the PCL format.
 :)
declare variable $xsl-fo:PCL as xs:string := "application/x-pcl";
(:~
 : The mime type of the PDF format.
 :)
declare variable $xsl-fo:PDF as xs:string := "application/pdf";
(:~
 : The mime type for plain text files.
 :)
declare variable $xsl-fo:PLAIN_TEXT as xs:string := "text/plain";
(:~
 : The mime type of the PNG format.
 :)
declare variable $xsl-fo:PNG as xs:string := "image/png";
(:~
 : The mime type of the postscript format.
 :)
declare variable $xsl-fo:POSTSCRIPT as xs:string := "application/postscript";
(:~
 : The mime type of the RTF format.
 :)
declare variable $xsl-fo:RTF as xs:string := "application/rtf";
(:~
 : The mime type of TIFF format.
 :)
declare variable $xsl-fo:TIFF as xs:string := "image/tiff";

(:~
 : The generator function takes an xsl-fo as input and generates output in the format given as input.
 : The output format can be given as a Mime - for example "application/pdf" - or one of the predefines
 : variables can be used - like $xsl-fo:PDF. Please refer to the Apache FOP documentation for documentation
 : about the supported ouput formats.
 :
 : Apache FOP does not support 100% of the XSL-FO standard. Please consult the official documentation,
 : for further information.
 :
 : @param $output-format The mime of the output format, to tell Apache FOP which kind of document it should
 :        create.
 : @param $xsl-fo-document The xsl-fo node, from which the document should be generated.
 : @param $classpath The classpath which has to contain Apache FOP and all its dependencies. If you don't
 :        want to set this programmatically, use the generator function without this parameter instead.
 : @return The generated output document.
 : @error VM001 if zorba was unable to start the JVM.
 : @error JAVA-EXCEPTION If Apache FOP throws an exception - i.e. if the input format is not correct/supported.
 :)
declare function xsl-fo:generator($output-format as xs:string, $xsl-fo-document as node(), $classpath as xs:string+) as xs:base64Binary {
  let $os as xs:string := os:operating-system()
  let $dir-separator as xs:string := if ($os eq "Windows") then ";" else ":"
  return xsl-fo:generator-impl($output-format, $xsl-fo-document, fn:string-join($classpath, $dir-separator))
};

(:~
 : The function behaves like generator#3, but tries to find the needed Java libraries itself.
 : On a Mac OS X computer, it should be sufficient to install Apache FOP via Mac Ports, on
 : Ubuntu it should be sufficient to install the fop packages via apt-get.
 :
 : This function tries to find the jar files via envroinment variables. The user can set the
 : variable FOP_HOME to the root directory of an Apache FOP distribution. If you have all
 : Jar files in the same directory, you can set the envroinment variable FOP_LIB_DIR to this
 : directory.
 :
 : @param $output-format The mime of the output format, to tell Apache FOP which kind of document it should
 :        create.
 : @param $xsl-fo-document The xsl-fo node, from which the document should be generated.
 : @return The generated output document.
 : @error VM001 if zorba was unable to start the JVM.
 : @error JAVA-EXCEPTION If Apache FOP throws an exception - i.e. if the input format is not correct/supported.
 : @error JAR-NOT-FOUND If a needed Java library could not be found.
 :)
declare function xsl-fo:generator($output-format as xs:string, $xsl-fo-document as node()) as xs:base64Binary {
  let $os as xs:string := os:operating-system()
  let $fop-home as xs:string? :=
    if (fn:not(os:get-env("FOP_HOME"))) then
      if ($os eq "Mac OS X") then
        let $f := fn:concat("/opt/local/share/java/fop/", xs:string((
          for $d in
              for $dir in file:files("/opt/local/share/java/fop", "[0-9]+\.[0-9]+")
              where file:is-directory(fn:concat("/opt/local/share/java/fop/", $dir))
              return $dir
          order by xs:decimal($d) descending
          return $d)[1]))
        return
          if (file:exists($f) and file:is-directory($f)) then
            $f
          else
            ()
      else ()
    else os:get-env("FOP_HOME")
  let $fop-lib-dir as xs:string? :=
    if (os:get-env("FOP_LIB_DIR")) then
      os:get-env("FOP_LIB_DIR")
    else if ($os eq "Linux") then
      "/usr/share/java"
    else ()
  let $fop-jar-file as xs:string :=
    if ($fop-home or $fop-lib-dir) then
      if (file:exists(fn:concat($fop-home, file:path-separator(), "build", file:path-separator(), "fop.jar"))) then
        fn:concat($fop-home, file:path-separator(), "build", file:path-separator(), "fop.jar")
      else if (file:exists(fn:concat($fop-lib-dir, file:path-separator(), "fop.jar"))) then
        fn:concat($fop-lib-dir, file:path-separator(), "fop.jar")
      else
        fn:error($xsl-fo:JAR-NOT-FOUND,
          fn:concat("Could not find fop.jar. If you are using Ubuntu or Mac OS X, please make sure,
           that you have installed it, else make sure, that you have set the envroinment variable
           FOP_HOME or FOP_LIB_DIR correctly.
           tried ", fn:concat($fop-home, file:path-separator(), "build",
           file:path-separator(), "fop.jar"), "
           and ",
           fn:concat($fop-lib-dir, file:path-separator(), "fop.jar"), " with FOP_HOME=",
           $fop-home, " and FOP_LIB_DIR=", $fop-lib-dir))
    else
      fn:error($xsl-fo:JAR-NOT-FOUND,
        "None of the envroinment variables FOP_HOME and FOP_LIB_DIR has bin set.")
  let $classpath as xs:string* :=
    ($fop-jar-file, for $jar in ("avalon-framework", "batik-all", "commons-io", "commons-logging", "serializer",
                 "xalan", "xmlgraphics-commons")
    let $jar-dir as xs:string :=
      if ($fop-home) then
        fn:concat($fop-home, file:path-separator(), "lib")
      else
        $fop-lib-dir
    let $res as xs:string := fn:concat($jar-dir, file:path-separator(), file:files($jar-dir, fn:concat($jar, ".*\.jar"))[1])
    return
      if (file:exists($res) and fn:not(file:is-directory($res))) then
        $res
      else
        fn:error($xsl-fo:JAR-NOT-FOUND, fn:concat("Could not find ", $jar)))
  return xsl-fo:generator($output-format, $xsl-fo-document, $classpath)
};

declare %private function xsl-fo:generator-impl($output-format as xs:string, $xsl-fo-document as node(), $classpath as xs:string) external;

(:
 : Copyright 2006-2009 The FLWOR Foundation.
 :
 : Licensed under the Apache License, Version 2.0 (the "License");
 : you may not use this file except in compliance with the License.
 : You may obtain a copy of the License at
 :
 : http://www.apache.org/licenses/LICENSE-2.0
 :
 : Unless required by applicable law or agreed to in writing, software
 : distributed under the License is distributed on an "AS IS" BASIS,
 : WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 : See the License for the specific language governing permissions and
 : limitations under the License.
:)
(:~
 : This module uses Apache-FOP to generate content from a xsl-fo. Apache-FOP supports
 : several output formats. See the Apache FOP
 : documentation for further information.
 :
 : @author Markus Pilman
 :)
module namespace xsl-fo = "http://www.zorba-xquery.com/modules/xsl-fo";

import module namespace file = "http://www.zorba-xquery.com/modules/file";
import module namespace os = "http://www.zorba-xquery.com/modules/os";

(:~
 : This is the name of the error which gets thrown, if zorba is unable
 : to start a JVM.
 :)
declare variable $xsl-fo:VM001 as xs:QName := xs:QName("xsl-fo:VM001");
(:~
 : This is the name of the error which gets thrown, if Apache throws an exception
 : - the Java stack trace will be part of the description.
 :)
declare variable $xsl-fo:JAVA-EXCEPTION as xs:QName := xs:QName("xsl-fo:JAVA-EXCEPTION");
(:~
 : This is the name of the error which gets thrown, if zorba is unable to
 : find a required JAR library.
 :)
declare variable $xsl-fo:JAR-NOT-FOUND as xs:QName := xs:QName("xsl-fo:JAR_NOT_FOUND");

(:~
 : The mime type of IBMs AFP format.
 :)
declare variable $xsl-fo:AFP as xs:string := "application/x-afp";
(:~
 : The mime type of the EPS format.
 :)
declare variable $xsl-fo:EPS as xs:string := "application/postscript";
(:~
 : The mime type of the PCL format.
 :)
declare variable $xsl-fo:PCL as xs:string := "application/x-pcl";
(:~
 : The mime type of the PDF format.
 :)
declare variable $xsl-fo:PDF as xs:string := "application/pdf";
(:~
 : The mime type for plain text files.
 :)
declare variable $xsl-fo:PLAIN_TEXT as xs:string := "text/plain";
(:~
 : The mime type of the PNG format.
 :)
declare variable $xsl-fo:PNG as xs:string := "image/png";
(:~
 : The mime type of the postscript format.
 :)
declare variable $xsl-fo:POSTSCRIPT as xs:string := "application/postscript";
(:~
 : The mime type of the RTF format.
 :)
declare variable $xsl-fo:RTF as xs:string := "application/rtf";
(:~
 : The mime type of TIFF format.
 :)
declare variable $xsl-fo:TIFF as xs:string := "image/tiff";

(:~
 : The generator function takes an xsl-fo as input and generates output in the format given as input.
 : The output format can be given as a Mime - for example "application/pdf" - or one of the predefines
 : variables can be used - like $xsl-fo:PDF. Please refer to the Apache FOP documentation for documentation
 : about the supported ouput formats.
 :
 : Apache FOP does not support 100% of the XSL-FO standard. Please consult the official documentation,
 : for further information.
 :
 : @param $output-format The mime of the output format, to tell Apache FOP which kind of document it should
 :        create.
 : @param $xsl-fo-document The xsl-fo node, from which the document should be generated.
 : @param $classpath The classpath which has to contain Apache FOP and all its dependencies. If you don't
 :        want to set this programmatically, use the generator function without this parameter instead.
 : @return The generated output document.
 : @error VM001 if zorba was unable to start the JVM.
 : @error JAVA-EXCEPTION If Apache FOP throws an exception - i.e. if the input format is not correct/supported.
 :)
declare function xsl-fo:generator($output-format as xs:string, $xsl-fo-document as node(), $classpath as xs:string+) as xs:base64Binary {
  let $os as xs:string := os:operating-system()
  let $dir-separator as xs:string := if ($os eq "Windows") then ";" else ":"
  return xsl-fo:generator-impl($output-format, $xsl-fo-document, fn:string-join($classpath, $dir-separator))
};

(:~
 : The function behaves like generator#3, but tries to find the needed Java libraries itself.
 : On a Mac OS X computer, it should be sufficient to install Apache FOP via Mac Ports, on
 : Ubuntu it should be sufficient to install the fop packages via apt-get.
 :
 : This function tries to find the jar files via envroinment variables. The user can set the
 : variable FOP_HOME to the root directory of an Apache FOP distribution. If you have all
 : Jar files in the same directory, you can set the envroinment variable FOP_LIB_DIR to this
 : directory.
 :
 : @param $output-format The mime of the output format, to tell Apache FOP which kind of document it should
 :        create.
 : @param $xsl-fo-document The xsl-fo node, from which the document should be generated.
 : @return The generated output document.
 : @error VM001 if zorba was unable to start the JVM.
 : @error JAVA-EXCEPTION If Apache FOP throws an exception - i.e. if the input format is not correct/supported.
 : @error JAR-NOT-FOUND If a needed Java library could not be found.
 :)
declare function xsl-fo:generator($output-format as xs:string, $xsl-fo-document as node()) as xs:base64Binary {
  let $os as xs:string := os:operating-system()
  let $fop-home as xs:string? :=
    if (fn:not(os:get-env("FOP_HOME"))) then
      if ($os eq "Mac OS X") then
        let $f := fn:concat("/opt/local/share/java/fop/", xs:string((
          for $d in
              for $dir in file:files("/opt/local/share/java/fop", "[0-9]+\.[0-9]+")
              where file:is-directory(fn:concat("/opt/local/share/java/fop/", $dir))
              return $dir
          order by xs:decimal($d) descending
          return $d)[1]))
        return
          if (file:exists($f) and file:is-directory($f)) then
            $f
          else
            ()
      else ()
    else os:get-env("FOP_HOME")
  let $fop-lib-dir as xs:string? :=
    if (os:get-env("FOP_LIB_DIR")) then
      os:get-env("FOP_LIB_DIR")
    else if ($os eq "Linux") then
      "/usr/share/java"
    else ()
  let $fop-jar-file as xs:string :=
    if ($fop-home or $fop-lib-dir) then
      if (file:exists(fn:concat($fop-home, file:path-separator(), "build", file:path-separator(), "fop.jar"))) then
        fn:concat($fop-home, file:path-separator(), "build", file:path-separator(), "fop.jar")
      else if (file:exists(fn:concat($fop-lib-dir, file:path-separator(), "fop.jar"))) then
        fn:concat($fop-lib-dir, file:path-separator(), "fop.jar")
      else
        fn:error($xsl-fo:JAR-NOT-FOUND,
          fn:concat("Could not find fop.jar. If you are using Ubuntu or Mac OS X, please make sure,
           that you have installed it, else make sure, that you have set the envroinment variable
           FOP_HOME or FOP_LIB_DIR correctly.
           tried ", fn:concat($fop-home, file:path-separator(), "build",
           file:path-separator(), "fop.jar"), "
           and ",
           fn:concat($fop-lib-dir, file:path-separator(), "fop.jar"), " with FOP_HOME=",
           $fop-home, " and FOP_LIB_DIR=", $fop-lib-dir))
    else
      fn:error($xsl-fo:JAR-NOT-FOUND,
        "None of the envroinment variables FOP_HOME and FOP_LIB_DIR has bin set.")
  let $classpath as xs:string* :=
    ($fop-jar-file, for $jar in ("avalon-framework", "batik-all", "commons-io", "commons-logging", "serializer",
                 "xalan", "xmlgraphics-commons")
    let $jar-dir as xs:string :=
      if ($fop-home) then
        fn:concat($fop-home, file:path-separator(), "lib")
      else
        $fop-lib-dir
    let $res as xs:string := fn:concat($jar-dir, file:path-separator(), file:files($jar-dir, fn:concat($jar, ".*\.jar"))[1])
    return
      if (file:exists($res) and fn:not(file:is-directory($res))) then
        $res
      else
        fn:error($xsl-fo:JAR-NOT-FOUND, fn:concat("Could not find ", $jar)))
  return xsl-fo:generator($output-format, $xsl-fo-document, $classpath)
};

declare %private function xsl-fo:generator-impl($output-format as xs:string, $xsl-fo-document as node(), $classpath as xs:string) external;