571 lines
18 KiB
Scheme
571 lines
18 KiB
Scheme
;;; Sam Thibault
|
|
;;; ODBC/SQL interface for scsh
|
|
;;; Spring 1999
|
|
|
|
;;; This is file: odbc0.scm
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;;
|
|
;;; General Comments
|
|
;;; ----------------
|
|
;;; This file contains define-foreigns that link to stubs in odbc0.c, a file
|
|
;;; automatically generated with cig. The C definitiions are located in two
|
|
;;; separate files:
|
|
;;;
|
|
;;; /solidSDK30/Solaris_SPARC/lib/sclssx30.so contains definitions of the
|
|
;;; ODBC functions in the first half of this file.
|
|
;;;
|
|
;;; scch-sql.o (compiled from scsh-sql.c) contains the definitions of the
|
|
;;; functions in the second half of this file (used for allocating and
|
|
;;; freeing memory, and converting some data types.
|
|
;;;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;;; The headers below will be included in C file the generated by cig
|
|
|
|
(foreign-source
|
|
"#if 0"
|
|
"#include \"cli0cli.h\""
|
|
"#include \"cli0defs.h\""
|
|
"#include \"cli0env.h\""
|
|
"#else"
|
|
"#include <windows.h>"
|
|
"#include <sql.h>"
|
|
"#include <sqlext.h>"
|
|
"#endif"
|
|
"")
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;;
|
|
;;; ODBC Functions
|
|
;;; ---------------
|
|
;;; These define-foreigns link to ODBC functions defined in sclssx30.so
|
|
;;; This set contains all ODBC core functions.
|
|
;;;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;;; SQLAllocConnect allocates memory for a connection handle within the
|
|
;;; identified environment.
|
|
|
|
(define-foreign %alloc-connect
|
|
("SQLAllocConnect" ((C "SQLHENV~a") environment)
|
|
((C "SQLHDBC*~a") connection))
|
|
(to-scheme (C "SQLRETURN SQL_API ~a") "ENTER_FIXNUM"))
|
|
|
|
;;; SQLAllocEnv allocates memory for an environment handle and initializes the
|
|
;;; ODBC call level interface for use by an application. AllocEnv must be
|
|
;;; called before any other ODBC function can be called.
|
|
|
|
(define-foreign %alloc-env
|
|
("SQLAllocEnv" ((C "SQLHENV*~a") pSQLHENV))
|
|
(to-scheme (C "SQLRETURN SQL_API ~a") "ENTER_FIXNUM"))
|
|
|
|
;;; SQLAllocStmt allocates memory for a statement handle and associates the
|
|
;;; statement handle with the specified connection. AllocStmt must be called
|
|
;;; before executing any SQL statements.
|
|
|
|
(define-foreign %alloc-stmt
|
|
("SQLAllocStmt" ((C "SQLHDBC ~a") connection)
|
|
((C "SQLHSTMT*~a") statement))
|
|
(to-scheme (C "SQLRETURN SQL_API ~a") "ENTER_FIXNUM"))
|
|
|
|
;;; SQLBindCol assigns storage and data type for a column in a result set.
|
|
|
|
(define-foreign %bind-col
|
|
("SQLBindCol" ((C "SQLHSTMT ~a") statement)
|
|
((rep integer? "UWORD ~a" "EXTRACT_FIXNUM") column-number)
|
|
((rep integer? "SWORD ~a" "EXTRACT_FIXNUM") data-type)
|
|
((C "PTR ~a") storage-pointer)
|
|
((rep integer? "SDWORD ~a" "EXTRACT_FIXNUM") buffer-length)
|
|
((C "SDWORD*~a") available-bytes))
|
|
(to-scheme (C "SQLRETURN SQL_API ~a") "ENTER_FIXNUM"))
|
|
|
|
;;; SQLBindParameter binds a buffer to a parameter marker in an SQL statement.
|
|
|
|
(define-foreign %bind-parameter
|
|
("SQLBindParameter" ((C "SQLHSTMT ~a") statement)
|
|
((rep integer? "UWORD ~a" "EXTRACT_FIXNUM") param-number)
|
|
((rep integer? "SWORD ~a" "EXTRACT_FIXNUM") param-type)
|
|
((rep integer? "SWORD ~a" "EXTRACT_FIXNUM") c-datatype)
|
|
((rep integer? "SWORD ~a" "EXTRACT_FIXNUM") sql-datatype)
|
|
((rep integer? "UDWORD ~a" "EXTRACT_FIXNUM") precision)
|
|
((rep integer? "SWORD ~a" "EXTRACT_FIXNUM") scale)
|
|
((C "PTR ~a") storage-pointer)
|
|
((rep integer? "SDWORD ~a" "EXTRACT_FIXNUM") buf-length)
|
|
((C "SDWORD*~a") available-bytes))
|
|
(to-scheme (C "SQLRETURN SQL_API ~a") "ENTER_FIXNUM"))
|
|
|
|
;;; SQLCancel cancels the processing on a statement.
|
|
|
|
(define-foreign %cancel
|
|
("SQLCancel" ((C "SQLHSTMT ~a") statement))
|
|
(to-scheme (C "SQLRETURN SQL_API ~a") "ENTER_FIXNUM"))
|
|
|
|
;;; SQLColAttributes returns descriptor information for a cloumn in a result
|
|
;;; set.
|
|
|
|
(define-foreign %col-attributes
|
|
("SQLColAttributes" ((C "SQLHSTMT ~a") statement)
|
|
((rep integer? "UWORD ~a" "EXTRACT_FIXNUM") column-num)
|
|
((rep integer? "UWORD ~a" "EXTRACT_FIXNUM") desc-type)
|
|
((C "PTR ~a") storage-pointer)
|
|
((rep integer? "SWORD ~a" "EXTRACT_FIXNUM") buf-length)
|
|
((C "SWORD*~a") available-bytes)
|
|
((C "SDWORD*~a") descriptor-pointer))
|
|
(to-scheme (C "SQLRETURN SQL_API ~a") "ENTER_FIXNUM"))
|
|
|
|
;;; SQLConnect loads a driver and establishes a connection to the data source.
|
|
|
|
(define-foreign %connect
|
|
("SQLConnect" ((C "SQLHDBC ~a") connection)
|
|
(string source-name)
|
|
((rep integer? "SWORD ~a" "EXTRACT_FIXNUM") source-name-length)
|
|
(string user-name)
|
|
((rep integer? "SWORD ~a" "EXTRACT_FIXNUM") user-name-length)
|
|
(string password)
|
|
((rep integer? "SWORD ~a" "EXTRACT_FIXNUM") password-length))
|
|
no-declare
|
|
(to-scheme (C "SQLRETURN SQL_API ~a") "ENTER_FIXNUM"))
|
|
|
|
;;; SQLDescribeCol returns the result descriptor for one column in a result
|
|
;;; set.
|
|
|
|
(define-foreign %describe-col
|
|
("SQLDescribeCol" ((C "SQLHSTMT ~a") statment)
|
|
((rep integer? "UWORD ~a" "EXTRACT_FIXNUM") column-number)
|
|
(string column-name)
|
|
((rep integer? "SWORD ~a" "EXTRACT_FIXNUM") name-buffer-length)
|
|
((C "SWORD*~a") bytes-available)
|
|
((C "SWORD*~a") data-type)
|
|
((C "UDWORD*~a") precision)
|
|
((C "SWORD*~a") scale)
|
|
((C "SWORD*~a") nullable))
|
|
no-declare
|
|
(to-scheme (C "SQLRETURN SQL_API ~a") "ENTER_FIXNUM"))
|
|
|
|
;;; SQLDescribeParam returns the description of a parameter marker associated
|
|
;;; with a prepared SQL statement.
|
|
|
|
(define-foreign %describe-param
|
|
("SQLDescribeParam" ((C "SQLHSTMT ~a") statement)
|
|
((rep integer? "UWORD ~a" "EXTRACT_FIXNUM") param-number)
|
|
((C "SWORD*~a") sql-type)
|
|
((C "UDWORD*~a") precision)
|
|
((C "SWORD*~a") scale)
|
|
((C "SWORD*~a") nullable))
|
|
(to-scheme (C "SQLRETURN SQL_API ~a") "ENTER_FIXNUM"))
|
|
|
|
;;; SQLDisconnect closes the connection associated with a specific connection
|
|
;;; handle.
|
|
|
|
(define-foreign %disconnect
|
|
("SQLDisconnect" ((C "SQLHDBC ~a") connection))
|
|
(to-scheme (C "SQLRETURN SQL_API ~a") "ENTER_FIXNUM"))
|
|
|
|
;;; SQLError returns error or status information.
|
|
|
|
(define-foreign %sql-error
|
|
("SQLError" ((C "SQLHENV ~a") environment)
|
|
((C "SQLHDBC ~a") connection)
|
|
((C "SQLHSTMT ~a") statement)
|
|
(string state)
|
|
((C "SDWORD*~a") error-code)
|
|
(string error-message)
|
|
((rep integer? "SWORD ~a" "EXTRACT_FIXNUM") buffer-length)
|
|
((C "SWORD*~a") bytes-available))
|
|
no-declare
|
|
(to-scheme (C "SQLRETURN SQL_API ~a") "ENTER_FIXNUM"))
|
|
|
|
;;; SQLExecDirect executes a preparable statement.
|
|
|
|
(define-foreign %exec-direct
|
|
("SQLExecDirect" ((C "SQLHSTMT ~a") statement)
|
|
(string sql-string)
|
|
((rep integer? "SDWORD ~a" "EXTRACT_FIXNUM") string-length))
|
|
no-declare
|
|
(to-scheme (C "SQLRETURN SQL_API ~a") "ENTER_FIXNUM"))
|
|
|
|
;;; SQLExecute executes a prepared statement.
|
|
|
|
(define-foreign %execute
|
|
("SQLExecute" ((C "SQLHSTMT ~a") statement))
|
|
(to-scheme (C "SQLRETURN SQL_API ~a") "ENTER_FIXNUM"))
|
|
|
|
;;; SQLFetch fetches a row of data from a result set. The driver returns data
|
|
;;; for all columns that were bound to storage locations with BindCol.
|
|
|
|
(define-foreign %fetch
|
|
("SQLFetch" ((C "SQLHSTMT ~a") statement))
|
|
(to-scheme (C "SQLRETURN SQL_API ~a") "ENTER_FIXNUM"))
|
|
|
|
;;; SQLFreeConnect releases a connection handle and frees all memory associated
|
|
;;; with the handle.
|
|
|
|
(define-foreign %free-connect
|
|
("SQLFreeConnect" ((C "SQLHDBC ~a") connection))
|
|
(to-scheme (C "SQLRETURN SQL_API ~a") "ENTER_FIXNUM"))
|
|
|
|
;;; SQLFreeEnv frees the environment handle and frees all memory associated
|
|
;;; with the environment handle.
|
|
|
|
(define-foreign %free-env
|
|
("SQLFreeEnv" ((C "SQLHENV ~a") environment))
|
|
(to-scheme (C "SQLRETURN SQL_API ~a") "ENTER_FIXNUM"))
|
|
|
|
;;; SQLFreeStmt stops processing associated with a specific statement handle,
|
|
;;; closes any open cursors, discards pending results, and, optionally, frees
|
|
;;; all resources associated with the statement handle.
|
|
|
|
(define-foreign %free-stmt
|
|
("SQLFreeStmt" ((C "SQLHSTMT ~a") statement)
|
|
((rep integer? "UWORD ~a" "EXTRACT_FIXNUM") option))
|
|
(to-scheme (C "SQLRETURN SQL_API ~a") "ENTER_FIXNUM"))
|
|
|
|
;;; SQLGetCursorName returns the cursor name associated with a specified
|
|
;;; statement handle.
|
|
|
|
(define-foreign %get-cursor-name
|
|
("SQLGetCursorName" ((C "SQLHSTMT ~a") statement)
|
|
(string cursor-name)
|
|
((rep integer? "SWORD ~a" "EXTRACT_FIXNUM") name-length)
|
|
((C "SWORD*~a") bytes-available))
|
|
no-declare
|
|
(to-scheme (C "SQLRETURN SQL_API ~a") "ENTER_FIXNUM"))
|
|
|
|
;;; SQLNumResultCols returns the number of columns in a result set.
|
|
|
|
(define-foreign %num-result-cols
|
|
("SQLNumResultCols" ((C "SQLHSTMT ~a") statement)
|
|
((C "SWORD*~a") columns))
|
|
(to-scheme (C "SQLRETURN SQL_API ~a") "ENTER_FIXNUM"))
|
|
|
|
;;; SQLPrepare prepares an SQL string for execution.
|
|
|
|
(define-foreign %prepare
|
|
("SQLPrepare" ((C "SQLHSTMT ~a") statement)
|
|
(string sql-string)
|
|
((rep integer? "SDWORD ~a" "EXTRACT_FIXNUM") string-length))
|
|
no-declare
|
|
(to-scheme (C "SQLRETURN SQL_API ~a") "ENTER_FIXNUM"))
|
|
|
|
;;; SQLRowCount returns the number of rows affected by an UPDATE, INSERT, or
|
|
;;; DELETE statement.
|
|
|
|
(define-foreign %row-count
|
|
("SQLRowCount" ((C "SQLHSTMT ~a") statement)
|
|
((C "SDWORD*~a") rows))
|
|
(to-scheme (C "SQLRETURN SQL_API ~a") "ENTER_FIXNUM"))
|
|
|
|
;;; SQLSetCursorName associates a cursor name with an active statement handle.
|
|
;;; If an application does not call SetCursorName, the driver generates cursor
|
|
;;; names as needed for SQL statement processing.
|
|
|
|
(define-foreign %set-cursor-name
|
|
("SQLSetCursorName" ((C "SQLHSTMT ~a") statement)
|
|
(string cursor-name)
|
|
((rep integer? "SWORD ~a" "EXTRACT_FIXNUM") name-length))
|
|
no-declare
|
|
(to-scheme (C "SQLRETURN SQL_API ~a") "ENTER_FIXNUM"))
|
|
|
|
;;; SQLTransact requests a commit or rollback operation for all active
|
|
;;; operations on all statement handles associated with a connection.
|
|
|
|
(define-foreign %transact
|
|
("SQLTransact" ((C "SQLHENV ~a") environment)
|
|
((C "SQLHDBC ~a") connection)
|
|
((rep integer? "UWORD ~a" "EXTRACT_FIXNUM") option))
|
|
(to-scheme (C "SQLRETURN SQL_API ~a") "ENTER_FIXNUM"))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;;
|
|
;;; Other Functions
|
|
;;; ---------------
|
|
;;; These define-foregins link to functions defined in scsh-sql.c. These
|
|
;;; functions are used for allocating and freeing memory in C that the ODBC
|
|
;;; functions utilize.
|
|
;;;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;;; Environment handles
|
|
|
|
(define *environment* #f)
|
|
|
|
(define-foreign make-environment
|
|
(makesqlhenv)
|
|
(C "SQLHENV*~a"))
|
|
|
|
(define-foreign de-ref-env
|
|
(derefsqlhenv ((C "SQLHENV*~a") EnvPointer))
|
|
(C "SQLHENV ~a"))
|
|
|
|
(define-foreign free-environment
|
|
(freesqlhenv ((C "SQLHENV*~a") EnvPointer))
|
|
bool)
|
|
|
|
;;; Connection handles
|
|
|
|
(define-foreign make-connection
|
|
(makesqlhdbc)
|
|
(C "SQLHDBC*~a"))
|
|
|
|
(define-foreign de-ref-con
|
|
(derefsqlhdbc ((C "SQLHDBC*~a") DBCPointer))
|
|
(C "SQLHDBC ~a"))
|
|
|
|
(define-foreign free-connection
|
|
(freesqlhdbc ((C "SQLHDBC*~a") DBCPointer))
|
|
bool)
|
|
|
|
;;; Statement handles
|
|
|
|
(define-foreign make-statement
|
|
(makesqlhstmt)
|
|
(C "SQLHSTMT*~a"))
|
|
|
|
(define-foreign de-ref-stmt
|
|
(derefsqlhstmt ((C "SQLHSTMT*~a") StmtPointer))
|
|
(C "SQLHSTMT ~a"))
|
|
|
|
(define-foreign free-statement
|
|
(freesqlhstmt ((C "SQLHSTMT*~a") StmtPointer))
|
|
bool)
|
|
|
|
;;; void* (unknown type)
|
|
|
|
(define-foreign make-storage
|
|
("makeStorage" ((C "SDWORD*~a") pcbValue))
|
|
(C "void*~a"))
|
|
|
|
(define-foreign free-storage
|
|
("freeStorage" ((C "void*~a") rgbValue))
|
|
bool)
|
|
|
|
;;; SDWORDs (long ints)
|
|
|
|
(define-foreign make-SDWORD
|
|
("makeSDWORD")
|
|
(C "SDWORD*~a"))
|
|
|
|
(define-foreign de-ref-SDWORD
|
|
("derefSDWORD" ((C "SDWORD*~a") SDWORDpointer))
|
|
(C "SDWORD ~a"))
|
|
|
|
(define-foreign extract-SDWORD
|
|
("extractSDWORD" ((C "SDWORD*~a") SDWORDpointer))
|
|
(to-scheme (C "SDWORD ~a") "ENTER_FIXNUM"))
|
|
|
|
(define-foreign assign-SDWORD
|
|
("assignSDWORD" ((C "SDWORD*~a") SDWORDpointer)
|
|
(long value))
|
|
bool)
|
|
|
|
(define-foreign free-SDWORD
|
|
("freeSDWORD" ((C "SDWORD*~a") SDWORDpointer))
|
|
bool)
|
|
|
|
;;; UDWORDs (unsigned long ints)
|
|
|
|
(define-foreign make-UDWORD
|
|
("makeUDWORD")
|
|
(C "UDWORD*~a"))
|
|
|
|
(define-foreign de-ref-UDWORD
|
|
("derefUDWORD" ((C "UDWORD*~a") UDWORDpointer))
|
|
(C "UDWORD ~a"))
|
|
|
|
(define-foreign extract-UDWORD
|
|
("extractUDWORD" ((C "UDWORD*~a") UDWORDpointer))
|
|
(to-scheme (C "UDWORD ~a") "ENTER_FIXNUM"))
|
|
|
|
(define-foreign free-UDWORD
|
|
("freeUDWORD" ((C "UDWORD*~a") UDWORDpointer))
|
|
bool)
|
|
|
|
;;; SWORDs (short ints)
|
|
|
|
(define-foreign make-SWORD
|
|
("makeSWORD")
|
|
(C "SWORD*~a"))
|
|
|
|
(define-foreign de-ref-SWORD
|
|
("derefSWORD" ((C "SWORD*~a") SWORDpointer))
|
|
(C "SWORD ~a"))
|
|
|
|
(define-foreign extract-SWORD
|
|
("extractSWORD" ((C "SWORD*~a") SWORDpointer))
|
|
(to-scheme (C "SWORD ~a") "ENTER_FIXNUM"))
|
|
|
|
(define-foreign assign-SWORD
|
|
("assignSWORD" ((C "SWORD*~a") SWORDpointer)
|
|
(long value))
|
|
bool)
|
|
|
|
(define-foreign free-SWORD
|
|
("freeSWORD" ((C "SWORD*~a") SWORDpointer))
|
|
bool)
|
|
|
|
;;; UCHARs (unsigned chars)
|
|
|
|
(define-foreign make-UCHAR
|
|
("makeUCHAR")
|
|
static-string)
|
|
|
|
(define-foreign de-ref-UCHAR
|
|
("derefUCHAR" (string UCHARpointer))
|
|
(C "UCHAR ~a"))
|
|
|
|
(define-foreign extract-UCHAR
|
|
("extractUCHAR" (string UCHARpointer))
|
|
static-string)
|
|
|
|
(define-foreign free-UCHAR
|
|
("freeUCHAR" (string UCHARpointer))
|
|
bool)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;;
|
|
;;; Getting values to Scheme
|
|
;;; ------------------------
|
|
;;; The following define foreigns enable ways to yank values
|
|
;;; in a C void* into Scheme.
|
|
;;;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define-foreign void*->string
|
|
("VoidToString" ((C "PTR ~a") pointer))
|
|
static-string)
|
|
|
|
(define-foreign void*->integer
|
|
("VoidToInteger" ((C "PTR ~a") pointer))
|
|
integer)
|
|
|
|
(define (void*->number val)
|
|
(string->number (void*->string val)))
|
|
|
|
;;; Date manipulations using sql-date records
|
|
|
|
(define-record sql-date
|
|
seconds ; Seconds after the minute [0-59] or #f
|
|
minute ; Minutes after the hour [0-59] or #f
|
|
hour ; Hours since midnight [0-23] or #f
|
|
month-day ; Day of the month [1-31] or #f
|
|
month ; Months since January [1-12] or #f
|
|
year) ; Years since 1900 or #f
|
|
|
|
;;; Conversion from string into sql-date records
|
|
|
|
(define (void*->date val)
|
|
(let ((date-string (void*->string val)))
|
|
(make-sql-date #f #f #f
|
|
(string->number (substring date-string 8 10))
|
|
(string->number (substring date-string 5 7))
|
|
(string->number (substring date-string 0 4)))))
|
|
|
|
(define (void*->time val)
|
|
(let ((time-string (void*->string val)))
|
|
(make-sql-date (substring time-string 6 8)
|
|
(substring time-string 3 5)
|
|
(substring time-string 0 2)
|
|
#f #f #f)))
|
|
|
|
(define (void*->timestamp val)
|
|
(let ((timestamp-string (void*->string val)))
|
|
(make-sql-date (string->number (substring timestamp-string 17 19))
|
|
(string->number (substring timestamp-string 14 16))
|
|
(string->number (substring timestamp-string 11 13))
|
|
(string->number (substring timestamp-string 8 10))
|
|
(string->number (substring timestamp-string 5 7))
|
|
(string->number (substring timestamp-string 0 4)))))
|
|
|
|
;;; Conversion from sql-date records into strings
|
|
|
|
(define (number->string/len n l)
|
|
(let* ((s (number->string n))
|
|
(dif (- l (string-length n))))
|
|
(case dif
|
|
((0) s)
|
|
((1) (string-append "0" s))
|
|
((2) (string-append "00" s))
|
|
((3) (string-append "000" s)))))
|
|
|
|
(define (sql-date->string d)
|
|
(let ((sd (sql-date:seconds d))
|
|
(mn (sql-date:minute d))
|
|
(hr (sql-date:hour d))
|
|
(md (sql-date:month-day d))
|
|
(mo (sql-date:month d))
|
|
(yr (sql-date:year d)))
|
|
(cond ((and sd mn hr md mo yr) ;make timestamp
|
|
(string-append
|
|
(number->string/len yr 4) "-"
|
|
(number->string/len mo 2) "-"
|
|
(number->string/len md 2) " "
|
|
(number->string/len md 2) ":"
|
|
(number->string/len md 2) ":"
|
|
(number->string/len sd 2)))
|
|
((and sd mn hr) ;make time
|
|
(string-append
|
|
(number->string/len md 2) ":"
|
|
(number->string/len md 2) ":"
|
|
(number->string/len sd 2)))
|
|
((and md mo yr) ;make date
|
|
(string-append
|
|
(number->string/len yr 4) "-"
|
|
(number->string/len mo 2) "-"
|
|
(number->string/len md 2)))
|
|
(else (error "sql-date record contains incomplete fields" d)))))
|
|
|
|
;;; Conversion from scsh date record to sql-date record
|
|
|
|
(define (date->sql-date d)
|
|
(make-sql-date (date:seconds d)
|
|
(date:minute d)
|
|
(date:hour d)
|
|
(date:month-day d)
|
|
(+ 1 (date:month d))
|
|
(date:year d)))
|
|
|
|
;;; Conversion from sql-date record to scsh date record
|
|
;;; This function may return an error if fields in sql-date record are #f.
|
|
;;; Raising an error here will prevent later scsh date manipulations from
|
|
;;; blowing up.
|
|
|
|
(define (sql-date->date d)
|
|
(let ((sd (sql-date:seconds d))
|
|
(mn (sql-date:minute d))
|
|
(hr (sql-date:hour d))
|
|
(md (sql-date:month-day d))
|
|
(mo (sql-date:month d))
|
|
(yr (sql-date:year d)))
|
|
(if (and sd mn hr md mo yr)
|
|
(make-date sd mn hr md (- mo 1) yr)
|
|
(error "sql-date record contains incomplete fields" d))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;;
|
|
;;; Getting values to C
|
|
;;; -------------------
|
|
;;; The following define foreigns enable was to stuff values
|
|
;;; from Scheme into a C void*
|
|
;;;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define-foreign string->void*
|
|
("StringToVoid" (string-desc value)
|
|
((C "PTR ~a") pointer))
|
|
(C "void*~a"))
|
|
|
|
(define-foreign fixed-string->void*
|
|
("FixedStringToVoid" (string-desc value)
|
|
((rep integer? "UDWORD ~a" "EXTRACT_FIXNUM") precision)
|
|
((C "PTR ~a") pointer))
|
|
(C "void*~a"))
|
|
|
|
(define (number->void* num ptr)
|
|
(string->void* (number->string num) ptr))
|
|
|
|
(define-foreign integer->void*
|
|
("IntegerToVoid" (integer value)
|
|
((C "PTR ~a") pointer))
|
|
(C "void*~a"))
|