From: Russ Tyndall Date: Tue, 7 Jan 2014 16:39:08 +0000 (-0500) Subject: Merge branch 'master' of github.com:vityok/clsql into fix-atol64 X-Git-Tag: v6.5.0~16 X-Git-Url: http://git.kpe.io/?p=clsql.git;a=commitdiff_plain;h=5bb8544ca8a58d10b57f751bad2c9abf4d7a13c8;hp=0b757e652eda05d8d824438d925665f17e764d93 Merge branch 'master' of github.com:vityok/clsql into fix-atol64 --- 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/clsql-uffi.asd b/clsql-uffi.asd index 5629d45..84bfeb2 100644 --- a/clsql-uffi.asd +++ b/clsql-uffi.asd @@ -19,56 +19,56 @@ (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" @@ -85,6 +85,7 @@ ((: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")))))) 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..35b163f 100644 --- a/sql/expressions.lisp +++ b/sql/expressions.lisp @@ -1105,23 +1105,27 @@ uninclusive, and the args from that keyword to the end." (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'" 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.")) diff --git a/uffi/clsql-uffi-loader.lisp b/uffi/clsql-uffi-loader.lisp index 6a286a9..04b9f24 100644 --- a/uffi/clsql-uffi-loader.lisp +++ b/uffi/clsql-uffi-loader.lisp @@ -54,12 +54,12 @@ set to the right path before compiling or loading the system.") (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) diff --git a/uffi/clsql-uffi.lisp b/uffi/clsql-uffi.lisp index 79d423f..76dfd04 100644 --- a/uffi/clsql-uffi.lisp +++ b/uffi/clsql-uffi.lisp @@ -71,6 +71,20 @@ (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) @@ -108,6 +122,11 @@ (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)) @@ -127,12 +146,14 @@ (: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)