Paste: odbc lib

! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license.

USING: accessors kernel sequences vectors 
alien alien.strings alien.syntax alien.c-types alien.libraries present
combinators  strings namespaces make locals
words math threads io.encodings.ascii nested-comments 
odbc.ffi ;

IN: odbc.lib

: 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: \s  <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 )
   [ alloc-dbc-handle dup ] dip
   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 )
  [ 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? ;       !  SQLFetch not true for second row.

: 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

! ( SQLHSTMT statementHandle, a 
! SQLSMALLINT columnNumber,  
! SQLCHAR* columnName,  c
! SQLSMALLINT bufferLength, d 
!  SQLSMALLINT* nameLengthPtr, e
! SQLSMALLINT* dataTypePtr, f
! SQLUINTEGER* columnSizePtr, g
! SQLSMALLINT* decimalDigitsPtr, h
! SQLSMALLINT* nullablePtr ) ; i

:: odbc-describe-column ( stmnt col-nth -- col )
  stmnt ! a
  col-nth ! 
  1024 CHAR: \s <string> ascii string>alien dup :> col-name ! c 
  1024 ! d
  0 <short> ! e
  0 <short> dup :> col-type ! f
  0 <uint> dup :> col-size ! g
  0 <short> dup :> col-digits ! h
  0 <short> dup :> col-nullable ! i
  SQLDescribeCol succeeded? 
  [
    col-nullable *short
    col-digits *short
    col-size *uint
    col-type *short convert-sql-type
    col-name ascii alien>string
    col-nth <column>
  ] 
  [    
    "odbc-describe-column failed" throw
  ] 
  if ;

: dereference-type-pointer ( byte-array column -- object )
  type>> {
    { SQL-LONGVARCHAR [ ascii alien>string ] }
    { SQL-WCHAR [ ascii alien>string ] }
    { SQL-WCHARVAR [ ascii alien>string ] }
    { SQL-WLONGCHARVAR [ ascii alien>string ] }
    { SQL-SMALLINT [ *short ] }
    { SQL-REAL [ *float ] }
    { SQL-FLOAT [ *double ] }
    { SQL-DOUBLE [ *double ] }
    { SQL-TINYINT [ *char  ] }
    { SQL-BIGINT [ *longlong ] }

    ! pre-existing, just fails now
    { SQL-INTEGER [ *long ] }
    { SQL-VARCHAR [ ascii alien>string ] }
    { SQL-CHAR [ ascii alien>string ] }

    ! testing the exact type
    { SQL-TYPE-TIMESTAMP [ *double ] }
    { SQL-NUMERIC [ ascii alien>string ] }
    { SQL-BINARY [ *longlong ] }
    { SQL-DECIMAL [ ascii alien>string ] }
    { SQL-MONEY [  ascii alien>string ] }
    [ nip [ "Unknown SQL Type: " % name>> % ] "" make ]
  } case ;

TUPLE: field value column ;

C: <field> field

SYMBOL: first-row
SYMBOL: columns

:: odbc-get-field ( statement column -- field )
  statement column dup column? [ dupd odbc-describe-column ] unless
  dup :> num1 number>>
  SQL-C-DEFAULT
  8192 CHAR: \s <string> ascii string>alien dup :> num2
  8192
  f SQLGetData succeeded?

  [ num2 num1 [ dereference-type-pointer ] keep <field>
  ]
  [ f num1 <field>   
  ]
  if ;

: odbc-get-row-fields ( statement -- seq )
  [
    dup odbc-number-of-columns iota [
      ?1+ odbc-get-field value>> ,
    ] with  each
  ] { } make ;

: odbc-get-columns ( statement -- colAry )
 [ dup odbc-number-of-columns iota
    [ ?1+ odbc-get-field [ columns get push ] [ value>> , ] bi
    ] with each
 ] { } make ;

! 1 row

: (odbc-get-all-columns) ( statement -- )
  dup odbc-next-row
    [ dup first-row get
        [ odbc-get-columns  f first-row set ]
        [ odbc-get-row-fields ]
        if
        , yield (odbc-get-all-columns) ]
    [ drop ] if ;

: odbc-get-all-columns ( statement -- seq )
  t first-row set
  [ (odbc-get-all-columns) ] { } make ;


! original
: (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 ;


! TUPLE: sgd statementHandle columnNumber  targetType targetValuePtr bufferLength strlen_or_indPtr ;