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