db-odbc/odbc-sql.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          odbc-sql.cl
   6 ;;;; Purpose:       Low-level interface for CLSQL ODBC backend
   7 ;;;; Programmer:    Kevin M. Rosenberg
   8 ;;;; Date Started:  Feb 2002
   9 ;;;;
  10 ;;;; $Id: odbc-sql.lisp 8983 2004-04-12 21:16:48Z kevin $
  11 ;;;;
  12 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
  13 ;;;;
  14 ;;;; CLSQL users are granted the rights to distribute and use this software
  15 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
  16 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
  17 ;;;; *************************************************************************
  18
  19 (defpackage #:clsql-odbc
  20     (:use #:common-lisp #:clsql-base-sys)
  21     (:export #:odbc-database)
  22     (:documentation "This is the CLSQL interface to ODBC."))
  23
  24 (in-package #:clsql-odbc)
  25
  26 ;; ODBC interface
  27
  28 (defclass odbc-database (database)
  29   ((odbc-conn :accessor database-odbc-conn :initarg :odbc-conn)))
  30
  31 (defmethod database-name-from-spec (connection-spec
  32                                     (database-type (eql :odbc)))
  33   (check-connection-spec connection-spec database-type (dsn user password))
  34   (destructuring-bind (dsn user password) connection-spec
  35     (declare (ignore password))
  36     (concatenate 'string dsn "/" user)))
  37
  38 (defmethod database-connect (connection-spec (database-type (eql :odbc)))
  39   (check-connection-spec connection-spec database-type (dsn user password))
  40   (destructuring-bind (dsn user password) connection-spec
  41     (handler-case
  42         (make-instance 'odbc-database
  43           :name (database-name-from-spec connection-spec :odbc)
  44           :odbc-conn
  45           (odbc:connect :user user
  46                         :password password
  47                         :data-source-name dsn))
  48       (error ()         ;; Init or Connect failed
  49         (error 'clsql-connect-error
  50                :database-type database-type
  51                :connection-spec connection-spec
  52                :errno nil
  53                :error "Connection failed")))))
  54
  55 (defmethod database-disconnect ((database odbc-database))
  56   (odbc:disconnect (database-odbc-conn database))
  57   (setf (database-odbc-conn database) nil)
  58   t)
  59
  60 (defmethod database-query (query-expression (database odbc-database) result-types)
  61   (handler-case
  62       (odbc:sql query-expression :db (database-odbc-conn database)
  63                :types result-types)
  64     (error ()
  65       (error 'clsql-sql-error
  66              :database database
  67              :expression query-expression
  68              :errno nil
  69              :error "Query failed"))))
  70
  71 (defmethod database-execute-command (sql-expression
  72                                      (database odbc-database))
  73   (handler-case
  74       (odbc:sql sql-expression (database-odbc-conn database))
  75     (error ()
  76       (error 'clsql-sql-error
  77              :database database
  78              :expression sql-expression
  79              :errno nil
  80              :error "Execute command failed"))))
  81
  82 (defstruct odbc-result-set
  83   (query nil)
  84   (types nil :type cons)
  85   (full-set nil :type boolean))
  86
  87 (defmethod database-query-result-set ((query-expression string)
  88                                       (database odbc-database)
  89                                       &key full-set result-types)
  90   (handler-case
  91       (multiple-value-bind (query column-names)
  92           (odbc:sql query-expression
  93                    :db (database-odbc-conn database)
  94                    :row-count nil
  95                    :column-names t
  96                    :query t
  97                    :result-types result-types
  98                    )
  99         (values
 100          (make-odbc-result-set :query query :full-set full-set
 101                                 :types result-types)
 102          (length column-names)
 103          nil ;; not able to return number of rows with odbc
 104          ))
 105     (error ()
 106       (error 'clsql-sql-error
 107              :database database
 108              :expression query-expression
 109              :errno nil
 110              :error "Query result set failed"))))
 111
 112 (defmethod database-dump-result-set (result-set (database odbc-database))
 113   (odbc:close-query (odbc-result-set-query result-set))
 114   t)
 115
 116 (defmethod database-store-next-row (result-set
 117                                     (database odbc-database)
 118                                     list)
 119   (let ((row (odbc:fetch-row (odbc-result-set-query result-set) nil 'eof)))
 120     (if (eq row 'eof)
 121         nil
 122       (progn
 123         (loop for elem in row
 124             for rest on list
 125             do
 126               (setf (car rest) elem))
 127         list))))
 128
 129 ;;; Sequence functions
 130
 131 (defun %sequence-name-to-table (sequence-name)
 132   (concatenate 'string "_clsql_seq_" (sql-escape sequence-name)))
 133
 134 (defun %table-name-to-sequence-name (table-name)
 135   (and (>= (length table-name) 11)
 136        (string= (subseq table-name 0 11) "_clsql_seq_")
 137        (subseq table-name 11)))
 138
 139 (defmethod database-create-sequence (sequence-name
 140                                      (database odbc-database))
 141   (let ((table-name (%sequence-name-to-table sequence-name)))
 142     (database-execute-command
 143      (concatenate 'string "CREATE TABLE " table-name
 144                   " (id int NOT NULL PRIMARY KEY AUTO_INCREMENT)")
 145      database)
 146     (database-execute-command
 147      (concatenate 'string "INSERT INTO " table-name
 148                   " VALUES (0)")
 149      database)))
 150
 151 (defmethod database-drop-sequence (sequence-name
 152                                    (database odbc-database))
 153   (database-execute-command
 154    (concatenate 'string "DROP TABLE " (%sequence-name-to-table sequence-name))
 155    database))
 156
 157 (defmethod database-list-sequences ((database odbc-database)
 158                                     &key (owner nil))
 159   (declare (ignore owner))
 160   (mapcar #'(lambda (s) (%table-name-to-sequence-name (car s)))
 161           (database-query "SHOW TABLES LIKE '%clsql_seq%'"
 162                           database nil)))
 163
 164 (defmethod database-set-sequence-position (sequence-name
 165                                            (position integer)
 166                                            (database odbc-database))
 167   (database-execute-command
 168    (format nil "UPDATE ~A SET id=~A" (%sequence-name-to-table sequence-name)
 169            position)
 170    database)
 171   position)
 172
 173 (defmethod database-sequence-next (sequence-name (database odbc-database))
 174   (warn "Not implemented."))
 175
 176 (defmethod database-sequence-last (sequence-name (database odbc-database))
 177   (declare (ignore sequence-name)))
 178
 179 (defmethod database-create (connection-spec (type (eql :odbc)))
 180   (warn "Not implemented."))
 181
 182 (defmethod database-destroy (connection-spec (type (eql :odbc)))
 183   (warn "Not implemented."))
 184
 185 (defmethod database-probe (connection-spec (type (eql :odbc)))
 186   (warn "Not implemented."))
 187
 188 #+ignore
 189 (when (clsql-base-sys:database-type-library-loaded :odbc)
 190   (clsql-base-sys:initialize-database-type :database-type :odbc))