SQL扱うのに便利な関数とか、プレースホルダーを埋める関数とか

Arkのログ、DBIC_TRACE=1 の時に出るやつをごニョゴニョしたいと思って。いろいろやってみた。

SELECT * FROM user me WHERE ( ( me.id = ? AND deleted = ? ) ): '4', '0'

を選択して、
M-x sql-fill-placeholders
すると、kill-ring に

SELECT * FROM user me WHERE ( ( me.id = '4' AND deleted = '0' ) );

が入っている状態になる。埋め込まれている。そのまま実行できるはず。
以下は、応用。

SELECT * FROM user me WHERE ( ( me.id = ? AND deleted = ? ) ): '4', '0'
を選択して、
C-u M-x sql-fill-placeholders-and-send
で EXPLAIN をつけてSQLバッファで実行。
以外と便利。
落ち着いたらゆっくり書きたい。

(defun sql-fill-params (q los)
  (assert (stringp q))
  (assert (and (listp los)
               (stringp (car-safe los))))
  (with-temp-buffer
    (insert q)
    (goto-char (point-min))
    (dolist (s los)
      (re-search-forward (rx "?"))
      (replace-match s nil t nil))
    (buffer-substring-no-properties (point-min) (point-max))))

(defun sql-fill-placeholders-parse-param-str (param-str)
  (let ((params (split-string param-str "," t)))
    (mapcar (lambda (s) (replace-regexp-in-string
                         "[ \t\n]*$" "" (replace-regexp-in-string "^[ \t\n]*" "" s)))
            params)))

(defun sql-fill-placeholders-from-string (str)
  (when (string-match (rx (* space) (group (* (not (any ":")))) ":" (* space) (group (* print)) eol) str)
    (let ((query (match-string-no-properties 1 str))
          (param-str (match-string-no-properties 2 str)))
      (cond
       ;; no placeholder
       ((not (string-match (rx "?") query))
        query)
       (t
        (let ((params (sql-fill-placeholders-parse-param-str param-str)))
          (sql-fill-params query params)))))))

(defun sql-fill-placeholders-make-executable-sql (start end)
  (let ((sql (sql-fill-placeholders-from-string
              (buffer-substring-no-properties start end))))
    (concat sql ";")))

(defun sql-fill-placeholders (start end)
  (interactive "r")
  (let ((sql (sql-fill-placeholders-make-executable-sql start end)))
    (kill-new sql)))

(defun sql-fill-placeholders-and-send (start end)
  (interactive "r")
  (assert (buffer-live-p (get-buffer sql-buffer)))
  (let* ((sql (sql-fill-placeholders-make-executable-sql start end))
         (sql (if current-prefix-arg (concat "EXPLAIN " sql) sql)))
    (with-current-buffer sql-buffer
      (sql-send-string sql))))