--- /dev/null
+Chris Double
--- /dev/null
+! Copyright (C) 2007 Chris Double.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.syntax help.markup threads ;
+
+IN: odbc
+
+HELP: odbc-init
+{ $values { "env" "an ODBC environment handle" } }
+{ $description
+ "Initializes the ODBC driver manager and returns the "
+ "environment handle required by " { $link odbc-connect } "."
+}
+{ $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 } ;
+
+HELP: odbc-connect
+{ $values
+ { "env" "an ODBC environment handle" }
+ { "dsn" "a string" }
+ { "dbc" "an ODBC database connection handle" }
+}
+{ $description
+ "Connects to the database identified by the ODBC data source name (DSN). "
+ "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."
+}
+{ $examples { $code "dbc get \"DSN=mydsn\" odbc-connect" } }
+{ $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 } ;
+
+HELP: odbc-disconnect
+{ $values { "dbc" "an ODBC database connection handle" } }
+{ $description
+ "Disconnects from the given database."
+}
+{ $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 } ;
+
+HELP: odbc-prepare
+{ $values
+ { "dbc" "an ODBC database connection handle" }
+ { "string" "a string containing SQL" }
+ { "statement" "an ODBC statement handle" }
+}
+{ $description
+ "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."
+}
+{ $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 } ;
+
+HELP: odbc-free-statement
+{ $values { "statement" "an ODBC statement handle" } }
+{ $description
+ "Closes the statement handle and frees up all resources associated with it."
+}
+{ $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 } ;
+
+HELP: odbc-execute
+{ $values { "statement" "an ODBC statement handle" } }
+{ $description
+ "Executes the statement. Once this is done " { $link odbc-next-row } " can be called to retrieve rows."
+}
+{ $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 } ;
+
+HELP: odbc-next-row
+{ $values
+ { "statement" "an ODBC statement handle" }
+ { "bool" "a boolean indicating success or failure" }
+}
+{ $description
+ "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."
+}
+{ $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 } ;
+
+HELP: odbc-number-of-columns
+{ $values { "statement" "an ODBC statement handle" } { "number" "a number" } }
+{ $description
+ "Returns the number of columns of data retrieved."
+}
+{ $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 } ;
+
+HELP: odbc-describe-column
+{ $values
+ { "statement" "an ODBC statement handle" }
+ { "n" "a column number starting from one" }
+ { "column" "a column object" }
+}
+{ $description
+ "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."
+}
+{ $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 } ;
+
+HELP: odbc-get-field
+{ $values
+ { "statement" "an ODBC statement handle" }
+ { "column" "a column number starting from one or a <column> object" }
+ { "field" "a <field> object" }
+}
+{ $description
+ "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."
+}
+{ $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 } ;
+
+HELP: odbc-get-row-fields
+{ $values { "statement" "an ODBC statement handle" } { "seq" "a sequence" } }
+{ $description
+ "Returns a sequence of all field data for the current row. Note that this is not 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."
+}
+{ $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 } ;
+
+HELP: odbc-get-all-rows
+{ $values { "statement" "an ODBC statement handle" } { "seq" "a sequence" } }
+{ $description
+ "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."
+}
+{ $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 } ;
+
+HELP: odbc-query
+{ $values
+ { "string" "a string containing SQL" }
+ { "dsn" "a DSN string" }
+ { "result" "a sequence" }
+}
+{ $description
+ "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."
+}
+{ $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 } ;
--- /dev/null
+! Copyright (C) 2007 Chris Double.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien alien.c-types alien.data alien.libraries
+alien.strings alien.syntax combinators io.encodings.ascii kernel
+locals make math sequences strings threads ;
+FROM: alien.c-types => float short ;
+IN: odbc
+
+<< "odbc" "odbc32.dll" stdcall add-library >>
+
+LIBRARY: odbc
+
+TYPEDEF: short SQLRETURN
+TYPEDEF: short SQLSMALLINT
+TYPEDEF: ushort SQLUSMALLINT
+TYPEDEF: uint SQLUINTEGER
+TYPEDEF: int SQLINTEGER
+TYPEDEF: char SQLCHAR
+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* <ref> [ SQLAllocHandle ] keep swap succeeded? [
+ void* deref
+ ] [
+ 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 ;
+
+<PRIVATE
+
+: alien-space-str ( len -- alien )
+ CHAR: space <string> ascii string>alien ;
+
+PRIVATE>
+
+: temp-string ( length -- byte-array length )
+ [ alien-space-str ] 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 )
+ [ alloc-dbc-handle dup ] dip
+ f swap ascii string>alien dup length
+ 1024 temp-string 0 short <ref>
+ 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 )
+ [ alloc-stmt-handle dup ] dip 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 <ref> [ SQLNumResultCols succeeded? ] keep swap [
+ short deref
+ ] [
+ drop f
+ ] if ;
+
+TUPLE: column nullable digits size type name number ;
+
+C: <column> column
+
+:: odbc-describe-column ( statement columnNumber -- column )
+ 1024 :> bufferLen
+ bufferLen alien-space-str :> columnName
+ 0 short <ref> :> nameLengthPtr
+ 0 short <ref> :> dataTypePtr
+ 0 uint <ref> :> columnSizePtr
+ 0 short <ref> :> decimalDigitsPtr
+ 0 short <ref> :> nullablePtr
+ statement columnNumber columnName bufferLen nameLengthPtr
+ dataTypePtr columnSizePtr decimalDigitsPtr nullablePtr
+ SQLDescribeCol succeeded? [
+ nullablePtr short deref
+ decimalDigitsPtr short deref
+ columnSizePtr uint deref
+ dataTypePtr short deref convert-sql-type
+ columnName ascii alien>string
+ columnNumber <column>
+ ] [
+ "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 deref ] }
+ { SQL-INTEGER [ long deref ] }
+ { SQL-REAL [ float deref ] }
+ { SQL-FLOAT [ double deref ] }
+ { SQL-DOUBLE [ double deref ] }
+ { SQL-TINYINT [ char deref ] }
+ { SQL-BIGINT [ longlong deref ] }
+ [ nip [ "Unknown SQL Type: " % name>> % ] "" make ]
+ } case ;
+
+TUPLE: field value column ;
+
+C: <field> field
+
+:: odbc-get-field ( statement column! -- field )
+ column column? [
+ statement column odbc-describe-column column!
+ ] unless
+ 8192 :> bufferLen
+ bufferLen alien-space-str :> targetValuePtr
+ statement column number>> SQL-C-DEFAULT
+ targetValuePtr bufferLen f SQLGetData
+ succeeded? [
+ targetValuePtr column [ dereference-type-pointer ] keep <field>
+ ] [
+ column [
+ "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.
-! See http://factorcode.org/license.txt for BSD license.
-USING: help.syntax help.markup threads ;
-
-IN: odbc
-
-HELP: odbc-init
-{ $values { "env" "an ODBC environment handle" } }
-{ $description
- "Initializes the ODBC driver manager and returns the "
- "environment handle required by " { $link odbc-connect } "."
-}
-{ $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 } ;
-
-HELP: odbc-connect
-{ $values
- { "env" "an ODBC environment handle" }
- { "dsn" "a string" }
- { "dbc" "an ODBC database connection handle" }
-}
-{ $description
- "Connects to the database identified by the ODBC data source name (DSN). "
- "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."
-}
-{ $examples { $code "dbc get \"DSN=mydsn\" odbc-connect" } }
-{ $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 } ;
-
-HELP: odbc-disconnect
-{ $values { "dbc" "an ODBC database connection handle" } }
-{ $description
- "Disconnects from the given database."
-}
-{ $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 } ;
-
-HELP: odbc-prepare
-{ $values
- { "dbc" "an ODBC database connection handle" }
- { "string" "a string containing SQL" }
- { "statement" "an ODBC statement handle" }
-}
-{ $description
- "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."
-}
-{ $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 } ;
-
-HELP: odbc-free-statement
-{ $values { "statement" "an ODBC statement handle" } }
-{ $description
- "Closes the statement handle and frees up all resources associated with it."
-}
-{ $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 } ;
-
-HELP: odbc-execute
-{ $values { "statement" "an ODBC statement handle" } }
-{ $description
- "Executes the statement. Once this is done " { $link odbc-next-row } " can be called to retrieve rows."
-}
-{ $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 } ;
-
-HELP: odbc-next-row
-{ $values
- { "statement" "an ODBC statement handle" }
- { "bool" "a boolean indicating success or failure" }
-}
-{ $description
- "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."
-}
-{ $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 } ;
-
-HELP: odbc-number-of-columns
-{ $values { "statement" "an ODBC statement handle" } { "number" "a number" } }
-{ $description
- "Returns the number of columns of data retrieved."
-}
-{ $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 } ;
-
-HELP: odbc-describe-column
-{ $values
- { "statement" "an ODBC statement handle" }
- { "n" "a column number starting from one" }
- { "column" "a column object" }
-}
-{ $description
- "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."
-}
-{ $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 } ;
-
-HELP: odbc-get-field
-{ $values
- { "statement" "an ODBC statement handle" }
- { "column" "a column number starting from one or a <column> object" }
- { "field" "a <field> object" }
-}
-{ $description
- "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."
-}
-{ $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 } ;
-
-HELP: odbc-get-row-fields
-{ $values { "statement" "an ODBC statement handle" } { "seq" "a sequence" } }
-{ $description
- "Returns a sequence of all field data for the current row. Note that this is not 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."
-}
-{ $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 } ;
-
-HELP: odbc-get-all-rows
-{ $values { "statement" "an ODBC statement handle" } { "seq" "a sequence" } }
-{ $description
- "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."
-}
-{ $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 } ;
-
-HELP: odbc-query
-{ $values
- { "string" "a string containing SQL" }
- { "dsn" "a DSN string" }
- { "result" "a sequence" }
-}
-{ $description
- "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."
-}
-{ $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 } ;
+++ /dev/null
-! Copyright (C) 2007 Chris Double.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types alien.data alien.libraries
-alien.strings alien.syntax combinators io.encodings.ascii kernel
-locals make math sequences strings threads ;
-FROM: alien.c-types => float short ;
-IN: odbc
-
-<< "odbc" "odbc32.dll" stdcall add-library >>
-
-LIBRARY: odbc
-
-TYPEDEF: short SQLRETURN
-TYPEDEF: short SQLSMALLINT
-TYPEDEF: ushort SQLUSMALLINT
-TYPEDEF: uint SQLUINTEGER
-TYPEDEF: int SQLINTEGER
-TYPEDEF: char SQLCHAR
-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* <ref> [ SQLAllocHandle ] keep swap succeeded? [
- void* deref
- ] [
- 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 ;
-
-<PRIVATE
-
-: alien-space-str ( len -- alien )
- CHAR: space <string> ascii string>alien ;
-
-PRIVATE>
-
-: temp-string ( length -- byte-array length )
- [ alien-space-str ] 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 )
- [ alloc-dbc-handle dup ] dip
- f swap ascii string>alien dup length
- 1024 temp-string 0 short <ref>
- 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 )
- [ alloc-stmt-handle dup ] dip 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 <ref> [ SQLNumResultCols succeeded? ] keep swap [
- short deref
- ] [
- drop f
- ] if ;
-
-TUPLE: column nullable digits size type name number ;
-
-C: <column> column
-
-:: odbc-describe-column ( statement columnNumber -- column )
- 1024 :> bufferLen
- bufferLen alien-space-str :> columnName
- 0 short <ref> :> nameLengthPtr
- 0 short <ref> :> dataTypePtr
- 0 uint <ref> :> columnSizePtr
- 0 short <ref> :> decimalDigitsPtr
- 0 short <ref> :> nullablePtr
- statement columnNumber columnName bufferLen nameLengthPtr
- dataTypePtr columnSizePtr decimalDigitsPtr nullablePtr
- SQLDescribeCol succeeded? [
- nullablePtr short deref
- decimalDigitsPtr short deref
- columnSizePtr uint deref
- dataTypePtr short deref convert-sql-type
- columnName ascii alien>string
- columnNumber <column>
- ] [
- "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 deref ] }
- { SQL-INTEGER [ long deref ] }
- { SQL-REAL [ float deref ] }
- { SQL-FLOAT [ double deref ] }
- { SQL-DOUBLE [ double deref ] }
- { SQL-TINYINT [ char deref ] }
- { SQL-BIGINT [ longlong deref ] }
- [ nip [ "Unknown SQL Type: " % name>> % ] "" make ]
- } case ;
-
-TUPLE: field value column ;
-
-C: <field> field
-
-:: odbc-get-field ( statement column! -- field )
- column column? [
- statement column odbc-describe-column column!
- ] unless
- 8192 :> bufferLen
- bufferLen alien-space-str :> targetValuePtr
- statement column number>> SQL-C-DEFAULT
- targetValuePtr bufferLen f SQLGetData
- succeeded? [
- targetValuePtr column [ dereference-type-pointer ] keep <field>
- ] [
- column [
- "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