xquery version "3.0";
(:
    ART-DECOR® STANDARD COPYRIGHT AND LICENSE NOTE
    Copyright © ART-DECOR Expert Group and ART-DECOR Open Tools GmbH
    see https://docs.art-decor.org/copyright and https://docs.art-decor.org/licenses

    This file is part of the ART-DECOR® tools suite.
:)
(: TODO: Should come up with some kind of marker in content retrieved from a repo just to make it clear that is not actual local to this file? :)
module namespace hist            = "http://art-decor.org/ns/decor/history";

import module namespace get      = "http://art-decor.org/ns/art-decor-settings" at "../modules/art-decor-settings.xqm";
import module namespace art      = "http://art-decor.org/ns/art" at "../modules/art-decor.xqm";
import module namespace adserver = "http://art-decor.org/ns/art-decor-server" at "api-server-settings.xqm";
import module namespace decor    = "http://art-decor.org/ns/decor" at "api-decor.xqm";

declare namespace xdb            = "http://exist-db.org/xquery/xmldb";
declare namespace request        = "http://exist-db.org/xquery/request";
declare namespace response       = "http://exist-db.org/xquery/response";
declare namespace datetime       = "http://exist-db.org/xquery/datetime";
declare namespace util           = "http://exist-db.org/xquery/util";

declare option exist:serialize "method=xml media-type=text/xml";

declare variable $hist:debug               := false();

(:~
:   Store history for artefact obejcttype as historic item with a wrapper
:   
:   @param $objecttype      - required. Object type of the artefact, e.g. TM or VS, shall use $decor:OBJECTTYPE-TEMPLATE from api-decor or 'DECOR' for the whole file
    @param $projectPrefix   - required. Identifier of the project where the artefact resides
:   @param $intention       - required. String whether this historic item is subject of a "patch" (for active/final override) or a regular "version" change
:   @param $object          - required. The whole object (e.g. a template) as the new historic item
:   @return <history type="{$artefact}" project="{$projectPrefix}" date="{$now}" author="{$author}" success="true|false">
:   @since 2016-12-09
:)
declare function hist:AddHistory ($objecttype as xs:string, $projectPrefix as xs:string, $intention as xs:string, $object as element()) as element() {

    (: always assume the change happened now :)
    let $now            := current-dateTime()
    
    (: artefact signature :)
    let $artefact       := hist:getHistoryArtefactType($objecttype)
    
    (: find the right place to put the history item :)
    let $newcollection  := substring($projectPrefix, 1, string-length($projectPrefix) - 1)
    let $targetDir      := 
        if (xmldb:collection-available(concat($get:strDecorHistory, '/', $newcollection)))
        then concat($get:strDecorHistory, '/', $newcollection)
        else xmldb:create-collection($get:strDecorHistory, $newcollection)
    
    (: filename for history :)
    let $uuid           := util:uuid()
    let $targetfile     := concat($artefact, '.xml')

    (: who did that :)
    let $authorid       := get:strCurrentUserName()
    let $author         := $get:colDecorData//project[@prefix=$projectPrefix]/author[@username=$authorid]
    
    (: create the artefact historic list wrapper with artefact type, project, date and author :)
    (: TO DO COPY NAMESPACES INTO history ELEMENT FROM DECOR ROOT ELEMENT OR SO :)        
    let $wrapper        :=
        <history date="{$now}" authorid="{$authorid}" author="{$author}" id ="{$uuid}" intention="{$intention}">
        {
            if ($object/@id)            then attribute artefactId {$object/@id} else (),
            if ($object/@effectiveDate) then attribute artefactEffectiveDate {$object/@effectiveDate} else (),
            if ($object/@statusCode)    then attribute artefactStatusCode {$object/@statusCode} else ()
        }
        {
            $object
        }
        </history>
    (: store the historic item, the contained comment circumvents a bug in eXist-db 3.6.0 that prevents adding the first child
        under an element with attributes.
    :)
    let $rootElement    := <histories artefactType="{$artefact}" projectPrefix="{$projectPrefix}"><!-- history -->{$wrapper}</histories>
    let $store          := concat($targetDir, '/', $targetfile)
    let $add            := 
        if (doc-available($store)) then
            update insert $wrapper into doc($store)/histories
        else (
            xmldb:store($targetDir, $targetfile, $rootElement)
        )
    
    (: set access rights :)
    let $access          :=
        try {
            let $access1 := sm:chmod(xs:anyURI($store), 'rw-rw-r--')
            let $access1 := sm:chgrp(xs:anyURI($store), 'decor')
            let $access1 := sm:chown(xs:anyURI($store), 'admin')
            return ()
        } catch * { <norights/> }
        
    (: new: 2021-12-14 Add @lastModifiedDate on the object and its ancestors so we can tell the outside world when it was last modified. :)    
    let $addLastModified    :=
        switch (name($object))
        case 'dataset'
        case 'concept'
        case 'scenario'
        case 'transaction'
        case 'valueSet'
        case 'codeSystem'
        case 'template'
        (:case 'StructureDefinition'
        case 'Questionnaire':) return hist:addLastModifiedDate($object, $now)
        default return ()
        
    (: return :)
    return
        <history>
        {
            $wrapper/@*,
            attribute {'success' } { if (string-length($store) > 0) then 'true' else 'false' }
        }
        </history>
};

declare %private function hist:addLastModifiedDate ($object as element(), $now as xs:dateTime) {
    for $node in $object | $object/ancestor::transaction | $object/ancestor::scenario | $object/ancestor::concept | $object/ancestor::dataset
    return
        if ($node/@lastModifiedDate) then
            update value $node/@lastModifiedDate with substring(string($now), 1, 19)
        else (
            update insert attribute lastModifiedDate {substring(string($now), 1, 19)} into $node
        )
};

declare function hist:ListHistory ($objecttype as xs:string, $projectPrefix as xs:string) as element() {
    hist:ListHistory ($objecttype, $projectPrefix, '', '')
};

declare function hist:ListHistory ($objecttype as xs:string, $projectPrefix as xs:string, $id as xs:string?) as element() {
    hist:ListHistory ($objecttype, $projectPrefix, $id, '')
};

(:~
:   Get list of history for artefact obejcttype
:   
:   @param $objecttype      - required. Object type of the artefact, e.g. TM or VS, shall use $decor:OBJECTTYPE-TEMPLATE from api-decor
    @param $projectPrefix   - required. Identifier of the project where the artefact resides
:   @param $id              - optional. id of object or all historic items if empty string
:   @return 
:        <histories type="{$artefact}" project="{$projectPrefix}">
:           <history 
:               date="2017-01-29T14:05:13.414+01:00"
:               author="dr Kai U. Heitmann"
:               id="e8e37309-493a-4a46-8aae-962cf4a97534"
:               intention="version"
:               artefactId="2.16.840.1.113883.3.1937.99.60.5.10.3001"
:               artefactEffectiveDate="2014-07-08T00:00:00"
:               artefactStatusCode="draft"
:           />
:       </histories>
:   @since 2017-01-29
:)
declare function hist:ListHistory ($objecttype as xs:string, $projectPrefix as xs:string, $id as xs:string?, $effectiveDate as xs:string?) as element() {
    let $id             := $id[not(. = '')]
    let $effectiveDate  := $effectiveDate[. castable as xs:dateTime]
    
    (: artefact signature :)
    let $artefact       := hist:getHistoryArtefactType($objecttype)

    let $where          := collection(concat($get:strDecorHistory, '/', substring($projectPrefix, 1, string-length($projectPrefix) - 1)))
    let $what           :=
        if (empty($id)) then $where/histories[@artefactType = $artefact]/history else (
            if (empty($effectiveDate)) then 
                $where/histories[@artefactType = $artefact]/history[@artefactId = $id] 
            else (
                $where/histories[@artefactType = $artefact]/history[@artefactId = $id][@artefactEffectiveDate = $effectiveDate]
            )
        )
    return 
        <histories artefactType="{$artefact}" projectPrefix="{$projectPrefix}">
        {
            if (empty($id)) then () else attribute id {$id},
            if (empty($effectiveDate)) then () else attribute effectiveDate {$effectiveDate},
            for $a in $what
            order by $a/@date descending
            return
                <history>
                {
                    (: AD30-762 GDPR/Security. Don't expose database username :)
                    $a/(@* except @authorid),
                    <artefact>
                    {
                        $a/*[1]/@*,
                        $a/*[1]/classification
                    }
                    </artefact>
                    
                }
                </history>
        }
        </histories>
        
};

(:~ Delete history item by project, by type, by date, by count. 
    Example usage hist:DeleteHistory ((), 'demo1-', 180) means "Delete all history of any type from demo1- if it is older than 180 days

    @param $objecttype - Optional type of DECOR object to delete. Accepts DECOR.xsd DecorObjectType types, e.g. DE for dataelement/dataset concept or VS for valueSet. Default is "any object type"
    @param $projectPrefix - Optional DECOR project prefix, e.g. demo1- (trailing hyphen matters). Default is to delete from all projects
    @param $numberOfDaysToKeep - Required integer indicating how many days you want to keep. Use 0 to delete all history
    
    older than $noofdaystokeep days ago (based on current-dateTime()) from a specific project $projectPrefix or if empty all projects, with a specific type $objecttype or if empty all types 
:)
declare function hist:DeleteHistory ($objecttype as xs:string?, $projectPrefix as xs:string?, $numberOfDaysToKeep as xs:positiveInteger) as element() {
    let $now                    := current-dateTime()
    let $maxdatetokeep          := $now - xs:dayTimeDuration(concat('P', $numberOfDaysToKeep, 'D'))
    
    (: artefact signature :)
    let $artefact               := hist:getHistoryArtefactType($objecttype)
    
    (: find the right place to put the history item :)
    let $newcollection          := if (string-length($projectPrefix) = 0) then () else substring($projectPrefix, 1, string-length($projectPrefix) - 1)
    let $targetDir              := string-join(($get:strDecorHistory, $newcollection), '/')
    
    let $deletetargets          := if (xmldb:collection-available($targetDir)) then collection($targetDir)/histories else ()
    let $totalhistorycnt        := count($deletetargets/history)
    let $deletetargets          := if (string-length($objecttype) = 0) then $deletetargets else $deletetargets[@artefactType = $artefact]
    let $totaltypecnt           := count($deletetargets)
    let $deletetargets          := if ($numberOfDaysToKeep = 0) then $deletetargets/history else $deletetargets/history[xs:dateTime(@date) lt $maxdatetokeep]
    let $totaldatecnt           := count($deletetargets)
    
    let $delete                 := update delete $deletetargets
    
    return
        <deleted prefix="{$projectPrefix}" artefactType="{$objecttype}" daystokeep="{$numberOfDaysToKeep}" maxdate="{$maxdatetokeep}"
                numberofhistoryitems="{$totalhistorycnt}" numberoftypeitems="{$totaltypecnt}" numberofitemstodelete="{$totaldatecnt}" numberofitemsleft="{$totalhistorycnt - $totaldatecnt}"/>
};

(: We did not used to write these extra attributes, but that doesn't perform when doing ListHistory. Add these attributes to speed that up.
    Return true() is update done or $statusonly and update necessary. Return false() if $stastusonly and no update necessary 
:)
declare function hist:ConvertHistory($statusonly as xs:boolean) as xs:boolean {
    if ($statusonly) then empty(collection($get:strDecorHistory)/histories[empty(@artefactType)]) else (
        let $update         :=
            for $histories in collection($get:strDecorHistory)/histories
            return (
                if ($histories[@artefactType]       ) then () else update insert attribute artefactType {$histories/@type} into $histories,
                if ($histories[@projectPrefix]      ) then () else update insert attribute projectPrefix {$histories/@project} into $histories,
                if ($histories[@type]               ) then update delete $histories/@type else (),
                if ($histories[@project]            ) then update delete $histories/@project else ()
            )
        let $update         :=
            for $history in collection($get:strDecorHistory)/histories/history[empty(@artefactId)]
            let $artefactId                 := $history/*/@id
            let $artefactEffectiveDate      := $history/*/@effectiveDate
            let $artefactStatusCode         := $history/*/@statusCode
            return (
                if ($history[@artefactId]           ) then () else update insert attribute artefactId {$artefactId} into $history,
                if ($history[@artefactEffectiveDate]) then () else update insert attribute artefactEffectiveDate {$artefactEffectiveDate} into $history,
                if ($history[@artefactStatusCode]   ) then () else update insert attribute artefactStatusCode {$artefactStatusCode} into $history
            )
            
        return
            true()
    )
};

declare %private function hist:getHistoryArtefactType($objecttype as xs:string?) as xs:string {
    switch ($objecttype)
    case $decor:OBJECTTYPE-DATASET                  return $decor:OBJECTTYPE-DATASET
    case $decor:OBJECTTYPE-DATASETCONCEPT           return $decor:OBJECTTYPE-DATASETCONCEPT
    case $decor:OBJECTTYPE-TEMPLATE                 return $decor:OBJECTTYPE-TEMPLATE
    case $decor:OBJECTTYPE-VALUESET                 return $decor:OBJECTTYPE-VALUESET
    case $decor:OBJECTTYPE-CODESYSTEM               return $decor:OBJECTTYPE-CODESYSTEM
    case $decor:OBJECTTYPE-MAPPING                  return $decor:OBJECTTYPE-MAPPING
    case $decor:OBJECTTYPE-SCENARIO                 return $decor:OBJECTTYPE-SCENARIO
    case $decor:OBJECTTYPE-TRANSACTION              return $decor:OBJECTTYPE-TRANSACTION
    case $decor:OBJECTTYPE-IMPLEMENTATIONGUIDE      return $decor:OBJECTTYPE-IMPLEMENTATIONGUIDE
    case 'DECOR'                            return 'DECOR'
    default return 'UNK'
};