diff --git a/extra/db/postgresql/lib/lib.factor b/extra/db/postgresql/lib/lib.factor index bfe7dab3ce..cd3d619326 100755 --- a/extra/db/postgresql/lib/lib.factor +++ b/extra/db/postgresql/lib/lib.factor @@ -5,7 +5,7 @@ quotations sequences db.postgresql.ffi alien alien.c-types db.types tools.walker ascii splitting math.parser combinators libc shuffle calendar.format byte-arrays destructors prettyprint accessors strings serialize io.encodings.binary -io.streams.byte-array ; +io.streams.byte-array inspector ; IN: db.postgresql.lib : postgresql-result-error-message ( res -- str/f ) @@ -28,7 +28,13 @@ IN: db.postgresql.lib : postgresql-error ( res -- res ) dup [ postgresql-error-message throw ] unless ; -: postgresql-result-ok? ( n -- ? ) +ERROR: postgresql-result-null ; + +M: postgresql-result-null summary ( obj -- str ) + drop "PQexec returned f." ; + +: postgresql-result-ok? ( res -- ? ) + [ postgresql-result-null ] unless* PQresultStatus PGRES_COMMAND_OK PGRES_TUPLES_OK 2array member? ; diff --git a/extra/db/postgresql/postgresql.factor b/extra/db/postgresql/postgresql.factor index 9dfa123952..d0eb390888 100755 --- a/extra/db/postgresql/postgresql.factor +++ b/extra/db/postgresql/postgresql.factor @@ -5,7 +5,7 @@ kernel math math.parser namespaces prettyprint quotations sequences debugger db db.postgresql.lib db.postgresql.ffi db.tuples db.types tools.annotations math.ranges combinators sequences.lib classes locals words tools.walker -namespaces.lib accessors ; +namespaces.lib accessors random ; IN: db.postgresql TUPLE: postgresql-db < db @@ -43,10 +43,9 @@ M: postgresql-statement bind-statement* ( statement -- ) drop ; M: postgresql-statement bind-tuple ( tuple statement -- ) - [ - statement-in-params - [ sql-spec-slot-name swap get-slot-named ] with map - ] keep set-statement-bind-params ; + tuck in-params>> + [ slot-name>> swap get-slot-named ] with map + >>bind-params drop ; M: postgresql-result-set #rows ( result-set -- n ) handle>> PQntuples ; @@ -55,11 +54,11 @@ M: postgresql-result-set #columns ( result-set -- n ) handle>> PQnfields ; M: postgresql-result-set row-column ( result-set column -- obj ) - >r dup result-set-handle swap result-set-n r> pq-get-string ; + >r [ handle>> ] [ n>> ] bi r> pq-get-string ; M: postgresql-result-set row-column-typed ( result-set column -- obj ) dup pick result-set-out-params nth sql-spec-type - >r >r [ result-set-handle ] [ result-set-n ] bi r> r> postgresql-column-typed ; + >r >r [ handle>> ] [ result-set-n ] bi r> r> postgresql-column-typed ; M: postgresql-statement query-results ( query -- result-set ) dup statement-bind-params [ @@ -82,7 +81,7 @@ M: postgresql-statement dispose ( query -- ) f swap set-statement-handle ; M: postgresql-result-set dispose ( result-set -- ) - dup result-set-handle PQclear + dup handle>> PQclear 0 0 f roll { set-result-set-n set-result-set-max set-result-set-handle } set-slots ; @@ -90,7 +89,7 @@ M: postgresql-result-set dispose ( result-set -- ) M: postgresql-statement prepare-statement ( statement -- ) [ >r db get handle>> "" r> - dup statement-sql swap statement-in-params + [ sql>> ] [ in-params>> ] bi length f PQprepare postgresql-error ] keep set-statement-handle ; @@ -115,7 +114,10 @@ SYMBOL: postgresql-counter postgresql-counter [ inc ] keep get 0# ; M: postgresql-db bind% ( spec -- ) - 1, bind-name% ; + bind-name% 1, ; + +M: postgresql-db bind# ( spec obj -- ) + >r bind-name% f swap type>> r> 1, ; : postgresql-make ( class quot -- ) >r sql-props r> @@ -125,11 +127,10 @@ M: postgresql-db bind% ( spec -- ) : create-table-sql ( class -- statement ) [ "create table " 0% 0% - "(" 0% - [ ", " 0% ] [ - dup sql-spec-column-name 0% + "(" 0% [ ", " 0% ] [ + dup column-name>> 0% " " 0% - dup sql-spec-type t lookup-type 0% + dup type>> t lookup-type 0% modifiers 0% ] interleave ");" 0% ] postgresql-make ; @@ -250,6 +251,7 @@ M: postgresql-db ( tuple class -- statement ) M: postgresql-db type-table ( -- hash ) H{ { +native-id+ "integer" } + { +random-id+ "bigint" } { TEXT "text" } { VARCHAR "varchar" } { INTEGER "integer" } @@ -265,6 +267,7 @@ M: postgresql-db type-table ( -- hash ) M: postgresql-db create-type-table ( -- hash ) H{ { +native-id+ "serial primary key" } + { +random-id+ "bigint primary key" } } ; : postgresql-compound ( str n -- newstr ) @@ -286,12 +289,16 @@ M: postgresql-db modifier-table ( -- hashtable ) H{ { +native-id+ "primary key" } { +assigned-id+ "primary key" } + { +random-id+ "primary key" } { +foreign-id+ "references" } { +autoincrement+ "autoincrement" } { +unique+ "unique" } { +default+ "default" } { +null+ "null" } { +not-null+ "not null" } + { system-random-generator "" } + { secure-random-generator "" } + { random-generator "" } } ; M: postgresql-db compound-type ( str n -- newstr ) diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor index 6dc394abd9..f361e18c48 100755 --- a/extra/db/sqlite/sqlite.factor +++ b/extra/db/sqlite/sqlite.factor @@ -110,10 +110,16 @@ M: sqlite-db begin-transaction ( -- ) "BEGIN" sql-command ; M: sqlite-db commit-transaction ( -- ) "COMMIT" sql-command ; M: sqlite-db rollback-transaction ( -- ) "ROLLBACK" sql-command ; + +: maybe-make-retryable ( statement -- statement ) + dup in-params>> [ generator-bind? ] contains? [ + make-retryable + ] when ; + : sqlite-make ( class quot -- ) >r sql-props r> [ 0 sql-counter rot with-variable ] { "" { } { } } nmake - ; + maybe-make-retryable ; M: sqlite-db create-sql-statement ( class -- statement ) [ @@ -124,7 +130,7 @@ M: sqlite-db create-sql-statement ( class -- statement ) dup type>> t lookup-type 0% modifiers 0% ] interleave ");" 0% - ] sqlite-make ; + ] sqlite-make dup sql>> . ; M: sqlite-db drop-sql-statement ( class -- statement ) [ "drop table " 0% 0% ";" 0% drop ] sqlite-make ; @@ -151,10 +157,7 @@ M: sqlite-db ( tuple -- statement ) ] if ] interleave ");" 0% - ] sqlite-make - dup in-params>> [ generator-bind? ] contains? [ - make-retryable - ] when ; + ] sqlite-make ; M: sqlite-db ( tuple -- statement ) ; diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor index 2eb31ebe18..038197d864 100755 --- a/extra/db/tuples/tuples-tests.factor +++ b/extra/db/tuples/tuples-tests.factor @@ -346,13 +346,15 @@ C: secret ] unit-test [ t ] [ - T{ secret } select-tuples dup . length 3 = + T{ secret } select-tuples length 3 = ] unit-test ; [ test-random-id ] test-sqlite [ native-person-schema test-tuples ] test-sqlite [ assigned-person-schema test-tuples ] test-sqlite [ assigned-person-schema test-repeated-insert ] test-sqlite + +[ test-random-id ] test-postgresql [ native-person-schema test-tuples ] test-postgresql [ assigned-person-schema test-tuples ] test-postgresql [ assigned-person-schema test-repeated-insert ] test-postgresql diff --git a/extra/db/types/types.factor b/extra/db/types/types.factor index 9f111a42e4..41db970b12 100755 --- a/extra/db/types/types.factor +++ b/extra/db/types/types.factor @@ -110,8 +110,7 @@ ERROR: no-sql-type ; dup array? [ first lookup-type* ] [ - type-table at* - [ no-sql-type ] unless + type-table at* [ no-sql-type ] unless ] if ; : lookup-create-type ( obj -- str )