initial libs/sql
erg
parent
9e705d5599
commit
688425f94d
|
|
@ -0,0 +1,10 @@
|
|||
USING: kernel namespaces ;
|
||||
IN: sql
|
||||
|
||||
GENERIC: execute-sql* ( string db -- )
|
||||
GENERIC: query-sql* ( string db -- seq )
|
||||
|
||||
: execute-sql ( string -- ) db get execute-sql* ;
|
||||
: query-sql ( string -- ) db get query-sql* ;
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,27 @@
|
|||
PROVIDE: libs/sql
|
||||
{ +files+ {
|
||||
"sql.factor"
|
||||
"utils.factor"
|
||||
"simple.factor"
|
||||
"mappings.factor"
|
||||
"execute.factor"
|
||||
|
||||
"sqlite/libsqlite.factor"
|
||||
"sqlite/sqlite.factor"
|
||||
"sqlite/simple.factor"
|
||||
"sqlite/execute.factor"
|
||||
"postgresql/libpq.factor"
|
||||
"postgresql/postgresql.factor"
|
||||
"postgresql/simple.factor"
|
||||
"postgresql/execute.factor"
|
||||
|
||||
"tupledb.factor"
|
||||
|
||||
"thewebsite.factor"
|
||||
} }
|
||||
{ +tests+ {
|
||||
"test/data.factor"
|
||||
"test/insert.factor"
|
||||
"test/util.factor"
|
||||
} } ;
|
||||
|
||||
|
|
@ -0,0 +1 @@
|
|||
IN: sql
|
||||
|
|
@ -0,0 +1 @@
|
|||
IN: postgresql
|
||||
|
|
@ -0,0 +1,353 @@
|
|||
! See http://factor.sf.net/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
|
||||
|
||||
IN: postgresql
|
||||
USING: alien ;
|
||||
|
||||
|
||||
! 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,60 @@
|
|||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
|
||||
! adapted from libpq-fe.h version 7.4.7
|
||||
! tested on debian linux with postgresql 7.4.7
|
||||
|
||||
IN: postgresql
|
||||
USING: kernel alien errors io prettyprint sequences namespaces arrays math sql ;
|
||||
|
||||
SYMBOL: query-res
|
||||
|
||||
: connect-postgres ( host port pgopts pgtty db user pass -- conn )
|
||||
PQsetdbLogin
|
||||
dup PQstatus zero? [ "couldn't connect to database" throw ] unless ;
|
||||
|
||||
: with-postgres ( host port pgopts pgtty db user pass quot -- )
|
||||
[ >r connect-postgres db set r>
|
||||
[ db get PQfinish ] cleanup ] with-scope ; inline
|
||||
|
||||
: with-postgres-catch ( host port pgopts pgtty db user pass quot -- )
|
||||
[ with-postgres ] catch [ "caught: " write print ] when* ;
|
||||
|
||||
: postgres-error ( ret -- ret )
|
||||
dup zero? [ PQresultErrorMessage throw ] when ;
|
||||
|
||||
: (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 PQresultStatus PGRES_COMMAND_OK =
|
||||
over PQresultStatus PGRES_TUPLES_OK =
|
||||
or [
|
||||
[ PQresultErrorMessage CHAR: \n swap remove ] keep 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 ;
|
||||
|
||||
: do-command ( str -- )
|
||||
unit \ (do-command) add db get swap call ;
|
||||
|
||||
: prepare ( str quot word -- conn quot )
|
||||
rot unit 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 ] map-with ] map-with ;
|
||||
|
||||
: print-table ( seq -- )
|
||||
[ [ write bl ] each "\n" write ] each ;
|
||||
|
||||
|
|
@ -0,0 +1 @@
|
|||
IN: postgresql
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
USING: kernel ;
|
||||
IN: sql
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,52 @@
|
|||
USING: generic kernel namespaces prettyprint sequences sql:utils ;
|
||||
IN: sql
|
||||
|
||||
GENERIC: create-sql* ( tuple db -- string )
|
||||
GENERIC: drop-sql* ( tuple db -- string )
|
||||
GENERIC: insert-sql* ( tuple db -- string )
|
||||
GENERIC: delete-sql* ( tuple db -- string )
|
||||
GENERIC: update-sql* ( tuple db -- string )
|
||||
GENERIC: select-sql* ( tuple db -- string )
|
||||
|
||||
: create-sql ( tuple -- string ) db get create-sql* ;
|
||||
: drop-sql ( tuple -- string ) db get drop-sql* ;
|
||||
: insert-sql ( tuple -- string ) db get insert-sql* ;
|
||||
: delete-sql ( tuple -- string ) db get delete-sql* ;
|
||||
: update-sql ( tuple -- string ) db get update-sql* ;
|
||||
: select-sql ( tuple -- string ) db get select-sql* ;
|
||||
|
||||
M: connection create-sql* ( tuple db -- string )
|
||||
drop [
|
||||
"create table " %
|
||||
dup class unparse % "(" %
|
||||
tuple>mapping%
|
||||
");" %
|
||||
] "" make ;
|
||||
|
||||
M: connection drop-sql* ( tuple db -- string )
|
||||
drop [ "drop table " % tuple>sql-name % ";" % ] "" make ;
|
||||
|
||||
M: connection insert-sql* ( tuple db -- string )
|
||||
drop [
|
||||
"insert into " %
|
||||
dup tuple>sql-name %
|
||||
" (" % tuple>insert-parts dup first ", " join %
|
||||
") values(" %
|
||||
second [ escape-sql enquote ] map ", " join %
|
||||
");" %
|
||||
] "" make ;
|
||||
|
||||
M: connection delete-sql* ( tuple db -- string )
|
||||
drop [
|
||||
! "delete from table " % unparse % ";" %
|
||||
] "" make ;
|
||||
|
||||
M: connection update-sql* ( tuples db -- string )
|
||||
drop [
|
||||
] "" make ;
|
||||
|
||||
M: connection select-sql* ( tuples db -- string )
|
||||
drop [
|
||||
] "" make ;
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
USING: kernel namespaces ;
|
||||
IN: sql
|
||||
|
||||
SYMBOL: db
|
||||
TUPLE: connection handle ;
|
||||
|
||||
! TESTING
|
||||
"handle" <connection> db set-global
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
USING: kernel namespaces sql ;
|
||||
IN: sqlite
|
||||
|
||||
M: sqlite execute-sql* ( string db -- )
|
||||
connection-handle swap
|
||||
sqlite-prepare dup [ drop ] sqlite-each sqlite-finalize ;
|
||||
|
||||
|
|
@ -0,0 +1,111 @@
|
|||
! 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.
|
||||
! Remeber to pass the following to factor:
|
||||
! -libraries:sqlite=libsqlite3.so
|
||||
!
|
||||
! Not all functions have been wrapped yet. Only those directly involving
|
||||
! executing SQL calls and obtaining results.
|
||||
!
|
||||
IN: libsqlite
|
||||
USING: alien compiler errors kernel math namespaces sequences strings ;
|
||||
|
||||
! 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
|
||||
|
||||
TYPEDEF: void sqlite3
|
||||
TYPEDEF: void sqlite3_stmt
|
||||
|
||||
LIBRARY: sqlite
|
||||
FUNCTION: int sqlite3_open ( char* filename, void* ppDb ) ;
|
||||
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,11 @@
|
|||
PROVIDE: libs/sqlite
|
||||
{ +files+ {
|
||||
"libsqlite.factor"
|
||||
"sqlite.factor"
|
||||
"sqlite.facts"
|
||||
"tuple-db.factor"
|
||||
"tuple-db.facts"
|
||||
} }
|
||||
{ +tests+ {
|
||||
"tuple-db-tests.factor"
|
||||
} } ;
|
||||
|
|
@ -0,0 +1,24 @@
|
|||
USING: generic kernel namespaces prettyprint sql sql:utils ;
|
||||
IN: sqlite
|
||||
|
||||
TUPLE: sqlite ;
|
||||
C: sqlite ( path -- db )
|
||||
>r sqlite-open <connection> r>
|
||||
[ set-delegate ] keep ;
|
||||
|
||||
! M: sqlite insert-sql* ( tuple db -- string )
|
||||
#! Insert and fill in the ID column
|
||||
! ;
|
||||
|
||||
M: sqlite delete-sql* ( tuple db -- string )
|
||||
#! Delete based on the ID column
|
||||
;
|
||||
|
||||
M: sqlite update-sql* ( tuple db -- string )
|
||||
#! Update based on the ID column
|
||||
;
|
||||
|
||||
M: sqlite select-sql* ( tuple db -- string )
|
||||
;
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,126 @@
|
|||
! Copyright (C) 2005 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
!
|
||||
! An interface to the sqlite database. Tested against sqlite v3.0.8.
|
||||
! Remeber to pass the following to factor:
|
||||
! -libraries:sqlite=libsqlite3.so
|
||||
!
|
||||
! Not all functions have been wrapped yet. Only those directly involving
|
||||
! executing SQL calls and obtaining results.
|
||||
!
|
||||
IN: sqlite
|
||||
USING: alien compiler errors libsqlite kernel namespaces sequences sql strings ;
|
||||
|
||||
TUPLE: sqlite-error n message ;
|
||||
|
||||
! High level sqlite routines
|
||||
: sqlite-check-result ( result -- )
|
||||
#! Check the result from a sqlite call is ok. If it is
|
||||
#! return, otherwise throw an error.
|
||||
dup SQLITE_OK = [
|
||||
drop
|
||||
] [
|
||||
dup sqlite-error-messages nth <sqlite-error> throw
|
||||
] if ;
|
||||
|
||||
: sqlite-open ( filename -- db )
|
||||
#! Open the database referenced by the filename and return
|
||||
#! a handle to that database. An error is thrown if the database
|
||||
#! failed to open.
|
||||
"void*" <c-object> [ sqlite3_open sqlite-check-result ] keep *void* ;
|
||||
|
||||
: sqlite-close ( db -- )
|
||||
#! Close the given database
|
||||
sqlite3_close sqlite-check-result ;
|
||||
|
||||
: sqlite-last-insert-rowid ( db -- rowid )
|
||||
#! Return the rowid of the last insert
|
||||
sqlite3_last_insert_rowid ;
|
||||
|
||||
: sqlite-prepare ( db sql -- statement )
|
||||
#! Prepare a SQL statement. Returns the statement which
|
||||
#! can have values bound to parameters or simply executed.
|
||||
#! 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 -- )
|
||||
#! Bind the text to the parameterized value in the statement.
|
||||
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-finalize ( statement -- )
|
||||
#! Clean up all resources related to a statement. Once called
|
||||
#! the statement cannot be used. All statements must be finalized
|
||||
#! before closing the database.
|
||||
sqlite3_finalize sqlite-check-result ;
|
||||
|
||||
: sqlite-reset ( statement -- )
|
||||
#! Reset a statement so it can be called again, possibly with
|
||||
#! different parameters.
|
||||
sqlite3_reset sqlite-check-result ;
|
||||
|
||||
: column-count ( statement -- int )
|
||||
#! Given a prepared statement, return the number of
|
||||
#! columns in each row of the result set of that statement.
|
||||
sqlite3_column_count ;
|
||||
|
||||
: column-text ( statement index -- string )
|
||||
#! Return the value of the given column, indexed
|
||||
#! from zero, as a string.
|
||||
sqlite3_column_text ;
|
||||
|
||||
: step-complete? ( step-result -- bool )
|
||||
#! Return true if the result of a sqlite3_step is
|
||||
#! such that the iteration has completed (ie. it is
|
||||
#! SQLITE_DONE). Throw an error if an error occurs.
|
||||
dup SQLITE_ROW = [
|
||||
drop f
|
||||
] [
|
||||
dup SQLITE_DONE = [
|
||||
drop t
|
||||
] [
|
||||
sqlite-check-result t
|
||||
] if
|
||||
] if ;
|
||||
|
||||
: sqlite-each ( statement quot -- )
|
||||
#! Execute the SQL statement, and call the quotation for
|
||||
#! each row returned from executing the statement with the
|
||||
#! statement on the top of the stack.
|
||||
over sqlite3_step step-complete? [
|
||||
2drop
|
||||
] [
|
||||
[ call ] 2keep sqlite-each
|
||||
] if ; inline
|
||||
|
||||
! For comparison, here is the linrec implementation of sqlite-each
|
||||
! [ drop sqlite3_step step-complete? ]
|
||||
! [ 2drop ]
|
||||
! [ 2dup 2slip ]
|
||||
! [ ] linrec ;
|
||||
|
||||
DEFER: (sqlite-map)
|
||||
|
||||
: (sqlite-map) ( statement quot seq -- )
|
||||
pick sqlite3_step step-complete? [
|
||||
2nip
|
||||
] [
|
||||
>r 2dup call r> curry (sqlite-map)
|
||||
] if ;
|
||||
|
||||
: sqlite-map ( statement quot -- seq )
|
||||
[ ] (sqlite-map) ;
|
||||
|
||||
: with-sqlite ( path quot -- )
|
||||
[
|
||||
>r sqlite-open db set r>
|
||||
[ db get sqlite-close ] cleanup
|
||||
] with-scope ;
|
||||
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
USING: kernel math sql:utils ;
|
||||
IN: sql
|
||||
|
||||
: save ( tuple -- )
|
||||
dup "id" tuple-slot [
|
||||
! update
|
||||
] [
|
||||
! insert
|
||||
] if ;
|
||||
|
||||
: restore ( tuple -- )
|
||||
;
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,151 @@
|
|||
USING: arrays errors generic hashtables kernel math namespaces
|
||||
prettyprint sequences sql strings tools words ;
|
||||
IN: sql:utils
|
||||
|
||||
! : 2seq>hash 2array flip alist>hash ;
|
||||
|
||||
: 2seq>hash ( seq seq -- hash )
|
||||
H{ } clone -rot [ pick set-hash ] 2each ;
|
||||
|
||||
: tuple-fields ( tuple -- seq )
|
||||
class "slot-names" word-prop ;
|
||||
|
||||
: tuple>parts ( tuple -- values names )
|
||||
[ tuple-slots ] keep tuple-fields ;
|
||||
|
||||
: tuple>hash ( tuple -- hash )
|
||||
tuple>parts 2seq>hash ;
|
||||
|
||||
: tuple>all-slots
|
||||
delegates <reversed> V{ } clone
|
||||
[ tuple-slots dupd nappend ] reduce
|
||||
<reversed> prune <reversed> >array ;
|
||||
|
||||
: tuple>all-fields
|
||||
delegates <reversed> V{ } clone
|
||||
[ tuple-fields dupd nappend ] reduce
|
||||
<reversed> prune <reversed> >array ;
|
||||
|
||||
: full-tuple>hash ( tuple -- hash )
|
||||
delegates <reversed>
|
||||
H{ } clone [ tuple>hash hash-union ] reduce ;
|
||||
|
||||
: tuple>all-parts ( tuple -- values names )
|
||||
[
|
||||
[ full-tuple>hash ] keep tuple>all-fields
|
||||
[ swap hash ] map-with
|
||||
] keep tuple>all-fields ;
|
||||
|
||||
: maybe-unparse ( obj -- )
|
||||
dup string? [ unparse ] unless ;
|
||||
|
||||
: replace ( new old seq -- seq )
|
||||
>r 2seq>hash r> [
|
||||
[
|
||||
[
|
||||
tuck swap hash* [ nip ] [ drop ] if
|
||||
dup sequence? [ % ] [ , ] if
|
||||
] each-with
|
||||
] { } make
|
||||
] keep like ;
|
||||
|
||||
GENERIC: escape-sql* ( string type db -- string )
|
||||
|
||||
M: connection escape-sql* ( string type db -- string )
|
||||
drop { "''" } "'" rot replace ;
|
||||
|
||||
: escape-sql ( string type -- string ) db get escape-sql* ;
|
||||
|
||||
: sanitize-name ( string -- string )
|
||||
"_p" "-?" pick subst ;
|
||||
|
||||
: tuple>sql-name ( tuple -- string )
|
||||
class unparse sanitize-name ;
|
||||
|
||||
: enquote% "'" % % "'" % ;
|
||||
|
||||
: enquote ( string -- 'string' )
|
||||
[ enquote% ] "" make ;
|
||||
|
||||
: split-last ( seq -- last most )
|
||||
dup length {
|
||||
{ [ dup zero? ] [ 2drop f f ] }
|
||||
{ [ dup 1 = ] [ drop f ] }
|
||||
{ [ t ] [ >r [ peek 1array ] keep r> 1- head ] }
|
||||
} cond ;
|
||||
|
||||
: (each-last) ( seq quot quot -- )
|
||||
>r >r split-last r> each r> each ; inline
|
||||
|
||||
: each-last ( seq quot quot -- )
|
||||
>r dup clone r> append swap (each-last) ;
|
||||
|
||||
: (2each-last) ( seq seq quot quot -- )
|
||||
>r >r [ split-last ] 2apply swapd r> 2each r> 2each ; inline
|
||||
|
||||
: 2each-last ( seq seq quot quot -- )
|
||||
#! apply first quotation on all but last elt of seq
|
||||
#! apply second quotation on last element
|
||||
>r dup clone r> append swap (2each-last) ;
|
||||
|
||||
! <foo1> { integer string }
|
||||
! mapping: { integer { varchar(256) "not null" } }
|
||||
! { "a integer" "b string" }
|
||||
|
||||
SYMBOL: mappings
|
||||
H{ } clone mappings set-global
|
||||
|
||||
: get-mapping ( tuple -- seq )
|
||||
dup class mappings get hash* [
|
||||
nip
|
||||
] [
|
||||
drop tuple-slots [ drop "varchar" ] map
|
||||
] if ;
|
||||
|
||||
: tuple>mapping% ( obj -- seq )
|
||||
[ get-mapping ] keep tuple-fields
|
||||
[ sanitize-name % " " % % ] [ ", " % ] 2each-last ;
|
||||
|
||||
: tuple>mapping ( tuple -- string )
|
||||
[ tuple>mapping% ] "" make ;
|
||||
|
||||
: tuple>insert-parts ( tuple -- string )
|
||||
[
|
||||
tuple>parts
|
||||
[
|
||||
dup "id" = [
|
||||
2drop
|
||||
] [
|
||||
over [ swap 2array , ] [ 2drop ] if
|
||||
] if
|
||||
] 2each
|
||||
] { } make flip ;
|
||||
|
||||
: tuple>assignments% ( tuple -- string )
|
||||
[ tuple-slots [ maybe-unparse escape-sql ] map ] keep
|
||||
tuple-fields
|
||||
[ sanitize-name % " = " % enquote% ] [ ", " % ] 2each-last ;
|
||||
|
||||
: tuple>assignments% ( tuple -- string )
|
||||
tuple>parts dup [ "id" = ] find drop
|
||||
dup -1 = [ "tuple must have an id slot" throw ] when
|
||||
swap >r tuck >r remove-nth r> r> remove-nth
|
||||
>r [ maybe-unparse escape-sql ] map r>
|
||||
[ % " = " % enquote% ] [ ", " % ] 2each-last ;
|
||||
|
||||
: tuple>assignments ( tuple -- string )
|
||||
[ tuple>assignments% ] "" make ;
|
||||
|
||||
: tuple-slot ( string slot -- ? obj )
|
||||
"slot-names" over class word-props hash
|
||||
rot [ = ] curry find over -1 = [
|
||||
swap
|
||||
] [
|
||||
drop 2 + swap tuple>array nth >r t r>
|
||||
] if ;
|
||||
|
||||
: explode-tuple ( tuple -- )
|
||||
dup tuple-slots swap class "slot-names" word-prop
|
||||
[ set ] 2each ;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue