;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: clsql-mysql.system,v 1.3 2002/03/24 04:01:26 kevin Exp $
+;;;; $Id: clsql-mysql.system,v 1.4 2002/03/27 08:09:25 kevin Exp $
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
(:file "mysql-loader" :depends-on ("mysql-package"))
(:file "mysql-api" :depends-on ("mysql-loader"))
(:file "mysql-sql" :depends-on ("mysql-api")))
- :depends-on (:uffi :clsql)
+ :depends-on (:uffi :clsql :clsql-uffi)
:finally-do
(when (clsql-sys:database-type-library-loaded :mysql)
(clsql-sys:initialize-database-type :database-type :mysql)
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: clsql-postgresql.system,v 1.3 2002/03/24 04:01:26 kevin Exp $
+;;;; $Id: clsql-postgresql.system,v 1.4 2002/03/27 08:09:25 kevin Exp $
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
(:file "postgresql-loader" :depends-on ("postgresql-package"))
(:file "postgresql-api" :depends-on ("postgresql-loader"))
(:file "postgresql-sql" :depends-on ("postgresql-api")))
- :depends-on (:uffi :clsql)
+ :depends-on (:uffi :clsql :clsql-uffi)
:finally-do
(when (clsql-sys:database-type-library-loaded :postgresql)
(clsql-sys:initialize-database-type :database-type :postgresql)
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: clsql-uffi.system
+;;;; Purpose: Defsystem-3/4 definition file for CLSQL UFFI Helper package
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: clsql-uffi.system,v 1.1 2002/03/27 08:09:25 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; CLSQL users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+
+(in-package :cl-user)
+
+;;; System definition
+
+(mk:defsystem :clsql-uffi
+ :source-pathname "CLSQL:interfaces;clsql-uffi;"
+ :source-extension "cl"
+ :binary-pathname "CLSQL:interfaces;clsql-uffi;bin;"
+ :components ((:file "clsql-uffi-package")
+ (:file "clsql-uffi-loader" :depends-on ("clsql-uffi-package"))
+ (:file "clsql-uffi" :depends-on ("clsql-uffi-loader")))
+ :depends-on (:uffi))
+
<member><symbol>:int</symbol> Field is imported as a
32-bit signed integer.
</member>
+ <member><symbol>:longlong</symbol> Field is imported as a
+ 64-bit signed integer.
+ </member>
<member><symbol>:double</symbol> Field is imported as a
double-float number.
</member>
--- /dev/null
+clsql-uffi.so
+clsql-uffi.dll
+clsql-uffi.lib
+.bin
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: clsql-uffi-loader.sql
+;;;; Purpose: library loader using CLSQL UFFI helper library
+;;;; Programmers: Kevin M. Rosenberg
+;;;; Date Started: Mar 2002
+;;;;
+;;;; $Id: clsql-uffi-loader.cl,v 1.1 2002/03/27 08:09:25 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; CLSQL users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :clsql-uffi)
+
+(defvar *clsql-uffi-library-filename*
+ (translate-logical-pathname
+ #+(or linux unix) "CLSQL:interfaces;clsql-uffi;clsql-uffi.so"
+ #+(or mswindows win32) "CLSQL:interfaces;clsql-uffi;clsql-uffi.dll"
+ ))
+
+(defvar *clsql-uffi-supporting-libraries* '("c")
+ "Used only by CMU. List of library flags needed to be passed to ld to
+load the MySQL client library succesfully. If this differs at your site,
+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 ()
+ (when (uffi:load-foreign-library *clsql-uffi-library-filename*
+ :module "clsql-uffi"
+ :supporting-libraries
+ *clsql-uffi-supporting-libraries*)
+ (setq *uffi-library-loaded* t)))
+
+(load-uffi-foreign-library)
+
+
+
--- /dev/null
+/****************************************************************************
+ * FILE IDENTIFICATION
+ *
+ * Name: clsql-uffi.c
+ * Purpose: Helper functions for common interfaces using UFFI
+ * Programmer: Kevin M. Rosenberg
+ * Date Started: Mar 2002
+ *
+ * $Id: clsql-uffi.c,v 1.1 2002/03/27 08:09:25 kevin Exp $
+ *
+ * This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+ *
+ * CLSQL users are granted the rights to distribute and use this software
+ * as governed by the terms of the Lisp Lesser GNU Public License
+ * (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+ ***************************************************************************/
+
+#ifdef WIN32
+#include <windows.h>
+
+BOOL WINAPI DllEntryPoint(HINSTANCE hinstdll, DWORD fdwReason,
+ LPVOID lpvReserved)
+{
+ return 1;
+}
+
+#define DLLEXPORT __declspec(dllexport)
+
+#else
+#define DLLEXPORT
+#endif
+
+
+const unsigned int bitmask_32bits = 0xFFFFFFFF;
+#define lower_32bits(int64) ((unsigned int) int64 & bitmask_32bits)
+#define upper_32bits(int64) ((unsigned int) (int64 >> 32))
+
+/* Reads a 64-bit integer string, returns result as two 32-bit integers */
+
+DLLEXPORT
+unsigned int
+atol64 (const unsigned char* str, int* pHigh32)
+{
+ long long result = 0;
+ int minus = 0;
+ int first_char = *str;
+ if (first_char == '+')
+ ++str;
+ else if (first_char == '-') {
+ minus = 1;
+ ++str;
+ }
+
+ while (*str) {
+ int i = *str - '0';
+ if (i < 0 || i > 9) /* Non-numeric character -- quit */
+ break;
+ result = i + (10 * result);
+ str++;
+ }
+ if (minus)
+ result = -result;
+
+ *pHigh32 = upper_32bits(result);
+ return lower_32bits(result);
+}
+
+
+
+
+
/****************************************************************************
* FILE IDENTIFICATION
*
- * Name: mysql-helper.cl
+ * Name: clsql-mysql.c
* Purpose: Helper functions for mysql.cl to handle 64-bit parts of API
* Programmer: Kevin M. Rosenberg
* Date Started: Mar 2002
*
- * $Id: clsql-mysql.c,v 1.3 2002/03/27 05:48:22 kevin Exp $
+ * $Id: clsql-mysql.c,v 1.4 2002/03/27 08:09:25 kevin Exp $
*
* This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
*
located sent via a pointer */
const unsigned int bitmask_32bits = 0xFFFFFFFF;
-
#define lower_32bits(int64) ((unsigned int) int64 & bitmask_32bits)
#define upper_32bits(int64) ((unsigned int) (int64 >> 32))
+DLLEXPORT
+unsigned int
+clsql_mysql_num_rows (MYSQL_RES* res, unsigned int* pHigh32)
+{
+ my_ulonglong nRows = mysql_num_rows (res);
+ *pHigh32 = upper_32bits(nRows);
+ return lower_32bits(nRows);
+}
+
DLLEXPORT
unsigned int
clsql_mysql_affected_rows (MYSQL* res, unsigned int* pHigh32)
}
-/* Reads a 64-bit integer string, returns result as two 32-bit integers */
-
-DLLEXPORT
-unsigned int
-atol64 (const unsigned char* str, int* pHigh32)
-{
- long long result = 0;
- int minus = 0;
- int first_char = *str;
- if (first_char == '+')
- ++str;
- else if (first_char == '-') {
- minus = 1;
- ++str;
- }
-
- while (*str) {
- int i = *str - '0';
- if (i < 0 || i > 9) /* Non-numeric character -- quit */
- break;
- result = i + (10 * result);
- str++;
- }
- if (minus)
- result = -result;
-
- *pHigh32 = upper_32bits(result);
- return lower_32bits(result);
-}
-
-
-
-
;;;; Original code by Pierre R. Mai
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: mysql-api.cl,v 1.2 2002/03/25 14:13:41 kevin Exp $
+;;;; $Id: mysql-api.cl,v 1.3 2002/03/27 08:09:25 kevin Exp $
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
;;;; Equivalents of C Macro definitions for accessing various fields
;;;; in the internal MySQL Datastructures
-(uffi:def-constant +2^32+ 4294967296)
-(uffi:def-constant +2^32-1+ (1- +2^32+))
-
-(defmacro make-64-bit-integer (high32 low32)
- `(+ ,low32 (* ,high32 +2^32+)))
(declaim (inline mysql-num-rows))
(defun mysql-num-rows (res)
:returning :void)
-(declaim (inline split-64bit-integer))
-(defun split-64bit-integer (int64)
- (values (ash int64 -32) (logand int64 +2^32-1+)))
-
(defun mysql-data-seek (res offset)
- (multiple-value-bind (high32 low32) (split-64bit-integer offset)
+ (multiple-value-bind (high32 low32) (split-64-bit-integer offset)
(clsql-mysql-data-seek res high32 low32)))
;;;; Programmers: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: mysql-package.cl,v 1.6 2002/03/27 05:37:35 kevin Exp $
+;;;; $Id: mysql-package.cl,v 1.7 2002/03/27 08:09:25 kevin Exp $
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
(in-package :cl-user)
(defpackage :mysql
- (:use :common-lisp)
+ (:use :common-lisp :clsql-uffi)
(:export
#:database-library-loaded
;;;; Original code by Pierre R. Mai
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: mysql-sql.cl,v 1.13 2002/03/27 05:37:35 kevin Exp $
+;;;; $Id: mysql-sql.cl,v 1.14 2002/03/27 08:09:25 kevin Exp $
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
;;;; Added field types
(defpackage :clsql-mysql
- (:use :common-lisp :clsql-sys :mysql)
+ (:use :common-lisp :clsql-sys :mysql :clsql-uffi)
(:export #:mysql-database)
(:documentation "This is the CLSQL interface to MySQL."))
(defun canonicalize-types (types num-fields res-ptr)
(cond
- ((if (listp types)
- (let ((length-types (length types))
- (new-types '()))
- (loop for i from 0 below num-fields
- do
- (if (>= i length-types)
- (push t new-types) ;; types is shorted than num-fields
- (push
- (case (nth i types)
- ((:int :long :double t)
- (nth i types))
- (t
- t))
- new-types)))
- (nreverse new-types))))
+ ((listp types)
+ (canonicalize-type-list types num-fields))
((eq types :auto)
(let ((new-types '())
#+ignore (field-vec (mysql-fetch-fields res-ptr)))
(t
nil)))
-(uffi:def-function "atoi"
- ((str (* :unsigned-char)))
- :returning :int)
-
-(uffi:def-function "atol"
- ((str (* :unsigned-char)))
- :returning :long)
-
-(uffi:def-function "atol64"
- ((str (* :unsigned-char))
- (high32 (* :int)))
- :returning :int)
-
-(uffi:def-function "atof"
- ((str (* :unsigned-char)))
- :returning :double)
-
-(defun convert-raw-field (char-ptr types index)
- (let ((type (if (listp types)
- (nth index types)
- types)))
- (case type
- (:int
- (atoi char-ptr))
- (:long
- (atol char-ptr))
- (:double
- (atof char-ptr))
- (:longlong
- (uffi:with-foreign-object (high32-ptr :int)
- (let ((low32 (atol64 char-ptr high32-ptr))
- (high32 (uffi:deref-pointer high32-ptr :int)))
- (if (zerop high32)
- low32
- (mysql:make-64-bit-integer high32 low32)))))
- (otherwise
- (uffi:convert-from-foreign-string char-ptr)))))
-
(defmethod database-initialize-database-type ((database-type (eql :mysql)))
t)
t)
-
(defmethod database-store-next-row (result-set (database mysql-database) list)
(let* ((res-ptr (mysql-result-set-res-ptr result-set))
(row (mysql-fetch-row res-ptr))
;;;;
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: postgresql-socket-api.cl,v 1.8 2002/03/27 05:04:19 kevin Exp $
+;;;; $Id: postgresql-socket-api.cl,v 1.9 2002/03/27 08:09:25 kevin Exp $
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
((:bytea 17)
(:int2 21)
(:int4 23)
+ (:int8 20)
(:float4 700)
(:float8 701)))
(defun read-field (socket type)
(let ((length (- (read-socket-value 'int32 socket) 4)))
(case type
- (:int
+ ((:int :long :longlong)
(read-integer-from-socket socket length))
(:double
(read-double-from-socket socket length))
;;;; Programmers: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: postgresql-socket-package.cl,v 1.2 2002/03/25 23:22:07 kevin Exp $
+;;;; $Id: postgresql-socket-package.cl,v 1.3 2002/03/27 08:09:25 kevin Exp $
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
#:pgsql-ftype#bytea
#:pgsql-ftype#int2
#:pgsql-ftype#int4
+ #:pgsql-ftype#int8
#:pgsql-ftype#float4
#:pgsql-ftype#float8
;;;; Original code by Pierre R. Mai
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: postgresql-socket-sql.cl,v 1.6 2002/03/25 23:48:46 kevin Exp $
+;;;; $Id: postgresql-socket-sql.cl,v 1.7 2002/03/27 08:09:25 kevin Exp $
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
#.pgsql-ftype#int2
#.pgsql-ftype#int4)
:int)
+ (#.pgsql-ftype#int8
+ :longlong)
((#.pgsql-ftype#float4
#.pgsql-ftype#float8)
:double)
(otherwise
t))))
+
+(defun canonicalize-type-list (types num-fields)
+ "Ensure a field type list meets expectations.
+Duplicated from clsql-uffi package so that this interface
+doesn't depend on UFFI."
+ (let ((length-types (length types))
+ (new-types '()))
+ (loop for i from 0 below num-fields
+ do
+ (if (>= i length-types)
+ (push t new-types) ;; types is shorted than num-fields
+ (push
+ (case (nth i types)
+ ((:int :long :double :longlong t)
+ (nth i types))
+ (t
+ t))
+ new-types)))
+ (nreverse new-types)))
+
(defun canonicalize-types (types cursor)
(let* ((fields (postgresql-cursor-fields cursor))
(num-fields (length fields)))
(cond
((listp types)
- (let ((length-types (length types))
- (new-types '()))
- (loop for i from 0 below num-fields
- do
- (if (>= i length-types)
- (push t new-types) ;; types is shorted than num-fields
- (push
- (case (nth i types)
- ((:int :long :double t)
- (nth i types))
- (t
- t))
- new-types)))
- (nreverse new-types)))
+ (canonicalize-type-list types num-fields))
((eq types :auto)
(let ((new-types '()))
(dotimes (i num-fields)
;;;; Original code by Pierre R. Mai
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: postgresql-api.cl,v 1.3 2002/03/25 14:13:41 kevin Exp $
+;;;; $Id: postgresql-api.cl,v 1.4 2002/03/27 08:09:25 kevin Exp $
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
((:bytea 17)
(:int2 21)
(:int4 23)
+ (:int8 20)
(:float4 700)
(:float8 701)))
-
;;(declaim (inline PQsetdbLogin)) ;; causes compile error in LW 4.2.0
(uffi:def-function ("PQsetdbLogin" PQsetdbLogin)
((pghost :cstring)
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: postgresql-package.cl,v 1.4 2002/03/25 14:13:41 kevin Exp $
+;;;; $Id: postgresql-package.cl,v 1.5 2002/03/27 08:09:25 kevin Exp $
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
(defpackage :postgresql
(:nicknames :pgsql)
- (:use :common-lisp)
+ (:use :common-lisp :clsql-uffi)
(:export
#:pgsql-oid
#:pgsql-conn-status-type
#:pgsql-ftype#bytea
#:pgsql-ftype#int2
#:pgsql-ftype#int4
+ #:pgsql-ftype#int8
#:pgsql-ftype#float4
#:pgsql-ftype#float8
+
;; Functions
#:PQsetdbLogin
#:PQlogin
;;;; Original code by Pierre R. Mai
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: postgresql-sql.cl,v 1.9 2002/03/25 23:48:46 kevin Exp $
+;;;; $Id: postgresql-sql.cl,v 1.10 2002/03/27 08:09:25 kevin Exp $
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
(in-package :cl-user)
(defpackage :clsql-postgresql
- (:use :common-lisp :clsql-sys :postgresql)
+ (:use :common-lisp :clsql-sys :postgresql :clsql-uffi)
(:export #:postgresql-database)
(:documentation "This is the CLSQL interface to PostgreSQL."))
(defun canonicalize-types (types num-fields res-ptr)
(cond
- ((if (listp types)
- (let ((length-types (length types))
- (new-types '()))
- (loop for i from 0 below num-fields
- do
- (if (>= i length-types)
- (push t new-types) ;; types is shorted than num-fields
- (push
- (case (nth i types)
- ((:int :long :double t)
- (nth i types))
- (t
- t))
- new-types)))
- (nreverse new-types))))
+ ((listp types)
+ (canonicalize-type-list types num-fields))
((eq types :auto)
(let ((new-types '()))
(dotimes (i num-fields)
#.pgsql-ftype#int2
#.pgsql-ftype#int4)
:int)
+ (#.pgsql-ftype#int8
+ :longlong)
((#.pgsql-ftype#float4
#.pgsql-ftype#float8)
:double)
nil)))
-(uffi:def-function "atoi"
- ((str :cstring))
- :returning :int)
-
-(uffi:def-function "atol"
- ((str :cstring))
- :returning :long)
-
-(uffi:def-function "atof"
- ((str :cstring))
- :returning :double)
-
-(defun convert-raw-field (char-ptr types index)
- (let ((type (if (listp types)
- (nth index types)
- types)))
- (case type
- (:int
- (atoi char-ptr))
- (:long
- (atol char-ptr))
- (:double
- (atof char-ptr))
- (otherwise
- (uffi:convert-from-foreign-string char-ptr)))))
-
-
(defun tidy-error-message (message)
(unless (stringp message)
(setq message (uffi:convert-from-foreign-string message)))
projects / clsql.git / commitdiff