first draft of implementing cl-postgres as a backend for clsql (called db-postgresql...

diff --git a/clsql-postgresql-socket3.asd b/clsql-postgresql-socket3.asd
new file mode 100644 (file)
index 0000000..3c069bd
--- /dev/null
+++ b/clsql-postgresql-socket3.asd
@@ -0,0 +1,41 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          clsql-postgresql-socket.asd
+;;;; Purpose:       ASDF file for CLSQL PostgresSQL socket backend
+;;;; Programmer:    Kevin M. Rosenberg
+;;;; Date Started:  Aug 2002
+;;;;
+;;;; $Id$
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(defpackage #:clsql-postgresql-socket-system (:use #:asdf #:cl))
+(in-package #:clsql-postgresql-socket-system)
+
+;;; System definition
+
+(defsystem clsql-postgresql-socket3
+  :name "cl-sql-postgresql-socket3"
+  :author "Russ Tyndall <russ@acceleration.net>"
+  :maintainer "Russ Tyndall <russ@acceleration.net>"
+  :licence "Lessor Lisp General Public License"
+  :description "Common Lisp SQL PostgreSQL Socket Driver"
+  :long-description "cl-sql-postgresql-socket package provides a database driver to the PostgreSQL database via a socket interface."
+
+  :depends-on (clsql cffi-uffi-compat md5 #+sbcl sb-bsd-sockets)
+  :components
+  ((:module :db-postgresql-socket
+           :components
+           ((:file "package")
+            (:file "api"
+                   :depends-on ("package"))
+            (:file "sql"
+                   :depends-on ("api")))
+           :depends-on (:cl-postgres))))

diff --git a/db-postgresql-socket3/.gitignore b/db-postgresql-socket3/.gitignore
new file mode 100644 (file)
index 0000000..1d27afc
--- /dev/null
+++ b/db-postgresql-socket3/.gitignore
@@ -0,0 +1,14 @@
+clsql-uffi.so
+clsql-uffi.dll
+clsql-uffi.lib
+clsql-uffi.dylib
+.bin
+*.fasl
+*.pfsl
+*.dfsl
+*.cfsl
+*.fasla16
+*.fasla8
+*.faslm16
+*.faslm8
+*.fsl

diff --git a/db-postgresql-socket3/api.lisp b/db-postgresql-socket3/api.lisp
new file mode 100644 (file)
index 0000000..8fa690c
--- /dev/null
+++ b/db-postgresql-socket3/api.lisp
@@ -0,0 +1,29 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:     postgresql-socket-api.lisp
+;;;; Purpose:  Low-level PostgreSQL interface using sockets
+;;;; Authors:  Kevin M. Rosenberg based on original code by Pierre R. Mai
+;;;; Created:  Feb 2002
+;;;;
+;;;; $Id$
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002-2004 by Kevin M. Rosenberg
+;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(in-package #:postgresql-socket3)
+
+(defmethod clsql-sys:database-type-load-foreign ((database-type (eql :postgresql-socket3)))
+  t)
+
+(defmethod clsql-sys:database-type-library-loaded ((database-type
+                                          (eql :postgresql-socket)))
+  "T if foreign library was able to be loaded successfully. Always true for
+socket interface"
+  t)
\ No newline at end of file

diff --git a/db-postgresql-socket3/package.lisp b/db-postgresql-socket3/package.lisp
new file mode 100644 (file)
index 0000000..df3a2f6
--- /dev/null
+++ b/db-postgresql-socket3/package.lisp
@@ -0,0 +1,26 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          postgresql-socket-package.lisp
+;;;; Purpose:       Package definition for PostgreSQL interface using sockets
+;;;; Programmers:   Kevin M. Rosenberg
+;;;; Date Started:  Feb 2002
+;;;;
+;;;; $Id$
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(in-package #:cl-user)
+
+#+lispworks (require "comm")
+
+(defpackage #:postgresql-socket3
+  (:use #:cl md5 #:cl-postgres)
+  (:export ))
+

diff --git a/db-postgresql-socket3/sql.lisp b/db-postgresql-socket3/sql.lisp
new file mode 100644 (file)
index 0000000..edebf0b
--- /dev/null
+++ b/db-postgresql-socket3/sql.lisp
@@ -0,0 +1,255 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:     postgresql-socket-sql.sql
+;;;; Purpose:  High-level PostgreSQL interface using socket
+;;;; Authors:  Kevin M. Rosenberg based on original code by Pierre R. Mai
+;;;; Created:  Feb 2002
+;;;;
+;;;; $Id$
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002-2007 by Kevin M. Rosenberg
+;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(in-package #:cl-user)
+
+(defpackage :clsql-postgresql-socket3
+    (:use #:common-lisp #:clsql-sys #:postgresql-socket)
+    (:export #:postgresql-socket-database)
+    (:documentation "This is the CLSQL socket interface to PostgreSQL."))
+
+(in-package #:clsql-postgresql-socket3)
+
+;; interface foreign library loading routines
+
+(clsql-sys:database-type-load-foreign :postgresql-socket3)
+
+
+(defmethod database-initialize-database-type ((database-type
+                                               (eql :postgresql-socket3)))
+  t)
+
+
+;; Field type conversion
+(defun convert-to-clsql-warning (database condition)
+  (ecase *backend-warning-behavior*
+    (:warn
+     (warn 'sql-database-warning :database database
+           :message (postgresql-condition-message condition)))
+    (:error
+     (error 'sql-database-error :database database
+            :message (format nil "Warning upgraded to error: ~A"
+                             (postgresql-condition-message condition))))
+    ((:ignore nil)
+     ;; do nothing
+     )))
+
+(defun convert-to-clsql-error (database expression condition)
+  (error 'sql-database-data-error
+         :database database
+         :expression expression
+         :error-id (type-of condition)
+         :message (postgresql-condition-message condition)))
+
+(defmacro with-postgresql-handlers
+    ((database &optional expression)
+     &body body)
+  (let ((database-var (gensym))
+        (expression-var (gensym)))
+    `(let ((,database-var ,database)
+           (,expression-var ,expression))
+       (handler-bind ((postgresql-warning
+                       (lambda (c)
+                         (convert-to-clsql-warning ,database-var c)))
+                      (postgresql-error
+                       (lambda (c)
+                         (convert-to-clsql-error
+                          ,database-var ,expression-var c))))
+         ,@body))))
+
+
+
+(defclass postgresql-socket3-database (generic-postgresql-database)
+  ((connection :accessor database-connection :initarg :connection
+               :type cl-postgres:database-connection)))
+
+(defmethod database-type ((database postgresql-socket3-database))
+  :postgresql-socket3)
+
+(defmethod database-name-from-spec (connection-spec (database-type (eql :postgresql-socket3)))
+  (check-connection-spec connection-spec database-type
+                         (host db user password &optional port options tty))
+  (destructuring-bind (host db user password &optional port options tty)
+      connection-spec
+    (declare (ignore password options tty))
+    (concatenate 'string
+      (etypecase host
+        (null
+         "localhost")
+        (pathname (namestring host))
+        (string host))
+      (when port
+        (concatenate 'string
+                     ":"
+                     (etypecase port
+                       (integer (write-to-string port))
+                       (string port))))
+      "/" db "/" user)))
+
+(defmethod database-connect (connection-spec
+                             (database-type (eql :postgresql-socket)))
+  (check-connection-spec connection-spec database-type
+                         (host db user password &optional port options tty))
+  (destructuring-bind (host db user password &optional
+                            (port +postgresql-server-default-port+)
+                            (options "") (tty ""))
+      connection-spec
+    (handler-case
+        (handler-bind ((warning
+                        (lambda (c)
+                          (warn 'sql-warning
+                                :format-control "~A"
+                                :format-arguments
+                                (list (princ-to-string c))))))
+          (cl-postgres:open-database
+          :database db
+          :user user
+          :password password
+          :host host
+          :port port
+           ))
+      (cl-postgres:database-error (c)
+        ;; Connect failed
+        (error 'sql-connection-error
+               :database-type database-type
+               :connection-spec connection-spec
+               :error-id (type-of c)
+               :message (postgresql-condition-message c)))
+      (:no-error (connection)
+                 ;; Success, make instance
+                 (make-instance 'postgresql-socket3-database
+                                :name (database-name-from-spec connection-spec database-type)
+                                :database-type :postgresql-socket3
+                                :connection-spec connection-spec
+                                :connection connection)))))
+
+(defmethod database-disconnect ((database postgresql-socket3-database))
+  (cl-postgres:close-database (database-connection database))
+  t)
+
+(defvar *include-field-names* nil)
+
+(cl-postgres:def-row-reader clsql-default-row-reader (fields)
+  (values (loop :while (next-row)
+               :collect (loop :for field :across fields
+                              :collect (next-field field)))
+         (when *include-field-names*
+           (loop :for field :across fields
+                 :collect (field-name field)))))
+
+(defmethod database-query ((expression string) (database postgresql-socket3-database) result-types field-names)
+  (let ((connection (database-connection database)))
+    (with-postgresql-handlers (database expression)
+      (let ((*include-field-names* field-names))
+       (cl-postgres:exec-query connection expression #'clsql-default-row-reader))
+      )))
+
+(defmethod database-execute-command
+    ((expression string) (database postgresql-socket3-database))
+  (let ((connection (database-connection database)))
+    (with-postgresql-handlers (database expression)
+      (exec-query connection expression))))
+
+;;;; Cursoring interface
+
+(defclass cursor ()
+  ((next-row :accessor next-row :initarg :next-row :initform nil)
+   (fields :accessor fields :initarg :fields :initform nil)
+   (next-field :accessor next-field :initarg :next-field :initform nil)
+   (done :accessor done :initarg :done :initform nil)))
+
+(defvar *cursor* ())
+
+(cl-postgres:def-row-reader clsql-cursored-row-reader (fields)
+  (setf *cursor*
+       (make-instance 'cursor :next-row #'next-row :fields fields :next-field #'next-field)))
+
+(defmethod database-query-result-set ((expression string)
+                                      (database postgresql-socket3-database)
+                                      &key full-set result-types)
+  (declare (ignore full-set))
+  (let ((connection (database-connection database))
+       *cursor*)
+    (with-postgresql-handlers (database expression)
+      (cl-postgres:exec-query connection expression 'clsql-cursored-row-reader)
+      (values *cursor* (length (fields *cursor*))))))
+
+(defmethod database-dump-result-set (result-set
+                                     (database postgresql-socket-database))
+  (unless (done result-set)
+    (loop :while (funcall (next-row result-set))))
+  T)
+
+(defmethod database-store-next-row (result-set
+                                    (database postgresql-socket-database)
+                                    list)
+  (when (and (not (done result-set))
+            (setf (done result-set) (funcall (next-row result-set))))
+    
+    (let* ((data (loop :for field :across (fields result-set)
+                      :collect (funcall (next-field result-set) field))))
+      ;; Maybe?
+      (setf (car list) (car data)
+           (cdr list) (cdr data)))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(defmethod database-create (connection-spec (type (eql :postgresql-socket3)))
+  (destructuring-bind (host name user password &optional port options tty) connection-spec
+    (let ((database (database-connect (list host "postgres" user password)
+                                      type)))
+      (setf (slot-value database 'clsql-sys::state) :open)
+      (unwind-protect
+           (database-execute-command (format nil "create database ~A" name) database)
+        (database-disconnect database)))))
+
+(defmethod database-destroy (connection-spec (type (eql :postgresql-socket3)))
+  (destructuring-bind (host name user password &optional port optional tty) connection-spec
+    (let ((database (database-connect (list host "postgres" user password)
+                                      type)))
+      (setf (slot-value database 'clsql-sys::state) :open)
+      (unwind-protect
+          (database-execute-command (format nil "drop database ~A" name) database)
+        (database-disconnect database)))))
+
+
+(defmethod database-probe (connection-spec (type (eql :postgresql-socket3)))
+  (when (find (second connection-spec) (database-list connection-spec type)
+              :test #'string-equal)
+    t))
+
+
+;; Database capabilities
+
+(defmethod db-backend-has-create/destroy-db? ((db-type (eql :postgresql-socket3)))
+  nil)
+
+(defmethod db-type-has-fancy-math? ((db-type (eql :postgresql-socket3)))
+  t)
+
+(defmethod db-type-default-case ((db-type (eql :postgresql-socket3)))
+  :lower)
+
+(defmethod database-underlying-type ((database postgresql-socket3-database))
+  :postgresql)
+
+(when (clsql-sys:database-type-library-loaded :postgresql-socket3)
+  (clsql-sys:initialize-database-type :database-type :postgresql-socket3))