interfaces/aodbc/aodbc-sql.cl

   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: aodbc-sql.cl,v 1.8 2002/03/29 08:28:14 kevin Exp $
  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 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-sys:database-type-load-foreign ((databae-type (eql :aodbc)))
  30   t)
  31
  32 (when (find-package :dbi)
  33   (clsql-sys:database-type-load-foreign :aodbc))
  34
  35 (defmethod database-initialize-database-type ((database-type (eql :aodbc)))
  36   t)
  37
  38
  39 ;; AODBC interfac
  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   (destructuring-bind (dsn user password) connection-spec
  54     (handler-case
  55         (make-instance 'aodbc-database
  56           :name (database-name-from-spec connection-spec :aodbc)
  57           :aodbc-conn
  58           (dbi:connect :user user
  59                        :password password
  60                        :data-source-name dsn))
  61       (error ()         ;; Init or Connect failed
  62         (error 'clsql-connect-error
  63                :database-type database-type
  64                :connection-spec connection-spec
  65                :errno nil
  66                :error "Connection failed")))))
  67
  68 (defmethod database-disconnect ((database aodbc-database))
  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) types)
  74   (handler-case
  75       (dbi:sql query-expression :db (database-aodbc-conn database)
  76                :types types)
  77     (error ()
  78       (error 'clsql-sql-error
  79              :database database
  80              :expression query-expression
  81              :errno nil
  82              :error "Query failed"))))
  83
  84 (defmethod database-execute-command (sql-expression
  85                                      (database aodbc-database))
  86   (handler-case
  87       (dbi:sql sql-expression :db (database-aodbc-conn database))
  88     (error ()
  89       (error 'clsql-sql-error
  90              :database database
  91              :expression sql-expression
  92              :errno nil
  93              :error "Execute command failed"))))
  94
  95 (defstruct aodbc-result-set
  96   (query nil)
  97   (types nil :type cons)
  98   (full-set nil :type boolean))
  99
 100 (defmethod database-query-result-set (query-expression (database aodbc-database)
 101                                       &key full-set types)
 102   (handler-case
 103       (multiple-value-bind (query column-names)
 104           (dbi:sql query-expression
 105                    :db (database-aodbc-conn database)
 106                    :row-count nil
 107                    :column-names t
 108                    :query t
 109                    :types types
 110                    )
 111         (values
 112          (make-aodbc-result-set :query query :full-set full-set
 113                                 :types types)
 114          (length column-names)
 115          nil ;; not able to return number of rows with aodbc
 116          ))
 117     (error ()
 118       (error 'clsql-sql-error
 119              :database database
 120              :expression query-expression
 121              :errno nil
 122              :error "Query result set failed"))))
 123
 124 (defmethod database-dump-result-set (result-set (database aodbc-database))
 125   (dbi:close-query (aodbc-result-set-query result-set))
 126   t)
 127
 128 (defmethod database-store-next-row (result-set
 129                                     (database aodbc-database)
 130                                     list)
 131   (let ((row (dbi:fetch-row (aodbc-result-set-query result-set) nil 'eof)))
 132     (if (eq row 'eof)
 133         nil
 134       (progn
 135         (loop for elem in row
 136             for rest on list
 137             do
 138               (setf (car rest) elem))
 139         list))))
 140
 141