REBOL [
    Title: "Persistent values"
    Purpose: {
        Persistent REBOL values, proof of concept version.
    }
    Author: "Gabriele Santilli"
    EMail: giesse@rebol.it
    File: %p-values.r
    License: {
Copyright (C) 2003  Gabriele Santilli

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 2
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, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

http://www.gnu.org/copyleft/gpl.html
    }
    Date: 17-Nov-2004
    Version: 2.14.0 ; majorv.minorv.status
                    ; status: 0: unfinished; 1: testing; 2: stable
    History: [
         7-Jun-2004 1.1.0 "History start"
         7-Jun-2004 1.2.0 "First sketch"
         7-Jun-2004 1.3.0 "First version of p-context!"
         8-Jun-2004 1.4.0 "Finished pc-set"
         8-Jun-2004 1.5.0 "First working version"
         8-Jun-2004 2.1.0 "Rewritten in a simpler and more generic way"
         9-Jun-2004 2.2.0 "Added user!"
         9-Jun-2004 2.3.0 "Fixed a few bugs"
         9-Jun-2004 2.4.0 "Added config-list!"
         9-Jun-2004 2.5.0 "Fixed a bug"
        11-Jun-2004 2.6.0 "Included SQL code to create tables"
        14-Jun-2004 2.7.0 "Added USER?"
        15-Jun-2004 2.8.0 "The SQL code didn't define the userid column as UNIQUE"
        16-Jun-2004 2.9.0 "Added set-in and get-in"
        16-Jun-2004 2.10.0 "Fixed two bugs in p-context! (empty contexts messed things up, and a make inside a make created problems too)"
        16-Jun-2004 2.11.0 "Fixed a typo and another recursion problem in make* p-context!"
        17-Jun-2004 2.12.0 "Added find*"
        17-Nov-2004 2.13.0 "Added ID? for p-contexts"
        17-Nov-2004 2.14.0 "Fixed a bug in pcontext's SET'"
    ]
]

; comment the following line if you are using autodoc.r
;#do [document: func [text] [none]]

;#include %utility.r

#do [document {
===Persistent values proof of concept (p-values.r)

currently: p-context! proof of concept, NREN's user!

only supports MySQL

a p-context! is a map word -> value

a user! is a user of the NREN configurator
}]

{
CREATE TABLE `configs` (
    `user` smallint(5) unsigned NOT NULL default '0',
    `cid` mediumint(8) unsigned NOT NULL default '0',
    KEY `user` (`user`)
) TYPE=MyISAM; 

CREATE TABLE `contexts` (
    `cid` mediumint(8) unsigned NOT NULL default '0',
    `name` varchar(255) NOT NULL default '',
    `value` text NOT NULL,
    PRIMARY KEY  (`cid`,`name`)
) TYPE=MyISAM; 

CREATE TABLE `users` (
    `id` smallint(5) unsigned NOT NULL auto_increment,
    `name` varchar(255) default '',
    `userid` varchar(16) NOT NULL default '',
    `password` varchar(16) NOT NULL default '',
    PRIMARY KEY  (`id`),
    UNIQUE KEY `userid` (`userid`)
) TYPE=MyISAM; 
}

form-sql: func [
    "Forms a value into SQL syntax"
    value
    /local result chars normal-chars
] [
    if none? :value [return "NULL"]
    if :value = '__last-id [return "LAST_INSERT_ID()"]
    if date? :value [
        return rejoin compose [
            "'" (value/year) "-" (value/month) "-" (value/day)
            (either value/time [reduce [" " value/time/hour ":" value/time/minute ":" value/time/second]] [])
            "'"
        ]
    ]
    if time? :value [
        return rejoin ["'" value/hour ":" value/minute ":" value/second "'"]
    ]
    if number? :value [return form value]
    if block? :value [
        if empty? value [return "(NULL)"] ; SQL's quite silly... this is a workaround
        result: make string! 256
        insert tail result "("
        foreach element value [
            insert insert tail result form-sql :element ","
        ]
        return head change back tail result ")"
    ]
    if word? :value [return form value]
    if not any-string? :value [value: mold :value]
    result: make string! 256
    insert tail result "'"
    normal-chars: complement charset "^(00)^/^-^M^(08)'\"
    parse/all value [
        any [
            #"^(00)"    (insert tail result "\0")
          | #"^/"       (insert tail result "\n")
          | #"^-"       (insert tail result "\t")
          | #"^M"       (insert tail result "\r")
          | #"^(08)"    (insert tail result "\b")
          | #"'"        (insert tail result "\'")
          | #"\"        (insert tail result "\\")
          | copy chars some normal-chars (insert tail result chars)
        ]
    ]
    head insert tail result "'"
]

p-values-init:
    func [
        "Initialize p-values.r"
        db-url "MySQL database URL"
    ] [
        db-port: open db-url
    ]

get*:
    func [
        "Get from a p-value" [catch]
        'path [path!]

        /local value
    ] [
        value: first path
        path: next path
        value: throw-on-error [get value]
        if not p-value? value [throw make error! reduce ['script 'invalid-arg first head path]]
        while [not tail? path] [
            either p-value? :value [
                value: value/actions/get' value first path
                path: next path
            ] [
                value: use reduce [first path: back path] compose/deep [
                    (:set) (to lit-word! first path) (:first) [(:value)]
                    (path)
                ]
                path: tail path
            ]
        ]
        :value
    ]

get-in:
    func [
        "Get an attribute of a p-value"
        p-value [object!]
        attribute [word!]
        /default defval "Default value to return (instead of NONE)"
    ] [
        either p-value? p-value [
            if-error [p-value/actions/get' p-value attribute] [:defval]
        ] [
            :defval
        ]
    ]

set*:
    func [
        "Set in a p-value" [catch]
        'path [path!]
        value

        /local root
    ] [
        root: first path
        path: next path
        root: throw-on-error [get root]
        if not p-value? :root [throw make error! reduce ['script 'invalid-arg first back path]]
        while [not tail? next path] [
            root: root/actions/get' root first path
            if not p-value? :root [throw make error! reduce ['script 'invalid-arg first back path]]
            path: next path
        ]
        root/actions/set' root first path value
    ]

set-in:
    func [
        "Set an attribute of a p-value"
        p-value [object!]
        attribute [word!]
        value
    ] [
        if p-value? p-value [
            attempt [p-value/actions/set' p-value attribute :value]
        ]
    ]
    
p-value?:
    func [value] [
        all [object? :value in value 'type in value 'actions]
    ]
    
p-context?:
    func [value] [
        'p-context! = type?* :value
    ]

type?*:
    func [value [any-type!]] [
        either object? get/any 'value [
            either in value 'type [
                value/type
            ] [
                'object!
            ]
        ] [
            type?/word get/any 'value
        ]
    ]

p-context!:
    context [
        type: 'p-context!
        actions:
            context [
                get':
                    func [
                        "Get from a p-context!"
                        pc [object!]
                        word [word!]
                    ] [
                        if not pc/loaded [pc-load pc]
                        if not in pc/loaded word [
                            throw make error! reduce ['script 'invalid-path word]
                        ]
                        get in pc/loaded word
                    ]

                pc-update:
                    func [cid name value] [
                        insert db-port rejoin [
                            "UPDATE contexts "
                                "SET value = " form-sql value
                                " WHERE cid = " form-sql cid " AND name = " form-sql name
                        ]
                    ]
                    
                set':
                    func [
                        "Set in a p-context!"
                        pc [object!]
                        word [word!]
                        value
                    ] [
                        if not pc/loaded [pc-load pc]
                        either in pc/loaded word [
                            set in pc/loaded word :value
                            pc-update pc/id mold word mold* :value
                            :value
                        ] [
                            pc/loaded: make pc/loaded compose/only/deep [(to set-word! word) (:first) [(:value)]]
                            insert db-port rejoin [
                                "INSERT INTO contexts (cid, name, value) VALUES ("
                                    form-sql pc/id ", "
                                    form-sql mold word ", "
                                    form-sql mold* :value 
                                ")"
                            ]
                            :value
                        ]
                    ]

                pc-load:
                    func [
                        "(Re)Load a p-context!"
                        pc [object!]

                        /local loaded name value
                    ] [
                        insert db-port rejoin [
                            {SELECT name, value FROM contexts WHERE cid = } form-sql pc/id
                        ]
                        set [name value] [1 2]
                        loaded: clear [ ]
                        foreach item copy db-port [
                            if item/:name <> "self" [insert/only insert tail loaded to set-word! item/:name load* item/:value]
                        ]
                        pc/loaded: construct loaded
                    ]
                    
                pc-save:
                    func [
                        "Save a p-context!"
                        pc [object!]
                    ] [
                        if pc/loaded [
                            insert db-port rejoin ["DELETE FROM contexts WHERE cid = " form-sql pc/id]
                            foreach word first pc/loaded [
                                insert db-port rejoin [
                                    "INSERT INTO contexts (cid, name, value) VALUES ("
                                        form-sql pc/id ", "
                                        form-sql mold word ", "
                                        form-sql either word = 'self [pc/id] [mold* get/any in pc/loaded word]
                                    ")"
                                ]
                            ]
                        ]
                    ]

                mold':
                    func [
                        "Mold a p-context! value"
                        pc [object!]
                    ] [
                        pc/id
                    ]

                load':
                    func [
                        "Load a p-context! value"
                        arg [integer!]
                    ] [
                        make p-context! [id: arg]
                    ]

                make':
                    func [
                        "Make a new p-context!"
                        spec [object! block! integer!]
                    ] [
                        make p-context! either integer? spec [[
                            id: spec
                        ]] [
                            ; COPY needed for recursion
                            copy/deep [
                                loaded: either block? spec [make object! spec] [make spec []]
                                insert db-port "SELECT MAX(cid) + 1 FROM contexts"
                                id: any [attempt [to integer! first first first db-port] 0]
                                pc-save self
                            ]
                        ]
                    ]

                to':
                    func [
                        "Convert p-context! <-> object!"
                        type [word!]
                        spec [object!]
                    ] [
                        switch type [
                            p-context! [
                                if p-value? spec [throw make error! reduce ['script 'invalid-arg type?* spec]]
                                make' spec
                            ]
                            object! [
                                if not spec/loaded [pc-load spec]
                                make spec/loaded [ ]
                            ]
                        ]
                    ]
            ]

        loaded: none
        id: none
    ]

id?:
    func [
        "Return the unique ID of a p-context!" [catch]
        value
    ] [
        if not p-context? :value [throw make error! reduce ['script 'invalid-arg type?* :value]]
        value/id
    ]
    
mold*:
    func [
        "Mold a p-value (or a normal REBOL value)" [catch]
        value
    ] [
        either p-value? :value [
            rejoin [
                "#[p-value " value/type " " mold/all value/actions/mold' value "]"
            ]
        ] [
            mold/all :value
        ]
    ]

load*:
    func [
        "Load a p-value (or a normal REBOL value)" [catch]
        spec [string!]

        /local type arg
    ] [
        either parse spec ["#[" "p-value" spec: to end] [
            set [type spec] load/next spec
            set [arg spec] load/next spec
            if not all [
                word? :type
                p-value? get/any type
            ] [
                throw make error! reduce ['syntax 'invalid "p-value" spec]
            ]
            type: get type
            throw-on-error [type/actions/load' :arg]
        ] [
            throw-on-error [load spec]
        ]
    ]

make*:
    func [
        "Make a new p-value" [catch]
        type [object!]
        spec
    ] [
        if not p-value? type [throw make error! reduce ['script 'invalid-arg type]]
        type/actions/make' :spec
    ]

to*:
    func [
        "Convert p-values" [catch]
        type
        spec
    ] [
        either p-value? :type [
            type/actions/to' type/type :spec
        ] [
            either p-value? :spec [
                spec/actions/to' either datatype? :type [to word! mold type] [type?/word :type] spec
            ] [
                to :type :spec
            ]
        ]
    ]

; these are actually NREN-specific

user!:
    context [
        type: 'user!
        actions:
            context [
                get':
                    func [
                        "Get from a user!"
                        user [object!]
                        word [word!]
                    ] [
                        switch/default word [
                            name [user/name]
                            userid [user/userid]
                            configs [
                                either user/configs [user/configs] [user/configs: make* config-list! user/id]
                            ]
                        ] [
                            throw make error! reduce ['script 'invalid-path word]
                        ]
                    ]

                set':
                    func [
                        "Set in a user!"
                        user [object!]
                        word [word!]
                        value [string!]

                        /local sql
                    ] [
                        switch/default word [
                            name [sql: form-sql value]
                            userid [sql: form-sql value]
                            password [sql: rejoin ["PASSWORD(" form-sql value ")"]]
                        ] [
                            throw make error! reduce ['script 'invalid-path word]
                        ]
                        insert db-port rejoin [
                            "UPDATE users SET " word " = " sql " WHERE id = " form-sql user/id
                        ]
                        if in user word [set in user word value]
                        value
                    ]

                mold':
                    func [
                        "Mold a user! value"
                        user [object!]
                    ] [
                        user/id
                    ]

                load':
                    func [
                        "Load a user! value"
                        arg [integer!]

                        /local result
                    ] [
                        insert db-port rejoin [
                            "SELECT name, userid FROM users WHERE id = " form-sql arg
                        ]
                        result: copy db-port
                        if 1 <> length? result [
                            throw make error! reduce ['script 'invalid-arg arg]
                        ]
                        make user! [
                            id: arg
                            set [name userid] first result
                        ]
                    ]

                make':
                    func [
                        "Make a new user!"
                        spec [block! integer!]
                    ] [
                        either integer? spec [
                            load' spec
                        ] [
                            if not parse spec [string! string! opt string!] [
                                throw make error! reduce ['script 'invalid-arg spec]
                            ]
                            make user! [
                                insert db-port rejoin [
                                    "INSERT INTO users (userid, password, name) VALUES ("
                                        form-sql pick spec 1 ", "
                                        "PASSWORD(" form-sql pick spec 2 "), "
                                        form-sql pick spec 3
                                    ")"
                                ]
                                insert db-port "SELECT LAST_INSERT_ID()"
                                id: to integer! first first first db-port
                                userid: pick spec 1
                                name: pick spec 3
                            ]
                        ]
                    ]

                to':
                    func [
                        "Lookup a user by userid and password"
                        type [word!]
                        spec [string! block!]

                        /local userid' password result
                    ] [
                        if type <> 'user! [throw make error! reduce ['script 'invalid-arg type]]
                        either string? spec [
                            userid': spec
                        ] [
                            if not parse spec [string! opt string!] [
                                throw make error! reduce ['script 'invalid-arg spec]
                            ]
                            userid': pick spec 1
                            password: pick spec 2
                        ]
                        insert db-port rejoin [
                            "SELECT id, name FROM users WHERE userid = " form-sql userid'
                                either password [
                                    rejoin [" AND password = PASSWORD(" form-sql password ")"]
                                ] [
                                    ""
                                ]
                        ]
                        result: copy db-port
                        if 1 <> length? result [
                            throw make error! reduce ['script 'invalid-arg spec]
                        ]
                        make user! [
                            set [id name] first result
                            userid: userid'
                        ]
                    ]
            ]

        id: userid: name: configs: none
    ]

user?:
    func [value] [
        'user! = type?* :value
    ]
    
config-list!:
    context [
        type: 'config-list!
        actions:
            context [
                mold':
                    func [
                        "Mold a config-list! value"
                        cl [object!]
                    ] [
                        cl/user-id
                    ]

                load':
                    func [
                        "Load a config-list! value"
                        arg [integer!]

                        /local cl
                    ] [
                        insert db-port rejoin [
                            "SELECT cid FROM configs WHERE user = " form-sql arg
                        ]
                        cl: make config-list! [user-id: arg]
                        foreach config copy db-port [
                            insert tail cl/list make* p-context! config/1
                        ]
                        cl
                    ]

                make':
                    func [
                        "Make a new config-list!"
                        spec [integer!]
                    ] [
                        load' spec
                    ]

                to':
                    func [
                        "Convert config-list! -> block!"
                        type [word!]
                        spec [object!]
                    ] [
                        if type <> 'block! [throw make error! reduce ['script 'invalid-arg type]]
                        copy spec/list
                    ]
                    
                insert':
                    func [
                        "Insert a new config in the config-list!"
                        cl [object!]
                        config [object!]
                    ] [
                        if not p-context? config [throw make error! reduce ['script 'invalid-arg config]]
                        insert db-port rejoin [
                            "INSERT INTO configs (user, cid) VALUES ("
                                form-sql cl/user-id ", "
                                form-sql id? config
                            ")"
                        ]
                        insert tail cl/list config
                    ]

                find':
                    func [
                        "Returns true if a config is already in the list"
                        cl [object!]
                        config [object!]
                    ] [
                        if not p-context? config [throw make error! reduce ['script 'invalid-arg config]]
                        foreach cfg cl/list [
                            if cfg/id = id? config [break/return true]
                            none
                        ]
                    ]
            ]

        user-id: none
        list: [ ]
    ]

insert*:
    func [
        "Insert into a p-value" [catch]
        p-value [object!]
        value
    ] [
        if not p-value? p-value [throw make error! reduce ['script 'invalid-arg p-value]]
        p-value/actions/insert' p-value :value
    ]

find*:
    func [
        "Find into a p-value" [catch]
        p-value [object!]
        value
    ] [
        if not p-value? p-value [throw make error! reduce ['script 'invalid-arg p-value]]
        p-value/actions/find' p-value :value
    ]