REBOL [
    Title: "SQL PROTOCOL"
    Date: 05-Mar-2006
    Author: ["Marco"]
    Version: 0.6.8
    Email: [mvri@bluewin.ch]
    File: %sql-protocol.r
    Category: [database]
    Library: [
        level: 'intermediate
        platform: 'all
        type: [dialect protocol tool]
        domain: [database db dialects protocol scheme sql]
        tested-under: [win]
        support: mvri@bluewin.ch
        license: 'public-domain
        see-also: none
    ]
    Purpose: {
		SQL-PROTOCOL is a SQL Relationnal Database Management System (RDBMS) entirely written in REBOL 
		with JOIN and SORT capability. This allow you having an easy to use lightweight database engine embeded
		in your REBOL application.
		
		Today, sql-protocol execute only these kind of query :
		* SELECT ... FROM ... WHERE ... ORDER BY ...
		* INSERT ... INTO ... VALUES ...
		* UPDATE ... SET ... WHERE ...
		* DELETE FROM ... WHERE ...
		* CREATE TABLE ...
		* DROP TABLE ...
		
		Query can be submited either as a standard SQL query string or as a SQL like query dialect block.
		* by using SQL query string you will have a better compatibility with other database system like MySQL, Oracle or DB2.
		* by using SQL query dialect you will get advantage of REBOL scripting facility.
		
		This quick example illustrates how to load the protocol, open a database, 
		select some rows from two tables, probe the result and close the database.
		
		Using standard SQL query string :
		
		    do %sql-protocol.r
		    db: open sql:my-db
		    insert db {
		        SELECT * FROM a, b
		        WHERE a.c2 = b.c1 AND a.c1 = 1
		        ORDER BY 1, 2 DESC
		    }
		    foreach item copy db [probe item]
		    close db
		
		The same using the SQL dialect :
		
		    do %sql-protocol.r
		    db: open sql:my-db
		    insert db [
		        SELECT * FROM a b
		        WHERE a.c2 = b.c1 AND a.c1 = 1
		        ORDER BY 1 [2 DESC]
		    ]
		    foreach item copy db [probe item]
		    close db
		
		Moreover, sql-protocol provide a basic compabibility with the ODBC text driver {Microsoft text driver (*.csv,*.txt)} 
		in order to provide a quick and simple way to share data between REBOL application and any ODBC application,
		for example, MS Excel to produce table or chart,or MS Word to produce letters or mailing.
		
		sql-protocol provide also a set of file protocol which can be used directly in your script :
		DATA:  - text file containing a REBOL block for each row
		HEAP:  - same as DATA but for transient table (in memory table)
		CSV:   - delimited file by any caracter except doublequote ("), newline (^/) or linefeed (^M).
    }
    Comment: {
        This script includes some elements inspired from Logan
        This script is also inspired by ODBC and MySQL
        
        Many thanks to Christophe for the Rebol Unit tool that I use to test each version of sql-protocol.
        Many thanks to Robert for the Make Doc Pro tool that I use to produce the documentation of sql-protocol.
    }
    Usage: {
        Columns id must be either table-name.column-name or row/index
        Table & Alias couple must be placed in a block
        Columns & Asc | Desc couple must be placed in a block

        Sample for persistent dababase :
        --------------------------------
        do %sql-protocol.r
        db: open sql:my-db
        insert db [CREATE TABLE a [c1 c2 c3] IF NOT EXISTS]
        insert db [CREATE TABLE b [c1 c2] IF NOT EXISTS]
        insert db [CREATE TABLE c [c1 c2 c3] TYPE = HEAP]
        insert db [CREATE TABLE d [c1 c2 c3] TYPE = [CSV ColNameHeader: false format: 'Delimited delimited: ";"]
        insert db [INSERT INTO a VALUES 
            [1 2 3]
            [1 2 4]
            [2 3 4]
            [3 4 5]
        ]
        insert db [INSERT INTO b VALUES 
            [1 "x"]
            [2 "y"]
        ]
        repeat i 100 [insert db compose/deep [INSERT INTO c VALUES [(i) (i + 1) (i + 2)]]]
        insert db [SELECT DISTINCT * a.c2 FROM a [b b1]
            WHERE a.c2 = b1.c1 AND a.c1 = 1
            ORDER BY 1 [2 DESC]
        ]
        foreach item copy db [probe item]
        insert db [UPDATE c SET c1: 1 WHERE c1 > 50]
        insert db [DELETE FROM c WHERE c1 >= 2]
        insert db [DROP TABLE a]
        close db
    }
    History: [
        0.0.1 [15-Sep-2004 {Initial alpha version} marco@adyreb.org]
        0.1.0 [28-Sep-2004 {Change in provision of SQl protocol - DATA: protocol & database object} marco@adyreb.org]
        0.2.0 [13-Oct-2004 {First beta published on www.rebol.org} marco@adyreb.org]
        0.3.0 [11-Nov-2004 {Add CSV protocol, change on DATA protocol and preparation to FIXED protocol} marco@adyreb.org]
        0.4.0 [14-Dec-2004 {Implement new schema.ctl and extend TYPE = clause} marco@adyreb.org]
        0.5.0 [17-Jan-2005 {Alpha version published on www.rebol.org} marco@adyreb.org]
        0.6.0 [17-Jan-2005 {More flexible SQL dialect (FROM clause)} marco@adyreb.org]
        0.6.1 [16-Mar-2005 {More flexible SQL dialect (columns, WHERE and ORDER BY clause)} marco@adyreb.org]
        0.6.2 [29-Mar-2005 {Extends test case} marco@adyreb.org]
        0.6.3 [11-May-2005 {End of extended test and publication to library} marco@adyreb.org]
        0.6.4 [02-Feb-2006 {Add LIKE clause + some bug correction} marco@adyreb.org]
        0.6.5 [05-Feb-2006 {First attempt of SQL string parsing for SELECT + some bug correction} marco@adyreb.org]
        0.6.6 [07-Feb-2006 {Correction of a bug when using word in the SQL dialect} marco@adyreb.org]
        0.6.7 [08-Feb-2006 {Improvement of word handling in dialect} marco@adyreb.org]
        0.6.8 [05-Mar-2006 {Implement SQL parsing for INSERT, UPDATE & DELETE clauses} marco@adyreb.org]
    ]
    to-do: [
        {Implement /new when openning sql protocol and throw an error fr all other refinements}
        {Implement directory mngt for sql protocol}
        {implement FixedLength file (FIXED protocol)}
        {More and more, improve performance and simplify the script}
    ]
]

; *******************************************************************
; protocol utilities
; *******************************************************************

; -----------------
; Word redefinition
; -----------------
; These words are redefined because
; - either they are functions redefined for the protocol handler
; - or they are used as refinement within functions of thze protocol handler

all*: get in system/words 'all
any*: get in system/words 'any
change*: get in system/words 'change
close*: get in system/words 'close
copy*: get in system/words 'copy
find*: get in system/words 'find
get-modes*: get in system/words 'get-modes
insert*: get in system/words 'insert
open*: get in system/words 'open
pick*: get in system/words 'pick
poke*: get in system/words 'poke
query*: get in system/words 'query
remove*: get in system/words 'remove
update*: get in system/words 'update
skip*: get in system/words 'skip
select*: get in system/words 'select
sort*: get in system/words 'sort
set-modes*: get in system/words 'set-modes

; -----------------------
; port flags redefinition
; -----------------------
; These are the values I could find, but some are misssing

system/standard/port-flags: make system/standard/port-flags [
    read: to-integer power 2 0
    write: to-integer power 2 1
    append: to-integer power 2 2
    new: to-integer power 2 3
    flag-4: to-integer power 2 4
    binary: to-integer power 2 5
    lines: to-integer power 2 6
    flag-7: to-integer power 2 7
    with: to-integer power 2 8
    opened: to-integer power 2 9
    closed: to-integer power 2 10
    wait: to-integer power 2 11
    flag-12: to-integer power 2 12
    eof: to-integer power 2 13
    async: to-integer power 2 14
    flag-15: to-integer power 2 15
    flag-16: to-integer power 2 16
    changed: to-integer power 2 17
    updated: to-integer power 2 18
    direct: to-integer power 2 19
    flag-20: to-integer power 2 20
    custom: to-integer power 2 21
    pass-thru: to-integer power 2 22
    flag-23: to-integer power 2 23
    seek: to-integer power 2 24
    skip: to-integer power 2 25
    flag-26: to-integer power 2 26
    flag-27: to-integer power 2 27
    allow-read: to-integer power 2 28
    allow-write: to-integer power 2 29
    flag-30: to-integer power 2 30
    flag-31: to-integer -1
]

; --------------------
; throw-error function
; --------------------

throw-error: func [
    [throw]
    "Throw an error base on err parms"
    err [error! block! object!]
][
    either error? err [
        err: disarm err
    ][
        err: make error-object err
    ]
    throw make error! reduce bind [type id arg1 arg2 arg3 near where] in err 'self
]

; -----------------------
; to-record function
; -----------------------
    to-record: func [
        value
        only
        /local data item rule out-data sub-data
    ][
        parse data: copy/deep value rule: [
            any [
                s: set item word! (either value? item [
                    change/only s get item
                ][
                    s: next s
                ]) :s
            |
                into rule
            |
                skip
            ]
        ]
        either all [
            not only
            parse data [any [block!]]
        ][
            data
        ][
            reduce [data]
        ]
    ]


; *******************************************************************
; Base data protocol handler
; *******************************************************************

base-protocol: context [
; ------------------
; BASE Close handler
; ------------------

    close: func [
        {Close sub-port} 
        port [port!] "An open port spec"
    ][
        net-utils/net-log reduce ["Closing port for" to-string port/scheme]
        if port? port/sub-port [
            close* port/sub-port
        ]
        port
    ]

; -------------------
; BASE Update handler
; -------------------

    update: func [
        {Update sub-port} 
        port [port!] "An open port spec"
    ][
        net-utils/net-log reduce ["Updating port for" to-string port/scheme] 
        if port? port/sub-port [
            update* port/sub-port
        ]
        port
    ]

; -----------------
; BASE Pick handler
; -----------------

    pick: func [
        "Pick operation." 
        port [port!] "An open port spec"
        data "Index where to pick data"
        /local buffer
    ][
        net-utils/net-log ["Pick at " data "index"]
        if none? data [data: 1]
        buffer: at port/state/inBuffer index? port
        pick* buffer data
    ]

; -----------------
; BASE Copy handler
; -----------------

    copy: func [
        "Copy operation." 
        port [port!] "An open port spec"
        /local buffer
    ][
        net-utils/net-log ["Copy of" port/scheme]
        buffer: at port/state/inBuffer index? port
        copy*/part buffer port/state/num
    ]

; ----------------------
; BASE get-modes handler
; ----------------------
    get-modes: func [
        port [port!] "An open port spec"
        modes "A mode block"
    ][
        get-modes* port
    ]

; ----------------------
; BASE set-modes handler
; ----------------------
    set-modes: func [
        port [port!] "An open port spec"
        modes "A mode block"
    ][
        set-modes* port
    ]
]

        
; *******************************************************************
; Default file handler (reused for data, csv and fixed protocol)
; *******************************************************************

file-handler: context [

; -----------------
; FILE Init handler
; -----------------
    init: func [
        port
        spec
        /local scheme file path target locals
    ][
        net-utils/net-log reduce ["Initializing" to-string spec "for" to-string port/scheme] 

        if url? spec [
            set [scheme target] parse/all spec ":"
            spec: compose [scheme: (scheme) target: (target)]
        ]
        spec: context spec
; ------------
; Manage shema
; ------------
        if any [
            none? locals: in spec 'schema
            none? locals: get locals
        ][
            locals: []
        ]
        port/locals: make file-schema locals

; ----------------------------
; Manage file, path and target
; ----------------------------
        target: to-file spec/target
        if any [
            none? path: in spec 'path
            none? path: get path
        ][
            either #"/" = first target [
                path: %/.
            ][
                path: %.
            ]
        ]
        if #"/" <> first target [
            path: dirize to-file path
        ]
        set [path target] split-path file: join path spec/target
        if none? target [target: %./]
        if not any [
            #"/" = last target
            find target #"."
        ][
            target: join target port/handler/file-extension port
        ]
        port/path: clean-path path
        port/target: target
        if none? port/target [
            net-error reform ["No target file for" port/scheme "is specified"]
        ] 
    ]
; -----------------
; FILE Open handler
; -----------------
    open: func [
        {Open sub-port.} 
        port "Initalized port spec"
        /local sub-port inBuffer file header delimiter cmd parms
    ][
        net-utils/net-log reduce ["Opening port for" to-string port/scheme]
        port/status: 'file

        port/state/flags: port/state/flags and complement system/standard/port-flags/direct
        port/state/flags: port/state/flags or system/standard/port-flags/lines
        port/state/flags: port/state/flags or system/standard/port-flags/pass-thru

        port/sub-port: make port! join port/path port/target
        port/sub-port/state/flags: port/sub-port/state/flags or (port/state/flags and system/standard/port-flags/new)
        either #"/" = last port/target [
            open* port/sub-port
            port/state/inBuffer: copy* port/sub-port
        ][
            port/state/inBuffer: port/handler/read-sub-port port
        ]
        port/state/tail: length? port/state/inBuffer
        port
    ]

; ------------------
; FILE Close handler
; ------------------
    close: func [
        {Close sub-port} 
        port [port!] "An open port spec"
    ][
        net-utils/net-log reduce ["Closing port for" to-string port/scheme]
        if all [
            not #"/" = last port/target
            system/standard/port-flags/changed = (port/state/flags and system/standard/port-flags/changed)
        ][
            port/handler/write-sub-port port
            port/state/flags: port/state/flags and complement system/standard/port-flags/changed
        ]
        close* port/sub-port
        port
    ]

; -------------------
; FILE Update handler
; -------------------
    update: func [
        port [port!] "An open port spec"
    ][
        net-utils/net-log reduce ["Updating port for" to-string port/scheme] 
        if all [
            not #"/" = last port/target
            system/standard/port-flags/changed = (port/state/flags and system/standard/port-flags/changed)
        ][
            port/handler/write-sub-port port
            port/state/flags: port/state/flags and complement system/standard/port-flags/changed
        ]
        update* port/sub-port
        port
    ]

; -----------------
; FILE Pick handler
; -----------------
    pick: func [
        "Pick operation." 
        port [port!] "An open port spec"
        data "Index where to pick data"
        /local buffer
    ][
        net-utils/net-log ["Pick at " data "index"]
        if none? data [data: 1]
        buffer: at port/state/inBuffer index? port
        pick* buffer data
    ]

; -----------------
; FILE Copy handler
; -----------------
    copy: func [
        "Copy operation." 
        port [port!] "An open port spec"
        /local buffer
    ][
        net-utils/net-log ["Copy of" port/scheme]
        buffer: at port/state/inBuffer index? port
        copy*/part buffer port/state/num
    ]

; -------------------
; FILE Insert handler
; -------------------
    insert: func [
        port [port!]
        value
        /part
            range [number! series! port! pair!] 
        /only
        /dup
            count [number! pair!]
        /local buffer cmd parms
    ][
        net-utils/net-log ["Insert of " port/state/num "bytes"]
        cmd: to-path 'insert*
        parms: copy* []
        if all [value? 'part part][append cmd 'part repend parms [range]] 
        if dup [append cmd 'dup repend parms [dup]]
        either #"/" = last port/target [
            buffer: at port/sub-port index? port
            buffer: do compose [(cmd) buffer value (parms)]
        ][
            value: to-record value only
            buffer: at port/state/inBuffer index? port
            buffer: do compose [(cmd) buffer value (parms)]
            port/handler/insert-sub-port port value cmd parms
        ]
        port/state/tail: length? head buffer
        at port index? buffer
    ]

; -------------------
; FILE Change handler
; -------------------
    change: func [
        port [port!]
        value
        /part
            range [number! series! port! pair!] 
        /only
        /dup
            count [number! pair!]
        /local buffer cmd parms data
    ][
        net-utils/net-log ["Change of " port/state/num "bytes"]
        cmd: to-path 'change*
        parms: copy* []
        if part [append cmd 'part repend parms [range]] 
        if dup [append cmd 'dup repend parms [count]] 
        either #"/" = last port/target [
            buffer: at port/sub-port index? port
            buffer: do compose [(cmd) buffer value (parms)]
        ][
            value: to-record value only
            buffer: at port/state/inBuffer index? port
            buffer: do compose [(cmd) buffer value (parms)]
            port/handler/change-sub-port port value cmd parms
        ]
        port/state/tail: length? head buffer
        at port index? buffer
    ]

; -----------------
; FILE Sort handler
; -----------------
    sort: func [
        port [port!]
        /case "Case sensitive sort."
        /skip "Treat the series as records of fixed size."
            size [integer!] "Size of each record."
        /compare "Comparator offset, block or function."
            comparator [integer! block! function!]
        /part "Sort only part of a series."
            length [integer!] "Length of series to sort."
        /all "Compare all fields"
        /reverse "Reverse sort order"
        /local buffer cmd parms
    ][
        net-utils/net-log ["Sort in" port/scheme]

        cmd: to-path 'sort*
        parms: copy* []
        if skip [append cmd 'skip repend parms [size]] 
        if compare [append cmd 'compare repend parms [:comparator]] 
        if part [append cmd 'part repend parms [length]] 
        if all [append cmd 'all] 
        if reverse [append cmd 'reverse] 

        either #"/" = last port/target [
            buffer: at port/sub-port index? port
            buffer: do compose [(cmd) buffer value (parms)]
        ][
            buffer: at port/state/inBuffer index? port
            buffer: do compose [(cmd) buffer (parms)]
            port/handler/sort-sub-port port cmd parms
        ]
        port/state/tail: length? head buffer
        at port index? buffer
    ]

; -----------------
; FILE Poke handler
; -----------------
    poke: func [
        port [port!]
        index [number! logic! pair!]
        value
        /local buffer item
    ][
        net-utils/net-log ["Pick at " data "index"]
        either #"/" = last port/target [
            buffer: at port/sub-port index? port
            poke* buffer index value
        ][
            buffer: at port/state/inBuffer index? port
            buffer: poke* buffer index value
            port/handler/poke-sub-port port index value
        ]
        value
    ]

; -------------------
; FILE Remove handler
; -------------------
    remove: func [
        "Remove operation." 
        port [port!] "An open port spec"
        /local buffer cmd parms
    ][
        net-utils/net-log ["Remove of" port/scheme]
        either #"/" = last port/target [
            buffer: at port/sub-port index? port
            buffer: remove*/part buffer port/state/num
        ][
            buffer: at port/state/inBuffer index? port
            remove*/part buffer port/state/num
            remove-sub-port port
        ]
        port/state/tail: length? head buffer
        at port index? buffer
    ]

; ------------------
; FILE Query handler
; ------------------
    query: func [
        port [port!]
        /clear
        /local sub-port
    ][
        net-utils/net-log ["query of " port/scheme]
        sub-port: make port! rejoin [port/path port/target]
        query* sub-port
        port/status: sub-port/status
        port/date: sub-port/date
        port/size: sub-port/size
        none
    ]

; ---------------------------
; FILE get-modes handler
; ---------------------------
    get-modes: func [
        port [port!] "An open port spec"
        modes "A mode block"
    ][
        get-modes* port
    ]

; ----------------------
; FILE set-modes handler
; ----------------------
    set-modes: func [
        port [port!] "An open port spec"
        modes "A mode block"
    ][
        set-modes* port
    ]

; ----------------------------
; FILE file-extension function
; ----------------------------
    file-extension: func [
        port [port!]
    ][
        %.dat
    ]

; ----------------------------
; FILE file-schema function
; ----------------------------
    file-schema: context [
        format: none
        cols: []
    ]

; --------------------
; FILE insert-sub-port
; --------------------
    insert-sub-port: func [
        port [port!]
        value
        cmd [path!]
        parms [block!]
        /local buffer result data
    ][
        result: data: make block! length? value
        foreach item value [
            data: insert* data port/handler/to-sub-record port item
        ]
        buffer: at port/sub-port index? port
        buffer: do compose [(cmd) buffer result (parms)]
    ]

; --------------------
; FILE change-sub-port
; --------------------
    change-sub-port: func [
        port [port!]
        value
        cmd [path!]
        parms [block!]
        /local buffer result data
    ][
        result: data: make block! length? value
        foreach item value [
            data: insert* data port/handler/to-sub-record port item
        ]
        buffer: at port/sub-port index? port
        buffer: do compose [(cmd) buffer result (parms)]
    ]

; ------------------
; FILE sort-sub-port
; ------------------
    sort-sub-port: func [
        port [port!]
        cmd [path!]
        parms [block!]
        /local buffer
    ][
        close* port/sub-port
        buffer: open*/new/lines port/sub-port
        foreach item port/state/inBuffer [
        buffer: insert* buffer port/handler/to-sub-record port item
        ]
        port/sub-port
    ]

; ------------------
; FILE poke-sub-port
; ------------------
    poke-sub-port: func [
        port [port!]
        index [number! logic! pair!]
        value
    ][
        buffer: at port/sub-port index? port
        buffer: poke* buffer index port/handler/to-sub-record port value
    ]

; --------------------
; FILE remove-sub-port
; --------------------
    remove-sub-port: func [
        port [port!]
    ][
        buffer: at port/sub-port index? port
        buffer: remove*/part buffer port/state/num
    ]

; --------------------------
; FILE Register the protocol
; --------------------------
; -->       net-utils/net-install FILE self none
]

; *******************************************************************
; DELIMITED Protocol Handler
; *******************************************************************

make file-handler [

; ---------------------------------
; DELIMITED file-extension function
; ---------------------------------
    file-extension: func [
        port [port!]
    ][
        switch port/locals/format [
            Delimited %.txt
            CSVDelimited %.csv
            TABDelimited %.tab
        ]
        ""
    ]

; ---------------------------------
; DELIMITED file-delimiter function
; ---------------------------------
    file-delimiter: func [
        {Default file delimiter}
        port [port!]
    ][
        switch/default port/locals/format [
            Delimited [";"]
            CSVDelimited [","]
            TABDelimited ["^-"]
        ][
            ";,^-"
        ]
    ]

; -----------------------------
; DELIMITED file-schema
; -----------------------------
    file-schema: context [
        ColNameHeader: false
        format: 'Delimited
        delimiter: none
        max-scan-rows: 0
        character-set: 'OEM
        cols: none
    ]

; -----------------------
; DELIMITED Read sub-port
; -----------------------
    read-sub-port: func [
        port "Initalized port spec" 
        /local result line d m y v s e
            end-of-line
            quote-char
            double-quote
            end-of-line-set
            digit-set
            delimited-header-line
            delimited-text-line
            delimited-data
            delimited-string
            unquoted-string
            quoted-string
            number
            exact-number
            approximate-number
            unsigned-integer
            date
            mm dd yy yyyy mmm
            date-separator
            delimited-null
            current-delimiter
            delimiter-set
            character-set
    ][
        net-utils/net-log reduce ["Reading sub-port for" to-string port/scheme] 
; Basic char
; ----------
        quote-char: {"}
        digit-char: "0123456789"
        end-of-line-char: "^/^M"

; Basic character set
; -------------------
        end-of-line: [ "^/^M" | "^M" | "^/" ]
        double-quote: rejoin [quote-char quote-char]
        end-of-line-set: charset end-of-line-char
        digit-set: charset digit-char

; Manage delimiter
; ----------------
        current-delimiter: any [
            port/locals/delimiter
            port/handler/file-delimiter port
            ",;^-"
        ]
        delimiter-set: charset current-delimiter
        character-set: complement charset rejoin [current-delimiter quote-char end-of-line-char]
        delimiter: [
            copy d delimiter-set (
                if none? port/locals/delimiter [
                    delimiter-set: charset port/locals/delimiter: d
                    character-set: complement charset rejoin [current-delimiter quote-char end-of-line-char]
                ]
            )
        ]

; Manage file
; -----------
        text-file: either port/locals/ColNameHeader [
            [delimited-header-line any delimited-text-line]
        ][
            [any delimited-text-line]
        ]

; Manage line
; -----------
        delimited-header-line: [delimited-text-line (
            if none? port/locals/cols [
                port/locals/cols: copy* []
                foreach item first result [
                    repend port/locals/cols [to-word item copy* []]
                ]
            ]
            clear result
        )]

        delimited-text-line: [
            end-of-line 
        |
            (line: copy* [])
            delimited-data
            any [delimiter delimited-data]
            end-of-line
            (insert*/only tail result line)
        ]

; Manage data
; -----------
        delimited-data: [[
            date s: [delimiter | end-of-line] :s
        |
            number s: [delimiter | end-of-line] :s
        |
            delimited-string s: [delimiter | end-of-line] :s
        |
            delimited-null s: [delimiter | end-of-line] :s
        ] (append line v)]

; Manage date
; -----------
        date: [[
            copy d dd date-separator copy m [mm | mmm] date-separator copy y [yyyy | yy]
        |
            copy m mmm date-separator copy d dd date-separator copy y [yyyy | yy]
        |
            copy y yyyy date-separator copy m [mm | mmm] date-separator copy d dd
        ] (v: to-date rejoin [d "-" m "-" y])]
        mm: [digit-set [digit-set | none]]
        dd: [digit-set [digit-set | none]]
        yy: [digit-set digit-set]
        yyyy: [digit-set digit-set digit-set digit-set]
        mmm: ["Jan" | "Feb" | "Mar" | "Apr" | "May" | "Jun" | "Jul" | "Aug" | "Sep" | "Oct" | "Nov" | "Dec"]
        date-separator: [ "-" | "/" | "."]

; Manage number
; -------------
        number: [approximate-number | exact-number]
        approximate-number: [copy v [
            ["+" | "-" | none] [
                unsigned-integer ["." unsigned-integer | none]
            |
                "." unsigned-integer
            ]["e" | "E"] ["+" | "-"] unsigned-integer
        ] (v: to-decimal v) ]
        exact-number: [s:
            ["+" | "-" | none]
            [
                unsigned-integer "." [unsigned-integer | none] e: (v: to-decimal copy*/part s e)
            |
                "." unsigned-integer e: (v: to-decimal copy*/part s e)
            |
                 unsigned-integer e: (v: to-integer copy*/part s e)
            ]
        ]

        unsigned-integer: [some digit-set]

; Manage string
; -------------
        delimited-string: [unquoted-string | quoted-string]

        unquoted-string: [
            s: character-set
            any [character-set | quote-char]
            e: (v: to-string copy*/part s e)
        ]

        quoted-string: [
            quote-char s:
            any [character-set | delimiter-set | end-of-line-set | double-quote]
            e: quote-char
            (v: to-string copy*/part s e)
        ]

; Manage null value
; -----------------
        delimited-null: [s: delimiter :s (v: none)] ; NULL is represented by no data between two delimiters.

        either system/standard/port-flags/new =(port/state/flags and system/standard/port-flags/new) [
;            port/state/flags: port/state/flags or system/standard/port-flags/changed
        port/state/inBuffer: copy* []
            write-sub-port port
            port/state/inBuffer
        ][
            open* port/sub-port
            result: make block! 0
            either parse/all copy* port/sub-port text-file [
                port/state/inBuffer: result
            ][
            make error! "Invalid CSV file"
            ]
        ]
    ]

; ----------------------
; DELIMITED Write record
; ----------------------
    write-sub-port: func [
        {Write the file.} 
        port "Initalized port spec" 
        /local line sep
    ][
        net-utils/net-log reduce ["Writing records" to-string port/scheme] 
        if none? port/locals/delimiter [
            port/locals/delimiter: port/handler/file-delimiter port
        ]
;       clear head port/sub-port
        attempt [close* port/sub-port]
        open*/new port/sub-port
        if port/locals/ColNameHeader [
            line: clear []
            sep: ""
            foreach item port/locals/cols [
                if block? item [
                    item: first item
                ]
                item: to-string item
                append line sep
                append line item
                sep: port/locals/delimiter
            ]
            append port/sub-port line
            append port/sub-port newline
        ]
        foreach item head port/state/inBuffer [
            line: clear []
            sep: ""
            foreach jtem item [
                if none? find [integer! decimal! date! time!] type? jtem [
                    jtem: to-string jtem
                    jtem: replace/all to-string jtem {"} {""}
                    if any [
                        find* jtem {"}
                        find* jtem port/locals/delimiter
                        find* jtem {^/}
                        find* jtem {^M}
                    ][
                        jtem: rejoin [{"} jtem {"}]
                    ]
                ]
                append line sep
                append line jtem
                sep: port/locals/delimiter
            ]
            append port/sub-port line
            append port/sub-port newline
        ]
    ]

; -------------------------
; DELIMITED insert-sub-port
; -------------------------
    insert-sub-port: func [
        port [port!]
        value
        cmd [path!]
        parms [block!]
        /local
    ][
        port/state/flags: port/state/flags or system/standard/port-flags/changed
    ]

; -------------------------
; DELIMITED change-sub-port
; -------------------------
    change-sub-port: func [
        port [port!]
        value
        cmd [path!]
        parms [block!]
        /local
    ][
        port/state/flags: port/state/flags or system/standard/port-flags/changed
    ]

; -------------------------
; DELIMITED sort-sub-port
; -------------------------
    sort-sub-port: func [
        port [port!]
        cmd [path!]
        parms [block!]
        /local
    ][
        port/state/flags: port/state/flags or system/standard/port-flags/changed
    ]

; -----------------------
; DELIMITED poke-sub-port
; -----------------------
    poke-sub-port: func [
        port [port!]
        index [number! logic! pair!]
        value
        /local
    ][
        port/state/flags: port/state/flags or system/standard/port-flags/changed
    ]

; -------------------------
; DELIMITED remove-sub-port
; -------------------------
    remove-sub-port: func [
        port [port!]
    ][
        port/state/flags: port/state/flags or system/standard/port-flags/changed
    ]

; -------------------------------
; DELIMITED Register the protocol
; -------------------------------
    net-utils/net-install CSV self none
]

; *******************************************************************
; DATA Protocol Handler
; *******************************************************************

    make file-handler [

; ----------------------------
; DATA file-extension function
; ----------------------------
    file-extension: func [
        port [port!]
    ][
        %.data
    ]

; -----------------------
; DATA Read sub-port
; -----------------------
    read-sub-port: func [
        port
        /local result data sub-port
    ][
        sub-port: open*/lines port/sub-port
        port/state/inBuffer: data: make block! length? sub-port
        while [not tail? sub-port][
            data: insert*/only data load first sub-port
            sub-port: next sub-port
        ]
        port/state/inBuffer
    ]

; -----------------
; DATA Write record
; -----------------
    write-sub-port: func [
        {Write the file.} 
        port "Initalized port spec" 
    ][
        none
    ]

; ---------------------------
; DATA to-sub-record function
; ---------------------------

    to-sub-record: func [
        port [port!]
        value
    ][
        mold value
    ]

; --------------------------
; DATA Register the protocol
; --------------------------
    net-utils/net-install DATA self none
]

; *******************************************************************
; HEAP Protocol Handler
; *******************************************************************

context [

    root-heap: make block! 0

; -----------------
; HEAP Init handler
; -----------------

    init: func [
        "Parse URL and/or check the port spec object" 
        port "Unopened port spec" 
        spec {Argument passed to open or make (a URL or port-spec)} 
        /local scheme file path target locals
    ][
        net-utils/net-log reduce ["Initializing" to-string spec "for" to-string port/scheme] 
        either url? spec [
            set [scheme file] parse/all spec ":"
            set [path target] split-path file: to-file file
            if none? target [target: %./]
            if not any [
                #"/" = last target
                find target #"."
            ][=
                target: join target %.heap
            ]
            port/path: clean-path to-rebol-file path
            port/target: target
            port/url: spec 
        ][
            spec: context spec
            target: to-file spec/target
            if any [
                none? path: in spec 'path
                none? path: get path
            ][
                either #"/" = first target [
                    path: %/.
                ][
                    path: %.
                ]
            ]
            path: dirize to-file path
            set [path target] split-path file: join path target
            if none? target [target: %./]
            if not any [
                #"/" = last target
                find target #"."
            ][
                target: join target %.heap
            ]
            port/path: clean-path path
            port/target: target
        ]
        if none? port/target [
            net-error reform ["No target file for" port/scheme "is specified"]
        ] 
    ]

; -----------------
; HEAP Open handler
; -----------------

    open: func [
        {Open sub-port.} 
        port "Initalized port spec"
        /local item file path new-flag
    ][
        net-utils/net-log reduce ["Opening port for" to-string port/scheme]
        port/status: 'file
        port/state/flags: port/state/flags or system/standard/port-flags/lines
        port/state/flags: port/state/flags or system/standard/port-flags/pass-thru
        file: rejoin [port/path port/target]
        new-flag: system/standard/port-flags/new = (system/standard/port-flags/new and port/state/flags)
        either none? port/state/inBuffer: select-heap file root-heap [
            either all [
                #"/" = last port/target
                not new-flag
            ][
                throw-error [type: 'access id: 'cannot-open arg1: file]
            ][
                port/state/inBuffer: insert-heap file root-heap 
            ]
        ][
            if new-flag [
                either #"/" = last port/target [
                    throw-error [type: 'access id: 'cannot-open arg1: file]
                ][
                    clear port/state/inBuffer
                ]
            ]
        ]
        if #"/" = last port/target [
            port/state/inBuffer: extract port/locals: port/state/inBuffer 2
        ]
        port/state/tail: length? port/state/inBuffer
        port
    ]

; ------------------
; HEAP Close handler
; ------------------

    close: func [
        {Close sub-port} 
        port [port!] "An open port spec"
    ][
        net-utils/net-log reduce ["Closing port for" to-string port/scheme]
        port
    ]

; -------------------
; HEAP Update handler
; -------------------

    update: func [
        {Update sub-port} 
        port [port!] "An open port spec"
    ][
        net-utils/net-log reduce ["Updating port for" to-string port/scheme] 
        port
    ]

; -----------------
; HEAP Pick handler
; -----------------

    pick: func [
        "Pick operation." 
        port [port!] "An open port spec"
        data "Index where to pick data"
        /local buffer
    ][
        net-utils/net-log ["Pick at " data "index"]
        if none? data [data: 1]
        buffer: at port/state/inBuffer index? port
        pick* buffer data
    ]

; -----------------
; HEAP Copy handler
; -----------------

    copy: func [
        "Copy operation." 
        port [port!] "An open port spec"
        /local buffer
    ][
        net-utils/net-log ["Copy of" port/scheme]
        buffer: at port/state/inBuffer index? port
        copy*/part buffer port/state/num
    ]

; -------------------
; HEAP Insert handler
; -------------------

    insert: func [
        port [port!]
        value
        /part
            range [number! series! port! pair!] 
        /only
        /dup
            count [number! pair!]
        /local buffer cmd parms
    ][
        net-utils/net-log ["Insert of " port/state/num "bytes"]
        cmd: to-path 'insert*
        parms: copy* []
        if all [value? 'part part][append cmd 'part repend parms [range]] 
        if dup [append cmd 'dup repend parms [dup]]
        either #"/" = last port/target [
            throw-error [type: 'script id: 'bad-port-action arg1: 'insert]
        ][
            buffer: at port/state/inBuffer index? port
            buffer: do compose [(cmd) buffer to-record value only (parms)]
        ]
        port/state/tail: length? head buffer
        at port index? buffer
    ]

; -------------------
; HEAP Change handler
; -------------------

    change: func [
        port [port!]
        value
        /part
            range [number! series! port! pair!] 
        /only
        /dup
            count [number! pair!]
        /local buffer cmd parms data
    ][
        net-utils/net-log ["Change of " port/state/num "bytes"]
        cmd: to-path 'change*
        parms: copy* []
        if part [append cmd 'part repend parms [range]] 
        if dup [append cmd 'dup repend parms [count]] 
        either #"/" = last port/target [
            buffer: at port/locals (2 * index? port) - 1
            change* buffer value
            buffer: at port/state/inBuffer index? port
            buffer: change* buffer value
        ][
            buffer: at port/state/inBuffer index? port
            buffer: do compose [(cmd) buffer to-record value only (parms)]
        ]
        port/state/tail: length? head buffer
        at port index? buffer
    ]

; -----------------
; HEAP Poke handler
; -----------------

    poke: func [
        port [port!]
        index [number! logic! pair!]
        value
        /local buffer item
    ][
        net-utils/net-log ["Pick at " data "index"]
        either #"/" = last port/target [
            buffer: at port/locals (2 * index? port) - 1
            poke* buffer (2 * index) - 1 value
            buffer: at port/state/inBuffer index? port
            poke* buffer index value
        ][
            buffer: at port/state/inBuffer index? port
            poke* buffer index value
        ]
        value
    ]

; -------------------
; HEAP Remove handler
; -------------------

    remove: func [
        "Remove operation." 
        port [port!] "An open port spec"
        /local buffer cmd parms
    ][
        net-utils/net-log ["Remove of" port/scheme]
        either #"/" = last port/target [
            buffer: at port/locals (2 * index? port) - 1
            buffer: remove*/part buffer 2 * port/state/num
            buffer: at port/state/inBuffer index? port
            buffer: remove*/part buffer port/state/num
        ][
            buffer: at port/state/inBuffer index? port
            buffer: remove*/part buffer port/state/num
        ]
        port/state/tail: length? head buffer
        at port index? buffer
    ]

; ------------------
; HEAP Query handler
; ------------------

    query: func [
        port [port!]
        /clear
    ][
        net-utils/net-log ["query at " data "index"]
        if select-heap rejoin [port/path port/target] root-heap [
            either #"/" = last port/target [
                port/status: 'directory
            ][
                port/status: 'file
            ]
        ]
        none
    ]

; ----------------------
; HEAP get-modes handler
; ----------------------
    get-modes: func [
        port [port!] "An open port spec"
        modes "A mode block"
    ][
        get-modes* port
    ]

; ----------------------
; HEAP set-modes handler
; ----------------------
    set-modes: func [
        port [port!] "An open port spec"
        modes "A mode block"
    ][
        set-modes* port
    ]

; ===================================================================
; HEAP protocol utilities
; ===================================================================

    split-full-path: func [
        file [file!]
        /local path target result block
    ][
        file: clean-path file
        block: result: parse/all file "/"
        forall block [
            change* block to-file rejoin [first block "/"]
        ]
        if #"/" <> last file [
            remove* back tail last result
        ]
        next result
    ]

    select-heap: func [
        file [file!]
        heap [block!]
        /local item
    ][
        file: split-full-path file
        while [all [
            not tail? file
            heap: select* heap first file
        ]][
            file: next file
        ]
        heap
    ]

    find-heap: func [
        file [file!]
        heap [block!]
    ][
        file: split-full-path file
        item: heap
        while [all [
            not tail? file
            heap: find*/skip item first file 2
        ]][
            file: next file
            item: second heap
        ]
        heap
    ]

    insert-heap: func [
        file [file!]
        heap [block!]
        /locals item
    ][
        file: split-full-path file
        while [not tail? file][
            if none? item: select* heap first file [
                insert* tail heap reduce [first file item: make block! 0]
            ]
            heap: item
            file: next file
        ]
        item
    ]

; --------------------------
; HEAP Register the protocol
; --------------------------
    net-utils/net-install HEAP self none

]

; *******************************************************************
; SQL protocol context
; *******************************************************************
; This object contains 4 things:
; - the SQL engine (various functions)
; - the SQL protocol
; - the DATA protocol
; - some utilities

sql-ctx: context [

; *******************************************************************
;                          SQL parsing
; *******************************************************************
    result: cols: where: values: value: item: item-1: item-2: sql-err: sql-exp: none
; Parse function
    sql-parse-request: func [
        "Return an SQL Rebol dialect block from SQL request string"
        request [string!] "The request string"
    ][
    	sql-exp: request
        result: copy []
        cols: copy []
        values: copy []
        value: copy []
        sql-err: 'SQL
        either not parse/all request [
        	any space-set [
        		sqlc-select
        	|
	        	sqlc-insert
    	    |
        		sqlc-update
        	|
        		sqlc-delete
    		]
        ][
            return throw-error [type: 'sql id: 'syntax arg1: sql-err arg2: sql-exp]
        ][
            result
        ]
    ]

; Basic charset
    end-of-line: [ "^/^M" | "^/" ]
    end-of-line-set: charset "^/^M"
    space-set: charset " ^-^/^M"
    any-space: [any space-set]
    some-space: [some space-set]
    num-set: charset "1234567890"
    alpha-set: charset "abcdefghijklmnopqrstuvwxyz"
    name-set: union num-set alpha-set
    str-set: complement charset "'"

; Basic type
    sqlc-integer: [some num-set]
    sqlc-decimal: [some num-set opt ["." some num-set]]
    sqlc-number: [copy item sqlc-integer (item: to integer! item)| sqlc-decimal (item: to integer! item)]
    sqlc-string: [any str-set]
    sqlc-name: [alpha-set any name-set]
    sqlc-full-name: [sqlc-name "." sqlc-name | sqlc-name]

; -------------------------------------------------------
; SELECT clause
; -------------------------------------------------------
    sqlc-select: [
        any space-set "SELECT" some space-set (append result [SELECT])
        opt ["DISTINCT" some space-set (append result [DISTINCT])]
        [
            "FROM" some space-set
        |
            sqlc-column any [any space-set "," any space-set sqlc-column] some space-set "FROM" some space-set
        ] (append result [FROM])
        sqlc-table any [any space-set "," any space-set sqlc-table]
        opt [
            some space-set "WHERE" some space-set (
                append result [WHERE]
                insert*/only where: copy [] result
            ) sqlc-where
        ]
        opt [
            some space-set "GROUP" some space-set "BY" (append result [GROUP BY])
            some space-set sqlc-group any [any space-set "," any space-set sqlc-group]
        ]
        opt [
            some space-set "ORDER" some space-set "BY" (append result [ORDER BY])
            some space-set sqlc-order any [any space-set "," any space-set sqlc-order]
        ]
        any space-set
    ]

; Column clause
    sqlc-column: [
        sqlc-count
    |
        "*" (append result '*)
    |
        copy item [sqlc-name ".*"] (append result to word! item)
    |
        (insert/only where: copy [] to paren! copy []) sqlc-value (append result first where)
    ]

; COUNT clause
    sqlc-count: [
        "COUNT" any space-set "(" any space-set ["UNIQUE" some space-set | none]
        sqlc-count-col any [any space-set "," any space-set sqlc-count-col] 
        any space-set ")"                   
    ]

; Count column clause
    sqlc-count-col: ["*" | sqlc-full-name]

; From table clause
    sqlc-table: [
        copy item-1 sqlc-name [
            some space-set opt ["AS" some space-set] copy item-2 sqlc-name (
                insert*/only tail result compose [(to word! item-1) AS (to word! item-2)]
            )
        |
            none (append result to word! item-1)
        ]
    ]

; WHERE clause
    sqlc-where: [
        sqlc-where-condition
        any [
            any space-set copy item ["AND" | "OR"] some space-set (append first where to word! uppercase item)
            sqlc-where-condition
        ]
    ]

; Test clause
    sqlc-where-condition: [
        "(" any space-set (
            insert/only where to paren! copy []
        ) sqlc-where any space-set ")" (
            insert*/only tail second where first where
            remove where
        )
    |
        sqlc-value any space-set [
            "LIKE" (append first where 'LIKE) some space-set [
                "'" copy item sqlc-string "'" (
                    item: copy item
                    replace/all item #"%" #"*"
                    replace/all item #"_" #"?"
                    append first where item
                )
            |
                sqlc-value
            ]
        |
            copy item ["<>" | "<=" | ">=" | "=" | "<" | ">"] (append first where to word! item) 
            any space-set sqlc-value
        ]
    ]

; GROUP BY clause
    sqlc-group: [
            copy item sqlc-integer (append result to integer! item)
        |
            copy item sqlc-full-name (append result to word! item)
    ]

; ORDER BY clause
    sqlc-order: [
        [
            copy item sqlc-integer (item-1: to integer! item)
        |
            copy item sqlc-full-name (item-1: to word! item)
        ][
            some space-set copy item-2 ["ASC" | "DESC"]  (insert*/only tail result compose [(item-1) (to word! uppercase item-2)])
        |
            none (insert*/only tail result item-1)
        ]
    ]

; Value clause
    sqlc-value: [
        [
            "(" any space-set (
                insert/only where to paren! copy []
            ) sqlc-value any space-set ")" (
                insert*/only tail second where first where
                remove where
            )
        |
            "'" copy item sqlc-string "'" (append first where item)
        |
            copy item sqlc-full-name (append first where to word! item)
        |
            sqlc-number (append first where item)
        ]
        opt [
            any space-set copy item ["+" | "-" | "*" | "/"] (append first where to word! item)
            any space-set sqlc-value
        ]
    ]

; -------------------------------------------------------
; INSERT clause
; -------------------------------------------------------
    sqlc-insert: [
        any space-set sql-exp: "INSERT" opt [ some space-set "INTO"] (append result [INSERT INTO])
        some space-set sql-exp: sqlc-table
        opt [
        	any space-set "(" sql-exp: copy item sqlc-name (append cols to word! item) any [
        		any space-set "," any space-set sql-exp: copy item sqlc-name (append cols to word! item)
        	]
        	any space-set ")" (insert*/only tail result cols)
        ]
        [
        	any space-set "VALUES" (append result [VALUES]) sqlc-insert-values any [
        		any space-set "," any space-set sqlc-insert-values
        	]
        |
        	any space-set sqlc-select
    	]
	]
; INSERT values
    sqlc-insert-values: [
        any space-set "(" (
			insert*/only tail result copy []
        	insert/only where: copy [] last result
        ) sql-exp: sqlc-value
        any [
        	any space-set "," any space-set sql-exp: sqlc-value 
        ] ")"
    ]

; -------------------------------------------------------
; UPDATE clause
; -------------------------------------------------------
    sqlc-update: [
        any space-set sql-exp: "UPDATE" (append result [UPDATE])
        some space-set sql-exp: sqlc-table
        some space-set sql-exp: "SET" (append result [SET]) some space-set sql-exp: sqlc-set
        any [
        	any space-set "," any space-set sql-exp: sqlc-set
        ]
        opt [
            some space-set "WHERE" some space-set (
                append result [WHERE]
                insert*/only where: copy [] result
            ) sqlc-where
        ]
	]
    sqlc-set: [
    	copy item sqlc-name any space-set "=" (
			insert* tail result to set-word! item
        	insert*/only where: copy [] result
        ) sql-exp: sqlc-value
	]

; -------------------------------------------------------
; DELETE clause
; -------------------------------------------------------
    sqlc-delete: [
        any space-set sql-exp: "DELETE" some space-set "FROM"(append result [DELETE FROM])
        some space-set sql-exp: sqlc-table
        opt [
            some space-set "WHERE" some space-set (
                append result [WHERE]
                insert*/only where: copy [] result
            ) sqlc-where
        ]
	]

; *******************************************************************
;                          SQL Engine
; *******************************************************************

; ===================================================================
; sql-query function
; ===================================================================

    sql-query: func [
            "Execute sql like request on a database"
        query [string! block!]
        port [port!]
        /local word distinct cols col from where order-by table values value if-not-exist scheme spec
    ][
        if string? query [sql-exp: query: sql-parse-request query]
        distinct: if-not-exist: false
        cols: copy* []
        where: copy* []
        order-by: copy* []
        values: copy* []
        scheme: 'data
        spec: copy* []
        sql-exp: query
        sql-err: 'SQD
        either parse query [
            sql-exp: 'SELECT (word: 'SELECT)
            ['DISTINCT (distinct: true) | none]
            copy cols to 'FROM
            'FROM copy from [to 'WHERE | to 'ORDER | to end]
            [
                'WHERE copy where [to 'ORDER | to end]
            |
                none
            ]
            [
                'ORDER 'BY copy order-by to end
            |
                none
            ]
            end
        |
            sql-exp: 'INSERT (word: 'INSERT)
            opt 'INTO set table word!
            opt [set cols block!]
            'VALUES copy values to end
        |
            sql-exp: 'UPDATE (word: 'UPDATE)
            set table word!
            'SET copy values [to 'WHERE | to end] 
            [
                'WHERE copy where to end
            |
                none
            ]
        |
            sql-exp: 'DELETE (word: 'DELETE)
            'FROM set table word!
            [
                'WHERE copy where to end
            |
                none
            ]
        |
            sql-exp: ['CREATE 'TABLE] (word: 'CREATE-TABLE)
            set table word!
            set cols block!
            ['IF 'NOT 'EXISTS (if-not-exist: true) | none]
            [
                'TYPE '= [
                    set scheme word!
                |
                    set spec block! (
                        scheme: first spec
                        spec: copy next spec
                    )
                ]
            |
                none
            ]
        |
            sql-exp: ['DROP 'TABLE] (word: 'DROP-TABLE)
            set table word!
        ][
            switch/default word [
                SELECT [
                    sql-select distinct cols from where order-by port
                ]
                INSERT [
                    sql-insert table cols values port
                ]
                UPDATE [
                    sql-update table values where port
                ]
                DELETE [
                    sql-delete table where port
                ]
                CREATE-TABLE [
                    sql-create-table table cols if-not-exist scheme spec port
                ]
                DROP-TABLE [
                    sql-drop-table table port
                ]
            ][
	            return throw-error [type: 'sql id: 'syntax arg1: sql-err arg2: sql-exp]
            ]
        ][
            return throw-error [type: 'sql id: 'syntax arg1: sql-err arg2: sql-exp]
        ]
    ]

; ===================================================================
; SQL-SELECT function
; ===================================================================
; This function return the rows corresponding to the cols, from, where and order-by clause

; It does 4 things :
; - normalize the cols clause (replace the * and table.* element by corresponding cols)
; - normalize the where clause (add parenthesis when necessary and translate the LIKE clause)
; - generate dynamicaly the code that
;   - extract the data from the database
;   - join the tables (if many)
;   - execute the where condition
;   - obtain the columns
; - apply the distinct flag if any
; - sort the result
; - return the result

; The result is a block of block (one for each resulting row)
; If the where block is empty, the function return all the row
; The join is done even if the where clause is empty (this is not true in SQL)

; Return a block of block (one for each resulting row)

    sql-select: func [
        distinct [logic!]
        cols [block!]
        from [block!]
        where [block!]
        order-by [block!]
        port [port!]
        /local result spec body rows index way
    ][

; Normalize the cols, from and where clause
; -----------------------------------
        from: to-rebol-from from
        cols: either empty? cols [
            [*] 
        ][
            to-rebol-cols cols from port
        ]
        where: either empty? where [
            [true]
        ][
            to-rebol-where where
        ]
        order-by: to-rebol-path order-by

; Extract the data, applies joins, where and cols clause
; ------------------------------------------------------
        result: rows: copy* []
        set [spec body] make-do-select cols from where port
        bind body 'result
        use spec body

; Applies the distinct clause
; ---------------------------
        if distinct [result: unique result]

; Applies the order by clause
; ---------------------------
        if not empty? order-by [
            foreach item head reverse copy order-by [
                set [index way] either block? item [
                    item
                ][
                    reduce [item 'asc]
                ]
                if not integer? index [
                    index: index? find cols reduce [index]
                ]
                either way = 'desc [ 
                    sort/compare/reverse result index
                ][  
                    sort/compare result index
                ]
            ]
        ]

; return the result
; -----------------
        result
    ]

; -------------
; to-rebol-from
; -------------
; This function normalize the from clause in order to be compatible with Rebol, can be
; FROM table table ...
; FROM table AS alias ... !!! To remove -> not good
; FROM [table alias] ...
; FROM [table AS alias] ...
; or combination of above

    to-rebol-from: func [
        from [block!]
        /local table item1 item2
    ][
        table: copy* []
        parse from [any [
            into [
                copy item1 word! opt 'AS copy item2 word! (
                    append table reduce [first item2 first item1]
                )
            ]
        |
            copy item1 word! 'AS copy item2 word! (
                append table reduce [first item2 first item1]
            )
        |
            copy item1 word! (
            append table reduce [first item1 first item1]
            )
        ]]
        table
    ]

; -------------
; to-rebol-cols
; -------------
; This function normalize the cols clause in order to be compatible with Rebol

; It replace * and alias.* by the corresponding columns
; Return a normalized cols clause (block of column or alias/column)

    to-rebol-cols: func [
        cols [block!]
        from [block!]
        port [port!]
        /local result rule p item1 item2
    ][
        cols: to-rebol-path cols
        result: copy* []
        foreach item cols [
            set [item1 item2] to-block item
            either item1 = '* [
                foreach [item1 item2] from [
                    foreach item get-cols item2 port [
                        item: first to-block item
                        insert*/only tail result to-path reduce [item1 item]
                    ]
                ]
            ][
                either item2 = '* [
                    item2: first select/skip from item1 2
                    foreach item get-cols item2 port [
                        item: first to-block item
                        insert*/only tail result to-path reduce [item1 item]
                    ]
                ][
                    insert*/only tail result item
                ]
            ]
        ]
        result
    ]

; --------------
; to-rebol-where
; --------------
; This function normalize the where clause in order to be compatible with Rebol
; - Column names are normalized
; - Clause before or after AND or OR are placed between parenthesis
;   AND is applied before OR
;   sample : a = 1 and b = 2 or a = 2 ==>> ((a = 1) and (b = 2)) or (a = 2)
; -  LIKE  is changed to
;     tail? any [find/any/match  "*"]
; Return the normalized where clause

    to-rebol-where: func [
        where [block!]
        /local result item item-1 item-2
    ][
        result: copy* []
        where: to-rebol-path where
        parse where [
            any [
                end
                break
            |
                'OR copy item [to 'OR | to end] (
                    append result 'OR
                    if parse item [paren!] [item: to-block first item]
                    insert*/only tail result to-paren to-rebol-where item
                )
            |
                copy item to 'OR (
                    if parse item [paren!] [item: to-block first item]
                    insert*/only tail result to-paren to-rebol-where item
                )
            |
                'AND copy item [to 'AND | to end] (
                    append result 'AND
                    if parse item [paren!] [item: to-block first item]
                    append result to-rebol-where item
                )
            |
                copy item to 'AND (
                    if parse item [paren!] [item: to-block first item]
                    append result to-rebol-where item
                )
            |
                copy item to end (
                    if parse item [paren!] [item: to-rebol-where to block! first item]
                    parse item [
;                        'LIKE copy item-2 to end (
;                                item: compose/deep [tail? any [find/any/match (item-2) "*"]]
;                            )
;                    |
                        copy item-1 to 'LIKE 'LIKE copy item-2 to end (
                                item: compose/deep [tail? any [find/any/match (item-1) (item-2) "*"]]
                            )
                    |
                        to end
                    ]
                    insert*/only tail result to-paren item
                )
            ]
        ]
        result
    ]

; --------------
; to-rebol-path
; --------------
; This function normalize the block or paren to remove the dot notation
; Return a normalized block

    to-rebol-path: func [
        block [block! paren!]
        /local result p
    ][
        result: copy* []
        parse block rule: [any [
            set p word! (
                if find to string! p "." [
                    p: parse/all to-string p "."
                    forall p [change p to-word first p]
                    p: to path! head p
                ]
                insert*/only tail result p
            )
        |
            set p [block! | paren!] (
                insert*/only tail result to-rebol-path p
            )
        |
            set p any-type! (
                insert*/only tail result p
            )
        ]]
        either block? block [
            result
        ][
            to-paren result
        ]
    ]

; ---------------------
; make-do-select
; ---------------------
; This function build dynamicaly a the used spec and body to process the data

; Return the body and the spec

    make-do-select: func [
        cols [block!]
        from [block!]
        where [block!]
        port [port!]
        /local body words set-words £item1 spec
    ][
        spec: copy* [cols]
        body: copy* []
        foreach [item1 item2] from [
            append spec reduce [item1 £item1: to-word rejoin ['£ item1]]
            words: copy* []
            set-words: copy* []
            foreach item get-cols item2 port [
                item: first to-block item
                append words item
                append set-words to-set-word item
            ]
            insert body compose/deep [
                (to-set-word item1) context [(set-words) none]
                (to-set-word £item1) bind [(words)] in (item1) 'self
                bind cols in (item1) 'self
                bind where in (item1) 'self
            ]
        ]
        insert body compose/deep [
            cols: [(cols)]
        ]
        append body make-do-loop cols from where port 1
        reduce [spec body]
    ]

; -------------------
; make-do-loop
; -------------------
; This function build dynamicaly a the spec and body that applies the where clause.

; Return the body of the function

    make-do-loop: func [
        cols [block!]
        from [block!]
        where [block!]
        port [port!]
        index [integer!]
        /local item item1 item2 code
    ][
        either tail? from [
            compose/deep [
                if (where) [
                    rows: insert*/only rows reduce cols
                ]
            ]
        ][
            set [item1 item2] from
            item: to-word join '£ index
            compose/deep [
                use [(item)][
                    (to-set-word item) get-data (to-lit-word item2) port
                    while [not tail? (item)][
                        set (to-word rejoin ['£ item1]) first (item)
                        (make-do-loop cols skip from 2 where port index + 1)
                        (to-set-word item) next (item) 
                    ]
                ]
            ]
        ]
    ]

; ===================================================================
; SQL-INSERT function
; ===================================================================
; This execute the sql INSERT query

    sql-insert: func [
        table [word!]
        cols [block!]
        values [block!]
        port [port!]
        /local spec rows
    ][
        spec: get-cols-name table port
        if empty? cols [
            cols: copy spec
        ]
        cols
        rows: get-data table port
        do compose/deep [
            use [(spec)] [
                foreach item to-record values false [
                    set [(cols)] item
                    insert*/only tail rows reduce [(spec)]
                ]
            ]
        ]
        copy* []
    ]

; ===================================================================
; SQL-UPDATE function
; ===================================================================
; This execute the sql UPDATE query

    sql-update: func [
        table [word!]
        values [block!]
        where [block!]
        port [port!]
        /local spec data
    ][
        where: either empty? where [
            [true]
        ][
            to-rebol-where where
        ]
        spec: get-cols-name table port
        data: get-data table port
        do compose/deep [
            use [(spec)][
                while [not tail? data][
                    row: first data
                    set [(spec)] row
                    if (where) [
                        reduce [(values)]
                        change/only data reduce [(spec)]
                    ]
                    data: next data
                ]
            
            ]
        ]
        copy* []
    ]

; ===================================================================
; SQL-DELETE function
; ===================================================================
; This execute the sql DELETE query

    sql-delete: func [
        table [word!]
        where [block!]
        port [port!]
        /local spec data row
    ][
        where: either empty? where [
            [true]
        ][
            to-rebol-where where
        ]
        spec: copy* []
        foreach item get-cols table port [
            append spec item
        ]
        data: get-data table port
        do compose/deep [
            use [(spec)][
                while [not tail? data][
                    row: first data
                    set [(spec)] row
                    either (where) [
                        data: remove data
                    ][
                        data: next data
                    ]
                ]
            ]
        ]
        copy* []
    ]

; ===================================================================
; SQL-CREATE-TABLE function
; ===================================================================
; This execute the sql CREATE TABLE query

    table-schema: context [
        scheme: none
        cols: none
    ]

    sql-create-table: func [
        table [word!]
        cols [block!]
        if-not-exist [none! logic!]
        scheme [none! word!]
        spec [none! block!]
        port [port!]
        /local item file url
    ][
        if attempt [port/locals/table/:table] [
            either if-not-exist [
                return copy* []
            ][
                throw-error [type: 'sql id: 'already-exist arg1: "Table" arg2: table]
            ]
        ]
        if none? scheme [scheme: 'data]
        scheme: to-word lowercase to-string scheme
        if none? in system/schemes scheme [
            throw-error [type: 'sql id: 'invalid-type arg1: "table" arg2: table arg3: scheme]
        ]
        if none? spec [
            spec: copy* []
        ]
        if scheme = 'CSV [
            spec: make sql-text spec
            spec/format: to-string spec/format
            spec/delimiter: any [
                select ["CSVDelimited" "," "TabDelimited" "^-" "FixedLength" ""] spec/format
                spec/delimiter
                ";"
            ]
            spec: third spec
        ]
        port/locals/table: make port/locals/table compose/deep [
            (to-set-word table) [
                scheme: (to-lit-word scheme)
                target: (to-file rejoin [table either find to-string table #"." [copy ""][rejoin ["." scheme]]])
                schema: [
                    (spec)
                    cols: [(cols)]
                ]
            ]
        ]
        save-schema port
        get-data/new table port
        copy* []
    ]

; ===================================================================
; SQL-DROP-TABLE function
; ===================================================================
; This execute the sql DROP TABLE query

    sql-drop-table: func [
        table [word!]
        port [port!]
        /local item data url
    ][
        url: get-url table port
        if data: attempt [port/locals/data/:table] [
            close* data
            port/locals/data: context remove find third port/locals/data to-set-word table
        ]
        if exists? url [delete url]
        port/locals/table: context remove find third port/locals/table to-set-word table
        save-schema port
        copy* []
    ]

; ===================================================================
; Other function
; ===================================================================

; -----------------
; get-cols function
; -----------------

        get-cols: func [
            table [word!]
            port [port!]
            /local spec
        ][
            if none? spec: attempt [port/locals/table/:table] [
                throw-error [type: 'sql id: 'not-found arg1: "Table" arg2: table]
            ]
        spec: select spec to-set-word 'schema
            select spec to-set-word 'cols
        ]

; ----------------------
; get-cols-name function
; ----------------------

    get-cols-name: func [
        table [word!]
        port [port!]
        /local result
    ][
        result: copy* []
        foreach item get-cols table port [
        append result either block? item [ first item ][ item ]
        ]
        result
    ]

; -----------------
; get-data function
; -----------------

        get-data: func [
            table [word!]
            port [port!]
            /new
            /locals spec data
        ][
            if none? spec: attempt [port/locals/table/:table] [
                throw-error [type: 'sql id: 'not-found arg1: "Table" arg2: table]
            ]
            spec: compose [
                (spec)
                path: (port/path)
            ]
            if none? data: attempt [port/locals/data/:table] [
                port/locals/data: make port/locals/data compose [
                    (to-set-word table) either new [data: open*/new spec][data: open* spec]
                ]
            ]
        data
        ]

; ----------------
; get-url function
; ----------------

        get-url: func [
            table [word!]
            port [port!]
            /local spec word
        ][
            if none? spec: attempt [port/locals/table/:table] [
                throw-error [type: 'sql id: 'not-found arg1: "Table" arg2: table]
            ]
            spec: context spec
            to-url rejoin [spec/scheme ":" port/path spec/target]
        ]

; --------------------
; load-schema function
; --------------------

        load-schema: func [
            port [port!]
            /local file table spec item cols name value
        ][
            either port/target = %schema.ini [
                file: open/lines rejoin [port/path port/target]
                table: copy* []
            forall file [
                parse/all first file [
                    "[" copy name to "]" to end (
                        name: trim name
                        append table compose/only [
                            (to-set-word name) (spec: compose/only [
                                target: (to-file name)
                                schema: (item: compose/only [cols: (cols: copy* [])])
                            ])
                        ]
                    )
                |
                    "ColNameHeader=" copy value to end (
                        append item compose/only [
                            ColNameHeader: (do value)
                        ]
                    )
                |
                    "Format=Delimited(" copy value to ")" to end (
                        append spec compose [scheme: 'CSV]
                        append item compose/only [
                            Format: "Delimited"
                            Delimiter: (value)
                        ]
                    )
                |
                    "Format=" copy value to end (
                                    value: trim value
                        append spec compose [scheme: (select ["CSVDelimited" 'CSV "TabDelimited" 'CSV "FixedLength" 'FEXED] value)]
                        append item compose [
                            Format: (value)
                            Delimiter: (select ["CSVDelimited" "," "TabDelimited" "^-" "FixedLength" ""] value)
                        ]
                    )
                |
                    "Col" to "=" skip copy name to " " skip copy type to " width " " width " copy length to end (
                        insert*/only tail cols compose [
                            (to-word name) (to-word type) (to-integer length)
                        ]
                    )
                |
                    "Col" to "=" skip copy name to " " skip copy type to end (
                        insert*/only tail  cols compose [
                            (to-word name) (to-word type)
                        ]
                    )
                |
                    copy name to "=" skip copy value to end (
                        append item compose/only [
                            (to-set-word trim name) (value)
                        ]
                    )
                ]
            ]
                close file
                port/locals/table: context table
            ][
                port/locals/table: context load rejoin [port/path port/target]
            ]

        ]

; --------------------
; save-schema function
; --------------------

        save-schema: func [
            port [port!]
            /local file index schema
        ][
            either port/target = %schema.ini [
                file: open*/new/lines rejoin [port/path port/target]
                foreach [table spec] third port/locals/table [
                    append file rejoin ["[" to-word table "]"]
                    schema: third make sql-text select spec to-set-word 'schema
                    foreach [name value] schema [
                name: lowercase to-string name
                switch/default name [
                            "format" [
                                value: lowercase value
                                either value = "delimited" [
                                    append file rejoin ["format=Delimited(" select schema to-set-word 'delimiter ")"]
                                ][
                                    append file rejoin ["format=" value]
                                ]
                            ]
                            "delimiter" [
                            ]
                            "cols" [
                                index: 0
                                foreach col value [
                                    index: index + 1
                                    either block? col [
                                        append file reform [rejoin ["Col" index "=" col/1] col/2 either col/3 [reform ['width col/3]][""]]
                                    ][
                                        append file reform [rejoin ["Col" index "=" col] 'char 'width 255]
                                    ]
                                ]
                            ]
                        ][
                            append file rejoin ["" name "=" value]
                        ]
                    ]
                ]
                close* file
            ][
                if file? port/target [
                    save rejoin [port/path port/target] third port/locals/table
                ]
            ]
        ]

; ===================================================================
; sql-locals prototype
; ===================================================================

    sql-locals: context [

; Table object
; -------------
        table: context []

; Data object
; -----------
        data: context []
    ]

; ===================================================================
; sql-text prototype
; ===================================================================

    sql-text: context [
        ColNameHeader: True
        Format: "Delimited"
        Delimiter: ";"
        MaxScanRows: 0
        CharacterSet: "OEM"
    ]

; ===================================================================
; SQL Error model
; ===================================================================

    system/error: make system/error [
        sql: context [
            code: 8100
            type: "SQL Error"
            syntax: ["Syntax error" :arg1 "in query expression" :arg2]
            already-exist: [:arg1 :arg2 "already exist"]
            invalid-type: [:arg3 "is an invalid type for" :arg1 :arg2 ]
            not-found: [:arg1 :arg2 "could not be found. Make sur the object exists and that you spell it correctly"]
        ]
    ]

; ===================================================================
; SQL Protocol Handler
; ===================================================================
; This object contains the handler for the SQL protocol.

    context [

; ----------------
; SQL Init handler
; ----------------

        init: func [
            port
            spec [url! block!]
            /local scheme file path target locals
        ][
            net-utils/net-log reduce ["Initializing" mold/only spec "for" to-string port/scheme] 
            either url? spec [
                set [scheme file] parse/all spec ":"
                set [path target] split-path file: to-file file
                if not find target #"." [
                    set [path target] compose [(dirize file)]
                ]
                port/path: clean-path to-rebol-file path
                if none? target [
                    either exists? rejoin [port/path %schema.ini] [
                        target: %schema.ini
                    ][
                        target: %schema.ctl
                    ]
                ]
                port/target: target
                port/url: spec
                port/locals: make sql-locals []
            ][
                spec: context spec 
                if none? locals: attempt [spec/database] [
                    locals: []
                ]
                locals: make sql-locals locals
                if none? path: attempt [spec/path] [
                   path: %.
                ]
                path: dirize to-file path

                port/path: path
                port/target: 'transient
                port/locals: locals
            ]
            if none? port/target [
                net-error reform ["No target file for" port/scheme "is specified"]
            ]
        ]

; ----------------
; SQL Open handler
; ----------------

        open: func [
            port
            /local target file
        ][
            net-utils/net-log reduce ["Opening port for" to-string port/scheme]
            port/status: 'file
            port/state/flags: port/state/flags or system/standard/port-flags/pass-thru
            if file? port/target[
                target: join port/path port/target
                query* file: make port! target
                either file/status [
                    load-schema port
                ][
                    make-dir port/path
                    save-schema port
                ]
            ]
            port/state/inBuffer: copy* []
            port/state/tail: length? port/state/inBuffer
            port
        ]

; -----------------
; SQL Close handler
; -----------------

        close: func [
            port [port!]
        ][
            net-utils/net-log reduce ["Closing port for" to-string port/scheme]
            foreach item second port/locals/data [
                if port? item [
                    close* item
                ]
            ]
            port
        ]

; ------------------
; SQL Update handler
; ------------------

        update: func [
            port [port!]
        ][
            net-utils/net-log reduce ["Updating port for" to-string port/scheme] 
            foreach item next second port/locals/data [
                if port? item [
                    update* item
                ]
            ]
            port
        ]

; ----------------
; SQL Pick handler
; ----------------

        pick: func [
            port [port!]
        ][
            pick* port/state/inBuffer (port/state/index + port/state/num)
        ]

; ----------------
; SQL Copy handler
; ----------------

        copy: func [
            port [port!]
        ][
            net-utils/net-log ["Copy of" port/scheme]
            copy*/part at port/state/inBuffer index? port port/state/num
        ]

; ------------------
; SQL Insert handler
; ------------------

        insert: func [
            port [port!]
            value [string! block!]
            /local result
        ][
            net-utils/net-log ["Insert of " port/state/num "bytes"]
;            port/state/inBuffer: sql-query to-block value port
            port/state/inBuffer: sql-query value port
            port/state/tail: length? port/state/inBuffer
            head port
        ]

; ---------------------
; SQL get-modes handler
; ---------------------
        get-modes: func [
            port [port!]
            modes
        ][
            get-modes* port
        ]

; ---------------------
; SQL set-modes handler
; ---------------------
        set-modes: func [
            port [port!] "An open port spec"
            modes
        ][
            set-modes* port
        ]

; -------------------------
; SQL Register the protocol
; -------------------------

        net-utils/net-install SQL self none
    ]
]