From 9242af658c4978cba02cdfde02d5337a04788978 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Sun, 23 May 2004 10:12:56 +0000 Subject: [PATCH] r9448: * db-odbc/odbc-sql.lisp, db-aodbc/aodbc-sql.lisp: Move common code to sql/generic-odbc.lisp * db-postgresql/postgresql-sql.lisp, db-postgresql-socket/postgresql-socket-sql.lisp: Move common code to sql/generic-postgresql.lisp --- sql/classes.lisp | 3 +- sql/generic-odbc.lisp | 183 +++++++++++++++++++++++++++++++++++- sql/generic-postgresql.lisp | 11 ++- 3 files changed, 192 insertions(+), 5 deletions(-) diff --git a/sql/classes.lisp b/sql/classes.lisp index 3bde105..6848621 100644 --- a/sql/classes.lisp +++ b/sql/classes.lisp @@ -100,8 +100,7 @@ (call-next-method))))) (defmethod output-sql ((expr sql-ident) database) - (with-slots (name) - expr + (with-slots (name) expr (write-string (convert-to-db-default-case (etypecase name diff --git a/sql/generic-odbc.lisp b/sql/generic-odbc.lisp index a5e8c68..8601ed6 100644 --- a/sql/generic-odbc.lisp +++ b/sql/generic-odbc.lisp @@ -1,7 +1,7 @@ ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;;; ************************************************************************* ;;;; -;;;; $Id$ +;;;; $Id: $ ;;;; ;;;; Generic ODBC layer, used by db-odbc and db-aodbc backends ;;;; @@ -15,11 +15,190 @@ (in-package #:clsql-sys) (defclass generic-odbc-database (database) - () + ((dbi-package :initarg :dbi-package :reader dbi-package) + (odbc-conn :initarg :odbc-conn :initform nil :accessor odbc-conn) + (disconnect-fn :reader disconnect-fn) + (sql-fn :reader sql-fn) + (close-query-fn :reader close-query-fn) + (fetch-row :reader fetch-row-fn) + (list-all-database-tables-fn :reader list-all-database-tables-fn) + (list-all-table-columns-fn :reader list-all-table-columns-fn)) (:documentation "Encapsulate same behavior across odbc and aodbc backends.")) +(defmethod initialize-instance :after ((db generic-odbc-database) + &rest all-keys) + (unless (slot-boundp db 'dbi-package) + (error "dbi-package not specified.")) + (let ((pkg (slot-value db 'dbi-package))) + (unless pkg + (error "dbi-package is nil.")) + (setf (slot-value db 'disconnect-fn) + (intern (symbol-name '#:disconnect) pkg) + (slot-value db 'sql-fn) + (intern (symbol-name '#:sql) pkg) + (slot-value db 'close-query-fn) + (intern (symbol-name '#:close-query) pkg) + (slot-value db 'fetch-row) + (intern (symbol-name '#:fetch-row) pkg) + (slot-value db 'list-all-database-tables-fn) + (intern (symbol-name '#:list-all-database-tables) pkg) + (slot-value db 'list-all-table-columns-fn) + (intern (symbol-name '#:list-all-table-columns) pkg)))) + +;;; Object methods + (defmethod read-sql-value (val (type (eql 'boolean)) (database generic-odbc-database) (db-type (eql :postgresql))) (if (string= "0" val) nil t)) + +;;; Backend methods + +(defmethod database-disconnect ((database generic-odbc-database)) + (funcall (disconnect-fn database) (odbc-conn database)) + (setf (odbc-conn database) nil) + t) + +(defmethod database-query (query-expression (database generic-odbc-database) + result-types field-names) + (handler-case + (funcall (sql-fn database) + query-expression :db (odbc-conn database) + :result-types result-types + :column-names field-names) + (error () + (error 'sql-database-data-error + :database database + :expression query-expression + :message "Query failed")))) + + +(defmethod database-execute-command (sql-expression (database generic-odbc-database)) + (handler-case + (funcall (sql-fn database) + sql-expression :db (odbc-conn database)) + #+ignore + (sql-error (e) + (error e)) + #+ignore + (error () + (error 'sql-database-data-error + :database database + :expression sql-expression + :message "Execute command failed")))) + + +(defstruct odbc-result-set + (query nil) + (types nil) + (full-set nil :type boolean)) + + + + +(defmethod database-query-result-set ((query-expression string) + (database generic-odbc-database) + &key full-set result-types) + (handler-case + (multiple-value-bind (query column-names) + (funcall (sql-fn database) + query-expression + :db (odbc-conn database) + :row-count nil + :column-names t + :query t + :result-types result-types) + (values + (make-odbc-result-set :query query :full-set full-set + :types result-types) + (length column-names) + nil ;; not able to return number of rows with odbc + )) + (error () + (error 'sql-database-data-error + :database database + :expression query-expression + :message "Query result set failed")))) + +(defmethod database-dump-result-set (result-set (database generic-odbc-database)) + (funcall (close-query-fn database) (odbc-result-set-query result-set)) + t) + +(defmethod database-store-next-row (result-set + (database generic-odbc-database) + list) + (let ((row (funcall (fetch-row-fn database) + (odbc-result-set-query result-set) nil 'eof))) + (if (eq row 'eof) + nil + (progn + (loop for elem in row + for rest on list + do + (setf (car rest) elem)) + list)))) + +(defmethod database-list-tables ((database generic-odbc-database) + &key (owner nil)) + (declare (ignore owner)) + (multiple-value-bind (rows col-names) + (funcall (list-all-database-tables-fn database) :db (odbc-conn database)) + (declare (ignore col-names)) + ;; TABLE_SCHEM is hard-coded in second column by ODBC Driver Manager + ;; TABLE_NAME in third column, TABLE_TYPE in fourth column + (loop for row in rows + when (and (not (string-equal "information_schema" (nth 1 row))) + (string-equal "TABLE" (nth 3 row))) + collect (nth 2 row)))) + + +(defmethod database-list-views ((database generic-odbc-database) + &key (owner nil)) + (declare (ignore owner)) + (multiple-value-bind (rows col-names) + (funcall (list-all-database-tables-fn database) :db (odbc-conn database)) + (declare (ignore col-names)) + ;; TABLE_SCHEM is hard-coded in second column by ODBC Driver Manager + ;; TABLE_NAME in third column, TABLE_TYPE in fourth column + (loop for row in rows + when (and (not (string-equal "information_schema" (nth 1 row))) + (string-equal "VIEW" (nth 3 row))) + collect (nth 2 row)))) + + +(defmethod database-list-attributes ((table string) (database generic-odbc-database) + &key (owner nil)) + (declare (ignore owner)) + (multiple-value-bind (rows col-names) + (funcall (list-all-table-columns-fn database) table + :db (odbc-conn database)) + (declare (ignore col-names)) + ;; COLUMN_NAME is hard-coded by odbc spec as fourth position + (loop for row in rows + collect (fourth row)))) + + + +(defmethod database-attribute-type ((attribute string) (table string) (database generic-odbc-database) + &key (owner nil)) + (declare (ignore owner)) + (multiple-value-bind (rows col-names) + (funcall (list-all-table-columns-fn database) table + :db (odbc-conn database)) + (declare (ignore col-names)) + ;; COLUMN_NAME is hard-coded by odbc spec as fourth position + ;; TYPE_NAME is the sixth column + ;; PRECISION/COLUMN_SIZE is the seventh column + ;; SCALE/DECIMAL_DIGITS is the ninth column + ;; NULLABLE is the eleventh column + (loop for row in rows + when (string-equal attribute (fourth row)) + do + (let ((size (seventh row)) + (precision (ninth row)) + (scale (nth 10 row))) + (return (values (ensure-keyword (sixth row)) + (when size (parse-integer size)) + (when precision (parse-integer precision)) + (when scale (parse-integer scale)))))))) diff --git a/sql/generic-postgresql.lisp b/sql/generic-postgresql.lisp index af0ef61..45ad1fb 100644 --- a/sql/generic-postgresql.lisp +++ b/sql/generic-postgresql.lisp @@ -1,7 +1,7 @@ ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;;; ************************************************************************* ;;;; -;;;; $Id$ +;;;; $Id: $ ;;;; ;;;; Generic postgresql layer, used by db-postgresql and db-postgresql-socket ;;;; @@ -227,3 +227,12 @@ (sql-escape (string-downcase table))) database :auto nil)) + +;; Capabilities + +(defmethod db-type-has-fancy-math? ((db-type (eql :postgresql))) + t) + +(defmethod db-type-default-case ((db-type (eql :postgresql))) + :lower) + -- 2.34.1