X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql%2Fobjects.lisp;h=0232917ff4662b7ca80ae62d79b75b86cfd4c08d;hb=f69c5bfba59d54628f9a08b83413ec3df3c92432;hp=ab1a7bcbefa229e2f1bfeeb95430dfc973318068;hpb=68290f0275c3193cd0413fb247a1395486747338;p=clsql.git diff --git a/sql/objects.lisp b/sql/objects.lisp index ab1a7bc..0232917 100644 --- a/sql/objects.lisp +++ b/sql/objects.lisp @@ -430,9 +430,7 @@ superclass of the newly-defined View Class." (defmethod update-slot-with-null ((object standard-db-object) slotname slotdef) - (let ((st (slot-type slotdef)) - (void-value (slot-value slotdef 'void-value))) - (setf (slot-value object slotname) void-value))) + (setf (slot-value object slotname) (slot-value slotdef 'void-value))) (defvar +no-slot-value+ '+no-slot-value+) @@ -586,8 +584,11 @@ superclass of the newly-defined View Class." (prin1-to-string val))) (defmethod database-output-sql-as-type ((type (eql 'boolean)) val database) - (declare (ignore database)) - (if val "t" "f")) + (case (database-underlying-type database) + (:mysql + (if val 1 0)) + (t + (if val "t" "f")))) (defmethod database-output-sql-as-type ((type (eql 'string)) val database) (declare (ignore database)) @@ -658,8 +659,13 @@ superclass of the newly-defined View Class." (float (read-from-string val))) (defmethod read-sql-value (val (type (eql 'boolean)) database) - (declare (ignore database)) - (equal "t" val)) + (case (database-underlying-type database) + (:mysql + (etypecase val + (string (if (string= "0" val) nil t)) + (integer (if (zerop val) nil t)))) + (t + (equal "t" val)))) (defmethod read-sql-value (val (type (eql 'univeral-time)) database) (declare (ignore database)) @@ -825,7 +831,7 @@ superclass of the newly-defined View Class." (defmethod instance-refreshed ((instance standard-db-object))) -(defun select (&rest select-all-args) +(defmethod select (&rest select-all-args) "Selects data from database given the constraints specified. Returns a list of lists of record values as specified by select-all-args. By default, the records are each represented as lists of attribute @@ -846,9 +852,10 @@ tuples." (let ((expr (apply #'make-query select-all-args))) (destructuring-bind (&key (flatp nil) (result-types :auto) + (field-names t) (database *default-database*) &allow-other-keys) qualifier-args (query expr :flatp flatp :result-types result-types - :database database))))))) + :field-names field-names :database database)))))))