base/recording.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;;
   4 ;;;; $Id$
   5 ;;;;
   6 ;;;; CLSQL broadcast streams which can be used to monitor the
   7 ;;;; flow of commands to, and results from, a database.
   8 ;;;;
   9 ;;;; This file is part of CLSQL.
  10 ;;;;
  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 ;;;; *************************************************************************
  15
  16 (in-package #:clsql-base)
  17
  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*)))
  31   (values))
  32
  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))
  42   (values))
  43
  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))
  52             (and (eq type :both)
  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))))
  58     t))
  59
  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))))))
  79   stream)
  80
  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
  86 *default-database*."
  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)))))
  97   stream)
  98
  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)))
 106     (cond
 107       ((eq type :commands)
 108        (when crs (broadcast-stream-streams crs)))
 109       ((eq type :results)
 110        (when rrs (broadcast-stream-streams rrs)))
 111       ((eq type :both)
 112        (append (when crs (broadcast-stream-streams crs))
 113                (when rrs (broadcast-stream-streams rrs))))
 114       (t
 115        (error "Unknown recording type. ~A" type)))))
 116
 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*."
 121   (cond
 122     ((eq type :commands)
 123      (command-recording-stream database))
 124     ((eq type :results)
 125      (result-recording-stream database))
 126     (t
 127      (error "Unknown recording type. ~A" type))))
 128
 129 (defun record-sql-command (expr database)
 130   (if database
 131       (with-slots (command-recording-stream)
 132           database
 133         (if command-recording-stream
 134             (format command-recording-stream "~&;; ~A ~A => ~A~%"
 135                     (iso-timestring (get-time))
 136                     (database-name database)
 137                     expr)))))
 138
 139 (defun record-sql-result (res database)
 140   (if database
 141       (with-slots (result-recording-stream)
 142           database
 143         (if result-recording-stream
 144             (format result-recording-stream "~&;; ~A ~A <= ~A~%"
 145                     (iso-timestring (get-time))
 146                     (database-name database)
 147                     res)))))
 148
 149
 150