From 4332610851d855ebc858f231f06cff81c675e5f2 Mon Sep 17 00:00:00 2001
From: Victor <victor@victor-mobi>
Date: Wed, 16 Oct 2013 17:34:08 +0300
Subject: [PATCH] initial version of the autoincrement support for sqlite3
 backend

---
 clsql-sqlite3.asd               |  5 +++--
 db-sqlite3/sqlite3-methods.lisp | 20 ++++++++++++++++++++
 db-sqlite3/sqlite3-sql.lisp     | 25 +++++++++++++++++++++++++
 sql/expressions.lisp            | 15 +++++++++------
 sql/generics.lisp               |  5 +++++
 5 files changed, 62 insertions(+), 8 deletions(-)
 create mode 100644 db-sqlite3/sqlite3-methods.lisp

diff --git a/clsql-sqlite3.asd b/clsql-sqlite3.asd
index a32130f..f83d2dd 100644
--- a/clsql-sqlite3.asd
+++ b/clsql-sqlite3.asd
@@ -32,5 +32,6 @@
 	    :components
 	    ((:file "sqlite3-package")
 	     (:file "sqlite3-loader" :depends-on ("sqlite3-package"))
-	     (:file  "sqlite3-api" :depends-on ("sqlite3-loader"))
-	     (:file "sqlite3-sql" :depends-on ("sqlite3-api"))))))
+	     (:file "sqlite3-api" :depends-on ("sqlite3-loader"))
+	     (:file "sqlite3-sql" :depends-on ("sqlite3-api"))
+	     (:file "sqlite3-methods" :depends-on ("sqlite3-sql"))))))
diff --git a/db-sqlite3/sqlite3-methods.lisp b/db-sqlite3/sqlite3-methods.lisp
new file mode 100644
index 0000000..181fca4
--- /dev/null
+++ b/db-sqlite3/sqlite3-methods.lisp
@@ -0,0 +1,20 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+
+(in-package #:clsql-sys)
+
+;; This method generates primary key constraints part of the table
+;; definition. For Sqlite autoincrement primary keys to work properly
+;; this part of the table definition must be left out.
+(defmethod database-pkey-constraint ((class standard-db-class)
+				     (database clsql-sqlite3:sqlite3-database)))
+
+(defmethod database-translate-constraint (constraint
+					  (database clsql-sqlite3:sqlite3-database))
+  ;; Primary purpose of this is method is to intecept and translate
+  ;; auto-increment primary keys constraints.
+  (let ((constraint-name (symbol-name constraint)))
+    (if (eql constraint :auto-increment)
+	(cons constraint "PRIMARY KEY AUTOINCREMENT")
+	(call-next-method))))
+
+;; EOF
diff --git a/db-sqlite3/sqlite3-sql.lisp b/db-sqlite3/sqlite3-sql.lisp
index 63e48ec..7b16b48 100644
--- a/db-sqlite3/sqlite3-sql.lisp
+++ b/db-sqlite3/sqlite3-sql.lisp
@@ -303,6 +303,12 @@
                   (if (string-equal (fourth field-info) "0")
                       1 0)))))
 
+(defmethod database-last-auto-increment-id ((database sqlite3-database) table column)
+  (declare (ignore table column))
+  (car (query "SELECT LAST_INSERT_ROWID();"
+	      :flatp t :field-names nil
+	      :database database)))
+
 (defmethod database-create (connection-spec (type (eql :sqlite3)))
   (declare (ignore connection-spec))
   ;; databases are created automatically by Sqlite3
@@ -320,7 +326,26 @@
     (or (string-equal ":memory:" name)
         (and (probe-file name) t))))
 
+(defmethod database-get-type-specifier ((type (eql 'integer))
+                                        args database
+                                        (db-type (eql :sqlite3)))
+  (declare (ignore database))
+  (if args
+      (format nil "INTEGER(~A)" (car args))
+      "INTEGER"))
+
+(defmethod database-get-type-specifier ((type (eql 'integer))
+                                        args database
+                                        (db-type (eql :sqlite3)))
+  (declare (ignore database))
+  (if args
+      (format nil "INTEGER(~A)" (car args))
+      "INTEGER"))
+
 ;;; Database capabilities
 
 (defmethod db-type-has-boolean-where? ((db-type (eql :sqlite3)))
   nil)
+
+(defmethod db-type-has-auto-increment? ((db-type (eql :sqlite3)))
+  t)
diff --git a/sql/expressions.lisp b/sql/expressions.lisp
index 8b6167b..16bf687 100644
--- a/sql/expressions.lisp
+++ b/sql/expressions.lisp
@@ -1111,17 +1111,20 @@ uninclusive, and the args from that keyword to the end."
    ))
 
 (defmethod database-constraint-statement (constraint-list database)
-  (declare (ignore database))
-  (make-constraints-description constraint-list))
+  (make-constraints-description constraint-list database))
+
+(defmethod database-translate-constraint (constraint database)
+  (assoc (symbol-name constraint)
+	 *constraint-types*
+	 :test #'equal))
 
-(defun make-constraints-description (constraint-list)
+(defun make-constraints-description (constraint-list database)
   (if constraint-list
       (let ((string ""))
         (do ((constraint constraint-list (cdr constraint)))
             ((null constraint) string)
-          (let ((output (assoc (symbol-name (car constraint))
-                               *constraint-types*
-                               :test #'equal)))
+          (let ((output (database-translate-constraint (car constraint)
+						       database)))
             (if (null output)
                 (error 'sql-user-error
                        :message (format nil "unsupported column constraint '~A'"
diff --git a/sql/generics.lisp b/sql/generics.lisp
index 748cbd9..7f276fc 100644
--- a/sql/generics.lisp
+++ b/sql/generics.lisp
@@ -193,3 +193,8 @@ the arguments EXPR and DATABASE."))
 
 (defgeneric database-constraint-statement  (constraints database)
   )
+
+(defgeneric database-translate-constraint (constraint database)
+  (:documentation "Given a column constraint returns its
+database-specific name. For example, auto-increment constraints can
+have different names in different database engines."))
-- 
2.34.1