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