From b08c25a7a9e56fb125caa9f7d7a56a473615007e Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Mon, 14 Jun 2004 07:46:57 +0000 Subject: [PATCH] r9615: * sql/expressions.lisp: Avoid duplicate FROM names when selecting from a table that has more than one primary index. --- ChangeLog | 6 ++++++ sql/expressions.lisp | 7 ++++++- sql/oodml.lisp | 24 ++++++++++++++++++++++++ sql/package.lisp | 4 +++- 4 files changed, 39 insertions(+), 2 deletions(-) diff --git a/ChangeLog b/ChangeLog index 0dc2e4b..9066b78 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +13 Jun 2004 Kevin Rosenberg + * sql/oodml.lisp: Add new serialization functions: + WRITE-INSTANCE-TO-STREAM and READ-INSTANCE-FROM-STREAM + * sql/expressions.lisp: Avoid duplicate FROM names when selecting + from a table that has more than one primary index. + 13 Jun 2004 Kevin Rosenberg * Version 2.11.9 * sql/conditions.lisp: Set initial slot value for message in SQL-WARNING diff --git a/sql/expressions.lisp b/sql/expressions.lisp index 10b1130..f2d63c9 100644 --- a/sql/expressions.lisp +++ b/sql/expressions.lisp @@ -579,7 +579,12 @@ uninclusive, and the args from that keyword to the end." (when from (write-string " FROM " *sql-stream*) (typecase from - (list (output-sql (apply #'vector from) database)) + (list (output-sql (apply #'vector (remove-duplicates + from + :test #'(lambda (a b) + (string-equal (symbol-name (slot-value a 'name)) + (symbol-name (slot-value b 'name)))))) + database)) (string (write-string from *sql-stream*)) (t (output-sql from database)))) (when inner-join diff --git a/sql/oodml.lisp b/sql/oodml.lisp index 3294443..82f166e 100644 --- a/sql/oodml.lisp +++ b/sql/oodml.lisp @@ -1081,3 +1081,27 @@ as elements of a list." results) + +;;; Serialization functions + +(defun write-instance-to-stream (obj stream) + "Writes an instance to a stream where it can be later be read. +NOTE: an error will occur if a slot holds a value which can not be written readably." + (let* ((class (class-of obj)) + (alist '())) + (dolist (slot (ordered-class-slots (class-of obj))) + (let ((name (slot-definition-name slot))) + (when (and (not (eq 'view-database name)) + (slot-boundp obj name)) + (push (cons name (slot-value obj name)) alist)))) + (setq alist (reverse alist)) + (write (cons (class-name class) alist) :stream stream :readably t)) + obj) + +(defun read-instance-from-stream (stream) + (let ((raw (read stream nil nil))) + (when raw + (let ((obj (make-instance (car raw)))) + (dolist (pair (cdr raw)) + (setf (slot-value obj (car pair)) (cdr pair))) + obj)))) diff --git a/sql/package.lisp b/sql/package.lisp index 32365c0..9d654fc 100644 --- a/sql/package.lisp +++ b/sql/package.lisp @@ -360,7 +360,9 @@ #:delete-instance-records ;; CLSQL Extensions #:*db-auto-sync* - + #:write-instance-to-stream + #:read-instance-from-stream + ;; Symbolic SQL Syntax (syntax.lisp) #:sql #:sql-expression -- 2.34.1