db-aodbc/aodbc-sql.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          aodbc-sql.cl
   6 ;;;; Purpose:       Low-level interface for CLSQL AODBC backend
   7 ;;;; Programmer:    Kevin M. Rosenberg
   8 ;;;; Date Started:  Feb 2002
   9 ;;;;
  10 ;;;; $Id$
  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 (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
  20 (in-package :clsql-aodbc)
  21
  22
  23 ;; interface foreign library loading routines
  24 (defmethod clsql-base-sys:database-type-library-loaded ((database-type (eql :aodbc)))
  25   "T if foreign library was able to be loaded successfully. "
  26   (when (find-package :dbi) ;; finds Allegro's DBI (AODBC) package
  27     t))
  28
  29 (defmethod clsql-base-sys:database-type-load-foreign ((databae-type (eql :aodbc)))
  30   t)
  31
  32 (when (find-package :dbi)
  33   (clsql-base-sys:database-type-load-foreign :aodbc))
  34
  35 (defmethod database-initialize-database-type ((database-type (eql :aodbc)))
  36   t)
  37
  38
  39 ;; AODBC interface
  40
  41 (defclass aodbc-database (database)
  42   ((aodbc-conn :accessor database-aodbc-conn :initarg :aodbc-conn)))
  43
  44 (defmethod database-name-from-spec (connection-spec
  45                                     (database-type (eql :aodbc)))
  46   (check-connection-spec connection-spec database-type (dsn user password))
  47   (destructuring-bind (dsn user password) connection-spec
  48     (declare (ignore password))
  49     (concatenate 'string dsn "/" user)))
  50
  51 (defmethod database-connect (connection-spec (database-type (eql :aodbc)))
  52   (check-connection-spec connection-spec database-type (dsn user password))
  53   #+aodbc-v2
  54   (destructuring-bind (dsn user password) connection-spec
  55     (handler-case
  56         (make-instance 'aodbc-database
  57           :name (database-name-from-spec connection-spec :aodbc)
  58           :aodbc-conn
  59           (dbi:connect :user user
  60                        :password password
  61                        :data-source-name dsn))
  62       (error ()         ;; Init or Connect failed
  63         (error 'clsql-connect-error
  64                :database-type database-type
  65                :connection-spec connection-spec
  66                :errno nil
  67                :error "Connection failed")))))
  68
  69 (defmethod database-disconnect ((database aodbc-database))
  70   #+aodbc-v2
  71   (dbi:disconnect (database-aodbc-conn database))
  72   (setf (database-aodbc-conn database) nil)
  73   t)
  74
  75 (defmethod database-query (query-expression (database aodbc-database) types)
  76   #+aodbc-v2
  77   (handler-case
  78       (dbi:sql query-expression :db (database-aodbc-conn database)
  79                :types types)
  80     (error ()
  81       (error 'clsql-sql-error
  82              :database database
  83              :expression query-expression
  84              :errno nil
  85              :error "Query failed"))))
  86
  87 (defmethod database-execute-command (sql-expression
  88                                      (database aodbc-database))
  89   #+aodbc-v2
  90   (handler-case
  91       (dbi:sql sql-expression :db (database-aodbc-conn database))
  92     (error ()
  93       (error 'clsql-sql-error
  94              :database database
  95              :expression sql-expression
  96              :errno nil
  97              :error "Execute command failed"))))
  98
  99 (defstruct aodbc-result-set
 100   (query nil)
 101   (types nil :type cons)
 102   (full-set nil :type boolean))
 103
 104 (defmethod database-query-result-set ((query-expression string)
 105                                       (database aodbc-database)
 106                                       &key full-set types)
 107   #+aodbc-v2
 108   (handler-case
 109       (multiple-value-bind (query column-names)
 110           (dbi:sql query-expression
 111                    :db (database-aodbc-conn database)
 112                    :row-count nil
 113                    :column-names t
 114                    :query t
 115                    :types types
 116                    )
 117         (values
 118          (make-aodbc-result-set :query query :full-set full-set
 119                                 :types types)
 120          (length column-names)
 121          nil ;; not able to return number of rows with aodbc
 122          ))
 123     (error ()
 124       (error 'clsql-sql-error
 125              :database database
 126              :expression query-expression
 127              :errno nil
 128              :error "Query result set failed"))))
 129
 130 (defmethod database-dump-result-set (result-set (database aodbc-database))
 131   #+aodbc-v2
 132   (dbi:close-query (aodbc-result-set-query result-set))
 133   t)
 134
 135 (defmethod database-store-next-row (result-set
 136                                     (database aodbc-database)
 137                                     list)
 138   #+aodbc-v2
 139   (let ((row (dbi:fetch-row (aodbc-result-set-query result-set) nil 'eof)))
 140     (if (eq row 'eof)
 141         nil
 142       (progn
 143         (loop for elem in row
 144             for rest on list
 145             do
 146               (setf (car rest) elem))
 147         list))))
 148
 149 #+ignore
 150 (when (clsql-base-sys:database-type-library-loaded :aodbc)
 151   (clsql-base-sys:initialize-database-type :database-type :aodbc))