X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql%2Fobjects.lisp;h=2d569c754a0ea6deff68d83edeba3a92b029a403;hb=ec9b352b8205e4204a06797f98970b03cf532ab2;hp=ab1a7bcbefa229e2f1bfeeb95430dfc973318068;hpb=68290f0275c3193cd0413fb247a1395486747338;p=clsql.git diff --git a/sql/objects.lisp b/sql/objects.lisp index ab1a7bc..2d569c7 100644 --- a/sql/objects.lisp +++ b/sql/objects.lisp @@ -397,7 +397,7 @@ superclass of the newly-defined View Class." (let ((qualifier (key-qualifier-for-instance instance :database vd))) (delete-records :from vt :where qualifier :database vd) (setf (slot-value instance 'view-database) nil)) - (error 'clsql-no-database-error nil)))) + (error 'clsql-base::clsql-no-database-error :database nil)))) (defmethod update-instance-from-records ((instance standard-db-object) &key (database *default-database*)) @@ -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,17 @@ 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)))) + (:postgresql + (if (eq :odbc (database-type database)) + (if (string= "0" val) nil t) + (equal "t" val))) + (t + (equal "t" val)))) (defmethod read-sql-value (val (type (eql 'univeral-time)) database) (declare (ignore database)) @@ -785,7 +795,7 @@ superclass of the newly-defined View Class." objects)))) (let* ((*db-deserializing* t) (*default-database* (or database - (error 'clsql-no-database-error nil))) + (error 'clsql-base::clsql-no-database-error :database nil))) (sclasses (mapcar #'find-class view-classes)) (sels (mapcar #'generate-selection-list sclasses)) (fullsels (apply #'append sels)) @@ -825,7 +835,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 +856,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)))))))