From: Russ Tyndall <russ@acceleration.net>
Date: Fri, 3 Jul 2009 14:59:56 +0000 (-0400)
Subject: added the '~* ANY' and Array operators / expressions
X-Git-Url: http://git.kpe.io/?a=commitdiff_plain;h=95c3d1b5fb4b3479c4d36f5560c55ba6f77654b7;p=clsql.git

added the '~* ANY' and Array operators / expressions
---

diff --git a/sql/expressions.lisp b/sql/expressions.lisp
index 6388515..971609e 100644
--- a/sql/expressions.lisp
+++ b/sql/expressions.lisp
@@ -257,6 +257,28 @@
       (write-char #\) *sql-stream*)))
   t)
 
+(defclass sql-array-exp (sql-relational-exp)
+  ()
+  (:documentation "An SQL relational expression."))
+
+(defmethod output-sql ((expr sql-array-exp) database)
+  (with-slots (operator sub-expressions)
+    expr
+    (let ((subs (if (consp (car sub-expressions))
+                    (car sub-expressions)
+                    sub-expressions)))
+      (write-char #\( *sql-stream*)
+      (output-sql operator database)
+      (write-char #\[ *sql-stream*)
+      (do ((sub subs (cdr sub)))
+          ((null (cdr sub)) (output-sql (car sub) database))
+        (output-sql (car sub) database)
+        (write-char #\, *sql-stream*)
+        (write-char #\Space *sql-stream*))
+      (write-char #\] *sql-stream*)
+      (write-char #\) *sql-stream*)))
+  t)
+
 (defclass sql-upcase-like (sql-relational-exp)
   ()
   (:documentation "An SQL 'like' that upcases its arguments."))
diff --git a/sql/operations.lisp b/sql/operations.lisp
index 1b52925..3357761 100644
--- a/sql/operations.lisp
+++ b/sql/operations.lisp
@@ -128,6 +128,16 @@
   (make-instance 'sql-relational-exp
                  :operator '~* :sub-expressions rest))
 
+(defsql |sql-~* ANY| (:symbol "~* ANY") (&rest rest)
+	"This is the postgres regex match any in an array"
+  (make-instance 'sql-relational-exp
+                 :operator '|~* ANY| :sub-expressions rest))
+
+(defsql sql-array (:symbol "array") (&rest rest)
+	"This is the postgres regex match any in an array"
+  (make-instance 'sql-array-exp
+                 :operator 'array :sub-expressions rest))
+
 (defsql sql-uplike (:symbol "uplike") (&rest rest)
   (make-instance 'sql-upcase-like
                  :sub-expressions rest))