+++ /dev/null
-Chris Double
+++ /dev/null
-! Copyright (C) 2007 Chris Double.\r
-! See http://factorcode.org/license.txt for BSD license.\r
-USING: help.syntax help.markup threads ;\r
-\r
-IN: odbc\r
-\r
-HELP: odbc-init \r
-{ $values { "env" "an ODBC environment handle" } } \r
-{ $description \r
- "Initializes the ODBC driver manager and returns the " \r
- "environment handle required by " { $link odbc-connect } "."\r
-} \r
-{ $see-also odbc-init odbc-connect odbc-disconnect odbc-prepare odbc-free-statement odbc-execute odbc-next-row odbc-number-of-columns odbc-describe-column odbc-get-field odbc-get-row-fields odbc-get-all-rows odbc-query } ;\r
-\r
-HELP: odbc-connect \r
-{ $values { "env" "an ODBC environment handle" } { "dsn" "a string" } { "dbc" "an ODBC database connection handle" } } \r
-{ $description \r
- "Connects to the database identified by the ODBC data source name (DSN). " \r
- "The environment handle is usually obtained by a call to " { $link odbc-init } ". The result is the ODBC connection handle which can be used in other ODBC calls. When finished with the connection handle " { $link odbc-disconnect } " must be called on it."\r
-} \r
-{ $examples { $code "dbc get \"DSN=mydsn\" odbc-connect" } }\r
-{ $see-also odbc-init odbc-connect odbc-disconnect odbc-prepare odbc-free-statement odbc-execute odbc-next-row odbc-number-of-columns odbc-describe-column odbc-get-field odbc-get-row-fields odbc-get-all-rows odbc-query } ;\r
-\r
-HELP: odbc-disconnect \r
-{ $values { "dbc" "an ODBC database connection handle" } } \r
-{ $description \r
- "Disconnects from the given database." \r
-} \r
-{ $see-also odbc-init odbc-connect odbc-disconnect odbc-prepare odbc-free-statement odbc-execute odbc-next-row odbc-number-of-columns odbc-describe-column odbc-get-field odbc-get-row-fields odbc-get-all-rows odbc-query } ;\r
-\r
-HELP: odbc-prepare\r
-{ $values { "dbc" "an ODBC database connection handle" } { "string" "a string containing SQL" } { "statement" "an ODBC statement handle" } } \r
-{ $description \r
- "Prepares (precompiles) the given SQL string, ready for execution with " { $link odbc-execute } ". When finished with the statement " { $link odbc-free-statement } " must be called on it." \r
-} \r
-{ $see-also odbc-init odbc-connect odbc-disconnect odbc-prepare odbc-free-statement odbc-execute odbc-next-row odbc-number-of-columns odbc-describe-column odbc-get-field odbc-get-row-fields odbc-get-all-rows odbc-query } ;\r
-\r
-HELP: odbc-free-statement\r
-{ $values { "statement" "an ODBC statement handle" } } \r
-{ $description \r
- "Closes the statement handle and frees up all resources associated with it." \r
-} \r
-{ $see-also odbc-init odbc-connect odbc-disconnect odbc-prepare odbc-free-statement odbc-execute odbc-next-row odbc-number-of-columns odbc-describe-column odbc-get-field odbc-get-row-fields odbc-get-all-rows odbc-query } ;\r
-\r
-HELP: odbc-execute\r
-{ $values { "statement" "an ODBC statement handle" } } \r
-{ $description \r
- "Executes the statement. Once this is done " { $link odbc-next-row } " can be called to retrieve rows." \r
-} \r
-{ $see-also odbc-init odbc-connect odbc-disconnect odbc-prepare odbc-free-statement odbc-execute odbc-next-row odbc-number-of-columns odbc-describe-column odbc-get-field odbc-get-row-fields odbc-get-all-rows odbc-query } ;\r
-\r
-HELP: odbc-next-row\r
-{ $values { "statement" "an ODBC statement handle" } { "bool" "a boolean indicating success or failure" } } \r
-{ $description \r
- "Retrieves the next available row from the database. If no next row is available then " { $link f } " is returned. Once the row is retrieved " { $link odbc-number-of-columns } ", " { $link odbc-describe-column } ", " { $link odbc-get-field } " and " { $link odbc-get-row-fields } " can be used to query the data retrieved." \r
-} \r
-{ $see-also odbc-init odbc-connect odbc-disconnect odbc-prepare odbc-free-statement odbc-execute odbc-next-row odbc-number-of-columns odbc-describe-column odbc-get-field odbc-get-row-fields odbc-get-all-rows odbc-query } ;\r
-\r
-HELP: odbc-number-of-columns\r
-{ $values { "statement" "an ODBC statement handle" } { "number" "a number" } } \r
-{ $description \r
- "Returns the number of columns of data retrieved."\r
-} \r
-{ $see-also odbc-init odbc-connect odbc-disconnect odbc-prepare odbc-free-statement odbc-execute odbc-next-row odbc-number-of-columns odbc-describe-column odbc-get-field odbc-get-row-fields odbc-get-all-rows odbc-query } ;\r
-\r
-HELP: odbc-describe-column\r
-{ $values { "statement" "an ODBC statement handle" } { "n" "a column number starting from one" } { "column" "a column object" } } \r
-{ $description \r
- "Retrieves column information for the given column number from the statement. The column number must be one or greater. The " { $link <column> } " object returned provides data type, name, etc."\r
-} \r
-{ $see-also odbc-init odbc-connect odbc-disconnect odbc-prepare odbc-free-statement odbc-execute odbc-next-row odbc-number-of-columns odbc-describe-column odbc-get-field odbc-get-row-fields odbc-get-all-rows odbc-query } ;\r
-\r
-HELP: odbc-get-field\r
-{ $values { "statement" "an ODBC statement handle" } { "column" "a column number starting from one or a <column> object" } { "field" "a <field> object" } } \r
-{ $description \r
- "Returns a field object which contains the data for the field in the given column in the current row. The column can be identified by a number or a <column> object. The datatype of the contents of the field depends on the type of the column itself. Note that this word can only be safely called once on each column in a given row with most ODBC drivers. Subsequent calls on the same row for the same column can fail."\r
-} \r
-{ $see-also odbc-init odbc-connect odbc-disconnect odbc-prepare odbc-free-statement odbc-execute odbc-next-row odbc-number-of-columns odbc-describe-column odbc-get-field odbc-get-row-fields odbc-get-all-rows odbc-query } ;\r
-\r
-HELP: odbc-get-row-fields\r
-{ $values { "statement" "an ODBC statement handle" } { "seq" "a sequence" } } \r
-{ $description \r
- "Returns a sequence of all field data for the current row. Note that this isnot the <field> objects, but the data for that field. This word can only be called once on a given row. Subsequent calls on the same row may fail on some ODBC drivers."\r
-} \r
-{ $see-also odbc-init odbc-connect odbc-disconnect odbc-prepare odbc-free-statement odbc-execute odbc-next-row odbc-number-of-columns odbc-describe-column odbc-get-field odbc-get-row-fields odbc-get-all-rows odbc-query } ;\r
-\r
-HELP: odbc-get-all-rows\r
-{ $values { "statement" "an ODBC statement handle" } { "seq" "a sequence" } } \r
-{ $description \r
- "Returns a sequence of all rows available from the statement. Effectively it is the contents of the entire query so may take some time and memory. Each element of the sequence is itself a sequence containing the data for that row. A " { $link yield } " is performed an various intervals so as to not lock up the Factor instance while it is running."\r
-} \r
-{ $see-also odbc-init odbc-connect odbc-disconnect odbc-prepare odbc-free-statement odbc-execute odbc-next-row odbc-number-of-columns odbc-describe-column odbc-get-field odbc-get-row-fields odbc-get-all-rows odbc-query } ;\r
-\r
-HELP: odbc-query\r
-{ $values { "string" "a string containing SQL" } { "dsn" "a DSN string" } { "result" "a sequence" } } \r
-{ $description \r
- "This word initializes odbc, connects to the database with the given DSN, executes the query string and returns the result as a sequence. It cleans up all resources it uses. It is an inefficient way of running multiple queries but is useful for the occasional query, testing at the REPL, or as an example of how to do it."\r
-} \r
-{ $see-also odbc-init odbc-connect odbc-disconnect odbc-prepare odbc-free-statement odbc-execute odbc-next-row odbc-number-of-columns odbc-describe-column odbc-get-field odbc-get-row-fields odbc-get-all-rows odbc-query } ;\r
+++ /dev/null
-! Copyright (C) 2007 Chris Double.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel alien alien.strings alien.syntax
-combinators alien.c-types strings sequences namespaces make
-words math threads io.encodings.ascii ;
-IN: odbc
-
-<< "odbc" "odbc32.dll" "stdcall" add-library >>
-
-LIBRARY: odbc
-
-TYPEDEF: void* usb_dev_handle*
-TYPEDEF: short SQLRETURN
-TYPEDEF: short SQLSMALLINT
-TYPEDEF: short* SQLSMALLINT*
-TYPEDEF: ushort SQLUSMALLINT
-TYPEDEF: uint* SQLUINTEGER*
-TYPEDEF: int SQLINTEGER
-TYPEDEF: char SQLCHAR
-TYPEDEF: char* SQLCHAR*
-TYPEDEF: void* SQLHANDLE
-TYPEDEF: void* SQLHANDLE*
-TYPEDEF: void* SQLHENV
-TYPEDEF: void* SQLHDBC
-TYPEDEF: void* SQLHSTMT
-TYPEDEF: void* SQLHWND
-TYPEDEF: void* SQLPOINTER
-
-: SQL-HANDLE-ENV ( -- number ) 1 ; inline
-: SQL-HANDLE-DBC ( -- number ) 2 ; inline
-: SQL-HANDLE-STMT ( -- number ) 3 ; inline
-: SQL-HANDLE-DESC ( -- number ) 4 ; inline
-
-: SQL-NULL-HANDLE ( -- alien ) f ; inline
-
-: SQL-ATTR-ODBC-VERSION ( -- number ) 200 ; inline
-
-: SQL-OV-ODBC2 ( -- number ) 2 <alien> ; inline
-: SQL-OV-ODBC3 ( -- number ) 3 <alien> ; inline
-
-: SQL-SUCCESS ( -- number ) 0 ; inline
-: SQL-SUCCESS-WITH-INFO ( -- number ) 1 ; inline
-: SQL-NO-DATA-FOUND ( -- number ) 100 ; inline
-
-: SQL-DRIVER-NOPROMPT ( -- number ) 0 ; inline
-: SQL-DRIVER-PROMPT ( -- number ) 2 ; inline
-
-: SQL-C-DEFAULT ( -- number ) 99 ; inline
-
-SYMBOL: SQL-CHAR
-SYMBOL: SQL-VARCHAR
-SYMBOL: SQL-LONGVARCHAR
-SYMBOL: SQL-WCHAR
-SYMBOL: SQL-WCHARVAR
-SYMBOL: SQL-WLONGCHARVAR
-SYMBOL: SQL-DECIMAL
-SYMBOL: SQL-SMALLINT
-SYMBOL: SQL-NUMERIC
-SYMBOL: SQL-INTEGER
-SYMBOL: SQL-REAL
-SYMBOL: SQL-FLOAT
-SYMBOL: SQL-DOUBLE
-SYMBOL: SQL-BIT
-SYMBOL: SQL-TINYINT
-SYMBOL: SQL-BIGINT
-SYMBOL: SQL-BINARY
-SYMBOL: SQL-VARBINARY
-SYMBOL: SQL-LONGVARBINARY
-SYMBOL: SQL-TYPE-DATE
-SYMBOL: SQL-TYPE-TIME
-SYMBOL: SQL-TYPE-TIMESTAMP
-SYMBOL: SQL-TYPE-UTCDATETIME
-SYMBOL: SQL-TYPE-UTCTIME
-SYMBOL: SQL-INTERVAL-MONTH
-SYMBOL: SQL-INTERVAL-YEAR
-SYMBOL: SQL-INTERVAL-YEAR-TO-MONTH
-SYMBOL: SQL-INTERVAL-DAY
-SYMBOL: SQL-INTERVAL-HOUR
-SYMBOL: SQL-INTERVAL-MINUTE
-SYMBOL: SQL-INTERVAL-SECOND
-SYMBOL: SQL-INTERVAL-DAY-TO-HOUR
-SYMBOL: SQL-INTERVAL-DAY-TO-MINUTE
-SYMBOL: SQL-INTERVAL-DAY-TO-SECOND
-SYMBOL: SQL-INTERVAL-HOUR-TO-MINUTE
-SYMBOL: SQL-INTERVAL-HOUR-TO-SECOND
-SYMBOL: SQL-INTERVAL-MINUTE-TO-SECOND
-SYMBOL: SQL-GUID
-SYMBOL: SQL-TYPE-UNKNOWN
-
-: convert-sql-type ( number -- symbol )
- {
- { 1 [ SQL-CHAR ] }
- { 12 [ SQL-VARCHAR ] }
- { -1 [ SQL-LONGVARCHAR ] }
- { -8 [ SQL-WCHAR ] }
- { -9 [ SQL-WCHARVAR ] }
- { -10 [ SQL-WLONGCHARVAR ] }
- { 3 [ SQL-DECIMAL ] }
- { 5 [ SQL-SMALLINT ] }
- { 2 [ SQL-NUMERIC ] }
- { 4 [ SQL-INTEGER ] }
- { 7 [ SQL-REAL ] }
- { 6 [ SQL-FLOAT ] }
- { 8 [ SQL-DOUBLE ] }
- { -7 [ SQL-BIT ] }
- { -6 [ SQL-TINYINT ] }
- { -5 [ SQL-BIGINT ] }
- { -2 [ SQL-BINARY ] }
- { -3 [ SQL-VARBINARY ] }
- { -4 [ SQL-LONGVARBINARY ] }
- { 91 [ SQL-TYPE-DATE ] }
- { 92 [ SQL-TYPE-TIME ] }
- { 93 [ SQL-TYPE-TIMESTAMP ] }
- [ drop SQL-TYPE-UNKNOWN ]
- } case ;
-
-: succeeded? ( n -- bool )
- #! Did the call succeed (SQL-SUCCESS or SQL-SUCCESS-WITH-INFO)
- {
- { SQL-SUCCESS [ t ] }
- { SQL-SUCCESS-WITH-INFO [ t ] }
- [ drop f ]
- } case ;
-
-FUNCTION: SQLRETURN SQLAllocHandle ( SQLSMALLINT handleType, SQLHANDLE inputHandle, SQLHANDLE* outputHandlePtr ) ;
-FUNCTION: SQLRETURN SQLSetEnvAttr ( SQLHENV environmentHandle, SQLINTEGER attribute, SQLPOINTER valuePtr, SQLINTEGER stringLength ) ;
-FUNCTION: SQLRETURN SQLDriverConnect ( SQLHDBC connectionHandle, SQLHWND windowHandle, SQLCHAR* inConnectionString, SQLSMALLINT stringLength, SQLCHAR* outConnectionString, SQLSMALLINT bufferLength, SQLSMALLINT* stringLength2Ptr, SQLUSMALLINT driverCompletion ) ;
-FUNCTION: SQLRETURN SQLDisconnect ( SQLHDBC connectionHandle ) ;
-FUNCTION: SQLRETURN SQLPrepare ( SQLHSTMT statementHandle, SQLCHAR* statementText, SQLINTEGER length ) ;
-FUNCTION: SQLRETURN SQLExecute ( SQLHSTMT statementHandle ) ;
-FUNCTION: SQLRETURN SQLFreeHandle ( SQLSMALLINT handleType, SQLHANDLE handle ) ;
-FUNCTION: SQLRETURN SQLFetch ( SQLHSTMT statementHandle ) ;
-FUNCTION: SQLRETURN SQLNumResultCols ( SQLHSTMT statementHandle, SQLSMALLINT* columnCountPtr ) ;
-FUNCTION: SQLRETURN SQLDescribeCol ( SQLHSTMT statementHandle, SQLSMALLINT columnNumber, SQLCHAR* columnName, SQLSMALLINT bufferLength, SQLSMALLINT* nameLengthPtr, SQLSMALLINT* dataTypePtr, SQLUINTEGER* columnSizePtr, SQLSMALLINT* decimalDigitsPtr, SQLSMALLINT* nullablePtr ) ;
-FUNCTION: SQLRETURN SQLGetData ( SQLHSTMT statementHandle, SQLUSMALLINT columnNumber, SQLSMALLINT targetType, SQLPOINTER targetValuePtr, SQLINTEGER bufferLength, SQLINTEGER* strlen_or_indPtr ) ;
-
-: alloc-handle ( type parent -- handle )
- f <void*> [ SQLAllocHandle ] keep swap succeeded? [
- *void*
- ] [
- drop f
- ] if ;
-
-: alloc-env-handle ( -- handle )
- SQL-HANDLE-ENV SQL-NULL-HANDLE alloc-handle ;
-
-: alloc-dbc-handle ( env -- handle )
- SQL-HANDLE-DBC swap alloc-handle ;
-
-: alloc-stmt-handle ( dbc -- handle )
- SQL-HANDLE-STMT swap alloc-handle ;
-
-: temp-string ( length -- byte-array length )
- [ CHAR: \space <string> ascii string>alien ] keep ;
-
-: odbc-init ( -- env )
- alloc-env-handle
- [
- SQL-ATTR-ODBC-VERSION SQL-OV-ODBC3 0 SQLSetEnvAttr
- succeeded? [ "odbc-init failed" throw ] unless
- ] keep ;
-
-: odbc-connect ( env dsn -- dbc )
- >r alloc-dbc-handle dup r>
- f swap dup length 1024 temp-string 0 <short> SQL-DRIVER-NOPROMPT
- SQLDriverConnect succeeded? [ "odbc-connect failed" throw ] unless ;
-
-: odbc-disconnect ( dbc -- )
- SQLDisconnect succeeded? [ "odbc-disconnect failed" throw ] unless ;
-
-: odbc-prepare ( dbc string -- statement )
- >r alloc-stmt-handle dup r> dup length SQLPrepare succeeded? [ "odbc-prepare failed" throw ] unless ;
-
-: odbc-free-statement ( statement -- )
- SQL-HANDLE-STMT swap SQLFreeHandle succeeded? [ "odbc-free-statement failed" throw ] unless ;
-
-: odbc-execute ( statement -- )
- SQLExecute succeeded? [ "odbc-execute failed" throw ] unless ;
-
-: odbc-next-row ( statement -- bool )
- SQLFetch succeeded? ;
-
-: odbc-number-of-columns ( statement -- number )
- 0 <short> [ SQLNumResultCols succeeded? ] keep swap [
- *short
- ] [
- drop f
- ] if ;
-
-TUPLE: column nullable digits size type name number ;
-
-C: <column> column
-
-: odbc-describe-column ( statement n -- column )
- dup >r
- 1024 CHAR: \space <string> ascii string>alien dup >r
- 1024
- 0 <short>
- 0 <short> dup >r
- 0 <uint> dup >r
- 0 <short> dup >r
- 0 <short> dup >r
- SQLDescribeCol succeeded? [
- r> *short
- r> *short
- r> *uint
- r> *short convert-sql-type
- r> ascii alien>string
- r> <column>
- ] [
- r> drop r> drop r> drop r> drop r> drop r> drop
- "odbc-describe-column failed" throw
- ] if ;
-
-: dereference-type-pointer ( byte-array column -- object )
- type>> {
- { SQL-CHAR [ ascii alien>string ] }
- { SQL-VARCHAR [ ascii alien>string ] }
- { SQL-LONGVARCHAR [ ascii alien>string ] }
- { SQL-WCHAR [ ascii alien>string ] }
- { SQL-WCHARVAR [ ascii alien>string ] }
- { SQL-WLONGCHARVAR [ ascii alien>string ] }
- { SQL-SMALLINT [ *short ] }
- { SQL-INTEGER [ *long ] }
- { SQL-REAL [ *float ] }
- { SQL-FLOAT [ *double ] }
- { SQL-DOUBLE [ *double ] }
- { SQL-TINYINT [ *char ] }
- { SQL-BIGINT [ *longlong ] }
- [ nip [ "Unknown SQL Type: " % name>> % ] "" make ]
- } case ;
-
-TUPLE: field value column ;
-
-C: <field> field
-
-: odbc-get-field ( statement column -- field )
- dup column? [ dupd odbc-describe-column ] unless dup >r number>>
- SQL-C-DEFAULT
- 8192 CHAR: \space <string> ascii string>alien dup >r
- 8192
- f SQLGetData succeeded? [
- r> r> [ dereference-type-pointer ] keep <field>
- ] [
- r> drop r> [
- "SQLGetData Failed for Column: " %
- dup name>> %
- " of type: " % dup type>> name>> %
- ] "" make swap <field>
- ] if ;
-
-: odbc-get-row-fields ( statement -- seq )
- [
- dup odbc-number-of-columns [
- 1+ odbc-get-field value>> ,
- ] with each
- ] { } make ;
-
-: (odbc-get-all-rows) ( statement -- )
- dup odbc-next-row [ dup odbc-get-row-fields , yield (odbc-get-all-rows) ] [ drop ] if ;
-
-: odbc-get-all-rows ( statement -- seq )
- [ (odbc-get-all-rows) ] { } make ;
-
-: odbc-query ( string dsn -- result )
- odbc-init swap odbc-connect [
- swap odbc-prepare
- dup odbc-execute
- dup odbc-get-all-rows
- swap odbc-free-statement
- ] keep odbc-disconnect ;
+++ /dev/null
-ODBC (Open DataBase Connectivity) binding
--- /dev/null
+Chris Double
--- /dev/null
+! Copyright (C) 2007 Chris Double.\r
+! See http://factorcode.org/license.txt for BSD license.\r
+USING: help.syntax help.markup threads ;\r
+\r
+IN: odbc\r
+\r
+HELP: odbc-init \r
+{ $values { "env" "an ODBC environment handle" } } \r
+{ $description \r
+ "Initializes the ODBC driver manager and returns the " \r
+ "environment handle required by " { $link odbc-connect } "."\r
+} \r
+{ $see-also odbc-init odbc-connect odbc-disconnect odbc-prepare odbc-free-statement odbc-execute odbc-next-row odbc-number-of-columns odbc-describe-column odbc-get-field odbc-get-row-fields odbc-get-all-rows odbc-query } ;\r
+\r
+HELP: odbc-connect \r
+{ $values { "env" "an ODBC environment handle" } { "dsn" "a string" } { "dbc" "an ODBC database connection handle" } } \r
+{ $description \r
+ "Connects to the database identified by the ODBC data source name (DSN). " \r
+ "The environment handle is usually obtained by a call to " { $link odbc-init } ". The result is the ODBC connection handle which can be used in other ODBC calls. When finished with the connection handle " { $link odbc-disconnect } " must be called on it."\r
+} \r
+{ $examples { $code "dbc get \"DSN=mydsn\" odbc-connect" } }\r
+{ $see-also odbc-init odbc-connect odbc-disconnect odbc-prepare odbc-free-statement odbc-execute odbc-next-row odbc-number-of-columns odbc-describe-column odbc-get-field odbc-get-row-fields odbc-get-all-rows odbc-query } ;\r
+\r
+HELP: odbc-disconnect \r
+{ $values { "dbc" "an ODBC database connection handle" } } \r
+{ $description \r
+ "Disconnects from the given database." \r
+} \r
+{ $see-also odbc-init odbc-connect odbc-disconnect odbc-prepare odbc-free-statement odbc-execute odbc-next-row odbc-number-of-columns odbc-describe-column odbc-get-field odbc-get-row-fields odbc-get-all-rows odbc-query } ;\r
+\r
+HELP: odbc-prepare\r
+{ $values { "dbc" "an ODBC database connection handle" } { "string" "a string containing SQL" } { "statement" "an ODBC statement handle" } } \r
+{ $description \r
+ "Prepares (precompiles) the given SQL string, ready for execution with " { $link odbc-execute } ". When finished with the statement " { $link odbc-free-statement } " must be called on it." \r
+} \r
+{ $see-also odbc-init odbc-connect odbc-disconnect odbc-prepare odbc-free-statement odbc-execute odbc-next-row odbc-number-of-columns odbc-describe-column odbc-get-field odbc-get-row-fields odbc-get-all-rows odbc-query } ;\r
+\r
+HELP: odbc-free-statement\r
+{ $values { "statement" "an ODBC statement handle" } } \r
+{ $description \r
+ "Closes the statement handle and frees up all resources associated with it." \r
+} \r
+{ $see-also odbc-init odbc-connect odbc-disconnect odbc-prepare odbc-free-statement odbc-execute odbc-next-row odbc-number-of-columns odbc-describe-column odbc-get-field odbc-get-row-fields odbc-get-all-rows odbc-query } ;\r
+\r
+HELP: odbc-execute\r
+{ $values { "statement" "an ODBC statement handle" } } \r
+{ $description \r
+ "Executes the statement. Once this is done " { $link odbc-next-row } " can be called to retrieve rows." \r
+} \r
+{ $see-also odbc-init odbc-connect odbc-disconnect odbc-prepare odbc-free-statement odbc-execute odbc-next-row odbc-number-of-columns odbc-describe-column odbc-get-field odbc-get-row-fields odbc-get-all-rows odbc-query } ;\r
+\r
+HELP: odbc-next-row\r
+{ $values { "statement" "an ODBC statement handle" } { "bool" "a boolean indicating success or failure" } } \r
+{ $description \r
+ "Retrieves the next available row from the database. If no next row is available then " { $link f } " is returned. Once the row is retrieved " { $link odbc-number-of-columns } ", " { $link odbc-describe-column } ", " { $link odbc-get-field } " and " { $link odbc-get-row-fields } " can be used to query the data retrieved." \r
+} \r
+{ $see-also odbc-init odbc-connect odbc-disconnect odbc-prepare odbc-free-statement odbc-execute odbc-next-row odbc-number-of-columns odbc-describe-column odbc-get-field odbc-get-row-fields odbc-get-all-rows odbc-query } ;\r
+\r
+HELP: odbc-number-of-columns\r
+{ $values { "statement" "an ODBC statement handle" } { "number" "a number" } } \r
+{ $description \r
+ "Returns the number of columns of data retrieved."\r
+} \r
+{ $see-also odbc-init odbc-connect odbc-disconnect odbc-prepare odbc-free-statement odbc-execute odbc-next-row odbc-number-of-columns odbc-describe-column odbc-get-field odbc-get-row-fields odbc-get-all-rows odbc-query } ;\r
+\r
+HELP: odbc-describe-column\r
+{ $values { "statement" "an ODBC statement handle" } { "n" "a column number starting from one" } { "column" "a column object" } } \r
+{ $description \r
+ "Retrieves column information for the given column number from the statement. The column number must be one or greater. The " { $link <column> } " object returned provides data type, name, etc."\r
+} \r
+{ $see-also odbc-init odbc-connect odbc-disconnect odbc-prepare odbc-free-statement odbc-execute odbc-next-row odbc-number-of-columns odbc-describe-column odbc-get-field odbc-get-row-fields odbc-get-all-rows odbc-query } ;\r
+\r
+HELP: odbc-get-field\r
+{ $values { "statement" "an ODBC statement handle" } { "column" "a column number starting from one or a <column> object" } { "field" "a <field> object" } } \r
+{ $description \r
+ "Returns a field object which contains the data for the field in the given column in the current row. The column can be identified by a number or a <column> object. The datatype of the contents of the field depends on the type of the column itself. Note that this word can only be safely called once on each column in a given row with most ODBC drivers. Subsequent calls on the same row for the same column can fail."\r
+} \r
+{ $see-also odbc-init odbc-connect odbc-disconnect odbc-prepare odbc-free-statement odbc-execute odbc-next-row odbc-number-of-columns odbc-describe-column odbc-get-field odbc-get-row-fields odbc-get-all-rows odbc-query } ;\r
+\r
+HELP: odbc-get-row-fields\r
+{ $values { "statement" "an ODBC statement handle" } { "seq" "a sequence" } } \r
+{ $description \r
+ "Returns a sequence of all field data for the current row. Note that this isnot the <field> objects, but the data for that field. This word can only be called once on a given row. Subsequent calls on the same row may fail on some ODBC drivers."\r
+} \r
+{ $see-also odbc-init odbc-connect odbc-disconnect odbc-prepare odbc-free-statement odbc-execute odbc-next-row odbc-number-of-columns odbc-describe-column odbc-get-field odbc-get-row-fields odbc-get-all-rows odbc-query } ;\r
+\r
+HELP: odbc-get-all-rows\r
+{ $values { "statement" "an ODBC statement handle" } { "seq" "a sequence" } } \r
+{ $description \r
+ "Returns a sequence of all rows available from the statement. Effectively it is the contents of the entire query so may take some time and memory. Each element of the sequence is itself a sequence containing the data for that row. A " { $link yield } " is performed an various intervals so as to not lock up the Factor instance while it is running."\r
+} \r
+{ $see-also odbc-init odbc-connect odbc-disconnect odbc-prepare odbc-free-statement odbc-execute odbc-next-row odbc-number-of-columns odbc-describe-column odbc-get-field odbc-get-row-fields odbc-get-all-rows odbc-query } ;\r
+\r
+HELP: odbc-query\r
+{ $values { "string" "a string containing SQL" } { "dsn" "a DSN string" } { "result" "a sequence" } } \r
+{ $description \r
+ "This word initializes odbc, connects to the database with the given DSN, executes the query string and returns the result as a sequence. It cleans up all resources it uses. It is an inefficient way of running multiple queries but is useful for the occasional query, testing at the REPL, or as an example of how to do it."\r
+} \r
+{ $see-also odbc-init odbc-connect odbc-disconnect odbc-prepare odbc-free-statement odbc-execute odbc-next-row odbc-number-of-columns odbc-describe-column odbc-get-field odbc-get-row-fields odbc-get-all-rows odbc-query } ;\r
--- /dev/null
+! Copyright (C) 2007 Chris Double.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors kernel alien alien.strings alien.syntax
+combinators alien.c-types strings sequences namespaces make
+words math threads io.encodings.ascii ;
+IN: odbc
+
+<< "odbc" "odbc32.dll" "stdcall" add-library >>
+
+LIBRARY: odbc
+
+TYPEDEF: void* usb_dev_handle*
+TYPEDEF: short SQLRETURN
+TYPEDEF: short SQLSMALLINT
+TYPEDEF: short* SQLSMALLINT*
+TYPEDEF: ushort SQLUSMALLINT
+TYPEDEF: uint* SQLUINTEGER*
+TYPEDEF: int SQLINTEGER
+TYPEDEF: char SQLCHAR
+TYPEDEF: char* SQLCHAR*
+TYPEDEF: void* SQLHANDLE
+TYPEDEF: void* SQLHANDLE*
+TYPEDEF: void* SQLHENV
+TYPEDEF: void* SQLHDBC
+TYPEDEF: void* SQLHSTMT
+TYPEDEF: void* SQLHWND
+TYPEDEF: void* SQLPOINTER
+
+: SQL-HANDLE-ENV ( -- number ) 1 ; inline
+: SQL-HANDLE-DBC ( -- number ) 2 ; inline
+: SQL-HANDLE-STMT ( -- number ) 3 ; inline
+: SQL-HANDLE-DESC ( -- number ) 4 ; inline
+
+: SQL-NULL-HANDLE ( -- alien ) f ; inline
+
+: SQL-ATTR-ODBC-VERSION ( -- number ) 200 ; inline
+
+: SQL-OV-ODBC2 ( -- number ) 2 <alien> ; inline
+: SQL-OV-ODBC3 ( -- number ) 3 <alien> ; inline
+
+: SQL-SUCCESS ( -- number ) 0 ; inline
+: SQL-SUCCESS-WITH-INFO ( -- number ) 1 ; inline
+: SQL-NO-DATA-FOUND ( -- number ) 100 ; inline
+
+: SQL-DRIVER-NOPROMPT ( -- number ) 0 ; inline
+: SQL-DRIVER-PROMPT ( -- number ) 2 ; inline
+
+: SQL-C-DEFAULT ( -- number ) 99 ; inline
+
+SYMBOL: SQL-CHAR
+SYMBOL: SQL-VARCHAR
+SYMBOL: SQL-LONGVARCHAR
+SYMBOL: SQL-WCHAR
+SYMBOL: SQL-WCHARVAR
+SYMBOL: SQL-WLONGCHARVAR
+SYMBOL: SQL-DECIMAL
+SYMBOL: SQL-SMALLINT
+SYMBOL: SQL-NUMERIC
+SYMBOL: SQL-INTEGER
+SYMBOL: SQL-REAL
+SYMBOL: SQL-FLOAT
+SYMBOL: SQL-DOUBLE
+SYMBOL: SQL-BIT
+SYMBOL: SQL-TINYINT
+SYMBOL: SQL-BIGINT
+SYMBOL: SQL-BINARY
+SYMBOL: SQL-VARBINARY
+SYMBOL: SQL-LONGVARBINARY
+SYMBOL: SQL-TYPE-DATE
+SYMBOL: SQL-TYPE-TIME
+SYMBOL: SQL-TYPE-TIMESTAMP
+SYMBOL: SQL-TYPE-UTCDATETIME
+SYMBOL: SQL-TYPE-UTCTIME
+SYMBOL: SQL-INTERVAL-MONTH
+SYMBOL: SQL-INTERVAL-YEAR
+SYMBOL: SQL-INTERVAL-YEAR-TO-MONTH
+SYMBOL: SQL-INTERVAL-DAY
+SYMBOL: SQL-INTERVAL-HOUR
+SYMBOL: SQL-INTERVAL-MINUTE
+SYMBOL: SQL-INTERVAL-SECOND
+SYMBOL: SQL-INTERVAL-DAY-TO-HOUR
+SYMBOL: SQL-INTERVAL-DAY-TO-MINUTE
+SYMBOL: SQL-INTERVAL-DAY-TO-SECOND
+SYMBOL: SQL-INTERVAL-HOUR-TO-MINUTE
+SYMBOL: SQL-INTERVAL-HOUR-TO-SECOND
+SYMBOL: SQL-INTERVAL-MINUTE-TO-SECOND
+SYMBOL: SQL-GUID
+SYMBOL: SQL-TYPE-UNKNOWN
+
+: convert-sql-type ( number -- symbol )
+ {
+ { 1 [ SQL-CHAR ] }
+ { 12 [ SQL-VARCHAR ] }
+ { -1 [ SQL-LONGVARCHAR ] }
+ { -8 [ SQL-WCHAR ] }
+ { -9 [ SQL-WCHARVAR ] }
+ { -10 [ SQL-WLONGCHARVAR ] }
+ { 3 [ SQL-DECIMAL ] }
+ { 5 [ SQL-SMALLINT ] }
+ { 2 [ SQL-NUMERIC ] }
+ { 4 [ SQL-INTEGER ] }
+ { 7 [ SQL-REAL ] }
+ { 6 [ SQL-FLOAT ] }
+ { 8 [ SQL-DOUBLE ] }
+ { -7 [ SQL-BIT ] }
+ { -6 [ SQL-TINYINT ] }
+ { -5 [ SQL-BIGINT ] }
+ { -2 [ SQL-BINARY ] }
+ { -3 [ SQL-VARBINARY ] }
+ { -4 [ SQL-LONGVARBINARY ] }
+ { 91 [ SQL-TYPE-DATE ] }
+ { 92 [ SQL-TYPE-TIME ] }
+ { 93 [ SQL-TYPE-TIMESTAMP ] }
+ [ drop SQL-TYPE-UNKNOWN ]
+ } case ;
+
+: succeeded? ( n -- bool )
+ #! Did the call succeed (SQL-SUCCESS or SQL-SUCCESS-WITH-INFO)
+ {
+ { SQL-SUCCESS [ t ] }
+ { SQL-SUCCESS-WITH-INFO [ t ] }
+ [ drop f ]
+ } case ;
+
+FUNCTION: SQLRETURN SQLAllocHandle ( SQLSMALLINT handleType, SQLHANDLE inputHandle, SQLHANDLE* outputHandlePtr ) ;
+FUNCTION: SQLRETURN SQLSetEnvAttr ( SQLHENV environmentHandle, SQLINTEGER attribute, SQLPOINTER valuePtr, SQLINTEGER stringLength ) ;
+FUNCTION: SQLRETURN SQLDriverConnect ( SQLHDBC connectionHandle, SQLHWND windowHandle, SQLCHAR* inConnectionString, SQLSMALLINT stringLength, SQLCHAR* outConnectionString, SQLSMALLINT bufferLength, SQLSMALLINT* stringLength2Ptr, SQLUSMALLINT driverCompletion ) ;
+FUNCTION: SQLRETURN SQLDisconnect ( SQLHDBC connectionHandle ) ;
+FUNCTION: SQLRETURN SQLPrepare ( SQLHSTMT statementHandle, SQLCHAR* statementText, SQLINTEGER length ) ;
+FUNCTION: SQLRETURN SQLExecute ( SQLHSTMT statementHandle ) ;
+FUNCTION: SQLRETURN SQLFreeHandle ( SQLSMALLINT handleType, SQLHANDLE handle ) ;
+FUNCTION: SQLRETURN SQLFetch ( SQLHSTMT statementHandle ) ;
+FUNCTION: SQLRETURN SQLNumResultCols ( SQLHSTMT statementHandle, SQLSMALLINT* columnCountPtr ) ;
+FUNCTION: SQLRETURN SQLDescribeCol ( SQLHSTMT statementHandle, SQLSMALLINT columnNumber, SQLCHAR* columnName, SQLSMALLINT bufferLength, SQLSMALLINT* nameLengthPtr, SQLSMALLINT* dataTypePtr, SQLUINTEGER* columnSizePtr, SQLSMALLINT* decimalDigitsPtr, SQLSMALLINT* nullablePtr ) ;
+FUNCTION: SQLRETURN SQLGetData ( SQLHSTMT statementHandle, SQLUSMALLINT columnNumber, SQLSMALLINT targetType, SQLPOINTER targetValuePtr, SQLINTEGER bufferLength, SQLINTEGER* strlen_or_indPtr ) ;
+
+: alloc-handle ( type parent -- handle )
+ f <void*> [ SQLAllocHandle ] keep swap succeeded? [
+ *void*
+ ] [
+ drop f
+ ] if ;
+
+: alloc-env-handle ( -- handle )
+ SQL-HANDLE-ENV SQL-NULL-HANDLE alloc-handle ;
+
+: alloc-dbc-handle ( env -- handle )
+ SQL-HANDLE-DBC swap alloc-handle ;
+
+: alloc-stmt-handle ( dbc -- handle )
+ SQL-HANDLE-STMT swap alloc-handle ;
+
+: temp-string ( length -- byte-array length )
+ [ CHAR: \space <string> ascii string>alien ] keep ;
+
+: odbc-init ( -- env )
+ alloc-env-handle
+ [
+ SQL-ATTR-ODBC-VERSION SQL-OV-ODBC3 0 SQLSetEnvAttr
+ succeeded? [ "odbc-init failed" throw ] unless
+ ] keep ;
+
+: odbc-connect ( env dsn -- dbc )
+ >r alloc-dbc-handle dup r>
+ f swap dup length 1024 temp-string 0 <short> SQL-DRIVER-NOPROMPT
+ SQLDriverConnect succeeded? [ "odbc-connect failed" throw ] unless ;
+
+: odbc-disconnect ( dbc -- )
+ SQLDisconnect succeeded? [ "odbc-disconnect failed" throw ] unless ;
+
+: odbc-prepare ( dbc string -- statement )
+ >r alloc-stmt-handle dup r> dup length SQLPrepare succeeded? [ "odbc-prepare failed" throw ] unless ;
+
+: odbc-free-statement ( statement -- )
+ SQL-HANDLE-STMT swap SQLFreeHandle succeeded? [ "odbc-free-statement failed" throw ] unless ;
+
+: odbc-execute ( statement -- )
+ SQLExecute succeeded? [ "odbc-execute failed" throw ] unless ;
+
+: odbc-next-row ( statement -- bool )
+ SQLFetch succeeded? ;
+
+: odbc-number-of-columns ( statement -- number )
+ 0 <short> [ SQLNumResultCols succeeded? ] keep swap [
+ *short
+ ] [
+ drop f
+ ] if ;
+
+TUPLE: column nullable digits size type name number ;
+
+C: <column> column
+
+: odbc-describe-column ( statement n -- column )
+ dup >r
+ 1024 CHAR: \space <string> ascii string>alien dup >r
+ 1024
+ 0 <short>
+ 0 <short> dup >r
+ 0 <uint> dup >r
+ 0 <short> dup >r
+ 0 <short> dup >r
+ SQLDescribeCol succeeded? [
+ r> *short
+ r> *short
+ r> *uint
+ r> *short convert-sql-type
+ r> ascii alien>string
+ r> <column>
+ ] [
+ r> drop r> drop r> drop r> drop r> drop r> drop
+ "odbc-describe-column failed" throw
+ ] if ;
+
+: dereference-type-pointer ( byte-array column -- object )
+ type>> {
+ { SQL-CHAR [ ascii alien>string ] }
+ { SQL-VARCHAR [ ascii alien>string ] }
+ { SQL-LONGVARCHAR [ ascii alien>string ] }
+ { SQL-WCHAR [ ascii alien>string ] }
+ { SQL-WCHARVAR [ ascii alien>string ] }
+ { SQL-WLONGCHARVAR [ ascii alien>string ] }
+ { SQL-SMALLINT [ *short ] }
+ { SQL-INTEGER [ *long ] }
+ { SQL-REAL [ *float ] }
+ { SQL-FLOAT [ *double ] }
+ { SQL-DOUBLE [ *double ] }
+ { SQL-TINYINT [ *char ] }
+ { SQL-BIGINT [ *longlong ] }
+ [ nip [ "Unknown SQL Type: " % name>> % ] "" make ]
+ } case ;
+
+TUPLE: field value column ;
+
+C: <field> field
+
+: odbc-get-field ( statement column -- field )
+ dup column? [ dupd odbc-describe-column ] unless dup >r number>>
+ SQL-C-DEFAULT
+ 8192 CHAR: \space <string> ascii string>alien dup >r
+ 8192
+ f SQLGetData succeeded? [
+ r> r> [ dereference-type-pointer ] keep <field>
+ ] [
+ r> drop r> [
+ "SQLGetData Failed for Column: " %
+ dup name>> %
+ " of type: " % dup type>> name>> %
+ ] "" make swap <field>
+ ] if ;
+
+: odbc-get-row-fields ( statement -- seq )
+ [
+ dup odbc-number-of-columns [
+ 1+ odbc-get-field value>> ,
+ ] with each
+ ] { } make ;
+
+: (odbc-get-all-rows) ( statement -- )
+ dup odbc-next-row [ dup odbc-get-row-fields , yield (odbc-get-all-rows) ] [ drop ] if ;
+
+: odbc-get-all-rows ( statement -- seq )
+ [ (odbc-get-all-rows) ] { } make ;
+
+: odbc-query ( string dsn -- result )
+ odbc-init swap odbc-connect [
+ swap odbc-prepare
+ dup odbc-execute
+ dup odbc-get-all-rows
+ swap odbc-free-statement
+ ] keep odbc-disconnect ;
--- /dev/null
+ODBC (Open DataBase Connectivity) binding
projects / factor.git / commitdiff