From: Kevin M. Rosenberg Date: Thu, 24 Jun 2004 08:00:53 +0000 (+0000) Subject: r9678: 23 Jun 2004 Kevin Rosenberg X-Git-Tag: v3.8.6~306 X-Git-Url: http://git.kpe.io/?p=clsql.git;a=commitdiff_plain;h=39ee7191fd3087c2d7e149b33dd3e985db021721 r9678: 23 Jun 2004 Kevin Rosenberg * sql/oodml.lisp: Add keyword :transactions to def-view-from-class to allow specifying transactionless table creation * doc/ref-oodml.lisp: Add new keyword to signature of DEF-VIEW-FROM-CLASS --- diff --git a/ChangeLog b/ChangeLog index efb0ac7..ff355b2 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +23 Jun 2004 Kevin Rosenberg + * sql/oodml.lisp: Add keyword :transactions to def-view-from-class + to allow specifying transactionless table creation + * doc/ref-oodml.lisp: Add new keyword to signature of + DEF-VIEW-FROM-CLASS + 18 Jun 2004 Marcus Pearce * Version 2.11.11 * sql/expressions.lisp: when removing duplicate table identifiers diff --git a/doc/ref-ooddl.xml b/doc/ref-ooddl.xml index 568cb1a..ebe7de1 100644 --- a/doc/ref-ooddl.xml +++ b/doc/ref-ooddl.xml @@ -97,7 +97,7 @@ Syntax - (CREATE-VIEW-FROM-CLASS VIEW-CLASS-NAME &KEY (DATABASE *DEFAULT-DATABASE*)) [function] => + (CREATE-VIEW-FROM-CLASS VIEW-CLASS-NAME &KEY (DATABASE *DEFAULT-DATABASE*) (TRANSACTIONS T)) [function] => Arguments and Values diff --git a/sql/generics.lisp b/sql/generics.lisp index 9ff6492..5bc74ca 100644 --- a/sql/generics.lisp +++ b/sql/generics.lisp @@ -139,7 +139,7 @@ DATABASE-NULL-VALUE on the type of the slot.")) ) (defgeneric database-constraint-statement (constraints database) ) -(defgeneric %install-class (class database) +(defgeneric %install-class (class database &key transactions) ) (defgeneric database-generate-column-definition (class slotdef database) ) diff --git a/sql/ooddl.lisp b/sql/ooddl.lisp index c5e9d88..64d974a 100644 --- a/sql/ooddl.lisp +++ b/sql/ooddl.lisp @@ -72,28 +72,32 @@ ;; (defun create-view-from-class (view-class-name - &key (database *default-database*)) + &key (database *default-database*) + (transactions t)) "Creates a table as defined by the View Class VIEW-CLASS-NAME in DATABASE which defaults to *DEFAULT-DATABASE*." (let ((tclass (find-class view-class-name))) (if tclass (let ((*default-database* database)) - (%install-class tclass database)) + (%install-class tclass database :transactions transactions)) (error "Class ~s not found." view-class-name))) (values)) -(defmethod %install-class ((self standard-db-class) database &aux schemadef) - (dolist (slotdef (ordered-class-slots self)) - (let ((res (database-generate-column-definition (class-name self) - slotdef database))) - (when res - (push res schemadef)))) - (unless schemadef - (error "Class ~s has no :base slots" self)) - (create-table (sql-expression :table (view-table self)) (nreverse schemadef) - :database database - :constraints (database-pkey-constraint self database)) - (push self (database-view-classes database)) +(defmethod %install-class ((self standard-db-class) database + &key (transactions t)) + (let ((schemadef '())) + (dolist (slotdef (ordered-class-slots self)) + (let ((res (database-generate-column-definition (class-name self) + slotdef database))) + (when res + (push res schemadef)))) + (unless schemadef + (error "Class ~s has no :base slots" self)) + (create-table (sql-expression :table (view-table self)) (nreverse schemadef) + :database database + :transactions transactions + :constraints (database-pkey-constraint self database)) + (push self (database-view-classes database))) t) (defmethod database-pkey-constraint ((class standard-db-class) database)