From a050eddab954ab3045d8427cf0c5563142266833 Mon Sep 17 00:00:00 2001
From: "Kevin M. Rosenberg" <kevin@rosenberg.net>
Date: Thu, 10 Jun 2004 09:41:27 +0000
Subject: [PATCH] r9576: Add generalized-boolean

---
 ChangeLog                     |  2 ++
 TODO                          |  3 ++-
 db-mysql/mysql-objects.lisp   | 12 ++++++++++++
 db-oracle/oracle-objects.lisp | 11 +++++++++++
 doc/intro.xml                 |  2 +-
 sql/generic-odbc.lisp         |  5 +++++
 sql/oodml.lisp                | 16 ++++++++++++++++
 sql/package.lisp              |  1 +
 8 files changed, 50 insertions(+), 2 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index ca87d03..bfa2556 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,7 @@
 10 Jun 2004 Kevin Rosenberg <kevin@rosenberg.net>
 	* db-mysql/mysql-loader.lisp: Remove load of unnecessary zlib library
+	* multiple: Add generalized-boolean type as requested by
+	Edi Weitz
 	
 9 Jun 2004 Kevin Rosenberg <kevin@rosenberg.net>
 	* Version 2.11.7 released
diff --git a/TODO b/TODO
index c5e706c..b72f150 100644
--- a/TODO
+++ b/TODO
@@ -10,7 +10,8 @@ TESTS TO ADD
 * Number and Char field types
 * Add test case for return type of (setf slot-value-using-class)
 * symbol slot
- 
+* generalized-boolean slot
+
 VARIANCES FROM COMMONSQL
 
 CLSQL starts with in transaction AUTOCOMMIT mode. To begin a transaction,
diff --git a/db-mysql/mysql-objects.lisp b/db-mysql/mysql-objects.lisp
index a118f47..29013c7 100644
--- a/db-mysql/mysql-objects.lisp
+++ b/db-mysql/mysql-objects.lisp
@@ -25,9 +25,21 @@
   (declare (ignore database))
   (if val 1 0))
 
+(defmethod database-output-sql-as-type ((type (eql 'generalized-boolean)) val database
+					(db-type (eql :mysql)))
+  (declare (ignore database))
+  (if val 1 0))
+
 (defmethod read-sql-value (val (type (eql 'boolean)) database
 			   (db-type (eql :mysql)))
   (declare (ignore database)) 
   (etypecase val
     (string (if (string= "0" val) nil t))
     (integer (if (zerop val) nil t))))
+
+(defmethod read-sql-value (val (type (eql 'generalized-boolean)) database
+			   (db-type (eql :mysql)))
+  (declare (ignore database)) 
+  (etypecase val
+    (string (if (string= "0" val) nil t))
+    (integer (if (zerop val) nil t))))
diff --git a/db-oracle/oracle-objects.lisp b/db-oracle/oracle-objects.lisp
index a5583ee..ac85445 100644
--- a/db-oracle/oracle-objects.lisp
+++ b/db-oracle/oracle-objects.lisp
@@ -71,6 +71,11 @@
   (declare (ignore args database))
   "CHAR(1)")
 
+(defmethod database-get-type-specifier ((type (eql 'generalized-boolean)) args
+					database (db-type (eql :oracle)))
+  (declare (ignore args database))
+  "CHAR(1)")
+
 (defmethod read-sql-value (val type
 			   database (db-type (eql :oracle)))
   ;;(format t "value is \"~A\" of type ~A~%" val (type-of val))
@@ -97,6 +102,12 @@
   (when (char-equal #\t (schar val 0))
     t))
 
+(defmethod read-sql-value (val (type (eql 'generalized-boolean))
+			   database (db-type (eql :oracle)))
+  (declare (ignore database))
+  (when (char-equal #\t (schar val 0))
+    t))
+
 (defmethod read-sql-value (val (type (eql 'bigint))
 			   database (db-type (eql :oracle)))
   (declare (ignore database))
diff --git a/doc/intro.xml b/doc/intro.xml
index a717241..c68cc52 100644
--- a/doc/intro.xml
+++ b/doc/intro.xml
@@ -132,7 +132,7 @@
 	socket connections.</para></listitem>
 	<listitem><para>&sqlite;.</para></listitem>
 	<listitem><para>Direct &odbc; interface.</para></listitem>
-        <listitem><para>&oracle;</para></listitem>
+        <listitem><para>&oracle; OCI.</para></listitem>
 	<listitem><para>Allegro's DB interface (&aodbc;).</para></listitem>
       </itemizedlist>
     </sect2>
diff --git a/sql/generic-odbc.lisp b/sql/generic-odbc.lisp
index 06338ae..5d82fdd 100644
--- a/sql/generic-odbc.lisp
+++ b/sql/generic-odbc.lisp
@@ -52,6 +52,11 @@
 			   (db-type (eql :postgresql)))
   (if (string= "0" val) nil t))
 
+(defmethod read-sql-value (val (type (eql 'generalized-boolean))
+			   (database generic-odbc-database)
+			   (db-type (eql :postgresql)))
+  (if (string= "0" val) nil t))
+
   
 ;;; Backend methods
 
diff --git a/sql/oodml.lisp b/sql/oodml.lisp
index 399519c..3294443 100644
--- a/sql/oodml.lisp
+++ b/sql/oodml.lisp
@@ -381,10 +381,18 @@
       (format nil "FLOAT(~A)" (car args))
       "FLOAT"))
 
+(deftype generalized-boolean () 
+  "A type which outputs a SQL boolean value, though any lisp type can be stored in the slot."
+  t)
+
 (defmethod database-get-type-specifier ((type (eql 'boolean)) args database db-type)
   (declare (ignore args database db-type))
   "BOOL")
 
+(defmethod database-get-type-specifier ((type (eql 'generalized-boolean)) args database db-type)
+  (declare (ignore args database db-type))
+  "BOOL")
+
 (defmethod database-get-type-specifier ((type (eql 'number)) args database db-type)
   (declare (ignore database db-type))
   (cond
@@ -442,6 +450,10 @@
   (declare (ignore database db-type))
   (if val "t" "f"))
 
+(defmethod database-output-sql-as-type ((type (eql 'generalized-boolean)) val database db-type)
+  (declare (ignore database db-type))
+  (if val "t" "f"))
+
 (defmethod database-output-sql-as-type ((type (eql 'string)) val database db-type)
   (declare (ignore database db-type))
   val)
@@ -510,6 +522,10 @@
   (declare (ignore database db-type))
   (equal "t" val))
 
+(defmethod read-sql-value (val (type (eql 'generalized-boolean)) database db-type)
+  (declare (ignore database db-type))
+  (equal "t" val))
+
 (defmethod read-sql-value (val (type (eql 'number)) database db-type)
   (declare (ignore database db-type))
   (etypecase val
diff --git a/sql/package.lisp b/sql/package.lisp
index bec6206..0d6d375 100644
--- a/sql/package.lisp
+++ b/sql/package.lisp
@@ -331,6 +331,7 @@
 	 #:view-table        
 	 #:bigint
 	 #:varchar
+	 #:generalized-boolean
 	 #:*default-varchar-length*
 
 	 ;; OODML (oodml.lisp) 
-- 
2.34.1