[REBOL] Re: PostgreSQL 2 Rebol and back again...
From: emptyhead::home::nl at: 7-Dec-2000 11:21
PostgreSQL also has an tcp/ip interface, an it is free and has more options than
mysql and is distrubuted with redhat. I saw some database tests where PostgreSQL
outperforms most databases.
I managed to login into the database using rebol connecting to the tcp/ip port.
The only problem is that when sending an query the protocol doesn't seem to
match the implementation. The documentation of the protocol is on their website:
http://www.postgresql.org/
Could someone find out what goes wrong. I can not find the problem.
Daan Oosterveld
CRS - Psy Sel/SPO, COUSSEMENT Christophe, CPN
schreef:
> Jeff:
>
> Just ask Bo at RT for a trial version: [bo--rebol--com]
> You will get it in no time, with the documentation about it!
> They are very helpful at RT.
>
> I personally use command for shell and MS SQL Server through odbc... with no
> problem until now.
>
> good luck
>
> Christophe
-- Attached file included as plaintext by Listar --
-- File: postgres.r
REBOL [
Title: "PostgreSQL frontend client"
Author: "Daan Oosterveld"
Date: now
Version: 0.0.1
Notes: {
This client can be used on the localhost...
It does not supply any password authorisation
of any kind at this moment...
Standart host is localhost:5432 other connections
can be set by using /host
}
Usage: {
Quick information: >> postgres/help
database: postgres/startup
user (string!)
database (string!)
[/host
tcp://host.domain:port (url)
]
result: postgres/query database {query}
postgres/terminate database
}
]
postgres: make object! [
; all postgres user functions:
startup: func [
{Make a connection to a postgreSQL database}
user [string!] {User indentification}
database [string!] {Database to connect}
/host {Use a custom host}
address [url!] {postgreSQL TCP/IP server to connect}
/throw {Throw "postgres" instead of creating errors}
name {name to throw, none is no name...}
/debug {Print logs direct on screen}
/local
database
][
either debug [
database: make-database/debug database user
][
database: make-database database user
]
database/throw: throw
open-database-connection database tcp://localhost:5432
send-packet/StartupPacket database database/name database/user "" ""
; Handles startup cycle
recieve-packet/startup-cycle database
; If no errors where triggered we should be logged in
; and be able to run a query!
database
]
query: func [
{Queries a connected database}
database [object!] {database to query (returned by startup)}
query [string!] {SQL query}
/throw {Throws "postgres" instead of creating errors}
name {A named throw, none to disable}
][
database/throw: throw
send-packet/Query database query
return recieve-packet/Query-cycle database
]
terminate: func [
{Terminates a database connection}
database [object!] {Database to terminate}
][
send-packet/terminate database
close database/host
add-log database 'connection
{Frontend: Closed connection}
]
log: func [
{Returns notice and error log, great for debuging}
database [object!] {Database to get log from}
][
foreach [type entry] database/log [
print entry
]
]
;------------------------------------------------
; Do not use any functions below this comment...
;------------------------------------------------
; Notivy me (by email) when...
; - You found a bug
; - You have a suggestion
; - You changed the code to suit your implementation
; (you shouldn't do this, but if you do: add an author,
; and also change the version and date.)
; - You bugfixed untested parts
add-log: func [database type log-entry][
append database/log reduce [type log-entry]
if database/trace [print log-entry]
]
issue-error-log: func [database error][
add-log database 'error error
either database/throw [
throw/name error "postgres"
][
make error! error
]
]
; function to make a database object...
make-database: func [
the-name [string!]
the-user [string!]
/debug
][
make object! [
host: none ; port to use
log: make block! 10 ; connection log
name: the-name ; database name
user: the-user ; user login name
pid: none
key: none
trace: debug
throw: false
]
]
open-database-connection: func [database host][
database/host: open/binary host
add-log database 'connection "Frontend: Opened connection"
]
; functions to recieve packets...
recieve-packet: make object! [
; packetlist: Startup Query Status
; AsciiRow x T
; AuthenticationOk x C
; AuthenticationKerberosV4 x X
; AuthenticationKerberosV5 x X
; AuthenticationUnencryptedPassword x T
; AuthenticationEncryptedPassword x X
; BackendKeyData x C
; BinaryRow x T
; CompletedResponse x T
; CopyDataRows x T
; CopyInResponse x T
; CopyOutResponse x T
; CursorResponse x T
; EmptyQueryResponse x T
; ErrorResponse x x U
; FunctionResultResponse N
; FunctionVoidResponse N
; NoticeResponse x x U
; NotificationResponse x T
; ReadyForQuery x x C
; RowDiscription x T
;
; Status:
; (T)odo, should be implemented in the near future
; (C)ompleted,
; (U)ntested, might be bugs in it, never used before
; (B)uggy,
; (N)ot implemented
; (X) terminates connection after unsupported packet...
; Note: The function cycle is not implemented in this release
; function to recieve data after sending a query
query-cycle: func [database /local result][
result: make block! 10
until [
;print "LOOP!"
switch/default recieve-value/byte database 1 [
"G" [ CopyInResponse database false ]
"H" [ insert/only tail result CopyOutResponse database false ]
"P" [ CursorResponse database ]
"N" [ NoticeResponse database ]
"I" [ EmptyQueryResponse database ]
; Completed SQL statement:
"C" [ CompleteResponse database false ]
; Exit packets
"E" [ ErrorResponse database ]
"Z" [ ReadyForQuery database ]
][
add-log database 'unknown
{Frontend: Warning: recieved unknown packet}
false
]
]
result
]
; function to recieve packets from the startup cycle
startup-cycle: func [database][
; First we have to wait for a AuthorisationOk or other less pleasant
; response...
until [
switch/default recieve-value/byte database 1 [
"N" [ NoticeResponse database ]
"E" [ ErrorResponse ]
"R" [
switch/default to-integer recieve-value/int/b32 database [
0 [
add-log database 'startup
{Backend: AuthenticationOK}
return true
]
1 [ KerberosV4 database ]
2 [ KerberosV5 database ]
3 [ UnencryptedPassword database ]
4 [ EncryptedPassword database ]
][
add-log database 'unknown
{Frontend: Warning: Recieved unknown packet}
false
]
]
][
add-log database 'unknown
{Frontend: Warning: Recieved unknown packet}
false
]
]
; The until is not needed, because no authentication
; loops more times, just implemented it already for future
; implementation
; AuthenticationOk recieved!, entering the backend startup loop
until [
switch/default recieve-value/byte database 1 [
"K" [ BackendKeyData database ]
"Z" [ ReadyForQuery database ]
"N" [ NoticeResponse database ]
"E" [
; ErrorResponse
issue-error-log database rejoin [
"Backend: Error: " recieve-value/string database
]
]
][
issue-error-log database
{Frontend: Error: Recieved unsupported packet}
]
]
; The database is now ready for SQL queries...
return database
]
; The packet-handlers follow:
; ErrorResponse
ErrorResponse: func [database][
issue-error-log database
recieve-value/string database
]
; Unsupported password authentications
KerberosV4:
KerberosV5:
UnencryptedPassword:
EncryptedPassword: func [database][
send-packet/Terminate database
issue-error-log database
{Frontend: Error: Unsupported authentication protocol}
]
; Notice packet... just a message for the log
NoticeResponse: func [database][
add-log database 'notice rejoin [
"Backend: Notice: "
recieve-value/string database
]
false
]
; Copy from frontend to backend... Not supported...
CopyInResponse: func [database][
issue-error-log database
{Frontend: Error: CopyInResponse not supported.}
]
CopyOutResponse: func [database][
add-log database 'query
{Backend: CopyOutResponse, sending datarows...}
CopyDataRows database
]
; Copies a stream of datarows...
CopyDataRows: func [database /local result temp][
add-log database 'query
{Backend: Sending datarows}
result: make string! 100
append result recieve-value/byte database 4
until [
append result recieve/byte database 1
(found? find/match skip tail result -4 "^/\.^/")
]
result
]
; SQL result is commin' in...
CursorResponse: func [database][
add-log database 'query rejoin [
{Backend: Cursor: [ }
mold recieve-value/string database
{ ]}
]
false
]
; Completed SQL statement:
CompleteResponse: func [database][
add-log database 'query rejoin [
{Backend: Completed query: [ }
mold recieve-value/string database
{ ] }
]
false
]
; EmptyQueryResponse...(who would send one?)
EmptyQueryResponse: func [database][
recieve-value/string database
add-log database 'query
{Backend: Empty query!}
false
]
; Indicates that a new query starts or the startup stops
ReadyForQuery: func [database][
add-log database 'ready {Backend: Ready for query}
; this packet has no more data then the header...
true ; stop looping
]
; Magic key data to cancel a request...
BackendKeyData: func [database][
; The backend has suceeded to startup...
database/pid: recieve-value/int/b32 database
database/key: recieve-value/int/b32 database
add-log database 'startup rejoin [
{Backend: Backend key data: [ pid: } database/pid
{ key: } database/key { ] }
]
false ; still have to wait for ReadyForQuery...
]
; recives values from the database
recieve-value: make object! [
; Get a byte value...
byte: func [database length][
to-string copy/part database/host length
]
string: func [database /local string temp][
string: make string! 32
while[ (temp: copy/part database/host 1) <> #{00} ][
append string temp
]
probe string
]
lim-string: func [database length][
trim/with to-string copy/part database/host length "^@"
]
int: make object! [
b16: func [database][ copy/part database/host 2 ]
b32: func [database][ copy/part database/host 4 ]
]
]
]
; functions to send frontend packets..
send-packet: make object! [
; Packet list: Startup Query Status
; CancelRequest x N
; CopyDataRows x T
; EncryptedPasswordPacket x N
; FunctionCall x N
; Query x T
; StartupPacket x C
; Terminate x C
; UnencryptedPasswordPacket x T
;
; Status:
; (T)odo, should be implemented in the near future
; (C)ompleted,
; (U)ntested, might be bugs in it, never used before
; (B)uggy,
; (N)ot implemented
; (X) terminates connection after unsupported packet...
; Note: The function cycle is not implemented in this release
; The query packet...
; The queries should end with an ; !
Query: func [ database q ][
;send-value/byte database "Q"
send-value/string database q
add-log database 'query "Frontend: Query: Sended SQL query"
]
; The startup packet is one of the most important
; packets, it initialises a database connection and
; it is the first packet to be sended over a new connection
StartupPacket: func [
database
database-name
user-name
backend-commandline
tty-debug-messages
][
; length of packet (296)
send-value/int/b32 database #{000000C4}
; version 2.0 int16(2).int16(0)
send-value/int/b32 database #{00020000}
; Send database name
send-value/lim-string database database-name 64
; Send user name
send-value/lim-string database user-name 32
; Send backend command arguments
send-value/lim-string database backend-commandline 64
; Unused
send-value/lim-string database "" 64
; tty backend debug messages
send-value/lim-string database tty-debug-messages 64
add-log database 'packet rejoin [
{Frontend: Startup packet: [}
{ protocol: 2.0}
{ database: } mold database-name
{ user: } mold user-name { ] }
]
]
; Terminate connection with backend after ReayForQuery
Terminate: func [database][
add-log database 'terminate "Frontend: Terminate"
send-value/byte database "X"
]
; Used to send elements of a message
; These functions should only be used by packet senders...
send-value: make object! [
; Value list:
; Intn(i) n integer i (32/64)
; String(v) send a normal C-string (NullTerminated)
; LimStringn(v) string limited to a size n (NullTerm)
; Byten(v) send n bytes (characters)
;
int: func [database /b16 /b32 value ][
either b16 [
insert/part database/host value 2
][
; standart is int32(v)
insert/part database/host value 4
]
]
string: func [ database value ][
;print query database/host
insert probe database/host probe join to-binary value #{00}
;insert database/host #{00}
]
lim-string: func [ database value bytes ][
insert database/host
to-binary value
insert/dup database/host #{00} (bytes - length? value)
]
byte: func [ database value ][
insert database/host to-binary value
]
]
]
]
trace/net on
db: postgres/startup/debug "daan" "compactdiskshop"
postgres/query db "QCREATE TABLE compactdisks (NAME CHARACTER(40));^/"
postgres/terminate db
postgres/log db