From 126812fb21eeb397865ebd1f4cfaf13ca5b350f3 Mon Sep 17 00:00:00 2001 From: Russ Tyndall Date: Mon, 28 Sep 2009 17:34:01 -0400 Subject: [PATCH] first draft of implementing cl-postgres as a backend for clsql (called db-postgresql-socket3 (after the protocol version)) --- clsql-postgresql-socket3.asd | 41 +++++ db-postgresql-socket3/.gitignore | 14 ++ db-postgresql-socket3/api.lisp | 29 ++++ db-postgresql-socket3/package.lisp | 26 +++ db-postgresql-socket3/sql.lisp | 255 +++++++++++++++++++++++++++++ 5 files changed, 365 insertions(+) create mode 100644 clsql-postgresql-socket3.asd create mode 100644 db-postgresql-socket3/.gitignore create mode 100644 db-postgresql-socket3/api.lisp create mode 100644 db-postgresql-socket3/package.lisp create mode 100644 db-postgresql-socket3/sql.lisp diff --git a/clsql-postgresql-socket3.asd b/clsql-postgresql-socket3.asd new file mode 100644 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 " + :maintainer "Russ Tyndall " + :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 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 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 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 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)) -- 2.34.1