From 07fbd088c47a0218992e09431d433c9edf9b976d Mon Sep 17 00:00:00 2001 From: Sabra Crolleton Date: Wed, 18 Aug 2021 20:47:04 -0400 Subject: [PATCH 01/13] partial fix for sql file comments Does not handle nested multiline comments --- doc/postmodern.html | 138 +++++++++++++------------ doc/postmodern.org | 2 + postmodern/execute-file.lisp | 17 ++- postmodern/tests/test-execute-file.sql | 16 ++- 4 files changed, 97 insertions(+), 76 deletions(-) diff --git a/doc/postmodern.html b/doc/postmodern.html index 98ea6a61..1ca9eb46 100644 --- a/doc/postmodern.html +++ b/doc/postmodern.html @@ -1,7 +1,7 @@ - + Postmodern Reference Manual @@ -246,7 +246,7 @@

Postmodern Reference Manual

Table of Contents

-
-

Overview

-
+
+

Overview

+

This is the reference manual for the component named postmodern, which is part of a library of the same name. @@ -1000,9 +1000,9 @@

macro query (query &rest args/format)

Some Examples:

-
-

Default

-
+
+

Default

+

The default is :lists

@@ -1013,9 +1013,9 @@

Default

-
-

Single

-
+
+

Single

+

Returns a single field. Will throw an error if the queries returns more than one field or more than one row

@@ -1026,9 +1026,9 @@

Single

-
-

List

-
+
+

List

+

Returns a list containing the selected fields. Will throw an error if the query returns more than one row

@@ -1039,9 +1039,9 @@

List

-
-

Lists

-
+
+

Lists

+

This is the default

@@ -1052,9 +1052,9 @@

Lists

-
-

Alist

-
+
+

Alist

+

Returns an alist containing the field name as a keyword and the selected fields. Will throw an error if the query returns more than one row.

@@ -1065,9 +1065,9 @@

Alist

-
-

Str-alist

-
+
+

Str-alist

+

Returns an alist containing the field name as a lower case string and the selected fields. Will throw an error if the query returns more than one row.

@@ -1078,9 +1078,9 @@

Str-alist

-
-

Alists

-
+
+

Alists

+

Returns a list of alists containing the field name as a keyword and the selected fields.

@@ -1092,9 +1092,9 @@

Alists

-
-

Str-alists

-
+
+

Str-alists

+

Returns a list of alists containing the field name as a lower case string and the selected fields.

@@ -1106,9 +1106,9 @@

Str-alists

-
-

Plist

-
+
+

Plist

+

Returns a plist containing the field name as a keyword and the selected fields. Will throw an error if the query returns more than one row.

@@ -1119,9 +1119,9 @@

Plist

-
-

Plists

-
+
+

Plists

+

Returns a list of plists containing the field name as a keyword and the selected fields.

@@ -1132,9 +1132,9 @@

Plists

-
-

Vectors

-
+
+

Vectors

+

Returns a vector of vectors where each internal vector is a returned row from the query. The field names are not included. NOTE: It will return an empty vector instead of NIL if there is no result.

@@ -1152,9 +1152,9 @@

Vectors

-
-

Array-hash

-
+
+

Array-hash

+

Returns a vector of hashtables where each hash table is a returned row from the query with field name as the key expressed as a lower case string.

@@ -1172,9 +1172,9 @@

Array-hash

-
-

Dao

-
+
+

Dao

+

Returns a list of daos of the type specified

@@ -1188,9 +1188,9 @@

Dao

-
-

Column

-
+
+

Column

+

Returns a list of field values of a single field. Will throw an error if more than one field is selected

@@ -1204,9 +1204,9 @@

Column

-
-

Json-strs

-
+
+

Json-strs

+

Return a list of strings where the row returned is a json object expressed as a string

@@ -1244,9 +1244,9 @@

Json-strs

-
-

Json-str

-
+
+

Json-str

+

Return a single string where the row returned is a json object expressed as a string

@@ -1261,9 +1261,9 @@

Json-str

-
-

Json-array-str

-
+
+

Json-array-str

+

Return a string containing a json array, each element in the array is a selected row expressed as a json object. NOTE: If there is no result, this will return a string with an empty json array.

@@ -1280,9 +1280,9 @@

Json-array-str

-
-

Second value returned

-
+
+

Second value returned

+

If the database returns information about the amount rows that were affected, such as with updating or deleting queries, this is returned as a second value. @@ -2332,9 +2332,9 @@

function add-comment (type name comment &optio

-
-

find-comments (type identifier)

-
+
+

find-comments (type identifier)

+

Returns the comments attached to a particular database object. The allowed types are :database :schema :table :columns (all the columns in a table) @@ -3507,9 +3507,9 @@

function rename-table (old-name new-name)

-
-

function rename-column (table-name old-name new-name)

-
+
+

function rename-column (table-name old-name new-name)

+

→ boolean

@@ -3696,6 +3696,10 @@

function execute-file (filename &optional (pr print the count of the query and the query to the REPL.

+

+This function does not handle nested multiple line comments. +

+

IMPORTANT NOTE: This utility function assumes that the file containing the sql queries can be trusted and bypasses the normal postmodern parameterization of diff --git a/doc/postmodern.org b/doc/postmodern.org index 5b12b430..a159a247 100644 --- a/doc/postmodern.org +++ b/doc/postmodern.org @@ -2188,6 +2188,8 @@ the test file test-execute-file-broken-transaction.sql as an example. For debugging purposes, if the optional print parameter is set to t, format will print the count of the query and the query to the REPL. +This function does not handle nested multiple line comments. + IMPORTANT NOTE: This utility function assumes that the file containing the sql queries can be trusted and bypasses the normal postmodern parameterization of queries. diff --git a/postmodern/execute-file.lisp b/postmodern/execute-file.lisp index efc25a90..c343a2c6 100644 --- a/postmodern/execute-file.lisp +++ b/postmodern/execute-file.lisp @@ -145,13 +145,13 @@ should return (:tag (push-new-tag state)) - (:eot ; check the tag stack + (: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) @@ -198,6 +198,11 @@ should return (unless (eq :eat (parser-state state)) (error e))))) +;; For multiple unnested multi-line comments in the same string. +;; Does not handle nested multi-line comments. +(defparameter multi-line-comment-scanner + (cl-ppcre:create-scanner "//*.*?/*/" :single-line-mode t)) + (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." @@ -213,7 +218,9 @@ should return (merge-pathnames (subseq line 3) (directory-namestring filename)))) (read-lines include-filename q)) - (format q "~a~%" line)) + (progn + (setf line (cl-ppcre::regex-replace "--.*" line "")) ; drop single line comments + (format q "~a~%" line))) finally (return q)))) (defun parse-queries (file-content) @@ -227,7 +234,9 @@ should return (defun read-queries (filename) "Read SQL queries in given file and split them, returns a list" - (parse-queries (get-output-stream-string (read-lines filename)))) + (parse-queries (cl-ppcre:regex-replace-all multi-line-comment-scanner + (get-output-stream-string (read-lines filename)) + ""))) (defun execute-file (pathname &optional (print nil)) "This function will execute sql queries stored in a file. Each sql statement diff --git a/postmodern/tests/test-execute-file.sql b/postmodern/tests/test-execute-file.sql index d3c37091..ec519551 100644 --- a/postmodern/tests/test-execute-file.sql +++ b/postmodern/tests/test-execute-file.sql @@ -1,3 +1,5 @@ +drop table if exists company_employees; + create table company_employees( id bigserial primary key not null, name text not null, @@ -6,16 +8,20 @@ create table company_employees( salary real, join_date date ); --- Test comment 1 +-- ;Test comment 1;; insert into company_employees (id,name,age,address,salary,join_date) values (1, 'paul', 32, 'London', 20100.00,'2001-07-13'); insert into company_employees (id,name,age,address,salary,join_date) values (2, 'ziad', 32, 'Beirut', 20000.00,'2003-03-13'); -/* test comment 2 +/* test' comment 2 with multiple lines */ insert into company_employees (id,name,age,address,salary,join_date) values (3, 'john', 32, 'Toronto', 20100.00,'2005-07-13'); insert into company_employees (id,name,age,address,salary,join_date) values (4, 'yasmin', 32, 'Mumbai', 20000.00,'2007-03-13'); -/* test comment 3 (asterisk in second line of multiline comment) - * with multiple lines +/* ;test comment 3 (asterisk in second line of multiline comment) + * with multiple lines;; +*/ + insert into company_employees (id,name,age,address,salary,join_date) values (5, 'susan', 32, 'Vancouver', 20100.00,'2009-07-13'); +/* ;test comment 4 (asterisk in second line of multiline comment) + * with multiple lines;; + * did I say something wrong? */ -insert into company_employees (id,name,age,address,salary,join_date) values (5, 'susan', 32, 'Vancouver', 20100.00,'2009-07-13'); insert into company_employees (id,name,age,address,salary,join_date) values (6, 'johanna', 32, 'Berlin', 20000.00,'2011-03-13'); From 02a80264af1a82864491b93b3fa0d0fb165fdb59 Mon Sep 17 00:00:00 2001 From: Sabra Crolleton Date: Thu, 19 Aug 2021 08:03:55 -0400 Subject: [PATCH 02/13] minor editing on comment regex --- postmodern/execute-file.lisp | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/postmodern/execute-file.lisp b/postmodern/execute-file.lisp index c343a2c6..d404a02b 100644 --- a/postmodern/execute-file.lisp +++ b/postmodern/execute-file.lisp @@ -203,6 +203,9 @@ should return (defparameter multi-line-comment-scanner (cl-ppcre:create-scanner "//*.*?/*/" :single-line-mode t)) +(defparameter single-line-comment-scanner + (cl-ppcre:create-scanner "--.*")) + (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." @@ -219,7 +222,10 @@ should return (directory-namestring filename)))) (read-lines include-filename q)) (progn - (setf line (cl-ppcre::regex-replace "--.*" line "")) ; drop single line comments + (setf line (cl-ppcre::regex-replace + single-line-comment-scanner + line + "")) ; drop single line comments (format q "~a~%" line))) finally (return q)))) @@ -234,9 +240,10 @@ should return (defun read-queries (filename) "Read SQL queries in given file and split them, returns a list" - (parse-queries (cl-ppcre:regex-replace-all multi-line-comment-scanner - (get-output-stream-string (read-lines filename)) - ""))) + (parse-queries (cl-ppcre:regex-replace-all + multi-line-comment-scanner + (get-output-stream-string (read-lines filename)) + ""))) (defun execute-file (pathname &optional (print nil)) "This function will execute sql queries stored in a file. Each sql statement From 9d6b229942aa4548b12e2fdbfa6233877231636b Mon Sep 17 00:00:00 2001 From: Sabra Crolleton Date: Sat, 28 Aug 2021 10:20:12 -0400 Subject: [PATCH 03/13] fix bug in execute file when certain characters appear in comments regex was not properly dealing with forward slashes Still does not handle nested comments. --- postmodern/execute-file.lisp | 2 +- postmodern/tests/test-execute-file.sql | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/postmodern/execute-file.lisp b/postmodern/execute-file.lisp index d404a02b..9bebdb29 100644 --- a/postmodern/execute-file.lisp +++ b/postmodern/execute-file.lisp @@ -201,7 +201,7 @@ should return ;; For multiple unnested multi-line comments in the same string. ;; Does not handle nested multi-line comments. (defparameter multi-line-comment-scanner - (cl-ppcre:create-scanner "//*.*?/*/" :single-line-mode t)) + (cl-ppcre:create-scanner "/[*].*?[*]/" :single-line-mode t)) (defparameter single-line-comment-scanner (cl-ppcre:create-scanner "--.*")) diff --git a/postmodern/tests/test-execute-file.sql b/postmodern/tests/test-execute-file.sql index ec519551..27106cab 100644 --- a/postmodern/tests/test-execute-file.sql +++ b/postmodern/tests/test-execute-file.sql @@ -16,7 +16,7 @@ with multiple lines */ insert into company_employees (id,name,age,address,salary,join_date) values (3, 'john', 32, 'Toronto', 20100.00,'2005-07-13'); insert into company_employees (id,name,age,address,salary,join_date) values (4, 'yasmin', 32, 'Mumbai', 20000.00,'2007-03-13'); -/* ;test comment 3 (asterisk in second line of multiline comment) +/* ;test comment 3 (asterisk in /second/ line of multiline comment) * with multiple lines;; */ insert into company_employees (id,name,age,address,salary,join_date) values (5, 'susan', 32, 'Vancouver', 20100.00,'2009-07-13'); From 7ff8e2ee16954064b60fdbbfe7b547ac3b9181cd Mon Sep 17 00:00:00 2001 From: Sabra Crolleton Date: Sat, 28 Aug 2021 14:31:19 -0400 Subject: [PATCH 04/13] execute-sql files now handles nested comments --- doc/postmodern.html | 138 ++++++++++++------------- doc/postmodern.org | 2 - postmodern/execute-file.lisp | 61 ++++++++++- postmodern/tests/test-execute-file.sql | 3 + 4 files changed, 127 insertions(+), 77 deletions(-) diff --git a/doc/postmodern.html b/doc/postmodern.html index 1ca9eb46..f1d6b18c 100644 --- a/doc/postmodern.html +++ b/doc/postmodern.html @@ -1,7 +1,7 @@ - + Postmodern Reference Manual @@ -246,7 +246,7 @@

Postmodern Reference Manual

Table of Contents

-
-

Overview

-
+
+

Overview

+

This is the reference manual for the component named postmodern, which is part of a library of the same name. @@ -1000,9 +1000,9 @@

macro query (query &rest args/format)

Some Examples:

-
-

Default

-
+
+

Default

+

The default is :lists

@@ -1013,9 +1013,9 @@

Default

-
-

Single

-
+
+

Single

+

Returns a single field. Will throw an error if the queries returns more than one field or more than one row

@@ -1026,9 +1026,9 @@

Single

-
-

List

-
+
+

List

+

Returns a list containing the selected fields. Will throw an error if the query returns more than one row

@@ -1039,9 +1039,9 @@

List

-
-

Lists

-
+
+

Lists

+

This is the default

@@ -1052,9 +1052,9 @@

Lists

-
-

Alist

-
+
+

Alist

+

Returns an alist containing the field name as a keyword and the selected fields. Will throw an error if the query returns more than one row.

@@ -1065,9 +1065,9 @@

Alist

-
-

Str-alist

-
+
+

Str-alist

+

Returns an alist containing the field name as a lower case string and the selected fields. Will throw an error if the query returns more than one row.

@@ -1078,9 +1078,9 @@

Str-alist

-
-

Alists

-
+
+

Alists

+

Returns a list of alists containing the field name as a keyword and the selected fields.

@@ -1092,9 +1092,9 @@

Alists

-
-

Str-alists

-
+
+

Str-alists

+

Returns a list of alists containing the field name as a lower case string and the selected fields.

@@ -1106,9 +1106,9 @@

Str-alists

-
-

Plist

-
+
+

Plist

+

Returns a plist containing the field name as a keyword and the selected fields. Will throw an error if the query returns more than one row.

@@ -1119,9 +1119,9 @@

Plist

-
-

Plists

-
+
+

Plists

+

Returns a list of plists containing the field name as a keyword and the selected fields.

@@ -1132,9 +1132,9 @@

Plists

-
-

Vectors

-
+
+

Vectors

+

Returns a vector of vectors where each internal vector is a returned row from the query. The field names are not included. NOTE: It will return an empty vector instead of NIL if there is no result.

@@ -1152,9 +1152,9 @@

Vectors

-
-

Array-hash

-
+
+

Array-hash

+

Returns a vector of hashtables where each hash table is a returned row from the query with field name as the key expressed as a lower case string.

@@ -1172,9 +1172,9 @@

Array-hash

-
-

Dao

-
+
+

Dao

+

Returns a list of daos of the type specified

@@ -1188,9 +1188,9 @@

Dao

-
-

Column

-
+
+

Column

+

Returns a list of field values of a single field. Will throw an error if more than one field is selected

@@ -1204,9 +1204,9 @@

Column

-
-

Json-strs

-
+
+

Json-strs

+

Return a list of strings where the row returned is a json object expressed as a string

@@ -1244,9 +1244,9 @@

Json-strs

-
-

Json-str

-
+
+

Json-str

+

Return a single string where the row returned is a json object expressed as a string

@@ -1261,9 +1261,9 @@

Json-str

-
-

Json-array-str

-
+
+

Json-array-str

+

Return a string containing a json array, each element in the array is a selected row expressed as a json object. NOTE: If there is no result, this will return a string with an empty json array.

@@ -1280,9 +1280,9 @@

Json-array-str

-
-

Second value returned

-
+
+

Second value returned

+

If the database returns information about the amount rows that were affected, such as with updating or deleting queries, this is returned as a second value. @@ -2332,9 +2332,9 @@

function add-comment (type name comment &optio

-
-

find-comments (type identifier)

-
+
+

find-comments (type identifier)

+

Returns the comments attached to a particular database object. The allowed types are :database :schema :table :columns (all the columns in a table) @@ -3507,9 +3507,9 @@

function rename-table (old-name new-name)

-
-

function rename-column (table-name old-name new-name)

-
+
+

function rename-column (table-name old-name new-name)

+

→ boolean

@@ -3696,10 +3696,6 @@

function execute-file (filename &optional (pr print the count of the query and the query to the REPL.

-

-This function does not handle nested multiple line comments. -

-

IMPORTANT NOTE: This utility function assumes that the file containing the sql queries can be trusted and bypasses the normal postmodern parameterization of diff --git a/doc/postmodern.org b/doc/postmodern.org index a159a247..5b12b430 100644 --- a/doc/postmodern.org +++ b/doc/postmodern.org @@ -2188,8 +2188,6 @@ the test file test-execute-file-broken-transaction.sql as an example. For debugging purposes, if the optional print parameter is set to t, format will print the count of the query and the query to the REPL. -This function does not handle nested multiple line comments. - IMPORTANT NOTE: This utility function assumes that the file containing the sql queries can be trusted and bypasses the normal postmodern parameterization of queries. diff --git a/postmodern/execute-file.lisp b/postmodern/execute-file.lisp index 9bebdb29..aa23be91 100644 --- a/postmodern/execute-file.lisp +++ b/postmodern/execute-file.lisp @@ -1,6 +1,61 @@ ;;;; -*- Mode: LISP; Syntax: Ansi-Common-Lisp; Base: 10; Package: POSTMODERN; -*- (in-package :postmodern) +(defstruct mlc-parser + buffer + (stream (make-string-output-stream)) + (state :base) + (count 0)) ; nest levels. > 0 indicates already in at least one comment + +;; comments begin with /* and end with */ +;; possible states: +;; :base +;; :mlc (already in a multiline comment) +;; :mb (maybe beginning a new multiline comment) +;; :me (maybe ending a multiline comment) + +(defun mlc-parse-query (str &optional (state (make-mlc-parser))) + (loop for char across str + do + (case char + (#\/ (case (mlc-parser-state state) + (:base (setf (mlc-parser-state state) :mb)) + (:mb ; faked beginning, return to earlier state (:base or :mlc) + (if (> (mlc-parser-count state) 0) + (setf (mlc-parser-state state) :mlc) + (progn + (setf (mlc-parser-state state) :base) + (write-char #\/ (mlc-parser-stream state)) + (write-char #\/ (mlc-parser-stream state))))) + (:mlc (setf (mlc-parser-state state) :mb)) + (:me ; actual ending of a comment + (decf (mlc-parser-count state)) + (if (> (mlc-parser-count state) 0) + (progn ; ending nested comment decrement and return to :mlc + (setf (mlc-parser-state state) :mlc)) + (progn ; ending only comment level, decrement and return to :base + (setf (mlc-parser-state state) :base)))))) + (#\* (case (mlc-parser-state state) + (:base (write-char char (mlc-parser-stream state))) + (:mb (progn ; actual beginning, increment count, set :mlc + (setf (mlc-parser-state state) :mlc) + (incf (mlc-parser-count state)))) + (:mlc (setf (mlc-parser-state state) :me)) + (:me (setf (mlc-parser-state state) :mlc)))) + + (otherwise (case (mlc-parser-state state) + (:base + (write-char char (mlc-parser-stream state))) + (:mb + (if (> (mlc-parser-count state) 0) + (setf (mlc-parser-state state) :mlc) + (progn + (setf (mlc-parser-state state) :base) + (write-char char (mlc-parser-stream state))))) + (:me (setf (mlc-parser-state state) :mlc))))) + :finally (return + (get-output-stream-string (mlc-parser-stream state))))) + (defstruct parser filename (stream (make-string-output-stream)) @@ -240,10 +295,8 @@ should return (defun read-queries (filename) "Read SQL queries in given file and split them, returns a list" - (parse-queries (cl-ppcre:regex-replace-all - multi-line-comment-scanner - (get-output-stream-string (read-lines filename)) - ""))) + (parse-queries (mlc-parse-query + (get-output-stream-string (read-lines filename))))) (defun execute-file (pathname &optional (print nil)) "This function will execute sql queries stored in a file. Each sql statement diff --git a/postmodern/tests/test-execute-file.sql b/postmodern/tests/test-execute-file.sql index 27106cab..ddcbc4c3 100644 --- a/postmodern/tests/test-execute-file.sql +++ b/postmodern/tests/test-execute-file.sql @@ -22,6 +22,9 @@ insert into company_employees (id,name,age,address,salary,join_date) values (4, insert into company_employees (id,name,age,address,salary,join_date) values (5, 'susan', 32, 'Vancouver', 20100.00,'2009-07-13'); /* ;test comment 4 (asterisk in second line of multiline comment) * with multiple lines;; + /* test' comment 4-1 + with multiple lines + */ * did I say something wrong? */ insert into company_employees (id,name,age,address,salary,join_date) values (6, 'johanna', 32, 'Berlin', 20000.00,'2011-03-13'); From 3b3685c73619251d46553e36a52ee3668f10362e Mon Sep 17 00:00:00 2001 From: Sabra Crolleton Date: Sat, 28 Aug 2021 20:06:54 -0400 Subject: [PATCH 05/13] Correct execute-file for multiple asterisks Sigh. Yet another bug stomped in my parser. Greatful thanks to Florine. --- postmodern/execute-file.lisp | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/postmodern/execute-file.lisp b/postmodern/execute-file.lisp index aa23be91..29d90af9 100644 --- a/postmodern/execute-file.lisp +++ b/postmodern/execute-file.lisp @@ -41,7 +41,7 @@ (setf (mlc-parser-state state) :mlc) (incf (mlc-parser-count state)))) (:mlc (setf (mlc-parser-state state) :me)) - (:me (setf (mlc-parser-state state) :mlc)))) + (:me (setf (mlc-parser-state state) :me)))) (otherwise (case (mlc-parser-state state) (:base @@ -253,11 +253,6 @@ should return (unless (eq :eat (parser-state state)) (error e))))) -;; For multiple unnested multi-line comments in the same string. -;; Does not handle nested multi-line comments. -(defparameter multi-line-comment-scanner - (cl-ppcre:create-scanner "/[*].*?[*]/" :single-line-mode t)) - (defparameter single-line-comment-scanner (cl-ppcre:create-scanner "--.*")) From 5db7b0f3fba3e600e66fa4507a75f4cc21d4feb8 Mon Sep 17 00:00:00 2001 From: Sabra Crolleton Date: Mon, 30 Aug 2021 16:33:36 -0400 Subject: [PATCH 06/13] restructuring comment stripping in sql files When trying to execute sql files, strip any sql comments first. --- postmodern/execute-file.lisp | 121 +++++++++++++----------- postmodern/tests/tef-1.sql | 11 +++ postmodern/tests/tef-2.sql | 5 + postmodern/tests/test-execute-file.lisp | 2 +- postmodern/tests/test-execute-file.sql | 15 ++- 5 files changed, 95 insertions(+), 59 deletions(-) create mode 100644 postmodern/tests/tef-1.sql create mode 100644 postmodern/tests/tef-2.sql diff --git a/postmodern/execute-file.lisp b/postmodern/execute-file.lisp index 29d90af9..78d800e0 100644 --- a/postmodern/execute-file.lisp +++ b/postmodern/execute-file.lisp @@ -16,46 +16,58 @@ (defun mlc-parse-query (str &optional (state (make-mlc-parser))) (loop for char across str - do - (case char - (#\/ (case (mlc-parser-state state) - (:base (setf (mlc-parser-state state) :mb)) - (:mb ; faked beginning, return to earlier state (:base or :mlc) - (if (> (mlc-parser-count state) 0) - (setf (mlc-parser-state state) :mlc) - (progn - (setf (mlc-parser-state state) :base) - (write-char #\/ (mlc-parser-stream state)) - (write-char #\/ (mlc-parser-stream state))))) - (:mlc (setf (mlc-parser-state state) :mb)) - (:me ; actual ending of a comment - (decf (mlc-parser-count state)) - (if (> (mlc-parser-count state) 0) - (progn ; ending nested comment decrement and return to :mlc - (setf (mlc-parser-state state) :mlc)) - (progn ; ending only comment level, decrement and return to :base - (setf (mlc-parser-state state) :base)))))) - (#\* (case (mlc-parser-state state) - (:base (write-char char (mlc-parser-stream state))) - (:mb (progn ; actual beginning, increment count, set :mlc - (setf (mlc-parser-state state) :mlc) - (incf (mlc-parser-count state)))) - (:mlc (setf (mlc-parser-state state) :me)) - (:me (setf (mlc-parser-state state) :me)))) - - (otherwise (case (mlc-parser-state state) - (:base - (write-char char (mlc-parser-stream state))) - (:mb - (if (> (mlc-parser-count state) 0) - (setf (mlc-parser-state state) :mlc) - (progn - (setf (mlc-parser-state state) :base) - (write-char char (mlc-parser-stream state))))) - (:me (setf (mlc-parser-state state) :mlc))))) + do + (case char + (#\/ (case (mlc-parser-state state) + (:base (setf (mlc-parser-state state) :mb)) + (:mb ; faked beginning, return to earlier state (:base or :mlc) + (if (> (mlc-parser-count state) 0) + (setf (mlc-parser-state state) :mlc) + (progn + (setf (mlc-parser-state state) :base) + (write-char #\/ (mlc-parser-stream state)) + (write-char #\/ (mlc-parser-stream state))))) + (:mlc (setf (mlc-parser-state state) :mb)) + (:me ; actual ending of a comment + (decf (mlc-parser-count state)) + (if (> (mlc-parser-count state) 0) + (progn ; ending nested comment decrement and return to :mlc + (setf (mlc-parser-state state) :mlc)) + (progn ; ending only comment level, decrement and return to :base + (setf (mlc-parser-state state) :base)))))) + (#\* (case (mlc-parser-state state) + (:base (write-char char (mlc-parser-stream state))) + (:mb (progn ; actual beginning, increment count, set :mlc + (setf (mlc-parser-state state) :mlc) + (incf (mlc-parser-count state)))) + (:mlc (setf (mlc-parser-state state) :me)) + (:me (setf (mlc-parser-state state) :me)))) + + (otherwise (case (mlc-parser-state state) + (:base + (write-char char (mlc-parser-stream state))) + (:mb + (if (> (mlc-parser-count state) 0) + (setf (mlc-parser-state state) :mlc) + (progn + (setf (mlc-parser-state state) :base) + (write-char char (mlc-parser-stream state))))) + (:me (setf (mlc-parser-state state) :mlc))))) :finally (return (get-output-stream-string (mlc-parser-stream state))))) +(defparameter single-line-comment-scanner + (cl-ppcre:create-scanner "--.*")) + +(defun strip-sql-comments (str) + "Take a string input, replace all the multi-line comments, then +replace the single line comments, returning the resulting string." + (cl-ppcre::regex-replace-all + single-line-comment-scanner + (mlc-parse-query + str) + "")) + (defstruct parser filename (stream (make-string-output-stream)) @@ -253,13 +265,11 @@ should return (unless (eq :eat (parser-state state)) (error e))))) -(defparameter single-line-comment-scanner - (cl-ppcre:create-scanner "--.*")) - -(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) +(defun read-lines (filename &optional (included-files nil) (q (make-string-output-stream)) ) + "Read a given file and strip the comments. Read lines from the redacted result +and and return them in a stream. Recursively apply \i include instructions." + (with-input-from-string + (s (strip-sql-comments (alexandria:read-file-into-string filename))) (loop for line = (read-line s nil) while line @@ -270,28 +280,29 @@ should return (let ((include-filename (merge-pathnames (subseq line 3) (directory-namestring filename)))) - (read-lines include-filename q)) - (progn - (setf line (cl-ppcre::regex-replace - single-line-comment-scanner - line - "")) ; drop single line comments - (format q "~a~%" line))) + (when (not (member include-filename included-files)) + (push include-filename included-files) + (read-lines include-filename included-files q ))) + (format q "~a~%" line)) finally (return q)))) (defun parse-queries (file-content) "Read SQL queries in given string and split them, returns a list" (with-input-from-string (s (concatenate 'string file-content ";")) (let ((whitespace '(#\Space #\Tab #\Newline #\Linefeed #\Page #\Return))) - (flet ((emptyp (query) (every (alexandria:rcurry #'member whitespace) query))) + (flet ((emptyp (query) + (every (alexandria:rcurry #'member whitespace) query))) (loop :for query := (parse-query s) :while (and query (not (emptyp query))) :collect query))))) (defun read-queries (filename) - "Read SQL queries in given file and split them, returns a list" - (parse-queries (mlc-parse-query - (get-output-stream-string (read-lines filename))))) + "Read SQL queries in given file and split them, returns a list. Track included +files so there is no accidental infinite loop." + (let ((included-files nil)) + (parse-queries + (get-output-stream-string + (read-lines filename included-files))))) (defun execute-file (pathname &optional (print nil)) "This function will execute sql queries stored in a file. Each sql statement diff --git a/postmodern/tests/tef-1.sql b/postmodern/tests/tef-1.sql new file mode 100644 index 00000000..011b0802 --- /dev/null +++ b/postmodern/tests/tef-1.sql @@ -0,0 +1,11 @@ +/* test' comment tef-1-1 +with multiple lines + --*/ + + insert into company_employees (id,name,age,address,salary,join_date) values (7, 'robert', 32, 'Paris', 20000.00,'2011-04-13'); + +/* +\i tef-2.sql +*/ + +\i tef-1.sql diff --git a/postmodern/tests/tef-2.sql b/postmodern/tests/tef-2.sql new file mode 100644 index 00000000..4f12c61e --- /dev/null +++ b/postmodern/tests/tef-2.sql @@ -0,0 +1,5 @@ +/* test' comment tef-2-1 +with multiple lines + --*/ + + insert into company_employees (id,name,age,address,salary,join_date) values (8, 'Juan', 32, 'Madrid', 22000.00,'2011-04-13'); diff --git a/postmodern/tests/test-execute-file.lisp b/postmodern/tests/test-execute-file.lisp index 4647b623..0111b1d9 100644 --- a/postmodern/tests/test-execute-file.lisp +++ b/postmodern/tests/test-execute-file.lisp @@ -18,7 +18,7 @@ (pomo:execute-file good-file) (is (table-exists-p 'company-employees)) (is (equal "paul" (query (:select 'name :from 'company-employees :where (:= 'id 1)) :single))) - (is (equal 6 (query (:select (:count 'id) :from 'company-employees) :single))) + (is (equal 7 (query (:select (:count 'id) :from 'company-employees) :single))) (query (:drop-table :if-exists 'company-employees :cascade)))) (test broken-execute-file diff --git a/postmodern/tests/test-execute-file.sql b/postmodern/tests/test-execute-file.sql index ddcbc4c3..70a8ae0e 100644 --- a/postmodern/tests/test-execute-file.sql +++ b/postmodern/tests/test-execute-file.sql @@ -13,18 +13,27 @@ insert into company_employees (id,name,age,address,salary,join_date) values (1, insert into company_employees (id,name,age,address,salary,join_date) values (2, 'ziad', 32, 'Beirut', 20000.00,'2003-03-13'); /* test' comment 2 with multiple lines + --*/ +/* +/* + */ -insert into company_employees (id,name,age,address,salary,join_date) values (3, 'john', 32, 'Toronto', 20100.00,'2005-07-13'); + ***/ +\i tef-1.sql + + insert into company_employees (id,name,age,address,salary,join_date) values (3, 'john', 32, 'Toronto', 20100.00,'2005-07-13'); + -- Yet another comments insert into company_employees (id,name,age,address,salary,join_date) values (4, 'yasmin', 32, 'Mumbai', 20000.00,'2007-03-13'); /* ;test comment 3 (asterisk in /second/ line of multiline comment) * with multiple lines;; */ insert into company_employees (id,name,age,address,salary,join_date) values (5, 'susan', 32, 'Vancouver', 20100.00,'2009-07-13'); /* ;test comment 4 (asterisk in second line of multiline comment) - * with multiple lines;; + *** with multiple lines;; /* test' comment 4-1 with multiple lines + /***/ */ * did I say something wrong? -*/ +--*/ insert into company_employees (id,name,age,address,salary,join_date) values (6, 'johanna', 32, 'Berlin', 20000.00,'2011-03-13'); From a9dc4f4262304e75cef0ec5f69c4c6f56f3854e6 Mon Sep 17 00:00:00 2001 From: Sabra Crolleton Date: Mon, 6 Sep 2021 21:01:33 -0400 Subject: [PATCH 07/13] Fixed some shortcomings in execute-file Certain characters in sql comments would cause execute-file to fail. This commit fixes that and provides additional flexibility and safeguards. Execute-file now strips single and multi-line comments from sql files first before trying to parse them. The existing parsing code is untouched with this commit. This commit adds \include and \include_relative and follows the Postgresql practice that \i (and \include) and \ir (and \include_relative) resolve differently. Specifically \i or \include which look for a file location relative to your default pathname (current working directory) or \ir or \include_relative which look for a file location relative to the initial sql file. If the file is not found in the expected location, execute-file will look to see if the requested file is in the other command location. In other words, if not found where \i would expect it, is the file in the location that \ir would expect it? If the file is not found in either location, a restart will be triggered which allows you to provide a new name (including pathname) for the file. Execute-file now allows more flexibility in formatting in that preceding spaces or tabs are now ignored at the beginning of an inclusion meta-command line or excess spaces or tabs between the meta-command and the filename of the file to be included. Execute-file now tracks the files which have been included and will not include a file twice (which would lead to infinite loops). --- doc/postmodern.html | 144 +++++---- doc/postmodern.org | 8 + postmodern/execute-file.lisp | 294 ++++++++++++------ postmodern/tests/sub1/tef-4.sql | 5 + postmodern/tests/sub1/tef-5.sql | 5 + postmodern/tests/sub1/tef-7.sql | 5 + postmodern/tests/tef-1.sql | 4 +- postmodern/tests/tef-2.sql | 2 +- postmodern/tests/tef-3.sql | 5 + postmodern/tests/tef-6.sql | 5 + postmodern/tests/test-execute-file.lisp | 28 +- postmodern/tests/test-execute-file.sql | 23 +- .../tests/test-fail-include-execute-file.sql | 33 ++ 13 files changed, 381 insertions(+), 180 deletions(-) create mode 100644 postmodern/tests/sub1/tef-4.sql create mode 100644 postmodern/tests/sub1/tef-5.sql create mode 100644 postmodern/tests/sub1/tef-7.sql create mode 100644 postmodern/tests/tef-3.sql create mode 100644 postmodern/tests/tef-6.sql create mode 100644 postmodern/tests/test-fail-include-execute-file.sql diff --git a/doc/postmodern.html b/doc/postmodern.html index f1d6b18c..18a282dd 100644 --- a/doc/postmodern.html +++ b/doc/postmodern.html @@ -1,7 +1,7 @@ - + Postmodern Reference Manual @@ -246,7 +246,7 @@

Postmodern Reference Manual

Table of Contents

-
-

Overview

-
+
+

Overview

+

This is the reference manual for the component named postmodern, which is part of a library of the same name. @@ -1000,9 +1000,9 @@

macro query (query &rest args/format)

Some Examples:

-
-

Default

-
+
+

Default

+

The default is :lists

@@ -1013,9 +1013,9 @@

Default

-
-

Single

-
+
+

Single

+

Returns a single field. Will throw an error if the queries returns more than one field or more than one row

@@ -1026,9 +1026,9 @@

Single

-
-

List

-
+
+

List

+

Returns a list containing the selected fields. Will throw an error if the query returns more than one row

@@ -1039,9 +1039,9 @@

List

-
-

Lists

-
+
+

Lists

+

This is the default

@@ -1052,9 +1052,9 @@

Lists

-
-

Alist

-
+
+

Alist

+

Returns an alist containing the field name as a keyword and the selected fields. Will throw an error if the query returns more than one row.

@@ -1065,9 +1065,9 @@

Alist

-
-

Str-alist

-
+
+

Str-alist

+

Returns an alist containing the field name as a lower case string and the selected fields. Will throw an error if the query returns more than one row.

@@ -1078,9 +1078,9 @@

Str-alist

-
-

Alists

-
+
+

Alists

+

Returns a list of alists containing the field name as a keyword and the selected fields.

@@ -1092,9 +1092,9 @@

Alists

-
-

Str-alists

-
+
+

Str-alists

+

Returns a list of alists containing the field name as a lower case string and the selected fields.

@@ -1106,9 +1106,9 @@

Str-alists

-
-

Plist

-
+
+

Plist

+

Returns a plist containing the field name as a keyword and the selected fields. Will throw an error if the query returns more than one row.

@@ -1119,9 +1119,9 @@

Plist

-
-

Plists

-
+
+

Plists

+

Returns a list of plists containing the field name as a keyword and the selected fields.

@@ -1132,9 +1132,9 @@

Plists

-
-

Vectors

-
+
+

Vectors

+

Returns a vector of vectors where each internal vector is a returned row from the query. The field names are not included. NOTE: It will return an empty vector instead of NIL if there is no result.

@@ -1152,9 +1152,9 @@

Vectors

-
-

Array-hash

-
+
+

Array-hash

+

Returns a vector of hashtables where each hash table is a returned row from the query with field name as the key expressed as a lower case string.

@@ -1172,9 +1172,9 @@

Array-hash

-
-

Dao

-
+
+

Dao

+

Returns a list of daos of the type specified

@@ -1188,9 +1188,9 @@

Dao

-
-

Column

-
+
+

Column

+

Returns a list of field values of a single field. Will throw an error if more than one field is selected

@@ -1204,9 +1204,9 @@

Column

-
-

Json-strs

-
+
+

Json-strs

+

Return a list of strings where the row returned is a json object expressed as a string

@@ -1244,9 +1244,9 @@

Json-strs

-
-

Json-str

-
+
+

Json-str

+

Return a single string where the row returned is a json object expressed as a string

@@ -1261,9 +1261,9 @@

Json-str

-
-

Json-array-str

-
+
+

Json-array-str

+

Return a string containing a json array, each element in the array is a selected row expressed as a json object. NOTE: If there is no result, this will return a string with an empty json array.

@@ -1280,9 +1280,9 @@

Json-array-str

-
-

Second value returned

-
+
+

Second value returned

+

If the database returns information about the amount rows that were affected, such as with updating or deleting queries, this is returned as a second value. @@ -2332,9 +2332,9 @@

function add-comment (type name comment &optio

-
-

find-comments (type identifier)

-
+
+

find-comments (type identifier)

+

Returns the comments attached to a particular database object. The allowed types are :database :schema :table :columns (all the columns in a table) @@ -3507,9 +3507,9 @@

function rename-table (old-name new-name)

-
-

function rename-column (table-name old-name new-name)

-
+
+

function rename-column (table-name old-name new-name)

+

→ boolean

@@ -3684,6 +3684,16 @@

function execute-file (filename &optional (pr statement will have been commited.

+

+Execute-file allows the sql file to include other sql files, with the +meta-commands \i or \include which look for a file location relative to your +default pathname (current working directory) or \ir or \include_relative which +look for a file location relative to the initial sql file. If the file is not +found in the expected location, execute-file will look to see if the requested +file is in the other possible location. If that does not work, it will trigger +an error with a restart which allows you to provide a new name for the file. +

+

If you want the standard transction treatment such that all statements succeed or no statement succeeds, then ensure that the file starts with a "begin diff --git a/doc/postmodern.org b/doc/postmodern.org index 5b12b430..21ae956a 100644 --- a/doc/postmodern.org +++ b/doc/postmodern.org @@ -2180,6 +2180,14 @@ the file will be run independently, but if one statement fails, subsequent query statements will not be run, but any statement prior to the failing statement will have been commited. +Execute-file allows the sql file to include other sql files, with the +meta-commands \i or \include which look for a file location relative to your +default pathname (current working directory) or \ir or \include_relative which +look for a file location relative to the initial sql file. If the file is not +found in the expected location, execute-file will look to see if the requested +file is in the other possible location. If that does not work, it will trigger +an error with a restart which allows you to provide a new name for the file. + If you want the standard transction treatment such that all statements succeed or no statement succeeds, then ensure that the file starts with a "begin transaction" statement and finishes with an "end transaction" statement. See diff --git a/postmodern/execute-file.lisp b/postmodern/execute-file.lisp index 78d800e0..85ffd1be 100644 --- a/postmodern/execute-file.lisp +++ b/postmodern/execute-file.lisp @@ -1,73 +1,6 @@ ;;;; -*- Mode: LISP; Syntax: Ansi-Common-Lisp; Base: 10; Package: POSTMODERN; -*- (in-package :postmodern) -(defstruct mlc-parser - buffer - (stream (make-string-output-stream)) - (state :base) - (count 0)) ; nest levels. > 0 indicates already in at least one comment - -;; comments begin with /* and end with */ -;; possible states: -;; :base -;; :mlc (already in a multiline comment) -;; :mb (maybe beginning a new multiline comment) -;; :me (maybe ending a multiline comment) - -(defun mlc-parse-query (str &optional (state (make-mlc-parser))) - (loop for char across str - do - (case char - (#\/ (case (mlc-parser-state state) - (:base (setf (mlc-parser-state state) :mb)) - (:mb ; faked beginning, return to earlier state (:base or :mlc) - (if (> (mlc-parser-count state) 0) - (setf (mlc-parser-state state) :mlc) - (progn - (setf (mlc-parser-state state) :base) - (write-char #\/ (mlc-parser-stream state)) - (write-char #\/ (mlc-parser-stream state))))) - (:mlc (setf (mlc-parser-state state) :mb)) - (:me ; actual ending of a comment - (decf (mlc-parser-count state)) - (if (> (mlc-parser-count state) 0) - (progn ; ending nested comment decrement and return to :mlc - (setf (mlc-parser-state state) :mlc)) - (progn ; ending only comment level, decrement and return to :base - (setf (mlc-parser-state state) :base)))))) - (#\* (case (mlc-parser-state state) - (:base (write-char char (mlc-parser-stream state))) - (:mb (progn ; actual beginning, increment count, set :mlc - (setf (mlc-parser-state state) :mlc) - (incf (mlc-parser-count state)))) - (:mlc (setf (mlc-parser-state state) :me)) - (:me (setf (mlc-parser-state state) :me)))) - - (otherwise (case (mlc-parser-state state) - (:base - (write-char char (mlc-parser-stream state))) - (:mb - (if (> (mlc-parser-count state) 0) - (setf (mlc-parser-state state) :mlc) - (progn - (setf (mlc-parser-state state) :base) - (write-char char (mlc-parser-stream state))))) - (:me (setf (mlc-parser-state state) :mlc))))) - :finally (return - (get-output-stream-string (mlc-parser-stream state))))) - -(defparameter single-line-comment-scanner - (cl-ppcre:create-scanner "--.*")) - -(defun strip-sql-comments (str) - "Take a string input, replace all the multi-line comments, then -replace the single line comments, returning the resulting string." - (cl-ppcre::regex-replace-all - single-line-comment-scanner - (mlc-parse-query - str) - "")) - (defstruct parser filename (stream (make-string-output-stream)) @@ -265,26 +198,201 @@ should return (unless (eq :eat (parser-state state)) (error e))))) -(defun read-lines (filename &optional (included-files nil) (q (make-string-output-stream)) ) +(defstruct mlc-parser + buffer + (stream (make-string-output-stream)) + (state :base) + (count 0)) ; nest levels. > 0 indicates already in at least one comment + +;; comments begin with /* and end with */ +;; possible states: +;; :base +;; :mlc (already in a multiline comment) +;; :mb (maybe beginning a new multiline comment) +;; :me (maybe ending a multiline comment) + +(defun mlc-parse-query (str &optional (state (make-mlc-parser))) + (loop for char across str + do + (case char + (#\/ (case (mlc-parser-state state) + (:base (setf (mlc-parser-state state) :mb)) + (:mb ; faked beginning, return to earlier state (:base or :mlc) + (if (> (mlc-parser-count state) 0) + (progn + (setf (mlc-parser-state state) :mlc)) + (progn + (setf (mlc-parser-state state) :base) + (write-char #\/ (mlc-parser-stream state)) + (write-char #\/ (mlc-parser-stream state))))) + (:mlc (setf (mlc-parser-state state) :mb)) + (:me ; actual ending of a comment + (decf (mlc-parser-count state)) + (if (> (mlc-parser-count state) 0) + (progn ; ending nested comment decrement and return to :mlc + (setf (mlc-parser-state state) :mlc)) + (progn ; ending only comment level, decrement and return to :base + (setf (mlc-parser-state state) :base)))))) + (#\* (case (mlc-parser-state state) + (:base (write-char char (mlc-parser-stream state))) + (:mb (progn ; actual beginning, increment count, set :mlc + (setf (mlc-parser-state state) :mlc) + (incf (mlc-parser-count state)))) + (:mlc (setf (mlc-parser-state state) :me)) + (:me (setf (mlc-parser-state state) :me)))) + + (otherwise (case (mlc-parser-state state) + (:base + (write-char char (mlc-parser-stream state))) + (:mb + (if (> (mlc-parser-count state) 0) + (setf (mlc-parser-state state) :mlc) + (progn + (write-char #\/ (mlc-parser-stream state)) + (setf (mlc-parser-state state) :base) + (write-char char (mlc-parser-stream state))))) + (:me (setf (mlc-parser-state state) :mlc))))) + :finally (return + (get-output-stream-string (mlc-parser-stream state))))) + +(defparameter single-line-comment-scanner + (cl-ppcre:create-scanner "--.*")) + +(defun remove-sql-comments (str) + "Take a string input, replace all the multi-line comments, then +replace the single line comments, returning the resulting string." + (cl-ppcre::regex-replace-all + single-line-comment-scanner + (mlc-parse-query + str) + "")) + +(define-condition missing-i-file (error) + ((%filename :reader filename :initarg :filename) + (%base-filename :reader base-filename :initarg :base-filename) + ($meta-cmd :reader meta-cmd :initarg :meta-cmd)) + (:report (lambda (condition stream) + (format stream "We tried but failed to find file ~a at the location +specified by the ~a meta command. + +Note that meta-commands \\i or \\include in the sql file look for a file location +relative to your default pathname (current working directory), in this case: +~a. + +Meta-commandsd \\ir or \\include_relative look for a file location relative to the +initial sql file, in this case: +~a. + + As a fallback, we also looked for it where the ~a meta command would have specified. +Can you double check that the file actually exists where it is supposed to be?" + (filename condition) + (if (eq (meta-cmd condition) 'i) + "\\i or \\include" + "\\ir or \\include_relative") + (uiop::get-pathname-defaults) + (directory-namestring (base-filename condition)) + (if (eq (meta-cmd condition) 'i) + "\\ir or \\include_relative" + "\\i or \\include"))))) + +(defun line-has-includes (line) + "Returns 'i if the first characters in a line are the postgresql include file +commands: \i or \include. Returns 'ir if the first characters in a line are postgresql +include commands \ir or \include_relative. Returns nil otherwise." + (setf line (string-trim '(#\space #\tab) line)) + (cond ((and (> (length line) 3) + (string= "\\i " (subseq line 0 3))) + (values 'i (string-trim '(#\space #\tab) (subseq line 3)))) + ((and (> (length line) 9) + (string= "\\include " (subseq line 0 9))) + (values 'i (string-trim '(#\space #\tab) (subseq line 9)))) + ((and (> (length line) 4) + (string= "\\ir " (subseq line 0 4))) + (values 'ir (string-trim '(#\space #\tab) (subseq line 4)))) + ((and (> (length line) 18) + (string= "\\include_relative " (subseq line 0 18))) + (values 'ir (string-trim '(#\space #\tab) (subseq line 18)))) + (t nil))) + +(defun find-included-filename (meta-cmd new-filename base-filename) + "Create full pathname if included using a \ir metacommand or \include_relative." + (when new-filename + (restart-case + (let ((relative-pathname (merge-pathnames new-filename + (directory-namestring base-filename))) + (working-pathname (merge-pathnames new-filename + (uiop::get-pathname-defaults)))) + (cond ((and (eq meta-cmd 'ir) + (uiop:file-exists-p relative-pathname)) + relative-pathname) + ((and (eq meta-cmd 'i) + (uiop:file-exists-p working-pathname)) + working-pathname) + ((and (eq meta-cmd 'ir) + (uiop:file-exists-p working-pathname)) + (warn + (format nil "Using fallback to find file based on working directory position")) + working-pathname) + ((and (eq meta-cmd 'i) + (uiop:file-exists-p relative-pathname)) + (warn + (format nil "Using fallback to find file based on relative directory position")) + relative-pathname) + (t (error 'missing-i-file :meta-cmd meta-cmd + :filename new-filename :base-filename base-filename)))) + (use-other-values (new-full-filename) + :report "Use a different filename location to be included." + :interactive (lambda () + (flet ((get-value () + (format t "~&Enter new value for sql file to be included: ") + (read-line))) + (list (string (get-value))))) + (find-included-filename meta-cmd new-full-filename base-filename))))) + + +(defun read-sql-file (filename &optional (included-files nil) (q (make-string-output-stream)) ) "Read a given file and strip the comments. Read lines from the redacted result and and return them in a stream. Recursively apply \i include instructions." - (with-input-from-string - (s (strip-sql-comments (alexandria:read-file-into-string filename))) - (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)))) - (when (not (member include-filename included-files)) - (push include-filename included-files) - (read-lines include-filename included-files q ))) - (format q "~a~%" line)) - finally (return q)))) + (if (uiop:file-exists-p filename) + (with-input-from-string + (s (remove-sql-comments (alexandria:read-file-into-string filename))) + (loop + for line = (read-line s nil) + while line + do + (multiple-value-bind (meta-cmd new-filename) + (line-has-includes line) + (cond ((or (eq meta-cmd 'i) + (eq meta-cmd 'ir)) + (let ((include-filename + (find-included-filename meta-cmd new-filename filename))) + (when new-filename + (if (not (member include-filename included-files)) + (progn + (push include-filename included-files) + (read-sql-file include-filename included-files q)) + (progn + (warn + (format nil + "~a: Duplicate attempts to include sql files ~a skipped~%" + *package* filename)) + ""))))) + (t (format q "~a~%" line)))) + finally (return q))) + (warn (format nil "~a: file ~a doesn't seem to exist. If this was supposed to be an included file, please note that \\i looks for a file location relative to your default pathname, in this case ~a. \\ir looks for a file location relative to the initial included file location, in the case ~a~%" + *package* filename + (uiop::get-pathname-defaults) + (if filename + (directory-namestring filename) + nil)) + ""))) + +(defun read-queries (filename) + "Read SQL queries in given file and split them, returns a list. Track included +files so there is no accidental infinite loop." + (parse-queries + (get-output-stream-string + (read-sql-file filename)))) (defun parse-queries (file-content) "Read SQL queries in given string and split them, returns a list" @@ -296,20 +404,20 @@ and and return them in a stream. Recursively apply \i include instructions." :while (and query (not (emptyp query))) :collect query))))) -(defun read-queries (filename) - "Read SQL queries in given file and split them, returns a list. Track included -files so there is no accidental infinite loop." - (let ((included-files nil)) - (parse-queries - (get-output-stream-string - (read-lines filename included-files))))) - (defun execute-file (pathname &optional (print nil)) "This function will execute sql queries stored in a file. Each sql statement in the file will be run independently, but if one statement fails, subsequent query statements will not be run, but any statement prior to the failing statement will have been commited. +Execute-file allows the sql file to include other sql files, with the +meta-commands \i or \include which look for a file location relative to your +default pathname (current working directory) or \ir or \include_relative which +look for a file location relative to the initial sql file. If the file is not +found in the expected location, execute-file will look to see if the requested +file is in the other possible location. If that does not work, it will trigger +an error with a restart which allows you to provide a new name for the file. + If you want the standard transction treatment such that all statements succeed or no statement succeeds, then ensure that the file starts with a begin transaction statement and finishes with an end transaction statement. See the diff --git a/postmodern/tests/sub1/tef-4.sql b/postmodern/tests/sub1/tef-4.sql new file mode 100644 index 00000000..b268fad4 --- /dev/null +++ b/postmodern/tests/sub1/tef-4.sql @@ -0,0 +1,5 @@ +/* test' comment tef-4-1 +with multiple lines + --*/ + + insert into company_employees (id,name,age,address,include_file,join_date) values (10, 'Catharina', 32, 'Vienna', 'sub1/tef-4.sql','2011-04-13'); diff --git a/postmodern/tests/sub1/tef-5.sql b/postmodern/tests/sub1/tef-5.sql new file mode 100644 index 00000000..28959f06 --- /dev/null +++ b/postmodern/tests/sub1/tef-5.sql @@ -0,0 +1,5 @@ +/* test' comment tef-5-1 +with multiple lines + --*/ + + insert into company_employees (id,name,age,address,include_file,join_date) values (11, 'Lisa', 32, 'Frankfurt', 'sub1/tef-5.sql','2011-04-13'); diff --git a/postmodern/tests/sub1/tef-7.sql b/postmodern/tests/sub1/tef-7.sql new file mode 100644 index 00000000..6a9e3dc0 --- /dev/null +++ b/postmodern/tests/sub1/tef-7.sql @@ -0,0 +1,5 @@ +/* test' comment tef-7-1 +with multiple lines + --*/ + + insert into company_employees (id,name,age,address,include_file,join_date) values (155, 'Victor', 32, 'Warsaw', 'tef-7.sql','2011-04-13'); diff --git a/postmodern/tests/tef-1.sql b/postmodern/tests/tef-1.sql index 011b0802..05167fea 100644 --- a/postmodern/tests/tef-1.sql +++ b/postmodern/tests/tef-1.sql @@ -2,10 +2,10 @@ with multiple lines --*/ - insert into company_employees (id,name,age,address,salary,join_date) values (7, 'robert', 32, 'Paris', 20000.00,'2011-04-13'); + insert into company_employees (id,name,age,address,include_file,join_date) values (7, 'Robert', 32, 'Paris', 'tef-1.sql','2011-04-13'); /* \i tef-2.sql */ -\i tef-1.sql +-- \i tef-1.sql diff --git a/postmodern/tests/tef-2.sql b/postmodern/tests/tef-2.sql index 4f12c61e..4cc63cab 100644 --- a/postmodern/tests/tef-2.sql +++ b/postmodern/tests/tef-2.sql @@ -2,4 +2,4 @@ with multiple lines --*/ - insert into company_employees (id,name,age,address,salary,join_date) values (8, 'Juan', 32, 'Madrid', 22000.00,'2011-04-13'); + insert into company_employees (id,name,age,address,include_file,join_date) values (8, 'Juan', 32, 'Madrid', 'tef-2.sql','2011-04-13'); diff --git a/postmodern/tests/tef-3.sql b/postmodern/tests/tef-3.sql new file mode 100644 index 00000000..65ef8346 --- /dev/null +++ b/postmodern/tests/tef-3.sql @@ -0,0 +1,5 @@ +/* test' comment tef-3-1 +with multiple lines + --*/ + + insert into company_employees (id,name,age,address,include_file,join_date) values (9, 'Julian', 32, 'Athens', 'tef-3.sql','2011-04-13'); diff --git a/postmodern/tests/tef-6.sql b/postmodern/tests/tef-6.sql new file mode 100644 index 00000000..858a2987 --- /dev/null +++ b/postmodern/tests/tef-6.sql @@ -0,0 +1,5 @@ +/* test' comment tef-6-1 +with multiple lines + --*/ + + insert into company_employees (id,name,age,address,include_file,join_date) values (13, 'Stan', 32, 'Warsaw', 'tef-6.sql','2011-04-13'); diff --git a/postmodern/tests/test-execute-file.lisp b/postmodern/tests/test-execute-file.lisp index 0111b1d9..5803794c 100644 --- a/postmodern/tests/test-execute-file.lisp +++ b/postmodern/tests/test-execute-file.lisp @@ -7,25 +7,30 @@ (in-suite :postmodern-execute-file) -(defparameter good-file (asdf:system-relative-pathname :postmodern "postmodern/tests/test-execute-file.sql")) -(defparameter bad-file (asdf:system-relative-pathname :postmodern "postmodern/tests/test-execute-file-broken.sql")) -(defparameter bad-file-with-transaction (asdf:system-relative-pathname :postmodern "postmodern/tests/test-execute-file-broken-transaction.sql")) +(defparameter *good-file* (asdf:system-relative-pathname :postmodern "postmodern/tests/test-execute-file.sql")) + +(defparameter *first-include-good-file* (asdf:system-relative-pathname :postmodern "postmodern/tests/test-first-include-execute-file.sql")) + +(defparameter *fail-include-file* (asdf:system-relative-pathname :postmodern "postmodern/tests/test-fail-include-execute-file.sql")) + +(defparameter *bad-file* (asdf:system-relative-pathname :postmodern "postmodern/tests/test-execute-file-broken.sql")) +(defparameter *bad-file-with-transaction* (asdf:system-relative-pathname :postmodern "postmodern/tests/test-execute-file-broken-transaction.sql")) (test simple-execute-file (with-test-connection (when (table-exists-p 'company-employees) (query (:drop-table :if-exists 'company-employees :cascade))) - (pomo:execute-file good-file) + (pomo:execute-file *good-file*) (is (table-exists-p 'company-employees)) - (is (equal "paul" (query (:select 'name :from 'company-employees :where (:= 'id 1)) :single))) - (is (equal 7 (query (:select (:count 'id) :from 'company-employees) :single))) + (is (equal "Paul" (query (:select 'name :from 'company-employees :where (:= 'id 1)) :single))) + (is (equal 11 (query (:select (:count 'id) :from 'company-employees) :single))) (query (:drop-table :if-exists 'company-employees :cascade)))) (test broken-execute-file (with-test-connection (when (table-exists-p 'company-employees) (query (:drop-table :if-exists 'company-employees :cascade))) - (signals error (pomo:execute-file bad-file)) + (signals error (pomo:execute-file *bad-file*)) (is (table-exists-p 'company-employees)) (is (equal "paul" (query (:select 'name :from 'company-employees :where (:= 'id 1)) :single))) ;; the bad-file should stop executing on the attempt to insert a record with the same id as the first insertion @@ -36,7 +41,14 @@ (with-test-connection (when (table-exists-p 'company-employees) (query (:drop-table :if-exists 'company-employees :cascade))) - (signals error (pomo:execute-file bad-file-with-transaction))) + (signals error (pomo:execute-file *bad-file-with-transaction*))) (with-test-connection (is (not (table-exists-p 'company-employees))) (query (:drop-table :if-exists 'company-employees :cascade)))) + +(test fail-include-execute-file + (with-test-connection + (when (table-exists-p 'company-employees) + (query (:drop-table :if-exists 'company-employees :cascade))) + (signals error (pomo:execute-file *fail-include-file*)) + (query (:drop-table :if-exists 'company-employees :cascade)))) diff --git a/postmodern/tests/test-execute-file.sql b/postmodern/tests/test-execute-file.sql index 70a8ae0e..0e969f6c 100644 --- a/postmodern/tests/test-execute-file.sql +++ b/postmodern/tests/test-execute-file.sql @@ -5,12 +5,12 @@ create table company_employees( name text not null, age int not null, address char(50), - salary real, + include_file text, join_date date ); -- ;Test comment 1;; -insert into company_employees (id,name,age,address,salary,join_date) values (1, 'paul', 32, 'London', 20100.00,'2001-07-13'); -insert into company_employees (id,name,age,address,salary,join_date) values (2, 'ziad', 32, 'Beirut', 20000.00,'2003-03-13'); +insert into company_employees (id,name,age,address,include_file,join_date) values (1, 'Paul', 32, 'London', 'test-execute-file','2001-07-13'); +insert into company_employees (id,name,age,address,include_file,join_date) values (2, 'Ziad', 32, 'Beirut', 'test-execute-file','2003-03-13'); /* test' comment 2 with multiple lines --*/ @@ -18,16 +18,21 @@ with multiple lines /* */ - ***/ -\i tef-1.sql +***/ + --\i ./postmodern/tests/tef-11.sql +\i tef-1.sql -- an included file, will need to use fallback to find it +\ir tef-6.sql -- an included file using file location relative to this file + \ir tef-3.sql +\i sub1/tef-4.sql +\ir ./sub1/tef-5.sql - insert into company_employees (id,name,age,address,salary,join_date) values (3, 'john', 32, 'Toronto', 20100.00,'2005-07-13'); + insert into company_employees (id,name,age,address,include_file,join_date) values (3, 'John', 32, 'Toronto', 'test-execute-file','2005-07-13'); -- Yet another comments -insert into company_employees (id,name,age,address,salary,join_date) values (4, 'yasmin', 32, 'Mumbai', 20000.00,'2007-03-13'); +insert into company_employees (id,name,age,address,include_file,join_date) values (4, 'Yasmin', 32, 'Mumbai', 'test-execute-file','2007-03-13'); /* ;test comment 3 (asterisk in /second/ line of multiline comment) * with multiple lines;; */ - insert into company_employees (id,name,age,address,salary,join_date) values (5, 'susan', 32, 'Vancouver', 20100.00,'2009-07-13'); + insert into company_employees (id,name,age,address,include_file,join_date) values (5, 'Susan', 32, 'Vancouver', 'test-execute-file','2009-07-13'); /* ;test comment 4 (asterisk in second line of multiline comment) *** with multiple lines;; /* test' comment 4-1 @@ -36,4 +41,4 @@ insert into company_employees (id,name,age,address,salary,join_date) values (4, */ * did I say something wrong? --*/ -insert into company_employees (id,name,age,address,salary,join_date) values (6, 'johanna', 32, 'Berlin', 20000.00,'2011-03-13'); +insert into company_employees (id,name,age,address,include_file,join_date) values (6, 'Johanna', 32, 'Berlin', 'test-execute-file','2011-03-13'); diff --git a/postmodern/tests/test-fail-include-execute-file.sql b/postmodern/tests/test-fail-include-execute-file.sql new file mode 100644 index 00000000..08ee4ce4 --- /dev/null +++ b/postmodern/tests/test-fail-include-execute-file.sql @@ -0,0 +1,33 @@ +drop table if exists company_employees; + +create table company_employees( + id bigserial primary key not null, + name text not null, + age int not null, + address char(50), + include_file text , + join_date date +); + +insert into company_employees (id,name,age,address,include_file,join_date) values (1, 'Paul', 32, 'London', 'first-include-execute-file','2001-07-13'); + +\i ./postmodern/tests/tef-11.sql + + insert into company_employees (id,name,age,address,include_file,join_date) values (3, 'John', 32, 'Toronto', 'first-include-execute-file','2005-07-13'); + + \ir tef-6.sql + + insert into company_employees (id,name,age,address,include_file,join_date) values (6, 'Johanna', 32, 'Berlin', 'first-include-execute-file','2011-03-13'); + + \ir tef-3.sql + + insert into company_employees (id,name,age,address,include_file,join_date) values (4, 'Yasmin', 32, 'Mumbai', 'first-include-execute-file','2007-03-13'); + + \i ./postmodern/tests/sub1/tef-4.sql + + insert into company_employees (id,name,age,address,include_file,join_date) values (5, 'Susan', 32, 'Vancouver', 'first-include-execute-file','2009-07-13'); + +\ir ./sub1/tef-5.sql + + +insert into company_employees (id,name,age,address,include_file,join_date) values (2, 'Ziad', 32, 'Beirut', 'first-include-execute-file','2003-03-13'); From ac12633ff3dd4528aa2d9479099f6254d204e716 Mon Sep 17 00:00:00 2001 From: Sabra Crolleton Date: Thu, 9 Sep 2021 07:40:55 -0400 Subject: [PATCH 08/13] Minor formatting edits --- postmodern/execute-file.lisp | 44 ++++++++++++++++++------------------ 1 file changed, 22 insertions(+), 22 deletions(-) diff --git a/postmodern/execute-file.lisp b/postmodern/execute-file.lisp index 85ffd1be..6636a617 100644 --- a/postmodern/execute-file.lisp +++ b/postmodern/execute-file.lisp @@ -270,7 +270,7 @@ replace the single line comments, returning the resulting string." (define-condition missing-i-file (error) ((%filename :reader filename :initarg :filename) (%base-filename :reader base-filename :initarg :base-filename) - ($meta-cmd :reader meta-cmd :initarg :meta-cmd)) + (%meta-cmd :reader meta-cmd :initarg :meta-cmd)) (:report (lambda (condition stream) (format stream "We tried but failed to find file ~a at the location specified by the ~a meta command. @@ -303,16 +303,16 @@ include commands \ir or \include_relative. Returns nil otherwise." (cond ((and (> (length line) 3) (string= "\\i " (subseq line 0 3))) (values 'i (string-trim '(#\space #\tab) (subseq line 3)))) - ((and (> (length line) 9) + ((and (> (length line) 9) (string= "\\include " (subseq line 0 9))) (values 'i (string-trim '(#\space #\tab) (subseq line 9)))) ((and (> (length line) 4) (string= "\\ir " (subseq line 0 4))) (values 'ir (string-trim '(#\space #\tab) (subseq line 4)))) - ((and (> (length line) 18) - (string= "\\include_relative " (subseq line 0 18))) - (values 'ir (string-trim '(#\space #\tab) (subseq line 18)))) - (t nil))) + ((and (> (length line) 18) + (string= "\\include_relative " (subseq line 0 18))) + (values 'ir (string-trim '(#\space #\tab) (subseq line 18)))) + (t nil))) (defun find-included-filename (meta-cmd new-filename base-filename) "Create full pathname if included using a \ir metacommand or \include_relative." @@ -362,22 +362,22 @@ and and return them in a stream. Recursively apply \i include instructions." do (multiple-value-bind (meta-cmd new-filename) (line-has-includes line) - (cond ((or (eq meta-cmd 'i) - (eq meta-cmd 'ir)) - (let ((include-filename - (find-included-filename meta-cmd new-filename filename))) - (when new-filename - (if (not (member include-filename included-files)) - (progn - (push include-filename included-files) - (read-sql-file include-filename included-files q)) - (progn - (warn - (format nil - "~a: Duplicate attempts to include sql files ~a skipped~%" - *package* filename)) - ""))))) - (t (format q "~a~%" line)))) + (if (or (eq meta-cmd 'i) + (eq meta-cmd 'ir)) + (let ((include-filename + (find-included-filename meta-cmd new-filename filename))) + (when new-filename + (if (not (member include-filename included-files)) + (progn + (push include-filename included-files) + (read-sql-file include-filename included-files q)) + (progn + (warn + (format nil + "~a: Duplicate attempts to include sql files ~a skipped~%" + *package* filename)) + "")))) + (t (format q "~a~%" line)))) finally (return q))) (warn (format nil "~a: file ~a doesn't seem to exist. If this was supposed to be an included file, please note that \\i looks for a file location relative to your default pathname, in this case ~a. \\ir looks for a file location relative to the initial included file location, in the case ~a~%" *package* filename From a96f2de41c64e090e368c1894be3f9f4f7071cfa Mon Sep 17 00:00:00 2001 From: Sabra Crolleton Date: Thu, 9 Sep 2021 07:57:17 -0400 Subject: [PATCH 09/13] Fix typo in read-sql-file if clause --- postmodern/execute-file.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/postmodern/execute-file.lisp b/postmodern/execute-file.lisp index 6636a617..50fac606 100644 --- a/postmodern/execute-file.lisp +++ b/postmodern/execute-file.lisp @@ -377,7 +377,7 @@ and and return them in a stream. Recursively apply \i include instructions." "~a: Duplicate attempts to include sql files ~a skipped~%" *package* filename)) "")))) - (t (format q "~a~%" line)))) + (format q "~a~%" line))) finally (return q))) (warn (format nil "~a: file ~a doesn't seem to exist. If this was supposed to be an included file, please note that \\i looks for a file location relative to your default pathname, in this case ~a. \\ir looks for a file location relative to the initial included file location, in the case ~a~%" *package* filename From 830837729c69a04922ecdf94572bd46a2b9ee3f2 Mon Sep 17 00:00:00 2001 From: Sabra Crolleton Date: Fri, 17 Sep 2021 12:19:28 -0400 Subject: [PATCH 10/13] Reducing confusion between compilers on char names Compilers differ in names given to unicode characters. This changes some tests to allow the compiler to use its own name. Also changing order of compilation i cl-postgres files to reduce compiler warnings. --- cl-postgres.asd | 2 +- cl-postgres/tests/tests-saslprep.lisp | 12 ++++++------ 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/cl-postgres.asd b/cl-postgres.asd index de0e29cc..c19fdb96 100644 --- a/cl-postgres.asd +++ b/cl-postgres.asd @@ -27,6 +27,7 @@ :components ((:file "package") (:file "features") (:file "config") + (:file "oid" :depends-on ("package" "config")) (:file "errors" :depends-on ("package")) (:file "data-types" :depends-on ("package" "config")) (:file "sql-string" :depends-on ("package" "config" "data-types")) @@ -36,7 +37,6 @@ (:file "communicate" :depends-on (#.*string-file* "sql-string" "config")) (:file "messages" :depends-on ("communicate" "config")) - (:file "oid" :depends-on ("package" "config")) (:file "ieee-floats" :depends-on ("config")) (:file "interpret" :depends-on ("oid" "communicate" "ieee-floats" "config")) diff --git a/cl-postgres/tests/tests-saslprep.lisp b/cl-postgres/tests/tests-saslprep.lisp index f7ae3a28..6de885af 100644 --- a/cl-postgres/tests/tests-saslprep.lisp +++ b/cl-postgres/tests/tests-saslprep.lisp @@ -24,12 +24,12 @@ (is (not (cl-postgres::code-point-printable-ascii-p 163)))) (test char-mapped-to-nothing-p - (is (not (cl-postgres::char-mapped-to-nothing-p #\LATIN_CAPITAL_LETTER_O_WITH_DIAERESIS))) - (is (cl-postgres::char-mapped-to-nothing-p #\ZERO_WIDTH_SPACE))) + (is (not (cl-postgres::char-mapped-to-nothing-p (code-char 214)))) + (is (cl-postgres::char-mapped-to-nothing-p (code-char 8203)))) (test char-mapped-to-space-p - (is (not (cl-postgres::char-mapped-to-space-p #\LATIN_CAPITAL_LETTER_O_WITH_DIAERESIS))) - (is (cl-postgres::char-mapped-to-space-p #\ZERO_WIDTH_SPACE)) + (is (not (cl-postgres::char-mapped-to-space-p (code-char 214)))) + (is (cl-postgres::char-mapped-to-space-p (code-char 8203))) (is (cl-postgres::char-mapped-to-space-p (code-char 5760)))) (test string-mapped-to-nothing-p @@ -56,8 +56,8 @@ (test saslprep-normalize (is (equal (cl-postgres::saslprep-normalize - (coerce (vector #\a #\LATIN_CAPITAL_LETTER_O_WITH_DIAERESIS - (code-char 8193) #\c #\ZERO_WIDTH_SPACE + (coerce (vector #\a (code-char 214) + (code-char 8193) #\c (code-char 8203) (code-char 65025) (code-char 1214) #\d) 'string)) From 9e071c7055a4b53c6d3067ad8b45b43e4cacdad8 Mon Sep 17 00:00:00 2001 From: Sabra Crolleton Date: Fri, 17 Sep 2021 12:22:42 -0400 Subject: [PATCH 11/13] Eliminate dependence on cl-unicode Genera does not compile cl-unicode and the utility functions in Postmodern could be done using a uax-15 function instead. --- postmodern.asd | 1 - postmodern/util.lisp | 4 ++-- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/postmodern.asd b/postmodern.asd index a19dfb1c..ebac42f8 100644 --- a/postmodern.asd +++ b/postmodern.asd @@ -26,7 +26,6 @@ "s-sql" "global-vars" "split-sequence" - "cl-unicode" "uiop" (:feature :postmodern-use-mop "closer-mop") (:feature :postmodern-thread-safe "bordeaux-threads")) diff --git a/postmodern/util.lisp b/postmodern/util.lisp index 77730f6c..91e8ef0f 100644 --- a/postmodern/util.lisp +++ b/postmodern/util.lisp @@ -6,7 +6,7 @@ (defun valid-sql-character-p (chr) "Returns t if chr is letter, underscore, digits or dollar sign" - (or (cl-unicode:has-property chr "Letter") + (or (uax-15:unicode-letter-p chr) (digit-char-p chr) (eq chr #\_) (eq chr #\$))) @@ -25,7 +25,7 @@ First test is for a quoted string, which has less restrictions. " (notany #'code-char-0-p str)) str) ((and (stringp str) - (or (cl-unicode:has-property (char str 0) "Letter") + (or (uax-15:unicode-letter-p (char str 0)) (eq (char str 0) #\_)) (every #'valid-sql-character-p str))) (t nil))) From 0392520bef5bbcec57e7c43034ddc894e7011c28 Mon Sep 17 00:00:00 2001 From: Sabra Crolleton Date: Fri, 17 Sep 2021 12:24:00 -0400 Subject: [PATCH 12/13] Further development on resolving the execute-file function As noted in previous commits, execute file fails when certain characters or combinations of characters are found in sql comments in the file being executed. This commit makes removing sql comments optional and resolves character combinations in nested multi-line comments, mixed multi-line and single line comments and within sql single quoted text. --- postmodern/execute-file.lisp | 230 +++++++++++++++--------- postmodern/tests/test-execute-file.lisp | 87 ++++++++- 2 files changed, 231 insertions(+), 86 deletions(-) diff --git a/postmodern/execute-file.lisp b/postmodern/execute-file.lisp index 50fac606..4931119d 100644 --- a/postmodern/execute-file.lisp +++ b/postmodern/execute-file.lisp @@ -198,74 +198,130 @@ should return (unless (eq :eat (parser-state state)) (error e))))) -(defstruct mlc-parser +(defstruct comment-parser buffer (stream (make-string-output-stream)) - (state :base) - (count 0)) ; nest levels. > 0 indicates already in at least one comment + (state '(:base))) +(defparameter single-line-comment-scanner + (cl-ppcre:create-scanner "--.*")) + + +;; +;; If a single line comment in within a multiline comment, Postgresql will +;; ignore the single line comment. ;; comments begin with /* and end with */ ;; possible states: ;; :base -;; :mlc (already in a multiline comment) -;; :mb (maybe beginning a new multiline comment) -;; :me (maybe ending a multiline comment) - -(defun mlc-parse-query (str &optional (state (make-mlc-parser))) +;; :mlc (inside a multiline comment) +;; :mb? (maybe beginning a new multiline comment) +;; :me? (maybe ending a multiline comment) +;; :sb? (maybe beginning a single line comment) +;; :slc (inside a single line comment) +;; :sq (inside an sql quote) + +(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 (mlc-parser-state state) - (:base (setf (mlc-parser-state state) :mb)) - (:mb ; faked beginning, return to earlier state (:base or :mlc) - (if (> (mlc-parser-count state) 0) - (progn - (setf (mlc-parser-state state) :mlc)) - (progn - (setf (mlc-parser-state state) :base) - (write-char #\/ (mlc-parser-stream state)) - (write-char #\/ (mlc-parser-stream state))))) - (:mlc (setf (mlc-parser-state state) :mb)) - (:me ; actual ending of a comment - (decf (mlc-parser-count state)) - (if (> (mlc-parser-count state) 0) - (progn ; ending nested comment decrement and return to :mlc - (setf (mlc-parser-state state) :mlc)) - (progn ; ending only comment level, decrement and return to :base - (setf (mlc-parser-state state) :base)))))) - (#\* (case (mlc-parser-state state) - (:base (write-char char (mlc-parser-stream state))) - (:mb (progn ; actual beginning, increment count, set :mlc - (setf (mlc-parser-state state) :mlc) - (incf (mlc-parser-count state)))) - (:mlc (setf (mlc-parser-state state) :me)) - (:me (setf (mlc-parser-state state) :me)))) - - (otherwise (case (mlc-parser-state state) + (#\' (case (first (comment-parser-state state)) + (:base (push :sq (comment-parser-state state)) + (write-char #\' (comment-parser-stream state))) + (:mlc ) + (:slc ) + (:sb? (pop (comment-parser-state state)) + (write-char #\' (comment-parser-stream state))) + (:mb? ; faked multi-line beginning, return to earlier state + (pop (comment-parser-state state)) + (when (eq (first (comment-parser-state state)) + :base) + (write-char #\/ (comment-parser-stream state)) + (write-char #\/ (comment-parser-stream state)))) + (:me? (pop (comment-parser-state state))) + (:sq (pop (comment-parser-state state)) + (write-char #\' (comment-parser-stream state))))) + (#\- (case (first (comment-parser-state state)) + (:base (push :sb? (comment-parser-state state))) + (:mlc ) + (: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 + (pop (comment-parser-state state)) + (when (eq (first (comment-parser-state state)) + :base) + (write-char #\/ (comment-parser-stream state)) + (write-char #\/ (comment-parser-stream state)))) + (:me? (pop (comment-parser-state state))))) + (#\newline (case (first (comment-parser-state state)) + (:base + (write-char char (comment-parser-stream state))) + (:mlc ) + (:sq (write-char char (comment-parser-stream state))) + (:slc (pop (comment-parser-state state)) + (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 + (pop (comment-parser-state state)) + (when (eq (first (comment-parser-state state)) + :base) + (write-char #\/ (comment-parser-stream state)) + (write-char #\/ (comment-parser-stream state)))) + (:me? (pop (comment-parser-state state)) + (write-char char (comment-parser-stream state))))) + (#\/ (case (first (comment-parser-state state)) + (:base (push :mb? (comment-parser-state state))) + (:sb? (pop (comment-parser-state state))) + (:slc ) + (:sq (write-char char (comment-parser-stream state))) + (:mb? ; faked beginning, return to earlier state (:base or :mlc) + (pop (comment-parser-state state)) + (when (eq (first (comment-parser-state state)) + :base) + (write-char #\/ (comment-parser-stream state)) + (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 + (pop (comment-parser-state state)) + (pop (comment-parser-state state))))) + (#\* (case (first (comment-parser-state state)) + (:base (write-char char (comment-parser-stream state))) + (:mb? (setf (first (comment-parser-state state)) :mlc)) + (: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 + (pop (comment-parser-state state)) + (when (eq (first (comment-parser-state state)) :mlc) + (push :me? (comment-parser-state state)))))) + (otherwise (case (first (comment-parser-state state)) (:base - (write-char char (mlc-parser-stream state))) - (:mb - (if (> (mlc-parser-count state) 0) - (setf (mlc-parser-state state) :mlc) - (progn - (write-char #\/ (mlc-parser-stream state)) - (setf (mlc-parser-state state) :base) - (write-char char (mlc-parser-stream state))))) - (:me (setf (mlc-parser-state state) :mlc))))) + (write-char char (comment-parser-stream state))) + (:mb? + (pop (comment-parser-state state)) + (when (eq (first (comment-parser-state state)) + :base) + (write-char #\/ (comment-parser-stream state)) + (write-char char (comment-parser-stream state)))) + (:me? ; fake ending of a multi-line comment + (pop (comment-parser-state state))) + (:sb? ; fake single line comment + (pop (comment-parser-state state)) + (write-char #\- (comment-parser-stream state)) + (write-char char (comment-parser-stream state))) + (:sq (write-char char (comment-parser-stream state)))))) :finally (return - (get-output-stream-string (mlc-parser-stream state))))) + (get-output-stream-string (comment-parser-stream state))))) -(defparameter single-line-comment-scanner - (cl-ppcre:create-scanner "--.*")) (defun remove-sql-comments (str) - "Take a string input, replace all the multi-line comments, then -replace the single line comments, returning the resulting string." - (cl-ppcre::regex-replace-all - single-line-comment-scanner - (mlc-parse-query - str) - "")) + "Take a string input, replace all the multi-line comments and single line comments, +returning the resulting string." + (parse-comments str)) (define-condition missing-i-file (error) ((%filename :reader filename :initarg :filename) @@ -279,7 +335,7 @@ Note that meta-commands \\i or \\include in the sql file look for a file locati relative to your default pathname (current working directory), in this case: ~a. -Meta-commandsd \\ir or \\include_relative look for a file location relative to the +Meta-commands \\ir or \\include_relative look for a file location relative to the initial sql file, in this case: ~a. @@ -288,31 +344,31 @@ Can you double check that the file actually exists where it is supposed to be?" (filename condition) (if (eq (meta-cmd condition) 'i) "\\i or \\include" - "\\ir or \\include_relative") + "\\ir or \\include_relative") (uiop::get-pathname-defaults) (directory-namestring (base-filename condition)) (if (eq (meta-cmd condition) 'i) "\\ir or \\include_relative" - "\\i or \\include"))))) + "\\i or \\include"))))) (defun line-has-includes (line) "Returns 'i if the first characters in a line are the postgresql include file commands: \i or \include. Returns 'ir if the first characters in a line are postgresql include commands \ir or \include_relative. Returns nil otherwise." - (setf line (string-trim '(#\space #\tab) line)) - (cond ((and (> (length line) 3) - (string= "\\i " (subseq line 0 3))) - (values 'i (string-trim '(#\space #\tab) (subseq line 3)))) - ((and (> (length line) 9) - (string= "\\include " (subseq line 0 9))) - (values 'i (string-trim '(#\space #\tab) (subseq line 9)))) - ((and (> (length line) 4) - (string= "\\ir " (subseq line 0 4))) - (values 'ir (string-trim '(#\space #\tab) (subseq line 4)))) - ((and (> (length line) 18) - (string= "\\include_relative " (subseq line 0 18))) - (values 'ir (string-trim '(#\space #\tab) (subseq line 18)))) - (t nil))) + (let ((new-line (string-trim '(#\space #\tab) line))) + (cond ((and (> (length new-line) 3) + (string= "\\i " (subseq new-line 0 3))) + (values 'i (string-trim '(#\space #\tab) (subseq new-line 3)))) + ((and (> (length new-line) 9) + (string= "\\include " (subseq new-line 0 9))) + (values 'i (string-trim '(#\space #\tab) (subseq new-line 9)))) + ((and (> (length new-line) 4) + (string= "\\ir " (subseq new-line 0 4))) + (values 'ir (string-trim '(#\space #\tab) (subseq new-line 4)))) + ((and (> (length new-line) 18) + (string= "\\include_relative " (subseq new-line 0 18))) + (values 'ir (string-trim '(#\space #\tab) (subseq new-line 18)))) + (t nil)))) (defun find-included-filename (meta-cmd new-filename base-filename) "Create full pathname if included using a \ir metacommand or \include_relative." @@ -350,16 +406,20 @@ include commands \ir or \include_relative. Returns nil otherwise." (find-included-filename meta-cmd new-full-filename base-filename))))) -(defun read-sql-file (filename &optional (included-files nil) (q (make-string-output-stream)) ) +(defun read-sql-file (filename &key (included-files nil) + (output-stream (make-string-output-stream)) + (remove-comments t)) "Read a given file and strip the comments. Read lines from the redacted result -and and return them in a stream. Recursively apply \i include instructions." +and return them in a stream. Recursively apply \i include instructions." (if (uiop:file-exists-p filename) (with-input-from-string - (s (remove-sql-comments (alexandria:read-file-into-string filename))) + (s (if remove-comments + (remove-sql-comments (alexandria:read-file-into-string filename)) + (alexandria:read-file-into-string filename))) (loop - for line = (read-line s nil) - while line - do + :for line := (read-line s nil) + :while line + :do (multiple-value-bind (meta-cmd new-filename) (line-has-includes line) (if (or (eq meta-cmd 'i) @@ -370,15 +430,17 @@ and and return them in a stream. Recursively apply \i include instructions." (if (not (member include-filename included-files)) (progn (push include-filename included-files) - (read-sql-file include-filename included-files q)) + (read-sql-file include-filename :included-files included-files + :output-stream output-stream + :remove-comments remove-comments)) (progn (warn (format nil "~a: Duplicate attempts to include sql files ~a skipped~%" *package* filename)) "")))) - (format q "~a~%" line))) - finally (return q))) + (format output-stream "~a~%" line))) + :finally (return output-stream))) (warn (format nil "~a: file ~a doesn't seem to exist. If this was supposed to be an included file, please note that \\i looks for a file location relative to your default pathname, in this case ~a. \\ir looks for a file location relative to the initial included file location, in the case ~a~%" *package* filename (uiop::get-pathname-defaults) @@ -387,12 +449,12 @@ and and return them in a stream. Recursively apply \i include instructions." nil)) ""))) -(defun read-queries (filename) +(defun read-queries (filename &key (remove-comments t)) "Read SQL queries in given file and split them, returns a list. Track included files so there is no accidental infinite loop." (parse-queries (get-output-stream-string - (read-sql-file filename)))) + (read-sql-file filename :remove-comments remove-comments)))) (defun parse-queries (file-content) "Read SQL queries in given string and split them, returns a list" @@ -404,7 +466,7 @@ files so there is no accidental infinite loop." :while (and query (not (emptyp query))) :collect query))))) -(defun execute-file (pathname &optional (print nil)) +(defun execute-file (pathname &optional (print nil) (remove-comments t)) "This function will execute sql queries stored in a file. Each sql statement in the file will be run independently, but if one statement fails, subsequent query statements will not be run, but any statement prior to the failing @@ -429,7 +491,7 @@ will print the count of the query and the query to the REPL. IMPORTANT NOTE: This utility function assumes that the file containing the sql queries can be trusted and bypasses the normal postmodern parameterization of queries." - (let ((queries (read-queries pathname)) + (let ((queries (read-queries pathname :remove-comments remove-comments)) (cnt 0)) (dolist (query queries) (when print diff --git a/postmodern/tests/test-execute-file.lisp b/postmodern/tests/test-execute-file.lisp index 5803794c..2841b710 100644 --- a/postmodern/tests/test-execute-file.lisp +++ b/postmodern/tests/test-execute-file.lisp @@ -23,8 +23,7 @@ (pomo:execute-file *good-file*) (is (table-exists-p 'company-employees)) (is (equal "Paul" (query (:select 'name :from 'company-employees :where (:= 'id 1)) :single))) - (is (equal 11 (query (:select (:count 'id) :from 'company-employees) :single))) - (query (:drop-table :if-exists 'company-employees :cascade)))) + (is (equal 11 (query (:select (:count 'id) :from 'company-employees) :single))))) (test broken-execute-file (with-test-connection @@ -52,3 +51,87 @@ (query (:drop-table :if-exists 'company-employees :cascade))) (signals error (pomo:execute-file *fail-include-file*)) (query (:drop-table :if-exists 'company-employees :cascade)))) + +;; Test Parse Comments + +(test basic-multi-line1 + (is (equal (postmodern::parse-comments " something1 /* comment */ something2") + " something1 something2"))) + +(test basic-multi-line2 + (is (equal (postmodern::parse-comments " something1 /* + comment */ something2") + " something1 something2"))) + +(test basic-single-line + (is (equal (postmodern::parse-comments " something1 -- comment */ something2") + " something1 "))) + +(test multi-line-within-single-line + (is (equal (postmodern::parse-comments " something1 -- /* comment */ something2") + " something1 "))) + +(test multi-line-within-multi-line + (is (equal (postmodern::parse-comments " something1 /* outside comment + /* inside comment */ bad-something2 */ something2") + " something1 something2"))) + +(test broken-nested-muli-line-comments + (is (equal (pomo::parse-comments "/* comment /* still the same comment */") + ""))) + +(test single-line-within-multi-line + (is (equal (postmodern::parse-comments " something1 /* comm -- ent */ something2") + " something1 something2"))) + +(test basic-fake-single-line + (is (equal (postmodern::parse-comments " something1 - something2") + " something1 - something2"))) + +(test basic-fake-muli-line + (is (equal (postmodern::parse-comments " something1 / something2") + " something1 / something2"))) + +(test multi-line-within-sql-string1 + (is (equal (postmodern::parse-comments " something ('my wonder /* something */ company ')") + " something ('my wonder /* something */ company ')"))) + +(test multi-line-within-sql-string2 + (is (equal (postmodern::parse-comments "insert into a (d) values ('/*');") + "insert into a (d) values ('/*');"))) + +(test single-line-within-sql-string1 + (is (equal (postmodern::parse-comments " something ('my wonder -- company ')") + " something ('my wonder -- company ')"))) + +(test single-line-within-sql-string2 + (is (equal (postmodern::parse-comments "insert into a (d) values ('-- /*');") + "insert into a (d) values ('-- /*');"))) + +(test asterisk-no-comment + (is (equal (pomo::parse-comments "select * from x") + "select * from x"))) + +(test unicode-escapes + (is (equal (pomo::parse-comments "U&'d\\0061t\\+000061'") + "U&'d\\0061t\\+000061'"))) + +(test dollar-quoted-string-constants1 + (is (equal (pomo::parse-comments "$$Dianne's horse$$") + "$$Dianne's horse$$"))) + +(test dollar-quoted-string-constants2 + (is (equal (pomo::parse-comments "$function$ +BEGIN + RETURN ($1 ~ $q$[\\t\\r\\n\\v\\]$q$); +END; +$function$") + "$function$ +BEGIN + RETURN ($1 ~ $q$[\\t\\r\\n\\v\\]$q$); +END; +$function$"))) + +(test single-quote-sql + (is (equal (pomo::parse-comments "REAL '1.23' -- string style") + "REAL '1.23' "))) From d3c9017c72d53b5c199dd6eeeaad750bd9270daa Mon Sep 17 00:00:00 2001 From: Sabra Crolleton Date: Fri, 17 Sep 2021 12:35:22 -0400 Subject: [PATCH 13/13] Update documentation for executing-file This commit updates the documentation for execute-file and read-queries to note parameter to remove or not remove sql comments. --- doc/postmodern.html | 11 ++++++++++- doc/postmodern.org | 9 ++++++++- postmodern/execute-file.lisp | 10 ++++++++-- 3 files changed, 26 insertions(+), 4 deletions(-) diff --git a/doc/postmodern.html b/doc/postmodern.html index 18a282dd..1eeae5bf 100644 --- a/doc/postmodern.html +++ b/doc/postmodern.html @@ -3706,6 +3706,12 @@

function execute-file (filename &optional (pr print the count of the query and the query to the REPL.

+

+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. +

+

IMPORTANT NOTE: This utility function assumes that the file containing the sql queries can be trusted and bypasses the normal postmodern parameterization of @@ -3916,7 +3922,10 @@

function parse-queries (file-content)

function read-queries (filename)

-Read SQL queries in a given file and split them, returns a list. +Read SQL queries in a given file and split them, returns a list. Track included +files so there is no accidental infinite loop. 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.

diff --git a/doc/postmodern.org b/doc/postmodern.org index 21ae956a..7f8207f0 100644 --- a/doc/postmodern.org +++ b/doc/postmodern.org @@ -2196,6 +2196,10 @@ the test file test-execute-file-broken-transaction.sql as an example. For debugging purposes, if the optional print parameter is set to t, format will print the count of the query and the query to the REPL. +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. + IMPORTANT NOTE: This utility function assumes that the file containing the sql queries can be trusted and bypasses the normal postmodern parameterization of queries. @@ -2345,7 +2349,10 @@ Read SQL queries in given string and split them, returns a list. :CUSTOM_ID: function-read-queries :END: -Read SQL queries in a given file and split them, returns a list. +Read SQL queries in a given file and split them, returns a list. Track included +files so there is no accidental infinite loop. 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. ** function sql-escape-string (string) :PROPERTIES: :CUSTOM_ID: function-sql-escape-string diff --git a/postmodern/execute-file.lisp b/postmodern/execute-file.lisp index 4931119d..91544a4b 100644 --- a/postmodern/execute-file.lisp +++ b/postmodern/execute-file.lisp @@ -409,7 +409,7 @@ include commands \ir or \include_relative. Returns nil otherwise." (defun read-sql-file (filename &key (included-files nil) (output-stream (make-string-output-stream)) (remove-comments t)) - "Read a given file and strip the comments. Read lines from the redacted result + "Read a given file and (default) remove the comments. Read lines from the redacted result and return them in a stream. Recursively apply \i include instructions." (if (uiop:file-exists-p filename) (with-input-from-string @@ -451,7 +451,9 @@ and return them in a stream. Recursively apply \i include instructions." (defun read-queries (filename &key (remove-comments t)) "Read SQL queries in given file and split them, returns a list. Track included -files so there is no accidental infinite loop." +files so there is no accidental infinite loop. 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." (parse-queries (get-output-stream-string (read-sql-file filename :remove-comments remove-comments)))) @@ -488,6 +490,10 @@ test file test-execute-file-broken-transaction.sql as an example. For debugging purposes, if the optional print parameter is set to t, format will print the count of the query and the query to the REPL. +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. + IMPORTANT NOTE: This utility function assumes that the file containing the sql queries can be trusted and bypasses the normal postmodern parameterization of queries."