From: Kevin M. Rosenberg Date: Mon, 10 May 2004 20:49:31 +0000 (+0000) Subject: r9308: * sql/recording.lisp: Remove additional types to X-Git-Tag: v3.8.6~483 X-Git-Url: http://git.kpe.io/?p=clsql.git;a=commitdiff_plain;h=3a18cef462f8fb90652450128cd3dff5f7feaf7f r9308: * sql/recording.lisp: Remove additional types to increase CommonSQL conformance. --- diff --git a/base/recording.lisp b/base/recording.lisp index fb9fc8d..85620f7 100644 --- a/base/recording.lisp +++ b/base/recording.lisp @@ -20,160 +20,131 @@ broadcast stream is just *STANDARD-OUTPUT* but this can be modified using ADD-SQL-STREAM or DELETE-SQL-STREAM. TYPE determines whether SQL command or result traffic is recorded, or both. It must be either -:commands, :results, :query, :both, or :all, and defaults to -:commands. DATABASE defaults to *default-database*." - (when (in type :all :both :commands) +:commands, :results or :both, and defaults to :commands. DATABASE +defaults to *default-database*." + (when (or (eq type :both) (eq type :commands)) (setf (command-recording-stream database) (make-broadcast-stream *standard-output*))) - (when (in type :all :both :results) + (when (or (eq type :both) (eq type :results)) (setf (result-recording-stream database) (make-broadcast-stream *standard-output*))) - (when (in type :all :query) - (setf (query-recording-stream database) - (make-broadcast-stream - *standard-output*))) (values)) (defun stop-sql-recording (&key (type :commands) (database *default-database*)) "Stops recording of SQL command or result traffic. TYPE determines whether to stop SQL command or result traffic, or both. It must be -either :commands, :results, :both, or :all, defaulting to :commands. DATABASE +either :commands, :results or :both, defaulting to :commands. DATABASE defaults to *default-database*." - (when (in type :all :both :commands) + (when (or (eq type :both) (eq type :commands)) (setf (command-recording-stream database) nil)) - (when (in type :all :both :results) + (when (or (eq type :both) (eq type :results)) (setf (result-recording-stream database) nil)) - (when (in type :all :query) - (setf (query-recording-stream database) nil)) (values)) (defun sql-recording-p (&key (type :commands) (database *default-database*)) "Returns t if recording of TYPE of SQL interaction specified is -enabled. TYPE must be either :commands, :results, :query, :all, -:both, :either, or :any. DATABASE defaults to *default-database*." +enabled. TYPE must be either :commands, :results, :both or :either. +DATABASE defaults to *default-database*." (when (or (and (eq type :commands) (command-recording-stream database)) (and (eq type :results) (result-recording-stream database)) - (and (eq type :all) - (result-recording-stream database) - (query-recording-stream database) - (command-recording-stream database)) (and (eq type :both) (result-recording-stream database) (command-recording-stream database)) (and (eq type :either) (or (result-recording-stream database) - (command-recording-stream database))) - (and (eq type :any) - (or (result-recording-stream database) - (command-recording-stream database) - (query-recording-stream database)))) + (command-recording-stream database)))) t)) (defun add-sql-stream (stream &key (type :commands) (database *default-database*)) "Add the given STREAM as a component stream for the recording broadcast stream for the given SQL interaction TYPE. TYPE must be -either :commands, :results, :query, :all, or :both, defaulting to -:commands. DATABASE defaults to *default-database*." - (when (in type :all :both :commands) +either :commands, :results, or :both, defaulting to :commands. +DATABASE defaults to *default-database*." + (when (or (eq type :both) (eq type :commands)) (unless (member stream (list-sql-streams :type :commands :database database)) (setf (command-recording-stream database) (apply #'make-broadcast-stream (cons stream (list-sql-streams :type :commands :database database)))))) - (when (in type :all :both :results) + (when (or (eq type :both) (eq type :results)) (unless (member stream (list-sql-streams :type :results :database database)) (setf (result-recording-stream database) (apply #'make-broadcast-stream (cons stream (list-sql-streams :type :results :database database)))))) - (when (in type :all :query) - (unless (member stream (list-sql-streams :type :query :database database)) - (setf (query-recording-stream database) - (apply #'make-broadcast-stream - (cons stream (list-sql-streams :type :query - :database database)))))) stream) (defun delete-sql-stream (stream &key (type :commands) (database *default-database*)) "Removes the given STREAM from the recording broadcast stream for the given TYPE of SQL interaction. TYPE must be either :commands, -:results, :query, :both, or :all, defaulting to :commands. DATABASE -defaults to *default-database*." - (when (in type :all :both :commands) +:results, or :both, defaulting to :commands. DATABASE defaults to +*default-database*." + (when (or (eq type :both) (eq type :commands)) (setf (command-recording-stream database) (apply #'make-broadcast-stream (remove stream (list-sql-streams :type :commands :database database))))) - (when (in type :all :both :results) + (when (or (eq type :both) (eq type :results)) (setf (result-recording-stream database) (apply #'make-broadcast-stream (remove stream (list-sql-streams :type :results :database database))))) - (when (in type :all :query) - (setf (query-recording-stream database) - (apply #'make-broadcast-stream - (remove stream (list-sql-streams :type :commands - :database database))))) stream) (defun list-sql-streams (&key (type :commands) (database *default-database*)) "Returns the set of streams which the recording broadcast stream send SQL interactions of the given TYPE sends data. TYPE must be -either :commands, :results, :query, :both, or :all, defaulting to :commands. +either :commands, :results, or :both, defaulting to :commands. DATABASE defaults to *default-database*." (let ((crs (command-recording-stream database)) - (qrs (query-recording-stream database)) (rrs (result-recording-stream database))) (cond ((eq type :commands) (when crs (broadcast-stream-streams crs))) ((eq type :results) (when rrs (broadcast-stream-streams rrs))) - ((eq type :query) - (when qrs (broadcast-stream-streams qrs))) ((eq type :both) (append (when crs (broadcast-stream-streams crs)) (when rrs (broadcast-stream-streams rrs)))) - ((eq type :all) - (append (when crs (broadcast-stream-streams crs)) - (when rrs (broadcast-stream-streams rrs)) - (when qrs (broadcast-stream-streams qrs)))) (t (error "Unknown recording type. ~A" type))))) (defun sql-stream (&key (type :commands) (database *default-database*)) "Returns the broadcast streams used for recording SQL commands or -results traffic. TYPE must be either :commands, :query, or :results defaulting +results traffic. TYPE must be either :commands or :results defaulting to :commands while DATABASE defaults to *default-database*." (cond ((eq type :commands) (command-recording-stream database)) ((eq type :results) (result-recording-stream database)) - ((eq type :query) - (query-recording-stream database)) (t (error "Unknown recording type. ~A" type)))) -(defun record-sql-action (expr type database) - (unless database - (return-from record-sql-action)) - (with-slots (command-recording-stream - query-recording-stream - result-recording-stream) - database - (let ((stream - (ecase type - (:command command-recording-stream) - (:query query-recording-stream) - (:result result-recording-stream)))) - (when stream - (format stream ";; ~A ~A => ~A~%" - (iso-timestring (get-time)) - (database-name database) - expr))))) +(defun record-sql-command (expr database) + (if database + (with-slots (command-recording-stream) + database + (if command-recording-stream + (format command-recording-stream "~&;; ~A ~A => ~A~%" + (iso-timestring (get-time)) + (database-name database) + expr))))) + +(defun record-sql-result (res database) + (if database + (with-slots (result-recording-stream) + database + (if result-recording-stream + (format result-recording-stream "~&;; ~A ~A <= ~A~%" + (iso-timestring (get-time)) + (database-name database) + res))))) + + +