X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Ffdml.lisp;h=79fa18ef342bff10d97815b90920b303e5cac1e7;hp=15930301ac1d3c951b602b78be377577b406b5a1;hb=fdd069770e32d0cfa4b66d6e5cfd4540197660ba;hpb=e622ee6f4bf2b9fe81af59d566e651c983a4833b

diff --git a/sql/fdml.lisp b/sql/fdml.lisp
index 1593030..79fa18e 100644
--- a/sql/fdml.lisp
+++ b/sql/fdml.lisp
@@ -1,7 +1,7 @@
 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;;;; *************************************************************************
 ;;;;
-;;;; $Id: 
+;;;; $Id$
 ;;;;
 ;;;; The CLSQL Functional Data Manipulation Language (FDML). 
 ;;;;
@@ -314,13 +314,6 @@ of (attribute value) pairs."
         (write-char #\) *sql-stream*)))
   t)
 
-(defmethod describe-table ((table sql-create-table)
-			   &key (database *default-database*))
-  (database-describe-table
-   database
-   (convert-to-db-default-case 
-    (symbol-name (slot-value table 'name)) database)))
-
 #+nil
 (defmethod add-storage-class ((self database) (class symbol) &key (sequence t))
   (let ((tablename (view-table (find-class class))))
@@ -415,10 +408,8 @@ computed for each field."
       (database-query-result-set query-expression database :full-set nil
 				 :result-types result-types)
     (let ((flatp (and (= columns 1) 
-                      (typecase query-expression 
-                        (string t) 
-                        (sql-query 
-                         (slot-value query-expression 'flatp))))))
+		      (typep query-expression 'sql-query)
+		      (slot-value query-expression 'flatp))))
       (when result-set
         (unwind-protect
              (do ((row (make-list columns)))
@@ -434,10 +425,8 @@ computed for each field."
       (database-query-result-set query-expression database :full-set nil
 				 :result-types result-types)
     (let ((flatp (and (= columns 1) 
-                      (typecase query-expression 
-                        (string t) 
-                        (sql-query 
-                         (slot-value query-expression 'flatp))))))
+		      (typep query-expression 'sql-query)
+		      (slot-value query-expression 'flatp))))
       (when result-set
         (unwind-protect
              (let ((result (list nil)))
@@ -456,10 +445,8 @@ computed for each field."
       (database-query-result-set query-expression database :full-set t
 				 :result-types result-types)
     (let ((flatp (and (= columns 1) 
-                      (typecase query-expression 
-                        (string t) 
-                        (sql-query
-                         (slot-value query-expression 'flatp))))))
+		      (typep query-expression 'sql-query)
+		      (slot-value query-expression 'flatp))))
       (when result-set
         (unwind-protect
              (if rows
@@ -583,3 +570,37 @@ computed for each field."
   (database-delete-large-object object-id database))
 
 
+;;; Prepared statements
+
+(defun prepare-sql (sql-stmt types &key (database *default-database*) (result-types :auto) field-names)
+  "Prepares a SQL statement for execution. TYPES contains a
+list of types corresponding to the input parameters. Returns a
+prepared-statement object.
+
+A type can be
+  :int
+  :double
+  :null
+  (:string n)
+"
+  (unless (db-type-has-prepared-stmt? (database-type database))
+    (error 'sql-user-error 
+	   :message
+	   (format nil
+		   "Database backend type ~:@(~A~) does not support prepared statements."
+		   (database-type database))))
+
+  (database-prepare sql-stmt types database result-types field-names))
+
+(defun bind-parameter (prepared-stmt position value)
+  "Sets the value of a parameter is in prepared statement."
+  (database-bind-parameter prepared-stmt position value)
+  value)
+
+(defun run-prepared-sql (prepared-stmt)
+  "Execute the prepared sql statment. All input parameters must be bound."
+  (database-run-prepared prepared-stmt))
+
+(defun free-prepared-sql (prepared-stmt)
+  "Delete the objects associated with a prepared statement."
+  (database-free-prepared prepared-stmt))