;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Package : sqld-db2.scm ;;; Author : Hans Oesterholt-Dijkema. ;;; Copyright : HOD 2004/2005. ;;; License : The Elemental Programming Artistic License. ;;; CVS : $Id: sqld-db2-internal.scm,v 1.2 2006/01/04 20:15:19 HansOesterholt Exp $ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;=pod ; ;=head1 Name ; ;SQLD-Db2 - SQL Driver for Db2 ; ;=head1 Description ; ;This is an Db2 driver for SQLI. It is a simple ;driver, that has no optimizations like cursor operations, ;connection pools, etc. ; ;This driver conforms to ;L. ; ;The driver must be used through SQLI. ; ;=head1 API ; ;=head2 C<(sqld-db2-new connection-info) : closure> ; ;Calling this function with a valid Db2 database filename, ;will instantiate a new driver, that can be given to a new ;instance of SQLI. ; ;=head1 Synopsis ; ;=syn scm,8 ; ; (module test ; (import sqli) ; (import sqld-db2) ; (main main)) ; ; (define (main argv) ; (let* ((sqld (sqld-db2-new "test.db")) ; (sqlh (sqli-connect sqld)) ; ; (...) ; ;=head1 Literate section ; ;This module L that interfaces to the ;db2client library. ; ;=head2 Module definition ; ;The module definition is as follows: ; ;=verbatim scm,8 ;#+ mzscheme (module sqld-db2-internal mzscheme (require (lib "time.ss" "srfi" "19")) (require "c-sqld-db2.scm") ;## ;=verbatim ; ;As can be seen, only one function is exported, the C function. ;All other function definitions are interface definitions for C functions that ;are called from this module. ; ;=head2 Supportive functions ; ;In the next section, supportive functions and definitions are described. ; ;C defines a precompiled regular expression. This expression ;is used to escape the single quotes in a string. ; ; ;The C function displays a message and returns C<#f>. This function is ;simply used to report errors to the current output port. ; ;=verbatim scm,8 (define (ierr . msg) (define (d msg) (if (null? msg) (newline) (begin (display (car msg)) (d (cdr msg))))) (begin (d msg) #f)) ;=verbatim ; ;=head2 Conversion functions ; ;Conversion functions are used to convert between database representations ;of types and scheme representations of types. They are all straightforward. ; ;Db2 is SQL92 compliant, so for all strings, the single quote must be ;escaped. A simple C call is used to escape the single ;quotes. This function could be made more efficient, using a loop, or ;even a C function to do the same. ; ;=verbatim scm,8 (define (string2db db s) (string-append "'" (c-db2-escape db s) "'")) ;=verbatim ; ;The date types aren't known in Db2, so a date type is constructed ;from the bigloo date type, using a broken ISO8601 encoding (the zone ;info part is not there). ; ;The interpretation back from the database is done by expecting the ;same broken ISO8601 encoding. No checking is done for the parts of the ;strings; so, the ;precondition for the use of this function is, that the given string ;conforms to the previous definition. ; ;=verbatim scm,8 ;#+ mzscheme (define-syntax integer->string (syntax-rules () ((integer->string n) (number->string n)))) (define-syntax string->integer (syntax-rules () ((string->integer s) (string->number s)))) ;## (define (pre-zero2 n) (if (< n 10) (string-append "0" (integer->string n)) (integer->string n))) (define (date2db dt) (string-append "'" (date->string dt "~Y-~m-~d-~H.~M.~S") "'")) (define (db2date dt) (string->date dt "~Y-~m-~d ~H~M~S")) ;=verbatim ; ;All other conversions are done using the standard scheme primitives. ; ;=head2 Connecting ; ;The connection function is called from the closure provided ;by C, when it is called with the C<'connect> ;argument. It returns a closure that is used for further ;command processing and that has a connection to the Db2 ;database. ; ;The commands to be processed are placed in a C structure, ;with the probably most commonly used commands at front. ; ;Supportive functions are defined within the closure, to handle ;the interfacing for queries to the C part and fetches. ; ;=verbatim scm,8 (define (sqld-db2-connect connection-info) (let ((db (c-db2-open connection-info)) (current-query-result #f) (valid-handle #t) (ncols 0) (row 0) (in-transaction #f)) (define (query q) (set! current-query-result (c-db2-query db q)) (set! row -1) (set! ncols (c-db2-nfields current-query-result))) (define (autocommit c) (c-db2-autocommit db c)) (define (fetch) (define (f i) (if (<= i ncols) (cons (c-db2-field current-query-result i) (f (+ i 1))) (list))) (begin (if (eq? (c-db2-fetch current-query-result) #f) #f (f 1)))) (lambda (cmd . args) (if (eq? valid-handle #f) (ierr "ERROR: disconnected handle") (cond ((eq? cmd 'string2db) (string2db db (car args))) ((eq? cmd 'int2db) (integer->string (car args))) ((eq? cmd 'number2db) (number->string (car args))) ((eq? cmd 'date2db) (date2db (car args))) ((eq? cmd 'bool2db) (if (eq? (car args) #t) "1" "0")) ((eq? cmd 'db2date) (db2date (car args))) ((eq? cmd 'db2bool) (if (string=? (car args) "1") #t #f)) ((eq? cmd 'fetchrow) (if (eq? current-query-result #f) #f (fetch))) ((eq? cmd 'lasterr) (c-db2-lasterr db)) ((eq? cmd 'begin) (begin (if (not (eq? in-transaction #t)) (autocommit #f)) (set! in-transaction #t))) ((eq? cmd 'commit) (begin (if (eq? in-transaction #t) (begin (query "COMMIT;") (autocommit #t))) (set! in-transaction #f))) ((eq? cmd 'rollback) (begin (if (eq? in-transaction #t) (begin (query "ROLLBACK;") (autocommit #t))) (set! in-transaction #f))) ((eq? cmd 'query) (query (car args))) ((eq? cmd 'disconnect) (begin (c-db2-close db) (set! valid-handle #f))) (else (ierr "Unknown command"))))))) ;=verbatim ; ;=head2 The main entry function ; ;Now for the main function that this driver provides: C. ;This function takes C as an argument, which must be ;an Db2 database. It returns a closure that handles the C<'connect>, ;C<'clean>, C<'name> and C<'version> calls. It is a very simple function. ; ;The C<'version> call returns the major version number of Db2 * 100 + ;the minor version number. ; ;=verbatim scm,8 (define (sqld-db2-new _connection-info) (let ((connection-info _connection-info)) (lambda (cmd . args) (cond ((eq? cmd 'connect) (sqld-db2-connect connection-info)) ((eq? cmd 'clean) #t) ((eq? cmd 'name) "db2") ((eq? cmd 'version) (c-db2-version)) (else (ierr "ERROR: Connect to the datebase first")))))) ;=verbatim ; ;=cut ;#+ mzscheme (provide sqld-db2-new) ) ;##