--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;;
+;;;; $Id$
+;;;;
+;;;; 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*))
+ "Begin recording SQL command or result traffic. By default the
+broadcast stream is just *STANDARD-OUTPUT* but this can be modified
+using ADD-SQL-STREAM or DELETE-SQL-STREAM. TYPE determines whether SQL
+command or result traffic is recorded, or both. It must be either
+:commands, :results or :both, and defaults to :commands. DATABASE
+defaults to *default-database*."
+ (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 command or result traffic. TYPE determines
+whether to stop SQL command or result traffic, or both. It must be
+either :commands, :results or :both, defaulting to :commands. DATABASE
+defaults to *default-database*."
+ (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*))
+ "Returns t if recording of TYPE of SQL interaction specified is
+enabled. TYPE must be either :commands, :results, :both or :either.
+DATABASE defaults to *default-database*."
+ (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*))
+ "Add the given STREAM as a component stream for the recording
+broadcast stream for the given SQL interaction TYPE. TYPE must be
+either :commands, :results, or :both, defaulting to :commands.
+DATABASE defaults to *default-database*."
+ (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 given STREAM from the recording broadcast stream for
+the given TYPE of SQL interaction. TYPE must be either :commands,
+:results, or :both, defaulting to :commands. DATABASE defaults to
+*default-database*."
+ (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 set of streams which the recording broadcast stream
+send SQL interactions of the given TYPE sends data. TYPE must be
+either :commands, :results, or :both, defaulting to :commands.
+DATABASE defaults to *default-database*."
+ (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 streams used for recording SQL commands or
+results traffic. TYPE must be either :commands or :results defaulting
+to :commands while DATABASE defaults to *default-database*."
+ (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)
+ (if database
+ (with-slots (command-recording-stream)
+ database
+ (if command-recording-stream
+ (format command-recording-stream "~&;; ~A ~A => ~A~%"
+ (iso-timestring (get-time))
+ (database-name database)
+ expr)))))
+
+(defun record-sql-result (res database)
+ (if database
+ (with-slots (result-recording-stream)
+ database
+ (if result-recording-stream
+ (format result-recording-stream "~&;; ~A ~A <= ~A~%"
+ (iso-timestring (get-time))
+ (database-name database)
+ res)))))
+
+
+
projects / clsql.git / blobdiff