source: MDService/trunk/xquery/cmd-model.xqm @ 258

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

(: 
 $Id: cmd-model.xqm 258 2010-03-19 14:32:10Z ljo $
:)

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:xmlExt as xs:string := ".xml";

declare function cmd-model:elem($collection as xs:string, $path as xs:string, $depth as xs:integer) as element() {
  let $path-nodes := util:eval(fn:concat("collection('", $collection, "')//", $path))
  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)}" 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($collection, concat($path, '/', $elname), $depth - 1)
          else 'maxdepth'
        }</Term>
};

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) 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),
              $current := cmd-model:create-doc($collection, $type-name, $depth)
          return ($current, $child-results)
      else
        cmd-model:create-doc($collection, $type-name, $depth)
};

(:
  Recurse for collections
:)
declare function cmd-model:recurse-collections($collection as xs:string, $depth as xs:integer) 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(concat($collection, '/', xs:string($child)), $depth),
              $current := <Collection>{$collection}</Collection>
          return ($current, $child-results)
      else
      <Collection>{$collection}</Collection>
};

(:

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

(:

:)
declare function cmd-model:get-result-doc($collection as xs:string, $type-name as xs:string, $depth as xs:integer) as item()* {
  let $name-last := text:groups($type-name, "/(\w+)$")[last()],
    $new-name := if (fn:empty($name-last)) then $type-name else $name-last,
    $dummy := if (cmd-model:is-result-available($collection, fn:concat("/", $new-name, xs:string($depth)))) then
    ()
    else
      cmd-model:create-doc($collection, $type-name, $depth)
    return
      fn:doc(fn:concat($collection, "/", $new-name, xs:string($depth), $cmd-model:xmlExt))
};

(:
  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, $cmd-model:xmlExt))
};

(:
  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
    
      if (fn:exists($coll-names[2])) then
        (: Det gÀller fler Àn en samling. :)
        xdb:store($cmd-model:commonFreqsPath, cmd-model:make-compound-doc-name($coll-names, $type-name, $depth), cmd-model:make-doc-element-of-type($type-name, $coll-names, $entries, $depth))
      else
        (: Det gÀller endast en samling. :)
        let $dummy := util:log('debug', fn:concat('Stores ', $type-name, ' in ', $coll-names))
        return xdb:store($coll-names, cmd-model:make-doc-name($coll-names, $type-name, xs:string($depth), fn:false()), cmd-model:make-doc-element-of-type($type-name, (), $entries, xs:string($depth)))
};

(:
  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)
    return
    fn:concat($name-prefix, "-", util:hash(string-join($coll-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
};

(:
  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 $children := for $collection-item in $collections
                    return 
                      cmd-model:recurse-collections($collection-item, $max-depth)
   return
     cmd-model:serialise-as(<Collections count="{count($children)}" root="{$collections}">{$children}</Collections>, $format) 

};