REBOL [
    Title: "Simple Database Port"
    Author: "Christopher Ross-Gill"
    Date: 9-Aug-2010
]

;--## PORT HELPERS
;-------------------------------------------------------------------##
context [
    set 'add-protocol func ['proto-name proto-port-id proto-handler][
        unless in system/schemes proto-name [
            system/schemes: make system/schemes reduce [
                to-set-word proto-name none
            ]
        ]
        set in system/schemes proto-name make system/standard/port [
            scheme: proto-name
            port-id: proto-port-id
            handler: proto-handler
            passive: none
            cache-size: 5
            proxy: make object! [host: port-id: user: pass: type: bypass: none]
        ]
    ]
]

;--## DATABASE SYSTEM
;-------------------------------------------------------------------##
context [
    ; uri is simply: join data:// %/c/some-data.r
    parse-uri: func [uri /local target][
        all [
            parse/all uri ["data://" copy target to end]
            target: attempt [to-file target]
        ]
    ]

    sw*: get in system 'words

    length?: func [port /local len][
        len: sw*/length? head port/locals
        len / 2
    ]

    shift: func [port][
        port/locals: skip head port/locals 2 * port/state/index
    ]

    actions: context [
        port-flags: system/standard/port-flags/pass-thru

        init: func [[catch] port url /local spec][
            unless all [
                url? url
                port/target: parse-uri url
            ][make error! reform ["Spec Error:" url]]

            port/locals: none
        ]

        open: func [port][
            port/locals: either exists? port/target [
                load port/target
            ][
                write port/target ""
                make block! []
            ]

            port/state/tail: length? port
            port/state/index: 0
            port/state/flags: port/state/flags or port-flags
        ]

        copy: func [port][
            shift port
            sw*/copy port/locals
        ]

        insert: func [[catch] port record [block!] /local id data][
            either parse record [
                'id set id issue! copy data some [word! any-type!]
            ][
                shift port
                ; should check for existing ID
                sw*/insert port/locals reduce [id data]
                port/state/index: port/state/index + 1
                port/state/tail: length? port
                port
            ][
                make error! "Bad Data!"
            ]
        ]

        remove: func [port][
            shift port
            sw*/remove/part port/locals 2
            port/state/tail: length? port
            port
        ]

        find: func [port value /local loc][
            shift port
            switch type?/word value [
                issue! [
                    all [
                        loc: sw*/find port/locals value
                        port: skip head port (index? loc) - 1 / 2
                    ]
                ]
                block! [
                    ; dialect-based find goes here
                    use [field val][
                        parse value [
                            'field set field word!
                            'is set val any-type! end (
                                while [not tail? port][
                                    if val = sw*/select first port field [return port]
                                    port: next port
                                ]
                                
                                return none
                            )
                        ]
                    ]
                ]
            ]
        ]

        pick: func [port][
            shift port
            second port/locals
        ]

        select: func [port value][
            all [
                port: find port value
                pick port
            ]
        ]

        change: func [port data [block!]][
            shift port
            if parse data [some [word! any-type!]][
                sw*/change/only next port/locals data
            ]
            port
        ]

        close: func [port][
            save/all port/target head port/locals
            clear head port/locals
            recycle
        ]
    ]

    add-protocol data 0 actions
]