X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql%2Fobjects.lisp;h=e4b0ca13c50c328d9035cc0a46899b04995ce983;hb=fa32c4233b4a02ae631602dbb0a234ab10df8aaf;hp=1991b70c151f6e9b86f2781dc7ccf29ee3fde70b;hpb=5a6f424f3c8920f8f11bbf1e3aed6b4c2c7e6af8;p=clsql.git diff --git a/sql/objects.lisp b/sql/objects.lisp index 1991b70..e4b0ca1 100644 --- a/sql/objects.lisp +++ b/sql/objects.lisp @@ -1,14 +1,17 @@ ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- -;;;; ====================================================================== -;;;; $Id: $ +;;;; ************************************************************************* ;;;; -;;;; Description ========================================================== -;;;; ====================================================================== +;;;; $Id$ ;;;; ;;;; The CLSQL Object Oriented Data Definitional Language (OODDL) ;;;; and Object Oriented Data Manipulation Language (OODML). ;;;; -;;;; ====================================================================== +;;;; This file is part of CLSQL. +;;;; +;;;; CLSQL users are granted the rights to distribute and use this software +;;;; as governed by the terms of the Lisp Lesser GNU Public License +;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. +;;;; ************************************************************************* (in-package #:clsql-sys) @@ -101,9 +104,9 @@ (defun ensure-schema-version-table (database) (unless (table-exists-p "clsql_object_v" :database database) - (create-table [clsql_object_v] '(([name] (string 32)) + (create-table [clsql_object_v] '(([name] string) ([vers] integer) - ([def] (string 32))) + ([def] string)) :database database))) (defun update-schema-version-records (view-class-name @@ -142,7 +145,7 @@ the view. The argument DATABASE has a default value of (values)) (defmethod %install-class ((self standard-db-class) database &aux schemadef) - (dolist (slotdef (class-slots self)) + (dolist (slotdef (ordered-class-slots self)) (let ((res (database-generate-column-definition (class-name self) slotdef database))) (when res @@ -259,7 +262,7 @@ superclass of the newly-defined View Class." (defun generate-selection-list (vclass) (let ((sels nil)) - (dolist (slotdef (class-slots vclass)) + (dolist (slotdef (ordered-class-slots vclass)) (let ((res (generate-attribute-reference vclass slotdef))) (when res (push (cons slotdef res) sels)))) @@ -294,7 +297,7 @@ superclass of the newly-defined View Class." list)) (defun slot-type (slotdef) - (let ((slot-type (slot-definition-type slotdef))) + (let ((slot-type (specified-type slotdef))) (if (listp slot-type) (cons (find-symbol (symbol-name (car slot-type)) :clsql-sys) (cdr slot-type)) @@ -526,7 +529,7 @@ associated with that database.")) (db-value-from-slot slot value database))))) (let* ((view-class (class-of obj)) (view-class-table (view-table view-class)) - (slots (remove-if-not #'slot-storedp (class-slots view-class))) + (slots (remove-if-not #'slot-storedp (ordered-class-slots view-class))) (record-values (mapcar #'slot-value-list slots))) (unless record-values (error "No settable slots.")) @@ -555,7 +558,7 @@ associated with that database.")) (db-value-from-slot slot value database))))) (let* ((view-class (class-of obj)) (view-class-table (view-table view-class)) - (slots (remove-if-not #'slot-storedp (class-slots view-class))) + (slots (remove-if-not #'slot-storedp (ordered-class-slots view-class))) (record-values (mapcar #'slot-value-list slots))) (unless record-values (error "No settable slots.")) @@ -616,7 +619,7 @@ associated with that database.")) (let* ((view-class (class-of instance)) (joins (remove-if #'(lambda (sd) (not (equal (view-class-slot-db-kind sd) :join))) - (class-slots view-class)))) + (ordered-class-slots view-class)))) (dolist (slot joins) (let ((delete-rule (gethash :delete-rule (view-class-slot-db-info slot)))) (cond