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 } "."
-}
+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."
-}
+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."
-}
+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."
-}
+{ $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."
-}
+{ $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."
-}
+{ $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."
-}
+{ $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
+{ $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
+{ $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
+{ $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
+{ $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
+{ $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
+{ $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 } ;
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 ;
+ {
+ { 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 ;
+ ! 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 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 ;
+ f void* <ref> [ SQLAllocHandle ] keep swap succeeded? [
+ void* deref
+ ] [
+ drop f
+ ] if ;
: alloc-env-handle ( -- handle )
- SQL-HANDLE-ENV SQL-NULL-HANDLE alloc-handle ;
+ SQL-HANDLE-ENV SQL-NULL-HANDLE alloc-handle ;
: alloc-dbc-handle ( env -- handle )
- SQL-HANDLE-DBC swap alloc-handle ;
+ SQL-HANDLE-DBC swap alloc-handle ;
: alloc-stmt-handle ( dbc -- handle )
- SQL-HANDLE-STMT swap alloc-handle ;
+ SQL-HANDLE-STMT swap alloc-handle ;
<PRIVATE
PRIVATE>
: temp-string ( length -- byte-array length )
- [ alien-space-str ] keep ;
+ [ 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 ;
+ 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 dup length 1024 temp-string 0 short <ref> SQL-DRIVER-NOPROMPT
- SQLDriverConnect succeeded? [ "odbc-connect failed" throw ] unless ;
+ [ alloc-dbc-handle dup ] dip
+ f swap 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 ;
+ 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 ;
+ [ 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 ;
+ SQL-HANDLE-STMT swap SQLFreeHandle
+ succeeded? [ "odbc-free-statement failed" throw ] unless ;
: odbc-execute ( statement -- )
- SQLExecute succeeded? [ "odbc-execute failed" throw ] unless ;
+ SQLExecute succeeded? [ "odbc-execute failed" throw ] unless ;
: odbc-next-row ( statement -- bool )
- SQLFetch succeeded? ;
+ SQLFetch succeeded? ;
: odbc-number-of-columns ( statement -- number )
- 0 short <ref> [ SQLNumResultCols succeeded? ] keep swap [
- short deref
- ] [
- drop f
- ] if ;
+ 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 ;
+ 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 ;
+ 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 ;
+ 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 ;
+ [
+ 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 ;
+ 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-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 ;
+ odbc-init swap odbc-connect [
+ swap odbc-prepare
+ dup odbc-execute
+ dup odbc-get-all-rows
+ swap odbc-free-statement
+ ] keep odbc-disconnect ;
projects / factor.git / commitdiff