diff --git a/src/parsers/command-db-uri.lisp b/src/parsers/command-db-uri.lisp index fc8a399..caf1655 100644 --- a/src/parsers/command-db-uri.lisp +++ b/src/parsers/command-db-uri.lisp @@ -86,7 +86,7 @@ (append (list :host (when host (process-hostname host))) port)))) -(defrule dsn-dbname (and "/" (? namestring)) +(defrule dsn-dbname (and "/" (? maybe-quoted-namestring)) (:destructure (slash dbname) (declare (ignore slash)) (list :dbname dbname))) @@ -105,10 +105,6 @@ (declare (ignore key e)) (cons :use-ssl val)))) -(defrule maybe-quoted-namestring (or double-quoted-namestring - quoted-namestring - namestring)) - (defrule qualified-table-name (and maybe-quoted-namestring "." maybe-quoted-namestring) diff --git a/src/parsers/command-mysql.lisp b/src/parsers/command-mysql.lisp index a90bdf4..aaa1691 100644 --- a/src/parsers/command-mysql.lisp +++ b/src/parsers/command-mysql.lisp @@ -94,12 +94,8 @@ (defrule mysql-prefix "mysql://" (:constant (list :type :mysql))) -(defrule mysql-dsn-dbname (and "/" (* (or (alpha-char-p character) - (digit-char-p character) - punct))) - (:destructure (slash dbname) - (declare (ignore slash)) - (list :dbname (text dbname)))) +(defrule mysql-dsn-dbname (and "/" maybe-quoted-namestring) + (:lambda (m-d-d) (list :dbname (text (second m-d-d))))) (defrule mysql-uri (and mysql-prefix (? dsn-user-password) diff --git a/src/parsers/command-utils.lisp b/src/parsers/command-utils.lisp index 0848ec3..5a0073f 100644 --- a/src/parsers/command-utils.lisp +++ b/src/parsers/command-utils.lisp @@ -39,11 +39,11 @@ punct))) (:text t)) -(defrule double-quoted-namestring (and #\" namestring #\") - (:destructure (open name close) (declare (ignore open close)) name)) +(defrule double-quoted-namestring (and #\" (* (not #\")) #\") + (:lambda (dqn) (text (second dqn)))) -(defrule quoted-namestring (and #\' namestring #\') - (:destructure (open name close) (declare (ignore open close)) name)) +(defrule quoted-namestring (and #\' (+ (not #\')) #\') + (:lambda (dqn) (text (second dqn)))) (defrule name (or namestring quoted-namestring) (:text t)) @@ -52,3 +52,8 @@ (:destructure (whitespace name) (declare (ignore whitespace)) name)) (defrule namestring-or-regex (or quoted-namestring quoted-regex)) + +(defrule maybe-quoted-namestring (or double-quoted-namestring + quoted-namestring + namestring)) +