steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

fix a bug in sqlite 

add execute-statment-row-id to db
some work on postgresql
db4
Doug Coleman 2008-02-13 16:51:16 -06:00
parent 9f2c032b2f
commit eb75685031
9 changed files with 155 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
extra/db/db.factor
View File

@ -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 ;

2
extra/db/postgresql/ffi/ffi.factor
View File

@ -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

7
extra/db/postgresql/lib/lib.factor
View File

@ -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 ;

109
extra/db/postgresql/postgresql.factor
View File

@ -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 ;

2
extra/db/sqlite/ffi/ffi.factor
View File

@ -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 ) ;

2
extra/db/sqlite/lib/lib.factor
View File

@ -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 )

22
extra/db/sqlite/sqlite.factor
View File

@ -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 -- )
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 <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{

17
extra/db/tuples/tuples-tests.factor
View File

@ -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 ( -- )
! resource-path <postgresql-db> [
! test-tuples
! ] with-db ;
: test-postgresql ( -- )
"localhost" "postgres" "" "factor-test" <postgresql-db> [
test-tuples
] 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

11
extra/db/tuples/tuples.factor
View File

@ -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 -- )