r10546: 18 May 2005 Kevin Rosenberg <kevin@rosenberg.net>
[clsql.git] / sql / recording.lisp
1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;;
4 ;;;; $Id$
5 ;;;;
6 ;;;; CLSQL broadcast streams which can be used to monitor the
7 ;;;; flow of commands to, and results from, a database.
8 ;;;;
9 ;;;; This file is part of CLSQL.
10 ;;;;
11 ;;;; CLSQL users are granted the rights to distribute and use this software
12 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
13 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
14 ;;;; *************************************************************************
15
16 (in-package #:clsql-sys)
17
18 (defun start-sql-recording (&key (type :commands) (database *default-database*))
19   "Starts recording of SQL commands sent to and/or results
20 returned from DATABASE which defaults to *DEFAULT-DATABASE*. The
21 SQL is output on one or more broadcast streams, initially just
22 *STANDARD-OUTPUT*, and the functions ADD-SQL-STREAM and
23 DELETE-SQL-STREAM may be used to add or delete command or result
24 recording streams. The default value of TYPE is :commands which
25 means that SQL commands sent to DATABASE are recorded. If TYPE
26 is :results then SQL results returned from DATABASE are
27 recorded. Both commands and results may be recorded by passing
28 TYPE value of :both."
29   (when (or (eq type :both) (eq type :commands))
30     (setf (command-recording-stream database)
31           (make-broadcast-stream *standard-output*)))
32   (when (or (eq type :both) (eq type :results))
33     (setf (result-recording-stream database)
34           (make-broadcast-stream *standard-output*)))
35   (values))
36
37 (defun stop-sql-recording (&key (type :commands) (database *default-database*))
38   "Stops recording of SQL commands sent to and/or results
39 returned from DATABASE which defaults to *DEFAULT-DATABASE*. The
40 default value of TYPE is :commands which means that SQL commands
41 sent to DATABASE will no longer be recorded. If TYPE is :results
42 then SQL results returned from DATABASE will no longer be
43 recorded. Recording may be stopped for both commands and results
44 by passing TYPE value of :both."
45   (when (or (eq type :both) (eq type :commands))
46     (setf (command-recording-stream database) nil))
47   (when (or (eq type :both) (eq type :results))
48     (setf (result-recording-stream database) nil))
49   (values))
50
51 (defun sql-recording-p (&key (type :commands) (database *default-database*))
52   "Predicate to test whether the SQL recording specified by TYPE
53 is currently enabled for DATABASE which defaults to *DEFAULT-DATABASE*.  
54 TYPE may be one of :commands, :results, :both or :either, defaulting to
55 :commands, otherwise nil is returned."
56   (when (or (and (eq type :commands)
57                  (command-recording-stream database))
58             (and (eq type :results)
59                  (result-recording-stream database))
60             (and (eq type :both)
61                  (result-recording-stream database)
62                  (command-recording-stream database))
63             (and (eq type :either)
64                  (or (result-recording-stream database)
65                      (command-recording-stream database))))
66     t))
67
68 (defun add-sql-stream (stream &key (type :commands)
69                               (database *default-database*))
70   "Adds the supplied stream STREAM (or T for *standard-output*)
71 as a component of the recording broadcast stream for the SQL
72 recording type specified by TYPE on DATABASE which defaults to
73 *DEFAULT-DATABASE*. TYPE must be one of :commands, :results,
74 or :both, defaulting to :commands, depending on whether the
75 stream is to be added for recording SQL commands, results or
76 both."
77   (when (or (eq type :both) (eq type :commands))
78     (unless (member stream
79                     (list-sql-streams :type :commands :database database))
80       (setf (command-recording-stream database)
81             (apply #'make-broadcast-stream
82                    (cons stream (list-sql-streams :type :commands
83                                                   :database database))))))
84   (when (or (eq type :both) (eq type :results))
85     (unless (member stream (list-sql-streams :type :results :database database))
86       (setf (result-recording-stream database)
87             (apply #'make-broadcast-stream
88                    (cons stream (list-sql-streams :type :results
89                                                   :database database))))))
90   stream)
91                               
92 (defun delete-sql-stream (stream &key (type :commands)
93                                  (database *default-database*))
94  "Removes the supplied stream STREAM from the recording broadcast
95 stream for the SQL recording type specified by TYPE on DATABASE
96 which defaults to *DEFAULT-DATABASE*. TYPE must be one
97 of :commands, :results, or :both, defaulting to :commands,
98 depending on whether the stream is to be added for recording SQL
99 commands, results or both."
100   (when (or (eq type :both) (eq type :commands))
101     (setf (command-recording-stream database)
102           (apply #'make-broadcast-stream
103                  (remove stream (list-sql-streams :type :commands
104                                                   :database database)))))
105   (when (or (eq type :both) (eq type :results))
106     (setf (result-recording-stream database)
107           (apply #'make-broadcast-stream
108                  (remove stream (list-sql-streams :type :results
109                                                   :database database)))))
110   stream)
111
112 (defun list-sql-streams (&key (type :commands) (database *default-database*))
113   "Returns the list of component streams for the broadcast stream
114 recording SQL commands sent to and/or results returned from
115 DATABASE which defaults to *DEFAULT-DATABASE*. TYPE must be one
116 of :commands, :results, or :both, defaulting to :commands, and
117 determines whether the listed streams contain those recording SQL
118 commands, results or both."
119   (let ((crs (command-recording-stream database))
120         (rrs (result-recording-stream database)))
121     (cond
122       ((eq type :commands)
123        (when crs (broadcast-stream-streams crs)))
124       ((eq type :results)
125        (when rrs (broadcast-stream-streams rrs)))
126       ((eq type :both)
127        (append (when crs (broadcast-stream-streams crs))
128                (when rrs (broadcast-stream-streams rrs))))
129       (t
130        (error "Unknown recording type. ~A" type)))))
131
132 (defun sql-stream (&key (type :commands) (database *default-database*))
133   "Returns the broadcast stream used for recording SQL commands
134 sent to or results returned from DATABASE which defaults to
135 *DEFAULT-DATABASE*. TYPE must be one of :commands or :results,
136 defaulting to :commands, and determines whether the stream
137 returned is that used for recording SQL commands or results."
138   (cond
139     ((eq type :commands)
140      (command-recording-stream database))
141     ((eq type :results)
142      (result-recording-stream database))
143     (t
144      (error "Unknown recording type. ~A" type))))
145   
146 (defun record-sql-command (expr database)
147   (when database
148     (with-slots (command-recording-stream)
149         database
150       (when command-recording-stream 
151         (format command-recording-stream "~&;; ~A ~A => ~A~%"
152                 (iso-timestring (get-time))
153                 (database-name database)
154                 expr)))))
155
156 (defun record-sql-result (res database)
157   (when database
158     (with-slots (result-recording-stream)
159         database
160       (when result-recording-stream 
161         (format result-recording-stream "~&;; ~A ~A <= ~A~%"
162                 (iso-timestring (get-time))
163                 (database-name database)
164                 res)))))
165
166   
167