1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; ======================================================================
3 ;;;; File: package.lisp
4 ;;;; Updated: <04/04/2004 12:05:16 marcusp>
5 ;;;; ======================================================================
7 ;;;; Description ==========================================================
8 ;;;; ======================================================================
10 ;;;; CLSQL square bracket symbolic query syntax. Functions for
11 ;;;; enabling and disabling the syntax and for building SQL
12 ;;;; expressions using the syntax.
14 ;;;; ======================================================================
16 (in-package #:clsql-sys)
18 (defvar *original-reader-enter* nil)
20 (defvar *original-reader-exit* nil)
22 (defvar *sql-macro-open-char* #\[)
24 (defvar *sql-macro-close-char* #\])
26 (defvar *restore-sql-reader-syntax* nil)
29 ;; Exported functions for disabling SQL syntax.
31 (defmacro disable-sql-reader-syntax ()
32 "Turn off SQL square bracket syntax changing syntax state. Set state
33 such that RESTORE-SQL-READER-SYNTAX-STATE will make the syntax
34 disabled if it is consequently locally enabled."
35 '(eval-when (:compile-toplevel :load-toplevel :execute)
36 (setf *restore-sql-reader-syntax* nil)
37 (%disable-sql-reader-syntax)))
39 (defmacro locally-disable-sql-reader-syntax ()
40 "Turn off SQL square bracket syntax and do not change syntax state."
41 '(eval-when (:compile-toplevel :load-toplevel :execute)
42 (%disable-sql-reader-syntax)))
44 (defun %disable-sql-reader-syntax ()
45 (when *original-reader-enter*
46 (set-macro-character *sql-macro-open-char* *original-reader-enter*))
47 (setf *original-reader-enter* nil)
51 ;; Exported functions for enabling SQL syntax.
53 (defmacro enable-sql-reader-syntax ()
54 "Turn on SQL square bracket syntax changing syntax state. Set state
55 such that RESTORE-SQL-READER-SYNTAX-STATE will make the syntax enabled
56 if it is consequently locally disabled."
57 '(eval-when (:compile-toplevel :load-toplevel :execute)
58 (setf *restore-sql-reader-syntax* t)
59 (%enable-sql-reader-syntax)))
61 (defmacro locally-enable-sql-reader-syntax ()
62 "Turn on SQL square bracket syntax and do not change syntax state."
63 '(eval-when (:compile-toplevel :load-toplevel :execute)
64 (%enable-sql-reader-syntax)))
66 (defun %enable-sql-reader-syntax ()
67 (unless *original-reader-enter*
68 (setf *original-reader-enter* (get-macro-character *sql-macro-open-char*)))
69 (set-macro-character *sql-macro-open-char* #'sql-reader-open)
70 (enable-sql-close-syntax)
73 (defmacro restore-sql-reader-syntax-state ()
74 "Sets the enable/disable square bracket syntax state to reflect the
75 last call to either DISABLE-SQL-READER-SYNTAX or
76 ENABLE-SQL-READER-SYNTAX. The default state of the square bracket
78 '(eval-when (:compile-toplevel :load-toplevel :execute)
79 (if *restore-sql-reader-syntax*
80 (%enable-sql-reader-syntax)
81 (%disable-sql-reader-syntax))))
83 (defun sql-reader-open (stream char)
84 (declare (ignore char))
85 (let ((sqllist (read-delimited-list #\] stream t)))
86 (if (sql-operator (car sqllist))
87 (cons (sql-operator (car sqllist)) (cdr sqllist))
88 (apply #'generate-sql-reference sqllist))))
90 ;; Internal function that disables the close syntax when leaving sql context.
91 (defun disable-sql-close-syntax ()
92 (set-macro-character *sql-macro-close-char* *original-reader-exit*)
93 (setf *original-reader-exit* nil))
95 ;; Internal function that enables close syntax when entering SQL context.
96 (defun enable-sql-close-syntax ()
97 (setf *original-reader-exit* (get-macro-character *sql-macro-close-char*))
98 (set-macro-character *sql-macro-close-char* (get-macro-character #\))))
100 (defun generate-sql-reference (&rest arglist)
101 (cond ((= (length arglist) 1) ; string, table or attribute
102 (if (stringp (car arglist))
103 (sql-expression :string (car arglist))
104 (sql-expression :attribute (car arglist))))
105 ((<= 2 (length arglist))
106 (let ((sqltype (if (keywordp (caddr arglist))
107 (caddr arglist) nil))
108 (sqlparam (if (keywordp (caddr arglist))
111 ((stringp (cadr arglist))
112 (sql-expression :table (car arglist)
113 :alias (cadr arglist)
115 ((keywordp (cadr arglist))
116 (sql-expression :attribute (car arglist)
120 (sql-expression :attribute (cadr arglist)
125 (error 'clsql-sql-syntax-error :reason "bad expression syntax"))))
128 ;; Exported functions for dealing with SQL syntax
130 (defun sql (&rest args)
131 "Generates SQL from a set of expressions given by ARGS. Each
132 argument is translated into SQL and then the args are concatenated
133 with a single space between each pair."
134 (format nil "~{~A~^ ~}" (mapcar #'sql-output args)))
136 (defun sql-expression (&key string table alias attribute type params)
137 "Generates an SQL expression from the given keywords. Valid
138 combinations of the arguments are: string; table; table and alias;
139 table and attribute; table, attribute, and type; table or alias, and
140 attribute; table or alias, and attribute and type; attribute; and
144 (make-instance 'sql :string string))
146 (make-instance 'sql-ident-attribute :name attribute
147 :qualifier (or table alias)
150 ((and table (not attribute))
151 (make-instance 'sql-ident-table :name table
152 :table-alias alias))))
154 (defun sql-operator (operation)
155 "Takes an SQL operator as an argument and returns the Lisp symbol
159 (symbol (gethash (string-upcase (symbol-name operation))
162 (defun sql-operation (operation &rest rest)
163 "Generates an SQL statement from an operator and arguments."
164 (if (sql-operator operation)
165 (apply (symbol-function (sql-operator operation)) rest)
166 (error "~A is not a recognized SQL operator." operation)))