From b89f494d185b0ba98b06175404704cc9d762e321 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Mon, 12 Apr 2004 22:49:35 +0000 Subject: [PATCH] r8989: v 2.6.11 --- ChangeLog | 4 +++- TODO | 3 --- sql/objects.lisp | 31 ++++++++++++++++++++----------- sql/sql.lisp | 4 ++++ 4 files changed, 27 insertions(+), 15 deletions(-) diff --git a/ChangeLog b/ChangeLog index c663a82..b419131 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,7 +1,9 @@ 12 Apr 2004 Kevin Rosenberg (kevin@rosenberg.net) * Version 2.6.11 + * sql/objects.lisp: add :root-class functionality for + list-classes and add duration type support [Marcus Pearce] * db-odbc: Add mid-level [DBI] layer - + 12 Apr 2004 Kevin Rosenberg (kevin@rosenberg.net) * Version 2.6.10 * db-aodbc: Add methods for generic functions, some are diff --git a/TODO b/TODO index 739fe7a..9e3d694 100644 --- a/TODO +++ b/TODO @@ -49,9 +49,6 @@ COMMONSQL SPEC o get :target-slot working o implement :retrieval :immediate - LIST-CLASSES - o keyword arg :root-class should do something (portable) - DO-QUERY,MAP-QUERY,LOOP o should work with object queries as well as functional ones diff --git a/sql/objects.lisp b/sql/objects.lisp index a84bf3b..e1bc241 100644 --- a/sql/objects.lisp +++ b/sql/objects.lisp @@ -113,8 +113,6 @@ the view. The argument DATABASE has a default value of ;; Drop the tables which store the given view class ;; -#.(locally-enable-sql-reader-syntax) - (defun drop-view-from-class (view-class-name &key (database *default-database*)) "Deletes a view or base table from DATABASE based on VIEW-CLASS-NAME which defines that view. The argument DATABASE has a default value of @@ -126,8 +124,6 @@ which defines that view. The argument DATABASE has a default value of (error "Class ~s not found." view-class-name))) (values)) -#.(restore-sql-reader-syntax-state) - (defun %uninstall-class (self &key (database *default-database*)) (drop-table (sql-expression :table (view-table self)) :if-does-not-exist :ignore @@ -141,13 +137,21 @@ which defines that view. The argument DATABASE has a default value of ;; (defun list-classes (&key (test #'identity) - (root-class 'standard-db-object) - (database *default-database*)) - "Returns a list of View Classes connected to a given DATABASE which -defaults to *DEFAULT-DATABASE*." - (declare (ignore root-class)) - (remove-if #'(lambda (c) (not (funcall test c))) - (database-view-classes database))) + (root-class (find-class 'standard-db-object)) + (database *default-database*)) + "The LIST-CLASSES function collects all the classes below +ROOT-CLASS, which defaults to standard-db-object, that are connected +to the supplied DATABASE and which satisfy the TEST function. The +default for the TEST argument is identity. By default, LIST-CLASSES +returns a list of all the classes connected to the default database, +*DEFAULT-DATABASE*." + (flet ((find-superclass (class) + (member root-class (class-precedence-list class)))) + (let ((view-classes (and database (database-view-classes database)))) + (when view-classes + (remove-if #'(lambda (c) (or (not (funcall test c)) + (not (find-superclass c)))) + view-classes))))) ;; ;; Define a new view class @@ -727,6 +731,11 @@ DATABASE-NULL-VALUE on the type of the slot.")) (unless (eq 'NULL val) (parse-timestring val))) +(defmethod read-sql-value (val (type (eql 'duration)) database) + (declare (ignore database)) + (unless (or (eq 'NULL val) + (equal "NIL" val)) + (parse-timestring val))) ;; ------------------------------------------------------------ ;; Logic for 'faulting in' :join slots diff --git a/sql/sql.lisp b/sql/sql.lisp index 8cf7758..8227fea 100644 --- a/sql/sql.lisp +++ b/sql/sql.lisp @@ -217,6 +217,10 @@ condition is true." (declare (ignore database)) (db-timestring self)) +(defmethod database-output-sql ((self duration) database) + (declare (ignore database)) + (format nil "'~a'" (duration-timestring self))) + (defmethod database-output-sql (thing database) (if (or (null thing) (eq 'null thing)) -- 2.34.1