first commit of db stuff
Doug Coleman
parent
2924f4bc45
commit
71358d3c4a
|
|
@ -0,0 +1,96 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays assocs classes continuations kernel math
|
||||
namespaces sequences sequences.lib tuples words ;
|
||||
IN: db
|
||||
|
||||
TUPLE: db handle ;
|
||||
C: <db> db ( handle -- obj )
|
||||
|
||||
! HOOK: db-create db ( str -- )
|
||||
! HOOK: db-drop db ( str -- )
|
||||
GENERIC: db-open ( db -- )
|
||||
GENERIC: db-close ( db -- )
|
||||
|
||||
TUPLE: statement sql params handle bound? n max ;
|
||||
|
||||
TUPLE: simple-statement ;
|
||||
TUPLE: bound-statement ;
|
||||
TUPLE: prepared-statement ;
|
||||
TUPLE: prepared-bound-statement ;
|
||||
|
||||
HOOK: <simple-statement> db ( str -- statement )
|
||||
HOOK: <bound-statement> db ( str obj -- statement )
|
||||
HOOK: <prepared-statement> db ( str -- statement )
|
||||
HOOK: <prepared-bound-statement> db ( str obj -- statement )
|
||||
|
||||
! TUPLE: result sql params handle n max ;
|
||||
|
||||
GENERIC: #rows ( statement -- n )
|
||||
GENERIC: #columns ( statement -- n )
|
||||
GENERIC# row-column 1 ( statement n -- obj )
|
||||
GENERIC: advance-row ( statement -- ? )
|
||||
|
||||
GENERIC: prepare-statement ( statement -- )
|
||||
GENERIC: reset-statement ( statement -- )
|
||||
GENERIC: bind-statement* ( obj statement -- )
|
||||
GENERIC: rebind-statement ( obj statement -- )
|
||||
|
||||
: bind-statement ( obj statement -- )
|
||||
2dup dup statement-bound? [
|
||||
rebind-statement
|
||||
] [
|
||||
bind-statement*
|
||||
] if
|
||||
tuck set-statement-params
|
||||
t swap set-statement-bound? ;
|
||||
|
||||
: sql-row ( statement -- seq )
|
||||
dup #columns [ row-column ] with map ;
|
||||
|
||||
: query-each ( statement quot -- )
|
||||
over advance-row [
|
||||
2drop
|
||||
] [
|
||||
[ call ] 2keep query-each
|
||||
] if ; inline
|
||||
|
||||
: query-map ( statement quot -- seq )
|
||||
accumulator >r query-each r> { } like ; inline
|
||||
|
||||
: with-db ( db quot -- )
|
||||
[
|
||||
over db-open
|
||||
[ db swap with-variable ] curry with-disposal
|
||||
] with-scope ;
|
||||
|
||||
: do-statement ( statement -- )
|
||||
[ advance-row drop ] with-disposal ;
|
||||
|
||||
: do-query ( query -- rows )
|
||||
[ [ sql-row ] query-map ] with-disposal ;
|
||||
|
||||
: do-simple-query ( sql -- rows )
|
||||
<simple-statement> do-query ;
|
||||
|
||||
: do-bound-query ( sql obj -- rows )
|
||||
<bound-statement> do-query ;
|
||||
|
||||
: do-simple-command ( sql -- )
|
||||
<simple-statement> do-statement ;
|
||||
|
||||
: do-bound-command ( sql obj -- )
|
||||
<bound-statement> do-statement ;
|
||||
|
||||
SYMBOL: in-transaction
|
||||
HOOK: begin-transaction db ( -- )
|
||||
HOOK: commit-transaction db ( -- )
|
||||
HOOK: rollback-transaction db ( -- )
|
||||
|
||||
: in-transaction? ( -- ? ) in-transaction get ;
|
||||
|
||||
: with-transaction ( quot -- )
|
||||
t in-transaction [
|
||||
begin-transaction
|
||||
[ ] [ rollback-transaction ] cleanup commit-transaction
|
||||
] with-variable ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
||||
|
|
@ -0,0 +1,360 @@
|
|||
! Copyright (C) 2007 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
|
||||
! adapted from libpq-fe.h version 7.4.7
|
||||
! tested on debian linux with postgresql 7.4.7
|
||||
! Updated to 8.1
|
||||
|
||||
USING: alien alien.syntax combinators system ;
|
||||
IN: db.postgresql.ffi
|
||||
|
||||
<<
|
||||
"postgresql" {
|
||||
{ [ win32? ] [ "libpq.dll" ] }
|
||||
{ [ macosx? ] [ "/opt/local/lib/postgresql81/libpq.dylib" ] }
|
||||
{ [ unix? ] [ "libpq.so" ] }
|
||||
} cond "cdecl" add-library
|
||||
>>
|
||||
|
||||
! ConnSatusType
|
||||
: CONNECTION_OK HEX: 0 ; inline
|
||||
: CONNECTION_BAD HEX: 1 ; inline
|
||||
: CONNECTION_STARTED HEX: 2 ; inline
|
||||
: CONNECTION_MADE HEX: 3 ; inline
|
||||
: CONNECTION_AWAITING_RESPONSE HEX: 4 ; inline
|
||||
: CONNECTION_AUTH_OK HEX: 5 ; inline
|
||||
: CONNECTION_SETENV HEX: 6 ; inline
|
||||
: CONNECTION_SSL_STARTUP HEX: 7 ; inline
|
||||
: CONNECTION_NEEDED HEX: 8 ; inline
|
||||
|
||||
! PostgresPollingStatusType
|
||||
: PGRES_POLLING_FAILED HEX: 0 ; inline
|
||||
: PGRES_POLLING_READING HEX: 1 ; inline
|
||||
: PGRES_POLLING_WRITING HEX: 2 ; inline
|
||||
: PGRES_POLLING_OK HEX: 3 ; inline
|
||||
: PGRES_POLLING_ACTIVE HEX: 4 ; inline
|
||||
|
||||
! ExecStatusType;
|
||||
: PGRES_EMPTY_QUERY HEX: 0 ; inline
|
||||
: PGRES_COMMAND_OK HEX: 1 ; inline
|
||||
: PGRES_TUPLES_OK HEX: 2 ; inline
|
||||
: PGRES_COPY_OUT HEX: 3 ; inline
|
||||
: PGRES_COPY_IN HEX: 4 ; inline
|
||||
: PGRES_BAD_RESPONSE HEX: 5 ; inline
|
||||
: PGRES_NONFATAL_ERROR HEX: 6 ; inline
|
||||
: PGRES_FATAL_ERROR HEX: 7 ; inline
|
||||
|
||||
! PGTransactionStatusType;
|
||||
: PQTRANS_IDLE HEX: 0 ; inline
|
||||
: PQTRANS_ACTIVE HEX: 1 ; inline
|
||||
: PQTRANS_INTRANS HEX: 2 ; inline
|
||||
: PQTRANS_INERROR HEX: 3 ; inline
|
||||
: PQTRANS_UNKNOWN HEX: 4 ; inline
|
||||
|
||||
! PGVerbosity;
|
||||
: PQERRORS_TERSE HEX: 0 ; inline
|
||||
: PQERRORS_DEFAULT HEX: 1 ; inline
|
||||
: PQERRORS_VERBOSE HEX: 2 ; inline
|
||||
|
||||
|
||||
TYPEDEF: int size_t
|
||||
TYPEDEF: int ConnStatusType
|
||||
TYPEDEF: int ExecStatusType
|
||||
TYPEDEF: int PostgresPollingStatusType
|
||||
TYPEDEF: int PGTransactionStatusType
|
||||
TYPEDEF: int PGVerbosity
|
||||
|
||||
TYPEDEF: void* PGconn*
|
||||
TYPEDEF: void* PGresult*
|
||||
TYPEDEF: void* PGcancel*
|
||||
TYPEDEF: uint Oid
|
||||
TYPEDEF: uint* Oid*
|
||||
TYPEDEF: char pqbool
|
||||
TYPEDEF: void* PQconninfoOption*
|
||||
TYPEDEF: void* PGnotify*
|
||||
TYPEDEF: void* PQArgBlock*
|
||||
TYPEDEF: void* PQprintOpt*
|
||||
TYPEDEF: void* FILE*
|
||||
TYPEDEF: void* SSL*
|
||||
|
||||
LIBRARY: postgresql
|
||||
|
||||
|
||||
! Exported functions of libpq
|
||||
! === in fe-connect.c ===
|
||||
|
||||
! make a new client connection to the backend
|
||||
! Asynchronous (non-blocking)
|
||||
FUNCTION: PGconn* PQconnectStart ( char* conninfo ) ;
|
||||
FUNCTION: PostgresPollingStatusType PQconnectPoll ( PGconn* conn ) ;
|
||||
|
||||
! Synchronous (blocking)
|
||||
FUNCTION: PGconn* PQconnectdb ( char* conninfo ) ;
|
||||
FUNCTION: PGconn* PQsetdbLogin ( char* pghost, char* pgport,
|
||||
char* pgoptions, char* pgtty,
|
||||
char* dbName,
|
||||
char* login, char* pwd ) ;
|
||||
|
||||
: PQsetdb ( M_PGHOST M_PGPORT M_PGOPT M_PGTTY M_DBNAME -- PGconn* )
|
||||
f f PQsetdbLogin ;
|
||||
|
||||
! close the current connection and free the PGconn data structure
|
||||
FUNCTION: void PQfinish ( PGconn* conn ) ;
|
||||
|
||||
! get info about connection options known to PQconnectdb
|
||||
FUNCTION: PQconninfoOption* PQconndefaults ( ) ;
|
||||
|
||||
! free the data structure returned by PQconndefaults()
|
||||
FUNCTION: void PQconninfoFree ( PQconninfoOption* connOptions ) ;
|
||||
|
||||
!
|
||||
! close the current connection and restablish a new one with the same
|
||||
! parameters
|
||||
!
|
||||
! Asynchronous (non-blocking)
|
||||
FUNCTION: int PQresetStart ( PGconn* conn ) ;
|
||||
FUNCTION: PostgresPollingStatusType PQresetPoll ( PGconn* conn ) ;
|
||||
|
||||
! Synchronous (blocking)
|
||||
FUNCTION: void PQreset ( PGconn* conn ) ;
|
||||
|
||||
! request a cancel structure
|
||||
FUNCTION: PGcancel* PQgetCancel ( PGconn* conn ) ;
|
||||
|
||||
! free a cancel structure
|
||||
FUNCTION: void PQfreeCancel ( PGcancel* cancel ) ;
|
||||
|
||||
! issue a cancel request
|
||||
FUNCTION: int PQrequestCancel ( PGconn* conn ) ;
|
||||
|
||||
! Accessor functions for PGconn objects
|
||||
FUNCTION: char* PQdb ( PGconn* conn ) ;
|
||||
FUNCTION: char* PQuser ( PGconn* conn ) ;
|
||||
FUNCTION: char* PQpass ( PGconn* conn ) ;
|
||||
FUNCTION: char* PQhost ( PGconn* conn ) ;
|
||||
FUNCTION: char* PQport ( PGconn* conn ) ;
|
||||
FUNCTION: char* PQtty ( PGconn* conn ) ;
|
||||
FUNCTION: char* PQoptions ( PGconn* conn ) ;
|
||||
FUNCTION: ConnStatusType PQstatus ( PGconn* conn ) ;
|
||||
FUNCTION: PGTransactionStatusType PQtransactionStatus ( PGconn* conn ) ;
|
||||
FUNCTION: char* PQparameterStatus ( PGconn* conn,
|
||||
char* paramName ) ;
|
||||
FUNCTION: int PQprotocolVersion ( PGconn* conn ) ;
|
||||
! FUNCTION: int PQServerVersion ( PGconn* conn ) ;
|
||||
FUNCTION: char* PQerrorMessage ( PGconn* conn ) ;
|
||||
FUNCTION: int PQsocket ( PGconn* conn ) ;
|
||||
FUNCTION: int PQbackendPID ( PGconn* conn ) ;
|
||||
FUNCTION: int PQclientEncoding ( PGconn* conn ) ;
|
||||
FUNCTION: int PQsetClientEncoding ( PGconn* conn, char* encoding ) ;
|
||||
|
||||
! May not be compiled into libpq
|
||||
! Get the SSL structure associated with a connection
|
||||
FUNCTION: SSL* PQgetssl ( PGconn* conn ) ;
|
||||
|
||||
! Tell libpq whether it needs to initialize OpenSSL
|
||||
FUNCTION: void PQinitSSL ( int do_init ) ;
|
||||
|
||||
! Set verbosity for PQerrorMessage and PQresultErrorMessage
|
||||
FUNCTION: PGVerbosity PQsetErrorVerbosity ( PGconn* conn,
|
||||
PGVerbosity verbosity ) ;
|
||||
|
||||
! Enable/disable tracing
|
||||
FUNCTION: void PQtrace ( PGconn* conn, FILE* debug_port ) ;
|
||||
FUNCTION: void PQuntrace ( PGconn* conn ) ;
|
||||
|
||||
! BROKEN
|
||||
! Function types for notice-handling callbacks
|
||||
! typedef void (*PQnoticeReceiver) (void *arg, PGresult *res);
|
||||
! typedef void (*PQnoticeProcessor) (void *arg, char* message);
|
||||
! ALIAS: void* PQnoticeReceiver
|
||||
! ALIAS: void* PQnoticeProcessor
|
||||
|
||||
! Override default notice handling routines
|
||||
! FUNCTION: PQnoticeReceiver PQsetNoticeReceiver ( PGconn* conn,
|
||||
! PQnoticeReceiver proc,
|
||||
! void* arg ) ;
|
||||
! FUNCTION: PQnoticeProcessor PQsetNoticeProcessor ( PGconn* conn,
|
||||
! PQnoticeProcessor proc,
|
||||
! void* arg ) ;
|
||||
! END BROKEN
|
||||
|
||||
! === in fe-exec.c ===
|
||||
|
||||
! Simple synchronous query
|
||||
FUNCTION: PGresult* PQexec ( PGconn* conn, char* query ) ;
|
||||
FUNCTION: PGresult* PQexecParams ( PGconn* conn,
|
||||
char* command,
|
||||
int nParams,
|
||||
Oid* paramTypes,
|
||||
char** paramValues,
|
||||
int* paramLengths,
|
||||
int* paramFormats,
|
||||
int resultFormat ) ;
|
||||
FUNCTION: PGresult* PQprepare ( PGconn* conn, char* stmtName,
|
||||
char* query, int nParams,
|
||||
Oid* paramTypes ) ;
|
||||
FUNCTION: PGresult* PQexecPrepared ( PGconn* conn,
|
||||
char* stmtName,
|
||||
int nParams,
|
||||
char** paramValues,
|
||||
int* paramLengths,
|
||||
int* paramFormats,
|
||||
int resultFormat ) ;
|
||||
|
||||
! Interface for multiple-result or asynchronous queries
|
||||
FUNCTION: int PQsendQuery ( PGconn* conn, char* query ) ;
|
||||
FUNCTION: int PQsendQueryParams ( PGconn* conn,
|
||||
char* command,
|
||||
int nParams,
|
||||
Oid* paramTypes,
|
||||
char** paramValues,
|
||||
int* paramLengths,
|
||||
int* paramFormats,
|
||||
int resultFormat ) ;
|
||||
FUNCTION: PGresult* PQsendPrepare ( PGconn* conn, char* stmtName,
|
||||
char* query, int nParams,
|
||||
Oid* paramTypes ) ;
|
||||
FUNCTION: int PQsendQueryPrepared ( PGconn* conn,
|
||||
char* stmtName,
|
||||
int nParams,
|
||||
char** paramValues,
|
||||
int *paramLengths,
|
||||
int *paramFormats,
|
||||
int resultFormat ) ;
|
||||
FUNCTION: PGresult* PQgetResult ( PGconn* conn ) ;
|
||||
|
||||
! Routines for managing an asynchronous query
|
||||
FUNCTION: int PQisBusy ( PGconn* conn ) ;
|
||||
FUNCTION: int PQconsumeInput ( PGconn* conn ) ;
|
||||
|
||||
! LISTEN/NOTIFY support
|
||||
FUNCTION: PGnotify* PQnotifies ( PGconn* conn ) ;
|
||||
|
||||
! Routines for copy in/out
|
||||
FUNCTION: int PQputCopyData ( PGconn* conn, char* buffer, int nbytes ) ;
|
||||
FUNCTION: int PQputCopyEnd ( PGconn* conn, char* errormsg ) ;
|
||||
FUNCTION: int PQgetCopyData ( PGconn* conn, char** buffer, int async ) ;
|
||||
|
||||
! Deprecated routines for copy in/out
|
||||
FUNCTION: int PQgetline ( PGconn* conn, char* string, int length ) ;
|
||||
FUNCTION: int PQputline ( PGconn* conn, char* string ) ;
|
||||
FUNCTION: int PQgetlineAsync ( PGconn* conn, char* buffer, int bufsize ) ;
|
||||
FUNCTION: int PQputnbytes ( PGconn* conn, char* buffer, int nbytes ) ;
|
||||
FUNCTION: int PQendcopy ( PGconn* conn ) ;
|
||||
|
||||
! Set blocking/nonblocking connection to the backend
|
||||
FUNCTION: int PQsetnonblocking ( PGconn* conn, int arg ) ;
|
||||
FUNCTION: int PQisnonblocking ( PGconn* conn ) ;
|
||||
|
||||
! Force the write buffer to be written (or at least try)
|
||||
FUNCTION: int PQflush ( PGconn* conn ) ;
|
||||
|
||||
!
|
||||
! * "Fast path" interface --- not really recommended for application
|
||||
! * use
|
||||
!
|
||||
FUNCTION: PGresult* PQfn ( PGconn* conn,
|
||||
int fnid,
|
||||
int* result_buf,
|
||||
int* result_len,
|
||||
int result_is_int,
|
||||
PQArgBlock* args,
|
||||
int nargs ) ;
|
||||
|
||||
! Accessor functions for PGresult objects
|
||||
FUNCTION: ExecStatusType PQresultStatus ( PGresult* res ) ;
|
||||
FUNCTION: char* PQresStatus ( ExecStatusType status ) ;
|
||||
FUNCTION: char* PQresultErrorMessage ( PGresult* res ) ;
|
||||
FUNCTION: char* PQresultErrorField ( PGresult* res, int fieldcode ) ;
|
||||
FUNCTION: int PQntuples ( PGresult* res ) ;
|
||||
FUNCTION: int PQnfields ( PGresult* res ) ;
|
||||
FUNCTION: int PQbinaryTuples ( PGresult* res ) ;
|
||||
FUNCTION: char* PQfname ( PGresult* res, int field_num ) ;
|
||||
FUNCTION: int PQfnumber ( PGresult* res, char* field_name ) ;
|
||||
FUNCTION: Oid PQftable ( PGresult* res, int field_num ) ;
|
||||
FUNCTION: int PQftablecol ( PGresult* res, int field_num ) ;
|
||||
FUNCTION: int PQfformat ( PGresult* res, int field_num ) ;
|
||||
FUNCTION: Oid PQftype ( PGresult* res, int field_num ) ;
|
||||
FUNCTION: int PQfsize ( PGresult* res, int field_num ) ;
|
||||
FUNCTION: int PQfmod ( PGresult* res, int field_num ) ;
|
||||
FUNCTION: char* PQcmdStatus ( PGresult* res ) ;
|
||||
FUNCTION: char* PQoidStatus ( PGresult* res ) ;
|
||||
FUNCTION: Oid PQoidValue ( PGresult* res ) ;
|
||||
FUNCTION: char* PQcmdTuples ( PGresult* res ) ;
|
||||
FUNCTION: char* PQgetvalue ( PGresult* res, int tup_num, int field_num ) ;
|
||||
FUNCTION: int PQgetlength ( PGresult* res, int tup_num, int field_num ) ;
|
||||
FUNCTION: int PQgetisnull ( PGresult* res, int tup_num, int field_num ) ;
|
||||
|
||||
! Delete a PGresult
|
||||
FUNCTION: void PQclear ( PGresult* res ) ;
|
||||
|
||||
! For freeing other alloc'd results, such as PGnotify structs
|
||||
FUNCTION: void PQfreemem ( void* ptr ) ;
|
||||
|
||||
! Exists for backward compatibility.
|
||||
: PQfreeNotify PQfreemem ;
|
||||
|
||||
!
|
||||
! Make an empty PGresult with given status (some apps find this
|
||||
! useful). If conn is not NULL and status indicates an error, the
|
||||
! conn's errorMessage is copied.
|
||||
!
|
||||
FUNCTION: PGresult* PQmakeEmptyPGresult ( PGconn* conn, ExecStatusType status ) ;
|
||||
|
||||
! Quoting strings before inclusion in queries.
|
||||
FUNCTION: size_t PQescapeStringConn ( PGconn* conn,
|
||||
char* to, char* from, size_t length,
|
||||
int* error ) ;
|
||||
FUNCTION: uchar* PQescapeByteaConn ( PGconn* conn,
|
||||
char* from, size_t length,
|
||||
size_t* to_length ) ;
|
||||
FUNCTION: uchar* PQunescapeBytea ( uchar* strtext,
|
||||
size_t* retbuflen ) ;
|
||||
! These forms are deprecated!
|
||||
FUNCTION: size_t PQescapeString ( void* to, char* from, size_t length ) ;
|
||||
FUNCTION: uchar* PQescapeBytea ( uchar* bintext, size_t binlen,
|
||||
size_t* bytealen ) ;
|
||||
|
||||
! === in fe-print.c ===
|
||||
|
||||
FUNCTION: void PQprint ( FILE* fout, PGresult* res, PQprintOpt* ps ) ;
|
||||
|
||||
! really old printing routines
|
||||
FUNCTION: void PQdisplayTuples ( PGresult* res,
|
||||
FILE* fp,
|
||||
int fillAlign,
|
||||
char* fieldSep,
|
||||
int printHeader,
|
||||
int quiet ) ;
|
||||
|
||||
FUNCTION: void PQprintTuples ( PGresult* res,
|
||||
FILE* fout,
|
||||
int printAttName,
|
||||
int terseOutput,
|
||||
int width ) ;
|
||||
|
||||
! === in fe-lobj.c ===
|
||||
|
||||
! Large-object access routines
|
||||
FUNCTION: int lo_open ( PGconn* conn, Oid lobjId, int mode ) ;
|
||||
FUNCTION: int lo_close ( PGconn* conn, int fd ) ;
|
||||
FUNCTION: int lo_read ( PGconn* conn, int fd, char* buf, size_t len ) ;
|
||||
FUNCTION: int lo_write ( PGconn* conn, int fd, char* buf, size_t len ) ;
|
||||
FUNCTION: int lo_lseek ( PGconn* conn, int fd, int offset, int whence ) ;
|
||||
FUNCTION: Oid lo_creat ( PGconn* conn, int mode ) ;
|
||||
! FUNCTION: Oid lo_creat ( PGconn* conn, Oid lobjId ) ;
|
||||
FUNCTION: int lo_tell ( PGconn* conn, int fd ) ;
|
||||
FUNCTION: int lo_unlink ( PGconn* conn, Oid lobjId ) ;
|
||||
FUNCTION: Oid lo_import ( PGconn* conn, char* filename ) ;
|
||||
FUNCTION: int lo_export ( PGconn* conn, Oid lobjId, char* filename ) ;
|
||||
|
||||
! === in fe-misc.c ===
|
||||
|
||||
! Determine length of multibyte encoded char at *s
|
||||
FUNCTION: int PQmblen ( uchar* s, int encoding ) ;
|
||||
|
||||
! Determine display length of multibyte encoded char at *s
|
||||
FUNCTION: int PQdsplen ( uchar* s, int encoding ) ;
|
||||
|
||||
! Get encoding id from environment variable PGCLIENTENCODING
|
||||
FUNCTION: int PQenv2encoding ( ) ;
|
||||
|
|
@ -0,0 +1,72 @@
|
|||
USING: arrays continuations db io kernel math namespaces
|
||||
quotations sequences db.postgresql.ffi ;
|
||||
IN: db.postgresql.lib
|
||||
|
||||
SYMBOL: query-res
|
||||
|
||||
: connect-postgres ( host port pgopts pgtty db user pass -- conn )
|
||||
PQsetdbLogin
|
||||
dup PQstatus zero? [ "couldn't connect to database" throw ] unless ;
|
||||
|
||||
: postgresql-result-error-message ( res -- str/f )
|
||||
dup zero? [
|
||||
drop f
|
||||
] [
|
||||
PQresultErrorMessage [ CHAR: \n = ] right-trim
|
||||
] if ;
|
||||
|
||||
: postgres-result-error ( res -- )
|
||||
postgresql-result-error-message [ throw ] when* ;
|
||||
|
||||
: postgresql-error-message ( -- str )
|
||||
db get db-handle PQerrorMessage [ CHAR: \n = ] right-trim ;
|
||||
|
||||
: postgresql-error ( res -- res )
|
||||
dup [ postgresql-error-message throw ] unless ;
|
||||
|
||||
: postgresql-result-ok? ( n -- ? )
|
||||
PQresultStatus
|
||||
PGRES_COMMAND_OK PGRES_TUPLES_OK 2array member? ;
|
||||
|
||||
: do-postgresql-statement ( statement -- res )
|
||||
db get db-handle swap statement-sql PQexec dup postgresql-result-ok? [
|
||||
dup postgresql-result-error-message swap PQclear throw
|
||||
] unless ;
|
||||
|
||||
! : do-command ( str -- )
|
||||
! 1quotation \ (do-command) add db get swap call ;
|
||||
|
||||
! : prepare ( str quot word -- conn quot )
|
||||
! rot 1quotation swap append swap append db get swap ;
|
||||
|
||||
! : do-query ( str quot -- )
|
||||
! [ (do-query) query-res set ] prepare catch
|
||||
! [ rethrow ] [ query-res get PQclear ] if* ;
|
||||
|
||||
! : result>seq ( -- seq )
|
||||
! query-res get [ PQnfields ] keep PQntuples
|
||||
! [ swap [ query-res get -rot PQgetvalue ] with map ] with map ;
|
||||
!
|
||||
! : print-table ( seq -- )
|
||||
! [ [ write bl ] each "\n" write ] each ;
|
||||
|
||||
|
||||
|
||||
! select * from animal where name = 'Simba'
|
||||
! select * from animal where name = $1
|
||||
|
||||
! : (do-query) ( PGconn query -- PGresult* )
|
||||
! ! For queries that do not return rows, PQexec() returns PGRES_COMMAND_OK
|
||||
! ! For queries that return rows, PQexec() returns PGRES_TUPLES_OK
|
||||
! PQexec dup postgresql-result-ok? [
|
||||
! dup postgresql-error-message swap PQclear throw
|
||||
! ] unless ;
|
||||
|
||||
! : (do-command) ( PGconn query -- PGresult* )
|
||||
! [ (do-query) ] catch
|
||||
! [
|
||||
! swap
|
||||
! "non-fatal error: " print
|
||||
! "\tQuery: " write "'" write write "'" print
|
||||
! "\t" write print
|
||||
! ] when* drop ;
|
||||
|
|
@ -0,0 +1,54 @@
|
|||
! You will need to run 'createdb factor-test' to create the database.
|
||||
! Set username and password in the 'connect' word.
|
||||
|
||||
USING: kernel db.postgresql alien continuations io prettyprint
|
||||
sequences namespaces tools.test ;
|
||||
IN: temporary
|
||||
|
||||
: test-connection ( host port pgopts pgtty db user pass -- bool )
|
||||
[ [ ] with-postgres ] catch "Error connecting!" "Connected!" ? print ;
|
||||
|
||||
[ ] [ "localhost" "" "" "" "factor-test" "postgres" "" test-connection ] unit-test
|
||||
|
||||
[ ] [ "localhost" "postgres" "" "factor-test" <postgresql-db> [ ] with-db ] unit-test
|
||||
|
||||
! just a basic demo
|
||||
|
||||
"localhost" "postgres" "" "factor-test" <postgresql-db> [
|
||||
[ ] [ "drop table animal" do-command ] unit-test
|
||||
|
||||
[ ] [ "create table animal (id serial not null primary key, species varchar(256), name varchar(256), age integer)" do-command ] unit-test
|
||||
|
||||
[ ] [ "insert into animal (species, name, age) values ('lion', 'Mufasa', 5)"
|
||||
do-command ] unit-test
|
||||
|
||||
[ ] [ "select * from animal where name = 'Mufasa'" [ ] do-query ] unit-test
|
||||
[ ] [ "select * from animal where name = 'Mufasa'" [
|
||||
result>seq length 1 = [
|
||||
"...there can only be one Mufasa..." throw
|
||||
] unless
|
||||
] do-query
|
||||
] unit-test
|
||||
|
||||
[ ] [ "insert into animal (species, name, age) values ('lion', 'Simba', 1)"
|
||||
do-command ] unit-test
|
||||
|
||||
[ ] [
|
||||
"select * from animal"
|
||||
[
|
||||
"Animal table:" print
|
||||
result>seq print-table
|
||||
] do-query
|
||||
] unit-test
|
||||
|
||||
! intentional errors
|
||||
! [ "select asdf from animal"
|
||||
! [ ] do-query ] catch [ "caught: " write print ] when*
|
||||
! "select asdf from animal" [ ] do-query
|
||||
! "aofijweafew" do-command
|
||||
] with-db
|
||||
|
||||
|
||||
"localhost" "postgres" "" "factor-test" <postgresql-db> [
|
||||
[ ] [ "drop table animal" do-command ] unit-test
|
||||
] with-db
|
||||
|
|
@ -0,0 +1,87 @@
|
|||
! Copyright (C) 2007 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
! adapted from libpq-fe.h version 7.4.7
|
||||
! tested on debian linux with postgresql 7.4.7
|
||||
|
||||
USING: arrays assocs alien alien.syntax continuations io
|
||||
kernel math namespaces prettyprint quotations
|
||||
sequences debugger db db.postgresql.lib db.postgresql.ffi ;
|
||||
IN: db.postgresql
|
||||
|
||||
TUPLE: postgresql-db host port pgopts pgtty db user pass ;
|
||||
TUPLE: postgresql-statement ;
|
||||
: <postgresql-statement> ( statement -- postgresql-statement )
|
||||
postgresql-statement construct-delegate ;
|
||||
|
||||
: <postgresql-db> ( host user pass db -- obj )
|
||||
{
|
||||
set-postgresql-db-host
|
||||
set-postgresql-db-user
|
||||
set-postgresql-db-pass
|
||||
set-postgresql-db-db
|
||||
} postgresql-db construct ;
|
||||
|
||||
M: postgresql-db db-open ( db -- )
|
||||
dup {
|
||||
postgresql-db-host
|
||||
postgresql-db-port
|
||||
postgresql-db-pgopts
|
||||
postgresql-db-pgtty
|
||||
postgresql-db-db
|
||||
postgresql-db-user
|
||||
postgresql-db-pass
|
||||
} get-slots connect-postgres <db> swap set-delegate ;
|
||||
|
||||
M: postgresql-db dispose ( db -- )
|
||||
db-handle PQfinish ;
|
||||
|
||||
: with-postgresql ( host ust pass db quot -- )
|
||||
>r <postgresql-db> r> with-disposal ;
|
||||
|
||||
M: postgresql-statement #rows ( statement -- n )
|
||||
statement-handle PQntuples ;
|
||||
|
||||
M: postgresql-statement #columns ( statement -- n )
|
||||
statement-handle PQnfields ;
|
||||
|
||||
M: postgresql-statement row-column ( statement n -- obj )
|
||||
>r dup statement-handle swap statement-n r> PQgetvalue ;
|
||||
|
||||
: init-statement ( statement -- )
|
||||
dup statement-max [
|
||||
dup do-postgresql-statement over set-statement-handle
|
||||
dup #rows over set-statement-max
|
||||
-1 over set-statement-n
|
||||
] unless drop ;
|
||||
|
||||
: increment-n ( statement -- n )
|
||||
dup statement-n 1+ dup rot set-statement-n ;
|
||||
|
||||
M: postgresql-statement advance-row ( statement -- ? )
|
||||
dup init-statement
|
||||
dup increment-n swap statement-max >= ;
|
||||
|
||||
M: postgresql-statement dispose ( query -- )
|
||||
dup statement-handle PQclear
|
||||
0 0 rot { set-statement-n set-statement-max } set-slots ;
|
||||
|
||||
M: postgresql-statement prepare-statement ( statement -- )
|
||||
[
|
||||
>r db get db-handle "" r>
|
||||
dup statement-sql swap statement-params
|
||||
dup assoc-size swap PQprepare postgresql-error
|
||||
] keep set-statement-handle ;
|
||||
|
||||
M: postgresql-db <simple-statement> ( sql -- statement )
|
||||
{ set-statement-sql } statement construct
|
||||
<postgresql-statement> ;
|
||||
|
||||
M: postgresql-db <bound-statement> ( sql array -- statement )
|
||||
{ set-statement-sql set-statement-params } statement construct
|
||||
<postgresql-statement> ;
|
||||
|
||||
M: postgresql-db <prepared-statement> ( sql -- statement )
|
||||
;
|
||||
|
||||
M: postgresql-db <prepared-bound-statement> ( sql seq -- statement )
|
||||
;
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
Chris Double
|
||||
Doug Coleman
|
||||
|
|
@ -0,0 +1,131 @@
|
|||
! Copyright (C) 2005 Chris Double, Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
!
|
||||
! An interface to the sqlite database. Tested against sqlite v3.1.3.
|
||||
|
||||
! Not all functions have been wrapped yet. Only those directly involving
|
||||
! executing SQL calls and obtaining results.
|
||||
|
||||
USING: alien compiler kernel math namespaces sequences strings alien.syntax
|
||||
system combinators ;
|
||||
IN: db.sqlite.ffi
|
||||
|
||||
<<
|
||||
"sqlite" {
|
||||
{ [ winnt? ] [ "sqlite3.dll" ] }
|
||||
{ [ macosx? ] [ "/usr/lib/libsqlite3.dylib" ] }
|
||||
{ [ unix? ] [ "libsqlite3.so" ] }
|
||||
} cond "cdecl" add-library >>
|
||||
|
||||
! Return values from sqlite functions
|
||||
: SQLITE_OK 0 ; inline ! Successful result
|
||||
: SQLITE_ERROR 1 ; inline ! SQL error or missing database
|
||||
: SQLITE_INTERNAL 2 ; inline ! An internal logic error in SQLite
|
||||
: SQLITE_PERM 3 ; inline ! Access permission denied
|
||||
: SQLITE_ABORT 4 ; inline ! Callback routine requested an abort
|
||||
: SQLITE_BUSY 5 ; inline ! The database file is locked
|
||||
: SQLITE_LOCKED 6 ; inline ! A table in the database is locked
|
||||
: SQLITE_NOMEM 7 ; inline ! A malloc() failed
|
||||
: SQLITE_READONLY 8 ; inline ! Attempt to write a readonly database
|
||||
: SQLITE_INTERRUPT 9 ; inline ! Operation terminated by sqlite_interrupt()
|
||||
: SQLITE_IOERR 10 ; inline ! Some kind of disk I/O error occurred
|
||||
: SQLITE_CORRUPT 11 ; inline ! The database disk image is malformed
|
||||
: SQLITE_NOTFOUND 12 ; inline ! (Internal Only) Table or record not found
|
||||
: SQLITE_FULL 13 ; inline ! Insertion failed because database is full
|
||||
: SQLITE_CANTOPEN 14 ; inline ! Unable to open the database file
|
||||
: SQLITE_PROTOCOL 15 ; inline ! Database lock protocol error
|
||||
: SQLITE_EMPTY 16 ; inline ! (Internal Only) Database table is empty
|
||||
: SQLITE_SCHEMA 17 ; inline ! The database schema changed
|
||||
: SQLITE_TOOBIG 18 ; inline ! Too much data for one row of a table
|
||||
: SQLITE_CONSTRAINT 19 ; inline ! Abort due to contraint violation
|
||||
: SQLITE_MISMATCH 20 ; inline ! Data type mismatch
|
||||
: SQLITE_MISUSE 21 ; inline ! Library used incorrectly
|
||||
: SQLITE_NOLFS 22 ; inline ! Uses OS features not supported on host
|
||||
: SQLITE_AUTH 23 ; inline ! Authorization denied
|
||||
: SQLITE_FORMAT 24 ; inline ! Auxiliary database format error
|
||||
: SQLITE_RANGE 25 ; inline ! 2nd parameter to sqlite3_bind out of range
|
||||
: SQLITE_NOTADB 26 ; inline ! File opened that is not a database file
|
||||
|
||||
: sqlite-error-messages ( -- seq ) {
|
||||
"Successful result"
|
||||
"SQL error or missing database"
|
||||
"An internal logic error in SQLite"
|
||||
"Access permission denied"
|
||||
"Callback routine requested an abort"
|
||||
"The database file is locked"
|
||||
"A table in the database is locked"
|
||||
"A malloc() failed"
|
||||
"Attempt to write a readonly database"
|
||||
"Operation terminated by sqlite_interrupt()"
|
||||
"Some kind of disk I/O error occurred"
|
||||
"The database disk image is malformed"
|
||||
"(Internal Only) Table or record not found"
|
||||
"Insertion failed because database is full"
|
||||
"Unable to open the database file"
|
||||
"Database lock protocol error"
|
||||
"(Internal Only) Database table is empty"
|
||||
"The database schema changed"
|
||||
"Too much data for one row of a table"
|
||||
"Abort due to contraint violation"
|
||||
"Data type mismatch"
|
||||
"Library used incorrectly"
|
||||
"Uses OS features not supported on host"
|
||||
"Authorization denied"
|
||||
"Auxiliary database format error"
|
||||
"2nd parameter to sqlite3_bind out of range"
|
||||
"File opened that is not a database file"
|
||||
} ;
|
||||
|
||||
: SQLITE_ROW 100 ; inline ! sqlite_step() has another row ready
|
||||
: SQLITE_DONE 101 ; inline ! sqlite_step() has finished executing
|
||||
|
||||
! Return values from the sqlite3_column_type function
|
||||
: SQLITE_INTEGER 1 ; inline
|
||||
: SQLITE_FLOAT 2 ; inline
|
||||
: SQLITE_TEXT 3 ; inline
|
||||
: SQLITE_BLOB 4 ; inline
|
||||
: SQLITE_NULL 5 ; inline
|
||||
|
||||
! Values for the 'destructor' parameter of the 'bind' routines.
|
||||
: SQLITE_STATIC 0 ; inline
|
||||
: SQLITE_TRANSIENT -1 ; inline
|
||||
|
||||
: SQLITE_OPEN_READONLY HEX: 00000001 ; inline
|
||||
: SQLITE_OPEN_READWRITE HEX: 00000002 ; inline
|
||||
: SQLITE_OPEN_CREATE HEX: 00000004 ; inline
|
||||
: SQLITE_OPEN_DELETEONCLOSE HEX: 00000008 ; inline
|
||||
: SQLITE_OPEN_EXCLUSIVE HEX: 00000010 ; inline
|
||||
: SQLITE_OPEN_MAIN_DB HEX: 00000100 ; inline
|
||||
: SQLITE_OPEN_TEMP_DB HEX: 00000200 ; inline
|
||||
: SQLITE_OPEN_TRANSIENT_DB HEX: 00000400 ; inline
|
||||
: SQLITE_OPEN_MAIN_JOURNAL HEX: 00000800 ; inline
|
||||
: SQLITE_OPEN_TEMP_JOURNAL HEX: 00001000 ; inline
|
||||
: SQLITE_OPEN_SUBJOURNAL HEX: 00002000 ; inline
|
||||
: SQLITE_OPEN_MASTER_JOURNAL HEX: 00004000 ; inline
|
||||
|
||||
|
||||
TYPEDEF: void sqlite3
|
||||
TYPEDEF: void sqlite3_stmt
|
||||
|
||||
LIBRARY: sqlite
|
||||
FUNCTION: int sqlite3_open ( char* filename, void* ppDb ) ;
|
||||
FUNCTION: int sqlite3_open_v2 ( char* filename, void* ppDb, int flags, char* zVfs ) ;
|
||||
FUNCTION: int sqlite3_close ( sqlite3* pDb ) ;
|
||||
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 ) ;
|
||||
FUNCTION: int sqlite3_last_insert_rowid ( sqlite3* pStmt ) ;
|
||||
FUNCTION: int sqlite3_bind_blob ( sqlite3_stmt* pStmt, int index, void* ptr, int len, int destructor ) ;
|
||||
FUNCTION: int sqlite3_bind_int ( sqlite3_stmt* pStmt, int index, int n ) ;
|
||||
FUNCTION: int sqlite3_bind_null ( sqlite3_stmt* pStmt, int n ) ;
|
||||
FUNCTION: int sqlite3_bind_text ( sqlite3_stmt* pStmt, int index, char* text, int len, int destructor ) ;
|
||||
FUNCTION: int sqlite3_bind_parameter_index ( sqlite3_stmt* pStmt, char* name ) ;
|
||||
FUNCTION: int sqlite3_column_count ( sqlite3_stmt* pStmt ) ;
|
||||
FUNCTION: void* sqlite3_column_blob ( sqlite3_stmt* pStmt, int col ) ;
|
||||
FUNCTION: int sqlite3_column_bytes ( sqlite3_stmt* pStmt, int col ) ;
|
||||
FUNCTION: char* sqlite3_column_decltype ( sqlite3_stmt* pStmt, int col ) ;
|
||||
FUNCTION: int sqlite3_column_int ( sqlite3_stmt* pStmt, int col ) ;
|
||||
FUNCTION: int sqlite3_column_name ( sqlite3_stmt* pStmt, int col ) ;
|
||||
FUNCTION: char* sqlite3_column_text ( sqlite3_stmt* pStmt, int col ) ;
|
||||
FUNCTION: int sqlite3_column_type ( sqlite3_stmt* pStmt, int col ) ;
|
||||
|
|
@ -0,0 +1,103 @@
|
|||
USING: alien.c-types assocs kernel math math.parser sequences
|
||||
db.sqlite.ffi ;
|
||||
IN: db.sqlite.lib
|
||||
|
||||
TUPLE: sqlite-error n message ;
|
||||
|
||||
: sqlite-check-result ( result -- )
|
||||
dup SQLITE_OK = [
|
||||
drop
|
||||
] [
|
||||
dup sqlite-error-messages nth
|
||||
sqlite-error construct-boa throw
|
||||
] if ;
|
||||
|
||||
: sqlite-open ( filename -- db )
|
||||
"void*" <c-object>
|
||||
[ sqlite3_open sqlite-check-result ] keep *void* ;
|
||||
|
||||
: sqlite-close ( db -- )
|
||||
sqlite3_close sqlite-check-result ;
|
||||
|
||||
: sqlite-last-insert-rowid ( db -- rowid )
|
||||
sqlite3_last_insert_rowid ;
|
||||
|
||||
: sqlite-prepare ( db sql -- statement )
|
||||
#! TODO: Support multiple statements in the SQL string.
|
||||
dup length "void*" <c-object> "void*" <c-object>
|
||||
[ sqlite3_prepare sqlite-check-result ] 2keep
|
||||
drop *void* ;
|
||||
|
||||
: sqlite-bind-text ( statement index text -- )
|
||||
dup number? [ number>string ] when
|
||||
dup length SQLITE_TRANSIENT sqlite3_bind_text sqlite-check-result ;
|
||||
|
||||
: sqlite-bind-parameter-index ( statement name -- index )
|
||||
sqlite3_bind_parameter_index ;
|
||||
|
||||
: sqlite-bind-text-by-name ( statement name text -- )
|
||||
>r dupd sqlite-bind-parameter-index r> sqlite-bind-text ;
|
||||
|
||||
: sqlite-bind-assoc ( statement assoc -- )
|
||||
swap [
|
||||
-rot sqlite-bind-text-by-name
|
||||
] curry assoc-each ;
|
||||
|
||||
: sqlite-finalize ( statement -- )
|
||||
sqlite3_finalize sqlite-check-result ;
|
||||
|
||||
: sqlite-reset ( statement -- )
|
||||
sqlite3_reset sqlite-check-result ;
|
||||
|
||||
: sqlite-#columns ( query -- int )
|
||||
sqlite3_column_count ;
|
||||
|
||||
: sqlite-column ( statement index -- string )
|
||||
sqlite3_column_text ;
|
||||
|
||||
: sqlite-row ( statement -- seq )
|
||||
dup sqlite-#columns [ sqlite-column ] with map ;
|
||||
|
||||
! 2dup sqlite3_column_type .
|
||||
! SQLITE_INTEGER 1
|
||||
! SQLITE_FLOAT 2
|
||||
! SQLITE_TEXT 3
|
||||
! SQLITE_BLOB 4
|
||||
! SQLITE_NULL 5
|
||||
|
||||
|
||||
: step-complete? ( step-result -- bool )
|
||||
dup SQLITE_ROW = [
|
||||
drop f
|
||||
] [
|
||||
dup SQLITE_DONE = [ drop t ] [ sqlite-check-result t ] if
|
||||
] if ;
|
||||
|
||||
: sqlite-step ( prepared -- )
|
||||
dup sqlite3_step step-complete? [
|
||||
drop
|
||||
] [
|
||||
sqlite-step
|
||||
] if ;
|
||||
|
||||
: sqlite-next ( prepared -- )
|
||||
sqlite3_step step-complete? ;
|
||||
|
||||
: sqlite-each ( statement quot -- )
|
||||
over sqlite3_step step-complete? [
|
||||
2drop
|
||||
] [
|
||||
[ call ] 2keep sqlite-each
|
||||
] if ; inline
|
||||
|
||||
DEFER: (sqlite-map)
|
||||
|
||||
: (sqlite-map) ( statement quot seq -- )
|
||||
pick sqlite3_step step-complete? [
|
||||
2nip
|
||||
] [
|
||||
>r 2dup call r> swap add (sqlite-map)
|
||||
] if ;
|
||||
|
||||
: sqlite-map ( statement quot -- seq )
|
||||
{ } (sqlite-map) ;
|
||||
|
|
@ -0,0 +1,99 @@
|
|||
USING: io io.files io.launcher kernel namespaces
|
||||
prettyprint tools.test db.sqlite db db.sql sequences
|
||||
continuations ;
|
||||
IN: temporary
|
||||
|
||||
! "sqlite3 -init test.txt test.db"
|
||||
|
||||
: test.db "extra/db/sqlite/test.db" resource-path ;
|
||||
|
||||
: (create-db) ( -- str )
|
||||
[
|
||||
"sqlite3 -init " %
|
||||
"extra/db/sqlite/test.txt" resource-path %
|
||||
" " %
|
||||
test.db %
|
||||
] "" make ;
|
||||
|
||||
: create-db ( -- ) (create-db) run-process drop ;
|
||||
|
||||
[ ] [ test.db delete-file ] unit-test
|
||||
|
||||
[ ] [ create-db ] unit-test
|
||||
|
||||
[
|
||||
{
|
||||
{ "John" "America" }
|
||||
{ "Jane" "New Zealand" }
|
||||
}
|
||||
] [ test.db [ "select * from person" do-simple-query ] with-sqlite ] unit-test
|
||||
|
||||
[
|
||||
{ { "John" "America" } }
|
||||
] [
|
||||
test.db [
|
||||
"select * from person where name = :name and country = :country"
|
||||
{ { ":name" "Jane" } { ":country" "New Zealand" } }
|
||||
<bound-statement> dup [ sql-row ] query-map
|
||||
|
||||
{ { "Jane" "New Zealand" } } = [ "test fails" throw ] unless
|
||||
{ { ":name" "John" } { ":country" "America" } } over bind-statement
|
||||
|
||||
dup [ sql-row ] query-map swap dispose
|
||||
] with-sqlite
|
||||
] unit-test
|
||||
|
||||
[
|
||||
{
|
||||
{ "1" "John" "America" }
|
||||
{ "2" "Jane" "New Zealand" }
|
||||
}
|
||||
] [ test.db [ "select rowid, * from person" do-simple-query ] with-sqlite ] unit-test
|
||||
|
||||
[
|
||||
] [
|
||||
"extra/db/sqlite/test.db" resource-path [
|
||||
"insert into person(name, country) values('Jimmy', 'Canada')"
|
||||
do-simple-command
|
||||
] with-sqlite
|
||||
] unit-test
|
||||
|
||||
[
|
||||
{
|
||||
{ "1" "John" "America" }
|
||||
{ "2" "Jane" "New Zealand" }
|
||||
{ "3" "Jimmy" "Canada" }
|
||||
}
|
||||
] [ test.db [ "select rowid, * from person" do-simple-query ] with-sqlite ] unit-test
|
||||
|
||||
[
|
||||
"extra/db/sqlite/test.db" resource-path [
|
||||
[
|
||||
"insert into person(name, country) values('Jose', 'Mexico')" do-simple-command
|
||||
"insert into person(name, country) values('Jose', 'Mexico')" do-simple-command
|
||||
"oops" throw
|
||||
] with-transaction
|
||||
] with-sqlite
|
||||
] unit-test-fails
|
||||
|
||||
[ 3 ] [
|
||||
"extra/db/sqlite/test.db" resource-path [
|
||||
"select * from person" do-simple-query length
|
||||
] with-sqlite
|
||||
] unit-test
|
||||
|
||||
[
|
||||
] [
|
||||
"extra/db/sqlite/test.db" resource-path [
|
||||
[
|
||||
"insert into person(name, country) values('Jose', 'Mexico')" do-simple-command
|
||||
"insert into person(name, country) values('Jose', 'Mexico')" do-simple-command
|
||||
] with-transaction
|
||||
] with-sqlite
|
||||
] unit-test
|
||||
|
||||
[ 5 ] [
|
||||
"extra/db/sqlite/test.db" resource-path [
|
||||
"select * from person" do-simple-query length
|
||||
] with-sqlite
|
||||
] unit-test
|
||||
|
|
@ -0,0 +1,70 @@
|
|||
! Copyright (C) 2005, 2008 Chris Double, Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien arrays assocs classes compiler db db.sql hashtables
|
||||
io.files kernel math math.parser namespaces prettyprint sequences
|
||||
strings sqlite.lib tuples alien.c-types continuations
|
||||
db.sqlite.lib db.sqlite.ffi ;
|
||||
IN: db.sqlite
|
||||
|
||||
TUPLE: sqlite-db path ;
|
||||
C: <sqlite-db> sqlite-db
|
||||
|
||||
M: sqlite-db db-open ( db -- )
|
||||
dup sqlite-db-path sqlite-open <db>
|
||||
swap set-delegate ;
|
||||
|
||||
M: sqlite-db dispose ( obj -- )
|
||||
dup db-handle sqlite-close
|
||||
f over set-db-handle
|
||||
f swap set-delegate ;
|
||||
|
||||
: with-sqlite ( path quot -- )
|
||||
>r <sqlite-db> r> with-db ; inline
|
||||
|
||||
TUPLE: sqlite-statement ;
|
||||
C: <sqlite-statement> sqlite-statement
|
||||
|
||||
M: sqlite-db <simple-statement> ( str -- obj )
|
||||
<prepared-statement> ;
|
||||
|
||||
M: sqlite-db <bound-statement> ( str -- obj )
|
||||
<prepared-bound-statement> ;
|
||||
|
||||
M: sqlite-db <prepared-statement> ( str -- obj )
|
||||
db get db-handle over sqlite-prepare
|
||||
{ set-statement-sql set-statement-handle } statement construct
|
||||
<sqlite-statement> [ set-delegate ] keep ;
|
||||
|
||||
M: sqlite-db <prepared-bound-statement> ( str assoc -- obj )
|
||||
swap <prepared-statement> tuck bind-statement ;
|
||||
|
||||
M: sqlite-statement dispose ( statement -- )
|
||||
statement-handle sqlite-finalize ;
|
||||
|
||||
M: sqlite-statement bind-statement* ( assoc statement -- )
|
||||
statement-handle swap sqlite-bind-assoc ;
|
||||
|
||||
M: sqlite-statement rebind-statement ( assoc statement -- )
|
||||
dup reset-statement
|
||||
statement-handle swap sqlite-bind-assoc ;
|
||||
|
||||
M: sqlite-statement #columns ( statement -- n )
|
||||
statement-handle sqlite-#columns ;
|
||||
|
||||
M: sqlite-statement row-column ( statement n -- obj )
|
||||
>r statement-handle r> sqlite-column ;
|
||||
|
||||
M: sqlite-statement advance-row ( statement -- ? )
|
||||
statement-handle sqlite-next ;
|
||||
|
||||
M: sqlite-statement reset-statement ( statement -- )
|
||||
statement-handle sqlite-reset ;
|
||||
|
||||
M: sqlite-db begin-transaction ( -- )
|
||||
"BEGIN" do-simple-command ;
|
||||
|
||||
M: sqlite-db commit-transaction ( -- )
|
||||
"COMMIT" do-simple-command ;
|
||||
|
||||
M: sqlite-db rollback-transaction ( -- )
|
||||
"ROLLBACK" do-simple-command ;
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
create table person (name varchar(30), country varchar(30));
|
||||
insert into person values('John', 'America');
|
||||
insert into person values('Jane', 'New Zealand');
|
||||
Loading…
Reference in New Issue