From eb756850318654cd04e19c53f4000eb53adca60a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 13 Feb 2008 16:51:16 -0600 Subject: [PATCH] fix a bug in sqlite add execute-statment-row-id to db some work on postgresql --- extra/db/db.factor | 13 ++- extra/db/postgresql/ffi/ffi.factor | 2 + extra/db/postgresql/lib/lib.factor | 7 +- extra/db/postgresql/postgresql.factor | 109 +++++++++++++++++++++++++- extra/db/sqlite/ffi/ffi.factor | 2 +- extra/db/sqlite/lib/lib.factor | 2 +- extra/db/sqlite/sqlite.factor | 22 ++++-- extra/db/tuples/tuples-tests.factor | 17 ++-- extra/db/tuples/tuples.factor | 11 ++- 9 files changed, 155 insertions(+), 30 deletions(-) diff --git a/extra/db/db.factor b/extra/db/db.factor index 7bdb75af22..46b257ce7a 100755 --- a/extra/db/db.factor +++ b/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: 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 ; diff --git a/extra/db/postgresql/ffi/ffi.factor b/extra/db/postgresql/ffi/ffi.factor index 1ec6fc46f8..d14ec13ff8 100755 --- a/extra/db/postgresql/ffi/ffi.factor +++ b/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 diff --git a/extra/db/postgresql/lib/lib.factor b/extra/db/postgresql/lib/lib.factor index a940a42ae4..d8381ca83a 100644 --- a/extra/db/postgresql/lib/lib.factor +++ b/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 ; diff --git a/extra/db/postgresql/postgresql.factor b/extra/db/postgresql/postgresql.factor index 92e3fa5489..dac4d78b78 100755 --- a/extra/db/postgresql/postgresql.factor +++ b/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 -sequences debugger db db.postgresql.lib db.postgresql.ffi ; +kernel math math.parser namespaces prettyprint quotations +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 -- ) - query-results dispose ; +M: postgresql-statement execute-statement* ( statement -- obj ) + 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 ; diff --git a/extra/db/sqlite/ffi/ffi.factor b/extra/db/sqlite/ffi/ffi.factor index 9ffe797248..3d37348709 100755 --- a/extra/db/sqlite/ffi/ffi.factor +++ b/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 ) ; diff --git a/extra/db/sqlite/lib/lib.factor b/extra/db/sqlite/lib/lib.factor index 1780cc4a2d..e97dcf80c9 100755 --- a/extra/db/sqlite/lib/lib.factor +++ b/extra/db/sqlite/lib/lib.factor @@ -30,7 +30,7 @@ IN: db.sqlite.lib : sqlite-prepare ( db sql -- handle ) dup length "void*" "void*" - [ sqlite3_prepare_v2 sqlite-check-result ] 2keep + [ sqlite3_prepare sqlite-check-result ] 2keep drop *void* ; : sqlite-bind-parameter-index ( handle name -- index ) diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor index ad3a43bae3..f58c669681 100755 --- a/extra/db/sqlite/sqlite.factor +++ b/extra/db/sqlite/sqlite.factor @@ -25,7 +25,7 @@ M: sqlite-db dispose ( db -- ) dispose-db ; TUPLE: sqlite-statement ; C: sqlite-statement -TUPLE: sqlite-result-set ; +TUPLE: sqlite-result-set advanced? ; : ( query -- sqlite-result-set ) dup statement-handle sqlite-result-set ; @@ -40,7 +40,13 @@ M: sqlite-db ( 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 -- ) - statement-handle sqlite-next drop ; +M: sqlite-statement execute-statement* ( statement -- obj ) + 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 ; @@ -138,9 +145,10 @@ M: sqlite-db tuple>params ( columns tuple -- obj ) third 3array ] curry map ; -M: sqlite-db last-id ( -- id ) - db get db-handle sqlite3_last_insert_rowid ; - +M: sqlite-db last-id ( result-set -- id ) + maybe-advance-row drop + db get db-handle sqlite3_last_insert_rowid + dup zero? [ "last-id failed" throw ] when ; : sqlite-db-modifiers ( -- hashtable ) H{ diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor index 474593ae3f..6945ccc722 100755 --- a/extra/db/tuples/tuples-tests.factor +++ b/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 ; -: ( name age -- 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 ( -- ) - ! resource-path [ - ! test-tuples - ! ] with-db ; +: test-postgresql ( -- ) + "localhost" "postgres" "" "factor-test" [ + test-tuples + ] with-db ; person "PERSON" { @@ -52,7 +53,7 @@ person "PERSON" "billy" 10 3.14 the-person set test-sqlite -! test-postgres +! test-postgresql person "PERSON" { @@ -65,4 +66,4 @@ person "PERSON" 1 "billy" 20 6.28 the-person set test-sqlite -! test-postgres +! test-postgresql diff --git a/extra/db/tuples/tuples.factor b/extra/db/tuples/tuples.factor index 099326e4c1..783001f3f8 100755 --- a/extra/db/tuples/tuples.factor +++ b/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 - last-id + [ maybe-remove-id ] [ insert-sql ] + make-tuple-statement execute-statement-last-id ] keep set-primary-key ; : update-tuple ( tuple -- )