+(defvar *cache-table-queries-default* "Default atribute type caching behavior.")
+
+(defun cache-table-queries (table &key (action nil) (database *default-database*))
+ "Provides per-table control on the caching in a particular database
+connection of attribute type information using during update
+operations. If TABLE is a string, it is the name of the table for
+which caching is to be altered. If TABLE is t, then the action applies
+to all tables. If TABLE is :default, then the default caching action
+is set for those tables which do not have an explicit setting. ACTION
+specifies the caching action. The value t means cache the attribute
+type information. The value nil means do not cache the attribute type
+information. If TABLE is :default, the setting applies to all tables
+which do not have an explicit setup. The value :flush means remove any
+existing cache for table in database, but continue to cache. This
+function should be called with action :flush when the attribute
+specifications in table have changed."
+ (with-slots (attribute-cache) database
+ (cond
+ ((stringp table)
+ (multiple-value-bind (val found) (gethash table attribute-cache)
+ (cond
+ ((and found (eq action :flush))
+ (setf (gethash table attribute-cache) (list t nil)))
+ ((and found (eq action t))
+ (setf (gethash table attribute-cache) (list t (second val))))
+ ((and found (null action))
+ (setf (gethash table attribute-cache) (list nil nil)))
+ ((not found)
+ (setf (gethash table attribute-cache) (list action nil))))))
+ ((eq table t)
+ (maphash (lambda (k v)
+ (cond
+ ((eq action :flush)
+ (setf (gethash k attribute-cache) (list t nil)))
+ ((null action)
+ (setf (gethash k attribute-cache) (list nil nil)))
+ ((eq t action)
+ (setf (gethash k attribute-cache) (list t (second v))))))
+ attribute-cache))
+ ((eq table :default)
+ (maphash (lambda (k v)
+ (when (eq (first v) :unspecified)
+ (cond
+ ((eq action :flush)
+ (setf (gethash k attribute-cache) (list t nil)))
+ ((null action)
+ (setf (gethash k attribute-cache) (list nil nil)))
+ ((eq t action)
+ (setf (gethash k attribute-cache) (list t (second v)))))))
+ attribute-cache))))
+ (values))
+
+