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