X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=db-postgresql-socket3%2Fsql.lisp;h=6fdef8e1c6b8ea7c404a722f371975cbb9f9acb1;hb=814ef0649edf23f0136d5cad2d7738ae72e79871;hp=9e9a879bd20b03127053cd89049c1d910fa8b494;hpb=9f2b1f47684151e0706d51540ab5424c005f3184;p=clsql.git diff --git a/db-postgresql-socket3/sql.lisp b/db-postgresql-socket3/sql.lisp index 9e9a879..6fdef8e 100644 --- a/db-postgresql-socket3/sql.lisp +++ b/db-postgresql-socket3/sql.lisp @@ -22,10 +22,27 @@ (defpackage :clsql-postgresql-socket3 (:use #:common-lisp #:clsql-sys #:postgresql-socket3) (:export #:postgresql-socket3-database) - (:documentation "This is the CLSQL socket interface to PostgreSQL.")) + (:documentation "This is the CLSQL socket interface (protocol version 3) to PostgreSQL.")) (in-package #:clsql-postgresql-socket3) +(defvar *sqlreader* (cl-postgres:copy-sql-readtable)) +(let ((dt-fn (lambda (useconds-since-2000) + (let ((sec (truncate + (/ useconds-since-2000 + 1000000))) + (usec (mod useconds-since-2000 + 1000000))) + (clsql:make-time :year 2000 :second sec :usec usec))))) + (cl-postgres:set-sql-datetime-readers + :table *sqlreader* + :date (lambda (days-since-2000) + (clsql:make-date :year 2000 :day (+ 1 days-since-2000))) + :timestamp dt-fn + :timestamp-with-timezone dt-fn)) + + + ;; interface foreign library loading routines (clsql-sys:database-type-load-foreign :postgresql-socket3) @@ -41,11 +58,11 @@ (ecase *backend-warning-behavior* (:warn (warn 'sql-database-warning :database database - :message (postgresql-condition-message condition))) + :message (cl-postgres:database-error-message condition))) (:error (error 'sql-database-error :database database :message (format nil "Warning upgraded to error: ~A" - (postgresql-condition-message condition)))) + (cl-postgres:database-error-message condition)))) ((:ignore nil) ;; do nothing ))) @@ -55,7 +72,7 @@ :database database :expression expression :error-id (type-of condition) - :message (postgresql-condition-message condition))) + :message (cl-postgres:database-error-message condition))) (defmacro with-postgresql-handlers ((database &optional expression) @@ -67,7 +84,7 @@ (handler-bind ((postgresql-warning (lambda (c) (convert-to-clsql-warning ,database-var c))) - (postgresql-error + (cl-postgres:database-error (lambda (c) (convert-to-clsql-error ,database-var ,expression-var c)))) @@ -103,13 +120,14 @@ "/" db "/" user))) (defmethod database-connect (connection-spec - (database-type (eql :postgresql-socket))) + (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 +postgresql-server-default-port+) (options "") (tty "")) connection-spec + (declare (ignore options tty)) (handler-case (handler-bind ((warning (lambda (c) @@ -117,20 +135,14 @@ :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:open-database db user password host 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))) + :message (cl-postgres:database-error-message c))) (:no-error (connection) ;; Success, make instance (make-instance 'postgresql-socket3-database @@ -145,16 +157,44 @@ (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))))) + +;; THE FOLLOWING MACRO EXPANDS TO THE FUNCTION BELOW IT, +;; BUT TO GET null CONVENTIONS CORRECT I NEEDED TO TWEAK THE EXPANSION +;; +;; (cl-postgres:def-row-reader clsql-default-row-reader (fields) +;; (values (loop :while (cl-postgres:next-row) +;; :collect (loop :for field :across fields +;; :collect (cl-postgres:next-field field))) +;; (when *include-field-names* +;; (loop :for field :across fields +;; :collect (cl-postgres:field-name field))))) + + + +(defun clsql-default-row-reader (stream fields) + (declare (type stream stream) + (type (simple-array cl-postgres::field-description) fields)) + (flet ((cl-postgres:next-row () + (cl-postgres::look-for-row stream)) + (cl-postgres:next-field (cl-postgres::field) + (declare (type cl-postgres::field-description cl-postgres::field)) + (let ((cl-postgres::size (cl-postgres::read-int4 stream))) + (declare (type (signed-byte 32) cl-postgres::size)) + (if (eq cl-postgres::size -1) + nil + (funcall (cl-postgres::field-interpreter cl-postgres::field) + stream cl-postgres::size))))) + (values + (loop :while (cl-postgres:next-row) + :collect (loop :for field :across fields + :collect (cl-postgres:next-field field))) + (when *include-field-names* + (loop :for field :across fields + :collect (cl-postgres:field-name field)))))) (defmethod database-query ((expression string) (database postgresql-socket3-database) result-types field-names) - (let ((connection (database-connection database))) + (let ((connection (database-connection database)) + (cl-postgres:*sql-readtable* *sqlreader*)) (with-postgresql-handlers (database expression) (let ((*include-field-names* field-names)) (cl-postgres:exec-query connection expression #'clsql-default-row-reader)) @@ -164,49 +204,27 @@ ((expression string) (database postgresql-socket3-database)) (let ((connection (database-connection database))) (with-postgresql-handlers (database expression) - (exec-query connection expression)))) + (cl-postgres: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 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*)))))) + (error "Cursoring interface is not supported for postgresql-socket3-database try cl-postgres:exec-query with a custom row-reader")) (defmethod database-dump-result-set (result-set (database postgresql-socket3-database)) - (unless (done result-set) - (loop :while (funcall (next-row result-set)))) + (error "Cursoring interface is not supported for postgresql-socket3-database try cl-postgres:exec-query with a custom row-reader") T) (defmethod database-store-next-row (result-set (database postgresql-socket3-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))))) + (error "Cursoring interface is not supported for postgresql-socket3-database try cl-postgres:exec-query with a custom row-reader")) ;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -214,6 +232,7 @@ (defmethod database-create (connection-spec (type (eql :postgresql-socket3))) (destructuring-bind (host name user password &optional port options tty) connection-spec + (declare (ignore port options tty)) (let ((database (database-connect (list host "postgres" user password) type))) (setf (slot-value database 'clsql-sys::state) :open) @@ -222,7 +241,8 @@ (database-disconnect database))))) (defmethod database-destroy (connection-spec (type (eql :postgresql-socket3))) - (destructuring-bind (host name user password &optional port optional tty) connection-spec + (destructuring-bind (host name user password &optional port options tty) connection-spec + (declare (ignore port options tty)) (let ((database (database-connect (list host "postgres" user password) type))) (setf (slot-value database 'clsql-sys::state) :open)