update contrib/postgresql to 8.1 and code cleanup

contrib/postgresql/libpq.factor

@@ -2,10 +2,12 @@
 
 ! adapted from libpq-fe.h version 7.4.7
 ! tested on debian linux with postgresql 7.4.7
+! Updated to 8.1
 
 IN: postgresql
 USING: alien ;
 
+
 ! ConnSatusType
 : CONNECTION_OK 					HEX: 0 ; inline
 : CONNECTION_BAD					HEX: 1 ; inline
@@ -47,6 +49,7 @@ USING: alien ;
 : PQERRORS_VERBOSE					HEX: 2 ; inline
 
 
+TYPEDEF: int size_t
 TYPEDEF: int ConnStatusType
 TYPEDEF: int ExecStatusType 
 TYPEDEF: int PostgresPollingStatusType
@@ -55,6 +58,7 @@ TYPEDEF: int PGVerbosity
 
 TYPEDEF: void* PGconn*
 TYPEDEF: void* PGresult*
+TYPEDEF: void* PGcancel*
 TYPEDEF: uint Oid
 TYPEDEF: uint* Oid*
 TYPEDEF: char pqbool
@@ -106,6 +110,12 @@ FUNCTION: PostgresPollingStatusType PQresetPoll ( PGconn* conn ) ;
 ! Synchronous (blocking)
 FUNCTION: void PQreset ( PGconn* conn ) ;
 
+! request a cancel structure
+FUNCTION: PGcancel* PQgetCancel ( PGconn* conn ) ;
+
+! free a cancel structure
+FUNCTION: void PQfreeCancel ( PGcancel* cancel ) ;
+
 ! issue a cancel request
 FUNCTION: int	PQrequestCancel ( PGconn* conn ) ;
 
@@ -122,6 +132,7 @@ FUNCTION: PGTransactionStatusType PQtransactionStatus ( PGconn* conn ) ;
 FUNCTION: char* PQparameterStatus ( PGconn* conn,
 				  char* paramName ) ;
 FUNCTION: int	PQprotocolVersion ( PGconn* conn ) ;
+FUNCTION: int	PQServerVersion ( PGconn* conn ) ;
 FUNCTION: char* PQerrorMessage ( PGconn* conn ) ;
 FUNCTION: int	PQsocket ( PGconn* conn ) ;
 FUNCTION: int	PQbackendPID ( PGconn* conn ) ;
@@ -132,6 +143,8 @@ FUNCTION: int	PQsetClientEncoding ( PGconn* conn, char* encoding ) ;
 ! Get the SSL structure associated with a connection
 FUNCTION: SSL* PQgetssl ( PGconn* conn ) ;
 
+! Tell libpq whether it needs to initialize OpenSSL
+FUNCTION: void PQinitSSL ( int do_init ) ;
 
 ! Set verbosity for PQerrorMessage and PQresultErrorMessage
 FUNCTION: PGVerbosity PQsetErrorVerbosity ( PGconn* conn,
@@ -169,6 +182,9 @@ FUNCTION: PGresult* PQexecParams ( PGconn* conn,
 			 int* paramLengths,
 			 int* paramFormats,
 			 int resultFormat ) ;
+FUNCTION: PGresult* PQprepare ( PGconn* conn, char* stmtName,
+        char* query, int nParams,
+        Oid* paramTypes ) ;
 FUNCTION: PGresult* PQexecPrepared ( PGconn* conn,
 			 char* stmtName,
 			 int nParams,
@@ -187,6 +203,9 @@ FUNCTION: int PQsendQueryParams ( PGconn* conn,
 				  int* paramLengths,
 				  int* paramFormats,
 				  int resultFormat ) ;
+FUNCTION: PGresult* PQsendPrepare ( PGconn* conn, char* stmtName,
+            char* query, int nParams,
+            Oid* paramTypes ) ;
 FUNCTION: int PQsendQueryPrepared ( PGconn* conn,
 				  char* stmtName,
 				  int nParams,
@@ -275,11 +294,18 @@ FUNCTION: void PQfreemem ( void* ptr ) ;
 FUNCTION: PGresult* PQmakeEmptyPGresult ( PGconn* conn, ExecStatusType status ) ;
 
 ! Quoting strings before inclusion in queries.
+FUNCTION: size_t PQescapeStringConn ( PGconn* conn,
+                                    char* to, char* from, size_t length,
+                                    int* error ) ;
+FUNCTION: uchar* PQescapeByteaConn ( PGconn* conn,
+                                    char* from, size_t length,
+                                    size_t* to_length ) ;
+FUNCTION: uchar* PQunescapeBytea ( uchar* strtext,
+                size_t* retbuflen ) ;
+! These forms are deprecated!
 FUNCTION: size_t PQescapeString ( char* to, char* from, size_t length ) ;
 FUNCTION: uchar* PQescapeBytea ( uchar* bintext, size_t binlen,
 			  size_t* bytealen ) ;
-FUNCTION: uchar* PQunescapeBytea ( uchar* strtext,
-				size_t* retbuflen ) ;
 
 ! === in fe-print.c ===
 
@@ -308,6 +334,7 @@ FUNCTION: int	lo_read ( PGconn* conn, int fd, char* buf, size_t len ) ;
 FUNCTION: int	lo_write ( PGconn* conn, int fd, char* buf, size_t len ) ;
 FUNCTION: int	lo_lseek ( PGconn* conn, int fd, int offset, int whence ) ;
 FUNCTION: Oid	lo_creat ( PGconn* conn, int mode ) ;
+FUNCTION: Oid	lo_creat ( PGconn* conn, Oid lobjId ) ;
 FUNCTION: int	lo_tell ( PGconn* conn, int fd ) ;
 FUNCTION: int	lo_unlink ( PGconn* conn, Oid lobjId ) ;
 FUNCTION: Oid	lo_import ( PGconn* conn, char* filename ) ;
@@ -318,6 +345,9 @@ FUNCTION: int	lo_export ( PGconn* conn, Oid lobjId, char* filename ) ;
 ! Determine length of multibyte encoded char at *s
 FUNCTION: int	PQmblen ( uchar* s, int encoding ) ;
 
+! Determine display length of multibyte encoded char at *s
+FUNCTION: int	PQdsplen ( uchar* s, int encoding ) ;
+
 ! Get encoding id from environment variable PGCLIENTENCODING
 FUNCTION: int	PQenv2encoding ( ) ;
 

contrib/postgresql/load.factor

@@ -1,3 +1,8 @@
 PROVIDE: contrib/postgresql
-{ +files+ { "libpq.factor" "postgresql.factor" } }
+{ +files+ {
-{ +tests+ { "postgresql-test.factor" } } ;
+    "libpq.factor"
+    "postgresql.factor"
+} }
+{ +tests+ {
+    "postgresql-test.factor"
+} } ;

contrib/postgresql/postgresql-test.factor

@@ -4,19 +4,27 @@
 IN: postgresql-test
 USING: kernel postgresql alien errors io prettyprint sequences namespaces ;
 
+
+: test-connection ( host port pgopts pgtty db user pass -- bool )
+    [ [ ] with-postgres ] catch "Error connecting!" "Connected!" ? print ;
+
 ! just a basic demo
-: run-test ( host str str str db user pass -- )
+
-    [
+"localhost" "" "" "" "test" "postgres" "" [
     "drop table animal" do-command
 
     "create table animal (id serial not null primary key, species varchar(256), name varchar(256), age integer)" do-command
-	    "insert into animal (species, name, age) values ('lion', 'Mufasa', 5)" do-command
+    "insert into animal (species, name, age) values ('lion', 'Mufasa', 5)"
+    do-command
+
     "select * from animal where name = 'Mufasa'" [ ] do-query
     "select * from animal where name = 'Mufasa'"
     [
         result>seq length 1 = [ "...there can only be one Mufasa..." throw ] unless
     ] do-query
-	    "insert into animal (species, name, age) values ('lion', 'Simba', 1)" do-command
+
+    "insert into animal (species, name, age) values ('lion', 'Simba', 1)"
+    do-command
 
     "select * from animal" 
     [
@@ -29,5 +37,5 @@ USING: kernel postgresql alien errors io prettyprint sequences namespaces ;
     ! [ ] do-query ] catch [ "caught: " write print ] when*
     ! "select asdf from animal" [ ] do-query 
     ! "aofijweafew" do-command
-    ] with-postgres-catch ;
+] with-postgres-catch
 

contrib/postgresql/postgresql.factor

@@ -5,25 +5,23 @@
 
 IN: postgresql
 USING: kernel alien errors io prettyprint sequences namespaces arrays math ;
-SYMBOL: postgres-conn
+
+SYMBOL: db
 SYMBOL: query-res
 
 : connect-postgres ( host port pgopts pgtty db user pass -- conn )
     PQsetdbLogin
-    dup PQstatus 0 = [ "couldn't connect to database" throw ] unless ;
+    dup PQstatus zero? [ "couldn't connect to database" throw ] unless ;
 
 : with-postgres ( host port pgopts pgtty db user pass quot -- )
-    [ >r connect-postgres postgres-conn set r>
+    [ >r connect-postgres db set r>
-    [ postgres-conn get PQfinish ] cleanup ] with-scope ; inline
+    [ db get PQfinish ] cleanup ] with-scope ; inline
 
 : with-postgres-catch ( host port pgopts pgtty db user pass quot -- )
     [ with-postgres ] catch [ "caught: " write print ] when* ;
 
-: test-connection ( host port pgopts pgtty db user pass -- bool )
-    [ [ ] with-postgres ] catch "Error connecting!" "Connected!" ? print ;
-
 : postgres-error ( ret -- ret )
-    dup 0 = [ PQresultErrorMessage throw ] when ;
+    dup zero? [ PQresultErrorMessage throw ] when ;
 
 : (do-query) ( PGconn query -- PGresult* )
     ! For queries that do not return rows, PQexec() returns PGRES_COMMAND_OK
@@ -45,17 +43,19 @@ SYMBOL: query-res
     ] when* drop ;
 
 : do-command ( str -- )
-    unit \ (do-command) add postgres-conn get swap call ;
+    unit \ (do-command) add db get swap call ;
 
-: prepare ( str quot word -- quot )
+: prepare ( str quot word -- conn quot )
-    rot unit swap append swap append postgres-conn get swap ;
+    rot unit swap append swap append db get swap ;
 
 : do-query ( str quot -- )
-    [ (do-query) query-res set ] prepare catch [ rethrow ] [ query-res get PQclear ] if* ;
+    [ (do-query) query-res set ] prepare catch
+    [ rethrow ] [ query-res get PQclear ] if* ;
 
-: result>seq ( -- )
+: result>seq ( -- seq )
     query-res get [ PQnfields ] keep PQntuples
-    [ [ over [ [ 2dup query-res get -rot PQgetvalue , ] repeat ] { } make , ] repeat ] { } make nip ;
+    [ swap [ query-res get -rot PQgetvalue ] map-with ] map-with ;
 
 : print-table ( seq -- )
-    [ [ "\t" append write ] each "\n" write ] each ;
+    [ [ write bl ] each "\n" write ] each ;
+