X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=base%2Frecording.lisp;fp=base%2Frecording.lisp;h=0000000000000000000000000000000000000000;hb=8a8ee2d7d791b7a3efaed06420802a925d16fca3;hp=85620f785ad24895f379be21a217f2fd4bb93e5f;hpb=09f07ac9d914a83f9426609f3264f4e66b5a6d97;p=clsql.git diff --git a/base/recording.lisp b/base/recording.lisp deleted file mode 100644 index 85620f7..0000000 --- a/base/recording.lisp +++ /dev/null @@ -1,150 +0,0 @@ -;;;; -*- 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-base) - -(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))))) - - -