From 8cdec0202b9a40f2213b2a8221c582db53329bd7 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 27 Feb 2008 18:28:32 -0600 Subject: [PATCH] fix sqlite remove reset-statement from db vocab --- extra/db/db.factor | 17 ++++------ extra/db/postgresql/postgresql.factor | 5 +-- extra/db/sqlite/sqlite.factor | 47 +++++++++++++++------------ extra/db/tuples/tuples-tests.factor | 27 +++++++-------- extra/db/tuples/tuples.factor | 38 +++++++++++++--------- 5 files changed, 70 insertions(+), 64 deletions(-) diff --git a/extra/db/db.factor b/extra/db/db.factor index d5242659ae..f6596af101 100755 --- a/extra/db/db.factor +++ b/extra/db/db.factor @@ -12,9 +12,9 @@ TUPLE: db handle ; db construct-boa ; GENERIC: make-db* ( seq class -- db ) -: make-db ( seq class -- db ) construct-empty make-db* ; GENERIC: db-open ( db -- ) HOOK: db-close db ( handle -- ) +: make-db ( seq class -- db ) construct-empty make-db* ; : dispose-statements ( seq -- ) [ dispose drop ] assoc-each ; @@ -28,6 +28,9 @@ HOOK: db-close db ( handle -- ) ] with-variable ; TUPLE: statement handle sql in-params out-params bind-params bound? ; +TUPLE: simple-statement ; +TUPLE: prepared-statement ; +TUPLE: result-set sql params handle n max ; : ( sql in out -- statement ) { set-statement-sql @@ -35,17 +38,11 @@ TUPLE: statement handle sql in-params out-params bind-params bound? ; set-statement-out-params } statement construct ; -TUPLE: simple-statement ; -TUPLE: prepared-statement ; - HOOK: db ( str in out -- statement ) HOOK: db ( str in out -- statement ) GENERIC: prepare-statement ( statement -- ) -GENERIC: bind-statement* ( obj statement -- ) -GENERIC: reset-statement ( statement -- ) +GENERIC: bind-statement* ( statement -- ) GENERIC: bind-tuple ( tuple statement -- ) - -TUPLE: result-set sql params handle n max ; GENERIC: query-results ( query -- result-set ) GENERIC: #rows ( result-set -- n ) GENERIC: #columns ( result-set -- n ) @@ -53,6 +50,7 @@ GENERIC# row-column 1 ( result-set n -- obj ) GENERIC: advance-row ( result-set -- ) GENERIC: more-rows? ( result-set -- ? ) +! must be called from within with-disposal : execute-statement ( statement -- ) dup sequence? [ [ execute-statement ] each @@ -61,9 +59,8 @@ GENERIC: more-rows? ( result-set -- ? ) ] if ; : bind-statement ( obj statement -- ) - dup statement-bound? [ dup reset-statement ] when - [ bind-statement* ] 2keep [ set-statement-bind-params ] keep + [ bind-statement* ] keep t swap set-statement-bound? ; : init-result-set ( result-set -- ) diff --git a/extra/db/postgresql/postgresql.factor b/extra/db/postgresql/postgresql.factor index 154a330913..9383a9290c 100755 --- a/extra/db/postgresql/postgresql.factor +++ b/extra/db/postgresql/postgresql.factor @@ -38,10 +38,7 @@ M: postgresql-db db-open ( db -- ) M: postgresql-db dispose ( db -- ) db-handle PQfinish ; -M: postgresql-statement bind-statement* ( seq statement -- ) - set-statement-bind-params ; - -M: postgresql-statement reset-statement ( statement -- ) +M: postgresql-statement bind-statement* ( statement -- ) drop ; M: postgresql-statement bind-tuple ( tuple statement -- ) diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor index 8aba932490..b980e99718 100755 --- a/extra/db/sqlite/sqlite.factor +++ b/extra/db/sqlite/sqlite.factor @@ -4,7 +4,8 @@ USING: alien arrays assocs classes compiler db hashtables io.files kernel math math.parser namespaces prettyprint sequences strings tuples alien.c-types continuations db.sqlite.lib db.sqlite.ffi db.tuples -words combinators.lib db.types combinators tools.walker ; +words combinators.lib db.types combinators tools.walker +combinators.cleave ; IN: db.sqlite TUPLE: sqlite-db path ; @@ -29,14 +30,13 @@ M: sqlite-db ( str -- obj ) ; M: sqlite-db ( str -- obj ) - db get db-handle { set-statement-sql set-statement-in-params set-statement-out-params - set-statement-handle } statement construct - dup statement-handle over statement-sql sqlite-prepare + db get db-handle over statement-sql sqlite-prepare + over set-statement-handle sqlite-statement construct-delegate ; M: sqlite-statement dispose ( statement -- ) @@ -45,20 +45,32 @@ M: sqlite-statement dispose ( statement -- ) M: sqlite-result-set dispose ( result-set -- ) f swap set-result-set-handle ; -: sqlite-bind ( specs handle -- ) - swap [ sqlite-bind-type ] with each ; +: sqlite-bind ( triples handle -- ) + swap [ first3 sqlite-bind-type ] with each ; -M: sqlite-statement bind-statement* ( obj statement -- ) - statement-handle sqlite-bind ; - -M: sqlite-statement reset-statement ( statement -- ) +: reset-statement ( statement -- ) statement-handle sqlite-reset ; +M: sqlite-statement bind-statement* ( statement -- ) + dup statement-bound? [ dup reset-statement ] when + [ statement-bind-params ] [ statement-handle ] bi sqlite-bind ; + +M: sqlite-statement bind-tuple ( tuple statement -- ) + [ + statement-in-params + [ + [ sql-spec-column-name ":" swap append ] + [ sql-spec-slot-name rot get-slot-named ] + [ sql-spec-type ] tri 3array + ] with map + ] keep + [ set-statement-bind-params ] keep bind-statement* ; + : last-insert-id ( -- id ) db get db-handle sqlite3_last_insert_rowid dup zero? [ "last-id failed" throw ] when ; -M: sqlite-statement insert-tuple* ( tuple statement -- ) +M: sqlite-db insert-tuple* ( tuple statement -- ) execute-statement last-insert-id swap set-primary-key ; M: sqlite-result-set #columns ( result-set -- n ) @@ -78,7 +90,6 @@ M: sqlite-result-set more-rows? ( result-set -- ? ) sqlite-result-set-has-more? ; M: sqlite-statement query-results ( query -- result-set ) -break dup statement-handle sqlite-result-set dup advance-row ; @@ -127,7 +138,7 @@ M: sqlite-db ( tuple -- statement ) : where-primary-key% ( specs -- ) " where " 0% - find-primary-key sql-spec-column-name dup 0% " = " 0% bind% ; + find-primary-key dup sql-spec-column-name 0% " = " 0% bind% ; M: sqlite-db ( class -- statement ) [ @@ -135,7 +146,7 @@ M: sqlite-db ( class -- statement ) 0% " set " 0% dup remove-id - [ ", " 0% ] [ sql-spec-column-name dup 0% " = " 0% bind% ] interleave + [ ", " 0% ] [ dup sql-spec-column-name 0% " = " 0% bind% ] interleave where-primary-key% ] sqlite-make ; @@ -144,7 +155,7 @@ M: sqlite-db ( specs table -- sql ) "delete from " 0% 0% " where " 0% find-primary-key - sql-spec-column-name dup 0% " = " 0% bind% + dup sql-spec-column-name 0% " = " 0% bind% ] sqlite-make ; ! : select-interval ( interval name -- ) ; @@ -152,8 +163,6 @@ M: sqlite-db ( specs table -- sql ) M: sqlite-db bind% ( spec -- ) dup 1, sql-spec-column-name ":" swap append 0% ; - ! dup 1, sql-spec-column-name - ! dup 0% " = " 0% ":" swap append 0% ; M: sqlite-db ( tuple class -- statement ) [ @@ -201,7 +210,3 @@ M: sqlite-db type-table ( -- assoc ) M: sqlite-db create-type-table type-table ; - -! HOOK: get-column-value ( n result-set type -- ) -! M: sqlite get-column-value { { "TEXT" get-text-column } { -! "INTEGER" get-integer-column } ... } case ; diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor index 6a0d0378b2..c9e6d302e0 100755 --- a/extra/db/tuples/tuples-tests.factor +++ b/extra/db/tuples/tuples-tests.factor @@ -22,8 +22,9 @@ SYMBOL: the-person2 : test-tuples ( -- ) [ person drop-table ] [ drop ] recover [ ] [ person create-table ] unit-test + [ person create-table ] must-fail - [ ] [ the-person1 get insert-tuple ] unit-test + [ ] [ the-person1 get insert-tuple ] unit-test [ 1 ] [ the-person1 get person-the-id ] unit-test @@ -66,8 +67,8 @@ person "PERSON" "billy" 10 3.14 the-person1 set "johnny" 10 3.14 the-person2 set -! test-sqlite -test-postgresql +test-sqlite +! test-postgresql person "PERSON" { @@ -80,8 +81,8 @@ person "PERSON" 1 "billy" 10 3.14 the-person1 set 2 "johnny" 10 3.14 the-person2 set -! test-sqlite -test-postgresql +test-sqlite +! test-postgresql TUPLE: paste n summary author channel mode contents timestamp annotations ; TUPLE: annotation n paste-id summary author mode contents ; @@ -108,11 +109,11 @@ annotation "ANNOTATION" { "contents" "CONTENTS" TEXT } } define-persistent -{ "localhost" "postgres" "" "factor-test" } postgresql-db [ - [ paste drop-table ] [ drop ] recover - [ annotation drop-table ] [ drop ] recover - [ paste drop-table ] [ drop ] recover - [ annotation drop-table ] [ drop ] recover - [ ] [ paste create-table ] unit-test - [ ] [ annotation create-table ] unit-test -] with-db +! { "localhost" "postgres" "" "factor-test" } postgresql-db [ + ! [ paste drop-table ] [ drop ] recover + ! [ annotation drop-table ] [ drop ] recover + ! [ paste drop-table ] [ drop ] recover + ! [ annotation drop-table ] [ drop ] recover + ! [ ] [ paste create-table ] unit-test + ! [ ] [ annotation create-table ] unit-test +! ] with-db diff --git a/extra/db/tuples/tuples.factor b/extra/db/tuples/tuples.factor index 4e8b8ec9d0..28556a13fa 100755 --- a/extra/db/tuples/tuples.factor +++ b/extra/db/tuples/tuples.factor @@ -63,16 +63,20 @@ HOOK: insert-tuple* db ( tuple statement -- ) : sql-props ( class -- columns table ) dup db-columns swap db-table ; -: create-table ( class -- ) create-sql-statement execute-statement ; -: drop-table ( class -- ) drop-sql-statement execute-statement ; +: create-table ( class -- ) + create-sql-statement [ execute-statement ] with-disposal ; +: drop-table ( class -- ) + drop-sql-statement [ execute-statement ] with-disposal ; : insert-native ( tuple -- ) - dup class - [ bind-tuple ] 2keep insert-tuple* ; + dup class [ + [ bind-tuple ] 2keep dup . insert-tuple* + ] with-disposal ; : insert-assigned ( tuple -- ) - dup class - [ bind-tuple ] keep execute-statement ; + dup class [ + [ bind-tuple ] keep execute-statement + ] with-disposal ; : insert-tuple ( tuple -- ) dup class db-columns find-primary-key assigned-id? [ @@ -82,19 +86,21 @@ HOOK: insert-tuple* db ( tuple statement -- ) ] if ; : update-tuple ( tuple -- ) - dup class - [ bind-tuple ] keep execute-statement ; + dup class [ + [ bind-tuple ] keep execute-statement + ] with-disposal ; -: update-tuples ( seq -- ) - execute-statement ; +! : update-tuples ( seq -- ) + ! execute-statement ; : delete-tuple ( tuple -- ) - dup class - [ bind-tuple ] keep execute-statement ; + dup class [ + [ bind-tuple ] keep execute-statement + ] with-disposal ; -: setup-select ( tuple -- statement ) - dup dup class - [ bind-tuple ] keep ; +: select-tuples ( tuple -- tuple ) + dup dup class [ + [ bind-tuple ] keep query-tuples + ] with-disposal ; -: select-tuples ( tuple -- tuple ) setup-select query-tuples ; : select-tuple ( tuple -- tuple/f ) select-tuples ?first ;