updated CSR call

updated CSR call

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

(:Import other namespaces.  :)
import module namespace csd_webconf =  "https://github.com/openhie/openinfoman/csd_webconf";
import module namespace csr_proc = "https://github.com/openhie/openinfoman/csr_proc";
import module namespace csd_dm = "https://github.com/openhie/openinfoman/csd_dm";
import module namespace fadpt = "https://github.com/openhie/openinfoman/adapter/fhir";
import module namespace request = "http://exquery.org/ns/request";

declare namespace xs = "http://www.w3.org/2001/XMLSchema";
declare namespace csd = "urn:ihe:iti:csd:2013";
declare namespace   xforms = "http://www.w3.org/2002/xforms";
declare namespace fhir = "http://hl7.org/fhir";

declare
  %rest:path("/CSD/csr/{$doc_name}/careServicesRequest/{$search_name}/adapter/fhir")
  %output:method("xhtml")
  function page:show_endpoints($search_name,$doc_name)
{
  let $function := csr_proc:get_function_definition($csd_webconf:db,$search_name)
  let $read :=  ($function/csd:extension[@urn='urn:openhie.org:openinfoman:adapter:fhir:read' ])[1]
  let $valueset :=  ($function/csd:extension[@urn='urn:openhie.org:openinfoman:adapter:fhir:valueset' ])[1]
  let $doc := csd_dm:open_document($csd_webconf:db,$doc_name)
  let $org_opts :=
    for $org in $doc/csd:CSD/csd:organizationDirectory/csd:organization
    return <option value="{$org/@entityID}">{($org/csd:primaryName[1])/text()}</option>
  let $fac_opts :=
    for $fac in $doc/csd:CSD/csd:facilityDirectory/csd:facility
    return <option value="{$fac/@entityID}">{($fac/csd:primaryName[1])/text()}</option>

  return
    if (not(fadpt:is_fhir_function($search_name)))
      (:not a read practitioner query. should 404 or whatever is required by FHIR :)
    then ('Not a FHIR Compatible stored function'    )
    else
      let $headers :=
	(
	<link rel="stylesheet" type="text/css" media="screen"   href="{$csd_webconf:baseurl}static/bootstrap-datetimepicker/css/bootstrap-datetimepicker.min.css"/>
	,
	 )

      let $contents :=

{$doc_name}

	  {
	    if ($read)
	    then
	      let $entity := string($read/@type)
	      let $base_url := concat($csd_webconf:baseurl, "CSD/csr/",$doc_name ,"/careServicesRequest/",$search_name, "/adapter/fhir/", $entity)
              return
		(

	            Search {$entity}
		     XML
		    / JSON

Resource Endpoint:
{$base_url}

Query by entity details

		    <form method='get' action="{$base_url}/_search">
		      Format
		      <select name="_format">
			<option value="xml">XML</option>
			<option value="json">JSON</option>
		      </select>

		      {
			switch ($entity)
			case "Practitioner" return  page:search_practitioner_parameters_html($org_opts,$fac_opts)
			case "Location" return  page:search_location_parameters_html($org_opts)
			case "Organization" return  page:search_organization_parameters_html($org_opts)
			default return ()
		      }
		      <input type='submit' />
		    </form>

		  ,

	            History
		     XML
		    / JSON

Query by last modified time

		    <form method='get' action="{$base_url}/_history">
		      Format
		      <select name="_format">
			<option value="xml">XML</option>
			<option value="json">JSON</option>
		      </select>

		      Updated
		      <input  size="35" id="datetimepicker_xml"    name='_since' type="text" value=""/>

		      <input type='submit' />
		    </form>

	        )
            else ()
	  }
	  {
	    if ($valueset)
	    then
	      let $entity := string($valueset/@type)
	      let $base_url := concat($csd_webconf:baseurl, "CSD/csr/",$doc_name ,"/careServicesRequest/",$search_name, "/adapter/fhir/", $entity , "/valueset")
              return

	        Definition

Get valueset definition

		<form method='get' action="{$base_url}">
		  Format
		  <select name="_format">
	            <option value="xml">XML</option>
	            <option value="json">JSON</option>
		  </select>

		  {
		     page:search_valueset_parameters_html($org_opts)
		  }
		  <input type='submit' />
		</form>

            else ()
	  }

      return csd_webconf:wrapper($contents,$headers)
};

declare
  %rest:path("/CSD/csr/{$doc_name}/careServicesRequest/{$search_name}/adapter/fhir/{$entityType}/{$id}")
  %rest:query-param("_format","{$format}","application/xml+fhir")
  function page:read_entity($search_name,$doc_name,$entityType,$format,$id)
{

  let $function := csr_proc:get_function_definition($csd_webconf:db,$search_name)
  let $fEntityType :=   string(($function/csd:extension[@urn='urn:openhie.org:openinfoman:adapter:fhir:read' ])[1]/@type)
  return
    if (not(fadpt:is_fhir_function($search_name)) or not($fEntityType = $entityType))
    (:not a valid read query. should 404 or whatever is required by FHIR :)
  then ()
  else
    let $doc := csd_dm:open_document($csd_webconf:db,$doc_name)
    let $requestParams :=
      <csd:requestParams function="{$search_name}" resource="{$doc_name}" base_url="{$csd_webconf:baseurl}">
	<id>{$id}</id>
      </csd:requestParams>

    let $entities := (csr_proc:process_CSR_stored_results($csd_webconf:db, $doc,$requestParams))[1] (:make sure there is only one:)
    let $resource := fadpt:format_entities($doc,$entities,$entityType,$format)
    return
      if ($format = ('application/json+fhir' ,  'application/json' ,'json'))
      then
        (
        <rest:response>
	  <output:serialization-parameters>
	    <output:media-type value='application/json'/>
	  </output:serialization-parameters>
	</rest:response>
	,$resource
        )
      else
	$resource
};

declare
  %rest:path("/CSD/csr/{$doc_name}/careServicesRequest/{$search_name}/adapter/fhir/{$entityType}/_search")
  %rest:query-param("_format","{$format}","application/xml+fhir")
  function page:search_entity2($search_name,$doc_name,$entityType,$format)
{
  page:search_entity($search_name,$doc_name,$entityType,$format)
};

declare
  %rest:path("/CSD/csr/{$doc_name}/careServicesRequest/{$search_name}/adapter/fhir/{$entityType}")
  %rest:query-param("_format","{$format}","application/xml+fhir")
  function page:search_entity($search_name,$doc_name,$entityType,$format)
{
  let $function := csr_proc:get_function_definition($csd_webconf:db,$search_name)
  let $fEntityType :=   string(($function/csd:extension[@urn='urn:openhie.org:openinfoman:adapter:fhir:read' ])[1]/@type)
  return
    if (not(fadpt:is_fhir_function($search_name)) or not($fEntityType = $entityType))
    (:not a valid read query. should 404 or whatever is required by FHIR :)
  then ()
  else
    let $doc := csd_dm:open_document($csd_webconf:db,$doc_name)
    let $requestParams :=
	<csd:requestParams function="{$search_name}" resource="{$doc_name}" base_url="{$csd_webconf:baseurl}"> >
	  {
	    switch ($entityType)
	    case "Practitioner" return  page:search_practitioner_parameters()
	    case "Location" return   page:search_location_parameters()
	    case "Organization" return 	page:search_organization_parameters()
	    default return ()
	  }
	</csd:requestParams>

    let $entities := (csr_proc:process_CSR_stored_results($csd_webconf:db, $doc,$requestParams))
    let $resources := fadpt:format_entities($doc,$entities,$entityType,$format)
    return
      if ($format = ('application/json+fhir' ,  'application/json' ,'json'))
      then fadpt:create_feed_from_entities_JSON($resources,$requestParams)
      else fadpt:create_feed_from_entities($resources,$requestParams)
};

declare
  %rest:path("/CSD/csr/{$doc_name}/careServicesRequest/{$search_name}/adapter/fhir/{$entityType}/valueset")
  %rest:query-param("_format","{$format}","application/xml+fhir")
  function page:valueset_entity($search_name,$doc_name,$entityType,$format)
{
  let $function := csr_proc:get_function_definition($csd_webconf:db,$search_name)
  let $fEntityType :=   string(($function/csd:extension[@urn='urn:openhie.org:openinfoman:adapter:fhir:valueset' ])[1]/@type)
  return
    if (not(fadpt:is_fhir_function($search_name)) or not($fEntityType = $entityType))
    (:not a valid read query. should 404 or whatever is required by FHIR :)
  then ()
  else
    let $doc := csd_dm:open_document($csd_webconf:db,$doc_name)
    let $requestParams :=
	<csd:requestParams  function="{$search_name}" resource="{$doc_name}" base_url="{$csd_webconf:baseurl}">
	  {
	    page:search_valueset_parameters()
	  }
	</csd:requestParams>

    let $valueset := (csr_proc:process_CSR_stored_results($csd_webconf:db, $doc,$requestParams))
    return $valueset
};

declare
  %rest:path("/CSD/csr/{$doc_name}/careServicesRequest/{$search_name}/adapter/fhir/{$entityType}/_history")
  %rest:query-param("_format","{$format}","application/xml+fhir")
  function page:history_entity($search_name,$doc_name,$entityType,$format)
{
  let $function := csr_proc:get_function_definition($csd_webconf:db,$search_name)
  let $fEntityType :=   string(($function/csd:extension[@urn='urn:openhie.org:openinfoman:adapter:fhir:read' ])[1]/@type)
  return
    if (not(fadpt:is_fhir_function($search_name)) or not($fEntityType = $entityType))
    (:not a valid read query. should 404 or whatever is required by FHIR :)
  then ()
  else
    let $doc := csd_dm:open_document($csd_webconf:db,$doc_name)
    let $requestParams :=
	<csd:requestParams  function="{$search_name}" resource="{$doc_name}" base_url="{$csd_webconf:baseurl}">
	  {page:history_global_parameters() }
	</csd:requestParams>

    let $entities := (csr_proc:process_CSR_stored_results($csd_webconf:db, $doc,$requestParams))
    let $resources := fadpt:format_entities($doc,$entities,$entityType,$format)
    return
      if ($format = ('application/json+fhir' ,  'application/json' ,'json'))
      then fadpt:create_feed_from_entities_JSON($resources,$requestParams)
      else fadpt:create_feed_from_entities($resources,$requestParams)

};

declare function page:search_global_parameters()
{
  let $params := request:parameter-names()
  return
    (
      if ("_id" = $params)
      then <fhir:_id>{request:parameter("_id")}</fhir:_id>
      else ()
      ,
      if ("_count" = $params)
      then <fhir:_count>{request:parameter("_count")}</fhir:_count>
      else ()
      ,
      if ("page" = $params)
      then <page>{request:parameter("page")}</page>
      else ()
    )
};

declare function page:search_practitioner_parameters(){
  let $params := request:parameter-names()
  return
    (
      page:search_global_parameters()
      ,
      if ("name.text" = $params)
      then <fhir:name><fhir:text>{request:parameter("name.text")}</fhir:text></fhir:name>
      else (),
      if ("organization.reference" = $params)
      then <fhir:organization value="{request:parameter('organization.reference')}"/>
      else (),
      if ("location.reference" = $params)
      then <fhir:location value="{request:parameter('location.reference')}"/>
      else ()

  )

};

declare function page:search_practitioner_parameters_html($org_opts,$fac_opts){

    Common Name
    <input  size="35"    name='name.text' type="text" value=""/>

    Organization
    <select name="organization.reference">
      <option value="">Select A Value</option>
      {$org_opts}
    </select>

    Facility
    <select name="location.reference">
      <option value="">Select A Value</option>
      {$fac_opts}
    </select>

};

declare function page:search_organization_parameters(){
  let $params := request:parameter-names()
  return
    (

      page:search_global_parameters()
      ,
      if ("name" = $params)
      then <fhir:name>{request:parameter("name")}</fhir:name>
      else (),
      if ("partOf.reference" = $params)
      then <fhir:partOf value="{request:parameter('partOf.reference')}"/>
      else ()

  )
};

declare function page:search_organization_parameters_html($org_opts){

    Name
    <input  size="35"    name='name' type="text" value=""/>

    Parent Organization
    <select name="partOf.reference">
      <option value="">Select A Value</option>
      {$org_opts}
    </select>

};

declare function page:search_valueset_parameters(){
  let $params := request:parameter-names()
  return
    (
      if ("_id" = $params)
      then <fhir:_id>{request:parameter("_id")}</fhir:_id>
      else ()
	,
      if ("_query" = $params)
      then <fhir:_query value="{request:parameter('_query')}"/>
      else ()

  )
};

declare function page:search_valueset_parameters_html($org_opts){

     Organization
    <select name="_id">
      <option value="">Base Definition</option>
      {$org_opts}
    </select>
     Query Action
    <select name="_query">
      <option value="">Select A Value</option>
      <option value="expand">Value Set Expansion</option>
    </select>

};

declare function page:search_location_parameters(){
  let $params := request:parameter-names()
  return
    (
      page:search_global_parameters()
      ,
      if ("name" = $params)
      then <fhir:name>{request:parameter("name")}</fhir:name>
      else (),
      if ("managingOrganization.reference" = $params)
      then <fhir:managingOrganization value="{request:parameter('managingOrganization.reference')}"/>
      else ()
  )

};

declare function page:search_location_parameters_html($org_opts){

    Name
    <input  size="35"    name='name' type="text" value=""/>

    Managing Organization
    <select name="managingOrganization.reference">
      <option value="">Select A Value</option>
      {$org_opts}
    </select>

};

declare function page:history_global_parameters()
{
  let $params := request:parameter-names()
  return
    (
      if ("_since" = $params)
      then <fhir:_since>{request:parameter("_since")}</fhir:_since>
      else ()
      ,
      if ("_count" = $params)
      then <fhir:_count>{request:parameter("_count")}</fhir:_count>
      else ()
      ,
      if ("page" = $params)
      then <page>{request:parameter("page")}</page>
      else ()
    )
};

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

(:Import other namespaces.  :)
import module namespace csd_webconf =  "https://github.com/openhie/openinfoman/csd_webconf";
import module namespace csr_proc = "https://github.com/openhie/openinfoman/csr_proc";
import module namespace csd_dm = "https://github.com/openhie/openinfoman/csd_dm";
import module namespace fadpt = "https://github.com/openhie/openinfoman/adapter/fhir";
import module namespace request = "http://exquery.org/ns/request";

declare namespace xs = "http://www.w3.org/2001/XMLSchema";
declare namespace csd = "urn:ihe:iti:csd:2013";
declare namespace   xforms = "http://www.w3.org/2002/xforms";
declare namespace fhir = "http://hl7.org/fhir";

declare
  %rest:path("/CSD/csr/{$doc_name}/careServicesRequest/{$search_name}/adapter/fhir")
  %output:method("xhtml")
  function page:show_endpoints($search_name,$doc_name)
{
  let $function := csr_proc:get_function_definition($csd_webconf:db,$search_name)
  let $read :=  ($function/csd:extension[@urn='urn:openhie.org:openinfoman:adapter:fhir:read' ])[1]
  let $valueset :=  ($function/csd:extension[@urn='urn:openhie.org:openinfoman:adapter:fhir:valueset' ])[1]
  let $doc := csd_dm:open_document($csd_webconf:db,$doc_name)
  let $org_opts :=
    for $org in $doc/csd:CSD/csd:organizationDirectory/csd:organization
    return <option value="{$org/@entityID}">{($org/csd:primaryName[1])/text()}</option>
  let $fac_opts :=
    for $fac in $doc/csd:CSD/csd:facilityDirectory/csd:facility
    return <option value="{$fac/@entityID}">{($fac/csd:primaryName[1])/text()}</option>

  return
    if (not(fadpt:is_fhir_function($search_name)))
      (:not a read practitioner query. should 404 or whatever is required by FHIR :)
    then ('Not a FHIR Compatible stored function'    )
    else
      let $headers :=
	(
	<link rel="stylesheet" type="text/css" media="screen"   href="{$csd_webconf:baseurl}static/bootstrap-datetimepicker/css/bootstrap-datetimepicker.min.css"/>
	,
	 )

      let $contents :=

{$doc_name}

	  {
	    if ($read)
	    then
	      let $entity := string($read/@type)
	      let $base_url := concat($csd_webconf:baseurl, "CSD/csr/",$doc_name ,"/careServicesRequest/",$search_name, "/adapter/fhir/", $entity)
              return
		(

	            Search {$entity}
		     XML
		    / JSON

Resource Endpoint:
{$base_url}

Query by entity details

		    <form method='get' action="{$base_url}/_search">
		      Format
		      <select name="_format">
			<option value="xml">XML</option>
			<option value="json">JSON</option>
		      </select>

		      {
			switch ($entity)
			case "Practitioner" return  page:search_practitioner_parameters_html($org_opts,$fac_opts)
			case "Location" return  page:search_location_parameters_html($org_opts)
			case "Organization" return  page:search_organization_parameters_html($org_opts)
			default return ()
		      }
		      <input type='submit' />
		    </form>

		  ,

	            History
		     XML
		    / JSON

Query by last modified time

		    <form method='get' action="{$base_url}/_history">
		      Format
		      <select name="_format">
			<option value="xml">XML</option>
			<option value="json">JSON</option>
		      </select>

		      Updated
		      <input  size="35" id="datetimepicker_xml"    name='_since' type="text" value=""/>

		      <input type='submit' />
		    </form>

	        )
            else ()
	  }
	  {
	    if ($valueset)
	    then
	      let $entity := string($valueset/@type)
	      let $base_url := concat($csd_webconf:baseurl, "CSD/csr/",$doc_name ,"/careServicesRequest/",$search_name, "/adapter/fhir/", $entity , "/valueset")
              return

	        Definition

Get valueset definition

		<form method='get' action="{$base_url}">
		  Format
		  <select name="_format">
	            <option value="xml">XML</option>
	            <option value="json">JSON</option>
		  </select>

		  {
		     page:search_valueset_parameters_html($org_opts)
		  }
		  <input type='submit' />
		</form>

            else ()
	  }

      return csd_webconf:wrapper($contents,$headers)
};

declare
  %rest:path("/CSD/csr/{$doc_name}/careServicesRequest/{$search_name}/adapter/fhir/{$entityType}/{$id}")
  %rest:query-param("_format","{$format}","application/xml+fhir")
  function page:read_entity($search_name,$doc_name,$entityType,$format,$id)
{

  let $function := csr_proc:get_function_definition($csd_webconf:db,$search_name)
  let $fEntityType :=   string(($function/csd:extension[@urn='urn:openhie.org:openinfoman:adapter:fhir:read' ])[1]/@type)
  return
    if (not(fadpt:is_fhir_function($search_name)) or not($fEntityType = $entityType))
    (:not a valid read query. should 404 or whatever is required by FHIR :)
  then ()
  else
    let $doc := csd_dm:open_document($csd_webconf:db,$doc_name)
    let $careServicesRequest :=
      <csd:careServicesRequest >
	<csd:function urn="{$search_name}" resource="{$doc_name}" base_url="{$csd_webconf:baseurl}">
	  <csd:requestParams >
	    <id>{$id}</id>
	  </csd:requestParams>
	</csd:function>
      </csd:careServicesRequest>
    let $entities := (csr_proc:process_CSR_stored_results($csd_webconf:db, $doc,$careServicesRequest))[1] (:make sure there is only one:)
    let $resource := fadpt:format_entities($doc,$entities,$entityType,$format)
    return
      if ($format = ('application/json+fhir' ,  'application/json' ,'json'))
      then
        (
        <rest:response>
	  <output:serialization-parameters>
	    <output:media-type value='application/json'/>
	  </output:serialization-parameters>
	</rest:response>
	,$resource
        )
      else
	$resource
};

declare
  %rest:path("/CSD/csr/{$doc_name}/careServicesRequest/{$search_name}/adapter/fhir/{$entityType}/_search")
  %rest:query-param("_format","{$format}","application/xml+fhir")
  function page:search_entity2($search_name,$doc_name,$entityType,$format)
{
  page:search_entity($search_name,$doc_name,$entityType,$format)
};

declare
  %rest:path("/CSD/csr/{$doc_name}/careServicesRequest/{$search_name}/adapter/fhir/{$entityType}")
  %rest:query-param("_format","{$format}","application/xml+fhir")
  function page:search_entity($search_name,$doc_name,$entityType,$format)
{
  let $function := csr_proc:get_function_definition($csd_webconf:db,$search_name)
  let $fEntityType :=   string(($function/csd:extension[@urn='urn:openhie.org:openinfoman:adapter:fhir:read' ])[1]/@type)
  return
    if (not(fadpt:is_fhir_function($search_name)) or not($fEntityType = $entityType))
    (:not a valid read query. should 404 or whatever is required by FHIR :)
  then ()
  else
    let $doc := csd_dm:open_document($csd_webconf:db,$doc_name)
    let $requestParams :=
      <csd:function urn="{$search_name}" resource="{$doc_name}" base_url="{$csd_webconf:baseurl}">
	<csd:requestParams >
	  {
	    switch ($entityType)
	    case "Practitioner" return  page:search_practitioner_parameters()
	    case "Location" return   page:search_location_parameters()
	    case "Organization" return 	page:search_organization_parameters()
	    default return ()
	  }
	</csd:requestParams>
      </csd:function>

    let $careServicesRequest :=   <csd:careServicesRequest >{$requestParams}</csd:careServicesRequest>
    let $entities := (csr_proc:process_CSR_stored_results($csd_webconf:db, $doc,$careServicesRequest))
    let $resources := fadpt:format_entities($doc,$entities,$entityType,$format)
    return
      if ($format = ('application/json+fhir' ,  'application/json' ,'json'))
      then fadpt:create_feed_from_entities_JSON($resources,$requestParams)
      else fadpt:create_feed_from_entities($resources,$requestParams)
};

declare
  %rest:path("/CSD/csr/{$doc_name}/careServicesRequest/{$search_name}/adapter/fhir/{$entityType}/valueset")
  %rest:query-param("_format","{$format}","application/xml+fhir")
  function page:valueset_entity($search_name,$doc_name,$entityType,$format)
{
  let $function := csr_proc:get_function_definition($csd_webconf:db,$search_name)
  let $fEntityType :=   string(($function/csd:extension[@urn='urn:openhie.org:openinfoman:adapter:fhir:valueset' ])[1]/@type)
  return
    if (not(fadpt:is_fhir_function($search_name)) or not($fEntityType = $entityType))
    (:not a valid read query. should 404 or whatever is required by FHIR :)
  then ()
  else
    let $doc := csd_dm:open_document($csd_webconf:db,$doc_name)
    let $requestParams :=
      <csd:function urn="{$search_name}" resource="{$doc_name}" base_url="{$csd_webconf:baseurl}">
	<csd:requestParams >
	  {
	    page:search_valueset_parameters()
	  }
	</csd:requestParams>
      </csd:function>

    let $careServicesRequest :=   <csd:careServicesRequest >{$requestParams}</csd:careServicesRequest>
    let $valueset := (csr_proc:process_CSR_stored_results($csd_webconf:db, $doc,$careServicesRequest))
    return $valueset
};

declare
  %rest:path("/CSD/csr/{$doc_name}/careServicesRequest/{$search_name}/adapter/fhir/{$entityType}/_history")
  %rest:query-param("_format","{$format}","application/xml+fhir")
  function page:history_entity($search_name,$doc_name,$entityType,$format)
{
  let $function := csr_proc:get_function_definition($csd_webconf:db,$search_name)
  let $fEntityType :=   string(($function/csd:extension[@urn='urn:openhie.org:openinfoman:adapter:fhir:read' ])[1]/@type)
  return
    if (not(fadpt:is_fhir_function($search_name)) or not($fEntityType = $entityType))
    (:not a valid read query. should 404 or whatever is required by FHIR :)
  then ()
  else
    let $doc := csd_dm:open_document($csd_webconf:db,$doc_name)
    let $requestParams :=
      <csd:function urn="{$search_name}" resource="{$doc_name}" base_url="{$csd_webconf:baseurl}">
	<csd:requestParams >
	  {page:history_global_parameters() }
	</csd:requestParams>
      </csd:function>

    let $careServicesRequest :=   <csd:careServicesRequest >{$requestParams}</csd:careServicesRequest>
    let $entities := (csr_proc:process_CSR_stored_results($csd_webconf:db, $doc,$careServicesRequest))
    let $resources := fadpt:format_entities($doc,$entities,$entityType,$format)
    return
      if ($format = ('application/json+fhir' ,  'application/json' ,'json'))
      then fadpt:create_feed_from_entities_JSON($resources,$requestParams)
      else fadpt:create_feed_from_entities($resources,$requestParams)

};

declare function page:search_global_parameters()
{
  let $params := request:parameter-names()
  return
    (
      if ("_id" = $params)
      then <fhir:_id>{request:parameter("_id")}</fhir:_id>
      else ()
      ,
      if ("_count" = $params)
      then <fhir:_count>{request:parameter("_count")}</fhir:_count>
      else ()
      ,
      if ("page" = $params)
      then <page>{request:parameter("page")}</page>
      else ()
    )
};

declare function page:search_practitioner_parameters(){
  let $params := request:parameter-names()
  return
    (
      page:search_global_parameters()
      ,
      if ("name.text" = $params)
      then <fhir:name><fhir:text>{request:parameter("name.text")}</fhir:text></fhir:name>
      else (),
      if ("organization.reference" = $params)
      then <fhir:organization value="{request:parameter('organization.reference')}"/>
      else (),
      if ("location.reference" = $params)
      then <fhir:location value="{request:parameter('location.reference')}"/>
      else ()

  )

};

declare function page:search_practitioner_parameters_html($org_opts,$fac_opts){

    Common Name
    <input  size="35"    name='name.text' type="text" value=""/>

    Organization
    <select name="organization.reference">
      <option value="">Select A Value</option>
      {$org_opts}
    </select>

    Facility
    <select name="location.reference">
      <option value="">Select A Value</option>
      {$fac_opts}
    </select>

};

declare function page:search_organization_parameters(){
  let $params := request:parameter-names()
  return
    (

      page:search_global_parameters()
      ,
      if ("name" = $params)
      then <fhir:name>{request:parameter("name")}</fhir:name>
      else (),
      if ("partOf.reference" = $params)
      then <fhir:partOf value="{request:parameter('partOf.reference')}"/>
      else ()

  )
};

declare function page:search_organization_parameters_html($org_opts){

    Name
    <input  size="35"    name='name' type="text" value=""/>

    Parent Organization
    <select name="partOf.reference">
      <option value="">Select A Value</option>
      {$org_opts}
    </select>

};

declare function page:search_valueset_parameters(){
  let $params := request:parameter-names()
  return
    (
      if ("_id" = $params)
      then <fhir:_id>{request:parameter("_id")}</fhir:_id>
      else ()
	,
      if ("_query" = $params)
      then <fhir:_query value="{request:parameter('_query')}"/>
      else ()

  )
};

declare function page:search_valueset_parameters_html($org_opts){

     Organization
    <select name="_id">
      <option value="">Base Definition</option>
      {$org_opts}
    </select>
     Query Action
    <select name="_query">
      <option value="">Select A Value</option>
      <option value="expand">Value Set Expansion</option>
    </select>

};

declare function page:search_location_parameters(){
  let $params := request:parameter-names()
  return
    (
      page:search_global_parameters()
      ,
      if ("name" = $params)
      then <fhir:name>{request:parameter("name")}</fhir:name>
      else (),
      if ("managingOrganization.reference" = $params)
      then <fhir:managingOrganization value="{request:parameter('managingOrganization.reference')}"/>
      else ()
  )

};

declare function page:search_location_parameters_html($org_opts){

    Name
    <input  size="35"    name='name' type="text" value=""/>

    Managing Organization
    <select name="managingOrganization.reference">
      <option value="">Select A Value</option>
      {$org_opts}
    </select>

};

declare function page:history_global_parameters()
{
  let $params := request:parameter-names()
  return
    (
      if ("_since" = $params)
      then <fhir:_since>{request:parameter("_since")}</fhir:_since>
      else ()
      ,
      if ("_count" = $params)
      then <fhir:_count>{request:parameter("_count")}</fhir:_count>
      else ()
      ,
      if ("page" = $params)
      then <page>{request:parameter("page")}</page>
      else ()
    )
};


scanner put inplace q01 is two lines again

let $auction := doc("auctionG.xml") return
for $b in $auction/site/people/person[@id = "person0"] return $b/name/text()


Update check-element.xquery

Update check-element.xquery

(:
Last updated: November 5, 2014>
Author: Annie Glerum
Organization: Florida State University
Title: Check lines
Use these patterns to check individual elements in the source-pdfdata.xml file.
:)

declare boundary-space preserve;

<records>{
for $record in records/record return
    <record>{
let $title := $record/title
(: Create other variables as needed :)
(:
let $author := $record/author
let $awarded := $record/awarded
:)
return
        <title>{string($title)}</title>
(: Create other elements as needed :)
(:
        <author>{string($author)}</author>
        <awarded>{string($awarded)}</awarded>
:)
}   </record>
}</records>

(:
Last updated: November 5, 2014>
Author: Annie Glerum
Organization: Florida State University
Title: Check lines
Use these patterns to check individual elements in the source-pdfdata.xml file.
:)

declare boundary-space preserve;

<records>{
for $records in records/record return
    <record>{
for $record in $records
let $record := $records/record
let $title := $record/title
(: Create other variables as needed :)
(:
let $author := $record/author
let $awarded := $record/awarded
:)
return
        <title>{string($title)}</title>
(: Create other elements as needed :)
(:
        <author>{string($author)}</author>
        <awarded>{string($awarded)}</awarded>
:)
}   </record>
}</records>


home page

home page

(:~
 : This module contains a sample RESTXQ function
 : @copyright Quodatum
 : @license Apache
 : @author Andy Bunce
 :)
module namespace page = 'https://github.com/Quodatum/openshift-basex-quick-start';
declare default function namespace 'https://github.com/Quodatum/openshift-basex-quick-start';
import module namespace env = 'quodatum.basex.env';

(:~
 : This function generates the welcome page.
 : @return HTML page
 :)
declare
  %rest:path("")
  %output:method("html")
  %output:version("5.0")
   function page:start()
  as element(html)
{

 	<meta charset="utf-8"/>
    <meta http-equiv="X-UA-Compatible" content="IE=edge"/>
    <meta name="viewport" content="width=device-width, initial-scale=1"/>
    <meta name="description" content="BaseX Openshift quickstart"/>
    <meta name="author" content="andy bunce"/>
	<title>BaseX Openshift quickstart</title>
	<link href="//cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/3.0.3/css/bootstrap.css" rel="stylesheet" type="text/css" />

            OpenShift BaseX Quick start

BaseX

version: {env:basex-version()}

Uptime: {env:jvmUptime()}

	{panel("Applications",DBA)}

        {
        let $props:=property-table(env:about())
 		return panel("Environment Java Properties",$props)
 		}

};

declare function property-table($map){

Name	Value

{for $key in map:keys($map)
 order by $key
 return
{$key}
          {map:get($map,$key)}

}

};

declare function panel($title,$body){

{$title}

    {$body}

};

(:~
 : This module contains a sample RESTXQ function
 : @copyright Quodatum
 : @license Apache
 : @author Andy Bunce
 :)
module namespace page = 'https://github.com/Quodatum/openshift-basex-quick-start';
declare default function namespace 'https://github.com/Quodatum/openshift-basex-quick-start';

declare namespace sys="java.lang.System";
declare namespace Runtime="java.lang.Runtime";
declare variable $page:core:=(
            "java.version","java.vendor","java.vm.version",
            "os.name","os.version","os.arch");

(:~
 : This function generates the welcome page.
 : @return HTML page
 :)
declare
  %rest:path("")
  %output:method("html")
  %output:version("5.0")
   function page:start()
  as element(html)
{

 	<meta charset="utf-8"/>
    <meta http-equiv="X-UA-Compatible" content="IE=edge"/>
    <meta name="viewport" content="width=device-width, initial-scale=1"/>
    <meta name="description" content="BaseX Openshift quickstart"/>
    <meta name="author" content="andy bunce"/>
	<title>BaseX Openshift quickstart</title>
	<link href="//cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/3.0.3/css/bootstrap.css" rel="stylesheet" type="text/css" />

            BaseX

version: {basex-version()}

Quick start for Openshift

        {
        let $props:=property-table(about())
 		return panel("Environment Java Properties",$props)
 		}

};

(:~ @return BaseX version string :)
declare function basex-version() as xs:string{
db:system()/generalinformation/version
};

(:
 : memory status
 :http://javarevisited.blogspot.co.uk/2012/01/find-max-free-total-memory-in-java.html
:)
declare function memory()as map(*){
map{
    "memory.free":prof:human(Runtime:freeMemory(Runtime:getRuntime())),
    "memory.max":prof:human(Runtime:maxMemory(Runtime:getRuntime())),
    "memory.total":prof:human(Runtime:totalMemory(Runtime:getRuntime()))
    }
};

(:~ useful java properties :)
declare function about() as map(*){
 let $c:= map:merge($page:core!map:entry(.,sys:getProperty(.)))
 return map:merge(($c,memory()))
};

declare function property-table($map){

Name	Value

{for $key in map:keys($map)
 order by $key
 return
{$key}
          {map:get($map,$key)}

}

};

declare function panel($title,$body){

{$title}

    {$body}

};


old cmd-stats script obsoleted by crday:query-internal()

(: OBSOLETED by crday:query-internal() :)
let $doc-name := xmldb:store("/db/mdrepo-data/", "stats_cmdi-providers.xml", <result></result>),
    $doc := doc($doc-name),
    (:    $ns-uri := namespace-uri($context[1]/*), :)
            (: dynamically declare a namespace for the next step, if one is defined in current context :)
    (: $dummy := if (exists($ns-uri)) then util:declare-namespace("",$ns-uri) else () :)
    $dummy := util:declare-namespace("",xs:anyURI("http://www.clarin.eu/cmd/")),
    $collection := collection("/db/mdrepo-data/cmdi-providers"),
$items := (<item key="C" label="CMD" >count($collection//CMD)</item> ,
<item key="C.-handle" label="CMD without MdSelfLink" >count($collection//CMD[not(Header/MdSelfLink)])</item>,
<item key="C.0" label="CMD without " >count($collection//CMD[not(.//ResourceType='Resource')][not(.//ResourceType='Metadata')])</item>,
<item key="C.R+M" label="CMD with MD and Res" >count(($collection//CMD[.//ResourceType='Resource'][.//ResourceType='Metadata']))</item>,
<item key="C.R" label="CMD with Resource" >count($collection//CMD[.//ResourceType='Resource'])</item>,
<item key="C.R.0" label="CMD - with Resource empty">count($collection//CMD[.//ResourceType='Resource'][.//ResourceRef[. = ""]])</item>,
<item key="C.R.1" label="CMD with relative Resource (starts-with('.'))" >count($collection//CMD[.//ResourceType='Resource'][starts-with(.//normalize-space(ResourceRef),'.')])</item>,
<item key="C.R.2" label="CMD with http-uri Resource" >count($collection//CMD[.//ResourceType='Resource'][starts-with(.//normalize-space(ResourceRef),'http')])</item>,
<item key="C.R.1+2" label="CMD - with relative and http Resource">count($collection//CMD[.//ResourceType='Resource'][starts-with(.//ResourceRef,'.')][starts-with(.//normalize-space(ResourceRef),'http')])</item>,
<item key="C.R.3" label="CMD - Resource only filename (not empty, no '/')" >count($collection//CMD[.//ResourceProxy[ResourceType='Resource'][ResourceRef[not(. = "")][not(contains(.,'/'))]]])</item>,
<item key="RP.R" label="ResourceProxy - Resource" >count(//ResourceProxy[ResourceType='Resource'])</item>,

<item key="C.cc.self" label="CMD with IsPartOf=MdSelfLink" >count($collection//CMD[.//MdSelfLink=.//IsPartOf])</item>,
<item key="C.cc.link-match" label="CMD with MdSelfLink=ResourceRef" >count($collection//MdSelfLink[. = $collection//ResourceProxy[ResourceType eq 'Metadata']/ResourceRef])</item>,
<item key="C.cc.orphans" label="CMD with orphaned MdSelfLink" >count($collection//MdSelfLink[not(. = $collection//ResourceProxy[ResourceType eq 'Metadata']/ResourceRef)])</item>,
<item key="C.cc.deadlinks" label="CMD with dead Metadata-ResourceRef" >count($collection//ResourceRef[not(. =  $collection//MdSelfLink)][../ResourceType eq 'Metadata'])</item>,

<item key="C.M" label="CMD with Metadata = Collections" >count($collection//CMD[.//ResourceType='Metadata'])</item>,
<item key="C.M.1" label="CMD with relative MD" >count($collection//CMD[.//ResourceType='Metadata'][starts-with(.//normalize-space(ResourceRef),'.')])</item>,
<item key="C.M.2" label="CMD with http-uri MD" >count($collection//CMD[.//ResourceType='Metadata'][starts-with(.//normalize-space(ResourceRef),'http')])</item>
)
let $upd-dummy :=
        for $item in $items
            let $start-time := util:system-dateTime()
            let $answer := util:eval($item/text())
            let $duration := util:system-dateTime() - $start-time
           return update insert <item key="{$item/@key}" label="{$item/@label}" dur="{$duration}">{$answer}</item> into $doc/result

return $doc

(: <item key="C.R.3" label="CMD - Resource not empty, not relative, not http">5100</item>
  <item label="CMD - Resource not relative, not http" >count(//CMD[.//ResourceType='Resource'][not(starts-with(.//ResourceRef,'.'))][not(starts-with(.//ResourceRef,'http'))])</item>,

 ,
<item key="C.0" label="CMD without " >count(//CMD[not(.//ResourceType='Resource')][not(.//ResourceType='Metadata')])</item>,
<item key="C.R+M" label="CMD with MD and Res" >count((//CMD[.//ResourceType='Resource'][.//ResourceType='Metadata']))</item>,
<item key="C.R" label="CMD with Resource" >count(//CMD[.//ResourceType='Resource'])</item>,
<item key="C.R.0" label="CMD - with Resource empty">count(//CMD[.//ResourceType='Resource'][.//ResourceRef[. = ""]])</item>,
<item key="C.R.1" label="CMD with relative Resource (starts-with('.'))" >count(//CMD[.//ResourceType='Resource'][starts-with(.//ResourceRef,'.')])</item>,
<item key="C.R.2" label="CMD with http-uri Resource" >count(//CMD[.//ResourceType='Resource'][starts-with(.//ResourceRef,'http')])</item>,
<item key="C.R.1+2" label="CMD - with relative and http Resource">count(//CMD[.//ResourceType='Resource'][starts-with(.//ResourceRef,'.')][starts-with(.//ResourceRef,'http')])</item>,
<item key="C.R.3" label="CMD - Resource only filename (not empty, no '/')" >count(//CMD[.//ResourceProxy[ResourceType='Resource'][ResourceRef[not(. = "")][not(contains(.,'/'))]]])</item>,
<item key="RP.R" label="ResourceProxy - Resource" >count(//ResourceProxy[ResourceType='Resource'])</item>,

<item key="C.M" label="CMD with Metadata = Collections" >count(//CMD[.//ResourceType='Metadata'])</item>,
<item key="C.M.1" label="CMD with relative MD" >count(//CMD[.//ResourceType='Metadata'][starts-with(.//ResourceRef,'.')])</item>,
<item key="C.M.2" label="CMD with http-uri MD" >count(//CMD[.//ResourceType='Metadata'][starts-with(.//ResourceRef,'http')])</item>,

<item key="RP.M" label="ResourceProxy - Metadata" >count(//ResourceProxy[ResourceType='Metadata'])</item>,

<item key="C..3" label="CMD - only filename (not empty, no '/')" >count(//CMD[.//ResourceRef[not(. = "")][not(contains(.,'/'))]])</item>,
<item key="RR.3" label="ResourceRef only filename (not empty, no '/')" >count(//ResourceRef[not(. = "")][not(contains(.,'/'))])</item>,
<item key="C..RR.0" label="CMD - empty ResourceRef">count(//CMD[.//ResourceRef[. = ""]])</item>,
<item key="RR.0 label="ResourceRef empty">count(//ResourceRef[. = ""])</item>,
<item key="C..RR.0+1" label="CMD - empty and non-empty ResourceRef">count((//CMD[.//ResourceRef[. = ""]][.//ResourceRef[not(. = "")]]))</item>
 :)


prevent a document from getting added multiple times in the document manager

(:~
: This is the Care Services Discovery stored query registry
: @version 1.0
: @see https://github.com/openhie/openinfoman
:
:)
module namespace csd_dm = "https://github.com/openhie/openinfoman/csd_dm";

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

declare variable $csd_dm:document_manager := 'csd_docs.xml';

declare function csd_dm:blank_directory()
{
<CSD xmlns:csd="urn:ihe:iti:csd:2013" xmlns="urn:ihe:iti:csd:2013">
  <organizationDirectory/>
  <serviceDirectory/>
  <facilityDirectory/>
  <providerDirectory/>
</CSD>
};

declare  function csd_dm:document_source_exists($db,$name) {
  let $source := csd_dm:document_source($name)
  return  if ($source) then (db:is-xml($db,$source)) else false()

};

declare  function csd_dm:open_document($db,$name) {
  if (csd_dm:document_source_exists($db,$name)) then
    db:open($db,csd_dm:document_source($name))
  else
    csd_dm:blank_directory()
};

declare updating function csd_dm:add($db,$doc,$name) {
  csd_dm:empty($db,$name,$doc)
};

declare updating function csd_dm:delete($db,$name) {
  db:delete($db,csd_dm:document_source($name))
};

declare updating function csd_dm:empty($db,$name) {
  csd_dm:empty($db,$name,csd_dm:blank_directory())
};

declare updating function csd_dm:empty($db,$name,$doc) {
  let $source := csd_dm:document_source($name)
  return
    if (csd_dm:document_source_exists($db,$name)) then
      db:replace($db,$source,$doc)
    else
      db:add($db,$doc,$source)

};

declare function csd_dm:registered_documents($db) {
(:  db:list($db,"service_directories/*") :)
  for $doc in db:list($db,"service_directories")
  let $name := csd_dm:fn_base_name($doc,'.xml')
  return $name
};

declare function csd_dm:document_source($name) {
  concat("service_directories/",$name,".xml")
};

declare function csd_dm:fn_base_name($file,$ext) {
  let $old_base_name := fn:function-lookup(xs:QName("file:base-name"), 2)
  return
    if (not(exists($old_base_name))) then
      fn:replace(fn:function-lookup(xs:QName("file:name"), 1)($file), fn:concat($ext, "$"), "")
    else
      $old_base_name($file,$ext)
};

(:~
: This is the Care Services Discovery stored query registry
: @version 1.0
: @see https://github.com/openhie/openinfoman
:
:)
module namespace csd_dm = "https://github.com/openhie/openinfoman/csd_dm";

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

declare variable $csd_dm:document_manager := 'csd_docs.xml';

declare function csd_dm:blank_directory()
{
<CSD xmlns:csd="urn:ihe:iti:csd:2013" xmlns="urn:ihe:iti:csd:2013">
  <organizationDirectory/>
  <serviceDirectory/>
  <facilityDirectory/>
  <providerDirectory/>
</CSD>
};

declare  function csd_dm:document_source_exists($db,$name) {
  let $source := csd_dm:document_source($name)
  return  if ($source) then (db:is-xml($db,$source)) else false()

};

declare  function csd_dm:open_document($db,$name) {
  if (csd_dm:document_source_exists($db,$name)) then
    db:open($db,csd_dm:document_source($name))
  else
    csd_dm:blank_directory()
};

declare updating function csd_dm:add($db,$doc,$name) {
  db:add($db, $doc, csd_dm:document_source($name))
};

declare updating function csd_dm:delete($db,$name) {
  db:delete($db,csd_dm:document_source($name))
};

declare updating function csd_dm:empty($db,$name) {
  csd_dm:empty($db,$name,csd_dm:blank_directory())
};

declare updating function csd_dm:empty($db,$name,$doc) {
  let $source := csd_dm:document_source($name)
  return
    if (csd_dm:document_source_exists($db,$name)) then
      db:replace($db,$source,$doc)
    else
      db:add($db,$doc,$source)

};

declare function csd_dm:registered_documents($db) {
(:  db:list($db,"service_directories/*") :)
  for $doc in db:list($db,"service_directories")
  let $name := csd_dm:fn_base_name($doc,'.xml')
  return $name
};

declare function csd_dm:document_source($name) {
  concat("service_directories/",$name,".xml")
};

declare function csd_dm:fn_base_name($file,$ext) {
  let $old_base_name := fn:function-lookup(xs:QName("file:base-name"), 2)
  return
    if (not(exists($old_base_name))) then
      fn:replace(fn:function-lookup(xs:QName("file:name"), 1)($file), fn:concat($ext, "$"), "")
    else
      $old_base_name($file,$ext)
};


fixed xpath issue with getting url and credential of registered remote service directories

(:~
: This is the Care Services Discovery stored query registry
: @version 1.0
: @see https://github.com/his-interop/openinfoman
:
:)
module namespace csd_psd = "https://github.com/his-interop/openinfoman/csd_psd";
import module namespace csd_qus =  "https://github.com/his-interop/openinfoman/csd_qus" at "csd_query_updated_services.xqm";
import module namespace request = "http://exquery.org/ns/request";
declare namespace http = "http://expath.org/ns/http-client" ;
declare namespace soap = "http://www.w3.org/2003/05/soap-envelope";
declare namespace csd = "urn:ihe:iti:csd:2013";

declare variable $csd_psd:directory_manager := 'csd_directories.xml';

declare updating function csd_psd:init($db) {
  if ( not(csd_psd:dm_exists($db)))  then
    db:add($db, <serviceDirectoryLibrary/>,$csd_psd:directory_manager)
  else
      ()
};

declare function csd_psd:dm_exists($db) {
  db:is-xml($db,$csd_psd:directory_manager)
};

declare  function csd_psd:is_registered($db,$name) {
  if ( not(csd_psd:dm_exists($db)))  then
    false()
  else
    let $dm :=  db:open($db,$csd_psd:directory_manager)/serviceDirectoryLibrary
    return exists($dm/serviceDirectory[@name = $name])
};

declare updating function csd_psd:register_service($db,$name,$url,$credentials) {
  let $dm :=  db:open($db,$csd_psd:directory_manager)/serviceDirectoryLibrary
  (:bad bad plain text password:)
  let $reg_doc := <serviceDirectory name="{$name}" url="{$url}">{$credentials}</serviceDirectory>
  let $existing := $dm/serviceDirectory[@name = $name]
  return
    if (not(exists($existing)))  then
      insert node $reg_doc into $dm
    else
      replace  node $existing with $reg_doc

};

declare updating function csd_psd:deregister_service($db,$name) {
  if (csd_psd:dm_exists($db)) then
    let $dm :=  db:open($db,$csd_psd:directory_manager)/serviceDirectoryLibrary
    let $existing := $dm/serviceDirectory[@name = $name]
    return if (exists($existing))  then
      delete node $existing
    else
      ()
   else ()

};

declare function csd_psd:registered_directories($db) {
  if (csd_psd:dm_exists($db)) then
    db:open($db,$csd_psd:directory_manager)//serviceDirectory/text{@name}
  else
    ()
};

declare function csd_psd:get_service_directory_url($db,$name) {
  text{ db:open($db,$csd_psd:directory_manager)//serviceDirectory[@name=$name]/@url}
};

declare function csd_psd:get_service_directory_credentials($db,$name) {
  db:open($db,$csd_psd:directory_manager)//serviceDirectory[@name=$name]/credentials
};

declare function csd_psd:poll_service_directory($db,$name,$mtime)
{
  let $soap := csd_psd:poll_service_directory_soap_response($db,$name,$mtime)
  return  if ($soap) then
     $soap/soap:Envelope/soap:Body/csd:getModificationsResponse
(:     $soap//csd:CSD :)
  else
    ()
};

declare function csd_psd:generate_soap_request ($db,$name,$mtime)  {
  let $url := csd_psd:get_service_directory_url($db,$name)
  let $boundary := concat("----------------", random:uuid())
  let $message :=       <http:multipart media-type='multipart/form-data' boundary="{$boundary}" method='xml' accept='*/*'>
	<http:header name="Content-Disposition" value="form-data; name="fileupload"; filename="soap.xml""/>
	<http:header name="Content-Type" value="application/xml"/>
        <http:body   media-type="application/xml" method='xml' >
 	 {csd_qus:create_last_update_request($url,$mtime)}
        </http:body>
      </http:multipart>
  let $credentials := csd_psd:get_service_directory_credentials($db,$name)
  let $request :=
    if ($credentials/@type = 'basic_auth' and $credentials/@username )
      then
      <http:request
      href='{$url}'
      username='{$credentials/username}'
      password='{$credentials/password}'
      send-authorization='true'
      method='post' >
      {$message}
      </http:request>
    else
    <http:request
      href='{$url}'
      method='post' >
      {$message}
    </http:request>
  return $request
};

declare function csd_psd:poll_service_directory_soap_response($db,$name,$mtime)
{
  let $request := csd_psd:generate_soap_request($db,$name,$mtime)
  let $response := http:send-request($request)
  let $status := text{$response[1]/@status}
  return if ($status = "200")
  then
  (    $response[2]
)
  else
    ()

};

(:~
: This is the Care Services Discovery stored query registry
: @version 1.0
: @see https://github.com/his-interop/openinfoman
:
:)
module namespace csd_psd = "https://github.com/his-interop/openinfoman/csd_psd";
import module namespace csd_qus =  "https://github.com/his-interop/openinfoman/csd_qus" at "csd_query_updated_services.xqm";
import module namespace request = "http://exquery.org/ns/request";
declare namespace http = "http://expath.org/ns/http-client" ;
declare namespace soap = "http://www.w3.org/2003/05/soap-envelope";
declare namespace csd = "urn:ihe:iti:csd:2013";

declare variable $csd_psd:directory_manager := 'csd_directories.xml';

declare updating function csd_psd:init($db) {
  if ( not(csd_psd:dm_exists($db)))  then
    db:add($db, <serviceDirectoryLibrary/>,$csd_psd:directory_manager)
  else
      ()
};

declare function csd_psd:dm_exists($db) {
  db:is-xml($db,$csd_psd:directory_manager)
};

declare  function csd_psd:is_registered($db,$name) {
  if ( not(csd_psd:dm_exists($db)))  then
    false()
  else
    let $dm :=  db:open($db,$csd_psd:directory_manager)/serviceDirectoryLibrary
    return exists($dm/serviceDirectory[@name = $name])
};

declare updating function csd_psd:register_service($db,$name,$url,$credentials) {
  let $dm :=  db:open($db,$csd_psd:directory_manager)/serviceDirectoryLibrary
  (:bad bad plain text password:)
  let $reg_doc := <serviceDirectory name="{$name}" url="{$url}">{$credentials}</serviceDirectory>
  let $existing := $dm/serviceDirectory[@name = $name]
  return
    if (not(exists($existing)))  then
      insert node $reg_doc into $dm
    else
      replace  node $existing with $reg_doc

};

declare updating function csd_psd:deregister_service($db,$name) {
  if (csd_psd:dm_exists($db)) then
    let $dm :=  db:open($db,$csd_psd:directory_manager)/serviceDirectoryLibrary
    let $existing := $dm/serviceDirectory[@name = $name]
    return if (exists($existing))  then
      delete node $existing
    else
      ()
   else ()

};

declare function csd_psd:registered_directories($db) {
  if (csd_psd:dm_exists($db)) then
    db:open($db,$csd_psd:directory_manager)//serviceDirectory/text{@name}
  else
    ()
};

declare function csd_psd:get_service_directory_url($db,$name) {
  text{ db:open($db,$csd_psd:directory_manager)/serivceDirectoryLibrary/serviceDirectory[@name=$name]/@url}
};

declare function csd_psd:get_service_directory_credentials($db,$name) {
  db:open($db,$csd_psd:directory_manager)/serivceDirectoryLibrary/serviceDirectory[@name=$name]/credentials
};

declare function csd_psd:poll_service_directory($db,$name,$mtime)
{
  let $soap := csd_psd:poll_service_directory_soap_response($db,$name,$mtime)
  return  if ($soap) then
     $soap/soap:Envelope/soap:Body/csd:getModificationsResponse
(:     $soap//csd:CSD :)
  else
    ()
};

declare function csd_psd:poll_service_directory_soap_response($db,$name,$mtime)
{
  let $url := csd_psd:get_service_directory_url($db,$name)
  let $boundary := concat("----------------", random:uuid())
  let $message :=       <http:multipart media-type='multipart/form-data' boundary="{$boundary}" method='xml' accept='*/*'>
	<http:header name="Content-Disposition" value="form-data; name="fileupload"; filename="soap.xml""/>
	<http:header name="Content-Type" value="application/xml"/>
(:	<http:header name="Content-Type" value="application/xml; charset=utf-8"/>	 :)
(:	<http:header name="Media-Type" value="application/xml; charset=utf-8"/>	 :)
(:	<http:header name="Accept" value="*/*"/>	:)
        <http:body   media-type="application/xml" method='xml' >
 	 {csd_qus:create_last_update_request($url,$mtime)}
        </http:body>
      </http:multipart>

  let $credentials := csd_psd:get_service_directory_credentials($db,$name)
  let $request :=
    if ($credentials/@type = 'basic_auth' and $credentials/@username )
      then
      <http:request
      href='{$url}'
      username='{$credentials/username}'
      password='{$credentials/password}'
      send-authorization='true'
      method='post' >
      {$message}
      </http:request>
    else
    <http:request
      href='{$url}'
      method='post' >
      {$message}
    </http:request>
  let $response := http:send-request($request)
  let $status := text{$response[1]/@status}
  return if ($status = "200")
  then
  (    $response[2]
)
  else
    ()

};


Use OSIS Ids

Use OSIS Ids

declare variable $pos := //parts-of-speech;
declare variable $morph := //morphology;

declare function local:morph-description($tag, $category)
{
   $morph/field[@tag=$category]/value[@tag=$tag]/@summary ! string(.)
};

declare function local:number($morph as xs:string)
{
  let $tag := substring($morph,2,1)
  where $tag != "-"
  return
    attribute number {
      local:morph-description($tag, "number")
    }
};

declare function local:person($morph as xs:string)
{
  let $tag := substring($morph,1,1)
  where $tag != "-"
  return
    attribute person {
      tokenize(local:morph-description($tag, "person"))[1]
    }
};

declare function local:gender($morph as xs:string)
{
  let $tag := substring($morph,6,1)
  where $tag != "-"
  return
    attribute gender {
      local:morph-description($tag,"gender")
    }
};

declare function local:case($morph as xs:string)
{
  let $tag := substring($morph,7,1)
  where $tag != "-"
  return
    attribute case {
      local:morph-description($tag,"case")
    }
};

declare function local:tense($morph as xs:string)
{
  let $tag := substring($morph,3,1)
  where $tag != "-"
  return
    attribute tense {
      local:morph-description($tag,"tense")
    }
};

declare function local:voice($morph as xs:string)
{
  let $tag := substring($morph,5,1)
  where $tag != "-"
  return
    attribute voice {
      local:morph-description($tag,"voice")
    }
};

declare function local:mood($morph as xs:string)
{
  let $tag := substring($morph,4,1)
  where $tag != "-"
  return
    attribute mood {
      local:morph-description($tag,"mood")
    }
};

declare function local:degree($morph as xs:string)
{
  let $tag := substring($morph,8,1)
  where $tag != "-"
  return
    attribute degree {
      local:morph-description($tag,"degree")
    }
};

declare function local:strength($morph as xs:string)
{
  let $tag := substring($morph,9,1)
  where $tag != "-"
  return
    attribute strength {
      local:morph-description($tag,"strength")
    }
};

declare function local:inflection($morph as xs:string)
{
  let $tag := substring($morph,10,1)
  where $tag != "-"
  return
    attribute inflection {
      local:morph-description($tag,"inflection")
    }
};

declare function local:morphology($t)
{
  let $morph := string($t/@morphology)
  where $morph
  return (
    $t/@lemma,
    local:number($morph),
    local:person($morph),
    local:gender($morph),
    local:case($morph),
    local:tense($morph),
    local:voice($morph),
    local:mood($morph),
    local:degree($morph),
    local:strength($morph),
    local:inflection($morph)
  )
};

declare function local:class($t)
{
  let $description :=  string($pos/value[@tag = $t/@part-of-speech]/@summary)
  let $class :=
    switch ($description)
      case "interrogative adverb" return "adverb"
      case "relative adverb" return "adverb"
      case "common noun" return "noun"
      case "proper noun" return "noun"
      case "cardinal numeral" return "numeral"
      case "ordinal numeral" return "numeral"
      case "demonstrative pronoun" return "pronoun"
      case "indefinite pronoun" return "pronoun"
      case "interrogative pronoun" return "pronoun"
      case "relative pronoun" return "pronoun"
      case "personal pronoun" return "pronoun"
      case "personal reflexive pronoun" return "pronoun"
      case "possessive pronoun" return "pronoun"
      case "possessive reflexive pronoun" return "pronoun"
      case "reciprocal pronoun" return "pronoun"
      case "" return ()
      default return $description
  let $type :=
    switch ($description)
      case "interrogative adverb" return "interrogative"
      case "relative adverb" return "relative"
      case "common noun" return "common"
      case "proper noun" return "proper"
      case "cardinal numeral" return "cardinal"
      case "ordinal numeral" return "ordinal"
      case "demonstrative pronoun" return "demonstrative"
      case "indefinite pronoun" return "indefinite"
      case "interrogative pronoun" return "interrogative"
      case "relative pronoun" return "relative"
      case "personal pronoun" return "personal"
      case "personal reflexive pronoun" return "personal relative"
      case "possessive pronoun" return "possessive"
      case "possessive reflexive pronoun" return "possessive reflexive"
      case "reciprocal pronoun" return "reciprocal"
      default return ()
  return
    (
      $class ! attribute class {$class},
      $type ! attribute type {$type}
    )
};

declare function local:token($t)
{
  <w>
    {
      local:class($t),
      attribute role {$t/@relation},
      local:morphology($t),
      attribute id {$t/@id},
      $t/@head-id ! attribute head-id {$t/@head-id }
    }
    {
      string($t/@form)
    }
  </w>,
  $t/@presentation-after[. != ' '] ! <pc>{string(.)}</pc>
};

declare function local:unwrap($t, $stok)
{
  let $children :=  $stok[@head-id = $t/@id]
  let $seq := ($children | $t)/.
  return
    if ($children)
    then
      <wg role="{$t/@relation}" head="{$t/@id}">
        {
          for $s in $seq
          return
            if ($s is $t)
            then local:token($t)
            else local:unwrap($s, $stok)
        }
      </wg>
    else local:token($t)
};

declare function local:milestone($ms)
{
  let $groups := analyze-string($ms, "(\d+)?(\w+) (\d+)\.(\d+)")//fn:group
  let $name :=
    switch ($groups[@nr="2"])
      case "PHILEM" return "phlm"
      default return $groups[@nr="2"]
  let $first :=
    string-join(($groups[@nr="1"], upper-case(substring($name,1,1)),lower-case(substring($name,2))),"")
  let $osisId := string-join(($first, $groups[@nr="3"], $groups[@nr="4"]),".")
  return
    <milestone unit="verse" id="{$osisId}">{ $osisId }</milestone>
};

declare function local:sentence($s)
{
  <sentence>
    {
      attribute id { $s/@id }
    }
    {
      for $ms in distinct-values($s//@citation-part)
      return local:milestone($ms)
    }
    {
      <p>
       {
         string-join( $s//token ! (@form, @presentation-after), "")
       }
      </p>
    }
    {
      let $stok := $s//token
      for $t in $stok[not(@head-id)]
      return local:unwrap($t, $stok)
    }
  </sentence>
};

<?xml-stylesheet href="treedown.css"?>,
<?xml-stylesheet href="boxwood.css"?>,
<book>
  {
    for $s in //sentence
    return local:sentence($s)
  }
</book>

declare variable $pos := //parts-of-speech;
declare variable $morph := //morphology;

declare function local:morph-description($tag, $category)
{
   $morph/field[@tag=$category]/value[@tag=$tag]/@summary ! string(.)
};

declare function local:number($morph as xs:string)
{
  let $tag := substring($morph,2,1)
  where $tag != "-"
  return
    attribute number {
      local:morph-description($tag, "number")
    }
};

declare function local:person($morph as xs:string)
{
  let $tag := substring($morph,1,1)
  where $tag != "-"
  return
    attribute person {
      tokenize(local:morph-description($tag, "person"))[1]
    }
};

declare function local:gender($morph as xs:string)
{
  let $tag := substring($morph,6,1)
  where $tag != "-"
  return
    attribute gender {
      local:morph-description($tag,"gender")
    }
};

declare function local:case($morph as xs:string)
{
  let $tag := substring($morph,7,1)
  where $tag != "-"
  return
    attribute case {
      local:morph-description($tag,"case")
    }
};

declare function local:tense($morph as xs:string)
{
  let $tag := substring($morph,3,1)
  where $tag != "-"
  return
    attribute tense {
      local:morph-description($tag,"tense")
    }
};

declare function local:voice($morph as xs:string)
{
  let $tag := substring($morph,5,1)
  where $tag != "-"
  return
    attribute voice {
      local:morph-description($tag,"voice")
    }
};

declare function local:mood($morph as xs:string)
{
  let $tag := substring($morph,4,1)
  where $tag != "-"
  return
    attribute mood {
      local:morph-description($tag,"mood")
    }
};

declare function local:degree($morph as xs:string)
{
  let $tag := substring($morph,8,1)
  where $tag != "-"
  return
    attribute degree {
      local:morph-description($tag,"degree")
    }
};

declare function local:strength($morph as xs:string)
{
  let $tag := substring($morph,9,1)
  where $tag != "-"
  return
    attribute strength {
      local:morph-description($tag,"strength")
    }
};

declare function local:inflection($morph as xs:string)
{
  let $tag := substring($morph,10,1)
  where $tag != "-"
  return
    attribute inflection {
      local:morph-description($tag,"inflection")
    }
};

declare function local:morphology($t)
{
  let $morph := string($t/@morphology)
  where $morph
  return (
    $t/@lemma,
    local:number($morph),
    local:person($morph),
    local:gender($morph),
    local:case($morph),
    local:tense($morph),
    local:voice($morph),
    local:mood($morph),
    local:degree($morph),
    local:strength($morph),
    local:inflection($morph)
  )
};

declare function local:class($t)
{
  let $description :=  string($pos/value[@tag = $t/@part-of-speech]/@summary)
  let $class :=
    switch ($description)
      case "interrogative adverb" return "adverb"
      case "relative adverb" return "adverb"
      case "common noun" return "noun"
      case "proper noun" return "noun"
      case "cardinal numeral" return "numeral"
      case "ordinal numeral" return "numeral"
      case "demonstrative pronoun" return "pronoun"
      case "indefinite pronoun" return "pronoun"
      case "interrogative pronoun" return "pronoun"
      case "relative pronoun" return "pronoun"
      case "personal pronoun" return "pronoun"
      case "personal reflexive pronoun" return "pronoun"
      case "possessive pronoun" return "pronoun"
      case "possessive reflexive pronoun" return "pronoun"
      case "reciprocal pronoun" return "pronoun"
      case "" return ()
      default return $description
  let $type :=
    switch ($description)
      case "interrogative adverb" return "interrogative"
      case "relative adverb" return "relative"
      case "common noun" return "common"
      case "proper noun" return "proper"
      case "cardinal numeral" return "cardinal"
      case "ordinal numeral" return "ordinal"
      case "demonstrative pronoun" return "demonstrative"
      case "indefinite pronoun" return "indefinite"
      case "interrogative pronoun" return "interrogative"
      case "relative pronoun" return "relative"
      case "personal pronoun" return "personal"
      case "personal reflexive pronoun" return "personal relative"
      case "possessive pronoun" return "possessive"
      case "possessive reflexive pronoun" return "possessive reflexive"
      case "reciprocal pronoun" return "reciprocal"
      default return ()
  return
    (
      $class ! attribute class {$class},
      $type ! attribute type {$type}
    )
};

declare function local:token($t)
{
  <w>
    {
      local:class($t),
      attribute role {$t/@relation},
      local:morphology($t),
      attribute id {$t/@id},
      $t/@head-id ! attribute head-id {$t/@head-id }
    }
    {
      string($t/@form)
    }
  </w>,
  $t/@presentation-after[. != ' '] ! <pc>{string(.)}</pc>
};

declare function local:unwrap($t, $stok)
{
  let $children :=  $stok[@head-id = $t/@id]
  let $seq := ($children | $t)/.
  return
    if ($children)
    then
      <wg role="{$t/@relation}" head="{$t/@id}">
        {
          for $s in $seq
          return
            if ($s is $t)
            then local:token($t)
            else local:unwrap($s, $stok)
        }
      </wg>
    else local:token($t)
};

declare function local:sentence($s)
{
  <sentence>
    {
      attribute id { $s/@id }
    }
    {
      let $stok := $s//token
      for $t in $stok[not(@head-id)]
      return local:unwrap($t, $stok)
    }
  </sentence>
};

<?xml-stylesheet href="treedown.css"?>,
<?xml-stylesheet href="boxwood.css"?>,
<book>
  {
    for $s in //sentence
    return local:sentence($s)
  }
</book>


added a comment

added a comment

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

(:~
 : Zorba FOTS driver CLI
 : @author Ghislain Fourny, Sorin Nasoi
 :)

import module namespace d =
  "http://www.zorba-xquery.com/fots-driver" at "fots-driver.xq";

import module namespace r =
  "http://www.zorba-xquery.com/fots-driver/reporting" at "reporting.xq";

(:~
  Path to the FOTS catalog.xml file. If the path is relative, it will be
  resolved relative to the directory containing this cli.xq file.
:)
declare variable $fotsPath as xs:string external := "";

(:~
  Path to the FOTSZorbaManifest.xml file. If the path is relative, it will be
  resolved relative to the diractory containing this cli.xq file
:)
declare variable $fotsZorbaManifestPath as xs:string external :=
  "FOTSZorbaManifest.xml";

(:~
  Path to the results from a previous run. Used when we just want to generate
  a report based on some previous run, i.e., without running the tests again.
:)
declare variable $failuresFilePath as xs:string external := "";

(:~
  Path to the ExpectedFailures file.
:)
declare variable $expectedFailuresPath  as xs:string external :="";

(:~
  The CLI command you want to run.
:)
declare variable $mode as xs:string external := "";

(:~
  A list of comma-seperated prefixes. Only test-sets whose name starts with
  a prefix in this list are going to be proccesed. An empty string means no
  filtering of test-sets.
:)
declare variable $testSetPrefixes as xs:string external := "";

(:~
  A list of comma-seperated prefixes. Only test-cases whose name starts with
  a prefix in this list are going to be proccesed. An empty string means no
  filtering of test-cases.
:)
declare variable $testCasePrefixes as xs:string external := "";

(:~
 : Name of the test-set containing a test-case to process. Used only for the
 : "run-test-case" command.
:)
declare variable $testSetName as xs:string external := "";

(:~
 : Name of the test-case to process. Used only for the "run-test-case" command.
:)
declare variable $testCaseName as xs:string external := "";

(:~
  A dependency used in the 'list-test-cases' and 'run-test-sets' commands to
  filter the test-cases that will actually be listed/run. Only test-cases whose
  applicable dependencies contain at least one dependency the matches this
  user-specified dependency will be processed. The filtering dependency is
  given as a string of the form "depValue_depSatisfied" (for example,
  "XQ30+_true"), or just "depValue" (in which case "true" is assumed as the
  value of the satisfied attribute). If $dependency is set to the empty string,
  no filtering is done.
:)
declare variable $dependency as xs:string external := "";

(:~
  List of assertion types used in the 'list-test-cases' and 'run-test-sets'
  commands to filter the test-cases that will actually be listed/run. A test
  case qualifies if there is at least one element node under the <result>
  node of the <test-case> whose local name is equal to one of the strings
  in the filtering set. If $assrtType is set to the empty sequence, no
  filtering is done.
:)
declare variable $assertType as xs:string* external := ();

(:~
  Regex to be used by the 'list-matching-test-cases' command.
:)
declare variable $pattern as xs:string external := "";

(:~
  Flags to be used by the 'list-matching-test-cases' command.
:)
declare variable $flags as xs:string external := "";

(:~
  The test cases in this list have bugs assigned and should not be run.
:)
declare variable $exceptedTestCases := (
  "cbcl-subsequence-011",
  "cbcl-subsequence-012",
  "cbcl-subsequence-013",
  "cbcl-subsequence-014"        (:see bug lp:1069794 :)
, "re00975",
  "re00976",
  "re00976a"                    (:see bug lp:1070533 :)
, "fn-unparsed-text-lines-052"  (:see bug lp:1073175 :)
);

(:~
  The test in this list have bugs assigned already and should not be run
:)
declare variable $exceptedTestSets := ();

(:~
  Enable or disable verbose output
:)
declare variable $verbose as xs:string external := "true";

declare function local:usage() as xs:string
{
  string-join((
    "Zorba FOTS driver usage examples:",
    "If you run Zorba from a checkout of the trunk and the build/bin folder,",
    "- /path/to/cli.xq can be set to ../../test/fots_driver/cli.xq",
    "",
    "Always try to output the result back to an XML file with nice indentation:",
    "./zorba -f -q ../../test/fots_driver/cli.xq -e SET_CLI_OPTIONS_HERE -o output.xml --indent",
    "",
    " This way you will see trace information in the CLI window and detailed",
    " results of the test cases in the 'output.xml'.",
    "",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e fotsZorbaManifestPath:=/path/to/Zorba_manifest.xml -e mode:=list-test-sets",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=list-test-sets",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=list-test-sets -e testSetPrefixes:=prod,app",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=list-test-cases -e testSetPrefixes:=prod-Literal",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=list-test-cases -e dependency:=higherOrderFunctions",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=list-test-cases -e dependency:=higherOrderFunctions -e assertType:=assert-count",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=list-matching-test-cases -e pattern:=catch",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-sets -e testSetPrefixes:=prod -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-sets -e testSetPrefixes:=prod -e expectedFailuresPath:=ExpectedFailures.xml -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-sets -e testSetPrefixes:=prod -e dependency:=higherOrderFunctions_false -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-sets -e testSetPrefixes:=prod -e assertType:=assert-count -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-sets -e testSetPrefixes:=prod-Literal -e verbose:=false -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-case -e testSetName:=prod-Literal -e testCaseName:=Literals001 -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-and-report -o report.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=report -e failuresFilePath:=failures.xml -e verbose:=false -o report.xml --indent",
    "zorba -f -q /path/to/cli.xq -e mode:=generate-expected-failures -e failuresFilePath:=failures.xml -o ExpectedFailures.xml --indent",
    ""
    ), "
")
};

(:~
  Tokenize a string that contains a comma-separated list of tokens.
  Note: if the input string is empty, the function returns the empty sequence.
:)
declare %private function local:tokenize(
  $input as xs:string
) as xs:string*
{
  tokenize($input, ",")
};

variable $fotsPathMsg := "The path to FOTS catalog.xml was set to: ";

variable $testSetPrefixesMsg := "'testSetPrefixes' was set to: ";

variable $testCasePrefixesMsg := "'testCasePrefixes' was set to: ";

switch ($mode)

case "list-test-sets"
return
  string-join
  (
  (
    d:list-test-sets(trace($fotsPath, $fotsPathMsg),
                     local:tokenize(trace($testSetPrefixes, $testSetPrefixesMsg)))
  ),
  "
"
  )

case "list-test-cases"
return
  string-join
  (
  (
    d:list-test-cases(trace($fotsPath, $fotsPathMsg),
                      local:tokenize(trace($testSetPrefixes, $testSetPrefixesMsg)),
                      trace($dependency, "'dependency' set to:"),
                      trace($assertType, "'assertType' set to: "))
  ),
  "
"
  )

case "list-matching-test-cases"
return
  string-join
  (
  (
    d:list-matching-test-cases(trace($fotsPath, $fotsPathMsg),
                               trace($pattern, "pattern set to: "),
                               trace($flags, "flags were set to: ")), ""
  ),
  "
"
  )

case "run-test-sets"
return
  d:run-fots($fotsPath,
             $fotsZorbaManifestPath,
             d:list-test-sets($fotsPath,
                              local:tokenize(trace($testSetPrefixes,
                                                   $testSetPrefixesMsg))),
             d:list-test-cases($fotsPath,
                               local:tokenize($testSetPrefixes),
                               local:tokenize(trace($testCasePrefixes,
                                                    $testCasePrefixesMsg)),
                               trace($dependency, "'dependency' set to:"),
                               trace($assertType, "'assertType' set to: ")),
             $exceptedTestCases,
             $exceptedTestSets,
             xs:boolean($verbose),
             $expectedFailuresPath)

case "run-test-case"
return
  d:run-fots($fotsPath,
             $fotsZorbaManifestPath,
             trace($testSetName, "'testSetName' set to: "),
             trace($testCaseName,"'testCaseName' set to: "),
             $exceptedTestCases,
             $exceptedTestSets,
             xs:boolean($verbose),
             $expectedFailuresPath)

case "run-and-report"
return
  r:run-and-report($fotsPath,
                   $fotsZorbaManifestPath,
                   $exceptedTestCases,
                   $exceptedTestSets,
        (: the reports to W3C are always generated with verbose set to false:)
                   fn:false())

case "report"
return
  r:report($fotsPath,
           $failuresFilePath,
           $exceptedTestCases,
           $exceptedTestSets,
           xs:boolean($verbose))

case "generate-expected-failures"
return
  r:generate-expected-failures($failuresFilePath)

default
return
  local:usage()

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

(:~
 : Zorba FOTS driver CLI
 : @author Ghislain Fourny, Sorin Nasoi
 :)

import module namespace d =
  "http://www.zorba-xquery.com/fots-driver" at "fots-driver.xq";

import module namespace r =
  "http://www.zorba-xquery.com/fots-driver/reporting" at "reporting.xq";

(:~
  Path to the FOTS catalog.xml file. If the path is relative, it will be
  resolved relative to the directory containing this cli.xq file.
:)
declare variable $fotsPath as xs:string external := "";

(:~
  Path to the FOTSZorbaManifest.xml file. If the path is relative, it will be
  resolved relative to the diractory containing this cli.xq file
:)
declare variable $fotsZorbaManifestPath as xs:string external :=
  "FOTSZorbaManifest.xml";

(:~
  Path to the results from a previous run. Used when we just want to generate
  a report based on some previous run, i.e., without running the tests again.
:)
declare variable $failuresFilePath as xs:string external := "";

(:~
  Path to the ExpectedFailures file.
:)
declare variable $expectedFailuresPath  as xs:string external :="";

(:~
  The CLI command you want to run.
:)
declare variable $mode as xs:string external := "";

(:~
  A list of comma-seperated prefixes. Only test-sets whose name starts with
  a prefix in this list are going to be proccesed. An empty string means no
  filtering of test-sets.
:)
declare variable $testSetPrefixes as xs:string external := "";

(:~
  A list of comma-seperated prefixes. Only test-cases whose name starts with
  a prefix in this list are going to be proccesed. An empty string means no
  filtering of test-cases.
:)
declare variable $testCasePrefixes as xs:string external := "";

(:~
 : Name of the test-set containing a test-case to process. Used only for the
 : "run-test-case" command.
:)
declare variable $testSetName as xs:string external := "";

(:~
 : Name of the test-case to process. Used only for the "run-test-case" command.
:)
declare variable $testCaseName as xs:string external := "";

(:~
  A dependency used in the 'list-test-cases' and 'run-test-sets' commands to
  filter the test-cases that will actually be listed/run. Only test-cases whose
  applicable dependencies contain at least one dependency the matches this
  user-specified dependency will be processed. The filtering dependency is
  given as a string of the form "depValue_depSatisfied" (for example,
  "XQ30+_true"), or just "depValue" (in which case "true" is assumed as the
  value of the satisfied attribute). If $dependency is set to the empty string,
  no filtering is done.
:)
declare variable $dependency as xs:string external := "";

(:~
  List of assertion types used in the 'list-test-cases' and 'run-test-sets'
  commands to filter the test-cases that will actually be listed/run. A test
  case qualifies if there is at least one element node under the <result>
  node of the <test-case> whose local name is equal to one of the strings
  in the filtering set. If $assrtType is set to the empty sequence, no
  filtering is done.
:)
declare variable $assertType as xs:string* external := ();

(:~
  Regex to be used by the 'list-matching-test-cases' command.
:)
declare variable $pattern as xs:string external := "";

(:~
  Flags to be used by the 'list-matching-test-cases' command.
:)
declare variable $flags as xs:string external := "";

(:~
  The test cases in this list have bugs assigned and should not be run.
:)
declare variable $exceptedTestCases := (
  "cbcl-subsequence-011",
  "cbcl-subsequence-012",
  "cbcl-subsequence-013",
  "cbcl-subsequence-014"        (:see bug lp:1069794 :)
, "re00975",
  "re00976",
  "re00976a"                    (:see bug lp:1070533 :)
, "fn-unparsed-text-lines-052"  (:see bug lp:1073175 :)
);

(:~
  The test in this list have bugs assigned already and should not be run
:)
declare variable $exceptedTestSets := ();

(:~
  Enable or disable verbose output
:)
declare variable $verbose as xs:string external := "true";

declare function local:usage() as xs:string
{
  string-join((
    "Zorba FOTS driver usage examples:",
    "If you run Zorba from a checkout of the trunk and the build/bin folder,",
    "- /path/to/cli.xq can be set to ../../test/fots_driver/cli.xq",
    "",
    "Always try to output the result back to an XML file with nice indentation:",
    "./zorba -f -q ../../test/fots_driver/cli.xq -e SET_CLI_OPTIONS_HERE -o output.xml --indent",
    "",
    " This way you will see trace information in the CLI window and detailed",
    " results of the test cases in the 'output.xml'.",
    "",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e fotsZorbaManifestPath:=/path/to/Zorba_manifest.xml -e mode:=list-test-sets",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=list-test-sets",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=list-test-sets -e testSetPrefixes:=prod,app",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=list-test-cases -e testSetPrefixes:=prod-Literal",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=list-test-cases -e dependency:=higherOrderFunctions",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=list-test-cases -e dependency:=higherOrderFunctions -e assertType:=assert-count",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=list-matching-test-cases -e pattern:=catch",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-sets -e testSetPrefixes:=prod -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-sets -e testSetPrefixes:=prod -e expectedFailuresPath:=ExpectedFailures.xml -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-sets -e testSetPrefixes:=prod -e dependency:=higherOrderFunctions_false -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-sets -e testSetPrefixes:=prod -e assertType:=assert-count -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-sets -e testSetPrefixes:=prod-Literal -e verbose:=false -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-case -e testSetName:=prod-Literal -e testCaseName:=Literals001 -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-and-report -o report.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=report -e failuresFilePath:=failures.xml -e verbose:=false -o report.xml --indent",
    "zorba -f -q /path/to/cli.xq -e mode:=generate-expected-failures -e failuresFilePath:=failures.xml -o ExpectedFailures.xml --indent",
    ""
    ), "
")
};

(:~
  Tokenize comma or empty string
:)
declare %private function local:tokenize(
  $input as xs:string
) as xs:string*
{
  tokenize($input, ",")
};

variable $fotsPathMsg := "The path to FOTS catalog.xml was set to: ";

variable $testSetPrefixesMsg := "'testSetPrefixes' was set to: ";

variable $testCasePrefixesMsg := "'testCasePrefixes' was set to: ";

switch ($mode)

case "list-test-sets"
return
  string-join
  (
  (
    d:list-test-sets(trace($fotsPath, $fotsPathMsg),
                     local:tokenize(trace($testSetPrefixes, $testSetPrefixesMsg)))
  ),
  "
"
  )

case "list-test-cases"
return
  string-join
  (
  (
    d:list-test-cases(trace($fotsPath, $fotsPathMsg),
                      local:tokenize(trace($testSetPrefixes, $testSetPrefixesMsg)),
                      trace($dependency, "'dependency' set to:"),
                      trace($assertType, "'assertType' set to: "))
  ),
  "
"
  )

case "list-matching-test-cases"
return
  string-join
  (
  (
    d:list-matching-test-cases(trace($fotsPath, $fotsPathMsg),
                               trace($pattern, "pattern set to: "),
                               trace($flags, "flags were set to: ")), ""
  ),
  "
"
  )

case "run-test-sets"
return
  d:run-fots($fotsPath,
             $fotsZorbaManifestPath,
             d:list-test-sets($fotsPath,
                              local:tokenize(trace($testSetPrefixes,
                                                   $testSetPrefixesMsg))),
             d:list-test-cases($fotsPath,
                               local:tokenize($testSetPrefixes),
                               local:tokenize(trace($testCasePrefixes,
                                                    $testCasePrefixesMsg)),
                               trace($dependency, "'dependency' set to:"),
                               trace($assertType, "'assertType' set to: ")),
             $exceptedTestCases,
             $exceptedTestSets,
             xs:boolean($verbose),
             $expectedFailuresPath)

case "run-test-case"
return
  d:run-fots($fotsPath,
             $fotsZorbaManifestPath,
             trace($testSetName, "'testSetName' set to: "),
             trace($testCaseName,"'testCaseName' set to: "),
             $exceptedTestCases,
             $exceptedTestSets,
             xs:boolean($verbose),
             $expectedFailuresPath)

case "run-and-report"
return
  r:run-and-report($fotsPath,
                   $fotsZorbaManifestPath,
                   $exceptedTestCases,
                   $exceptedTestSets,
        (: the reports to W3C are always generated with verbose set to false:)
                   fn:false())

case "report"
return
  r:report($fotsPath,
           $failuresFilePath,
           $exceptedTestCases,
           $exceptedTestSets,
           xs:boolean($verbose))

case "generate-expected-failures"
return
  r:generate-expected-failures($failuresFilePath)

default
return
  local:usage()


[testsuite] Fixed XQuery test suite to compare XML test results correctly.

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

xquery version "1.0";

module namespace t="http://exist-db.org/xquery/testing";

import module namespace xdb="http://exist-db.org/xquery/xmldb";
import module namespace xdiff="http://exist-db.org/xquery/xmldiff"
at "java:org.exist.xquery.modules.xmldiff.XmlDiffModule";

declare function t:setup-action($action) {
    typeswitch ($action)
        case element(create-collection) return
            xdb:create-collection($action/@parent, $action/@name)
        case element(store) return
			t:store($action)
		case element(store-files) return
            t:store-files($action)
        case element(remove-collection) return
            xdb:remove($action/@collection)
        case element(remove-document) return
            xdb:remove($action/@collection, $action/@name)
        default return
            ()
};

declare function t:store($action as element(store)) {
    let $type := if ($action/@type) then $action/@type/string() else "application/xml"
    let $data :=
		if ($action/*) then
			$action/*[1]
		else
			$action/string()
	return
        xdb:store($action/@collection, $action/@name, $data, $type)
};

declare function t:store-files($action as element(store-files)) {
    let $type := if ($action/@type) then $action/@type/string() else "application/xml"
    return
        xdb:store-files-from-pattern($action/@collection, $action/@dir, $action/@pattern, $type)
};

declare function t:setup($setup as element(setup)) {
    for $action in $setup/*
    return
        t:setup-action($action)
};

declare function t:tearDown($tearDown as element(tearDown)?) {
    for $action in $tearDown/*
    return
        t:setup-action($action)
};

declare function t:declare-variable($var as element(variable)) as item()? {
    let $children := $var/*
    return
        if (empty($children)) then
            string-join($var/node(), '')
        else
            util:serialize($children, ())
};

declare function t:init-prolog($test as element(test)) {
	let $imports := $test/../imports
	let $vars :=
	    string-join(
        	for $var in $test/../variable
        	return
        	    concat("declare variable $", $var/@name, " := ", t:declare-variable($var), ";"),
            ""
        )
	return
		string-join(($imports, $vars, $test/../functions), '')
};

declare function t:test($result as item()*) {
    if ($result instance of xs:boolean) then
        $result
    else
        exists($result)
};

declare function t:run-test($test as element(test), $count as xs:integer) {
	let $context := t:init-prolog($test)
	let $null :=
	   if ($test/@trace eq 'yes') then
	       (system:clear-trace(), system:enable-tracing(true(), false()))
       else ()
    let $highlight-option := concat("highlight-matches=",
          if ($test/expected//@*[matches(., '^(\|{3}).*\1$')] and $test/expected//exist:match) then "both"
          else if ($test/expected//@*[matches(., '^(\|{3}).*\1$')]) then "attributes"
          else if ($test/expected//exist:match) then "elements"
          else "none"
          )
    let $serialize-options :=
      let $decls := ($test/../*[name() ne 'test']|$test/code)[matches(., 'declare[\- ]option(\(("|')|\s+)exist:serialize(\2,)?\s+("|').*?\4[;)]')]
      let $ops1 := $decls/replace(., "declare[\- ]option(\(("|')|\s+)exist:serialize(\2,)?\s+("|')(.*?)\4[;)]", "_|$5_")
      let $ops2 :=
        for $a in $ops1
        for $b in tokenize($a, '_')[starts-with(., '|')]
        return tokenize(substring-after($b, '|'), '\s+')
      return if (count($ops2[matches(., 'highlight-matches')]))
        then string-join($ops2, ' ')
        else string-join(($ops2, $highlight-option), ' ')
    let $queryOutput :=
		util:catch("*",
			util:eval(concat($context, $test/code/string())),
			<error>Compilation error: {$util:exception-message}</error>
		)
	let $output := if ($test/@trace eq 'yes') then system:trace() else $queryOutput
    let $expanded :=
		if ($output instance of node()) then
        	util:expand($output, $serialize-options)
		else
			$output
    let $expected :=
        if ($test/@output eq 'text') then
            data($test/expected)
        else $test/expected/node()
    let $OK :=
        if ($test/xpath) then
            t:test(t:xpath($output, $test/xpath))
        else if ($test/@output eq 'text') then
            normalize-space(string-join(for $x in $output return string($x),' ')) eq normalize-space($expected)
        else
            let $xn := t:normalize($expanded)
            let $en := t:normalize($expected)
            return
        	   deep-equal($xn, $en)
    return
        <test n="{$count}" pass="{$OK}">
        {
            if (not($OK)) then
                ($test/task, $test/expected, <result>{$expanded}</result>)
            else
                ()
        }
        </test>
};

declare function t:normalize($nodes as node()*) {
	for $node in $nodes return t:normalize-node($node)
};

declare function t:normalize-node($node as node()) {
	typeswitch ($node)
		case element() return
			element { node-name($node) } {
				$node/@*, for $child in $node/node() return t:normalize-node($child)
			}
		case text() return
			let $norm := normalize-space($node)
			return
				if (string-length($norm) eq 0) then () else $node
		default return
			$node
};

declare function t:xpath($output as item()*, $xpath as element()) {
    for $prefix in in-scope-prefixes($xpath)
    let $nsuri := namespace-uri-for-prefix($prefix, $xpath)
    return
        if ($prefix != 'xml') then
            util:declare-namespace($prefix, $nsuri)
        else (),
    let $expr := $xpath/string()
    return
        if (matches($expr, "^\s*/")) then
            util:eval(concat("$output", $expr))
        else
            util:eval($expr)
};

declare function t:run-testSet($set as element(TestSet)) {
    let $copy := util:expand($set)
    let $null := t:setup($copy/setup)
    let $result := util:expand(
           <TestSet>
           {$copy/testName}
           {$copy/description}
           {
               for $test at $p in $copy/test
               return
                   t:run-test($test, $p)
           }
           </TestSet>
        )
    let $null := t:tearDown($copy/tearDown)
    return $result
};

declare function t:format-testResult($result) {
    let $formatted :=

{$result/testName}

{$result/description/p}

          {for $test in $result//test
           return

                    {$test/@n/.}
                    {$test/@pass/.}

          }

     return
        $formatted
};

xquery version "1.0";

module namespace t="http://exist-db.org/xquery/testing";

import module namespace xdb="http://exist-db.org/xquery/xmldb";
import module namespace xdiff="http://exist-db.org/xquery/xmldiff"
at "java:org.exist.xquery.modules.xmldiff.XmlDiffModule";

declare function t:setup-action($action) {
    typeswitch ($action)
        case element(create-collection) return
            xdb:create-collection($action/@parent, $action/@name)
        case element(store) return
			t:store($action)
		case element(store-files) return
            t:store-files($action)
        case element(remove-collection) return
            xdb:remove($action/@collection)
        case element(remove-document) return
            xdb:remove($action/@collection, $action/@name)
        default return
            ()
};

declare function t:store($action as element(store)) {
    let $type := if ($action/@type) then $action/@type/string() else "application/xml"
    let $data :=
		if ($action/*) then
			$action/*[1]
		else
			$action/string()
	return
        xdb:store($action/@collection, $action/@name, $data, $type)
};

declare function t:store-files($action as element(store-files)) {
    let $type := if ($action/@type) then $action/@type/string() else "application/xml"
    return
        xdb:store-files-from-pattern($action/@collection, $action/@dir, $action/@pattern, $type)
};

declare function t:setup($setup as element(setup)) {
    for $action in $setup/*
    return
        t:setup-action($action)
};

declare function t:tearDown($tearDown as element(tearDown)?) {
    for $action in $tearDown/*
    return
        t:setup-action($action)
};

declare function t:declare-variable($var as element(variable)) as item()? {
    let $children := $var/*
    return
        if (empty($children)) then
            string-join($var/node(), '')
        else
            util:serialize($children, ())
};

declare function t:init-prolog($test as element(test)) {
	let $imports := $test/../imports
	let $vars :=
	    string-join(
        	for $var in $test/../variable
        	return
        	    concat("declare variable $", $var/@name, " := ", t:declare-variable($var), ";"),
            ""
        )
	return
		string-join(($imports, $vars, $test/../functions), '')
};

declare function t:test($result as item()*) {
    if ($result instance of xs:boolean) then
        $result
    else
        exists($result)
};

declare function t:compare-xml($output as node()*, $expected as node()*) {
    if (empty($output)) then
        true()
    else
        let $firstEqual :=
            if ($output[1] instance of text()) then
                deep-equal($output[1], $expected[1])
            else
                t:compare-xml(subsequence($output, 2), subsequence($expected, 2))
        return
            if (not($firstEqual)) then
                false()
            else if (count($output) gt 1) then
                t:compare-xml(subsequence($output, 2), subsequence($expected, 2))
            else
                true()
};

declare function t:run-test($test as element(test), $count as xs:integer) {
	let $context := t:init-prolog($test)
	let $null :=
	   if ($test/@trace eq 'yes') then
	       (system:clear-trace(), system:enable-tracing(true(), false()))
       else ()
    let $queryOutput :=
		util:catch("*",
			util:eval(concat($context, $test/code/string())),
			<error>Compilation error: {$util:exception-message}</error>
		)
	let $output := if ($test/@trace eq 'yes') then system:trace() else $queryOutput
    let $expected :=
        if ($test/@output eq 'text') then
            data($test/expected)
        else $test/expected/node()
    let $OK :=
        if ($test/xpath) then
            t:test(t:xpath($output, $test/xpath))
        else if ($test/@output eq 'text') then
            normalize-space(string-join(for $x in $output return string($x),' ')) eq normalize-space($expected)
        else
            t:compare-xml($output, $expected)
    let $expanded :=
		if ($output instance of node()) then
        	util:expand($output)
		else
			$output
    return
        <test n="{$count}" pass="{$OK}">
        {
            if (not($OK)) then
                ($test/task, $test/expected, <result>{$expanded}</result>)
            else ()
        }
        </test>
};

declare function t:xpath($output as item()*, $xpath as element()) {
    for $prefix in in-scope-prefixes($xpath)
    let $nsuri := namespace-uri-for-prefix($prefix, $xpath)
    return
        if ($prefix != 'xml') then
            util:declare-namespace($prefix, $nsuri)
        else (),
    let $expr := $xpath/string()
    return
        if (matches($expr, "^\s*/")) then
            util:eval(concat("$output", $expr))
        else
            util:eval($expr)
};

declare function t:run-testSet($set as element(TestSet)) {
    let $copy := util:expand($set)
    let $null := t:setup($copy/setup)
    let $result := util:expand(
           <TestSet>
           {$copy/testName}
           {$copy/description}
           {
               for $test at $p in $copy/test
               return
                   t:run-test($test, $p)
           }
           </TestSet>
        )
    let $null := t:tearDown($copy/tearDown)
    return $result
};

declare function t:format-testResult($result) {
    let $formatted :=

{$result/testName}

{$result/description/p}

          {for $test in $result//test
           return

                    {$test/@n/.}
                    {$test/@pass/.}

          }

     return
        $formatted
};