xquery version "3.1";
(:
    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.
:)
(:
:   Library of DECOR administrative types functions. Most if not all functions are available in two flavors.
:   One based on project prefix and the other based on some element inside the project usually the decor
:   root element. It is the expectation that these function are sometimes called somewhere in the middle of 
:   other logic. Therefor you may be at any point in the decor project at the stage where to you need to call
:   a function in this library.
:   The $decor parameter is always used as $decor/ancestor-or-self::decor[project] to make sure we have the 
:   correct starting point.
:   Note: unlike Java, XQuery doesn't distinguish functions by the same based on signature of the parameters
:         so all functions that take $decor are postfixed with a P in the function name. :)
module namespace decor          = "http://art-decor.org/ns/decor";
import module namespace aduser  = "http://art-decor.org/ns/art-decor-users" at "api-user-settings.xqm";
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";

declare namespace error         = "http://art-decor.org/ns/decor/error";
declare namespace sm            = "http://exist-db.org/xquery/securitymanager";
declare namespace xs            = "http://www.w3.org/2001/XMLSchema";

(:~ Legend:
:   Any guest/user always has read access
:
:   @email/         Not supported: handled by api-user-settings for now.
:   @notifier
:
:   @id             User id is an integer that increments with 1 for every user. The id is project unique and does not (necessarily) match across projects
:                           Used e.g. to bind issue authors/assignments to project authors
:
:   @username       Username that corresponds with his exist-db username
:
:   @effectiveDate  Date/time the author was added to the project. This date is independent from being added as a db user
:
:   @expirationDate Date/time the author was been deactivated in the project. This date is independent from being deactivated or removed as a db user
:
:   @active         User is active if there is a project/author[@username=$username][not(@active = 'false')]. Note that they might be deactivated at exist-db level
:                           Maps to: (author[@username=$username][empty(@active)] and $username=sm:get-group-members('decor'))
:
:   @datasets       User has write access to datasets (and terminologyAssociations) if there is a project/author[@username=$username][not(@active = 'false')][not(@datasets = 'false')]
:                           Maps to: (author[@username=$username][empty(@active)] and $username=sm:get-group-members('decor'))
:
:   @scenarios      User has write access to scenarios (and terminologyAssociations) if there is a project/author[@username=$username][not(@active = 'false')][not(@scenarios = 'false')]
:                           Maps to: (author[@username=$username][empty(@active)] and $username=sm:get-group-members('decor'))
:
:   @terminology    User has write access to terminologyAssociations/valueSets/codeSystems if there is a project/author[@username=$username][not(@active = 'false')][not(@terminology = 'false')]
:                           Maps to: (author[@username=$username][empty(@active)] and $username=sm:get-group-members('decor'))
:
:   @rules          User has write access to templateAssociations/templates if there is a project/author[@username=$username][not(@active = 'false')][not(@rules = 'false')]
:                           Maps to: (author[@username=$username][empty(@active)] and $username=sm:get-group-members('decor'))
:
:   @ids            User has write access to ids/id, but not to ids/(baseId|defaultBaseId) if there is a project/author[@username=$username][not(@active = 'false')][not(@ids = 'false')]
:                           Maps to: (author[@username=$username][empty(@active)] and $username=sm:get-group-members('decor'))
:
:   @issues         User has write access to issues if there is a project/author[@username=$username][not(@active = 'false')][not(@issues = 'false')]
:                           Maps to: (author[@username=$username][empty(@active)] and $username=sm:get-group-members('decor') and $username=sm:get-group-members('issues'))
:
:   @admin          User is admin if there is a project/author[@username=$username][not(@active = 'false')][not(@admin = 'false')]
:                   Admin users may edit project properties such as: decor/(@*), project, ids/(baseId|defaultBaseId), issues/@notifier
:                           Maps to: (author[@username=$username][empty(@active)] and $username=sm:get-group-members('decor') and $username=sm:get-group-members('decor-admin')) 
:)
declare variable $decor:AUTHOR-TEMPLATE as element(author)  := 
    <author id="" username="" notifier="off" active="true" datasets="false" scenarios="false" terminology="false" rules="false" ids="false" issues="false" admin="false" effectiveDate="{substring(string(current-dateTime()), 1, 19)}" expirationDate=""/>;

(:~ These statics are needed for function decor:authorCanEditP($decor,$username,$sections). 
:   If you change something here, you need to update the function too. :)
declare variable $decor:SECTION-PROJECT                     := 'project';
declare variable $decor:SECTION-DATASETS                    := 'datasets';
declare variable $decor:SECTION-IDS                         := 'ids';
declare variable $decor:SECTION-ISSUES                      := 'issues';
declare variable $decor:SECTION-RULES                       := 'rules';
declare variable $decor:SECTION-SCENARIOS                   := 'scenarios';
declare variable $decor:SECTION-TERMINOLOGY                 := 'terminology';
declare variable $decor:SECTIONS-ALL as xs:string+          := ($decor:SECTION-PROJECT,
                                                                $decor:SECTION-DATASETS,
                                                                $decor:SECTION-IDS,
                                                                $decor:SECTION-ISSUES,
                                                                $decor:SECTION-RULES,
                                                                $decor:SECTION-SCENARIOS,
                                                                $decor:SECTION-TERMINOLOGY);

declare variable $decor:OBJECTTYPE-DATASET                  := 'DS';
declare variable $decor:OBJECTTYPE-DATASETCONCEPT           := 'DE';
declare variable $decor:OBJECTTYPE-DATASETCONCEPTLIST       := 'CL';
declare variable $decor:OBJECTTYPE-SCENARIO                 := 'SC';
declare variable $decor:OBJECTTYPE-TRANSACTION              := 'TR';
declare variable $decor:OBJECTTYPE-ACTOR                    := 'AC';
declare variable $decor:OBJECTTYPE-VALUESET                 := 'VS';
declare variable $decor:OBJECTTYPE-ISSUE                    := 'IS';
(:declare variable $decor:OBJECTTYPE-RULE                     := 'RL';:)
declare variable $decor:OBJECTTYPE-TEMPLATE                 := 'TM';
declare variable $decor:OBJECTTYPE-TEMPLATEELEMENT          := 'EL';
(:declare variable $decor:OBJECTTYPE-TESTSCENARIO             := 'SX';
declare variable $decor:OBJECTTYPE-TESTTRANSACTION          := 'TX';
declare variable $decor:OBJECTTYPE-EXAMPLETRANSACTION       := 'EX';
declare variable $decor:OBJECTTYPE-TESTREQUIREMENT          := 'EX';:)
declare variable $decor:OBJECTTYPE-COMMUNITY                := 'CM';
declare variable $decor:OBJECTTYPE-CODESYSTEM               := 'CS';
declare variable $decor:OBJECTTYPE-MAPPING                  := 'MP';
declare variable $decor:OBJECTTYPE-QUESTIONNAIRE            := 'QQ';
declare variable $decor:OBJECTTYPE-QUESTIONNAIRERESPONSE    := 'QR';
declare variable $decor:OBJECTTYPE-IMPLEMENTATIONGUIDE      := 'IG';
declare variable $decor:OBJECTTYPES-ALL as xs:string*       := ($decor:OBJECTTYPE-DATASET ,
                                                                $decor:OBJECTTYPE-DATASETCONCEPT ,
                                                                (:$decor:OBJECTTYPE-DATASETCONCEPTLIST ,:)
                                                                $decor:OBJECTTYPE-SCENARIO ,
                                                                $decor:OBJECTTYPE-TRANSACTION ,
                                                                $decor:OBJECTTYPE-ACTOR ,
                                                                $decor:OBJECTTYPE-VALUESET ,
                                                                $decor:OBJECTTYPE-ISSUE ,
                                                                (:$decor:OBJECTTYPE-RULE ,:)
                                                                $decor:OBJECTTYPE-TEMPLATE ,
                                                                (:$decor:OBJECTTYPE-TEMPLATEELEMENT ,
                                                                $decor:OBJECTTYPE-TESTSCENARIO ,
                                                                $decor:OBJECTTYPE-TESTTRANSACTION ,
                                                                $decor:OBJECTTYPE-EXAMPLETRANSACTION ,
                                                                $decor:OBJECTTYPE-TESTREQUIREMENT ,:)
                                                                $decor:OBJECTTYPE-COMMUNITY ,
                                                                $decor:OBJECTTYPE-CODESYSTEM,
                                                                $decor:OBJECTTYPE-MAPPING,
                                                                $decor:OBJECTTYPE-QUESTIONNAIRE,
                                                                $decor:OBJECTTYPE-QUESTIONNAIRERESPONSE,
                                                                $decor:OBJECTTYPE-IMPLEMENTATIONGUIDE);

declare variable $decor:SECTION_TYPE_MAPPING                :=
    <maps>
        <map type="{$decor:OBJECTTYPE-DATASET}" section="{$decor:SECTION-DATASETS}"/>
        <map type="{$decor:OBJECTTYPE-DATASETCONCEPT}" section="{$decor:SECTION-DATASETS}"/>
        <!--<map type="{$decor:OBJECTTYPE-DATASETCONCEPTLIST}" section="{$decor:SECTION-DATASETS}"/>-->
        <map type="{$decor:OBJECTTYPE-SCENARIO}" section="{$decor:SECTION-SCENARIOS}"/>
        <map type="{$decor:OBJECTTYPE-TRANSACTION}" section="{$decor:SECTION-SCENARIOS}"/>
        <map type="{$decor:OBJECTTYPE-ACTOR}" section="{$decor:SECTION-SCENARIOS}"/>
        <map type="{$decor:OBJECTTYPE-VALUESET}" section="{$decor:SECTION-TERMINOLOGY}"/>
        <map type="{$decor:OBJECTTYPE-ISSUE}" section="{$decor:SECTION-ISSUES}"/>
        <!--<map type="{$decor:OBJECTTYPE-RULE}" section="{$decor:SECTION-RULES}"/>-->
        <map type="{$decor:OBJECTTYPE-TEMPLATE}" section="{$decor:SECTION-RULES}"/>
        <!--<map type="{$decor:OBJECTTYPE-TEMPLATEELEMENT}" section="{$decor:SECTION-RULES}"/>-->
        <!--<map type="{$decor:OBJECTTYPE-TESTSCENARIO}" section=""/>-->
        <!--<map type="{$decor:OBJECTTYPE-TESTTRANSACTION}" section=""/>-->
        <!--<map type="{$decor:OBJECTTYPE-EXAMPLETRANSACTION}" section=""/>-->
        <!--<map type="{$decor:OBJECTTYPE-TESTREQUIREMENT}" section=""/>-->
        <map type="{$decor:OBJECTTYPE-COMMUNITY}" section=""/>
        <map type="{$decor:OBJECTTYPE-CODESYSTEM}" section="{$decor:SECTION-TERMINOLOGY}"/>
        <map type="{$decor:OBJECTTYPE-MAPPING}" section="{$decor:SECTION-TERMINOLOGY}"/>
        <map type="{$decor:OBJECTTYPE-QUESTIONNAIRE}" section="{$decor:SECTION-SCENARIOS}"/>
        <map type="{$decor:OBJECTTYPE-QUESTIONNAIRERESPONSE}" section="{$decor:SECTION-SCENARIOS}"/>
        <map type="{$decor:OBJECTTYPE-IMPLEMENTATIONGUIDE}" section="{$decor:SECTION-SCENARIOS}"/>
    </maps>;

(: ======== GENERAL/READ FUNCTIONS ======== :)

(:~ Return full project contents based on $prefix or error(). If no project is found this is not an error, just a fact. :)
declare function decor:getDecorProject($prefix as xs:string) as element(decor)? {
    let $decor      := $get:colDecorData/decor[project/@prefix = $prefix]
    
    return
    switch (count($decor))
    case 0 (: fall through :)
    case 1 return $decor
    default return error(xs:QName('error:MultipleHits'),'Project with prefix ''' || $prefix || ''' has multiple hits (' || count($decor) || '). Contact your server administrator as this should not be possible.')     
};

(:~ Return full project contents based on get:strCurrentUserName() or error() :)
declare function decor:getDecorProjectsForCurrentUser() as element(decor)* {
    for $decor in $get:colDecorData/decor
    return
        if (decor:isActiveAuthorP($decor)) then $decor else ()
};

(:~ Returns boolean true|false whether or not the given project exists :)
declare function decor:isProject($prefix as xs:string) as xs:boolean {
    exists($get:colDecorData/decor[project/@prefix = $prefix])
};

(:~ Returns boolean true|false whether or not the given project is a repository/BBR :)
declare function decor:isRepository($prefix as xs:string) as xs:boolean {
    decor:isRepositoryP(decor:getDecorProject($prefix))
};

(:~ Returns boolean true|false whether or not the given project is a private project :)
declare function decor:isRepositoryP($decor as element()) as xs:boolean {
    $decor/ancestor-or-self::decor/@repository = 'true'
};

(:~ Returns boolean true|false whether or not the given project is a private project :)
declare function decor:isPrivate($prefix as xs:string) as xs:boolean {
    decor:isPrivateP(decor:getDecorProject($prefix))
};

(:~ Returns boolean true|false whether or not the given project is a private project :)
declare function decor:isPrivateP($decor as element()) as xs:boolean {
    $decor/ancestor-or-self::decor/@private ='true'
};

(:~ Returns boolean true|false whether or not the given project is an experimental project :)
declare function decor:isExperimental($prefix as xs:string) as xs:boolean {
    decor:isExperimentalP(decor:getDecorProject($prefix))
};

(:~ Returns boolean true|false whether or not the given project is an experimental project :)
declare function decor:isExperimentalP($decor as element()) as xs:boolean {
    $decor/ancestor-or-self::decor/project/@experimental = 'true'
};

(:~ Returns all authors from a project. Note that this does not take the exist-db level into account :)
declare function decor:getAuthors($prefix as xs:string) as xs:string* {
    decor:getAuthorsP(decor:getDecorProject($prefix))
};

(:~ Returns all authors from a project. Note that this does not take the exist-db level into account :)
declare function decor:getAuthorsP($decor as element()) as xs:string* {
    $decor/ancestor-or-self::decor/project/author/@username
};

(:~ Returns all active authors from a project. Note that this does not take the exist-db level into account :)
declare function decor:getActiveAuthors($prefix as xs:string) as xs:string* {
    decor:getActiveAuthorsP(decor:getDecorProject($prefix))
};

(:~ Returns all active authors from a project. Note that this does not take the exist-db level into account :)
declare function decor:getActiveAuthorsP($decor as element()) as xs:string* {
    $decor/ancestor-or-self::decor/project/author[not(@active = 'false')]/@username
};

(:~ Returns all inactive authors from a project. Note that this does not take the exist-db level into account :)
declare function decor:getInactiveAuthors($prefix as xs:string) as xs:string* {
    decor:getInactiveAuthorsP(decor:getDecorProject($prefix))
};

(:~ Returns all inactive authors from a project. Note that this does not take the exist-db level into account :)
declare function decor:getInactiveAuthorsP($decor as element()) as xs:string* {
    $decor/ancestor-or-self::decor/project/author[@active='false']/@username
};

(:~ Returns boolean true|false whether or not the current user is active+admin in the given project. Note that they might be deactivated at exist-db level :)
declare function decor:isProjectAdmin($prefix as xs:string) as xs:boolean {
    decor:isProjectAdminP(decor:getDecorProject($prefix),get:strCurrentUserName())
};

(:~ Returns boolean true|false whether or not the given user is active+admin in the given project. Note that they might be deactivated at exist-db level :)
declare function decor:isProjectAdmin($prefix as xs:string, $username as xs:string) as xs:boolean {
    decor:isProjectAdminP(decor:getDecorProject($prefix),$username)
};

(:~ Returns boolean true|false whether or not the current user is active+admin in the given project. Note that they might be deactivated at exist-db level :)
declare function decor:isProjectAdminP($decor as element()) as xs:boolean {
    decor:isProjectAdminP($decor,get:strCurrentUserName())
};

(:~ Returns boolean true|false whether or not the given user is active+admin in the given project. Note that they might be deactivated at exist-db level :)
declare function decor:isProjectAdminP($decor as element(), $username as xs:string) as xs:boolean {
    let $author   := $decor/ancestor-or-self::decor/project/author[@username=$username][not(@active = 'false')]
    return
        exists($author[@admin='true'] | $author['decor-admin' = sm:get-user-groups($username)])
};

(:~ Returns boolean true|false whether or not the current user is author in the given project. Note that they might be inactive and/or deactivated at exist-db level :)
declare function decor:isAuthor($prefix as xs:string) as xs:boolean {
    decor:isAuthorP(decor:getDecorProject($prefix), get:strCurrentUserName())
};

(:~ Returns boolean true|false whether or not the given user is author in the given project. Note that they might be inactive and/or deactivated at exist-db level :)
declare function decor:isAuthor($prefix as xs:string, $username as xs:string) as xs:boolean {
    decor:isAuthorP(decor:getDecorProject($prefix),$username)
};

(:~ Returns boolean true|false whether or not the current user is author in the given project. Note that they might be inactive and/or deactivated at exist-db level :)
declare function decor:isAuthorP($decor as element()) as xs:boolean {
    decor:isAuthorP($decor, get:strCurrentUserName())
};

(:~ Returns boolean true|false whether or not the given author is active in the given project. Note that they might be inactive and/or deactivated at exist-db level :)
declare function decor:isAuthorP($decor as element(), $username as xs:string) as xs:boolean {
    decor:getAuthorsP($decor) = $username
};

(:~ Returns boolean true|false whether or not the current user is active in the given project. Note that they might be deactivated at exist-db level :)
declare function decor:isActiveAuthor($prefix as xs:string) as xs:boolean {
    decor:isActiveAuthorP(decor:getDecorProject($prefix), get:strCurrentUserName())
};

(:~ Returns boolean true|false whether or not the given user is active in the given project. Note that they might be deactivated at exist-db level :)
declare function decor:isActiveAuthor($prefix as xs:string, $username as xs:string) as xs:boolean {
    decor:isActiveAuthorP(decor:getDecorProject($prefix),$username)
};

(:~ Returns boolean true|false whether or not the current user is active in the given project. Note that they might be deactivated at exist-db level :)
declare function decor:isActiveAuthorP($decor as element()) as xs:boolean {
    decor:isActiveAuthorP($decor, get:strCurrentUserName())
};

(:~ Returns boolean true|false whether or not the given user is active in the given project. Note that they might be deactivated at exist-db level :)
declare function decor:isActiveAuthorP($decor as element(), $username as xs:string) as xs:boolean {
    decor:getActiveAuthorsP($decor) = $username
};

(:~ Returns boolean true|false whether or not the current user is active in the given project and can edit ALL of the indicated sections.
:   Note that they might be deactivated at exist-db level :)
declare function decor:authorCanEdit($prefix as xs:string, $sections as xs:string+) as xs:boolean {
    decor:authorCanEditP(decor:getDecorProject($prefix), get:strCurrentUserName(), $sections)
};

(:~ Returns boolean true|false whether or not the current user is active in the given project and can edit ALL of the indicated sections.
:   Note that they might be deactivated at exist-db level :)
declare function decor:authorCanEdit($prefix as xs:string, $username as xs:string, $sections as xs:string+) as xs:boolean {
    decor:authorCanEditP(decor:getDecorProject($prefix), $username, $sections)
};

(:~ Returns boolean true|false whether or not the current user is active in the given project and can edit ALL of the indicated sections.
:   Note that they might be deactivated at exist-db level :)
declare function decor:authorCanEditP($decor as element(), $sections as xs:string+) as xs:boolean {
    decor:authorCanEditP($decor, get:strCurrentUserName(), $sections)
};

(:~ Returns boolean true|false whether or not the current user is active in the given project and can edit ALL of the indicated sections.
:   Note that they might be deactivated at exist-db level :)
declare function decor:authorCanEditP($decor as element(), $username as xs:string, $sections as xs:string+) as xs:boolean {
    let $check          :=
        if ($sections[not(. = $decor:SECTIONS-ALL)]) then
            error(xs:QName('error:UnsupportedSection'), 'You have at least one unsupported section: ' || string-join($sections[not(.= $decor:SECTIONS-ALL)], ' '))
        else ()

    let $decor          := $decor/ancestor-or-self::decor[project]
    let $activeAuthor   := decor:getActiveAuthor($decor, $username)
    (:decor-admin may not need to be a group at some point when all author properties are stored in the decor files:)
    let $isDecorAdmin   := if ('decor-admin'=sm:list-groups()) then $username=sm:get-group-members('decor-admin') else true()
    (:editor and issues may not need to be a group at some point when all author properties are stored in the decor files:)
    let $isEditor       := if ('editor'=sm:list-groups()) then $username=sm:get-group-members('editor') else true()
    (:any editor may edit issues:)
    let $isIssueEditor  := if ($isEditor) then true() else if ('issues'=sm:list-groups()) then $username=sm:get-group-members('issues') else true()
    
    let $return :=
        if ($activeAuthor[@active]) then (
            for $section in $sections
            return
                switch ($section) 
                case $decor:SECTION-PROJECT      return exists($activeAuthor[not(@admin = 'false')])
                case $decor:SECTION-DATASETS     return exists($activeAuthor[not(@datasets = 'false')])
                case $decor:SECTION-IDS          return exists($activeAuthor[not(@ids = 'false')])
                case $decor:SECTION-ISSUES       return exists($activeAuthor[not(@issues = 'false')])
                case $decor:SECTION-RULES        return exists($activeAuthor[not(@rules = 'false')])
                case $decor:SECTION-SCENARIOS    return exists($activeAuthor[not(@scenarios = 'false')])
                case $decor:SECTION-TERMINOLOGY  return exists($activeAuthor[not(@terminology = 'false')])
                (:default would mean some section we don't support, but that would be impossible at this point:)
                default                          return false()
        )
        else
        if ($activeAuthor) then (
            for $section in $sections
            return
                switch ($section) 
                case $decor:SECTION-PROJECT      return $isDecorAdmin and $isEditor
                case $decor:SECTION-DATASETS     return $isEditor
                case $decor:SECTION-IDS          return $isEditor
                case $decor:SECTION-ISSUES       return $isIssueEditor
                case $decor:SECTION-RULES        return $isEditor
                case $decor:SECTION-SCENARIOS    return $isEditor
                case $decor:SECTION-TERMINOLOGY  return $isEditor
                (:default would mean some section we don't support, but that would be impossible at this point:)
                default                          return false()
        )
        else (
            false()
        )
    
    return not($return = false())
};

(:~ Return xs:dateTime(@date) of last release or version in the project or null if none exists :)
declare function decor:getLastRevisionDate($prefix as xs:string) as xs:dateTime? {
    decor:getLastRevisionDateP(decor:getDecorProject($prefix))
};

(:~ Return xs:dateTime(@date) of last release or version in the project or null if none exists :)
declare function decor:getLastRevisionDateP($decor as element()) as xs:dateTime? {
    max($decor/ancestor-or-self::decor/project/(version|release)/xs:dateTime(@date))
};

(:~ Return xs:dateTime(@date) of last release in the project or null if none exists :)
declare function decor:getLastReleaseDate($prefix as xs:string) as xs:dateTime? {
    decor:getLastReleaseDateP(decor:getDecorProject($prefix))
};

(:~ Return xs:dateTime(@date) of last release in the project or null if none exists :)
declare function decor:getLastReleaseDateP($decor as element()) as xs:dateTime? {
    max($decor/ancestor-or-self::decor/project/release/xs:dateTime(@date))
};

(:~ Return xs:dateTime(@date) of last version in the project or null if none exists :)
declare function decor:getLastVersionDate($prefix as xs:string) as xs:dateTime? {
    decor:getLastVersionDateP(decor:getDecorProject($prefix))
};

(:~ Return xs:dateTime(@date) of last version in the project or null if none exists :)
declare function decor:getLastVersionDateP($decor as element()) as xs:dateTime? {
    max($decor/ancestor-or-self::decor/project/version/xs:dateTime(@date))
};

(:~ Return base ids in the project or null if none exists. Each baseId carries attribute @default=true|false to 
:   indicate if it is also a defaultBaseId or not.
:   Using parameter $types you may optionally filter on certain types only. See DECOR format for valid values.
:
:   <baseId id="1.2.3" type="DS" prefix="xyz" default="true"/> :)
declare function decor:getBaseIds($prefix as xs:string, $types as xs:string*) as element(baseId)* {
    decor:getBaseIdsP(decor:getDecorProject($prefix),$types)
};

(:~ Return base ids in the project or null if none exists. Each baseId carries attribute @default=true|false to 
:   indicate if it is also a defaultBaseId or not.
:   Using parameter $types you may optionally filter on certain types only. See DECOR format for valid values.
:
:   <baseId id="1.2.3" type="DS" prefix="xyz" default="true"/> :)
declare function decor:getBaseIdsP($decor as element(), $types as xs:string*) as element(baseId)* {
    let $baseIds        := 
        if (empty($types)) then
            $decor/ancestor-or-self::decor/ids/baseId
        else (
            $decor/ancestor-or-self::decor/ids/baseId[@type=$types]
        )
    
    let $defaultBaseIds := 
        if (empty($types)) then
            $decor/ancestor-or-self::decor/ids/defaultBaseId
        else (
            $decor/ancestor-or-self::decor/ids/defaultBaseId[@type=$types]
        )
    
    return 
        if ($baseIds[@default='true']) then (
            (:assume new style:)
            $baseIds
        ) else (
            (:assume old style:)
            for $baseId in $baseIds
            return
                <baseId>
                {
                    $baseId/@id,
                    $baseId/@type,
                    attribute {'default'} {$baseId/@id=$defaultBaseIds/@id},
                    $baseId/@prefix
                }
                </baseId>
        )
};

(:~ Return default base ids in the project or null if none exists. Each carries attribute @prefix=text as readable form.
:   Using parameter $types you may optionally filter on certain types only. See DECOR format for valid values.
:
:   <defaultBaseId id="1.2.3" type="DS" prefix="xyz"/> :)
declare function decor:getDefaultBaseIds($prefix as xs:string, $types as xs:string*) as element(defaultBaseId)* {
    decor:getDefaultBaseIdsP(decor:getDecorProject($prefix),$types)
};

(:~ Return default base ids in the project or null if none exists. Each carries attribute @prefix=text as readable form.
:   Using parameter $types you may optionally filter on certain types only. See DECOR format for valid values.
:
:   <defaultBaseId id="1.2.3" type="DS" prefix="xyz"/> :)
declare function decor:getDefaultBaseIdsP($decor as element(), $types as xs:string*) as element(defaultBaseId)* {
    let $baseIds        := 
        if (empty($types)) then
            $decor/ancestor-or-self::decor/ids/baseId
        else (
            $decor/ancestor-or-self::decor/ids/baseId[@type=$types]
        )
    
    let $defaultBaseIds := 
        if (empty($types)) then
            $decor/ancestor-or-self::decor/ids/defaultBaseId
        else (
            $decor/ancestor-or-self::decor/ids/defaultBaseId[@type=$types]
        )
    
    return 
        if ($baseIds[@default='true']) then (
            (:assume new style:)
            for $defaultBaseId in $baseIds[@default='true']
            return
                <defaultBaseId>
                {
                    $defaultBaseId/@id,
                    $defaultBaseId/@type,
                    $defaultBaseId/@prefix
                }
                </defaultBaseId>
        ) else (
            (:assume old style:)
            for $defaultBaseId in $defaultBaseIds
            return
                <defaultBaseId>
                {
                    $defaultBaseId/@id,
                    $defaultBaseId/@type,
                    $defaultBaseId/@prefix,
                    if ($defaultBaseId[@prefix]) then () else (
                        $baseIds[@id=$defaultBaseId/@id]/@prefix
                    )
                }
                </defaultBaseId>
        )
};

(:~ Return next available id(s) for a given baseId (OID) or for one or more types in a given project. If baseId has a value then
:   $projectPrefix/$types are not considered.
:   Using parameter $types you may optionally filter on certain types only. See DECOR format for valid values.
:
:   <next base="1.2" max="2" next="{$max + 1}" id="1.2.3" type="DS"/>    (only when $projectPrefix/$types is supplied)
:   <next base="1.2" max="2" next="{$max + 1}" id="1.2.3"/>              (only when $baseId is supplied) :)
declare function decor:getNextAvailableId($projectPrefix as xs:string?, $types as xs:string*, $baseId as item()?) as element(next)* {
    if (empty($projectPrefix)) then
        decor:getNextAvailableIdP((), $types, $baseId)
    else (
        decor:getNextAvailableIdP(decor:getDecorProject($projectPrefix), $types, $baseId)
    )
};
declare function decor:getNextAvailableIdP($decor as element()?, $types as xs:string*, $baseId as item()?) as element(next)* {
    let $baseIds    := 
        if (empty($baseId)) then 
            if ($decor) then decor:getDefaultBaseIdsP($decor, $types) else () 
        else (
            $baseId
        )
    
    for $base in $baseIds
    let $baseId     := if ($base instance of element()) then $base/@id else $base
    let $searchId   := concat($baseId, '.')
    let $all        := ($get:colDecorData//@id | collection($get:strDecorDataIG)/implementationGuide/@id)[starts-with(., $searchId)][substring-after(., $searchId) castable as xs:integer] 
    let $max        := if ($all) then max($all/xs:integer(tokenize(., '\.')[last()])) else 0
    return
        <next base="{$baseId}" max="{$max}" next="{$max + 1}" id="{concat($baseId, '.', $max + 1)}">
        {
            if ($base instance of element()) then $base/@type else (),
            if ($all) then attribute current {string-join(($baseId, $max), '.')} else ()
        }
        </next>
};

(:~ Return lock elements, which have varying element names, for a given object. Most objects have an effectiveDate but 
:   some do not, like issues and older transactions. Communities do not have an id|ref but are name based. 
:   Submit community/@name as param $ref for community locks.
:   Submit empty parameter and $forCurrentUser=true()|false() to get ALL lock for the current user or any user respectively :)
declare function decor:getLocks($ref as xs:string?, $effectiveDate as xs:string?, $projectId as xs:string?, $forCurrentUser as xs:boolean) as element()* {
    let $locks  := $get:docDecorLocks/*/*
    let $locks  := if (string-length($ref) gt 0)            then $locks[@ref = $ref]                      else ($locks)
    let $locks  := if (string-length($effectiveDate) gt 0)  then $locks[@effectiveDate = $effectiveDate]  else ($locks)
    let $locks  := if (string-length($projectId) gt 0)      then $locks[@projectId = $projectId]          else ($locks)
    let $locks  := if ($forCurrentUser)                     then $locks[@user = get:strCurrentUserName()] else ($locks)
    
    return $locks
};
declare function decor:getLocks($object as element()?, $forCurrentUser as xs:boolean) as element()* {
    let $ref            := if ($object/self::community) then $object/@name else ($object/@id)
    let $effectiveDate  := $object/@effectiveDate
    let $projectId      := if ($object/self::community) then $object/@projectId else ()
    
    return decor:getLocks($ref, $effectiveDate, $projectId, $forCurrentUser)
};

(:~ Return boolean true|false if a given object has any lock on it. Most objects have an effectiveDate but 
:   some do not, like issues and older transactions. Communities do not have an id|ref but are name based. 
:   Submit community/@name as param $ref for community locks :)
declare function decor:canLock($object as element()) as xs:boolean {
    let $ref            := if ($object/self::community) then $object/@name else ($object/@id)
    let $effectiveDate  := $object/@effectiveDate
    let $projectId      := if ($object/self::community) then $object/@projectId else ()
    let $objecthasLock  := decor:getLocks($ref, $effectiveDate, $projectId, false())
    let $userHasLock    := decor:getLocks($ref, $effectiveDate, $projectId, true())
    
    return
        if ($userHasLock) then (true()) else if ($objecthasLock) then (false()) else (
            if ($object/self::community) then (
                decor:authorCanEditCommunityP($object)
            ) else (
                let $decor      := $object/ancestor::decor
                let $section    := $object/ancestor::*[name()=$decor:SECTIONS-ALL][parent::decor]/name()
                
                return decor:authorCanEditP($decor, $section)
            )
        )
};

(:~ Return boolean true|false if a given object has any lock on it. Most objects have an effectiveDate but 
:   some do not, like issues and older transactions. Communities do not have an id|ref but are name based. 
:   Submit community/@name as param $ref for community locks :)
declare function decor:isLocked($ref as xs:string, $effectiveDate as xs:string?, $projectId as xs:string?) as xs:boolean {
    exists(decor:getLocks($ref, $effectiveDate, $projectId, false()))
};

(:~ Return boolean true|false if a given object has a lock on it that was set by the current logged in user. 
:   Most objects have an effectiveDate but  some do not, like issues and older transactions. Communities do not 
:   have an id|ref but are name based. Submit community/@name as param $ref for community locks :)
declare function decor:isLockedByUser($ref as xs:string, $effectiveDate as xs:string?, $projectId as xs:string?) as xs:boolean {
    exists(decor:getLocks($ref, $effectiveDate, $projectId, true()))
};

(:~ Return all communities for $projectId based on get:strCurrentUserName() or error() :)
declare function decor:getDecorCommunitiesForCurrentUser($projectId as xs:string) as element(community)* {
    decor:getDecorCommunity((), $projectId, (), true())
};

(:~ Return zero or more full community contents based on $name (optional) and $projectId. If $name 
:   is not valued then all communities for the given project are returned. If $forCurrentUser=true()
:   only those communities are returned that the current user has at least read access to :)
declare function decor:getDecorCommunity($name as xs:string*, $projectId as xs:string, $forCurrentUser as xs:boolean) as element(community)* {
    decor:getDecorCommunity($name, $projectId, (), $forCurrentUser)
};
(:~ Return zero or more full community contents based on $name (optional) and $projectId. If $name 
:   is not valued then all communities for the given project are returned. If $forCurrentUser=true()
:   only those communities are returned that the current user has at least read access to :)
declare function decor:getDecorCommunity($name as xs:string*, $projectId as xs:string, $projectVersion as xs:string?, $forCurrentUser as xs:boolean) as element(community)* {
    let $communities    := 
        if (empty($projectVersion)) then $get:colDecorData//community[@projectId = $projectId] else (
            let $release    := art:getDecorById($projectId, $projectVersion)
            
            return
                if ($release) then collection(util:collection-name($release[1]))//community[@projectId = $projectId] else ()
        )
    let $communities    := if (string-length($name) gt 0) then $communities[@name = $name] else ($communities)
    let $username       := get:strCurrentUserName()
    
    for $community in $communities
    return
        if ($forCurrentUser) then
            if (decor:authorCanReadCommunityP($community, $username)) then 
                $community
            else ()
        else (
            $community
        )
};

(:~ Returns all authors from a community. Note that this does not take the exist-db level into account :)
declare function decor:getCommunityAuthors($name as xs:string, $projectId as xs:string) as xs:string* {
    decor:getCommunityAuthorsP(decor:getDecorCommunity($name, $projectId, false()))
};

(:~ Returns all authors from a community. Note that this does not take the exist-db level into account :)
declare function decor:getCommunityAuthorsP($community as element()) as xs:string* {
    $community/ancestor-or-self::community/access/author/@username
};

(:~ Returns all active authors from a project. Note that this does not take the exist-db level into account :)
declare function decor:getActiveCommunityAuthors($name as xs:string, $projectId as xs:string) as xs:string* {
    decor:getActiveCommunityAuthorsP(decor:getDecorCommunity($name, $projectId, false()))
};

(:~ Returns all active authors from a project. Note that this does not take the exist-db level into account :)
declare function decor:getActiveCommunityAuthorsP($community as element()) as xs:string* {
    $community/ancestor-or-self::community/access/author[not(@active = 'false')][contains(@rights,'w')]/@username | 
    $community/ancestor-or-self::community/access/author[empty(@active)][contains(@rights,'w')]/@username
};

(:~ Returns all inactive authors from a project. Note that this does not take the exist-db level into account :)
declare function decor:getInactiveCommunityAuthors($name as xs:string, $projectId as xs:string) as xs:string* {
    decor:getInactiveCommunityAuthorsP(decor:getDecorCommunity($name, $projectId, false()))
};

(:~ Returns all inactive authors from a project. Note that this does not take the exist-db level into account :)
declare function decor:getInactiveCommunityAuthorsP($community as element()) as xs:string* {
    $community/ancestor-or-self::community/access/author[@active='false']/@username
};

(:~ Returns boolean true|false whether or not the current user is active in the given community and has write permissions
:   Note that they might be deactivated at exist-db level :)
declare function decor:authorCanEditCommunity($name as xs:string, $projectId as xs:string) as xs:boolean {
    decor:authorCanEditCommunityP(decor:getDecorCommunity($name, $projectId, false()))
};

(:~ Returns boolean true|false whether or not the current user is active in the given community and has write permissions
:   Note that they might be deactivated at exist-db level :)
declare function decor:authorCanEditCommunityP($community as element()) as xs:boolean {
    exists(decor:getCommunityAuthor($community/ancestor-or-self::community, get:strCurrentUserName())[matches(@rights,'w')])
};

(:~ Returns boolean true|false whether or not the current user is active in the given community and has read permissions
:   Note that they might be deactivated at exist-db level :)
declare function decor:authorCanReadCommunity($name as xs:string, $projectId as xs:string) as xs:boolean {
    exists(decor:getDecorCommunity($name, $projectId, true()))
};

(:~ Returns boolean true|false whether or not the current user or guest user (not logged in) is active in the given community 
:   and has read or write permissions. (write only does not exist)
:   Note that they might be deactivated at exist-db level :)
declare function decor:authorCanReadCommunityP($community as element(), $username as xs:string) as xs:boolean {
    let $eligibleUsers  := (decor:getActiveCommunityAuthor($community/ancestor-or-self::community, $username) |
                            decor:getActiveCommunityAuthor($community/ancestor-or-self::community, 'guest'))

    return exists($eligibleUsers[contains(@rights,'r')] | $eligibleUsers[contains(@rights,'w')])
};

(:~ Return full author element to caller. Caller needs to do write access checking if necessary.
:   Should multiple authors by that username exist, then this is a problem of the project, not this function :)
declare %private function decor:getAuthor($decor as element(decor)?, $username as xs:string) as element(author)? {
    $decor/project/author[@username=$username]
};

(:~ Return full author element to caller. Caller needs to do write access checking if necessary.
:   Should multiple authors by that username exist, then this is a problem of the project, not this function :)
declare %private function decor:getActiveAuthor($decor as element(decor)?, $username as xs:string) as element(author)? {
    decor:getAuthor($decor, $username)[not(@active = 'false')]
};

(:~ Return full author element to caller. Caller needs to do write access checking if necessary.
:   Should multiple authors by that username exist, then this is a problem of the community, not this function :)
declare %private function decor:getCommunityAuthor($community as element(community)?, $username as xs:string) as element(author)? {
    $community/access/author[@username=$username]
};

(:~ Return full author element to caller. Caller needs to do write access checking if necessary.
:   Should multiple authors by that username exist, then this is a problem of the community, not this function :)
declare %private function decor:getActiveCommunityAuthor($community as element(community)?, $username as xs:string) as element(author)? {
    $community/access/author[not(@active = 'false')][@username=$username]
};

(: ======== ADMIN/WRITE FUNCTIONS ======== :)

(:~ Set/update value of decor/@repository if $isRepository=true. Delete decor/@repository if $isRepository=false :)
declare function decor:setIsRepository($prefix as xs:string, $isRepository as xs:boolean) {
    decor:setIsRepositoryP(decor:getDecorProject($prefix),$isRepository)
};

(:~ Set/update value of decor/@repository if $isRepository=true. Delete decor/@repository if $isRepository=false :)
declare function decor:setIsRepositoryP($decor as element(), $isRepository as xs:boolean) {
    let $check      := decor:checkAdminPermissionsP($decor)
    
    let $decor      := $decor/ancestor-or-self::decor[project]
    
    return
        if ($decor) then
            if ($isRepository) then (
                if ($decor/@repository) then (
                    update value $decor/@repository with $isRepository
                )
                else (
                    update insert attribute repository {$isRepository} into $decor
                )
            )
            else (
                (:default value is false() so delete the attribute if exists:)
                update delete $decor/@repository
            )
        else (
            error(xs:QName('error:ProjectNotFound'),'Project with this prefix does not exist.')
        )
};

(:~ Set/update value of decor/@private if $isPrivate=true. Delete decor/@private if $isPrivate=false :)
declare function decor:setIsPrivate($prefix as xs:string, $isPrivate as xs:boolean) {
    decor:setIsPrivateP(decor:getDecorProject($prefix),$isPrivate)
};

(:~ Set/update value of decor/@private if $isPrivate=true. Delete decor/@private if $isPrivate=false :)
declare function decor:setIsPrivateP($decor as element(), $isPrivate as xs:boolean) {
    let $check      := decor:checkAdminPermissionsP($decor)
    
    let $decor      := $decor/ancestor-or-self::decor[project]
    
    return
        if ($decor) then
            if ($isPrivate) then (
                if ($decor/@private) then (
                    update value $decor/@private with $isPrivate
                )
                else (
                    update insert attribute private {$isPrivate} into $decor
                )
            )
            else (
                (:default value is false() so delete the attribute if exists:)
                update delete $decor/@private
            )
        else (
            error(xs:QName('error:ProjectNotFound'),'Project with this prefix does not exist.')
        )
};

(:~ Set/update value of decor/project/@experimental if $isExperimental=true. Delete decor/project/@experimental if $isExperimental=false :)
declare function decor:setIsExperimental($prefix as xs:string, $isExperimental as xs:boolean) {
    decor:setIsExperimentalP(decor:getDecorProject($prefix),$isExperimental)
};

(:~ Set/update value of decor/project/@experimental if $isExperimental=true. Delete decor/project/@experimental if $isExperimental=false :)
declare function decor:setIsExperimentalP($decor as element(), $isExperimental as xs:boolean) {
    let $check          := decor:checkAdminPermissionsP($decor)
    
    let $decorProject   := $decor/ancestor-or-self::decor/project
    
    return
        if ($decorProject) then
            if ($isExperimental=true()) then (
                if ($decor/@experimental) then (
                    update value $decorProject/@experimental with $isExperimental
                )
                else (
                    update insert attribute experimental {$isExperimental} into $decorProject
                )
            )
            else (
                (:default value is false() so delete the attribute if exists:)
                update delete $decorProject/@experimental
            )
        else (
            error(xs:QName('error:ProjectNotFound'),'Project with this prefix does not exist.')
        )
};

(:~ Updates a user in a project with given username and the first available increment as id. Adds the user if necessary when $addIfNecessary=true
:   Upon adding the user, all permissions are defaulted from $decor:AUTHOR-TEMPLATE. In updating the user settings only those $setting attributes 
:   are considered that match an attribute in $decor:AUTHOR-TEMPLATE.
:   Returns the resulting <author.../> element or error :)
declare function decor:setProjectAuthor($prefix as xs:string, $username as xs:string, $settings as element(author), $addIfNecessary as xs:boolean) as element(author) {
    decor:setProjectAuthorP(decor:getDecorProject($prefix),$username,$settings,$addIfNecessary)
};

(:~ Updates a user in a project with given username and the first available increment as id. Adds the user if necessary when $addIfNecessary=true
:   Upon adding the user, all permissions are defaulted from $decor:AUTHOR-TEMPLATE. In updating the user settings only those $setting attributes 
:   are considered that match an attribute in $decor:AUTHOR-TEMPLATE.
:   Returns the resulting <author.../> element or error :)
declare function decor:setProjectAuthorP($decor as element(), $username as xs:string, $settings as element(author), $addIfNecessary as xs:boolean) as element(author) {
    let $check      := decor:checkAdminPermissionsP($decor)
    
    let $decor      := $decor/ancestor-or-self::decor[project]
    let $prefix     := $decor/project/@prefix
    
    (: get update set. skip anything empty. skip anything we don't know (includes email and notifier) :)
    let $update-atts    :=
        for $att in $settings/(@active|@datasets|@scenarios|@terminology|@rules|@ids|@issues|@admin)[not(.='')]
        return
        if ($att castable as xs:boolean) then ($att) else (
            error(xs:QName('error:PermissionInvalid'),concat('Permission ',$att/name(),' must be a boolean value. Found ''',$att/string(),''''))
        )
    
    let $author         := 
        if ($addIfNecessary=true()) then
            (: add the user with default template, this takes care of @id/@username/full name :)
            decor:setProjectAuthor($decor, $username)
        else (
            (: author must already exist :)
            $decor/project/author[@username=$username]
        )
    
    (: update properties according to what we determined :)
    let $update         :=
        if ($author) then (
            for $att in $update-atts
            return
                if ($author/@*[name()=$att/name()]) then (
                    update value $author/@*[name()=$att/name()] with $att
                )
                else (
                    update insert $att into $author
                )
        ) else (
            error(xs:QName('error:AuthorNotFound'),'Author with this username does not exist in this project. Cannot update properties.')
        )
    
    return
        decor:getDecorProject($prefix)/project/author[@username=$username]
};

(:~ Adds a user to a project with given username and the first available increment as id. 
:   All permissions are taken from $decor:AUTHOR-TEMPLATE
:   Returns author element or error
:
:   Dependency aduser:getUserDisplayName($username) :)
declare %private function decor:setProjectAuthor($decor as element(decor)?, $username as xs:string) as element(author) {
    (:permissions are checked by caller, don't need new check:)
    
    let $project    := $decor/project
    let $author     := $project/author[@username=$username]
    let $newid      := if ($project/author[@id castable as xs:integer]) then max($project/author/xs:integer(@id)) else 0
    let $newid      := $newid + 1
    let $newname    := aduser:getUserDisplayName($username)
    let $newauthor  :=
        <author>
        {
            attribute id {$newid},
            attribute username {$username},
            attribute notifier {'off'},
            attribute effectiveDate {substring(string(current-dateTime()), 1, 19)},
            $decor:AUTHOR-TEMPLATE/(@* except (@id|@username|@notifier|@effectiveDate|@expirationDate)),
            $newname
        }
        </author>
    
    return
        if ($decor) then
            if ($author) then
                (:unexpected but possible... do not need to add anything, just return author as-is:)
                $author
            else (
                (:add user and return what we added:)
                let $add    := update insert $newauthor following $project/(name|desc|copyright|author)[last()]
                return $newauthor
            )
        else (
            error(xs:QName('error:ProjectNotFound'),'Project with this prefix does not exist.')
        )
};

(:~ Shortcut call to decor:setProjectAuthor to activate a project user. Note: does not manipulate the exist-db setting :)
declare function decor:activateAuthor($prefix as xs:string, $username as xs:string) as element(author) {
    decor:setProjectAuthor($prefix,$username,<author active="true"/>,false())
};

(:~ Shortcut call to decor:setProjectAuthor to activate a project user. Note: does not manipulate the exist-db setting :)
declare function decor:activateAuthorP($decor as element(), $username as xs:string) as element(author) {
    decor:setProjectAuthorP($decor,$username,<author active="true"/>,false())
};

(:~ Shortcut call to decor:setProjectAuthor to deactivate a project user. Note: does not manipulate the exist-db setting :)
declare function decor:deactivateAuthor($prefix as xs:string, $username as xs:string) as element(author) {
    decor:setProjectAuthor($prefix,$username,<author active="false"/>,false())
};

(:~ Shortcut call to decor:setProjectAuthor to deactivate a project user. Note: does not manipulate the exist-db setting :)
declare function decor:deactivateAuthorP($decor as element(), $username as xs:string) as element(author) {
    decor:setProjectAuthorP($decor,$username,<author active="false"/>,false())
};

(:~ Returns nothing if the currently logged in user has administrative privileges or error :)
declare function decor:checkAdminPermissions($prefix as xs:string) {
    if (sm:is-dba(get:strCurrentUserName())) then () else if (decor:isProjectAdmin($prefix,get:strCurrentUserName()) = true()) then () else (
        error(xs:QName('error:NotPermitted'),'You must have decor administrative privileges for this action.')
    )
};

(:~ Returns nothing if the currently logged in user has administrative privileges or error :)
declare function decor:checkAdminPermissionsP($decor as element()) {
    if (sm:is-dba(get:strCurrentUserName())) then () 
    else 
    if (decor:isProjectAdminP($decor,get:strCurrentUserName()) = true()) then () 
    else (
        error(xs:QName('error:NotPermitted'),'You must have decor administrative privileges for this action.')
    )
};

(:~ Returns <true/> element containing the lock that was successfully set, OR a <false/> element containing someone elses 
:   lock, or an <false/> element the user was not allowed edit rights for the object.
:
:   Most objects have an effectiveDate but some do not, like issues and older transactions. Communities do not 
:   have an id|ref but are name based. Submit community/@name as param $ref for community locks
:
:   To acquire a lock on an object the currently logged in user must have edit rights for the (rights parts of the) project 
:   or in the case of a community lock the user must have edit rights in the community. Secondly a lock must not have been 
:   set by another user, unless $breakLock is true in which case the lock from the other user is replaced by a new lock 
:   for the current user. :)
declare function decor:setLock($ref as xs:string, $effectiveDate as xs:string?, $breakLock as xs:boolean) as element() {
    decor:setLock((), $ref, $effectiveDate, $breakLock)
};
declare function decor:setLock($projectId as xs:string?, $ref as xs:string, $effectiveDate as xs:string?, $breakLock as xs:boolean) as element() {
    let $object             := 
        if (string-length($effectiveDate)=0) then
            $get:colDecorData//*[@id = $ref][not(ancestor::history|self::object)] | $get:colDecorData//community[@name = $ref][@projectId = $projectId]
        else (
            for $o in ( $get:colDecorData//dataset[@id = $ref] | $get:colDecorData//concept[@id = $ref] | 
                        $get:colDecorData//scenario[@id = $ref] | $get:colDecorData//transaction[@id = $ref] |
                        $get:colDecorData//valueSet[@id = $ref] | $get:colDecorData//template[@id = $ref] | 
                        $get:colDecorData//codeSystem[@id = $ref] |
                        $get:colDecorData//questionnaire[@id = $ref] | $get:colDecorData//questionnaireresponse[@id = $ref] |
                        $get:colDecorDataIG//implementationGuide[@id = $ref]
                      )
            return 
                if ($o[@effectiveDate = $effectiveDate][not(ancestor::history|self::object)]) then $o else ()
        )
    let $objectName         := 
        if ($object[@displayName]) then $object/@displayName else if ($object[@name]) then $object/@name else $object/name[1]
    let $objectType         := decor:getObjectDecorType($object[1])

    let $check              := 
        if ($object) then () else (
            error(QName('http://art-decor.org/ns/decor/error','ObjectNotFound'), concat('Object with ref="',$ref,'" effectiveDate="',$effectiveDate,'" is not found. Cannot create lock for an unknown object'))
        )
    let $check              := 
        if (count($object) = 1) then () else (
            error(QName('http://art-decor.org/ns/decor/error','MultipleObjectsFound'), concat('Object with ref="',$ref,'" effectiveDate="',$effectiveDate,'" is found multiple times (prefixes: ', string-join($object/ancestor::decor/project/@prefix, ', '), '). Cannot create lock multiple objects at once. This needs fixing in the database by an administrator.'))
        )
    let $check              := 
        if ($objectType = $decor:OBJECTTYPES-ALL) then () else (
            error(QName('http://art-decor.org/ns/decor/error','UnsupportedLockType'), concat('The lock type "',$objectType,'" is not supported. Please choose one of: ',string-join($decor:OBJECTTYPES-ALL,', ')))
        )
    
    let $decor              :=
        if (empty($projectId)) then
            $object/ancestor::decor
        else (
            $get:colDecorData//decor[project/@id=$projectId]
        )
    let $projectPrefix      := $decor/project/@prefix
    let $user               := get:strCurrentUserName()
    let $userDisplayName    := aduser:getUserDisplayName($user)
    
    let $currentLocks       :=
        if ($object[name()='object']) then () else (
            decor:getLocks($object/@id, $object/@effectiveDate, $projectId, false())
        )
    let $currentTreeLocks  :=
        for $a in $object/ancestor::*[@id] | $object/descendant::*[@id]
        return
            if ($a[name()='object']) then () else (
                decor:getLocks($a/@id, $a/@effectiveDate, $projectId, false())
            )
    let $lockFromOtherUser  := $currentLocks[not(@user = get:strCurrentUserName())] | $currentTreeLocks[not(@user = get:strCurrentUserName())]
    
    let $userCanEdit        := 
        if ($objectType = $decor:OBJECTTYPE-COMMUNITY) then (
            if ($object) then decor:authorCanEditCommunityP($object) else false()
        ) else (
            if ($decor) then decor:authorCanEditP($decor, $user, $decor:SECTION_TYPE_MAPPING//map[@type = $objectType]/@section) else false()
        )
    let $newLock            :=
        if ($userCanEdit) then (
            if (empty($lockFromOtherUser) or $breakLock) then (
                let $newLock    :=
                    <lock type="{$objectType}" ref="{$ref}" user="{$user}" userName="{$userDisplayName}" since="{current-dateTime()}" prefix="{$projectPrefix}" projectId="{$projectId}">
                    {
                        if (string-length($effectiveDate)>0) then attribute effectiveDate {$effectiveDate} else (),
                        if (string-length($objectName)>0) then attribute displayName {$objectName} else ()
                    }
                    </lock>
                let $locks      := if ($currentLocks) then update delete $currentLocks else ()
                
                let $insertLock := update insert $newLock into $get:docDecorLocks//decorLocks
                
                return <true>{$newLock}</true>
            ) else (
                <false>{$lockFromOtherUser}</false>
            )
        ) else (
            <false/>
        )
    
    return $newLock
};

(:~ Deletes locks for the given object. Returns true if any lock at all was deleted. Returns false if no locks were found to delete.
:
:   Most objects have an effectiveDate but some do not, like issues and older transactions. Communities do not 
:   have an id|ref but are name based. Submit community/@name as param $ref for community locks :)
declare function decor:deleteLock($ref as xs:string, $effectiveDate as xs:string?, $projectId as xs:string?) as xs:boolean {
    let $locks  := decor:getLocks($ref, $effectiveDate, $projectId, false())
    let $r      := exists($locks)
    let $clear  := update delete $locks
    
    return $r
};

(:~ Deletes locks for the given object. Returns true if any lock at all was deleted. Returns false if no locks were found to delete.
:
:   Most objects have an effectiveDate but some do not, like issues and older transactions. Communities do not 
:   have an id|ref but are name based. Submit community/@name as param $ref for community locks :)
declare function decor:deleteLock($object as element()?) as xs:boolean {
    let $ref            := if ($object/self::community) then $object/@name else if ($object[@id]) then ($object/@id) else ($object/@ref)
    let $effectiveDate  := $object/@effectiveDate
    let $projectId      := $object/@projectId
    
    return decor:deleteLock($ref, $effectiveDate, $projectId)
};

(:~ Deletes locks for the given object if they were set by the currently logged in user. Returns true if any lock at all was deleted. 
:   Returns false if no locks were found to delete.
:
:   Most objects have an effectiveDate but  some do not, like issues and older transactions. Communities do not 
:   have an id|ref but are name based. Submit community/@name as param $ref for community locks :)
declare function decor:deleteLocksUser() as xs:boolean {
    let $locks  := decor:getLocks((), (), (), true())
    let $r      := exists($locks)
    let $clear  := update delete $locks
    
    return $r
};

(:~ Deletes locks for the given object if they were set by the supplied user. Returns true if any lock at all was deleted. 
:   Returns false if no locks were found to delete.
:
:   Most objects have an effectiveDate but  some do not, like issues and older transactions. Communities do not 
:   have an id|ref but are name based. Submit community/@name as param $ref for community locks :)
declare function decor:deleteLocksUser($username as xs:string) as xs:boolean {
    let $current-user   := get:strCurrentUserName()
    let $locks          := 
        if ($current-user=$username or
            sm:is-dba($current-user) or
            sm:get-user-groups($current-user)='decor-admin') then
            decor:getLocks((), (), (), false())[@user=$username]
        else ()
    let $r      := exists($locks)
    let $clear  := update delete $locks
    
    return $r
};

(:~ Utility function to go from DECOR object to lock type :)
declare function decor:getObjectDecorType($object as element()?) as xs:string? {
    switch ($object/name()) 
    case 'community' return $decor:OBJECTTYPE-COMMUNITY
    case 'dataset' return $decor:OBJECTTYPE-DATASET
    case 'concept' return $decor:OBJECTTYPE-DATASETCONCEPT
    case 'valueSet' return $decor:OBJECTTYPE-VALUESET
    case 'codeSystem' return $decor:OBJECTTYPE-CODESYSTEM
    case 'conceptMap' return $decor:OBJECTTYPE-MAPPING
    case 'scenario' return $decor:OBJECTTYPE-SCENARIO
    case 'actor' return $decor:OBJECTTYPE-ACTOR
    case 'transaction' return $decor:OBJECTTYPE-TRANSACTION
    case 'questionnaire' return $decor:OBJECTTYPE-QUESTIONNAIRE
    case 'questionnaireresponse' return $decor:OBJECTTYPE-QUESTIONNAIRERESPONSE
    case 'template' return $decor:OBJECTTYPE-TEMPLATE
    case 'element' return $decor:OBJECTTYPE-TEMPLATEELEMENT
    case 'issue' return $decor:OBJECTTYPE-ISSUE
    case 'implementationGuide' return $decor:OBJECTTYPE-IMPLEMENTATIONGUIDE
    default return ()
};