X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql%2Fobjects.lisp;h=e4b0ca13c50c328d9035cc0a46899b04995ce983;hb=fa32c4233b4a02ae631602dbb0a234ab10df8aaf;hp=14bb76f8ddd3eb2f09e019d23191dfc7253f756b;hpb=7f0e4a65d1b425f2fa58fc7cce8296c1a6c52c2f;p=clsql.git diff --git a/sql/objects.lisp b/sql/objects.lisp index 14bb76f..e4b0ca1 100644 --- a/sql/objects.lisp +++ b/sql/objects.lisp @@ -1,18 +1,19 @@ ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- -;;;; ====================================================================== -;;;; File: objects.lisp -;;;; Updated: <04/04/2004 12:07:55 marcusp> -;;;; ====================================================================== +;;;; ************************************************************************* ;;;; -;;;; Description ========================================================== -;;;; ====================================================================== +;;;; $Id$ ;;;; -;;;; The CLSQL-USQL Object Oriented Data Definitional Language (OODDL) +;;;; 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-usql-sys) +(in-package #:clsql-sys) (defclass standard-db-object () ((view-database @@ -20,7 +21,7 @@ :initarg :view-database :db-kind :virtual)) (:metaclass standard-db-class) - (:documentation "Superclass for all CLSQL-USQL View Classes.")) + (:documentation "Superclass for all CLSQL View Classes.")) (defmethod view-database ((self standard-db-object)) (slot-value self 'view-database)) @@ -102,10 +103,10 @@ #.(locally-enable-sql-reader-syntax) (defun ensure-schema-version-table (database) - (unless (table-exists-p "usql_object_v" :database database) - (create-table [usql_object_v] '(([name] (string 32)) + (unless (table-exists-p "clsql_object_v" :database database) + (create-table [clsql_object_v] '(([name] string) ([vers] integer) - ([def] (string 32))) + ([def] string)) :database database))) (defun update-schema-version-records (view-class-name @@ -117,10 +118,10 @@ slotdef database))) (when res (setf schemadef (cons res schemadef))))) (when schemadef - (delete-records :from [usql_object_v] + (delete-records :from [clsql_object_v] :where [= [name] (sql-escape (class-name tclass))] :database database) - (insert-records :into [usql_object_v] + (insert-records :into [clsql_object_v] :av-pairs `(([name] ,(sql-escape (class-name tclass))) ([vers] ,(car (object-version tclass))) ([def] ,(prin1-to-string @@ -144,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 @@ -171,7 +172,7 @@ which defines that view. The argument DATABASE has a default value of (if tclass (let ((*default-database* database)) (%uninstall-class tclass) - (delete-records :from [usql_object_v] + (delete-records :from [clsql_object_v] :where [= [name] (sql-escape view-class-name)])) (error "Class ~s not found." view-class-name))) (values)) @@ -261,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)))) @@ -296,11 +297,11 @@ 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)) :usql-sys) + (cons (find-symbol (symbol-name (car slot-type)) :clsql-sys) (cdr slot-type)) - (find-symbol (symbol-name slot-type) :usql-sys)))) + (find-symbol (symbol-name slot-type) :clsql-sys)))) (defmethod update-slot-from-db ((instance standard-db-object) slotdef value) (declare (optimize (speed 3) #+cmu (extensions:inhibit-warnings 3))) @@ -528,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.")) @@ -557,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.")) @@ -618,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