;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Package   : sqld-mysql.scm
;;; Author    : Hans Oesterholt-Dijkema.
;;; Copyright : HOD 2004/2005.
;;; License   : The Elemental Programming Artistic License.
;;; CVS       : $Id: sqld-mysql-internal.scm,v 1.2 2006/01/04 20:15:19 HansOesterholt Exp $
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;=pod
;
;=head1 Name
;
;SQLD-MySQL - SQL Driver for MySQL
;
;=head1 Description
;
;This is an MySQL driver for SQLI. It is a simple
;driver, that has no optimizations like cursor operations,
;connection pools, etc.
;
;This driver conforms to
;L<the interface description for drivers|SQLD - Interface description for SQLI drivers>.
;
;The driver must be used through SQLI.
;
;=head1 API
;
;=head2 C<(sqld-mysql-new connection-info) : closure>
;
;Calling this function with a valid MySQL 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-mysql)
; 	(main main))
;
; (define (main argv)
;   (let* ((sqld    (sqld-mysql-new "test.db"))
; 	   (sqlh    (sqli-connect sqld))
;
; (...)
;
;=head1 Literate section
;
;This module L<interfaces with a C part|SQLD-MySQL - C part> that interfaces to the
;mysqlclient library.
;
;=head2 Module definition
;
;The module definition is as follows:
;
;=verbatim scm,8
;#+ mzscheme
(module sqld-mysql-internal mzscheme
	(require (lib "time.ss" "srfi" "19"))
	(require "c-sqld-mysql.scm")
;##
;=verbatim
;
;As can be seen, only one function is exported, the C<sqld-mysql-new> 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<re-quote> defines a precompiled regular expression. This expression
;is used to escape the single quotes in a string.
;
;=verbatim scm,8
;;#+ bigloo
;(define re-quote (pregexp "[']"))
;#+ mzscheme
(define re-quote (regexp "[']"))
;##
;=verbatim
;
;The C<ierr> 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.
;
;MySQL is SQL92 compliant, so for all strings, the single quote must be
;escaped. A simple C<pregexp-replace*> 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-mysql-escape db s) "'"))
;=verbatim
;
;The date types aren't known in MySQL, 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
(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<sqld-mysql-new>, 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 Mysql
;database.
;
;The commands to be processed are placed in a C<cond> 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-mysql-connect connection-info)
  (let ((db (c-mysql-open connection-info))
	(current-query-result #f)
	(valid-handle #t)
	(nrows 0)
	(ncols 0)
	(row 0)
	(in-transaction #f))

    (define (query q)
      (set! current-query-result (c-mysql-query db q))
      (set! row -1)
      (set! ncols (c-mysql-nfields current-query-result))
      (set! nrows (c-mysql-nrows   current-query-result)))

    (define (fetch)

      (define (f i)
	(if (< i ncols)
	    (cons (c-mysql-field current-query-result row i) (f (+ i 1)))
	    (list)))
	
      (begin
	(set! row (+ row 1))
	(if (>= row nrows)
	    #f
	    (f 0))))


    (lambda (cmd . args)
;      (ierr "sqld-mysql: " 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-mysql-lasterr db))

	   ((eq? cmd 'begin) 
	    (begin
	      (if (not (eq? in-transaction #t)) 
		  (query "BEGIN;"))
	      (set! in-transaction #t)))

	   ((eq? cmd 'commit) 
	    (begin
	      (if (eq? in-transaction #t)
		  (query "COMMIT;"))
	      (set! in-transaction #f)))
	    
	   ((eq? cmd 'rollback) 
	    (begin
	      (if (eq? in-transaction #t)
		  (query "ROLLBACK;"))
	      (set! in-transaction #f)))

	   ((eq? cmd 'query) (query (car args)))

	   ((eq? cmd 'disconnect) 
	    (begin
	      (c-mysql-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<sqld-mysql-new>.
;This function takes C<connection-info> as an argument, which must be
;an Mysql 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 Mysql * 100 +
;the minor version number.
;
;=verbatim scm,8
(define (sqld-mysql-new _connection-info)
  (let ((connection-info _connection-info))
    (lambda (cmd . args)
      (cond

       ((eq? cmd 'connect) (sqld-mysql-connect connection-info))
       ((eq? cmd 'clean) #t)

       ((eq? cmd 'name) "mysql")
       ((eq? cmd 'version) (c-mysql-version))

       (else (ierr "ERROR: Connect to the datebase first"))))))
;=verbatim
;
;=cut


;#+ mzscheme
   (provide sqld-mysql-new)
)
;##