(:
: Module: Utility functions for the database at www.risten.no.
:
: $Id: ristenutil.xqm 18236 2008-04-18 15:33:34Z sjur $
:
: The functions defined thus far are:
:
: makeTermID($term, $pos) as xs:string
: get-doc() as xs:string
: get-doc($lang) as xs:string
: get-doc($collID, $lang) as xs:string
: get-doc-path($collID, $docname) as xs:string
: pre-main
: newID() as xs:string
: dateTime() as xs:string
: countRecords() as xs:integer
: lastChanged() as xs:double
: ristenutil:cleanEntry()
: get-xmldb-collection() as xs:string
: get-collection() as xs:string
: ristenutil:get-termcolls-from-class()
: ristenutil:langs-to-docs
:
: namespace: "http://www.risten.no/shared/util"
:
:)
module namespace ristenutil="http://www.risten.no/shared/util";
declare namespace util="http://exist-db.org/xquery/util";
declare namespace request="http://exist-db.org/xquery/request";
declare namespace session="http://exist-db.org/xquery/session";
(: +
| Creates a new term ID based on entry string and POS
+ :)
declare function ristenutil:makeTermID($term as xs:string, $pos as xs:string) as xs:string
{
let $t := translate($term, ' ', '_')
let $id := concat($t, '\', $pos)
return $id
};
(: +
| Returns the full path to a term document in a term collection,
| based on collection ID and document name.
+ :)
declare function ristenutil:get-doc-path($collID as xs:string, $doc as xs:string) as xs:string
{
let $coll := ristenutil:get-collection($collID),
$doc := concat($coll,'/',$doc)
return $doc
};
(: +
| Returns the full path to a term document in a term collection,
| based on language and collection ID as function arguments.
+ :)
declare function ristenutil:get-doc($collID as xs:string, $lang as xs:string) as xs:string+
{
let $coll := ristenutil:get-collection($collID),
$doc := if ( $lang = 'all' or $lang = 'center' ) then
concat($coll,'/termcenter.xml')
else
concat($coll,'/terms-',$lang,'.xml')
return $doc
};
(: +
| Returns the full path to a term document in a term collection,
| based on language as function argument. It takes the collection ID
| from the session.
+ :)
declare function ristenutil:get-doc($lang as xs:string) as xs:string
{
let $coll := ristenutil:get-collection(),
$doc := if ( $lang = 'all' or $lang = 'center' ) then
concat($coll,'/termcenter.xml')
else
concat($coll,'/terms-',$lang,'.xml')
return $doc
};
(: +
| Returns the full path to a term document in the SD-terms collection,
| based on language selection given as request paramater. Collection ID
| is taken from the session.
+ :)
declare function ristenutil:get-doc() as xs:string
{
let $coll := ristenutil:get-collection(),
$lang := request:get-parameter("showlang", "")
let $doc := if ("all" = $lang or $lang = 'center') then
'termcenter.xml'
else (
concat('terms-', $lang, '.xml')
)
return concat($coll, '/', $doc)
};
(: Pre-main function - checks which documents are affected and locks them upon
calling the real main function, which includes XUpdates (the reason for the lock) :)
declare function ristenutil:pre-main($lang as xs:string, $func as element()) as element()+
{
let $centerdoc := concat(ristenutil:get-collection(), '/termcenter.xml'),
$langdoc := ristenutil:get-doc( $lang )
let $docs := ( doc($centerdoc), doc($langdoc) )
return util:exclusive-lock( $docs, $func )
};
(: +
| Creates an xml entry to be displayed
+ :)
declare function ristenutil:display($lang as xs:string, $hits as node()+)
as element()
{
let $entry := item-at($hits,1),
$common := $entry/common,
$senses := $entry/senses,
$id := $entry/@id
return
{$common}
{
for $s in $entry/senses/sense
let $status := $s/@status
order by $status
return
{
if ( $s/def ) then
$s/def
else (),
if ( $s/synonyms ) then
$s/synonyms
else ()
}
}
};
(: +
| Creates an xml entry to be displayed, senses filtered against a center ID
+ :)
declare function ristenutil:display($lang as xs:string,
$hits as node()+,
$centerid as xs:string)
as element()
{
let $entry := item-at($hits,1),
$common := $entry/common,
$senses := $entry/senses,
$id := $entry/@id
return
{$common}
{
for $s in $entry/senses/sense[@idref eq $centerid]
let $status := $s/@status
return
{
if ( $s/def ) then
$s/def
else (),
if ( $s/synonyms ) then
$s/synonyms
else ()
}
}
};
(: +
| Create an ID filter expression from query term
+ :)
declare function ristenutil:id-filter($record as xs:string) as xs:string
{
let $t := concat("'", $record, "'")
return
concat("@id = ", $t)
};
(:
: Make a unique numeric ID for termcenter.xml
: This function returns () if used on a collection that doesn't use a
: numeric centerID type (propnouns doesn't).
:)
declare function ristenutil:newID() as xs:integer
{
let $coll := ristenutil:get-collection()
return
if (collection($coll)/termmeta/centerIDType/text() eq "numeric") then
let $doc := concat($coll, '/termcenter.xml')
let $r := document($doc)//entry/@id
(: Find the highest existing ID and increment by one: :)
return (max($r) + 1)
else
-1
};
(: +
| Create a numeric string of the current date&time. The format is:
| YYYYMMDDHHMMSS, eg. 20050329123129
| Storing the date as an integer makes it easy to compare dates, sorting etc.
+ :)
declare function ristenutil:dateTime() as xs:string
{
let $dt:=fn:current-dateTime(),
$y:=fn:year-from-dateTime($dt) cast as xs:string,
$m:=fn:month-from-dateTime($dt) cast as xs:string,
$d:=fn:day-from-dateTime($dt) cast as xs:string,
$h:=fn:hours-from-dateTime($dt) cast as xs:string,
$min:=fn:minutes-from-dateTime($dt) cast as xs:string,
$s:=fn:round(fn:seconds-from-dateTime($dt)) cast as xs:string,
$lmon:=fn:string-length($m),
$padmon:=fn:concat(fn:string-pad("0",2-$lmon),$m),
$lday:=fn:string-length($d),
$padday:=fn:concat(fn:string-pad("0",2-$lday),$d),
$lhour:=fn:string-length($h),
$padhour:=fn:concat(fn:string-pad("0",2-$lhour),$h),
$lmin:=fn:string-length($min),
$padmin:=fn:concat(fn:string-pad("0",2-$lmin),$min),
$lsec:=fn:string-length($s),
$padsec:=fn:concat(fn:string-pad("0",2-$lsec),$s)
return
fn:concat($y,$padmon,$padday,$padhour,$padmin,$padsec)
};
(: Count the number of entries in all public termcenter.xml files: :)
declare function ristenutil:countRecords() as xs:integer
{
let $colls := ristenutil:get-public-termcolls()
let $r := if ( count($colls) != 0 ) then
collection($colls)/termCenter/entry
else ()
return count($r)
};
(: Count the number of entries in a specified termcenter.xml files: :)
declare function ristenutil:countRecords($coll as xs:string) as xs:integer
{
let $d := concat($coll, '/termcenter.xml'),
$r := document($d)//entry
return count($r)
};
(: Count the number of entries in a specified collection and type: :)
declare function ristenutil:countRecords($collID as xs:string,
$type as xs:string)
as xs:integer
{
let $path := ristenutil:get-collection($collID),
$doc := if ($type = 'dicts') then
concat($path, '/', collection($path)/dictmeta/dictfile )
else
concat($path, '/termcenter.xml'),
$r := document($doc)//entry
return count($r)
};
(: Count the number of entries in all terms-$LANG.xml files: :)
declare function ristenutil:count-term-entries() as xs:integer
{
let $colls := ristenutil:get-public-termcolls()
let $r := if ( count($colls) != 0 ) then
collection($colls)/terminology/entry
else ()
return count($r)
};
(: Count the number of entries in all dictionary files: :)
declare function ristenutil:count-dict-entries() as xs:integer
{
let $colls := ristenutil:get-public-dictcolls()
let $r := if ( count($colls) != 0 ) then
collection($colls)//entry
else ()
return count($r)
};
(: Get the last modified date on all files - this is the date
the whole db was last modified: :)
declare function ristenutil:lastChanged() as xs:decimal
{
let $r := collection('/db/ordbase')//@last-update
return max($r) cast as xs:decimal
};
(: Clean the entry, by removing spacing chars in the beginning
and end, collapsing double spaces to single instances, etc.: :)
declare function ristenutil:cleanEntry($entry as xs:string) as xs:string
{
(: to begin with, we remove leading and trailing spaces, and collapse
multiple spaces to one - later we may have to add more. :)
let $r := fn:normalize-space($entry)
return $r
};
(:~
: Utility function to return the term collection being worked with,
: with the xmldb: protocol appended.
:
: @return String with the whole xmldb reference to the collection
:)
declare function ristenutil:get-xmldb-collection() as xs:string
{
let $collID:= session:get-attribute("collection")
let $coll := util:collection-name(/(termmeta|dictmeta|classmeta)/id[text() eq $collID])
let $db := concat('xmldb:exist://',$coll)
return $db
};
(:~
: Utility function to return the term collection being worked with,
: without any xmldb: protocol. The term collection is taken from a
: session attribute.
:
: @return String with the collection reference
:)
declare function ristenutil:get-collection() as xs:string
{
let $collID := session:get-attribute("collection")
let $coll := if ( /dictmeta/id ) then
(: The following function breaks down if one of the elements aren't
found - thus two versions (there will always be at least one
term collection and one classification scheme) :)
util:collection-name(/(termmeta|dictmeta|classmeta)/id[text() eq $collID])
else
util:collection-name(/(termmeta|classmeta)/id[text() eq $collID])
return $coll
};
(:~
: Utility function to return the term collection being worked with,
: without any xmldb: protocol. The term collection is given as an input
: argument to the function
:
: @collID String with the ID of the collection
: @return String with the collection reference
:)
declare function ristenutil:get-collection($collID as xs:string) as xs:string
{
let $coll := if ( /dictmeta/id ) then
(: The following function breaks down if one of the elements aren't
found - thus two versions (there will always be at least one
term collection and one classification scheme) :)
util:collection-name(/(termmeta|dictmeta|classmeta)/id[text() eq $collID])
else
util:collection-name(/(termmeta|classmeta)/id[text() eq $collID])
return $coll
};
(:~
: Utility function to return the collection type of a collection. The term collection
: ID is given as an input argument to the function
:
: @collID String with the ID of the collection
: @return String with the collection type
:)
declare function ristenutil:get-collection-type($collID as xs:string) as xs:string
{
let $path := util:collection-name(/*/id[text() eq $collID]),
$type := tokenize($path, '/')[last()-1]
return $type
};
(:~
: Returns a list of all term collections publicly visible
: (i.e. they have their meta.xml/termmeta/public element set to 'yes')
:
: @return list of collection strings: /db/ordbase/terms/SD-terms
:)
declare function ristenutil:get-all-public-collections() as xs:string*
{
for $r in /(termmeta|dictmeta)[public/text() eq "yes"]
let $coll := util:collection-name($r/id)
return $coll
};
(:~
: Returns a list of all term collections publicly visible
: (i.e. they have their meta.xml/termmeta/public element set to 'yes')
:
: @return list of collection strings: /db/ordbase/terms/SD-terms
:)
declare function ristenutil:get-all-public-collections-with-id() as xs:string*
{
for $r in /(termmeta|dictmeta)[public/text() eq "yes"]
return $r/id cast as xs:string
};
(:~
: Returns a list of all term collections publicly visible
: (i.e. they have their meta.xml/termmeta/public element set to 'yes')
:
: @return list of strings
:)
declare function ristenutil:get-public-termcolls() as xs:string*
{
for $r in /termmeta[public/text() eq "yes"]
let $coll := util:collection-name($r/id)
return $coll
};
(:~
: Returns a list of all term collections publicly visible
: (i.e. they have their meta.xml/termmeta/public element set to 'yes')
:
: @return list of strings
:)
declare function ristenutil:get-public-dictcolls() as xs:string*
{
for $r in /dictmeta[public/text() eq "yes"]
let $coll := util:collection-name($r/id)
return $coll
};
(:~
: Returns a list of all term collections publicly visible
: (i.e. they have their meta.xml/termmeta/public element set to 'yes')
:
: @return list of strings
:)
declare function ristenutil:get-termcolls-from-class( $classID as xs:string) as xs:string*
{
for $r in /termmeta[class eq $classID]
return $r/id/text() cast as xs:string
};
(:~
: Stores the collection type and collection ID in session parameters,
: to make it possible to retrieve this info wihtout adding it to each
: request
:
: @return the boolean value "true"
:)
declare function ristenutil:store-coll-in-session() as xs:boolean
{
let $collPath := request:get-parameter("srchcoll", "")
let $pathcomps:= tokenize($collPath, "/")
let $collID := $pathcomps[5] cast as xs:string
let $colltype := $pathcomps[4] cast as xs:string
let $dummy1 := session:set-attribute("collection", $collID)
let $dummy2 := session:set-attribute("colltype", $colltype)
return true()
};
(:~
: Returns the languages defined for a classification system
:
: @return element langs, with one or more lang elements each containing an ISO code
:)
declare function ristenutil:get-class-langs( $classID as xs:string) as element()
{
let $classcoll := ristenutil:get-collection($classID)
return collection( $classcoll )/classmeta/langs
};
(: Transforms a list of language codes into a list of the corresponding document
reference strings for the requested collection. :)
declare function ristenutil:langs-to-docs($collID as xs:string,
$langs as xs:string+)
as xs:string+
{
for $lang in $langs
let $doc := ristenutil:get-doc($collID, $lang)
return concat("'",$doc,"'")
};