Merge branch 'master' of git://git.b9.com/clsql
[clsql/s11.git] / sql / recording.lisp
blob4d0810af00a4f09e57a3de03d87146631d798494
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 ;;;; *************************************************************************
16 (in-package #:clsql-sys)
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))
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))
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))
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)
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)
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))))
130 (error "Unknown recording type. ~A" type)))))
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))
144 (error "Unknown recording type. ~A" type))))
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)))))
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)))))