1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
6 ;;;; CLSQL broadcast streams which can be used to monitor the
7 ;;;; flow of commands to, and results from, a database.
9 ;;;; This file is part of CLSQL.
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-base-sys)
18 (defun start-sql-recording (&key (type :commands) (database *default-database*))
19 "Begin recording SQL command or result traffic. By default the
20 broadcast stream is just *STANDARD-OUTPUT* but this can be modified
21 using ADD-SQL-STREAM or DELETE-SQL-STREAM. TYPE determines whether SQL
22 command or result traffic is recorded, or both. It must be either
23 :commands, :results, :query, :both, or :all, and defaults to
24 :commands. DATABASE defaults to *default-database*."
25 (when (in type :all :both :commands)
26 (setf (command-recording-stream database)
27 (make-broadcast-stream *standard-output*)))
28 (when (in type :all :both :results)
29 (setf (result-recording-stream database)
30 (make-broadcast-stream *standard-output*)))
31 (when (in type :all :query)
32 (setf (query-recording-stream database)
33 (make-broadcast-stream
37 (defun stop-sql-recording (&key (type :commands) (database *default-database*))
38 "Stops recording of SQL command or result traffic. TYPE determines
39 whether to stop SQL command or result traffic, or both. It must be
40 either :commands, :results, :both, or :all, defaulting to :commands. DATABASE
41 defaults to *default-database*."
42 (when (in type :all :both :commands)
43 (setf (command-recording-stream database) nil))
44 (when (in type :all :both :results)
45 (setf (result-recording-stream database) nil))
46 (when (in type :all :query)
47 (setf (query-recording-stream database) nil))
50 (defun sql-recording-p (&key (type :commands) (database *default-database*))
51 "Returns t if recording of TYPE of SQL interaction specified is
52 enabled. TYPE must be either :commands, :results, :query, :all,
53 :both, :either, or :any. DATABASE defaults to *default-database*."
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 (query-recording-stream database)
61 (command-recording-stream database))
63 (result-recording-stream database)
64 (command-recording-stream database))
65 (and (eq type :either)
66 (or (result-recording-stream database)
67 (command-recording-stream database)))
69 (or (result-recording-stream database)
70 (command-recording-stream database)
71 (query-recording-stream database))))
74 (defun add-sql-stream (stream &key (type :commands)
75 (database *default-database*))
76 "Add the given STREAM as a component stream for the recording
77 broadcast stream for the given SQL interaction TYPE. TYPE must be
78 either :commands, :results, :query, :all, or :both, defaulting to
79 :commands. DATABASE defaults to *default-database*."
80 (when (in type :all :both :commands)
81 (unless (member stream
82 (list-sql-streams :type :commands :database database))
83 (setf (command-recording-stream database)
84 (apply #'make-broadcast-stream
85 (cons stream (list-sql-streams :type :commands
86 :database database))))))
87 (when (in type :all :both :results)
88 (unless (member stream (list-sql-streams :type :results :database database))
89 (setf (result-recording-stream database)
90 (apply #'make-broadcast-stream
91 (cons stream (list-sql-streams :type :results
92 :database database))))))
93 (when (in type :all :query)
94 (unless (member stream (list-sql-streams :type :query :database database))
95 (setf (query-recording-stream database)
96 (apply #'make-broadcast-stream
97 (cons stream (list-sql-streams :type :query
98 :database database))))))
101 (defun delete-sql-stream (stream &key (type :commands)
102 (database *default-database*))
103 "Removes the given STREAM from the recording broadcast stream for
104 the given TYPE of SQL interaction. TYPE must be either :commands,
105 :results, :query, :both, or :all, defaulting to :commands. DATABASE
106 defaults to *default-database*."
107 (when (in type :all :both :commands)
108 (setf (command-recording-stream database)
109 (apply #'make-broadcast-stream
110 (remove stream (list-sql-streams :type :commands
111 :database database)))))
112 (when (in type :all :both :results)
113 (setf (result-recording-stream database)
114 (apply #'make-broadcast-stream
115 (remove stream (list-sql-streams :type :results
116 :database database)))))
117 (when (in type :all :query)
118 (setf (query-recording-stream database)
119 (apply #'make-broadcast-stream
120 (remove stream (list-sql-streams :type :commands
121 :database database)))))
124 (defun list-sql-streams (&key (type :commands) (database *default-database*))
125 "Returns the set of streams which the recording broadcast stream
126 send SQL interactions of the given TYPE sends data. TYPE must be
127 either :commands, :results, :query, :both, or :all, defaulting to :commands.
128 DATABASE defaults to *default-database*."
129 (let ((crs (command-recording-stream database))
130 (qrs (query-recording-stream database))
131 (rrs (result-recording-stream database)))
134 (when crs (broadcast-stream-streams crs)))
136 (when rrs (broadcast-stream-streams rrs)))
138 (when qrs (broadcast-stream-streams qrs)))
140 (append (when crs (broadcast-stream-streams crs))
141 (when rrs (broadcast-stream-streams rrs))))
143 (append (when crs (broadcast-stream-streams crs))
144 (when rrs (broadcast-stream-streams rrs))
145 (when qrs (broadcast-stream-streams qrs))))
147 (error "Unknown recording type. ~A" type)))))
149 (defun sql-stream (&key (type :commands) (database *default-database*))
150 "Returns the broadcast streams used for recording SQL commands or
151 results traffic. TYPE must be either :commands, :query, or :results defaulting
152 to :commands while DATABASE defaults to *default-database*."
155 (command-recording-stream database))
157 (result-recording-stream database))
159 (query-recording-stream database))
161 (error "Unknown recording type. ~A" type))))
163 (defun record-sql-action (expr type database)
165 (return-from record-sql-action))
166 (with-slots (command-recording-stream
167 query-recording-stream
168 result-recording-stream)
172 (:command command-recording-stream)
173 (:query query-recording-stream)
174 (:result result-recording-stream))))
176 (format stream ";; ~A ~A => ~A~%"
177 (iso-timestring (get-time))
178 (database-name database)