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-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 or :both, and defaults to :commands. DATABASE
24 defaults to *default-database*."
25 (when (or (eq type :both) (eq type :commands))
26 (setf (command-recording-stream database)
27 (make-broadcast-stream *standard-output*)))
28 (when (or (eq type :both) (eq type :results))
29 (setf (result-recording-stream database)
30 (make-broadcast-stream *standard-output*)))
33 (defun stop-sql-recording (&key (type :commands) (database *default-database*))
34 "Stops recording of SQL command or result traffic. TYPE determines
35 whether to stop SQL command or result traffic, or both. It must be
36 either :commands, :results or :both, defaulting to :commands. DATABASE
37 defaults to *default-database*."
38 (when (or (eq type :both) (eq type :commands))
39 (setf (command-recording-stream database) nil))
40 (when (or (eq type :both) (eq type :results))
41 (setf (result-recording-stream database) nil))
44 (defun sql-recording-p (&key (type :commands) (database *default-database*))
45 "Returns t if recording of TYPE of SQL interaction specified is
46 enabled. TYPE must be either :commands, :results, :both or :either.
47 DATABASE defaults to *default-database*."
48 (when (or (and (eq type :commands)
49 (command-recording-stream database))
50 (and (eq type :results)
51 (result-recording-stream database))
53 (result-recording-stream database)
54 (command-recording-stream database))
55 (and (eq type :either)
56 (or (result-recording-stream database)
57 (command-recording-stream database))))
60 (defun add-sql-stream (stream &key (type :commands)
61 (database *default-database*))
62 "Add the given STREAM as a component stream for the recording
63 broadcast stream for the given SQL interaction TYPE. TYPE must be
64 either :commands, :results, or :both, defaulting to :commands.
65 DATABASE defaults to *default-database*."
66 (when (or (eq type :both) (eq type :commands))
67 (unless (member stream
68 (list-sql-streams :type :commands :database database))
69 (setf (command-recording-stream database)
70 (apply #'make-broadcast-stream
71 (cons stream (list-sql-streams :type :commands
72 :database database))))))
73 (when (or (eq type :both) (eq type :results))
74 (unless (member stream (list-sql-streams :type :results :database database))
75 (setf (result-recording-stream database)
76 (apply #'make-broadcast-stream
77 (cons stream (list-sql-streams :type :results
78 :database database))))))
81 (defun delete-sql-stream (stream &key (type :commands)
82 (database *default-database*))
83 "Removes the given STREAM from the recording broadcast stream for
84 the given TYPE of SQL interaction. TYPE must be either :commands,
85 :results, or :both, defaulting to :commands. DATABASE defaults to
87 (when (or (eq type :both) (eq type :commands))
88 (setf (command-recording-stream database)
89 (apply #'make-broadcast-stream
90 (remove stream (list-sql-streams :type :commands
91 :database database)))))
92 (when (or (eq type :both) (eq type :results))
93 (setf (result-recording-stream database)
94 (apply #'make-broadcast-stream
95 (remove stream (list-sql-streams :type :results
96 :database database)))))
99 (defun list-sql-streams (&key (type :commands) (database *default-database*))
100 "Returns the set of streams which the recording broadcast stream
101 send SQL interactions of the given TYPE sends data. TYPE must be
102 either :commands, :results, or :both, defaulting to :commands.
103 DATABASE defaults to *default-database*."
104 (let ((crs (command-recording-stream database))
105 (rrs (result-recording-stream database)))
108 (when crs (broadcast-stream-streams crs)))
110 (when rrs (broadcast-stream-streams rrs)))
112 (append (when crs (broadcast-stream-streams crs))
113 (when rrs (broadcast-stream-streams rrs))))
115 (error "Unknown recording type. ~A" type)))))
117 (defun sql-stream (&key (type :commands) (database *default-database*))
118 "Returns the broadcast streams used for recording SQL commands or
119 results traffic. TYPE must be either :commands or :results defaulting
120 to :commands while DATABASE defaults to *default-database*."
123 (command-recording-stream database))
125 (result-recording-stream database))
127 (error "Unknown recording type. ~A" type))))
129 (defun record-sql-command (expr database)
131 (with-slots (command-recording-stream)
133 (if command-recording-stream
134 (format command-recording-stream "~&;; ~A ~A => ~A~%"
135 (iso-timestring (get-time))
136 (database-name database)
139 (defun record-sql-result (res database)
141 (with-slots (result-recording-stream)
143 (if result-recording-stream
144 (format result-recording-stream "~&;; ~A ~A <= ~A~%"
145 (iso-timestring (get-time))
146 (database-name database)