1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
6 ;;;; CLSQL square bracket symbolic query syntax. Functions for
7 ;;;; enabling and disabling the syntax and for building SQL
8 ;;;; expressions using the syntax.
10 ;;;; This file is part of CLSQL.
12 ;;;; CLSQL users are granted the rights to distribute and use this software
13 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
14 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
15 ;;;; *************************************************************************
17 (in-package #:clsql-sys
)
19 (defvar *original-readtable
* nil
)
21 (defvar *sql-macro-open-char
* #\
[)
23 (defvar *sql-macro-close-char
* #\
])
25 (defvar *restore-sql-reader-syntax
* nil
)
28 ;; Exported functions for disabling SQL syntax.
30 (defmacro disable-sql-reader-syntax
()
31 "Turns off the SQL reader syntax setting the syntax state such
32 that if the syntax is subsequently enabled,
33 RESTORE-SQL-READER-SYNTAX-STATE will disable it again."
34 '(eval-when (:compile-toplevel
:load-toplevel
:execute
)
35 (setf *restore-sql-reader-syntax
* nil
)
36 (%disable-sql-reader-syntax
)))
38 (defmacro locally-disable-sql-reader-syntax
()
39 "Turns off the SQL reader syntax without changing the syntax
40 state such that RESTORE-SQL-READER-SYNTAX-STATE will re-establish
41 the current syntax state."
42 '(eval-when (:compile-toplevel
:load-toplevel
:execute
)
43 (%disable-sql-reader-syntax
)))
45 (defun %disable-sql-reader-syntax
()
46 (when *original-readtable
*
47 (setf *readtable
* *original-readtable
*
48 *original-readtable
* nil
))
52 ;; Exported functions for enabling SQL syntax.
54 (defmacro enable-sql-reader-syntax
()
55 "Turns on the SQL reader syntax setting the syntax state such
56 that if the syntax is subsequently disabled,
57 RESTORE-SQL-READER-SYNTAX-STATE will enable it again."
58 '(eval-when (:compile-toplevel
:load-toplevel
:execute
)
59 (setf *restore-sql-reader-syntax
* t
)
60 (%enable-sql-reader-syntax
)))
62 (defmacro locally-enable-sql-reader-syntax
()
63 "Turns on the SQL reader syntax without changing the syntax
64 state such that RESTORE-SQL-READER-SYNTAX-STATE will re-establish
65 the current syntax state."
66 '(eval-when (:compile-toplevel
:load-toplevel
:execute
)
67 (%enable-sql-reader-syntax
)))
69 (defun %enable-sql-reader-syntax
()
70 (unless *original-readtable
*
71 (setf *original-readtable
* *readtable
*
72 *readtable
* (copy-readtable))
73 (set-macro-character *sql-macro-open-char
* #'sql-reader-open
)
74 (set-macro-character *sql-macro-close-char
* (get-macro-character #\
))))
77 (defmacro restore-sql-reader-syntax-state
()
78 "Enables the SQL reader syntax if ENABLE-SQL-READER-SYNTAX has
79 been called more recently than DISABLE-SQL-READER-SYNTAX and
80 otherwise disables the SQL reader syntax. By default, the SQL
81 reader syntax is disabled."
82 '(eval-when (:compile-toplevel
:load-toplevel
:execute
)
83 (if *restore-sql-reader-syntax
*
84 (%enable-sql-reader-syntax
)
85 (%disable-sql-reader-syntax
))))
87 (defun sql-reader-open (stream char
)
88 (declare (ignore char
))
89 (let ((sqllist (read-delimited-list #\
] stream t
)))
90 (unless *read-suppress
*
92 (cond ((string= (write-to-string (car sqllist
)) "||")
93 (cons (sql-operator 'concat-op
) (cdr sqllist
)))
94 ((and (= (length sqllist
) 1) (eql (car sqllist
) '*))
95 (apply #'generate-sql-reference sqllist
))
96 ((sql-operator (car sqllist
))
97 (cons (sql-operator (car sqllist
)) (cdr sqllist
)))
98 (t (apply #'generate-sql-reference sqllist
)))
100 (error 'sql-user-error
101 :message
(format nil
"Error ~A occured while attempting to parse '~A' at file position ~A"
102 (sql-user-error-message c
) sqllist
(file-position stream
))))))))
104 (defun generate-sql-reference (&rest arglist
)
105 (cond ((= (length arglist
) 1) ; string, table or attribute
106 (if (stringp (car arglist
))
107 (sql-expression :string
(car arglist
))
108 (sql-expression :attribute
(car arglist
))))
109 ((<= 2 (length arglist
))
110 (let ((sqltype (when (keywordp (caddr arglist
)) (caddr arglist
) nil
)))
112 ((stringp (cadr arglist
))
113 (sql-expression :table
(car arglist
)
114 :alias
(cadr arglist
)
116 ((keywordp (cadr arglist
))
117 (sql-expression :attribute
(car arglist
)
118 :type
(cadr arglist
)))
120 (sql-expression :attribute
(cadr arglist
)
124 (error 'sql-user-error
:message
"bad expression syntax"))))
127 ;; Exported functions for dealing with SQL syntax
129 (defun sql (&rest args
)
130 "Returns an SQL string generated from the expressions ARGS. The
131 expressions are translated into SQL strings and then concatenated
132 with a single space delimiting each expression. An error of type
133 SQL-USER-ERROR is signalled if any element in ARGS is not of the
134 supported types (a symbol, string, number or symbolic SQL
135 expression) or a list or vector containing only these supported
137 (format nil
"~{~A~^ ~}" (mapcar #'sql-output args
)))
139 (defun sql-expression (&key string table alias attribute type
)
140 "Returns an SQL expression constructed from the supplied
141 arguments which may be combined as follows: ATTRIBUTE and TYPE;
142 ATTRIBUTE; ALIAS or TABLE and ATTRIBUTE and TYPE; ALIAS or TABLE
143 and ATTRIBUTE; TABLE, ATTRIBUTE and TYPE; TABLE and ATTRIBUTE;
144 TABLE and ALIAS; TABLE; and STRING. An error of type
145 SQL-USER-ERROR is signalled if an unsupported combination of
146 keyword arguments is specified."
149 (make-instance 'sql
:string string
))
151 (make-instance 'sql-ident-attribute
:name attribute
152 :qualifier
(or table alias
)
154 ((and table
(not attribute
))
155 (make-instance 'sql-ident-table
:name table
156 :table-alias alias
))))
158 (defun sql-operator (operator)
159 "Returns the Lisp symbol corresponding to the SQL operator
160 represented by the symbol OPERATOR. If OPERATOR does not
161 represent a supported SQL operator or is not a symbol, nil is
165 (symbol (values (gethash (symbol-name-default-case (symbol-name operator
))
168 (defun sql-operation (operator &rest args
)
169 "Returns an SQL expression constructed from the supplied symbol
170 OPERATOR representing an SQL operator or function and its
171 arguments ARGS. An error of type SQL-USER-ERROR is signalled if
172 OPERATOR is not a symbol representing a supported SQL
173 operator. If OPERATOR is passed the symbol FUNCTION then the
174 first value in ARGS must be a string representing a valid SQL
175 function and the remaining values in ARGS its arguments as
177 (if (sql-operator operator
)
178 (apply (symbol-function (sql-operator operator
)) args
)
179 (error 'sql-user-error
181 (format nil
"~A is not a recognized SQL operator." operator
))))