update-view-from-class
"Marco Baringer" <[email protected]> Thu, 27 Oct 2005 17:21:33 +0200
| Newsgroups | gmane.lisp.clsql.devel |
|---|---|
| Message-ID | <[email protected]> |
hi,
i got really annoied at having to manually change the db whenever
one of my view classes changed, so i implemented an
update-view-from-class function which attempts to do the Right
Thing(TM).
The docstring:
(defmethod update-view-from-class ((class standard-db-class)
&key (database *default-database*) (transactions t)
(drop-extra-columns t)
(if-does-not-exist :create))
"Update the table correspoding to the clas CLASS.
DATABASE and TRANSACTIONS have the same semantisc as with
CREATE-VIEW-FROM-CLASS. DROP-EXTRA-COLUMNS specifies what to do
with columns which appear in the table but not in the class. When
T we drop these 'extra' columns, when NIL we just leave them.
IF-DOES-NOT-EXIST specifies what to do when the table doesn't
exist:
:CREATE - Create the table using CREATE-VIEW-FROM-CLASS.
:ERROR - Signal an error.
NIL - Do nothing."
...)
In the process i added sql-expressions for alter table add column,
alter table drop column, and alter table column type, these have
corresponding fddl functions add-column, drop-column and
alter-column-type.
patch against clsql-3.3.0 attached.
--
-Marco
Ring the bells that still can ring.
Forget the perfect offering.
There is a crack in everything.
That's how the light gets in.
-Leonard Cohen
_______________________________________________
CLSQL-Devel mailing list
[email protected]
http://lists.b9.com/mailman/listinfo/clsql-devel
clsql.diff
(text/x-patch, 12.2 KB)
diff --exclude='*~' --exclude='*.dfsl' --exclude='*.fasl' -u -r clsql-3.3.0/sql/expressions.lisp clsql/sql/expressions.lisp
--- clsql-3.3.0/sql/expressions.lisp 2005-09-18 02:13:12.000000000 +0200
+++ clsql/sql/expressions.lisp 2005-10-21 14:34:17.000000000 +0200
@@ -810,6 +810,53 @@
(write-string " Type=InnoDB" *sql-stream*))))
t)
+(defclass sql-alter-table (%sql-expression)
+ ((table-name
+ :accessor table-name
+ :initarg :table-name
+ :initform nil)))
+
+(defmethod output-sql :before ((sql sql-alter-table) database)
+ (write-string "ALTER TABLE " *sql-stream*)
+ (output-sql (table-name sql) database)
+ (write-char #\Space *sql-stream*))
+
+(defclass sql-alter-table-add-column (sql-alter-table)
+ ((column-name :accessor column-name :initarg :column-name)
+ (column-type :accessor column-type :initarg :column-type)
+ (default-value :accessor default-value :initarg :default-value)
+ (constraint :accessor constraint :initarg :constraint)))
+
+(defmethod output-sql ((sql sql-alter-table-add-column) database)
+ (write-string "ADD COLUMN " *sql-stream*)
+ (output-sql (column-name sql) database)
+ (write-char #\Space *sql-stream*)
+ (write-string (let ((type (listify (column-type sql))))
+ (database-get-type-specifier (car type) (cdr type) database
+ (database-underlying-type database)))
+ *sql-stream*))
+
+(defclass sql-alter-table-drop-column (sql-alter-table)
+ ((column-name :accessor column-name :initarg :column-name)))
+
+(defmethod output-sql ((sql sql-alter-table-drop-column) database)
+ (write-string "DROP COLUMN " *sql-stream*)
+ (output-sql (column-name sql) database))
+
+(defclass sql-alter-table-column-type (sql-alter-table)
+ ((column-name :accessor column-name :initarg :column-name)
+ (column-type :accessor column-type :initarg :column-type)))
+
+(defmethod output-sql ((sql sql-alter-table-column-type) database)
+ (write-string "ALTER COLUMN " *sql-stream*)
+ (output-sql (column-name sql) database)
+ (write-string " TYPE " *sql-stream*)
+ (write-string (database-get-type-specifier (first (listify (column-type sql)))
+ (rest (listify (column-type sql)))
+ database
+ (database-underlying-type database))
+ *sql-stream*))
+
;; CREATE VIEW
diff --exclude='*~' --exclude='*.dfsl' --exclude='*.fasl' -u -r clsql-3.3.0/sql/fddl.lisp clsql/sql/fddl.lisp
--- clsql-3.3.0/sql/fddl.lisp 2005-09-18 02:13:12.000000000 +0200
+++ clsql/sql/fddl.lisp 2005-10-21 11:40:33.000000000 +0200
@@ -78,6 +78,32 @@
:transactions transactions)))
(execute-command stmt :database database)))
+(defun add-column (table-name column-name column-type
+ &key default-value constraint (database *default-database*))
+ (execute-command
+ (make-instance 'sql-alter-table-add-column
+ :table-name table-name
+ :column-name column-name
+ :column-type column-type
+ :default-value default-value
+ :constraint constraint)
+ :database database))
+
+(defun drop-column (table-name column-name &key (database *default-database*))
+ (execute-command (make-instance 'sql-alter-table-drop-column
+ :table-name table-name
+ :column-name column-name)
+ :database database))
+
+(defun alter-column-type (table-name column-name column-type
+ &key (database *default-database*))
+ (execute-command (make-instance 'sql-alter-table-column-type
+ :table-name table-name
+ :column-name column-name
+ :column-type column-type)
+ :database database))
+
+
(defun drop-table (name &key (if-does-not-exist :error)
(database *default-database*)
(owner nil))
diff --exclude='*~' --exclude='*.dfsl' --exclude='*.fasl' -u -r clsql-3.3.0/sql/ooddl.lisp clsql/sql/ooddl.lisp
--- clsql-3.3.0/sql/ooddl.lisp 2005-09-18 02:13:12.000000000 +0200
+++ clsql/sql/ooddl.lisp 2005-10-23 16:21:45.000000000 +0200
@@ -79,11 +79,9 @@
(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 :transactions transactions))
- (error "Class ~s not found." view-class-name)))
+ (let ((*default-database* database))
+ (%install-class (find-class view-class-name) database :transactions transactions))
+ (error "Class ~s not found." view-class-name)
(values))
(defmethod %install-class ((self standard-db-class) database
@@ -103,6 +101,78 @@
(push self (database-view-classes database)))
t)
+(defmethod update-view-from-class ((class-name symbol) &key (database *default-database*) (transactions t))
+ (update-view-from-class (find-class class-name) :database database :transactions transactions))
+
+(defmethod update-view-from-class ((class standard-db-class)
+ &key (database *default-database*) (transactions t)
+ (drop-extra-columns t)
+ (if-does-not-exist :create))
+ "Update the table correspoding to the clas CLASS.
+
+DATABASE and TRANSACTIONS have the same semantisc as with
+CREATE-VIEW-FROM-CLASS. DROP-EXTRA-COLUMNS specifies what to do
+with columns which appear in the table but not in the class. When
+T we drop these 'extra' columns, when NIL we just leave them.
+
+IF-DOES-NOT-EXIST specifies what to do when the table doesn't
+exist:
+
+ :CREATE - Create the table using CREATE-VIEW-FROM-CLASS.
+ :ERROR - Signal an error.
+ NIL - Do nothing."
+ (if (table-exists-p (view-table class))
+ (update-existing-table class
+ :drop-extra-columns drop-extra-columns
+ :database database)
+ (ecase if-does-not-exist
+ (:create (create-view-from-class (class-name class)
+ :database database
+ :transactions transactions))
+ (:error (error "No existing table to update. Class: ~S; base-table: ~S"
+ class (view-table class)))
+ (nil (values)))))
+
+(defmethod update-existing-table ((class standard-db-class)
+ &key (database *default-database*)
+ (drop-extra-columns t))
+ (let* ((table-name (view-table class))
+ (slots (ordered-class-slots class))
+ (column-defs (mapcar (lambda (slot)
+ (database-generate-column-definition
+ class slot database))
+ slots))
+ (schemadef (remove-if #'null column-defs))
+ (table-columns (list-attribute-types table-name :database database)))
+ ;; for every slot in schemadef we make sure the corresponding
+ ;; table has column of the proper name and type. if it doesn't
+ ;; we add it, if it does we check (and possibly change) the
+ ;; type.
+ (dolist (column-spec schemadef)
+ (destructuring-bind (column-name type db-type &rest constraints)
+ column-spec
+ (declare (ignore db-type constraints))
+ (if (find (database-identifier column-name database) table-columns
+ :key #'car
+ :test #'string=)
+ ;; column already exists
+ (alter-column-type table-name column-name type :database database)
+ ;; a new column
+ ;; FIXME: we completly ignore the contstraints here
+ (add-column table-name column-name type :database database))))
+ (when (eql t drop-extra-columns)
+ ;; look for any columns in the table which aren't defined by
+ ;; the class.
+ (dolist (column table-columns)
+ (let ((column-name (first column)))
+ (unless (find column-name schemadef
+ :key (lambda (column-spec)
+ (database-identifier (car column-spec) database))
+ :test #'string=)
+ ;; COLUMN-NAME is no longer part of CLASS's schemadef
+ (drop-column table-name column-name :database database)))))
+ (values)))
+
(defmethod database-pkey-constraint ((class standard-db-class) database)
(let ((keylist (mapcar #'view-class-slot-column (keyslots-for-class class))))
(when keylist
@@ -112,7 +182,9 @@
(sql-output keylist database))
database))))
-(defmethod database-generate-column-definition (class slotdef database)
+(defmethod database-generate-column-definition ((class standard-db-class)
+ (slotdef view-class-effective-slot-definition)
+ database)
(declare (ignore database class))
(when (member (view-class-slot-db-kind slotdef) '(:base :key))
(let ((cdef
@@ -124,6 +196,10 @@
(setq cdef (append cdef (listify const)))))
cdef)))
+(defmethod database-generate-column-definition ((class symbol)
+ (slotdef view-class-effective-slot-definition)
+ database)
+ (database-generate-column-definition (find-class class) slotdef database))
;;
;; Drop the tables which store the given view class
@@ -219,3 +295,11 @@
(defun keyslots-for-class (class)
(slot-value class 'key-slots))
+
+(defmethod key= ((a standard-db-object) (b standard-db-object))
+ (dolist (slot (keyslots-for-class (class-of a)))
+ (unless
+ (equal (slot-value a (slot-definition-name slot))
+ (slot-value b (slot-definition-name slot)))
+ (return-from key= nil)))
+ t)
diff --exclude='*~' --exclude='*.dfsl' --exclude='*.fasl' -u -r clsql-3.3.0/sql/oodml.lisp clsql/sql/oodml.lisp
--- clsql-3.3.0/sql/oodml.lisp 2005-09-18 02:13:12.000000000 +0200
+++ clsql/sql/oodml.lisp 2005-10-22 18:10:28.000000000 +0200
@@ -1200,3 +1200,7 @@
(dolist (pair (cdr raw))
(setf (slot-value obj (car pair)) (cdr pair)))
obj))))
+
+;;; Determines if two objects have the same keys
+
+()
\ No newline at end of file
diff --exclude='*~' --exclude='*.dfsl' --exclude='*.fasl' -u -r clsql-3.3.0/sql/package.lisp clsql/sql/package.lisp
--- clsql-3.3.0/sql/package.lisp 2005-09-18 02:13:12.000000000 +0200
+++ clsql/sql/package.lisp 2005-10-22 18:07:23.000000000 +0200
@@ -291,7 +291,8 @@
;; FDDL (fddl.lisp)
#:create-table
- #:drop-table
+ #:drop-table
+ #:alter-table
#:list-tables
#:table-exists-p
#:list-attributes
@@ -349,7 +350,8 @@
#:standard-db-object
#:def-view-class
#:create-view-from-class
- #:drop-view-from-class
+ #:drop-view-from-class
+ #:update-view-from-class
#:list-classes
#:universal-time
;; CLSQL Extensions
@@ -377,6 +379,7 @@
#:*db-auto-sync*
#:write-instance-to-stream
#:read-instance-from-stream
+ #:key=
;; Symbolic SQL Syntax (syntax.lisp)
#:sql
diff --exclude='*~' --exclude='*.dfsl' --exclude='*.fasl' -u -r clsql-3.3.0/uffi/Makefile clsql/uffi/Makefile
--- clsql-3.3.0/uffi/Makefile 2005-06-08 22:10:25.000000000 +0200
+++ clsql/uffi/Makefile 2005-10-21 19:41:30.000000000 +0200
@@ -26,9 +26,9 @@
all: $(shared_lib)
$(shared_lib): $(source) Makefile
- BASE=$(base) OBJECT=$(object) SOURCE=$(source) SHARED_LIB=$(shared_lib) LDFLAGS="-lc" sh make.sh
- rm $(object)
+ BASE=$(base) OBJECT=$(object) SOURCE=$(source) SHARED_LIB=$(shared_lib) LDFLAGS="-lc" /bin/sh make.sh
+ /bin/rm $(object)
.PHONY: distclean
distclean: clean
- rm -f $(base).dylib $(base).dylib $(base).so $(base).o
+ /bin/rm -f $(base).dylib $(base).dylib $(base).so $(base).o
Only in clsql/uffi: clsql_uffi.dylib
Only in clsql/uffi: z.dylib