Skip to content

Commit

Permalink
Merge pull request #319 from sabracrolleton/master
Browse files Browse the repository at this point in the history 
Minor bug fixes - Drop Role and Execute File
  • Loading branch information
@sabracrolleton
sabracrolleton committed Feb 12, 2023
2 parents 3fb0051 + 1fe2be4 commit 4b895e2
Show file tree
Hide file tree
Showing 11 changed files with 306 additions and 51 deletions.
12 changes: 12 additions & 0 deletions CHANGELOG.md
View file
Original file line number Diff line number Diff line change
@@ -1,3 +1,15 @@
# Changelog 1.33.8

Dollar Quoted tags are allowed in files. Prior to Postmodern version 1.33.8 only
alphabetic characters were allowed in tags. Postgresql documentation and industry
practice allow any character to be in a dollar quoted tag. Postmodern version 1.33.8
relaxes the alphabetic character requirement. The only limitation now is that digit
characters cannot be in the first position in a tag.

This version also fixes a bug in the postmodern function drop-role. Previously if a role
owned objects in multiple databases, the drop-role function tried to drop the role before
all owned objects were reassigned owners.

# Changelog 1.33.7
Changes in cl-postgres and s-sql to allow use of plain proper lists in parameterized queries. Previously only vectors could be used. The following show examples using both vectors and lists in queries using both raw sql and s-sql.
```lisp
Expand Down
2 changes: 1 addition & 1 deletion README.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@ A Common Lisp PostgreSQL programming interface

---

Version 1.33.7
Version 1.33.8

Postmodern is a Common Lisp library for interacting with [PostgreSQL](http://www.postgresql.org) databases. It is under active development. Features are:

Expand Down
2 changes: 1 addition & 1 deletion cl-postgres.asd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,7 @@
:author "Marijn Haverbeke <marijnh@gmail.com>"
:maintainer "Sabra Crolleton <sabra.crolleton@gmail.com>"
:license "zlib"
:version "1.33.7"
:version "1.33.8"
:depends-on ("md5" "split-sequence" "ironclad" "cl-base64" "uax-15"
(:feature (:or :allegro :ccl :clisp :genera
:armedbear :cmucl :lispworks)
Expand Down
15 changes: 14 additions & 1 deletion doc/postmodern.html
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

9 changes: 9 additions & 0 deletions doc/postmodern.org
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2327,6 +2327,15 @@ The default setting is to remove sql comments from the file before executing
the sql code. If that causes problems, the remove-comments parameter can be
set to nil.

Dollar Quoted tags are allowed in files. Prior to Postmodern version 1.33.8 only
alphabetic characters were allowed in tags. Postgresql documentation and industry
practice allow any character to be in a dollar quoted tag. Postmodern version 1.33.8
relaxes the alphabetic character requirement. The only limitation now is that digit
characters cannot be in the first position in a tag.

Execute-file does not support copy-in or copy-out in a file. If you have files
with that requirement, you will need to fall back on another solution.

IMPORTANT NOTE: This utility function assumes that the file containing the sql
queries can be trusted and bypasses the normal postmodern parameterization of
queries.
Expand Down
2 changes: 1 addition & 1 deletion postmodern.asd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,7 @@
:maintainer "Sabra Crolleton <sabra.crolleton@gmail.com>"
:homepage "https://github.com/marijnh/Postmodern"
:license "zlib"
:version "1.33.7"
:version "1.33.8"
:depends-on ("alexandria"
"cl-postgres"
"s-sql"
Expand Down
80 changes: 48 additions & 32 deletions postmodern/execute-file.lisp
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,11 @@
;;;; -*- Mode: LISP; Syntax: Ansi-Common-Lisp; Base: 10; Package: POSTMODERN; -*-
(in-package :postmodern)

(defun disallowed-tag-char-p (char)
"Returns t if char is a character we are going to disallow in a tag"
(if (member char '(#\space #\tab #\newline #\linefeed #\page #\return #\backspace #\rubout))
t nil))

(defstruct parser
filename
(stream (make-string-output-stream))
Expand Down Expand Up @@ -49,10 +54,13 @@
(pop (parser-tags p)))

(defmethod reset-state ((p parser) &key tagp)
"Depending on the current tags stack, set P state to either :eat or :eqt"
"Depending on the current tags stack, set P state to :eat, :ett or :eqt"
(setf (parser-state p)
(cond ((null (parser-tags p)) :eat)
(tagp :ett)
((or tagp
(> (length (parser-tags p))
0))
:ett)
(t :eqt))))

#|
Expand Down Expand Up @@ -137,24 +145,24 @@ should return
(:eat (setf (parser-state state) :tag))
(:ett (setf (parser-state state) :tag))
(:tag (setf (parser-state state) :eot)))

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

(:tag (push-new-tag 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 :tagp t))

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

(progn
(reset-state state :tagp t))
;; not the same tags, switch state back
;; don't forget to add the opening tag
(progn
Expand All @@ -167,7 +175,6 @@ should return

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

;; see
;; http://www.postgresql.org/docs/current/sql-syntax-lexical.html#SQL-SYNTAX-STRINGS-ESCAPE
;; we re-inject whatever we read in the \x
Expand All @@ -178,25 +185,34 @@ should return
(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)))))))
;; any non-numeric characters are allowed in tags
;; numeric characters immediately following a $ indicates a parameter
;; not a tag
(if
(or (not (digit-char-p char))
(> (length (first (parser-tags state))) 0))
(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)))))
(error
(format nil "~a~%~%~a" e
"In this context, look particularly for mismatched dollar quoted tags or a dollar quoted tag
that starts with a digit. Digits in a dollar quoted tag should not be in the first position
or they will be confused with parameterized variable positions."))))))

(defstruct comment-parser
buffer
Expand All @@ -223,7 +239,7 @@ should return
(defun parse-comments (str &optional (state (make-comment-parser)))
(loop for char across str
do
; (format t "~a ~a~%" char (char-code char))

(case char
(#\' (case (first (comment-parser-state state))
(:base (push :sq (comment-parser-state state))
Expand All @@ -247,7 +263,7 @@ should return
(:slc )
(:sq (write-char char (comment-parser-stream state)))
(:sb? (setf (first (comment-parser-state state)) :slc))
(:mb? ; faked multi-line beginning, return to earlier state
(:mb? ; faked multi-line beginning, return to earlier state
(pop (comment-parser-state state))
(when (eq (first (comment-parser-state state))
:base)
Expand All @@ -263,10 +279,10 @@ should return
(write-char char (comment-parser-stream state)))
(:sb? (pop (comment-parser-state state))
(write-char char (comment-parser-stream state)))
(:mb? ; faked multi-line beginning, return to earlier state
(:mb? ; faked multi-line beginning, return to earlier state
(pop (comment-parser-state state))
(when (eq (first (comment-parser-state state))
:base)
:base)
(write-char #\/ (comment-parser-stream state))
(write-char #\/ (comment-parser-stream state))))
(:me? (pop (comment-parser-state state))
Expand All @@ -284,8 +300,8 @@ should return
(write-char #\/ (comment-parser-stream state))))
(:mlc (push :mb? (comment-parser-state state))
)
(:me? ; actual ending of a multi-line comment
; need to pop both the :me? amd tej :mlc
(:me? ; actual ending of a multi-line comment
; need to pop both the :me? amd tej :mlc
(pop (comment-parser-state state))
(pop (comment-parser-state state)))))
(#\* (case (first (comment-parser-state state))
Expand All @@ -294,7 +310,7 @@ should return
(:mlc ; maybe starting the end of a nested multi-line comment
(push :me? (comment-parser-state state)))
(:sq (write-char char (comment-parser-stream state)))
(:me? ; fake ending of a multi-line comment
(:me? ; fake ending of a multi-line comment
(pop (comment-parser-state state))
(when (eq (first (comment-parser-state state)) :mlc)
(push :me? (comment-parser-state state))))))
Expand All @@ -307,9 +323,9 @@ should return
:base)
(write-char #\/ (comment-parser-stream state))
(write-char char (comment-parser-stream state))))
(:me? ; fake ending of a multi-line comment
(:me? ; fake ending of a multi-line comment
(pop (comment-parser-state state)))
(:sb? ; fake single line comment
(:sb? ; fake single line comment
(pop (comment-parser-state state))
(write-char #\- (comment-parser-stream state))
(write-char char (comment-parser-stream state)))
Expand Down
23 changes: 15 additions & 8 deletions postmodern/roles.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -433,17 +433,24 @@ group roles."
(when (not (role-exists-p new-owner))
(setf new-owner (cl-postgres::connection-user *database*)))
(if (eq database :all)
(loop for x in (list-databases :names-only t) do
(with-connection (list x (cl-postgres::connection-user *database*)
(progn
(loop for x in (list-databases :names-only t) do
(with-connection (list x (cl-postgres::connection-user *database*)
(cl-postgres::connection-password *database*)
(cl-postgres::connection-host *database*)
:port (cl-postgres::connection-port *database*)
:use-ssl (cl-postgres::connection-use-ssl *database*))
(when (and (not (string= role-name "postgres"))
(role-exists-p role-name))
(query (format nil "reassign owned by ~a to ~a" role-name new-owner))
(query (format nil "drop owned by ~a" role-name)))))
(with-connection (list (cl-postgres::connection-db *database*)
(cl-postgres::connection-user *database*)
(cl-postgres::connection-password *database*)
(cl-postgres::connection-host *database*)
:port (cl-postgres::connection-port *database*)
:use-ssl (cl-postgres::connection-use-ssl *database*))
(when (and (not (string= role-name "postgres"))
(role-exists-p role-name))
(query (format nil "reassign owned by ~a to ~a" role-name new-owner))
(query (format nil "drop owned by ~a" role-name))
(query (format nil "drop role if exists ~a" role-name)))))
(query (format nil "drop role if exists ~a" role-name))))
(with-connection (list database (cl-postgres::connection-user *database*)
(cl-postgres::connection-password *database*)
(cl-postgres::connection-host *database*)
Expand All @@ -454,7 +461,7 @@ group roles."
(query (format nil "reassign owned by ~a to ~a" role-name new-owner))
(query (format nil "drop owned by ~a cascade" role-name))
(query (format nil "drop role if exists ~a" role-name)))))
(not (role-exists-p role-name)))
(not (role-exists-p role-name)))

(defun list-role-permissions (&optional role)
"This returns a list of sublists of the permissions granted within the
Expand Down
Loading

0 comments on commit 4b895e2

Please sign in to comment.