Модуль ns_userkey для AOL Server

Описание модуля приведено в комментарии в коде.

#    Copyright 2009, Mobile Business Group
#    This program is free software: you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation, either version 3 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program.  If not, see http://www.gnu.org/licenses/.

package require json

# store and/or calculate limits and messages
proc ns_userkey_settings {name} {
    switch -exact -- $name {
        keylength            {return 100}
        valuelength          {return 1024}
        maxcount             {return 1000}

        messagesave          {return "Настройки сохранены."}
        messageflush         {return "Настройки удалены."}
        errornoargs          {return "Ошибочный запрос."}
        errorkeylength       {return "Превышена длина имени параметра (ограничение [ns_userkey_settings keylength] символов)."}
        errorvaluelength     {return "Превышен размер значения параметра (ограничение [ns_userkey_settings valuelength] байт)."}
        errormaxcount        {return "Превышено количество параметров (ограничение [ns_userkey_settings maxcount] параметров для одного пользователя)."}
        errorsystemunit      {return "Системные настройки не могут быть изменены через веб-запрос."}
    }
    return -code error "Unknown parameter $name"
}

ns_backup_nsv_array_sheduler userkeys*

proc ns_userkey {action args} {
    # проверить существование ключа
    if {$action eq {exists}} {
        if {[llength $args]!=2} {
            return -code error {Call function as ns_userkey exists _unit_ _param_}
        }
        return [nsv_exists userkeys[ns_user id] [lindex $args 0],[lindex $args 1]]
    } elseif {$action eq {names}} {
        if {[llength $args]!=1} {
            return -code error {Call function as ns_userkey names _unit_}
        }
        set names {}
        foreach name [nsv_array names userkeys[ns_user id] [lindex $args 0],*] {
            lappend names [string range $name [string last , $name]+1 end]
        }
        return $names
    } elseif {$action eq {get_escape}} {
        return [::json::string_escape [ns_userkey get {*}$args]]
    } elseif {$action eq {get}} {
        # получить значение ключа, если ключ не найден, функция вернет ключ по умолчанию или пустую строку
        if {[llength $args]==2} {
            set default {}
        } else {
            return -code error {Call function as ns_userkey get _unit_ _param_}
        }
        # если ключ не существует, нужно вернуть ключ по умолчанию
        if {[nsv_exists userkeys[ns_user id] [lindex $args 0],[lindex $args 1]] == 0} {
            # ключ не найден, возвращаем значение ключа по умолчанию, если таковой существует
            if {[ns_defaultkey exists [lindex $args 0] [lindex $args 1]]==1} {
                return [ns_defaultkey get [lindex $args 0] [lindex $args 1]]
            }
            # ключ по умолчанию тоже не найден, возвращаем пустую строку
            return
        }
        return [nsv_get userkeys[ns_user id] [lindex $args 0],[lindex $args 1]]
    } elseif {$action eq {set}} {
        # store this data
        if {[llength $args]!=3} {
            return -code error {Call function as ns_userkey set _unit_ _param_ _value_}
        }
        if {[nsv_array size userkeys[ns_user id]] > [ns_userkey_settings maxcount]} {
            return -code error [ns_userkey_settings errormaxcount]
        }
        nsv_set userkeys[ns_user id] [lindex $args 0],[lindex $args 1] [lindex $args 2]
        return [lindex $args 2]
    } elseif {$action eq {add}} {
        # store this data, but only if the server *doesn't* already hold data for this key
        if {[llength $args]!=3} {
            return -code error {Call function as ns_userkey add _unit_ _param_ _value_}
        }
        if {[nsv_exists userkeys[ns_user id] [lindex $args 0],[lindex $args 1]] == 0} {
            # ключ не найден
            nsv_set userkeys[ns_user id] [lindex $args 0],[lindex $args 1] [lindex $args 2]
            return [lindex $args 2]
        }
        return
    } elseif {$action eq {replace}} {
        # store this data, but only if the server *does* already hold data for this key
        if {[llength $args]!=3} {
            return -code error {Call function as ns_userkey replace _unit_ _param_ _value_}
        }
        if {[nsv_exists userkeys[ns_user id] [lindex $args 0],[lindex $args 1]] == 0} {
            # ключ не найден
            return
        }
        nsv_set userkeys[ns_user id] [lindex $args 0],[lindex $args 1] [lindex $args 2]
        return [lindex $args 2]
    } elseif {$action eq {flush}} {
        # удалить ключ или набор ключей, можно использовать шаблон имени ключа
        if {[llength $args]==1} {
            # удалить все ключи узла
            foreach key [nsv_array names userkeys[ns_user id] [lindex $args 0],*] {
                nsv_unset userkeys[ns_user id] $key
            }
        } elseif {[llength $args]==2} {
            # удалить ключи указанного узла согласно заданной маске имени
            foreach key [nsv_array names userkeys[ns_user id] [lindex $args 0],[lindex $args 1]] {
                nsv_unset userkeys[ns_user id] $key
            }
        } else {
            return -code error {Call function as ns_userkey flush _unit_ ?_pattern_?}
        }
    }
}