changes to DataView; base_elem in query optional; custom result highlighting (attributes matching)

xquery version '3.0';

(:
: Module Name: FCS
: Date: 2012-03-01
:
: XQuery
: Specification : XQuery v1.0
: Module Overview: Federated Content Search
:)

(:~ This module provides methods to serve XML-data via the FCS/SRU-interface
: @see http://clarin.eu/fcs
: @author Matej Durco
: @since 2011-11-01
: @version 1.1
:)
module namespace fcs = "http://clarin.eu/fcs/1.0";

declare namespace err = "http://www.w3.org/2005/xqt-errors";
declare namespace sru = "http://www.loc.gov/zing/srw/";
declare namespace zr = "http://explain.z3950.org/dtd/2.0/";
declare namespace tei = "http://www.tei-c.org/ns/1.0";
declare namespace cmd = "http://www.clarin.eu/cmd/";
import module namespace request="http://exist-db.org/xquery/request";
import module namespace diag =  "http://www.loc.gov/zing/srw/diagnostic/" at  "modules/diagnostics/diagnostics.xqm";

import module namespace repo-utils = "http://aac.ac.at/content_repository/utils" at  "repo-utils.xqm";
import module namespace kwic = "http://exist-db.org/xquery/kwic";
import module namespace cmdcoll = "http://clarin.eu/cmd/collections" at  "/db/cr/modules/cmd/cmd-collections.xqm";
import module namespace cmdcheck = "http://clarin.eu/cmd/check" at  "/db/cr/modules/cmd/cmd-check.xqm";
import module namespace cql = "http://exist-db.org/xquery/cql" at "/db/cr/modules/cqlparser/cqlparser.xqm";

declare option exist:serialize 'highlight-matches=both';
declare variable $fcs:explain as xs:string := "explain";
declare variable $fcs:scan  as xs:string := "scan";
declare variable $fcs:searchRetrieve as xs:string := "searchRetrieve";

declare variable $fcs:scanSortText as xs:string := "text";
declare variable $fcs:scanSortSize as xs:string := "size";
declare variable $fcs:indexXsl := doc('index.xsl');
declare variable $fcs:kwicWidth := 30;

(:~ The main entry-point. Processes request-parameters
@returns the result document (in xml, html or json)
:)
declare function fcs:repo($config-file as xs:string) as item()* {
  let
    $config := if (doc-available($config-file)) then doc($config-file)
                        else diag:diagnostics("general-error", concat("config not available: ", $config-file)) ,

        (: accept "q" as synonym to query-param; "query" overrides:)
    $q := request:get-parameter("q", ""),
    $query := request:get-parameter("query", $q),
        (: if query-parameter not present, 'explain' as DEFAULT operation, otherwise 'searchRetrieve' :)
    $operation :=  if ($query eq "") then request:get-parameter("operation", $fcs:explain)
                    else request:get-parameter("operation", $fcs:searchRetrieve),
    $x-format := request:get-parameter("x-format", $repo-utils:responseFormatXml),
    $x-context := request:get-parameter("x-context", ""),
    (:
    $query-collections :=
    if (matches($collection-params, "^root$") or $collection-params eq "") then
      $cr:collectionRoot
    else
		tokenize($collection-params,','),
        :)
(:      $collection-params, :)
  $max-depth as xs:integer := xs:integer(request:get-parameter("maxdepth", 1))

  let $result :=
      (: if ($operation eq $cr:getCollections) then
		cr:get-collections($query-collections, $format, $max-depth)
      else :)
      if ($operation eq $fcs:explain) then
          fcs:explain($x-context, $config)
      else if ($operation eq $fcs:scan) then
		let $scanClause := request:get-parameter("scanClause", ""),
		$start-term := request:get-parameter("startTerm", 1),
		$response-position := request:get-parameter("responsePosition", 1),
		$max-terms := request:get-parameter("maximumTerms", 50),
	    $max-depth := request:get-parameter("x-maximumDepth", 1),
		$sort := request:get-parameter("sort", 'text')
		 return fcs:scan($scanClause, $x-context, $start-term, $max-terms, $response-position, $max-depth, $sort, $config)
        (: return fcs:scan($scanClause, $x-context) :)
	  else if ($operation eq $fcs:searchRetrieve) then
        if ($query eq "") then diag:diagnostics("param-missing", "query")
        else
      	 let $cql-query := $query,
			$start-item := request:get-parameter("startRecord", 1),
			$max-items := request:get-parameter("maximumRecords", 50),
			$x-dataview := request:get-parameter("x-dataview", repo-utils:config-value($config, 'default.dataview'))
            (: return cr:search-retrieve($cql-query, $query-collections, $format, xs:integer($start-item), xs:integer($max-items)) :)
            return fcs:search-retrieve($cql-query, $x-context, xs:integer($start-item), xs:integer($max-items), $x-dataview, $config)
    else
      diag:diagnostics("unsupported-operation", $operation)

   return  repo-utils:serialise-as($result, $x-format, $operation, $config)

};

(:~ handles the explain-operation requests.
: @param $x-context optional, identifies a resource to return the explain-record for. (Accepts both MD-PID or Res-PID (MdSelfLink or ResourceRef/text))
: @returns either the default root explain-record, or - when provided with the $x-context parameter - the explain-record of given resource
:)
declare function fcs:explain($x-context as xs:string*, $config) as item()* {
    let $context := if ($x-context) then $x-context
                    else repo-utils:config-value($config, 'explain')
    let $md-dbcoll := collection(repo-utils:config-value($config,'metadata.path'))
   let $explain := $md-dbcoll//CMD[Header/MdSelfLink/text() eq $context or .//ResourceRef/text() eq $context]//(explain|zr:explain) (: //ResourceRef/text() :)

    return $explain
};

(:
TODO?: only read explicit indexes + create index on demand.
:)
(:
declare function fcs:scan($scanClause as xs:string, $x-context as xs:string*) {

    let $clause-tokens := tokenize($scanClause,'='),
        $index := $clause-tokens[1],
        $term := $clause-tokens[2],
        (\:$map-index := $repo-utils:mappings/map/index[@key=$index], :\)
        $index-file := concat(repo-utils:config-value('index.prefix'),$index,'.xml'),
        h$result := doc($index-file)

    return $result
};
:)

(:~ This function handles the scan-operation requests
:  (derived from cmd:scanIndex function)
: two phases:
:   1. one create full index for given path/element within given collection (for now the collection is stored in the name - not perfect) (and cache)
:	2. select wished subsequence (on second call, only the second step is performed)

: actually wrapping function handling caching of the actual scan result (coming from do-scan-default())
: or fetching the cached result (if available)
: also dispatching to cmd-collections for the scan-clause=cmd.collections
:   there either scanClause-filter or x-context is used as constraint (scanClause-filter is prefered))

:)
declare function fcs:scan($scan-clause  as xs:string, $x-context as xs:string+, $start-item as xs:integer, $max-items as xs:integer, $response-position as xs:integer, $max-depth as xs:integer, $p-sort as xs:string?, $config) as item()? {

  let $scx := tokenize($scan-clause,'='),
	 $index-name := $scx[1],
	 (:$index := fcs:get-mapping($index-name, $x-context, $config ), :)
	 (: if no index-mapping found, dare to use the index-name as xpath :)
(:	 $index-xpath := if ($index/text()) then $index/text() else $index-name, :)
     $index-xpath :=  fcs:index-as-xpath($index-name,$x-context, $config ),
 	 $filter := ($scx[2],'')[1],
	 $sort := if ($p-sort eq $fcs:scanSortText or $p-sort eq $fcs:scanSortSize) then $p-sort else $fcs:scanSortText

	 (: WATCHME: this is quite unreliable, it relies on manual (urn-like) creation of the ids for the resources)
	   it won't work once the id become PIDs
	   this is only used for generating the cache-id to store the resultset :)
	 let $short-xcontext := substring-after($x-context, concat(repo-utils:config-value($config, 'explain'),':'))
	 let $sanitized-xcontext := if ($short-xcontext='') then repo-utils:sanitize-name($x-context) else $short-xcontext
    let $index-doc-name := repo-utils:gen-cache-id("index", ($sanitized-xcontext, $index-name, $sort, $max-depth),""),

  (: get the base-index from cache, or create and cache :)
  $index-scan := if (repo-utils:is-in-cache($index-doc-name, $config)) then
          repo-utils:get-from-cache($index-doc-name, $config)
        else
            let $data :=
                if ($index-name eq $cmdcoll:scan-collection) then
                    let $starting-handle := if ($filter ne '') then $filter else $x-context
                    return cmdcoll:colls($starting-handle, $max-depth, cmdcoll:base-dbcoll($config))
                  (: just a hack for now, handling of special indexes should be put solved in some more easily extensible way :)
                else if ($index-name eq 'cmd.profile') then
                    let $context := repo-utils:context-to-collection($x-context, $config)
                    return  cmdcheck:stat-profiles($context)
                else
                    fcs:do-scan-default($scan-clause, $index-xpath, $x-context, $sort, $config)

        return repo-utils:store-in-cache($index-doc-name , $data, $config)

	(: extract the required subsequence (according to given sort) :)
	let $res-nodeset := transform:transform($index-scan,$fcs:indexXsl,
			<parameters><param name="scan-clause" value="{$scan-clause}"/>
			            <param name="mode" value="subsequence"/>
						<param name="sort" value="{$sort}"/>
						<param name="filter" value="{$filter}"/>
						<param name="start-item" value="{$start-item}"/>
					    <param name="response-position" value="{$response-position}"/>
						<param name="max-items" value="{$max-items}"/>
			</parameters>),
		$count-items := count($res-nodeset/sru:term),
		(: $colls := if (fn:empty($collection)) then '' else fn:string-join($collection, ","), :)
        $colls := string-join( $x-context, ', ') ,
		$created := fn:current-dateTime()
		(: $scan-clause := concat($xpath, '=', $filter) :)
		(: $res := <Terms colls="{$colls}" created="{$created}" count_items="{$count-items}"
					start-item="{$start-item}" max-items="{$max-items}" sort="{$sort}" scanClause="{$scan-clause}"  >{$res-term}</Terms>
					  count_text="{$count-text}" count_distinct_text="{$distinct-text-count}" :)
        (: $res := <sru:scanResponse>
                    <sru:version>1.2</sru:version>
                    {$res-nodeset}
                    <sru:echoedScanRequest>
                        <sru:scanClause>{$scan-clause}</sru:scanClause>
                        <sru:maximumTerms>{ $count-items }</sru:maximumTerms>

                    </sru:echoedScanRequest>
    			</sru:scanResponse>
           :)
(:	let	$result-count := $doc/Term/@count,
    $result-seq := fn:subsequence($doc/Term/v, $start-item, $end-item),
	$result-frag := ($doc/Term, $result-seq),
    $seq-count := fn:count($result-seq) :)

  return $res-nodeset
};

declare function fcs:do-scan-default($scan-clause as xs:string, $index-xpath as xs:string, $x-context as xs:string, $sort as xs:string, $config) as item()* {
  (:        let $getnodes := util:eval(fn:concat("$data-collection/descendant-or-self::", $index-xpath)),:)
    let $data-collection := repo-utils:context-to-collection($x-context, $config)
        let $getnodes := util:eval(fn:concat("$data-collection//", $index-xpath)),
            (: if we collected strings, we have to wrap them in elements
                    to be able to work with them in xsl :)
            $prenodes := if ($getnodes[1] instance of xs:string) then
                                    for $t in $getnodes return <v>{$t}</v>
                            else if ($getnodes[1] instance of attribute()) then
                                    for $t in $getnodes return <v>{xs:string($t)}</v>
                            else for $t in $getnodes return <v>{string-join($t//text()," ")}</v>
        let $nodes := <nodes path="{fn:concat('//', $index-xpath)}"  >{$prenodes}</nodes>,
        	(: use XSLT-2.0 for-each-group functionality to aggregate the values of a node - much, much faster, than XQuery :)
   	    $data := transform:transform($nodes,$fcs:indexXsl,
   	                <parameters><param name="scan-clause" value="{$scan-clause}"/>
   	                <param name="sort" value="{$sort}"/></parameters>)

   	  return $data
};

(:~ main search function (handles the searchRetrieve-operation request)
:)
declare function fcs:search-retrieve($query as xs:string, $x-context as xs:string*, $startRecord as xs:integer, $maximumRecords as xs:integer, $x-dataview as xs:string*, $config) as item()* {

        let $start-time := util:system-dateTime()
        let $data-collection := repo-utils:context-to-collection($x-context, $config)
        (:if ($x-context) then collection($repo-utils:mappings//map[xs:string(@key) eq $x-context]/@path)
                                else $repo-utils:data-collection:)

        let $xpath-query := fcs:transform-query ($query, $x-context, $config, true())

            (: if there was a problem with the parsing the query  don't evaluate :)
        let $results := if ($xpath-query instance of text() or $xpath-query instance of xs:string) then
                                util:eval(concat("$data-collection",$xpath-query))
                           else ()

        let	$result-count := fn:count($results),
        $result-seq := fn:subsequence($results, $startRecord, $maximumRecords),

        $seq-count := fn:count($result-seq),
        $end-time := util:system-dateTime(),
        $result-seq-match := fcs:highlight-result($result-seq, $query, $x-context, $config),

        $records :=
          <sru:records>
    	       {for $rec at $pos in $result-seq-match
    	           let $rec-data := fcs:format-record-data($rec,$x-dataview, $x-context, $config)
    	           return
    	               <sru:record>
    	                   <sru:recordSchema>http://clarin.eu/fcs/1.0/Resource.xsd</sru:recordSchema>
    	                   <sru:recordPacking>xml</sru:recordPacking>
    	                   <sru:recordData>
    	                     {$rec-data}
                            </sru:recordData>
    	                   <sru:recordPosition>{$pos}</sru:recordPosition>
    	                   <sru:recordIdentifier>{xs:string($rec-data/fcs:ResourceFragment/@ref) }</sru:recordIdentifier>
    	                </sru:record>
    	       }
          </sru:records>,
        $end-time2 := util:system-dateTime(),
        $result :=
        <sru:searchRetrieveResponse>
          <sru:numberOfRecords>{$result-count}</sru:numberOfRecords>
          <sru:echoedSearchRetrieveRequest>
              <sru:version>1.2</sru:version>
              <sru:query>{$query}</sru:query>
              <fcs:x-context>{$x-context}</fcs:x-context>
              <fcs:x-dataview>{$x-dataview}</fcs:x-dataview>
              <sru:startRecord>{$startRecord}</sru:startRecord>
              <sru:maximumRecords>{$maximumRecords}</sru:maximumRecords>
              <sru:query>{$query}</sru:query>
              <sru:baseUrl>{repo-utils:config-value($config, "base.url")}</sru:baseUrl>
          </sru:echoedSearchRetrieveRequest>
          <sru:extraResponseData>
          	<fcs:returnedRecords>{$seq-count}</fcs:returnedRecords>
    		<fcs:duration>{($end-time - $start-time, $end-time2 - $end-time) }</fcs:duration>
    		<fcs:transformedQuery>{ $xpath-query }</fcs:transformedQuery>
          </sru:extraResponseData>
          { ($records,
            if ($xpath-query instance of element(diagnostics)) then  <sru:diagnostics>{$xpath-query/*}</sru:diagnostics> else ()
           ) }
        </sru:searchRetrieveResponse>

        return $result

};

declare function fcs:format-record-data($record-data as node(), $data-view as xs:string*, $x-context as xs:string*, $config as node()) as item()*  {

                        (:	      cmdcoll:get-md-collection-name($raw-record-data):)
	let $title := fcs:apply-index ($record-data, "title",$x-context, $config)
	let $resource-pid := fcs:apply-index ($record-data, "resource-pid",$x-context, $config)
	let $resourcefragment-pid := fcs:apply-index ($record-data, "resourcefragment-pid",$x-context, $config)
	(: to repeat current $x-format param-value in the constructed requested :)
	let $x-format := request:get-parameter("x-format", $repo-utils:responseFormatXml)
	let $resourcefragment-ref := if (exists($resourcefragment-pid)) then concat('?operation=searchRetrieve&query=resourcefragment-pid="', xmldb:encode-uri($resourcefragment-pid), '"&x-dataview=full&x-context=', $x-context)
	                                      else ""

    let $kwic := if ('kwic' = $data-view) then
                   let $kwic-config := <config width="{$fcs:kwicWidth}"/>
                   let $kwic-html := kwic:summarize($record-data, $kwic-config)

                    return if (exists($kwic-html)) then
                                           <fcs:DataView type="kwic">{
                                               for $match in $kwic-html
                                               return (<fcs:c type="left">{$match/span[1]/text()}</fcs:c>,
                                       (: <c type="left">{kwic:truncate-previous($exp-rec, $matches[1], (), 10, (), ())}</c> :)
                                                      <fcs:kw>{$match/span[2]/text()}</fcs:kw>,
                                                      <fcs:c type="right">{$match/span[3]/text()}</fcs:c>)
                                       (: let $summary  := kwic:get-summary($exp-rec, $matches[1], $config) :)
                        (:	                               <fcs:DataView type="kwic-html">{$kwic-html}</fcs:DataView>:)
                                            }</fcs:DataView>
(: DEBUG:                                            <fcs:DataView>{$kwic-html}</fcs:DataView>) :)
                                     else (: if no kwic-match let's take first 100 characters
                                        There c/should be some more sophisticated way to extract most significant info
                                        e.g. match on the query-field :)
                                       <fcs:DataView type="kwic">{substring($record-data,1,$fcs:kwicWidth)}</fcs:DataView>
                     else ()
    let $title := <fcs:DataView type="title">{$title}</fcs:DataView>

    return if ($data-view = 'raw') then $record-data
            else <fcs:Resource pid="{$resource-pid}" >
                       <fcs:ResourceFragment pid="{$resourcefragment-pid}" ref="{$resourcefragment-ref}" >
                         {($title, $kwic,
                         if ('full' = $data-view or not(exists($kwic))) then <fcs:DataView type="{$data-view}">{$record-data}</fcs:DataView>
                             else ()
                           )}
                           </fcs:ResourceFragment>
                       </fcs:Resource>

};

(:~ This expects a CQL-query that it translates to XPath

It relies on the external cqlparser-module, that delivers the query in XCQL-format (parse-tree of the query as XML)
and then applies a stylesheet

@params $x-context identifier of a resource/collection
@returns XPath version of the CQL-query, or diagnostics bubbling up the call-chain if parse-error!
:)
declare function fcs:transform-query($cql-query as xs:string, $x-context as xs:string, $config, $base-elem-flag as xs:boolean) as item() {
    let $mappings := repo-utils:config-value($config, 'mappings'),
    $xpath-query := cql:cql2xpath ($cql-query, $x-context, $mappings),

    $final-xpath := if ($base-elem-flag) then
                let $context-map := fcs:get-mapping("",$x-context, $config),
(:                    $index-map := $context-map/index[xs:string(@key) eq $index],
                (\: get either a) the specific base-element for the index,
                      b) the default for given map,
                      c) the index itself :\)
                    $base-elem := if (exists($index-map/@base_elem)) then xs:string($index-map/@base_elem)
                        else if (exists($context-map/@base_elem)) then xs:string($context-map/@base_elem)
                        else $index:)
                    $base-elem := if ($context-map[@base_elem]) then
                                        concat('ancestor-or-self::', $context-map/@base_elem)
                                    else if ($mappings//map[@key='default'][@base_elem]) then
                                        concat('ancestor-or-self::', $mappings//map[@key='default']/@base_elem)
                                    else '.'

                return concat($xpath-query,'/', $base-elem)
            else
                $xpath-query

      return $final-xpath
 };

(: old version, "manually" parsing the cql-string
it accepted/understood:
term
index=term
index relation term
:)
declare function fcs:transform-query-old($cql-query as xs:string, $x-context as xs:string, $type as xs:string, $config ) as xs:string {

    let $query-constituents := if (contains($cql-query,'=')) then
                                        tokenize($cql-query, "=")
                                   else tokenize($cql-query, " ")
	let $index := if ($type eq 'scan' or count($query-constituents)>1 )  then $query-constituents[1]
	                else "cql.serverChoice"
	let $searchTerm := if (count($query-constituents)=1) then
							$cql-query
						else if (count($query-constituents)=2) then (: tokenized with '=' :)
						    normalize-space($query-constituents[2])
						else
							$query-constituents[3]

(: try to get a mapping specific to given context, else take the default :)
    let $context-map := fcs:get-mapping("",$x-context, $config),

(: TODO: for every index in $xcql :)
            (: try  to get a) a mapping for given index within the context-map,
                    b) in any of the mapping (if not found in the context-map) , - potentially dangerous!!
                    c) or else take the index itself :)
        $mappings := doc(repo-utils:config-value($config, 'mappings')),
        $index-map := $context-map/index[xs:string(@key) eq $index],
        $resolved-index := if (exists($index-map)) then $index-map/text()
                           else if (exists($mappings//index[xs:string(@key) eq $index])) then
                                $mappings//index[xs:string(@key) eq $index]
                            else $index
            ,
            (: get either a) the specific base-element for the index,
                  b) the default for given map,
                  c) the index itself :)
        $base-elem := if (exists($index-map/@base_elem)) then xs:string($index-map/@base_elem)
                        else if (exists($context-map/@base_elem)) then xs:string($context-map/@base_elem)
                        else $index,
            (: <index status="indexed"> - flag to know if ft-indexes can be used.
            TODO?: should be checked against the actual index-configuration :)
        $indexed := (xs:string($index-map/@status) eq 'indexed'),
        $match-on := if (exists($index-map/@use) ) then xs:string($index-map/@use) else '.'

	let $res := if ($type eq 'scan') then
	                   concat("//", $resolved-index, if ($match-on ne '.') then concat("/", $match-on) else '')
	               else
	                   concat("//", $resolved-index, "[",
	                                       if ($indexed) then
	                                               concat("ft:query(", $match-on, ",<term>",translate($searchTerm,'"',''), "</term>)")
	                                           else
	                                               concat("contains(", $match-on, ",'", translate($searchTerm,'"',''), "')")
	                                        , "]",
								"/ancestor-or-self::", $base-elem)

	return $res

};

(:~ gets the mapping-entry for the index

first tries a mapping within given context, then tries defaults.

if $index-param = "" return the map-element,
    else - if found - return the index-element
:)
declare function fcs:get-mapping($index as xs:string, $x-context as xs:string+, $config) as node()* {
    let $mappings := doc(repo-utils:config-value($config, 'mappings')),

    $context-map := if (exists($mappings//map[xs:string(@key) eq $x-context])) then
                                $mappings//map[xs:string(@key) eq $x-context]
                            else $mappings//map[xs:string(@key) eq 'default'],
    $context-index := $context-map/index[xs:string(@key) eq $index]

    return  if ($index eq '') then
                $context-map
             else if (exists($context-index)) then
                        $context-index
                else (: if no contextual index, dare to take any index - may be dangerous!  :)
                    let $any-index := $mappings//index[xs:string(@key) eq $index]
                    return $any-index
};

declare function fcs:indexes-in-query($cql as xs:string, $x-context as xs:string+, $config) as node()* {

    let $xcql := cql:cql-to-xcql($cql)
    let $indexes := for $ix in $xcql//index
                        return fcs:get-mapping($ix, $x-context, $config)

    return $indexes

};

(:~ evaluate given index on given piece of data
used when formatting record-data, to put selected pieces of data (indexes) into the results record

@returns result of evaluating given index's path on given data. or empty node if no mapping index was found
:)
declare function fcs:apply-index($data, $index as xs:string, $x-context as xs:string+, $config) as item()* {

  let $index-map := fcs:get-mapping($index,$x-context, $config),
  $match-on := if (exists($index-map/@use) ) then concat('/', xs:string($index-map/@use)) else ''

  return if (exists($index-map/path/text())) then util:eval(concat("$data//", $index-map/path/text(), $match-on))
            else ()
};

(:~ gets the mapping for the index and creates an xpath (UNION)

@param $index index-key as known to mappings

@returns xpath-equivalent of given index as defined in mappings; multiple xpaths are translated to a UNION,
           value of @use-attribute is also attached;
         if no mapping found, returns the input-index unchanged
:)
declare function fcs:index-as-xpath($index as xs:string, $x-context as xs:string+, $config) as xs:string {
    let $index-map := fcs:get-mapping($index, $x-context, $config )
     return if (exists($index-map)) then
                        let $match-on := if (exists($index-map/@use) ) then concat('/', xs:string($index-map/@use)) else ''
                        return translate(concat('(', string-join($index-map/path,'|'),')', $match-on),'.','/')
                    else $index

};

declare function fcs:highlight-result($result as node()*, $query as xs:string, $x-context as xs:string+, $config) as item()* {

    let $indexes := fcs:indexes-in-query($query, $x-context, $config)
    (: if any of the indexes matches on an attribute, use the custom highlighting, else use the kwic-module :)
    let $processed-result := if (exists($indexes[contains(@use,'@')])) then
                               let $xpath-query := fcs:transform-query ($query, $x-context, $config, false())
                               let $match := util:eval (concat("$result", $xpath-query))
                               return fcs:process-result($result, $match)
                    else util:expand($result, "highlight-matches=both")

    return $processed-result
};

(:~ this is to mark matched-element, even if usual index-matching-mechanism fails (which is when matching on attributes)
:)

declare function fcs:process-result($result as node()*, $matching as node()*) as item()* {
  for $node in $result
    return  typeswitch ($node)
        case text() return $node
        case comment() return $node
        (:case element() return  if ($node = $matching) then <exist:match>{fcs:process-result-default($node, $matching )}</exist:match>:)

        case element() return  if ($node = $matching) then <exist:match>{$node//text() }</exist:match>
                    else  fcs:process-result-default($node, $matching )
        default return fcs:process-result-default($node, $matching )

    };

declare function fcs:process-result-default($node as node(), $matching as node()*) as item()* {
  element {$node/name()} {($node/@*, fcs:process-result($node/node(), $matching))}
  (: <div class="default">{$node/name()} </div> :)
 };

xquery version '3.0';

(:
: Module Name: FCS
: Date: 2012-03-01
:
: XQuery
: Specification : XQuery v1.0
: Module Overview: Federated Content Search
:)

(:~ This module provides methods to serve XML-data via the FCS/SRU-interface
: @see http://clarin.eu/fcs
: @author Matej Durco
: @since 2011-11-01
: @version 1.1
:)
module namespace fcs = "http://clarin.eu/fcs/1.0";

declare namespace err = "http://www.w3.org/2005/xqt-errors";
declare namespace sru = "http://www.loc.gov/zing/srw/";
declare namespace zr = "http://explain.z3950.org/dtd/2.0/";
declare namespace tei = "http://www.tei-c.org/ns/1.0";
declare namespace cmd = "http://www.clarin.eu/cmd/";
import module namespace request="http://exist-db.org/xquery/request";
import module namespace diag =  "http://www.loc.gov/zing/srw/diagnostic/" at  "modules/diagnostics/diagnostics.xqm";

import module namespace repo-utils = "http://aac.ac.at/content_repository/utils" at  "repo-utils.xqm";
import module namespace kwic = "http://exist-db.org/xquery/kwic";
import module namespace cmdcoll = "http://clarin.eu/cmd/collections" at  "/db/cr/modules/cmd/cmd-collections.xqm";
import module namespace cmdcheck = "http://clarin.eu/cmd/check" at  "/db/cr/modules/cmd/cmd-check.xqm";
import module namespace cql = "http://exist-db.org/xquery/cql" at "/db/cr/modules/cqlparser/cqlparser.xqm";

declare variable $fcs:explain as xs:string := "explain";
declare variable $fcs:scan  as xs:string := "scan";
declare variable $fcs:searchRetrieve as xs:string := "searchRetrieve";

declare variable $fcs:scanSortText as xs:string := "text";
declare variable $fcs:scanSortSize as xs:string := "size";
declare variable $fcs:indexXsl := doc('index.xsl');
declare variable $fcs:kwicWidth := 30;

(:~ The main entry-point. Processes request-parameters
@returns the result document (in xml, html or json)
:)
declare function fcs:repo($config-file as xs:string) as item()* {
  let
    $config := if (doc-available($config-file)) then doc($config-file)
                        else diag:diagnostics("general-error", concat("config not available: ", $config-file)) ,

        (: accept "q" as synonym to query-param; "query" overrides:)
    $q := request:get-parameter("q", ""),
    $query := request:get-parameter("query", $q),
        (: if query-parameter not present, 'explain' as DEFAULT operation, otherwise 'searchRetrieve' :)
    $operation :=  if ($query eq "") then request:get-parameter("operation", $fcs:explain)
                    else request:get-parameter("operation", $fcs:searchRetrieve),
    $x-format := request:get-parameter("x-format", $repo-utils:responseFormatXml),
    $x-context := request:get-parameter("x-context", ""),
    (:
    $query-collections :=
    if (matches($collection-params, "^root$") or $collection-params eq "") then
      $cr:collectionRoot
    else
		tokenize($collection-params,','),
        :)
(:      $collection-params, :)
  $max-depth as xs:integer := xs:integer(request:get-parameter("maxdepth", 1))

  let $result :=
      (: if ($operation eq $cr:getCollections) then
		cr:get-collections($query-collections, $format, $max-depth)
      else :)
      if ($operation eq $fcs:explain) then
          fcs:explain($x-context, $config)
      else if ($operation eq $fcs:scan) then
		let $scanClause := request:get-parameter("scanClause", ""),
		$start-term := request:get-parameter("startTerm", 1),
		$response-position := request:get-parameter("responsePosition", 1),
		$max-terms := request:get-parameter("maximumTerms", 50),
	    $max-depth := request:get-parameter("x-maximumDepth", 1),
		$sort := request:get-parameter("sort", 'text')
		 return fcs:scan($scanClause, $x-context, $start-term, $max-terms, $response-position, $max-depth, $sort, $config)
        (: return fcs:scan($scanClause, $x-context) :)
	  else if ($operation eq $fcs:searchRetrieve) then
        if ($query eq "") then diag:diagnostics("param-missing", "query")
        else
      	 let $cql-query := $query,
			$start-item := request:get-parameter("startRecord", 1),
			$max-items := request:get-parameter("maximumRecords", 50),
			$x-dataview := request:get-parameter("x-dataview", repo-utils:config-value($config, 'default.dataview'))
            (: return cr:search-retrieve($cql-query, $query-collections, $format, xs:integer($start-item), xs:integer($max-items)) :)
            return fcs:search-retrieve($cql-query, $x-context, xs:integer($start-item), xs:integer($max-items), $x-dataview, $config)
    else
      diag:diagnostics("unsupported-operation", $operation)

   return  repo-utils:serialise-as($result, $x-format, $operation, $config)

};

(:~ handles the explain-operation requests.
: @param $x-context optional, identifies a resource to return the explain-record for. (Accepts both MD-PID or Res-PID (MdSelfLink or ResourceRef/text))
: @returns either the default root explain-record, or - when provided with the $x-context parameter - the explain-record of given resource
:)
declare function fcs:explain($x-context as xs:string*, $config) as item()* {
    let $context := if ($x-context) then $x-context
                    else repo-utils:config-value($config, 'explain')
    let $md-dbcoll := collection(repo-utils:config-value($config,'metadata.path'))
   let $explain := $md-dbcoll//CMD[Header/MdSelfLink/text() eq $context or .//ResourceRef/text() eq $context]//(explain|zr:explain) (: //ResourceRef/text() :)

    return $explain
};

(:
TODO?: only read explicit indexes + create index on demand.
:)
(:
declare function fcs:scan($scanClause as xs:string, $x-context as xs:string*) {

    let $clause-tokens := tokenize($scanClause,'='),
        $index := $clause-tokens[1],
        $term := $clause-tokens[2],
        (\:$map-index := $repo-utils:mappings/map/index[@key=$index], :\)
        $index-file := concat(repo-utils:config-value('index.prefix'),$index,'.xml'),
        h$result := doc($index-file)

    return $result
};
:)

(:~ This function handles the scan-operation requests
:  (derived from cmd:scanIndex function)
: two phases:
:   1. one create full index for given path/element within given collection (for now the collection is stored in the name - not perfect) (and cache)
:	2. select wished subsequence (on second call, only the second step is performed)

: actually wrapping function handling caching of the actual scan result (coming from do-scan-default())
: or fetching the cached result (if available)
: also dispatching to cmd-collections for the scan-clause=cmd.collections
:   there either scanClause-filter or x-context is used as constraint (scanClause-filter is prefered))

:)
declare function fcs:scan($scan-clause  as xs:string, $x-context as xs:string+, $start-item as xs:integer, $max-items as xs:integer, $response-position as xs:integer, $max-depth as xs:integer, $p-sort as xs:string?, $config) as item()? {

  let $scx := tokenize($scan-clause,'='),
	 $index-name := $scx[1],
	 (:$index := fcs:get-mapping($index-name, $x-context, $config ), :)
	 (: if no index-mapping found, dare to use the index-name as xpath :)
(:	 $index-xpath := if ($index/text()) then $index/text() else $index-name, :)
     $index-xpath :=  fcs:index-as-xpath($index-name,$x-context, $config ),
 	 $filter := ($scx[2],'')[1],
	 $sort := if ($p-sort eq $fcs:scanSortText or $p-sort eq $fcs:scanSortSize) then $p-sort else $fcs:scanSortText

	 (: WATCHME: this is quite unreliable, it relies on manual (urn-like) creation of the ids for the resources)
	   it won't work once the id become PIDs
	   this is only used for generating the cache-id to store the resultset :)
	 let $short-xcontext := substring-after($x-context, concat(repo-utils:config-value($config, 'explain'),':'))
	 let $sanitized-xcontext := if ($short-xcontext='') then repo-utils:sanitize-name($x-context) else $short-xcontext
    let $index-doc-name := repo-utils:gen-cache-id("index", ($sanitized-xcontext, $index-name, $sort, $max-depth),""),

  (: get the base-index from cache, or create and cache :)
  $index-scan := if (repo-utils:is-in-cache($index-doc-name, $config)) then
          repo-utils:get-from-cache($index-doc-name, $config)
        else
            let $data :=
                if ($index-name eq $cmdcoll:scan-collection) then
                    let $starting-handle := if ($filter ne '') then $filter else $x-context
                    return cmdcoll:colls($starting-handle, $max-depth, cmdcoll:base-dbcoll($config))
                  (: just a hack for now, handling of special indexes should be put solved in some more easily extensible way :)
                else if ($index-name eq 'cmd.profile') then
                    let $context := repo-utils:context-to-collection($x-context, $config)
                    return  cmdcheck:stat-profiles($context)
                else
                    fcs:do-scan-default($scan-clause, $index-xpath, $x-context, $sort, $config)

        return repo-utils:store-in-cache($index-doc-name , $data, $config)

	(: extract the required subsequence (according to given sort) :)
	let $res-nodeset := transform:transform($index-scan,$fcs:indexXsl,
			<parameters><param name="scan-clause" value="{$scan-clause}"/>
			            <param name="mode" value="subsequence"/>
						<param name="sort" value="{$sort}"/>
						<param name="filter" value="{$filter}"/>
						<param name="start-item" value="{$start-item}"/>
					    <param name="response-position" value="{$response-position}"/>
						<param name="max-items" value="{$max-items}"/>
			</parameters>),
		$count-items := count($res-nodeset/sru:term),
		(: $colls := if (fn:empty($collection)) then '' else fn:string-join($collection, ","), :)
        $colls := string-join( $x-context, ', ') ,
		$created := fn:current-dateTime()
		(: $scan-clause := concat($xpath, '=', $filter) :)
		(: $res := <Terms colls="{$colls}" created="{$created}" count_items="{$count-items}"
					start-item="{$start-item}" max-items="{$max-items}" sort="{$sort}" scanClause="{$scan-clause}"  >{$res-term}</Terms>
					  count_text="{$count-text}" count_distinct_text="{$distinct-text-count}" :)
        (: $res := <sru:scanResponse>
                    <sru:version>1.2</sru:version>
                    {$res-nodeset}
                    <sru:echoedScanRequest>
                        <sru:scanClause>{$scan-clause}</sru:scanClause>
                        <sru:maximumTerms>{ $count-items }</sru:maximumTerms>

                    </sru:echoedScanRequest>
    			</sru:scanResponse>
           :)
(:	let	$result-count := $doc/Term/@count,
    $result-seq := fn:subsequence($doc/Term/v, $start-item, $end-item),
	$result-frag := ($doc/Term, $result-seq),
    $seq-count := fn:count($result-seq) :)

  return $res-nodeset
};

declare function fcs:do-scan-default($scan-clause as xs:string, $index-xpath as xs:string, $x-context as xs:string, $sort as xs:string, $config) as item()* {
  (:        let $getnodes := util:eval(fn:concat("$data-collection/descendant-or-self::", $index-xpath)),:)
    let $data-collection := repo-utils:context-to-collection($x-context, $config)
        let $getnodes := util:eval(fn:concat("$data-collection//", $index-xpath)),
            (: if we collected strings, we have to wrap them in elements
                    to be able to work with them in xsl :)
            $prenodes := if ($getnodes[1] instance of xs:string) then
                                    for $t in $getnodes return <v>{$t}</v>
                            else for $t in $getnodes return <v>{string-join($t//text()," ")}</v>
        let $nodes := <nodes path="{fn:concat('//', $index-xpath)}"  >{$prenodes}</nodes>,
        	(: use XSLT-2.0 for-each-group functionality to aggregate the values of a node - much, much faster, than XQuery :)
   	    $data := transform:transform($nodes,$fcs:indexXsl,
   	                <parameters><param name="scan-clause" value="{$scan-clause}"/>
   	                <param name="sort" value="{$sort}"/></parameters>)

   	  return $data
};

(:~ main search function (handles the searchRetrieve-operation request)
:)
declare function fcs:search-retrieve($query as xs:string, $x-context as xs:string*, $startRecord as xs:integer, $maximumRecords as xs:integer, $x-dataview as xs:string*, $config) as item()* {

        let $start-time := util:system-dateTime()
        let $data-collection := repo-utils:context-to-collection($x-context, $config)
        (:if ($x-context) then collection($repo-utils:mappings//map[xs:string(@key) eq $x-context]/@path)
                                else $repo-utils:data-collection:)

        let $xpath-query := fcs:transform-query ($query, $x-context, $config)

            (: if there was a problem with the parsing the query  don't evaluate :)
        let $results := if ($xpath-query instance of text()) then
                                util:eval(concat("$data-collection",$xpath-query))
                           else ()

        let	$result-count := fn:count($results),
        $result-seq := fn:subsequence($results, $startRecord, $maximumRecords),
        $seq-count := fn:count($result-seq),
        $end-time := util:system-dateTime(),
        (:<sru:recordSchema>mods</sru:recordSchema>:)
              (:<xQuery><searchClause xmlns="http://www.loc.gov/zing/cql/xcql/">
              <index>dc.title</index>
              <relation>
              <value>=</value>
              </relation>
              <term>dinosaur</term>
              </searchClause>
              </xQuery>:)
        $records :=
          <sru:records>
    	       {for $rec at $pos in $result-seq
    	           let $rec-data := fcs:format-record-data($rec,$x-dataview, $x-context, $config)
    	           return
    	               <sru:record>
    	                   <sru:recordSchema>http://clarin.eu/fcs/1.0/Resource.xsd</sru:recordSchema>
    	                   <sru:recordPacking>xml</sru:recordPacking>
    	                   <sru:recordData>
    	                     {$rec-data}
                            </sru:recordData>
    	                   <sru:recordPosition>{$pos}</sru:recordPosition>
    	                   <sru:recordIdentifier>{xs:string($rec-data/fcs:ResourceFragment/@ref) }</sru:recordIdentifier>
    	                </sru:record>
    	       }
          </sru:records>,
        $end-time2 := util:system-dateTime(),
        $result :=
        <sru:searchRetrieveResponse>
          <sru:numberOfRecords>{$result-count}</sru:numberOfRecords>
          <sru:echoedSearchRetrieveRequest>
              <sru:version>1.2</sru:version>
              <sru:query>{$query}</sru:query>
              <fcs:x-context>{$x-context}</fcs:x-context>
              <fcs:x-dataview>{$x-dataview}</fcs:x-dataview>
              <sru:startRecord>{$startRecord}</sru:startRecord>
              <sru:maximumRecords>{$maximumRecords}</sru:maximumRecords>
              <sru:query>{$query}</sru:query>
              <sru:baseUrl>{repo-utils:config-value($config, "base.url")}</sru:baseUrl>
          </sru:echoedSearchRetrieveRequest>
          <sru:extraResponseData>
          	<fcs:returnedRecords>{$seq-count}</fcs:returnedRecords>
    		<fcs:duration>{($end-time - $start-time, $end-time2 - $end-time) }</fcs:duration>
    		<fcs:transformedQuery>{ $xpath-query }</fcs:transformedQuery>
          </sru:extraResponseData>
          { ($records,
            if ($xpath-query instance of element(diagnostics)) then  <sru:diagnostics>{$xpath-query/*}</sru:diagnostics> else ()
           ) }
        </sru:searchRetrieveResponse>

        return $result

};

declare function fcs:format-record-data($raw-record-data as node(), $data-view as xs:string*, $x-context as xs:string*, $config as node()) as item()*  {

    let $exp-rec := util:expand($raw-record-data, "expand-xincludes=no") (: kwic:summarize($rec,<config width="40"/>) :)

                        (:	      cmdcoll:get-md-collection-name($raw-record-data):)
	let $title := fcs:apply-index ($raw-record-data, "title",$x-context, $config)
	let $resource-pid := fcs:apply-index ($raw-record-data, "resource-pid",$x-context, $config)
	let $resourcefragment-pid := fcs:apply-index ($raw-record-data, "resourcefragment-pid",$x-context, $config)
	(: to repeat current $x-format param-value in the constructed requested :)
	let $x-format := request:get-parameter("x-format", $repo-utils:responseFormatXml)
	let $resourcefragment-ref := if (exists($resourcefragment-pid)) then concat('?operation=searchRetrieve&query=resourcefragment-pid="', xmldb:encode-uri($resourcefragment-pid), '"&x-dataview=full&x-context=', $x-context)
	                                      else ""

    let $kwic := if ('kwic' = $data-view) then
                   let $kwic-config := <config width="{$fcs:kwicWidth}"/>
                   let $kwic-html := kwic:summarize($exp-rec, $kwic-config)

                    return if (exists($kwic-html)) then
                                           <fcs:DataView type="kwic">{
                                               for $match in $kwic-html
                                               return (<fcs:c type="left">{$match/span[1]/text()}</fcs:c>,
                                       (: <c type="left">{kwic:truncate-previous($exp-rec, $matches[1], (), 10, (), ())}</c> :)
                                                      <fcs:kw>{$match/span[2]/text()}</fcs:kw>,
                                                      <fcs:c type="right">{$match/span[3]/text()}</fcs:c>)
                                       (: let $summary  := kwic:get-summary($exp-rec, $matches[1], $config) :)
                        (:	                               <fcs:DataView type="kwic-html">{$kwic-html}</fcs:DataView>:)
                                            }</fcs:DataView>
                                     else (: if no kwic-match let's take first 100 characters
                                        There c/should be some more sophisticated way to extract most significant info
                                        e.g. match on the query-field :)
                                       <fcs:DataView type="kwic">{substring($raw-record-data,1,$fcs:kwicWidth)}</fcs:DataView>
                     else ()
    let $title := <fcs:DataView type="title">{$title}</fcs:DataView>

    return if ($data-view = 'raw') then $raw-record-data
            else <fcs:Resource pid="{$resource-pid}" >
                       <fcs:ResourceFragment pid="{$resourcefragment-pid}" ref="{$resourcefragment-ref}" >
                         {($title, $kwic,
                         if ('full' = $data-view or not(exists($kwic))) then <fcs:DataView type="{$data-view}">{$exp-rec}</fcs:DataView>
                             else ()
                           )}
                           </fcs:ResourceFragment>
                       </fcs:Resource>

};

(:~ This expects a CQL-query that it translates to XPath

It relies on the external cqlparser-module, that delivers the query in XCQL-format (parse-tree of the query as XML)
and then applies a stylesheet

@params $x-context identifier of a resource/collection
@returns XPath version of the CQL-query, or diagnostics bubbling up the call-chain if parse-error!
:)
declare function fcs:transform-query($cql-query as xs:string, $x-context as xs:string, $config) as item() {
    let $mappings := repo-utils:config-value($config, 'mappings'),
    $xpath-query := cql:cql2xpath ($cql-query, $x-context, $mappings)
    return $xpath-query
 };

(: old version, "manually" parsing the cql-string
it accepted/understood:
term
index=term
index relation term
:)
declare function fcs:transform-query-old($cql-query as xs:string, $x-context as xs:string, $type as xs:string, $config ) as xs:string {

    let $query-constituents := if (contains($cql-query,'=')) then
                                        tokenize($cql-query, "=")
                                   else tokenize($cql-query, " ")
	let $index := if ($type eq 'scan' or count($query-constituents)>1 )  then $query-constituents[1]
	                else "cql.serverChoice"
	let $searchTerm := if (count($query-constituents)=1) then
							$cql-query
						else if (count($query-constituents)=2) then (: tokenized with '=' :)
						    normalize-space($query-constituents[2])
						else
							$query-constituents[3]

(: try to get a mapping specific to given context, else take the default :)
    let $context-map := fcs:get-mapping("",$x-context, $config),

(: TODO: for every index in $xcql :)
            (: try  to get a) a mapping for given index within the context-map,
                    b) in any of the mapping (if not found in the context-map) , - potentially dangerous!!
                    c) or else take the index itself :)
        $mappings := doc(repo-utils:config-value($config, 'mappings')),
        $index-map := $context-map/index[xs:string(@key) eq $index],
        $resolved-index := if (exists($index-map)) then $index-map/text()
                           else if (exists($mappings//index[xs:string(@key) eq $index])) then
                                $mappings//index[xs:string(@key) eq $index]
                            else $index
            ,
            (: get either a) the specific base-element for the index,
                  b) the default for given map,
                  c) the index itself :)
        $base-elem := if (exists($index-map/@base_elem)) then xs:string($index-map/@base_elem)
                        else if (exists($context-map/@base_elem)) then xs:string($context-map/@base_elem)
                        else $index,
            (: <index status="indexed"> - flag to know if ft-indexes can be used.
            TODO?: should be checked against the actual index-configuration :)
        $indexed := (xs:string($index-map/@status) eq 'indexed'),
        $match-on := if (exists($index-map/@use) ) then xs:string($index-map/@use) else '.'

	let $res := if ($type eq 'scan') then
	                   concat("//", $resolved-index, if ($match-on ne '.') then concat("/", $match-on) else '')
	               else
	                   concat("//", $resolved-index, "[",
	                                       if ($indexed) then
	                                               concat("ft:query(", $match-on, ",<term>",translate($searchTerm,'"',''), "</term>)")
	                                           else
	                                               concat("contains(", $match-on, ",'", translate($searchTerm,'"',''), "')")
	                                        , "]",
								"/ancestor-or-self::", $base-elem)

	return $res

};

(:~ gets the mapping-entry for the index

first tries a mapping within given context, then tries defaults.

if $index-param = "" return the map-element,
    else - if found - return the index-element
:)
declare function fcs:get-mapping($index as xs:string, $x-context as xs:string+, $config) as node()* {
    let $mappings := doc(repo-utils:config-value($config, 'mappings')),

    $context-map := if (exists($mappings//map[xs:string(@key) eq $x-context])) then
                                $mappings//map[xs:string(@key) eq $x-context]
                            else $mappings//map[xs:string(@key) eq 'default'],
    $context-index := $context-map/index[xs:string(@key) eq $index]

    return  if ($index eq '') then
                $context-map
             else if (exists($context-index)) then
                        $context-index
                else (: if no contextual index, dare to take any index - may be dangerous!  :)
                    let $any-index := $mappings//index[xs:string(@key) eq $index]
                    return $any-index
};

(:~ evaluate given index on given piece of data
used when formatting record-data, to put selected pieces of data (indexes) into the results record

@returns result of evaluating given index's path on given data. or empty node if no mapping index was found
:)
declare function fcs:apply-index($data, $index as xs:string, $x-context as xs:string+, $config) as item()* {

  let $index-map := fcs:get-mapping($index,$x-context, $config),
  $match-on := if (exists($index-map/@use) ) then concat('/', xs:string($index-map/@use)) else ''

  return if (exists($index-map/path/text())) then util:eval(concat("$data//", $index-map/path/text(), $match-on))
            else ()
};

(:~ gets the mapping for the index and creates an xpath (UNION)

@param $index index-key as known to mappings

@returns xpath-equivalent of given index as defined in mappings; multiple xpaths are translated to a UNION,
           value of @use-attribute is also attached;
         if no mapping found, returns the input-index unchanged
:)
declare function fcs:index-as-xpath($index as xs:string, $x-context as xs:string+, $config) as xs:string {
    let $index-map := fcs:get-mapping($index, $x-context, $config )
     return if (exists($index-map)) then
                        let $match-on := if (exists($index-map/@use) ) then concat('/', xs:string($index-map/@use)) else ''
                        return translate(concat('(', string-join($index-map/path,'|'),')', $match-on),'.','/')
                    else $index

};


Add argument changes to `lazy:cache`.

Add argument changes to `lazy:cache`.

xquery version "3.0";
(:~
: BaseX Lazy Module functions
:
: @see http://docs.basex.org/wiki/Lazy_Module
:)
module namespace lazy = "http://basex.org/modules/lazy";

import module namespace a = "http://reecedunn.co.uk/xquery/annotations" at "res://reecedunn.co.uk/xquery/annotations.xqy";

declare %a:since("basex", "9.0") function lazy:cache($items as item()* (: $item(s) [9.0] as item() [9.1] as item()* :)) as item()* external;
declare %a:since("basex", "9.1") function lazy:cache($items as item()* (: $item(s) [9.0] as item() [9.1] as item()* :), $lazy as xs:boolean) as item()* external;
declare %a:since("basex", "9.0") function lazy:is-lazy($item as item()) as xs:boolean external;
declare %a:since("basex", "9.0") function lazy:is-cached($item as item()) as xs:boolean external;

xquery version "3.0";
(:~
: BaseX Lazy Module functions
:
: @see http://docs.basex.org/wiki/Lazy_Module
:)
module namespace lazy = "http://basex.org/modules/lazy";

import module namespace a = "http://reecedunn.co.uk/xquery/annotations" at "res://reecedunn.co.uk/xquery/annotations.xqy";

declare %a:since("basex", "9.0") function lazy:cache($items as item()*) as item()* external;
declare %a:since("basex", "9.1") function lazy:cache($items as item()*, $lazy as xs:boolean) as item()* external;
declare %a:since("basex", "9.0") function lazy:is-lazy($item as item()) as xs:boolean external;
declare %a:since("basex", "9.0") function lazy:is-cached($item as item()) as xs:boolean external;


CSR processor refactored so that stored functions can be called (and results obtained) when not in an HTTP context

(:~
: This is the Care Services Discovery RESTful document processor
: @version 1.0
: @see https://github.com/openhie/openinfoman
:
:)
module namespace csr_proc = "https://github.com/openhie/openinfoman/csr_proc";

import module namespace file = "http://expath.org/ns/file";
import module namespace csd_dm = "https://github.com/openhie/openinfoman/csd_dm";

declare   namespace   csd = "urn:ihe:iti:csd:2013";
declare namespace xquery = "http://basex.org/modules/xquery";

(:this should proabably be moved to the database :)
declare variable $csr_proc:stored_query_dir := concat(file:current-dir() , "../resources/stored_query_definitions");
declare variable $csr_proc:stored_updating_query_dir := concat(file:current-dir() , "../resources/stored_updating_query_definitions");

declare variable $csr_proc:stored_functions_doc := 'stored_functions.xml';
declare variable $csr_proc:stored_updating_functions_doc := 'stored_updating_functions.xml';

declare function csr_proc:stored_functions($db) {
 db:open($db,$csr_proc:stored_functions_doc)/careServicesFunctions/csd:careServicesFunction
};

declare function csr_proc:stored_updating_functions($db) {
 db:open($db,$csr_proc:stored_updating_functions_doc)/careServicesFunctions/csd:careServicesFunction
};

declare updating function csr_proc:init($db) {
  (
    if (not (db:is-xml($db,$csr_proc:stored_updating_functions_doc))) then
      db:add($db, <careServicesFunctions/>,$csr_proc:stored_updating_functions_doc)
    else
      ()
      ,
    if (not (db:is-xml($db,$csr_proc:stored_functions_doc))) then
      db:add($db, <careServicesFunctions/>,$csr_proc:stored_functions_doc)
    else
      ()
  )
};

declare updating function csr_proc:clear_stored_functions($db) {
  (
    db:delete($db,$csr_proc:stored_functions_doc)
    ,db:delete($db,$csr_proc:stored_updating_functions_doc)
    ,csr_proc:init($db)
    )

};

declare updating function csr_proc:load_functions_from_files($db) {
  (
    if (file:is-dir($csr_proc:stored_query_dir)) then
      for $file in file:list($csr_proc:stored_query_dir,boolean('false'),"*.xml")
      let $func := doc(concat($csr_proc:stored_query_dir,'/',$file))/csd:careServicesFunction
      return if (exists($func)) then csr_proc:load_stored_function($db,$func) else ()
    else()
      ,
    if (file:is-dir($csr_proc:stored_updating_query_dir)) then
      for $file in file:list($csr_proc:stored_updating_query_dir,boolean('false'),"*.xml")
      let $func := doc(concat($csr_proc:stored_updating_query_dir,'/',$file))/csd:careServicesFunction
      return if (exists($func)) then csr_proc:load_stored_updating_function($db,$func) else ()
    else ()
  )
};

declare updating function csr_proc:delete_stored_function($db,$uuid) {
  let $stored_updating_functions := db:open($db,$csr_proc:stored_updating_functions_doc)/careServicesFunctions/*
  let $stored_functions := db:open($db,$csr_proc:stored_functions_doc)/careServicesFunctions/*
  let $functions := ($stored_functions,$stored_updating_functions)

  let $old := $functions[@uuid = $uuid]
  return if ($old) then delete node $old else ()

};

declare updating function csr_proc:load_stored_updating_function($db,$func) {
  let $stored_updating_functions := db:open($db,$csr_proc:stored_updating_functions_doc)/careServicesFunctions
  let $uuid := $func/@uuid
  let $old := $stored_updating_functions/csd:careServicesFunction[@uuid = $uuid]
  return
    if (exists($uuid)) then
      if (exists($old))
	then
	(delete node $old,
	insert node $func into $stored_updating_functions
	)
      else
	insert node $func into $stored_updating_functions
  else ()
};

declare updating function csr_proc:load_stored_function($db,$func) {
  let $stored_functions := db:open($db,$csr_proc:stored_functions_doc)/careServicesFunctions
  let $uuid := $func/@uuid
  let $old := $stored_functions/csd:careServicesFunction[@uuid = $uuid]
  return
    if (exists($uuid) and exists($stored_functions)) then
      if (exists($old))
	then
	(delete node $old,
	insert node $func into $stored_functions
	)
      else
	insert node $func into $stored_functions
    else ()
};

declare function csr_proc:process_CSR($db,$careServicesRequest, $doc_name,$base_url)
{
csr_proc:process_CSR($db,$careServicesRequest, $doc_name, $base_url,map:new(()))
};

declare function csr_proc:process_CSR($db,$careServicesRequest, $doc_name,$base_url,$bindings as map(*))
{
let $function :=$careServicesRequest/csd:function
let $adhoc :=$careServicesRequest/csd:expression
return if (exists($function))
then
  let $uuid := string($function/@uuid)
  let $csr :=
  <csd:careServicesRequest>
    <csd:function uuid="{$uuid}" resource='{$doc_name}' base_url='{$base_url}'>
      <csd:requestParams >
	{
	  if ($function/csd:requestParams) then $function/csd:requestParams/*
	  else $function/requestParams/*
	}
      </csd:requestParams>
    </csd:function>
  </csd:careServicesRequest>

  return csr_proc:process_CSR_stored($db,$csr,$bindings)
else if (exists($adhoc))
then
  csr_proc:process_CSR_adhoc($db,$adhoc,$doc_name,$bindings)
else
 (:
  <rest:response>
    <http:response status="400" message="Invalid care services request.">
      <http:header name="Content-Language" value="en"/>
      <http:header name="Content-Type" value="text/html; charset=utf-8"/>
    </http:response>
  </rest:response>
  :)
  $careServicesRequest

};

declare function csr_proc:process_CSR_adhoc($db,$expression,$doc_name) {
   csr_proc:process_CSR_adhoc($expression,$doc_name,map:new(()))
};

declare function csr_proc:process_CSR_adhoc($db,$expression,$doc_name,$bindings as map(*))
{
let $doc := csd_dm:open_document($db,$doc_name)
let $expr :=string($expression)
return if ($expr) then
  let $result := xquery:eval($expr,map{"":=$doc},$bindings)
  return(
   <rest:response>
   <http:response status="200" >
      <http:header name="Content-Type" value="{$expression/@content-type}"/>
    </http:response>
  </rest:response>
  ,$result
 )
else
   <rest:response>
     <http:response status="400" message="No ad-hoc expression" />
  </rest:response>
};

declare function csr_proc:process_CSR_stored($db,$careServicesRequest)
{
  csr_proc:process_CSR_stored($db,$careServicesRequest,map:new())
};

declare function csr_proc:process_CSR_stored($db,$careServicesRequest,$bindings as map(*))
{
let $function :=$careServicesRequest/csd:function
let $stored_functions := csr_proc:stored_functions($db)
let $uuid := string($function/@uuid)
let $definition := ($stored_functions[@uuid = $uuid])[1]/csd:definition/text()
let $content_type := csr_proc:lookup_stored_content_type($db,$function/@uuid)
let $doc_name := string($function/@resource)
let $doc := csd_dm:open_document($db,$doc_name)

let $results0 := csr_proc:process_CSR_stored_results($db,$doc,$careServicesRequest,$bindings)

return if (exists($definition)) then
  let $results1:=
    if ($function/@encapsulated) then
      csr_proc:wrap_result($results0,$content_type)
    else $results0
  return
    (
    <rest:response>
      <http:response status="200" >
	<http:header name="Content-Type" value="{$content_type}"/>
      </http:response>
    </rest:response>
    ,
    $results1
    )
else
  <rest:response>
    <http:response status="404" message="No registered function with UUID='{$function/@uuid}'.">
      <http:header name="Content-Language" value="en"/>
      <http:header name="Content-Type" value="text/html; charset=utf-8"/>
    </http:response>
  </rest:response>
};

declare function csr_proc:wrap_result($result,$content-type) {
 <csd:careServicesResponse content-type="{$content-type}"><csd:result>{$result}</csd:result></csd:careServicesResponse>
};

declare function csr_proc:process_CSR_stored_results($db,$doc,$careServicesRequest)
{
  csr_proc:process_CSR_stored_results($db,$doc,$careServicesRequest,map:new())
};

declare function csr_proc:process_CSR_stored_results($db,$doc,$careServicesRequest,$bindings as map(*))
{
let $function :=$careServicesRequest/csd:function
let $uuid := string($function/@uuid)
let $doc_name := string($function/@resource)
let $base_url := string($function/@base_url)

let $stored_functions := csr_proc:stored_functions($db)
let $definition := ($stored_functions[@uuid = $uuid])[1]/csd:definition/text()

let $options := csr_proc:lookup_stored_options($db,$function/@uuid)

let $requestParams :=
 <csd:requestParams resource='{$doc_name}' function='{$uuid}' base_url='{$base_url}'>
   {
     if ($function/csd:requestParams) then $function/csd:requestParams/*
   else $function/requestParams/*
   }
 </csd:requestParams>

let $csr_bindings :=  map{'':=$doc,'careServicesRequest':=$requestParams}
let $all_bindings :=  map:new(($csr_bindings, $bindings))

return if (exists($definition)) then
  xquery:eval($definition,$all_bindings,$options)
else ()
};

declare function csr_proc:create_adhoc_doc($adhoc_query,$content_type) {
let $content := if ($content_type) then $content_type else "application/xml"
return
 <csd:careServicesRequest xmlns:csd='urn:ihe:iti:csd:2013'>
  <csd:expression content-type='{$content}'>
  {$adhoc_query}
  </csd:expression>
</csd:careServicesRequest>

};

declare function csr_proc:get_function_definition($db,$uuid) {
  csr_proc:stored_functions($db)[@uuid = $uuid][1]
};

declare function csr_proc:get_updating_function_definition($db,$uuid) {
  csr_proc:stored_updating_functions($db)[@uuid = $uuid][1]
};

declare updating function csr_proc:process_updating_CSR($db,$function,$doc_name,$base_url)
{
  csr_proc:process_updating_CSR($db,$function,$doc_name,$base_url,map:new(()))
};

declare updating function csr_proc:process_updating_CSR($db,$careServicesRequest, $doc_name, $base_url,$bindings as map(*))
{
(:not allowing ad-hoc updates:)
let $doc := csd_dm:open_document($db,$doc_name)
let $function :=$careServicesRequest//csd:function
let $uuid := $function/@uuid
let $stored_updating_functions := csr_proc:stored_updating_functions($db)
let $definition := $stored_updating_functions[@uuid = $uuid][1]/csd:definition/text()
let $content_type := csr_proc:lookup_stored_content_type($db,$function/@uuid)
let $requestParams := <csd:requestParams resource='{$doc_name}' function='{$uuid}' base_url='{$base_url}'>
  {
    if ($function/csd:requestParams) then $function/csd:requestParams/*
    else $function/requestParams/*
  }
</csd:requestParams>

let $csr_bindings :=  map{'':=$doc,'careServicesRequest':=$requestParams}
let $all_bindings :=  map:new(($csr_bindings, $bindings))

let $options := csr_proc:lookup_stored_options($db,$function/@uuid)

return if (exists($definition)) then
  xquery:update($definition,$all_bindings,$options)
else
    db:output(
    <rest:response>
      <http:response status="404" message="No registered updating function with UUID='{$function/@uuid}">
	<http:header name="Content-Language" value="en"/>
	<http:header name="Content-Type" value="text/html; charset=utf-8"/>
      </http:response>
    </rest:response>
       )
};

declare function csr_proc:lookup_stored_options($db,$uuid)
{
  let $stored_updating_functions := csr_proc:stored_updating_functions($db)
  let $stored_functions := csr_proc:stored_functions($db)
  let $func := ($stored_functions[@uuid = $uuid], $stored_updating_functions[@uuid = $uuid])[1]
   return  ($func/csd:extension[@urn='urn:openhie.org:openinfoman:csr_processor' and  @type='xquery:options']/xquery:options)[1]
     (: See: http://docs.basex.org/wiki/XQuery_Module :)
};

declare function csr_proc:lookup_stored_content_type($db,$uuid)
{
  let $stored_updating_functions := csr_proc:stored_updating_functions($db)
  let $stored_functions := csr_proc:stored_functions($db)
  return string(($stored_functions[@uuid = $uuid]/@content-type, $stored_updating_functions[@uuid = $uuid]/@content-type  , "text/xml")[1])
};

(:~
: This is the Care Services Discovery RESTful document processor
: @version 1.0
: @see https://github.com/his-interop/openinfoman
:
:)
module namespace csr_proc = "https://github.com/his-interop/openinfoman/csr_proc";

import module namespace file = "http://expath.org/ns/file";
import module namespace csd_dm = "https://github.com/his-interop/openinfoman/csd_dm";

declare   namespace   csd = "urn:ihe:iti:csd:2013";
declare namespace xquery = "http://basex.org/modules/xquery";

(:this should proabably be moved to the database :)
declare variable $csr_proc:stored_query_dir := concat(file:current-dir() , "../resources/stored_query_definitions");
declare variable $csr_proc:stored_updating_query_dir := concat(file:current-dir() , "../resources/stored_updating_query_definitions");

declare variable $csr_proc:stored_functions_doc := 'stored_functions.xml';
declare variable $csr_proc:stored_updating_functions_doc := 'stored_updating_functions.xml';

declare function csr_proc:stored_functions($db) {
 db:open($db,$csr_proc:stored_functions_doc)/careServicesFunctions/csd:careServicesFunction
};

declare function csr_proc:stored_updating_functions($db) {
 db:open($db,$csr_proc:stored_updating_functions_doc)/careServicesFunctions/csd:careServicesFunction
};

declare updating function csr_proc:init($db) {
  (
    if (not (db:is-xml($db,$csr_proc:stored_updating_functions_doc))) then
      db:add($db, <careServicesFunctions/>,$csr_proc:stored_updating_functions_doc)
    else
      ()
      ,
    if (not (db:is-xml($db,$csr_proc:stored_functions_doc))) then
      db:add($db, <careServicesFunctions/>,$csr_proc:stored_functions_doc)
    else
      ()
  )
};

declare updating function csr_proc:clear_stored_functions($db) {
  (
    db:delete($db,$csr_proc:stored_functions_doc)
    ,db:delete($db,$csr_proc:stored_updating_functions_doc)
    ,csr_proc:init($db)
    )

};

declare updating function csr_proc:load_functions_from_files($db) {
  (
    if (file:is-dir($csr_proc:stored_query_dir)) then
      for $file in file:list($csr_proc:stored_query_dir,boolean('false'),"*.xml")
      let $func := doc(concat($csr_proc:stored_query_dir,'/',$file))/csd:careServicesFunction
      return if (exists($func)) then csr_proc:load_stored_function($db,$func) else ()
    else()
      ,
    if (file:is-dir($csr_proc:stored_updating_query_dir)) then
      for $file in file:list($csr_proc:stored_updating_query_dir,boolean('false'),"*.xml")
      let $func := doc(concat($csr_proc:stored_updating_query_dir,'/',$file))/csd:careServicesFunction
      return if (exists($func)) then csr_proc:load_stored_updating_function($db,$func) else ()
    else ()
  )
};

declare updating function csr_proc:delete_stored_function($db,$uuid) {
  let $stored_updating_functions := db:open($db,$csr_proc:stored_updating_functions_doc)/careServicesFunctions/*
  let $stored_functions := db:open($db,$csr_proc:stored_functions_doc)/careServicesFunctions/*
  let $functions := ($stored_functions,$stored_updating_functions)

  let $old := $functions[@uuid = $uuid]
  return if ($old) then delete node $old else ()

};

declare updating function csr_proc:load_stored_updating_function($db,$func) {
  let $stored_updating_functions := db:open($db,$csr_proc:stored_updating_functions_doc)/careServicesFunctions
  let $uuid := $func/@uuid
  let $old := $stored_updating_functions/csd:careServicesFunction[@uuid = $uuid]
  return
    if (exists($uuid)) then
      if (exists($old))
	then
	(delete node $old,
	insert node $func into $stored_updating_functions
	)
      else
	insert node $func into $stored_updating_functions
  else ()
};

declare updating function csr_proc:load_stored_function($db,$func) {
  let $stored_functions := db:open($db,$csr_proc:stored_functions_doc)/careServicesFunctions
  let $uuid := $func/@uuid
  let $old := $stored_functions/csd:careServicesFunction[@uuid = $uuid]
  return
    if (exists($uuid) and exists($stored_functions)) then
      if (exists($old))
	then
	(delete node $old,
	insert node $func into $stored_functions
	)
      else
	insert node $func into $stored_functions
    else ()
};

declare function csr_proc:process_CSR($db,$careServicesRequest, $doc_name,$base_url)
{
csr_proc:process_CSR($db,$careServicesRequest, $doc_name, $base_url,map:new(()))
};

declare function csr_proc:process_CSR($db,$careServicesRequest, $doc_name,$base_url,$bindings as map(*))
{
let $func :=$careServicesRequest/csd:function
let $adhoc :=$careServicesRequest/csd:expression
return if (exists($func))
then
  csr_proc:process_CSR_stored($db,$func,$doc_name,$base_url,$bindings)
else if (exists($adhoc))
then
  csr_proc:process_CSR_adhoc($db,$adhoc,$doc_name,$bindings)
else
 (:
  <rest:response>
    <http:response status="400" message="Invalid care services request.">
      <http:header name="Content-Language" value="en"/>
      <http:header name="Content-Type" value="text/html; charset=utf-8"/>
    </http:response>
  </rest:response>
  :)
  $careServicesRequest

};

declare function csr_proc:process_CSR_adhoc($db,$expression,$doc_name) {
   csr_proc:process_CSR_adhoc($expression,$doc_name,map:new(()))
};

declare function csr_proc:process_CSR_adhoc($db,$expression,$doc_name,$bindings as map(*))
{
let $doc := csd_dm:open_document($db,$doc_name)
let $expr :=string($expression)
return if ($expr) then
  let $result := xquery:eval($expr,map{"":=$doc},$bindings)
  return(
   <rest:response>
   <http:response status="200" >
      <http:header name="Content-Type" value="{$expression/@content-type}"/>
    </http:response>
  </rest:response>
  ,$result
 )
else
   <rest:response>
     <http:response status="400" message="No ad-hoc expression" />
  </rest:response>
};

declare function csr_proc:process_CSR_stored($db,$function,$doc_name,$base_url)
{
  csr_proc:process_CSR_stored($db,$function,$doc_name,$base_url,map:new())
};

declare function csr_proc:process_CSR_stored($db,$function,$doc_name,$base_url,$bindings as map(*))
{
let $doc := csd_dm:open_document($db,$doc_name)
let $uuid := $function/@uuid
let $stored_functions := csr_proc:stored_functions($db)
let $definition := $stored_functions[@uuid = $uuid][1]/csd:definition/text()
let $content_type := csr_proc:lookup_stored_content_type($db,$function/@uuid)
let $options := csr_proc:lookup_stored_options($db,$function/@uuid)
let $requestParams := <csd:requestParams resource='{$doc_name}' function='{$uuid}' base_url='{$base_url}'>
  {
    if ($function/csd:requestParams) then $function/csd:requestParams/*
    else $function/requestParams/*
  }
</csd:requestParams>

let $csr_bindings :=  map{'':=$doc,'careServicesRequest':=$requestParams}
let $all_bindings :=  map:new(($csr_bindings, $bindings))

let $result0 :=
  if (exists($definition)) then
    xquery:eval($definition,$all_bindings,$options)
  else
    ()
let $result1:=
  if ($function/@encapsulated) then
    csr_proc:wrap_result($result0,$content_type)
  else $result0
return if ($result0) then
  (
  <rest:response>
    <http:response status="200" >
      <http:header name="Content-Type" value="{$content_type}"/>
    </http:response>
  </rest:response>
  ,
  $result1
  )
else
  <rest:response>
    <http:response status="404" message="No registered function with UUID='{$function/@uuid}'.">
      <http:header name="Content-Language" value="en"/>
      <http:header name="Content-Type" value="text/html; charset=utf-8"/>
    </http:response>
  </rest:response>

};

declare function csr_proc:wrap_result($result,$content-type) {
 <csd:careServicesResponse content-type="{$content-type}"><csd:result>{$result}</csd:result></csd:careServicesResponse>
};

declare function csr_proc:create_adhoc_doc($adhoc_query,$content_type) {
let $content := if ($content_type) then $content_type else "application/xml"
return
 <csd:careServicesRequest xmlns:csd='urn:ihe:iti:csd:2013'>
  <csd:expression content-type='{$content}'>
  {$adhoc_query}
  </csd:expression>
</csd:careServicesRequest>

};

declare function csr_proc:get_function_definition($db,$uuid) {
  csr_proc:stored_functions($db)[@uuid = $uuid][1]
};

declare function csr_proc:get_updating_function_definition($db,$uuid) {
  csr_proc:stored_updating_functions($db)[@uuid = $uuid][1]
};

declare updating function csr_proc:process_updating_CSR($db,$function,$doc_name,$base_url)
{
  csr_proc:process_updating_CSR($db,$function,$doc_name,$base_url,map:new(()))
};

declare updating function csr_proc:process_updating_CSR($db,$careServicesRequest, $doc_name, $base_url,$bindings as map(*))
{
(:not allowing ad-hoc updates:)
let $doc := csd_dm:open_document($db,$doc_name)
let $function :=$careServicesRequest//csd:function
let $uuid := $function/@uuid
let $stored_updating_functions := csr_proc:stored_updating_functions($db)
let $definition := $stored_updating_functions[@uuid = $uuid][1]/csd:definition/text()
let $content_type := csr_proc:lookup_stored_content_type($db,$function/@uuid)
let $requestParams := <csd:requestParams resource='{$doc_name}' function='{$uuid}' base_url='{$base_url}'>
  {
    if ($function/csd:requestParams) then $function/csd:requestParams/*
    else $function/requestParams/*
  }
</csd:requestParams>

let $csr_bindings :=  map{'':=$doc,'careServicesRequest':=$requestParams}
let $all_bindings :=  map:new(($csr_bindings, $bindings))

let $options := csr_proc:lookup_stored_options($db,$function/@uuid)

return if (exists($definition)) then
  xquery:update($definition,$all_bindings,$options)
else
    db:output(
    <rest:response>
      <http:response status="404" message="No registered updating function with UUID='{$function/@uuid} ">
	<http:header name="Content-Language" value="en"/>
	<http:header name="Content-Type" value="text/html; charset=utf-8"/>
      </http:response>
    </rest:response>
       )
};

declare function csr_proc:lookup_stored_options($db,$uuid)
{
  let $stored_updating_functions := csr_proc:stored_updating_functions($db)
  let $stored_functions := csr_proc:stored_functions($db)
  let $func := ($stored_functions[@uuid = $uuid], $stored_updating_functions[@uuid = $uuid])[1]
   return  ($func/csd:extension[@urn='urn:openhie.org:openinfoman:csr_processor' and  @type='xquery:options']/xquery:options)[1]
     (: See: http://docs.basex.org/wiki/XQuery_Module :)
};

declare function csr_proc:lookup_stored_content_type($db,$uuid)
{
  let $stored_updating_functions := csr_proc:stored_updating_functions($db)
  let $stored_functions := csr_proc:stored_functions($db)
  return string(($stored_functions[@uuid = $uuid]/@content-type, $stored_updating_functions[@uuid = $uuid]/@content-type  , "text/xml")[1])
};