base/recording.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; ======================================================================
   3 ;;;; $Id: $
   4 ;;;;
   5 ;;;; Description ==========================================================
   6 ;;;; ======================================================================
   7 ;;;;
   8 ;;;; CLSQL-USQL broadcast streams which can be used to monitor the
   9 ;;;; flow of commands to, and results from, a database.
  10 ;;;;
  11 ;;;; ======================================================================
  12
  13 (in-package #:clsql-base-sys)
  14
  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*)))
  28   (values))
  29
  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))
  39   (values))
  40
  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))
  49             (and (eq type :both)
  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))))
  55     t))
  56
  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))))))
  76   stream)
  77
  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
  83 *default-database*."
  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)))))
  94   stream)
  95
  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)))
 103     (cond
 104       ((eq type :commands)
 105        (when crs (broadcast-stream-streams crs)))
 106       ((eq type :results)
 107        (when rrs (broadcast-stream-streams rrs)))
 108       ((eq type :both)
 109        (append (when crs (broadcast-stream-streams crs))
 110                (when rrs (broadcast-stream-streams rrs))))
 111       (t
 112        (error "Unknown recording type. ~A" type)))))
 113
 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*."
 118   (cond
 119     ((eq type :commands)
 120      (command-recording-stream database))
 121     ((eq type :results)
 122      (result-recording-stream database))
 123     (t
 124      (error "Unknown recording type. ~A" type))))
 125
 126 (defun record-sql-command (expr database)
 127   (if database
 128       (with-slots (command-recording-stream)
 129           database
 130         (if command-recording-stream
 131             (format command-recording-stream "~&;; ~A ~A => ~A~%"
 132                     (iso-timestring (get-time))
 133                     (database-name database)
 134                     expr)))))
 135
 136 (defun record-sql-result (res database)
 137   (if database
 138       (with-slots (result-recording-stream)
 139           database
 140         (if result-recording-stream
 141             (format result-recording-stream "~&;; ~A ~A <= ~A~%"
 142                     (iso-timestring (get-time))
 143                     (database-name database)
 144                     res)))))
 145
 146
 147