src/utils/read-sql-files.lisp - master - n-dimens/pgloader

src/utils/read-sql-files.lisp
225 строк9 KB
Dimitri Fontaine
Fix our SQL parser.
29 май 2017, 13:42
29 май 2017, 13:428f92cc5
;;;
;;; Tools to get the list of query from the model.sql, api.sql and sql/*.sql
;;; files, which remains usable as-is interactively (hence the injecting
;;; trick)
;;;
(in-package #:pgloader.sql)

(defstruct parser
  filename
  (stream  (make-string-output-stream))
  (state   :eat)
  tags)

(defmethod print-object ((p parser) stream)
  (print-unreadable-object (p stream :type t :identity t)
    (with-slots (state tags) p
      (format stream "~a {~{~s~^ ~}}" state tags))))

(defmethod push-new-tag ((p parser))
  "Add a new element on the TAGS slot, a stack"
  (let ((tag (make-array 42
                         :fill-pointer 0
                         :adjustable t
                         :element-type 'character)))
    (push tag (parser-tags p))))

(defmethod extend-current-tag ((p parser) char)
  "The TAGS slot of the parser is a stack, maintain it properly."
  (declare (type character char))
  (assert (not (null (parser-tags p))))
  (vector-push-extend char (first (parser-tags p))))

(defmethod format-current-tag ((p parser) &optional (stream (parser-stream p)))
  "Output the current tag to the current stream."
  (format stream "$~a$" (coerce (first (parser-tags p)) 'string)))

(defmethod maybe-close-tags ((p parser) &optional (stream (parser-stream p)))
  "If the two top tags in the TAGS slot of the parser P are the
   same (compared using EQUALP), then pop them out of the stack and print
   the closing tag to STREAM."
  (when (and (< 1 (length (parser-tags p)))
             (equalp (first (parser-tags p))
                     (second (parser-tags p))))
    ;; format the tag in the stream and POP both entries
    (format-current-tag p stream)
    (pop (parser-tags p))
    (pop (parser-tags p))
    ;; and return t
    t))

(defmethod pop-current-tag ((p parser))
  "Remove current tag entry"
  (pop (parser-tags p)))

(defmethod reset-state ((p parser))
  "Depending on the current tags stack, set P state to either :eat or :eqt"
  (setf (parser-state p) (if (null (parser-tags p)) :eat :eqt)))

#|
Here's a test case straigth from the PostgreSQL docs:

(with-input-from-string (s "
create function f(text)
   returns bool
   language sql
as $function$
BEGIN
    RETURN ($1 ~ $q$[\\t\\r\\n\\v\\\\]$q$);
END;
$function$;")
        (parse-query s (make-parser)))


Another test case for the classic quotes:

      (with-pgsql-connection ("pgsql:///pginstall")
        (query
         (with-input-from-string (s "select E'\\';' as \";\";")
           (parse-query s)) :alists))

      should return
      (((:|;| . "';")))
|#

(defun parse-query (stream &optional (state (make-parser)))
  "Read a SQL query from STREAM, starting at whatever the current position is.

   Returns another SQL query each time it's called, or NIL when EOF is
   reached expectedly. Signal end-of-file condition when reaching EOF in the
   middle of a query.

   See the following docs for some of the parser complexity background:

    http://www.postgresql.org/docs/9.3/static/sql-syntax-lexical.html#SQL-SYNTAX-DOLLAR-QUOTING

   Parser states are:

     - EAT    reading the query
     - TAG    reading a tag that could be an embedded $x$ tag or a closing tag
     - EOT    End Of Tag
     - EQT    Eat Quoted Text
     - EDQ    Eat Double-Quoted Text (identifiers)
     - EOQ    done reading the query
     - ESC    read espaced text (with backslash)"
  (handler-case
      (loop
         :until (eq :eoq (parser-state state))
         :for char := (read-char stream)
         :do (case char
               (#\\       (case (parser-state state)
                            (:esc    (setf (parser-state state) :eqt))
                            (:eqt    (setf (parser-state state) :esc)))

                          (write-char char (parser-stream state)))

               (#\'       (case (parser-state state)
                            (:eat    (setf (parser-state state) :eqt))
                            (:esc    (setf (parser-state state) :eqt))
                            (:eqt    (setf (parser-state state) :eat))
                            (:tag
                             (progn
                               ;; a tag name can't contain a single-quote
                               ;; get back to previous state
                               (let ((tag (pop-current-tag state)))
                                 (format (parser-stream state) "$~a" tag))
                               (reset-state state))))

                          (write-char char (parser-stream state)))

               (#\"       (case (parser-state state)
                            (:eat    (setf (parser-state state) :edq))
                            (:edq    (setf (parser-state state) :eat)))

                          (write-char char (parser-stream state)))

               (#\$       (case (parser-state state)
                            (:eat    (setf (parser-state state) :tag))
                            (:eqt    (setf (parser-state state) :tag))
                            (:tag    (setf (parser-state state) :eot)))

                          ;; we act depending on the NEW state
                          (case (parser-state state)
                            (:eat (write-char char (parser-stream state)))
                            (:edq (write-char char (parser-stream state)))

                            (:tag (push-new-tag state))

                            (:eot       ; check the tag stack
                             (cond ((= 1 (length (parser-tags state)))
                                    ;; it's an opening tag, collect the text now
                                    (format-current-tag state)
                                    (reset-state state))

                                   (t   ; are we closing the current tag?
                                    (if (maybe-close-tags state)
                                        (reset-state state)

                                        ;; not the same tags, switch state back
                                        ;; don't forget to add the opening tag
                                        (progn
                                          (format-current-tag state)
                                          (setf (parser-state state) :eqt))))))))

               (#\;       (case (parser-state state)
                            (:eat      (setf (parser-state state) :eoq))
                            (otherwise (write-char char (parser-stream state)))))

               (otherwise (cond ((member (parser-state state) '(:eat :eqt :edq))
                                 (write-char char (parser-stream state)))

                                ;; see
                                ;; http://www.postgresql.org/docs/9.4/static/sql-syntax-lexical.html#SQL-SYNTAX-STRINGS-ESCAPE
                                ;; we re-inject whatever we read in the \x
                                ;; syntax into the stream and let PostgreSQL
                                ;; be the judge of what it means.
                                ((member (parser-state state) '(:esc))
                                 (write-char char (parser-stream state))
                                 (setf (parser-state state) :eqt))

                                ((member (parser-state state) '(:tag))
                                 ;; only letters are allowed in tags
                                 (if (alpha-char-p char)
                                     (extend-current-tag state char)

                                     (progn
                                       ;; not a tag actually: remove the
                                       ;; parser-tags entry and push back its
                                       ;; contents to the main output stream
                                       (let ((tag (pop-current-tag state)))
                                         (format (parser-stream state)
                                                 "$~a~c"
                                                 tag
                                                 char))
                                       (reset-state state)))))))
         :finally (return
                    (get-output-stream-string (parser-stream state))))
    (end-of-file (e)
      (unless (eq :eat (parser-state state))
        (error e)))))

(defun read-lines (filename &optional (q (make-string-output-stream)))
  "Read lines from given filename and return them in a stream. Recursively
   apply \i include instructions."
  (with-open-file (s filename :direction :input)
    (loop
       for line = (read-line s nil)
       while line
       do (if (or (and (> (length line) 3)
                       (string= "\\i " (subseq line 0 3)))
                  (and (> (length line) 4)
                       (string= "\\ir " (subseq line 0 4))))
	      (let ((include-filename
		     (merge-pathnames (subseq line 3)
				      (directory-namestring filename))))
	       (read-lines include-filename q))
	      (format q "~a~%" line))
       finally (return q))))

(defun read-queries (filename)
  "read SQL queries in given file and split them, returns a list"
  (let ((file-content (get-output-stream-string (read-lines filename))))
    (with-input-from-string (s file-content)
      (loop :for query := (parse-query s)
         :while query
         :collect query))))