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