: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"))))))
(defpackage clsql-uffi-system (:use #:asdf #:cl))
(in-package clsql-uffi-system)
-(defvar *clsql-uffi-library-dir*
- (merge-pathnames "uffi/"
- (make-pathname :name nil :type nil :defaults *load-truename*)))
+;; (defvar *clsql-uffi-library-dir*
+;; (merge-pathnames "uffi/"
+;; (make-pathname :name nil :type nil :defaults *load-truename*)))
-(defclass clsql-uffi-source-file (c-source-file)
- ())
+;; (defclass clsql-uffi-source-file (c-source-file)
+;; ())
-(defmethod output-files ((o compile-op) (c clsql-uffi-source-file))
- (let* ((library-file-type
- (funcall (intern (symbol-name'#:default-foreign-library-type)
- (symbol-name '#:uffi))))
- (found
- (some #'(lambda (dir)
- (probe-file (make-pathname
- :directory dir
- :name (component-name c)
- :type library-file-type)))
- '((:absolute "usr" "lib" "clsql")))))
- (list (if found
- found
- (make-pathname :name (component-name c)
- :type library-file-type
- :defaults *clsql-uffi-library-dir*)))))
+;; (defmethod output-files ((o compile-op) (c clsql-uffi-source-file))
+;; (let* ((library-file-type
+;; (funcall (intern (symbol-name'#:default-foreign-library-type)
+;; (symbol-name '#:uffi))))
+;; (found
+;; (some #'(lambda (dir)
+;; (probe-file (make-pathname
+;; :directory dir
+;; :name (component-name c)
+;; :type library-file-type)))
+;; '((:absolute "usr" "lib" "clsql")))))
+;; (list (if found
+;; found
+;; (make-pathname :name (component-name c)
+;; :type library-file-type
+;; :defaults *clsql-uffi-library-dir*)))))
-(defmethod perform ((o load-op) (c clsql-uffi-source-file))
- nil) ;;; library will be loaded by a loader file
+;; (defmethod perform ((o load-op) (c clsql-uffi-source-file))
+;; nil) ;;; library will be loaded by a loader file
-(defmethod operation-done-p ((o load-op) (c clsql-uffi-source-file))
- (and (find-package '#:clsql-uffi)
- (symbol-function (intern (symbol-name '#:atol64)
- (find-package '#:clsql-uffi)))
- t))
+;; (defmethod operation-done-p ((o load-op) (c clsql-uffi-source-file))
+;; (and (find-package '#:clsql-uffi)
+;; (symbol-function (intern (symbol-name '#:atol64)
+;; (find-package '#:clsql-uffi)))
+;; t))
-(defmethod perform ((o compile-op) (c clsql-uffi-source-file))
- (unless (operation-done-p o c)
- #-(or win32 win64 windows mswindows)
- (unless (zerop (run-shell-command
- #-(or freebsd netbsd) "cd ~A; make"
- #+(or freebsd netbsd) "cd ~A; gmake"
- (namestring *clsql-uffi-library-dir*)))
- (error 'operation-error :component c :operation o))))
+;; (defmethod perform ((o compile-op) (c clsql-uffi-source-file))
+;; (unless (operation-done-p o c)
+;; #-(or win32 win64 windows mswindows)
+;; (unless (zerop (run-shell-command
+;; #-(or freebsd netbsd) "cd ~A; make"
+;; #+(or freebsd netbsd) "cd ~A; gmake"
+;; (namestring *clsql-uffi-library-dir*)))
+;; (error 'operation-error :component c :operation o))))
-(defmethod operation-done-p ((o compile-op) (c clsql-uffi-source-file))
- (or (and (probe-file #p"/usr/lib/clsql/clsql_uffi.so") t)
- (let ((lib (make-pathname :defaults (component-pathname c)
- :type (funcall (intern (symbol-name '#:default-foreign-library-type)
- (find-package '#:uffi))))))
- (and (probe-file lib) (probe-file (component-pathname c))
- (> (file-write-date lib) (file-write-date (component-pathname c)))))))
+;; (defmethod operation-done-p ((o compile-op) (c clsql-uffi-source-file))
+;; (or (and (probe-file #p"/usr/lib/clsql/clsql_uffi.so") t)
+;; (let ((lib (make-pathname :defaults (component-pathname c)
+;; :type (funcall (intern (symbol-name '#:default-foreign-library-type)
+;; (find-package '#:uffi))))))
+;; (and (probe-file lib) (probe-file (component-pathname c))
+;; (> (file-write-date lib) (file-write-date (component-pathname c)))))))
(defsystem clsql-uffi
:name "cl-sql-base"
((:module :uffi
:components
((:file "clsql-uffi-package")
- (:clsql-uffi-source-file "clsql_uffi" :depends-on ("clsql-uffi-package"))
- (:file "clsql-uffi-loader" :depends-on ("clsql-uffi-package" "clsql_uffi"))
- (:file "clsql-uffi" :depends-on ("clsql-uffi-loader"))))))
+;; (:clsql-uffi-source-file "clsql_uffi" :depends-on ("clsql-uffi-package"))
+;; (:file "clsql-uffi-loader" :depends-on ("clsql-uffi-package" "clsql_uffi"))
+ (:file "clsql-uffi-loader" :depends-on ("clsql-uffi-package"))
+ (:file "clsql-uffi" :depends-on ("clsql-uffi-package"))))))
--- /dev/null
+;;;; -*- 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
(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
(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)
(cons (symbol-name-default-case "UNSIGNED") "UNSIGNED")
(cons (symbol-name-default-case "ZEROFILL") "ZEROFILL")
(cons (symbol-name-default-case "AUTO-INCREMENT") "AUTO_INCREMENT")
+ (cons (symbol-name-default-case "AUTOINCREMENT") "AUTOINCREMENT")
(cons (symbol-name-default-case "DEFAULT") "DEFAULT")
(cons (symbol-name-default-case "UNIQUE") "UNIQUE")
(cons (symbol-name-default-case "IDENTITY") "IDENTITY (1,1)") ;; added for sql-server support
))
(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'"
(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."))
(defvar *uffi-library-loaded* nil
"T if foreign library was able to be loaded successfully")
-(defun load-uffi-foreign-library ()
- (clsql:push-library-path clsql-uffi-system::*clsql-uffi-library-dir*)
- (find-and-load-foreign-library *clsql-uffi-library-filenames*
- :module "clsql-uffi"
- :supporting-libraries
- *clsql-uffi-supporting-libraries*)
- (setq *uffi-library-loaded* t))
+;; (defun load-uffi-foreign-library ()
+;; (clsql:push-library-path clsql-uffi-system::*clsql-uffi-library-dir*)
+;; (find-and-load-foreign-library *clsql-uffi-library-filenames*
+;; :module "clsql-uffi"
+;; :supporting-libraries
+;; *clsql-uffi-supporting-libraries*)
+;; (setq *uffi-library-loaded* t))
-(load-uffi-foreign-library)
+;; (load-uffi-foreign-library)
(radix :int))
:returning :unsigned-long)
+#-windows
+(uffi:def-function ("strtoull" c-strtoull)
+ ((str (* :unsigned-char))
+ (endptr (* :unsigned-char))
+ (radix :int))
+ :returning :unsigned-long-long)
+
+#+windows
+(uffi:def-function ("_strtoui64" c-strtoull)
+ ((str (* :unsigned-char))
+ (endptr (* :unsigned-char))
+ (radix :int))
+ :returning :unsigned-long-long)
+
(uffi:def-function "atol"
((str (* :unsigned-char)))
:returning :long)
(type char-ptr-def char-ptr))
(c-strtoul char-ptr uffi:+null-cstring-pointer+ 10))
+(defun strtoull (char-ptr)
+ (declare (optimize (speed 3) (safety 0) (space 0))
+ (type char-ptr-def char-ptr))
+ (c-strtoull char-ptr uffi:+null-cstring-pointer+ 10))
+
(defun convert-raw-field (char-ptr type &key length encoding)
(declare (optimize (speed 3) (safety 0) (space 0))
(type char-ptr-def char-ptr))
(:uint
(strtoul char-ptr))
((:int64 :uint64)
- (uffi:with-foreign-object (high32-ptr :unsigned-int)
+ (strtoull char-ptr)
+ #|(uffi:with-foreign-object (high32-ptr :unsigned-int)
(let ((low32 (atol64 char-ptr high32-ptr))
(high32 (uffi:deref-pointer high32-ptr :unsigned-int)))
(if (zerop high32)
low32
- (make-64-bit-integer high32 low32)))))
+ (make-64-bit-integer high32 low32))))|#
+)
(:blob
(if length
(uffi:convert-from-foreign-usb8 char-ptr length)