(:~
: Module: Save routines for storing xml into the db using XUpdate.
:
: This module provides the functions used to perform updates on xml
: documents. The functions are typically called from several other
: modules.
:
: @author Sjur Nørstebø Moshagen
: @version 0.2
:)
(: CVS tags:
$Id: saveroutines.xqm 18043 2008-04-10 10:44:49Z sjur $
:)
module namespace save="http://www.risten.no/edit/save";
import module namespace ristenutil="http://www.risten.no/shared/util" at "../xquery/ristenutil.xqm";
declare namespace session="http://exist-db.org/xquery/session";
declare namespace request="http://exist-db.org/xquery/request";
declare namespace xmldb="http://exist-db.org/xquery/xmldb";
declare namespace util="http://exist-db.org/xquery/util";
(: +-------------------------------------------+
| First some shared file-updating routines: |
+-------------------------------------------+ :)
(:~
: A simple function to create a timestamp for an updated file. All
: updates performed should be accompanied by such a timestamp, to
: have explicit knowledge about when a file was last changed.
:
: The timestamp XUpdate is only valid for language files in a
: terminology collection.
:
: @param $doc the document to which the timestamp should be added
:
: @return XUpdate update statement
:)
declare function save:defined-languages($id as xs:integer)
as element()
{
let $doc := ristenutil:get-doc('center')
let $langs := document($doc)//entry[@id &= $id]/entryref/@xml:lang
return
};
(:~
: A simple function to create a timestamp for an updated file. All
: updates performed should be accompanied by such a timestamp, to
: have explicit knowledge about when a file was last changed.
:
: The timestamp XUpdate is only valid for language files in a
: terminology collection.
:
: @param $doc the document to which the timestamp should be added
:
: @return XUpdate update statement
:)
declare function save:languageTimeStamp($doc as xs:string)
as element()
{
let $date := ristenutil:dateTime()
return
{$date}
};
(: +
| Create a statement for updating the timestamp on a term center document:
+ :)
declare function save:centerTimeStamp($doc as xs:string) as element()
{
let $date := ristenutil:dateTime()
let $timestamp :=
{$date}
return $timestamp
};
(: +-------------------------------------------+
| Then the real content-updating routines: |
+-------------------------------------------+ :)
(: Save an existing entry, with new sense for the new term record :)
declare function save:saveExistingEntry($centerid as xs:string) as element()
{
let $lang := request:get-parameter("lang", ""),
$rawentry := request:get-parameter("entry", ""),
$pos := request:get-parameter("pos", ""),
$entry := ristenutil:cleanEntry( $rawentry ),
(: The class codes are coming directly if adding to an exising record: :)
$topT := request:get-parameter("top", ""),
$midT := request:get-parameter("mid", ""),
$botmT := request:get-parameter("botm", ""),
(: The class codes are coming indirectly through this one if it is a new record: :)
$class := request:get-parameter("class", ""),
$top := if ($topT = "") then (: If the request param is empty, then it is a new rec :)
substring($class, 1, 1)
else $topT,
$mid := if ($midT = "") then
if (contains($class, '-') ) then
substring-before($class, "-")
else $class
else $midT,
$botm := if ($botmT = "") then
if (contains($class, '-') ) then
substring-after($class, "-")
else ""
else $botmT,
$langid := ristenutil:makeTermID($entry, $pos)
let $user := session:get-attribute("user" ),
$pass := session:get-attribute("password"),
$coll := "/db/ordbase/terms/SD-terms",
$doc := ristenutil:get-doc($lang),
$db := concat('xmldb:exist://',$coll)
let $date := ristenutil:dateTime()
(: $collection should refer to the collection, not the
document in the collection!
let $collection := xmldb:collection( $db, $user, $pass) :)
(: The document reference needs to include the collection
path even though it is given in the $collection argument in
the xmldb:update command (below). :)
let $langupdate :=
{$date}
(: execute the XUpdate: :)
let $dummy := xmldb:update($db, $langupdate)
return
Database: {$db}
ID: {$centerid}
LangID: {$langid}
Oppslag: {$entry}
XUpdate: {$langupdate}
Lagra!
};
(: Save an edited entry, the grammar part common to all senses: :)
declare function save:saveNewEntry($centerid as xs:string) as element()
{
let $lang := request:get-parameter("lang", ""),
$rawentry := request:get-parameter("entry", ""),
$pos := request:get-parameter("pos", ""),
$entry := ristenutil:cleanEntry( $rawentry ),
(: The class codes are coming directly if adding to an exising record: :)
$topT := request:get-parameter("top", ""),
$midT := request:get-parameter("mid", ""),
$botmT := request:get-parameter("botm", ""),
(: The class codes are coming indirectly through this one if it is a new record: :)
$class := request:get-parameter("class", ""),
$top := if ($topT = "") then (: If the request param is empty, then it is a new rec :)
substring($class, 1, 1)
else $topT,
$mid := if ($midT = "") then
if (contains($class, '-') ) then
substring-before($class, "-")
else $class
else $midT,
$botm := if ($botmT = "") then
if (contains($class, '-') ) then
substring-after($class, "-")
else ""
else $botmT,
$langid := ristenutil:makeTermID($entry, $pos)
let $user := session:get-attribute("user" ),
$pass := session:get-attribute("password"),
$coll := "/db/ordbase/terms/SD-terms",
$doc := ristenutil:get-doc($lang),
$cntrdoc := "/db/ordbase/terms/SD-terms/termcenter.xml",
$db := concat('xmldb:exist://',$coll)
let $date := ristenutil:dateTime()
(: $collection should refer to the collection, not the
document in the collecion!
let $collection := xmldb:collection( $db, $user, $pass) :)
(: The document reference needs to include the collection
path even though it is given in the $collection argument in
the xmldb:update command (below). :)
let $langupdate :=
{$langid}
{$entry}
{$date}
let $dummy := xmldb:update($db, $langupdate)
return
Database: {$db}
ID: {$centerid}
Oppslag: {$entry}
XUpdate: {$langupdate}
Result: {$dummy}
Lagra!
};
(: Create a new Term Record entry, return the record ID: :)
declare function save:saveNewCenter() as xs:integer
{
let $centerid := ristenutil:newID(),
$lang := request:get-parameter("lang", ""),
$rawentry := request:get-parameter("entry", ""),
$pos := request:get-parameter("pos", ""),
$entry := ristenutil:cleanEntry( $rawentry ),
$class := request:get-parameter("class", ""),
$top := substring( $class, 1, 1),
$mid := if (contains($class, '-') ) then
substring-before($class, "-")
else $class,
$botm := if (contains($class, '-') ) then
substring-after($class, "-")
else "",
$langid := ristenutil:makeTermID($entry, $pos)
let $user := session:get-attribute("user" ),
$pass := session:get-attribute("password"),
$coll := "/db/ordbase/terms/SD-terms",
$doc := ristenutil:get-doc($lang),
$cntrdoc := "/db/ordbase/terms/SD-terms/termcenter.xml",
$db := concat('xmldb:exist://',$coll)
let $date := ristenutil:dateTime(),
$comment := concat("Created this record, added entry for ", $lang),
$href := concat("terms-", $lang, ".xml" ),
$xpointer := concat("xpointer(//entry[@id='",
$langid,
"'])" )
(: $collection should refer to the collection, not the
document in the collecion!
let $collection := xmldb:collection( $db, $user, $pass) :)
return
if (0 > $centerid) then
$centerid
else
(: The document reference needs to include the collection
path even though it is given in the $collection argument in
the xmldb:update command (below). :)
let $centerupdate :=
{$date}
(: execute the XUpdate: :)
let $dummy := xmldb:update($db, $centerupdate)
return $centerid
};
(: Update a term center record with a new language: :)
declare function save:updatecenter($centerid as xs:string) as xs:string
{
let $lang := request:get-parameter("lang", ""),
$rawentry := request:get-parameter("entry", ""),
$pos := request:get-parameter("pos", ""),
$entry := ristenutil:cleanEntry( $rawentry ),
$top := request:get-parameter("top", ""),
$mid := request:get-parameter("mid", ""),
$botm := request:get-parameter("botm", ""),
$langid := ristenutil:makeTermID($entry, $pos)
let $user := session:get-attribute("user" ),
$pass := session:get-attribute("password"),
$coll := "/db/ordbase/terms/SD-terms",
$doc := ristenutil:get-doc($lang),
$cntrdoc := "/db/ordbase/terms/SD-terms/termcenter.xml",
$db := concat('xmldb:exist://',$coll)
let $date := ristenutil:dateTime(),
$comment := concat("Added entry for ", $lang),
$href := concat("terms-", $lang, ".xml" ),
$xpointer := concat("xpointer(//entry[@id='",
$langid,
"'])" )
(: $collection should refer to the collection, not the
document in the collecion!
let $collection := xmldb:collection( $db, $user, $pass) :)
(: The document reference needs to include the collection
path even though it is given in the $collection argument in
the xmldb:update command (below). :)
let $centerupdate :=
{$date}
(: execute the XUpdate: :)
let $dummy := xmldb:update($db, $centerupdate)
return $centerid
};
(: + The following functions are used to update an existing, monolingual terminology
| entry, with all senses and references back and forth.
+ :)
(: This function updates the ID of an entry, and all references to it :)
declare function save:updateID($oldID as xs:string, $newID as xs:string) as xs:string
{
let $lang := request:get-parameter("lang", ""),
$user := session:get-attribute("user"),
$pass := session:get-attribute("password"),
$coll := "/db/ordbase/terms/SD-terms",
$cntr := "termcenter.xml",
$doc := ristenutil:get-doc($lang),
$cntdoc := concat($coll,'/',$cntr),
$db := concat('xmldb:exist://',$coll)
(: let $collection := xmldb:collection( $db, $user, $pass) :)
(: Need to use ' since $oldcenterref is used as part of an attribute already containing '' :)
(: Also, it has to be ' and not ", since it should match a string containing '' :)
let $oldcenterref := concat("xpointer(//entry[@id='",
$oldID,
"'])" ),
$newcenterref := concat("xpointer(//entry[@id='",
$newID,
"'])" )
(: Update the ID of the entry itself: :)
let $mainupdate :=
{$newID}
(: Update all references to the term in the central term records: :)
(: Note that since $oldcenterref contains escaped '-s ('), it has to be surrounded by
double quotes, which in turn has to be within single quotes. This alternation is
important - without it the selection will crash due to unexpected end of string!!! :)
let $centerupdate :=
{
$newcenterref
}
(: Update all references to the term from synonyms, orthographical variants and main terms: :)
(: The references to be updated are in attributes:
- mainref
- synref
- variantref
and have to be targeted independently. :)
let $refupdate := (
{$newID},
{$newID},
{$newID}
)
let $timestamp := save:languageTimeStamp($doc)
let $cntrtimestamp := save:centerTimeStamp($cntdoc)
(: Wrap all update statements in the outer XUpdate element: :)
let $xupdate :=
{ $mainupdate }
{ $centerupdate }
{ $refupdate }
{ $timestamp }
{ $cntrtimestamp }
(: Execute the complete XUpdate: :)
let $dummy := xmldb:update($db, $xupdate)
return $newID
};
(: Function to check for the existence of a referenced entry. If the entry does
exist, that entry is updated with a new back-reference to the referee; if it
does not, the whole entry is created.
Arguments:
$entryID - the ID of the (potential) entry to check for
$doc - reference to the document in which the entry should be
$mainID - the ID of the referring entry
$centerID - the ID of the term center record of this entry
$orthStat - the orthographical status of the entry
$synStat - the synonym status of the entry - 'none' as value
signals that this is an orthographical variant with
no senses in itself
$topic - topicClass element ready for inclusion
RETURNS: the XUPdate fragment to perform the necessary changes. The fragment
should be embedded in a wrapping xupdate element, ie. alongside other
similar xupdate fragments. :)
declare function save:checkRefEntry( $entryID as xs:string,
$doc as xs:string,
$mainID as xs:string,
$centerID as xs:string,
$orthStat as xs:string,
$synStat as xs:string,
$topic as element() )
as element()*
{
let $entry := translate(substring-before($entryID, '\'), '_', ' '),
$pos := substring-after($entryID, '\')
let $date := ristenutil:dateTime(),
$user := session:get-attribute("user")
let $XUpdEntry := if ( $synStat = "none") then (: it is an orthograhic variant :)
if ( doc($doc)//entry[@id = $entryID] ) then
(: the entry exists already - - add backreference :)
() (: There's presently no support for backreferences to multiple main entries,
so we do nothing, assuming that one entry can only be a variant of one other :)
else (: it does not exist - - create the entry with backreference :)
{$entry}
else (: it is a synonym :)
if ( doc($doc)//entry[@id = $entryID] ) then
(: add sense if there is no existing reference to the main entry :)
if ( doc($doc)//entry[@id = $entryID]/senses[./sense/@mainref
= $mainID and ./sense/@idref = $centerID] ) then
(: if the mainref and centerref (idref) DOES exist, do nothing, it's a duplicate :)
()
else
(: add sense with backreference: :)
{$topic}
else
(: add entry:)
{$entry}
{$topic}
return $XUpdEntry
};
declare function save:buildSenseXupd( $iteration as xs:integer,
$sensecount as xs:integer,
$id as xs:string,
$doc as xs:string)
as element()+
{
let
$cntrIdPar := concat("topic-", $iteration, "-ref"),
$TopPar := concat("top-", $iteration),
$MidPar := concat("mid-", $iteration),
$BotmPar := concat("botm-", $iteration),
$statusPar := concat("status-", $iteration),
$mainRefPar := concat("mainref-", $iteration),
$defPar := concat("def-", $iteration),
$examplePar := concat("example-", $iteration),
$syn1Par := concat("sense-", $iteration, "-syn-1"),
$syn1posPar := concat("sense-", $iteration, "-synpos-1"),
$syn2Par := concat("sense-", $iteration, "-syn-2"),
$syn2posPar := concat("sense-", $iteration, "-synpos-2"),
$syn3Par := concat("sense-", $iteration, "-syn-3"),
$syn3posPar := concat("sense-", $iteration, "-synpos-3"),
$syn4Par := concat("sense-", $iteration, "-syn-4"),
$syn4posPar := concat("sense-", $iteration, "-synpos-4"),
$syn5Par := concat("sense-", $iteration, "-syn-5"),
$syn5posPar := concat("sense-", $iteration, "-synpos-5"),
$pos := request:get-parameter("pos", ""),
$centerID := request:get-parameter($cntrIdPar, ""),
$top := request:get-parameter($TopPar, ""),
$mid := request:get-parameter($MidPar, ""),
$botm := request:get-parameter($BotmPar, ""),
$status := request:get-parameter($statusPar, ""),
$mainRef := request:get-parameter($mainRefPar, ""),
$definition := request:get-parameter($defPar, ""),
$example := request:get-parameter($examplePar, ""),
$syn1 := request:get-parameter($syn1Par, ""),
$syn1pos := request:get-parameter($syn1posPar, ""),
$syn2 := request:get-parameter($syn2Par, ""),
$syn2pos := request:get-parameter($syn2posPar, ""),
$syn3 := request:get-parameter($syn3Par, ""),
$syn3pos := request:get-parameter($syn3posPar, ""),
$syn4 := request:get-parameter($syn4Par, ""),
$syn4pos := request:get-parameter($syn4posPar, ""),
$syn5 := request:get-parameter($syn5Par, ""),
$syn5pos := request:get-parameter($syn5posPar, "")
let $pos1 := if ($syn1pos = "" ) then $pos else $syn1pos
let $pos2 := if ($syn2pos = "" ) then $pos else $syn2pos
let $pos3 := if ($syn3pos = "" ) then $pos else $syn3pos
let $pos4 := if ($syn4pos = "" ) then $pos else $syn4pos
let $pos5 := if ($syn5pos = "" ) then $pos else $syn5pos
let $topic :=
let $defelement := if ($definition != "") then
{$definition}
else ()
let $xplelement := if ($example != "") then
{$example}
else ()
let $syn1ID := concat(translate($syn1, ' ', '_'), '\', $pos1),
$syn2ID := concat(translate($syn2, ' ', '_'), '\', $pos2),
$syn3ID := concat(translate($syn3, ' ', '_'), '\', $pos3),
$syn4ID := concat(translate($syn4, ' ', '_'), '\', $pos4),
$syn5ID := concat(translate($syn5, ' ', '_'), '\', $pos5)
let $syn1element := if ($syn1 != "") then
else ()
let $syn2element := if ($syn2 != "" and ( ( $syn2ID != $syn1ID ) and
( $syn2ID != $syn3ID ) and
( $syn2ID != $syn4ID ) and
( $syn2ID != $syn5ID ) ) ) then
else ()
let $syn3element := if ($syn3 != "" and ( ( $syn3ID != $syn1ID ) and
( $syn3ID != $syn2ID ) and
( $syn3ID != $syn4ID ) and
( $syn3ID != $syn5ID ) ) ) then
else ()
let $syn4element := if ($syn4 != "" and ( ( $syn4ID != $syn1ID ) and
( $syn4ID != $syn2ID ) and
( $syn4ID != $syn3ID ) and
( $syn4ID != $syn5ID ) ) ) then
else ()
let $syn5element := if ($syn5 != "" and ( ( $syn5ID != $syn1ID ) and
( $syn5ID != $syn2ID ) and
( $syn5ID != $syn3ID ) and
( $syn5ID != $syn4ID ) ) ) then
else ()
let $XUpdSyn1 := if ($syn1 != "") then
save:checkRefEntry($syn1ID, $doc, $id, $centerID, "main", "syn", $topic) else (),
$XUpdSyn2 := if ($syn2 != "") then
save:checkRefEntry($syn2ID, $doc, $id, $centerID, "main", "syn", $topic) else (),
$XUpdSyn3 := if ($syn3 != "") then
save:checkRefEntry($syn3ID, $doc, $id, $centerID, "main", "syn", $topic) else (),
$XUpdSyn4 := if ($syn4 != "") then
save:checkRefEntry($syn4ID, $doc, $id, $centerID, "main", "syn", $topic) else (),
$XUpdSyn5 := if ($syn5 != "") then
save:checkRefEntry($syn5ID, $doc, $id, $centerID, "main", "syn", $topic) else ()
let $XUpdateExpression := (
{$topic}
{$defelement}
{$xplelement}
{$syn1element}
{$syn2element}
{$syn3element}
{$syn4element}
{$syn5element}
,
$XUpdSyn1,
$XUpdSyn2,
$XUpdSyn3,
$XUpdSyn4,
$XUpdSyn5
)
let $senseXupd :=
if ($iteration < $sensecount ) then
( $XUpdateExpression,
save:buildSenseXupd( $iteration + 1, $sensecount, $id, $doc)
)
else ( $XUpdateExpression )
return ($senseXupd)
};
(: Save an edited entry: :)
declare function save:saveentry($recordid as xs:string) as element()
{
let $id := $recordid,
$lang := request:get-parameter("lang", ""),
$rawentry := request:get-parameter("entry", ""),
$pos := request:get-parameter("pos", ""),
$entry := ristenutil:cleanEntry( $rawentry ),
$spoken := request:get-parameter("spoken", ""),
$inflmajor := request:get-parameter("inflmajor", ""),
$inflminor := request:get-parameter("inflminor", ""),
$inflexmpl := request:get-parameter("inflexmpl", ""),
$orth := request:get-parameter("orthstatus", ""),
$orthV1 := request:get-parameter("orthvar1", ""),
$orthV1typ := request:get-parameter("orthvartyp1", ""),
$orthV2 := request:get-parameter("orthvar2", ""),
$orthV2typ := request:get-parameter("orthvartyp2", ""),
$orthV3 := request:get-parameter("orthvar3", ""),
$orthV3typ := request:get-parameter("orthvartyp3", ""),
$checked := request:get-parameter("qachecked", ""),
$changelog := request:get-parameter("changecomment", "")
let $orth1pos := if ($orthV1typ = "abbr") then "ABBR" else $pos,
$orth2pos := if ($orthV2typ = "abbr") then "ABBR" else $pos,
$orth3pos := if ($orthV3typ = "abbr") then "ABBR" else $pos
let $user := session:get-attribute("user") ,
$pass := session:get-attribute("password"),
$coll := "/db/ordbase/terms/SD-terms",
$doc := ristenutil:get-doc($lang),
$db := concat('xmldb:exist://',$coll)
let $sensecount := request:get-parameter("sensecount", "") cast as xs:integer,
$senseXupd := save:buildSenseXupd(1, $sensecount, $id, $doc)
let $date := ristenutil:dateTime()
let $infl :=
if ($inflexmpl != "") then
element infl {
if ($inflmajor != "") then
attribute major {$inflmajor}
else (),
if ($inflminor != "" and $inflmajor != "") then
attribute minor {$inflminor}
else (),
$inflexmpl
}
else
if ($inflmajor != "") then
element infl {
attribute major {$inflmajor},
if ($inflminor != "") then
attribute minor {$inflminor}
else ()
}
else ()
let $orthV1id := concat(translate($orthV1, ' ', '_'), '\', $orth1pos),
$orthV2id := concat(translate($orthV2, ' ', '_'), '\', $orth2pos),
$orthV3id := concat(translate($orthV3, ' ', '_'), '\', $orth3pos)
let $orth := if ( $orthV1 = "" and $orthV2 = "" and $orthV3 = "" ) then
else
{
if ( $orthV1 != "" ) then
else () }{
if ( $orthV2 != "" ) then
else () }{
if ( $orthV3 != "" ) then
else () }
let $XUpdOrthV1 := if ($orthV1 != "") then
save:checkRefEntry($orthV1id, $doc, $id, "", $orthV1typ, "none", ) else (),
$XUpdOrthV2 := if ($orthV2 != "") then
save:checkRefEntry($orthV2id, $doc, $id, "", $orthV2typ, "none", ) else (),
$XUpdOrthV3 := if ($orthV3 != "") then
save:checkRefEntry($orthV3id, $doc, $id, "", $orthV3typ, "none", ) else ()
let $qa := if ($checked = "true") then
else
let $spokenelement :=
if ($spoken != "") then
{$spoken}
else ()
let $log :=
if ( $changelog != "" ) then
else ()
let $timestamp := save:languageTimeStamp($doc)
(: $collection should refer to the collection, not the
document in the collecion!
let $collection := xmldb:collection( $db, $user, $pass) :)
(: The document reference needs to include the collection
path even though it is given in the $collection argument in
the xmldb:update command (below). :)
let $xupdate :=
{$entry}
{ $spokenelement }
{ $infl }
{ $orth }
{ $qa }
{ $XUpdOrthV1 }
{ $XUpdOrthV2 }
{ $XUpdOrthV3 }
{ $senseXupd }
{ $log }
{ $timestamp }
let $dummy := xmldb:update($db, $xupdate)
return
Database: {$db}
ID: {$id}
Oppslag: {$entry}
XUpdate: {$xupdate}
SenseXU: {$senseXupd}
Result: {$dummy}
Lagra!
};
(: +---------------------------------------------------+
| Routines for deleting entries, or parts thereof : |
+---------------------------------------------------+ :)
(:~
: Function to delete a specified sense of a specified language entry.
:
: @param $doc the document from which to delete
NB! should this just be the name of the doc, or
the full path as string?
: @param $coll the collection containing the document
: @param $entry the ID of the entry from which to delete
: @param $sense the ID of the termcenter record corresponding to the
: sense to be deleted
:
: @return XUpdate update statement
:)
declare function save:delete-language-sense($doc as xs:string,
$coll as xs:string,
$entry as xs:string,
$sense as xs:string)
as element()
{
let $user := session:get-attribute("user") ,
$pass := session:get-attribute("password"),
$db := concat('xmldb:exist://',$coll)
(: let $collection := xmldb:collection( $db, $user, $pass) :)
let $timestamp := save:languageTimeStamp($doc)
(: The document reference needs to include the collection
path even though it is given in the $collection argument in
the xmldb:update command (below). :)
let $xupdate :=
{ $timestamp }
let $dummy := xmldb:update($db, $xupdate)
return
Database: {$db}
Result: {$dummy}
Lagra!
};