REBOL [ Title: "techfell uSqlite3 protocol handler" Purpose: { http://users.iol.it/irwin/ uSQLite is a network wrapper for SQLite. It turns SQLite into an RDBMS but puts the emphasis on the 'Lite'. In fact it works in a somewhat unconventional mmanner in order to make both servers and clients as light, portable and simple as possible. Readers who are not familiar with SQLite are advised to visit www.sqlite.org. uSQLite uses the TechFell protocol for communications between clients and servers. } Comment: "based on mysql-protocol 1.0.2 by Nenad Rakocevic / SOFTINNOV" Author: "Piotr Gapinski" Email: {news [at] rowery! olsztyn.pl} File: %techfell-protocol.r Date: 2006-02-9 Version: 0.0.2 Copyright: "Olsztynska Strona Rowerowa http://www.rowery.olsztyn.pl/" License: "GNU General Public License (GPL)" History: [0.0.1 2006-02-09 0.0.2 2006-02-09] Library: [ level: 'intermediate platform: [Linux Windows] type: [protocol tool] domain: [protocol database] tested-under: [ view 1.3.2 on [Linux WinXP] core 2.6.2 on [Linux WinXP] ] support: none license: 'GPL ] ] make root-protocol [ scheme: 'techfell port-id: 3002 port-flags: system/standard/port-flags/pass-thru linux?: equal? fourth system/version 4 sys-copy: get in system/words 'copy sys-insert: get in system/words 'insert sys-pick: get in system/words 'pick sys-close: get in system/words 'close sys-write: get in system/words 'write net-log: get in net-utils 'net-log numbers: charset "0123456789" num: [some numbers] init: func [port [port!] spec /local scheme args][ if url? spec [net-utils/url-parser/parse-url port spec] port/locals: make object! [ columns: sys-copy [] rows: 0 values: sys-copy [] index: 0 tr: "^C" err: none rc: 0 level: 0 ] scheme: port/scheme port/url: spec if none? port/host [ net-error reform ["No network server for" scheme "is specified"] ] if none? port/port-id [ net-error reform ["No port address for" scheme "is specified"] ] if none? port/user [port/user: make string! 0] if none? port/pass [port/pass: make string! 0] if port/pass = "?" [port/pass: ask/hide "Password: "] ] open: func [port [port!] /local level][ open-proto port port/sub-port/timeout: 4 port/state/inBuffer: make string! 10240 port/state/flags: port/state/flags or port-flags ;; port/sub-port/state/flags: port/sub-port/state/flags or port-flags insert-query/tr port ":PPRAGMA VER" CR insert-query/tr port ":PPRAGMA ETX" CR insert-query port join ":PPRAGMA USER" [" " port/user] insert-query port join ":PPRAGMA PASS" [" " port/pass] if port/locals/rc [ parse/all port/state/inBuffer [(level: none) thru "USELEVEL " copy level num] net-log ["uselevel" level] port/locals/level: to-integer any [level 0] ] port/state/tail: 10 ; for 'pick to work properly ] close: func [port [port!]][ sys-close port/sub-port ] sql-escape: func [value [string!] /local chars no-chars want escaped escape mark] [ chars: charset want: {^(00)^/^-^M^(08)'"\} no-chars: complement chars escaped: ["\0" "\n" "\t" "\r" "\b" "\'" {\"} "\\"] escape: func [value][ mark: sys-insert remove mark sys-pick escaped index? find want value ] parse/all value [any [mark: chars (escape mark/1) :mark | no-chars]] value ] to-sql: func [value /local res] [ switch/default type?/word value [ none! ["NULL"] date! [ rejoin ["'" value/year "-" value/month "-" value/day either value: value/time [ rejoin [" " value/hour ":" value/minute ":" value/second] ][""] "'" ] ] time! [join "'" [value/hour ":" value/minute ":" value/second "'"]] money! [head remove find mold value "$"] string! [join "'" [sql-escape sys-copy value "'"]] binary! [to-sql to string! value] block! [ if empty? value: reduce value [return "(NULL)"] res: append make string! 100 #"(" forall value [repend res [to-sql value/1 #","]] head change back tail res #")" ] ][form value] ] map-rebol-values: func [data [block!] /local args sql mark] [ args: reduce next data sql: sys-copy sys-pick data 1 mark: sql while [found? mark: find mark #"?"][ mark: sys-insert remove mark either tail? args ["NULL"] [to-sql args/1] if not tail? args [args: next args] ] sql ] parse-schema: func [port [port!] /local numbers num headers tr header parts] [ ;numbers: charset "0123456789" ;num: [some numbers] headers: sys-copy [] tr: port/locals/tr parts: [":H" thru " " copy header to tr (append headers any [header ""]) | skip] parse/all port/state/inBuffer [some parts to end] net-log ["found" (length? headers) "columns"] headers ] parse-rows: func [port [port!] columns [integer!] /local numbers num rows tr dat parts here txt there values] [ ;numbers: charset "0123456789" ;num: [some numbers] rows: sys-copy [] tr: port/locals/tr dat: find/tail sys-copy port/state/inBuffer (join ":R" tr) if none? dat [return rows] ;; usun nadmiarowe znaczniki i podziel na linie ;; pamietaj o usunieciu znacznika tr w linii :OK parts: [ here: [":F" copy len num " " copy txt to tr there: (remove/part here there sys-insert here txt) :here] | ["!" there: (remove/part here there sys-insert here "none") :here] | [":OK" tr there: (remove/part here there) :here] | skip ] parse/all dat [some parts to end] values: parse/all dat tr if all [ not empty? values not zero? columns ][ net-log ["found" ((length? values) / columns) "rows" columns "columns per row"] forskip values columns [append/only rows sys-copy/part values columns] ] rows ] err?: func [port [port!] /local eol tr txt] [ eol: charset "^M^C^@^/" ; CR LF ETX ZERO tr: any [ if parse/all port/state/inBuffer [thru ":OK" copy tr eol] [tr] "^C" ] parse/all port/state/inBuffer [(txt: none) thru ":Err " copy txt to tr] port/locals/tr: tr not port/locals/rc: empty? port/locals/err: any [txt ""] ] insert-query: func [port [port!] dat [string!] /tr new-tr /local length buffer] [ dat: join dat either all [value? tr new-tr] [new-tr] [port/locals/tr] clear port/state/inBuffer net-log ["send" dat length? dat] write-io port/sub-port dat length? dat wait port/sub-port buffer: make string! 2048 until [ length: read-io port/sub-port buffer 2048 append port/state/inBuffer buffer clear buffer all [ (length < 2048) none? wait [port/sub-port 0:0:0.05] ] ] net-log ["recv" port/state/inBuffer length? port/state/inBuffer] err? port ] insert: func [[throw] port [port!] data [string! block!] /local columns] [ clear port/state/inBuffer clear port/locals/values port/locals/rows: 0 port/locals/index: 0 ;; execute sql if all [(string? data) (data/1 = #"[")] [data: load data] if empty? data [net-error "No data!"] either block? data [ insert-query port data: map-rebol-values data ][ insert-query port data: replace/all data {"} {'} ] ;; parse output if all [ port/locals/rc found? find port/state/inBuffer join ":R" port/locals/tr ][ port/locals/columns: parse-schema port columns: length? port/locals/columns port/locals/values: parse-rows port columns port/locals/rows: length? port/locals/values ] port/locals/rc ] read-rows: func [port [port!] /part n [integer!] /local values] [ if any [ not port/locals/rc ;; error empty? port/locals/values ;; no sql output ][ return [] ] values: skip port/locals/values port/locals/index either all [value? 'part n] [sys-copy/part values n] [sys-copy values] ] copy: func [port /part data [number! binary!] /local rows][ rows: either all [value? 'part part] [read-rows/part port data] [read-rows port] net-log ["copy" (length? rows) "rows" "at" "index" port/locals/index] port/locals/index: port/locals/index + length? rows rows ] pick: func [port [port!] data][ either any [none? data data = 1] [copy/part port 1] [none] ] net-utils/net-install :scheme self :port-id ] comment { ; example db: open techfell://user:?@localhost insert db "CREATE TABLE t1 (a int, b text, c text)" repeat i 25 [ insert db [{INSERT INTO t1 VALUES (?, ?, ?)} i (join "cool" i) (join "cool" (25 + 1 - i))] ] insert db "SELECT * FROM t1" probe db/locals/columns res: copy/part db 10 probe res probe length? res insert db "DROP TABLE t1" close db halt }