source: MDRepository/trunk/xquery/cmd-model.xqm @ 726

module namespace cmd-model = "http://spraakbanken.gu.se/clarin/xquery/model";

(: 
 $Id: cmd-model.xqm 726 2010-09-28 11:31:03Z vronk $
:)

import module namespace xdb="http://exist-db.org/xquery/xmldb";
import module namespace util="http://exist-db.org/xquery/util";

declare variable $cmd-model:cmdiDatabaseURI as xs:string := "xmldb:exist:///db";

declare variable $cmd-model:commonFreqsPath as xs:string := "/db/common/clarin/freqs";
declare variable $cmd-model:cmdiMirrorPath as xs:string := "/db/cmdi-mirror";

declare variable $cmd-model:getCollections as xs:string := "getCollections";
declare variable $cmd-model:queryModel as xs:string := "queryModel";
declare variable $cmd-model:searchRetrieve as xs:string := "searchRetrieve";

declare variable $cmd-model:typeActorPath as xs:string := "MDGroup/Actors/Actor";
declare variable $cmd-model:typeActorPath0 as xs:string := "Actor";
declare variable $cmd-model:typeActorRolePath as xs:string := "MDGroup/Actors/Actor/Role";

declare variable $cmd-model:docTypeTerms as xs:string := "Terms";
declare variable $cmd-model:docTypeSuffix as xs:string := "Values";

declare variable $cmd-model:responseFormatXml as xs:string := "xml";
declare variable $cmd-model:responseFormatJSon as xs:string := "json";
declare variable $cmd-model:responseFormatText as xs:string := "text";

declare variable $cmd-model:collectionDocName as xs:string := "collection.xml";

declare variable $cmd-model:collectionRoot as xs:string := "root";

declare variable $cmd-model:xmlExt as xs:string := ".xml";

declare variable $cmd-model:valuesLimit as xs:integer := 100;



declare function cmd-model:elem($collections as xs:string+, $path as xs:string, $depth as xs:integer) as element() {
(: fixme! - handle multiple collections :)
cmd-model:elem-r($collections, $path, $depth, $depth)
};

declare function cmd-model:elem-r($collections as xs:string+, $path as xs:string, $max-depth as xs:integer, $depth as xs:integer) as element() {
  let $collection := collection($cmd-model:cmdiMirrorPath),
    $path-nodes :=
    if ($collections[1] eq $cmd-model:collectionRoot) then
      util:eval(fn:concat("$collection//", $path))
    else
      for $coll in $collections return util:eval(fn:concat("$collection//ft:query(descendant::IsPartOf, <query><term>", xdb:decode($coll) ,"</term></query>)//", $path, "/ancestor::CMD"))

  let $path-count := count($path-nodes)
    
  let $subs := distinct-values($path-nodes/child::element()/name())
  let $text-nodes := $path-nodes//text()
  let $text-count := count($text-nodes)
  let $text-count-distinct := count(distinct-values($text-nodes))
  return 
        <Term path="{fn:concat("//", $path)}" name="{text:groups($path, "/([^/]+)$")[last()]}" count="{$path-count}" count_text="{$text-count}"  count_distinct_text="{$text-count-distinct}">{
          if ($depth > 0) then
            (for $elname in $subs[. != '']
            return
              cmd-model:elem-r($collection, concat($path, '/', $elname), $max-depth, $depth - 1),
              if ($max-depth eq 1) then cmd-model:values($path-nodes) else ())
          else 'maxdepth'
        }</Term>
};

declare function cmd-model:values($nodes as node()*) as node()* {
let $keys := distinct-values($nodes/text())
let $values := for $key at $pos in $keys
  let $kcount := count($nodes[. eq $key])
    order by lower-case($key) ascending
    return <v key="{$key}" cnt="{$kcount}" />
return
  if ($cmd-model:valuesLimit eq 0) then $values 
  else
  subsequence($values, 1, $cmd-model:valuesLimit)
};

declare function cmd-model:paths($n) {
        for $el in $n
        return <Term name="{$el/name()}"> {
        for $anc in $el/parent::element()
        return util:node-xpath($anc)
        }</Term>
};

(:

:)
declare function cmd-model:recurse-collections-model($collection as xs:string, $type-name as xs:string, $depth as xs:integer, $name as xs:string) as item()* {
    let $children := xdb:get-child-collections($collection)
    return
      if (fn:exists($children)) then
          let $child-results :=
            for $child in $children
            return
              cmd-model:recurse-collections-model(fn:concat($collection, '/', xs:string($child)), $type-name, $depth, $name),
              $current := cmd-model:create-doc($collection, $type-name, $depth, $name)
          return ($current, $child-results)
      else
        cmd-model:create-doc($collection, $type-name, $depth, $name)
};

(:
  Recurse for collections
:)
declare function cmd-model:recurse-collections($collection as node()+, $name as xs:string, $handle as xs:string, $proxy-id as xs:string, $depth as xs:integer) as item()* {
    let $children := if ($depth eq 0) then () else $collection//ResourceProxy[ResourceType = "Metadata"]
    return
      if (fn:exists($children)) then
          let $child-results :=
            for $child in $children
              let $child-doc := if (empty($child/unresolvable-uri)) then
                cmd-model:get-resource-by-handle-or-collection-path(util:collection-name($child/root()), $child/ResourceRef) else (),
                $child-name := if (empty($child-doc)) then concat(util:collection-name($child/root()), ":", $child/ResourceRef) else cmd-model:get-md-collection-name($child-doc)
            return
              if (empty($child-doc)) then ()
             else
              cmd-model:recurse-collections($child-doc, $child-name, $child-doc//Header/MdSelfLink, $child/@id, $depth - 1)
          return
          <c n="{$name}" handle="{$handle}" proxy-id="{$proxy-id}" cnt="-1" sub-colls="{count($child-results)}" >{$child-results}</c>
      else
      <c n="{$name}" handle="{$handle}" proxy-id="{$proxy-id}" cnt="{if ($handle eq "") then "-1" else cmd-model:get-resource-count($handle)}"></c>

};

(:
:)
declare function cmd-model:get-resource-count($handle as xs:string) as xs:string {
xs:string(count(collection($cmd-model:cmdiMirrorPath)//IsPartOf[. eq $handle]/ancestor::CMD[descendant::ResourceType[. = "Resource"]]))
};

(:
:)
declare function cmd-model:get-md-collection-name($collection-doc as node()) as xs:string {
($collection-doc//Corpus/Name, $collection-doc//Session/Name, $collection-doc//Collection/GeneralInfo/Name, $collection-doc//Collection/GeneralInfo/Title, "UNKNOWN")[1]
};

(:

:)
declare function cmd-model:create-doc($collections as xs:string+, $type-name as xs:string, $depth as xs:integer, $name as xs:string) as xs:string* {
  (: if newer data available :)
    cmd-model:store-result($collections, cmd-model:elem($collections, $type-name, $depth), $name, $depth)
  (:else () :)
};

(:

:)
declare function cmd-model:get-result-doc($collections as xs:string+, $type-name as xs:string, $depth as xs:integer) as item()* {
  let $name := cmd-model:make-compound-doc-name($collections, "values", xs:string($depth)),
    $dummy := if (cmd-model:is-result-available($cmd-model:commonFreqsPath, $name)) then
    ()
    else
      cmd-model:create-doc($collections, $type-name, $depth, $name)
    return
      cmd-model:get-doc($cmd-model:commonFreqsPath, $name)
};

(:
 Generic get-doc(collection, docname) 
:)
declare function cmd-model:get-doc($collection as xs:string, $doc-name as xs:string) as item()* {
      fn:doc(fn:concat($collection, "/", $doc-name))
};


(:
  Function for telling wether the result is already available or not.
:)
declare function cmd-model:is-result-available($collection as xs:string, $result-ref as xs:string) as xs:boolean {
  fn:doc-available(fn:concat($collection, "/", $result-ref))
};

(:
  Function for telling wether the document is available or not.
:)
declare function cmd-model:is-doc-available($collection as xs:string, $doc-name as xs:string) as xs:boolean {
  fn:doc-available(fn:concat($collection, "/", $doc-name))
};

(:
  Store the calculated frequencies for reuse.
  If more than one collection is given the result is stored in the common 
  collection for reuse.
:)
declare function cmd-model:store-result($coll-names as xs:string+, $entries as element()*, $type-name as xs:string, $depth as xs:integer) as xs:string {
  let $clarin-writer := fn:doc("/db/clarin/writer.xml"),
    $dummy := xdb:login($cmd-model:cmdiDatabaseURI, $clarin-writer//write-user/text(), $clarin-writer//write-user-cred/text())
    return
        xdb:store($cmd-model:commonFreqsPath, $type-name, cmd-model:make-doc-element-of-type($type-name, $coll-names, $entries, xs:string($depth)))
};

(:
  Store the collection listing for given collection.
:)
declare function cmd-model:store-collection-data($data as node(), $collection-path as xs:string, $doc-name as xs:string) as xs:string? {
  let $clarin-writer := fn:doc("/db/clarin/writer.xml"),
  $dummy := xdb:login($cmd-model:cmdiDatabaseURI, $clarin-writer//write-user/text(), $clarin-writer//write-user-cred/text()),
  $store := (: util:catch("org.exist.xquery.XPathException", :) xdb:store($collection-path, $doc-name, $data),(: , ()) :)
  $stored-doc := doc(concat($collection-path, "/", $doc-name)),
  $coll-count := update value $stored-doc/Collections/@count with sum($stored-doc//c[not(c)]/@cnt)
  return 
  for $i in $stored-doc//c[c][@cnt eq "-1"]
  return update value $i/@cnt with sum($i//c[not(c)]/@cnt)

};

(:
  Create document name for type () with or without collection path.
:)
declare function cmd-model:make-doc-name($coll-name as xs:string?, $type-name as xs:string, $depth as xs:string, $incl-path as xs:boolean) as xs:string {
  let $doc-name := fn:concat($type-name, $depth, $cmd-model:xmlExt)
  return
    if ($incl-path) then
      fn:concat($coll-name, "/", $doc-name)
    else
      $doc-name
};

(:
  Create document name with md5-hash for selected collections (or types) for reuse.
:)
declare function cmd-model:make-compound-doc-name($coll-names as xs:string+, $type-name as xs:string, $depth as xs:string) as xs:string {
  let $name-prefix := fn:concat($type-name, $depth),
    $sorted-names := for $coll in $coll-names order by $coll ascending return $coll
    return
    fn:concat($name-prefix, "-", util:hash(string-join($sorted-names, ""), "MD5"), $cmd-model:xmlExt)
};

(:
  Skapa ett element av angiven typ. 
:)
declare function cmd-model:make-element-of-type($type-name as xs:string, $count as xs:string, $text-count as xs:string, $text-types-count as xs:string, $value as xs:string) as element() {
  element {$type-name} {

      attribute count {$freq},
      attribute text-count {$rank},
      attribute text-types-count {$text-types},
      text {$value} 
  }
};

(:
  Skapa ett dokumentelement av angiven typ. 
:)
declare function cmd-model:make-doc-element-of-type($type-name as xs:string, $coll-names as xs:string*, $entries as element()*, $depth as xs:string) as element() {
      let $depth-value := attribute depth {$depth},
      $coll-names-value := if (fn:empty($coll-names)) then () else attribute colls {fn:string-join($coll-names, ",")}
      return
        element {cmd-model:get-doc-type-element-name($type-name)} {
          $depth-value,
          $coll-names-value,
          attribute created {fn:current-dateTime()},
          $entries
        }
};

(:
  Skapa elementnamn för dokumentet av typ. 
:)
declare function cmd-model:get-doc-type-element-name($type-name as xs:string) as xs:string {
  $cmd-model:docTypeTerms
};


(:
  Get the resource by handle or by path. 
:)
declare function cmd-model:get-resource-by-handle-or-collection-path($id as xs:string, $doc-name as xs:string?) as node()* {
  if (starts-with($id, "test-") or starts-with($id, "clarin-") or starts-with($doc-name, "clarin-")) then
    collection($cmd-model:cmdiMirrorPath)//MdSelfLink[. = xdb:decode(($doc-name, $id)[1])]/ancestor::CMD
    (: let $key := xdb:decode(($doc-name, $id)[1])
    return ft:query(//MdSelfLink, <term>{$key}</term>)[matches(., concat("^", $key, "$"))]/ancestor::CMD :)
  else if (empty($doc-name) or $id=$cmd-model:collectionRoot ) then
    collection($cmd-model:cmdiMirrorPath)//IsPartOf[. = $cmd-model:collectionRoot]/ancestor::CMD
  else
    doc(concat($id, "/", $doc-name))
};

(:
  Seraliseringsformat. 
:)
declare function cmd-model:serialise-as($item as node()?, $format as xs:string) as item()? {
      if ($format eq $cmd-model:responseFormatJSon) then
        let $option := util:declare-option("exist:serialize", "method=text media-type=application/json")
          return
           (: json:xml-to-json($item) :) $item
      else (: $cmd-model:responseFormatXml, $cmd-model:responseFormatText:)
        $item
};


(:~
  API function queryModel. 
:)
declare function cmd-model:query-model($cmd-index-path as xs:string, $collection as xs:string+, $format as xs:string, $max-depth as xs:integer) as item()? {
        cmd-model:serialise-as(cmd-model:get-result-doc($collection, $cmd-index-path, $max-depth), $format)
};

(:~
  API function getCollections. 
:)
declare function cmd-model:get-collections($collections as xs:string+, $format as xs:string, $max-depth as xs:integer) as item() {
  let $names := ($cmd-model:commonFreqsPath, cmd-model:make-compound-doc-name($collections, "collection", xs:string($max-depth))),
 $dummy := 
      if (cmd-model:is-doc-available($names[1], $names[2])) then
        ()
      else
        let $children := 
        for $collection-item in $collections
        return
        for $collection-doc in cmd-model:get-resource-by-handle-or-collection-path($collection-item, ()) return
          cmd-model:recurse-collections($collection-doc, cmd-model:get-md-collection-name($collection-doc), $collection-doc//MdSelfLink, "", $max-depth)
          return
            cmd-model:store-collection-data(<Collections count="-1" sub-colls="{count($children)}" root="{$collections}">{$children}</Collections>, $names[1], $names[2])
return 
  cmd-model:serialise-as(cmd-model:get-doc($names[1], $names[2]), $format)
};

(:~
  API function searchRetrieve. 
:)
declare function cmd-model:search-retrieve($cql-query as xs:string, $collections as xs:string+, $format as xs:string, $start-item as xs:integer, $end-item as xs:integer) as item()* {
  let $collection := collection($cmd-model:cmdiMirrorPath),
    $results :=
    if ($collections[1] eq $cmd-model:collectionRoot) then
      util:eval(fn:concat("$collection", xdb:decode($cql-query), "/ancestor::CMD"))
    else
      for $coll in $collections return util:eval(fn:concat("$collection", xdb:decode($cql-query), "/ancestor::CMD[descendant::IsPartOf = '", xdb:decode($coll) ,"']"))

    let $result-count := fn:count($results),
    $result-seq := fn:subsequence($results, $start-item, $end-item),
    $seq-count := fn:count($result-seq),
    $result-fragment :=
    <searchRetrieveResponse>
      <numberOfRecords>{$result-count}</numberOfRecords>
      <echoedSearchRetrieveRequest>{$cql-query, $collections, $start-item, $end-item}</echoedSearchRetrieveRequest>
      <diagnostics>{$seq-count}</diagnostics>
      <records>
        {$result-seq}
      </records>
    </searchRetrieveResponse>

    return
        cmd-model:serialise-as($result-fragment, $format)

};
(:
{cmdComponent}   //{cmdComponent}        Actor   //Actor
{cmdPath}.      //{cmdPath}/{cmdComponent}      Actor.Contact.Phone     //Actor/Contact/Phone
{cmdIndex} {rel} {term}         //{cmdIndex}[\. {rel} '{term}']         Actors.Actor.Sex=f      //Actors/Actor/Sex[.='f']
{cmdIndex} any {term}   //{cmdIndex}[contains(. '{term}')]      Organisation.Name any University        //Organisation/Name[contains(.,'University')]
and, or, and not        ?!      Organisation.Name any University and Actor.gender=m     ?! 

//MDGroup[Actors/Actor/Role[.='sponsor'] and Actors/Actor/Name[contains(.,'a')]]
//Title[starts-with(.,'a')]
//Title[starts-with(.,'A')]
//Title[contains(.,'analysis')]
http://demo.spraakdata.gu.se/clarin/cmd/model/stats?operation=searchRetrieve&query=//Title[contains(.,'analysis')]&collection=

<record>
  <recordSchema>info:srw/schema/1/dc-v1.1</recordSchema>
  <recordPacking>xml</recordPacking>
  <recordData>
    <srw_dc:dc xmlns:srw_dc="info:srw/schema/1/dc-v1.1">
     <dc:title>This is a Sample Record</dc:title>
    </srw_dc:dc>
  </recordData>
  <recordPosition>1</recordPosition>
  <extraRecordData>
    <rel:score xmlns:rel="info:srw/extensions/2/rel-1.0">
      0.965
    </rel:rank>
   </extraRecordData>
</record>

<searchRetrieveResponse>
        <numberOfRecords>integer</numberOfRecords>
        <echoedSearchRetrieveRequest>query itself (together with the context-collection) </echoedSearchRetrieveRequest>
        <diagnostics>if necessary</diagnostics>
        <records>
                ....
        </records>
</searchRetrieveResponse>

:)