r9403: Rework conditions to be CommonSQL backward compatible

[clsql.git] / db-mysql / mysql-sql.lisp

diff --git a/db-mysql/mysql-sql.lisp b/db-mysql/mysql-sql.lisp
index dd623033013e7952bf9140a3f0cabe99030ba94c..f85ffac9abcf37698a5316f31b2937b256aef7f8 100644 (file)
--- a/db-mysql/mysql-sql.lisp
+++ b/db-mysql/mysql-sql.lisp
@@ -14,7 +14,7 @@
 ;;;; *************************************************************************
 
 (defpackage #:clsql-mysql
-    (:use #:common-lisp #:clsql-base #:mysql #:clsql-uffi)
+    (:use #:common-lisp #:clsql-sys #:mysql #:clsql-uffi)
     (:export #:mysql-database)
     (:documentation "This is the CLSQL interface to MySQL."))
 
@@ -99,11 +99,11 @@
     (let ((mysql-ptr (mysql-init (uffi:make-null-pointer 'mysql-mysql)))
          (socket nil))
       (if (uffi:null-pointer-p mysql-ptr)
-         (error 'clsql-connect-error
+         (error 'sql-connection-error
                 :database-type database-type
                 :connection-spec connection-spec
-                :errno (mysql-errno mysql-ptr)
-                :error (mysql-error-string mysql-ptr))
+                :error-id (mysql-errno mysql-ptr)
+                :message (mysql-error-string mysql-ptr))
        (uffi:with-cstrings ((host-native host)
                            (user-native user)
                            (password-native password)
@@ -117,11 +117,11 @@
                      db-native 0 socket-native 0))
                    (progn
                      (setq error-occurred t)
-                     (error 'clsql-connect-error
+                     (error 'sql-connect-error
                             :database-type database-type
                             :connection-spec connection-spec
-                            :errno (mysql-errno mysql-ptr)
-                            :error (mysql-error-string mysql-ptr)))
+                            :error-id (mysql-errno mysql-ptr)
+                            :message (mysql-error-string mysql-ptr)))
                  (make-instance 'mysql-database
                    :name (database-name-from-spec connection-spec
                                                   database-type)
@@ -173,16 +173,16 @@
                         (when field-names
                           (result-field-names num-fields res-ptr))))
                  (mysql-free-result res-ptr))
-               (error 'clsql-sql-error
+               (error 'sql-database-data-error
                       :database database
                       :expression query-expression
-                      :errno (mysql-errno mysql-ptr)
-                      :error (mysql-error-string mysql-ptr))))
-         (error 'clsql-sql-error
+                      :error-id (mysql-errno mysql-ptr)
+                      :message (mysql-error-string mysql-ptr))))
+         (error 'sql-database-data-error
                 :database database
                 :expression query-expression
-                :errno (mysql-errno mysql-ptr)
-                :error (mysql-error-string mysql-ptr))))))
+                :error-id (mysql-errno mysql-ptr)
+                :message (mysql-error-string mysql-ptr))))))
 
 (defmethod database-execute-command (sql-expression (database mysql-database))
   (uffi:with-cstring (sql-native sql-expression)
@@ -191,11 +191,11 @@
       (if (zerop (mysql-real-query mysql-ptr sql-native 
                                    (length sql-expression)))
          t
-       (error 'clsql-sql-error
+       (error 'sql-database-data-error
               :database database
               :expression sql-expression
-              :errno (mysql-errno mysql-ptr)
-              :error (mysql-error-string mysql-ptr))))))
+              :error-id (mysql-errno mysql-ptr)
+              :message (mysql-error-string mysql-ptr))))))
 
 
 (defstruct mysql-result-set 
@@ -233,16 +233,16 @@
                              (mysql-num-rows res-ptr))
                      (values result-set
                              num-fields)))
-               (error 'clsql-sql-error
+               (error 'sql-database-data-error
                     :database database
                     :expression query-expression
-                    :errno (mysql-errno mysql-ptr)
-                    :error (mysql-error-string mysql-ptr))))
-       (error 'clsql-sql-error
+                    :error-id (mysql-errno mysql-ptr)
+                    :message (mysql-error-string mysql-ptr))))
+       (error 'sql-database-data-error
               :database database
               :expression query-expression
-              :errno (mysql-errno mysql-ptr)
-              :error (mysql-error-string mysql-ptr))))))
+              :error-id (mysql-errno mysql-ptr)
+              :message (mysql-error-string mysql-ptr))))))
 
 (defmethod database-dump-result-set (result-set (database mysql-database))
   (mysql-free-result (mysql-result-set-res-ptr result-set))
@@ -392,33 +392,31 @@
 (defmethod database-create (connection-spec (type (eql :mysql)))
   (destructuring-bind (host name user password) connection-spec
     (multiple-value-bind (output status)
-       (clsql-base:command-output "mysqladmin create -u~A -p~A -h~A ~A"
+       (clsql-sys:command-output "mysqladmin create -u~A -p~A -h~A ~A"
                                       user password 
                                       (if host host "localhost")
                                       name)
       (if (or (not (eql 0 status))
              (and (search "failed" output) (search "error" output)))
-         (error 'clsql-access-error
-                :connection-spec connection-spec
-                :database-type type
-                :error 
-                (format nil "database-create failed: ~A" output))
-         t))))
+         (error 'sql-database-error
+                :message 
+                (format nil "mysql database creation failed with connection-spec ~A."
+                        connection-spec))
+       t))))
 
 (defmethod database-destroy (connection-spec (type (eql :mysql)))
   (destructuring-bind (host name user password) connection-spec
     (multiple-value-bind (output status)
-       (clsql-base:command-output "mysqladmin drop -f -u~A -p~A -h~A ~A"
+       (clsql-sys:command-output "mysqladmin drop -f -u~A -p~A -h~A ~A"
                                       user password 
                                       (if host host "localhost")
                                       name)
       (if (or (not (eql 0 status))
              (and (search "failed" output) (search "error" output)))
-         (error 'clsql-access-error
-                :connection-spec connection-spec
-                :database-type type
-                :error 
-                (format nil "database-destroy failed: ~A" output))
+         (error 'sql-database-error
+                :message 
+                (format nil "mysql database deletion failed with connection-spec ~A."
+                        connection-spec))
        t))))
 
 (defmethod database-probe (connection-spec (type (eql :mysql)))
@@ -432,11 +430,11 @@
     (let ((database (database-connect (list host "mysql" user password) type)))
       (unwind-protect
           (progn
-            (setf (slot-value database 'clsql-base::state) :open)
+            (setf (slot-value database 'clsql-sys::state) :open)
             (mapcar #'car (database-query "show databases" database :auto nil)))
        (progn
          (database-disconnect database)
-         (setf (slot-value database 'clsql-base::state) :closed))))))
+         (setf (slot-value database 'clsql-sys::state) :closed))))))
 
 ;;; Database capabilities
 
@@ -454,10 +452,13 @@
 (defmethod db-type-has-boolean-where? ((db-type (eql :mysql)))
   nil)
 
+(defmethod db-type-has-union? ((db-type (eql :mysql)))
+  (not (eql (schar mysql::*mysql-client-info* 0) #\3)))
+
 (defmethod db-type-transaction-capable? ((db-type (eql :mysql)) database)
   (let ((tuple (car (database-query "SHOW VARIABLES LIKE 'HAVE_INNODB'" database :auto nil))))
     (and tuple (string-equal "YES" (second tuple)))))
 
-(when (clsql-base:database-type-library-loaded :mysql)
-  (clsql-base:initialize-database-type :database-type :mysql))
+(when (clsql-sys:database-type-library-loaded :mysql)
+  (clsql-sys:initialize-database-type :database-type :mysql))