X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Fnew-objects.lisp;h=d2013b74009e325b04bf13968e9799bf6922bc1e;hp=cfd63e173bacb0a2c5240c7f306f2129d93e9206;hb=9bbed78051e80e6ab76ae47834136035602bbbf1;hpb=6c70be35cc348b559d8aa869ecd0e14e27d5edbc

diff --git a/sql/new-objects.lisp b/sql/new-objects.lisp
index cfd63e1..d2013b7 100644
--- a/sql/new-objects.lisp
+++ b/sql/new-objects.lisp
@@ -324,74 +324,6 @@ superclass of the newly-defined View Class."
       (mapc #'update-slot slotdeflist values)
       obj))
 
-(defun synchronize-keys (src srckey dest destkey)
-  (let ((skeys (if (listp srckey) srckey (list srckey)))
-	(dkeys (if (listp destkey) destkey (list destkey))))
-    (mapcar #'(lambda (sk dk)
-		(setf (slot-value dest dk)
-		      (typecase sk
-			(symbol
-			 (slot-value src sk))
-			(t sk))))
-	    skeys dkeys)))
-
-(defun desynchronize-keys (dest destkey)
-  (let ((dkeys (if (listp destkey) destkey (list destkey))))
-    (mapcar #'(lambda (dk)
-		(setf (slot-value dest dk) nil))
-	    dkeys)))
-
-(defmethod add-to-relation ((target standard-db-object)
-			    slot-name
-			    (value standard-db-object))
-  (let* ((objclass (class-of target))
-	 (sdef (or (slotdef-for-slot-with-class slot-name objclass)
-                   (error "~s is not an known slot on ~s" slot-name target)))
-	 (dbinfo (view-class-slot-db-info sdef))
-	 (join-class (gethash :join-class dbinfo))
-	 (homekey (gethash :home-key dbinfo))
-	 (foreignkey (gethash :foreign-key dbinfo))
-	 (to-many (gethash :set dbinfo)))
-    (unless (equal (type-of value) join-class)
-      (error 'clsql-type-error :slotname slot-name :typespec join-class
-             :value value))
-    (when (gethash :target-slot dbinfo)
-      (error "add-to-relation does not work with many-to-many relations yet."))
-    (if to-many
-	(progn
-	  (synchronize-keys target homekey value foreignkey)
-	  (if (slot-boundp target slot-name)
-              (unless (member value (slot-value target slot-name))
-                (setf (slot-value target slot-name)
-                      (append (slot-value target slot-name) (list value))))
-              (setf (slot-value target slot-name) (list value))))
-        (progn
-          (synchronize-keys value foreignkey target homekey)
-          (setf (slot-value target slot-name) value)))))
-
-(defmethod remove-from-relation ((target standard-db-object)
-			    slot-name (value standard-db-object))
-  (let* ((objclass (class-of target))
-	 (sdef (slotdef-for-slot-with-class slot-name objclass))
-	 (dbinfo (view-class-slot-db-info sdef))
-	 (homekey (gethash :home-key dbinfo))
-	 (foreignkey (gethash :foreign-key dbinfo))
-	 (to-many (gethash :set dbinfo)))
-    (when (gethash :target-slot dbinfo)
-      (error "remove-relation does not work with many-to-many relations yet."))
-    (if to-many
-	(progn
-	  (desynchronize-keys value foreignkey)
-	  (if (slot-boundp target slot-name)
-	      (setf (slot-value target slot-name)
-		    (remove value
-			    (slot-value target slot-name)
-                            :test #'equal))))
-        (progn
-          (desynchronize-keys target homekey)
-          (setf (slot-value target slot-name)
-                nil)))))
-
 (defgeneric update-record-from-slot (object slot &key database)
   (:documentation
    "The generic function UPDATE-RECORD-FROM-SLOT updates an individual
@@ -502,6 +434,12 @@ associated with that database."))
  (setf (symbol-function (intern (symbol-name '#:store-instance)))
    (symbol-function 'update-records-from-instance))
 
+(defgeneric delete-instance-records (instance)
+  (:documentation
+   "Deletes the records represented by INSTANCE from the database
+associated with it. If instance has no associated database, an error
+is signalled."))
+
 (defmethod delete-instance-records ((object standard-db-object))
   (let ((vt (sql-expression :table (view-table (class-of object))))
         (qualifier (key-qualifier-for-instance object :database *default-database*)))
@@ -586,7 +524,7 @@ DATABASE-NULL-VALUE on the type of the slot."))
 
 (defmethod database-get-type-specifier (type args database)
   (declare (ignore type args))
-  (if (member (database-type database) '(:postgresql :postgresql-socket))
+  (if (member (database-underlying-type database) '(:postgresql :postgresql-socket))
           "VARCHAR"
           "VARCHAR(255)"))
 
@@ -601,7 +539,7 @@ DATABASE-NULL-VALUE on the type of the slot."))
                                         database)
   (if args
       (format nil "VARCHAR(~A)" (car args))
-      (if (member (database-type database) '(:postgresql :postgresql-socket))
+      (if (member (database-underlying-type database) '(:postgresql :postgresql-socket))
           "VARCHAR"
           "VARCHAR(255)")))
 
@@ -609,20 +547,20 @@ DATABASE-NULL-VALUE on the type of the slot."))
                                         database)
   (if args
       (format nil "VARCHAR(~A)" (car args))
-      (if (member (database-type database) '(:postgresql :postgresql-socket))
+      (if (member (database-underlying-type database) '(:postgresql :postgresql-socket))
           "VARCHAR"
           "VARCHAR(255)")))
 
 (defmethod database-get-type-specifier ((type (eql 'string)) args database)
   (if args
       (format nil "VARCHAR(~A)" (car args))
-      (if (member (database-type database) '(:postgresql :postgresql-socket))
+      (if (member (database-underlying-type database) '(:postgresql :postgresql-socket))
           "VARCHAR"
           "VARCHAR(255)")))
 
 (defmethod database-get-type-specifier ((type (eql 'wall-time)) args database)
   (declare (ignore args))
-  (case (database-type database)
+  (case (database-underlying-type database)
     (:postgresql
      "TIMESTAMP WITHOUT TIME ZONE")
     (:postgresql-socket
@@ -673,7 +611,7 @@ DATABASE-NULL-VALUE on the type of the slot."))
   (declare (ignore database))
   (progv '(*print-circle* *print-array*) '(t t)
     (let ((escaped (prin1-to-string val)))
-      (clsql-base-sys::substitute-char-string
+      (clsql-base::substitute-char-string
        escaped #\Null " "))))
 
 (defmethod database-output-sql-as-type ((type (eql 'symbol)) val database)