1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; ======================================================================
5 ;;;; Description ==========================================================
6 ;;;; ======================================================================
8 ;;;; CLSQL-USQL broadcast streams which can be used to monitor the
9 ;;;; flow of commands to, and results from, a database.
11 ;;;; ======================================================================
13 (in-package #:clsql-base-sys)
15 (defun start-sql-recording (&key (type :commands) (database *default-database*))
16 "Begin recording SQL command or result traffic. By default the
17 broadcast stream is just *STANDARD-OUTPUT* but this can be modified
18 using ADD-SQL-STREAM or DELETE-SQL-STREAM. TYPE determines whether SQL
19 command or result traffic is recorded, or both. It must be either
20 :commands, :results or :both, and defaults to :commands. DATABASE
21 defaults to *default-database*."
22 (when (or (eq type :both) (eq type :commands))
23 (setf (command-recording-stream database)
24 (make-broadcast-stream *standard-output*)))
25 (when (or (eq type :both) (eq type :results))
26 (setf (result-recording-stream database)
27 (make-broadcast-stream *standard-output*)))
30 (defun stop-sql-recording (&key (type :commands) (database *default-database*))
31 "Stops recording of SQL command or result traffic. TYPE determines
32 whether to stop SQL command or result traffic, or both. It must be
33 either :commands, :results or :both, defaulting to :commands. DATABASE
34 defaults to *default-database*."
35 (when (or (eq type :both) (eq type :commands))
36 (setf (command-recording-stream database) nil))
37 (when (or (eq type :both) (eq type :results))
38 (setf (result-recording-stream database) nil))
41 (defun sql-recording-p (&key (type :commands) (database *default-database*))
42 "Returns t if recording of TYPE of SQL interaction specified is
43 enabled. TYPE must be either :commands, :results, :both or :either.
44 DATABASE defaults to *default-database*."
45 (when (or (and (eq type :commands)
46 (command-recording-stream database))
47 (and (eq type :results)
48 (result-recording-stream database))
50 (result-recording-stream database)
51 (command-recording-stream database))
52 (and (eq type :either)
53 (or (result-recording-stream database)
54 (command-recording-stream database))))
57 (defun add-sql-stream (stream &key (type :commands)
58 (database *default-database*))
59 "Add the given STREAM as a component stream for the recording
60 broadcast stream for the given SQL interaction TYPE. TYPE must be
61 either :commands, :results, or :both, defaulting to :commands.
62 DATABASE defaults to *default-database*."
63 (when (or (eq type :both) (eq type :commands))
64 (unless (member stream
65 (list-sql-streams :type :commands :database database))
66 (setf (command-recording-stream database)
67 (apply #'make-broadcast-stream
68 (cons stream (list-sql-streams :type :commands
69 :database database))))))
70 (when (or (eq type :both) (eq type :results))
71 (unless (member stream (list-sql-streams :type :results :database database))
72 (setf (result-recording-stream database)
73 (apply #'make-broadcast-stream
74 (cons stream (list-sql-streams :type :results
75 :database database))))))
78 (defun delete-sql-stream (stream &key (type :commands)
79 (database *default-database*))
80 "Removes the given STREAM from the recording broadcast stream for
81 the given TYPE of SQL interaction. TYPE must be either :commands,
82 :results, or :both, defaulting to :commands. DATABASE defaults to
84 (when (or (eq type :both) (eq type :commands))
85 (setf (command-recording-stream database)
86 (apply #'make-broadcast-stream
87 (remove stream (list-sql-streams :type :commands
88 :database database)))))
89 (when (or (eq type :both) (eq type :results))
90 (setf (result-recording-stream database)
91 (apply #'make-broadcast-stream
92 (remove stream (list-sql-streams :type :results
93 :database database)))))
96 (defun list-sql-streams (&key (type :commands) (database *default-database*))
97 "Returns the set of streams which the recording broadcast stream
98 send SQL interactions of the given TYPE sends data. TYPE must be
99 either :commands, :results, or :both, defaulting to :commands.
100 DATABASE defaults to *default-database*."
101 (let ((crs (command-recording-stream database))
102 (rrs (result-recording-stream database)))
105 (when crs (broadcast-stream-streams crs)))
107 (when rrs (broadcast-stream-streams rrs)))
109 (append (when crs (broadcast-stream-streams crs))
110 (when rrs (broadcast-stream-streams rrs))))
112 (error "Unknown recording type. ~A" type)))))
114 (defun sql-stream (&key (type :commands) (database *default-database*))
115 "Returns the broadcast streams used for recording SQL commands or
116 results traffic. TYPE must be either :commands or :results defaulting
117 to :commands while DATABASE defaults to *default-database*."
120 (command-recording-stream database))
122 (result-recording-stream database))
124 (error "Unknown recording type. ~A" type))))
126 (defun record-sql-command (expr database)
128 (with-slots (command-recording-stream)
130 (if command-recording-stream
131 (format command-recording-stream "~&;; ~A ~A => ~A~%"
132 (iso-timestring (get-time))
133 (database-name database)
136 (defun record-sql-result (res database)
138 (with-slots (result-recording-stream)
140 (if result-recording-stream
141 (format result-recording-stream "~&;; ~A ~A <= ~A~%"
142 (iso-timestring (get-time))
143 (database-name database)