fix a bug in sqlite

add execute-statment-row-id to db
some work on postgresql

extra/db/db.factor

@@ -15,7 +15,8 @@ TUPLE: db handle insert-statements update-statements delete-statements select-st
 GENERIC: db-open ( db -- )
 HOOK: db-close db ( handle -- )
 
-: dispose-statements [ dispose drop ] assoc-each ;
+: dispose-statements ( seq -- )
+    [ dispose drop ] assoc-each ;
 
 : dispose-db ( db -- ) 
     dup db [
@@ -35,7 +36,13 @@ HOOK: <prepared-statement> db ( str -- statement )
 GENERIC: prepare-statement ( statement -- )
 GENERIC: bind-statement* ( obj statement -- )
 GENERIC: reset-statement ( statement -- )
-GENERIC: execute-statement ( statement -- )
+GENERIC: execute-statement* ( statement -- result-set )
+HOOK: last-id db ( res -- id )
+: execute-statement ( statement -- )
+    execute-statement* dispose ;
+
+: execute-statement-last-id ( statement -- id )
+    execute-statement* [ last-id ] with-disposal ;
 
 : bind-statement ( obj statement -- )
     dup statement-bound? [ dup reset-statement ] when
@@ -51,8 +58,6 @@ GENERIC: #columns ( result-set -- n )
 GENERIC# row-column 1 ( result-set n -- obj )
 GENERIC: advance-row ( result-set -- ? )
 
-HOOK: last-id db ( -- id )
-
 : init-result-set ( result-set -- )
     dup #rows over set-result-set-max
     -1 swap set-result-set-n ;

extra/db/postgresql/ffi/ffi.factor

@@ -50,6 +50,8 @@ IN: db.postgresql.ffi
 : PQERRORS_DEFAULT                  HEX: 1 ; inline
 : PQERRORS_VERBOSE                  HEX: 2 ; inline
 
+: InvalidOid 0 ; inline
+
 TYPEDEF: int size_t
 TYPEDEF: int ConnStatusType
 TYPEDEF: int ExecStatusType 

extra/db/postgresql/lib/lib.factor

@@ -37,8 +37,13 @@ IN: db.postgresql.lib
     >r db get db-handle r>
     [ statement-sql ] keep
     [ statement-params length f ] keep
-    statement-params [ malloc-char-string ] map >c-void*-array
+    statement-params [ second malloc-char-string ] map >c-void*-array
     f f 0 PQexecParams
     dup postgresql-result-ok? [
         dup postgresql-result-error-message swap PQclear throw
     ] unless ;
+
+: pq-oid-value ( res -- n )
+    PQoidValue dup InvalidOid = [
+        "postgresql returned an InvalidOid" throw
+    ] when ;

extra/db/postgresql/postgresql.factor

@@ -1,8 +1,9 @@
 ! Copyright (C) 2007, 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs alien alien.syntax continuations io
-kernel math namespaces prettyprint quotations
+kernel math math.parser namespaces prettyprint quotations
-sequences debugger db db.postgresql.lib db.postgresql.ffi ;
+sequences debugger db db.postgresql.lib db.postgresql.ffi
+db.tuples db.types ;
 IN: db.postgresql
 
 TUPLE: postgresql-db host port pgopts pgtty db user pass ;
@@ -51,8 +52,8 @@ M: postgresql-result-set #columns ( result-set -- n )
 M: postgresql-result-set row-column ( result-set n -- obj )
     >r dup result-set-handle swap result-set-n r> PQgetvalue ;
 
-M: postgresql-statement execute-statement ( statement -- )
+M: postgresql-statement execute-statement* ( statement -- obj )
-    query-results dispose ;
+    query-results ;
 
 : increment-n ( result-set -- n )
     dup result-set-n 1+ dup rot set-result-set-n ;
@@ -103,3 +104,103 @@ M: postgresql-db commit-transaction ( -- )
 
 M: postgresql-db rollback-transaction ( -- )
     "ROLLBACK" sql-command ;
+
+
+M: postgresql-db create-sql ( columns table -- sql )
+    [
+        "create table " % %
+        " (" % [ ", " % ] [
+            dup second % " " %
+            dup third >sql-type % " " %
+            sql-modifiers " " join %
+        ] interleave ")" %
+    ] "" make ;
+
+M: postgresql-db drop-sql ( table -- sql )
+    [
+        "drop table " % %
+    ] "" make ;
+
+SYMBOL: postgresql-counter
+
+M: postgresql-db insert-sql* ( columns table -- sql )
+    [
+        postgresql-counter off
+        "insert into " %
+        %
+        "(" %
+        dup [ ", " % ] [ second % ] interleave
+        ") " %
+        " values (" %
+        [ ", " % ] [
+            drop "$" % postgresql-counter [ inc ] keep get #
+        ] interleave
+        ")" %
+    ] "" make ;
+
+M: postgresql-db update-sql* ( columns table -- sql )
+    [
+        "update " %
+        %
+        " set " %
+        dup remove-id
+        [ ", " % ] [ second dup % " = :" % % ] interleave
+        " where " %
+        [ primary-key? ] find nip second dup % " = :" % %
+    ] "" make ;
+
+M: postgresql-db delete-sql* ( columns table -- sql )
+    [
+        "delete from " %
+        %
+        " where " %
+        first second dup % " = :" % %
+    ] "" make ;
+
+M: postgresql-db select-sql* ( columns table -- sql )
+    drop ;
+
+M: postgresql-db tuple>params ( columns tuple -- obj )
+    [
+        >r dup first r> get-slot-named swap third
+    ] curry { } map>assoc ;
+    
+M: postgresql-db last-id ( res -- id )
+    pq-oid-value ;
+
+: postgresql-db-modifiers ( -- hashtable )
+    H{
+        { +native-id+ "primary key" }
+        { +assigned-id+ "primary key" }
+        { +autoincrement+ "autoincrement" }
+        { +unique+ "unique" }
+        { +default+ "default" }
+        { +null+ "null" }
+        { +not-null+ "not null" }
+    } ;
+
+M: postgresql-db sql-modifiers* ( modifiers -- str )
+    postgresql-db-modifiers swap [
+        dup array? [
+            first2
+            >r swap at r> number>string*
+            " " swap 3append
+        ] [
+            swap at
+        ] if
+    ] with map [ ] subset ;
+
+: postgresql-type-hash ( -- assoc )
+    H{
+        { INTEGER "integer" }
+        { TEXT "text" }
+        { VARCHAR "text" }
+        { DOUBLE "real" }
+    } ;
+
+M: postgresql-db >sql-type ( obj -- str )
+    dup pair? [
+        first >sql-type
+    ] [
+        postgresql-type-hash at* [ T{ no-sql-type } throw ] unless
+    ] if ;

extra/db/sqlite/ffi/ffi.factor

@@ -108,7 +108,7 @@ LIBRARY: sqlite
 FUNCTION: int sqlite3_open ( char* filename, void* ppDb ) ;
 FUNCTION: int sqlite3_close ( sqlite3* pDb ) ;
 FUNCTION: char* sqlite3_errmsg ( sqlite3* pDb ) ;
-FUNCTION: int sqlite3_prepare_v2 ( sqlite3* pDb, char* zSql, int nBytes, void* ppStmt, void* pzTail ) ;
+FUNCTION: int sqlite3_prepare ( sqlite3* pDb, char* zSql, int nBytes, void* ppStmt, void* pzTail ) ;
 FUNCTION: int sqlite3_finalize ( sqlite3_stmt* pStmt ) ;
 FUNCTION: int sqlite3_reset ( sqlite3_stmt* pStmt ) ;
 FUNCTION: int sqlite3_step ( sqlite3_stmt* pStmt ) ;

extra/db/sqlite/lib/lib.factor

@@ -30,7 +30,7 @@ IN: db.sqlite.lib
 
 : sqlite-prepare ( db sql -- handle )
     dup length "void*" <c-object> "void*" <c-object>
-    [ sqlite3_prepare_v2 sqlite-check-result ] 2keep
+    [ sqlite3_prepare sqlite-check-result ] 2keep
     drop *void* ;
 
 : sqlite-bind-parameter-index ( handle name -- index )

extra/db/sqlite/sqlite.factor

@@ -25,7 +25,7 @@ M: sqlite-db dispose ( db -- ) dispose-db ;
 TUPLE: sqlite-statement ;
 C: <sqlite-statement> sqlite-statement
 
-TUPLE: sqlite-result-set ;
+TUPLE: sqlite-result-set advanced? ;
 : <sqlite-result-set> ( query -- sqlite-result-set )
     dup statement-handle sqlite-result-set <result-set> ;
 
@@ -40,7 +40,13 @@ M: sqlite-db <prepared-statement> ( str -- obj )
 M: sqlite-statement dispose ( statement -- )
     statement-handle sqlite-finalize ;
 
+: maybe-advance-row ( result-set -- result-set )
+    dup sqlite-result-set-advanced? [
+        dup advance-row drop
+    ] unless ;
+
 M: sqlite-result-set dispose ( result-set -- )
+    maybe-advance-row
     f swap set-result-set-handle ;
 
 : sqlite-bind ( triples handle -- )
@@ -52,8 +58,8 @@ M: sqlite-statement bind-statement* ( triples statement -- )
 M: sqlite-statement reset-statement ( statement -- )
     statement-handle sqlite-reset ;
 
-M: sqlite-statement execute-statement ( statement -- )
+M: sqlite-statement execute-statement* ( statement -- obj )
-    statement-handle sqlite-next drop ;
+    query-results ;
 
 M: sqlite-result-set #columns ( result-set -- n )
     result-set-handle sqlite-#columns ;
@@ -62,7 +68,8 @@ M: sqlite-result-set row-column ( result-set n -- obj )
     >r result-set-handle r> sqlite-column ;
 
 M: sqlite-result-set advance-row ( result-set -- handle ? )
-    result-set-handle sqlite-next ;
+    [ result-set-handle sqlite-next ] keep
+    t swap set-sqlite-result-set-advanced? ;
 
 M: sqlite-statement query-results ( query -- result-set )
     dup statement-handle sqlite-result-set <result-set> ;
@@ -138,9 +145,10 @@ M: sqlite-db tuple>params ( columns tuple -- obj )
         third 3array
     ] curry map ;
     
-M: sqlite-db last-id ( -- id )
+M: sqlite-db last-id ( result-set -- id )
-    db get db-handle sqlite3_last_insert_rowid ;
+    maybe-advance-row drop
-
+    db get db-handle sqlite3_last_insert_rowid
+    dup zero? [ "last-id failed" throw ] when ;
 
 : sqlite-db-modifiers ( -- hashtable )
     H{

extra/db/tuples/tuples-tests.factor

@@ -1,11 +1,12 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io.files kernel tools.test db db.sqlite db.tuples
-db.types continuations namespaces ;
+db.types continuations namespaces db.postgresql math
+tools.time ;
 IN: temporary
 
 TUPLE: person the-id the-name the-number real ;
-: <person> ( name age -- person )
+: <person> ( name age real -- person )
     {
         set-person-the-name
         set-person-the-number
@@ -36,10 +37,10 @@ SYMBOL: the-person
         test-tuples
     ] with-db ;
 
-! : test-postgres ( -- )
+: test-postgresql ( -- )
-    ! resource-path <postgresql-db> [
+    "localhost" "postgres" "" "factor-test" <postgresql-db> [
-        ! test-tuples
+        test-tuples
-    ! ] with-db ;
+    ] with-db ;
 
 person "PERSON"
 {
@@ -52,7 +53,7 @@ person "PERSON"
 "billy" 10 3.14 <person> the-person set
 
 test-sqlite
-! test-postgres
+! test-postgresql
 
 person "PERSON"
 {
@@ -65,4 +66,4 @@ person "PERSON"
 1 "billy" 20 6.28 <assigned-person> the-person set
 
 test-sqlite
-! test-postgres
+! test-postgresql

extra/db/tuples/tuples.factor

@@ -64,9 +64,12 @@ HOOK: tuple>params db ( columns tuple -- obj )
     2dup . .
     [ bind-statement ] keep ;
 
-: do-tuple-statement ( tuple columns-quot statement-quot -- )
+: make-tuple-statement ( tuple columns-quot statement-quot -- statement )
     >r [ class db-columns ] swap compose keep
-    r> tuple-statement execute-statement ;
+    r> tuple-statement ;
+
+: do-tuple-statement ( tuple columns-quot statement-quot -- )
+    make-tuple-statement execute-statement ;
 
 : create-table ( class -- )
     dup db-columns swap db-table create-sql sql-command ;
@@ -76,8 +79,8 @@ HOOK: tuple>params db ( columns tuple -- obj )
 
 : insert-tuple ( tuple -- )
     [
-        [ maybe-remove-id ] [ insert-sql ] do-tuple-statement
+        [ maybe-remove-id ] [ insert-sql ]
-        last-id
+        make-tuple-statement execute-statement-last-id
     ] keep set-primary-key ;
 
 : update-tuple ( tuple -- )