(in-package :cl-postgres)
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun integer-reader-name (bytes signed)
(intern (with-standard-io-syntax
(format nil "~a~a~a~a" '#:read- (if signed "" '#:u) '#:int bytes))))
(defun integer-writer-name (bytes signed)
(intern (with-standard-io-syntax
(format nil "~a~a~a~a" '#:write- (if signed "" '#:u) '#:int bytes)))))
(defmacro integer-reader (bytes)
"Create a function to read integers from a binary stream."
(let ((bits (* bytes 8)))
(labels ((return-form (signed)
`(if (logbitp ,(1- bits) result)
(dpb result (byte ,(1- bits) 0) -1)
(generate-reader (signed)
`(defun ,(integer-reader-name bytes signed) (socket)
(declare (type stream socket)
`(let ((result (the (unsigned-byte 8) (read-byte socket))))
(declare (type (unsigned-byte 8) result))
(declare (type (unsigned-byte ,bits) result))
,@(loop :for byte :from (1- bytes) :downto 0
:collect `(setf (ldb (byte 8 ,(* 8 byte)) result)
(the (unsigned-byte 8) (read-byte socket))))
,(return-form signed))))))
(declaim (ftype (function (t) (signed-byte ,bits))
,(integer-reader-name bytes t)))
(declaim (ftype (function (t) (unsigned-byte ,bits))
,(integer-reader-name bytes nil)))
,(generate-reader nil)))))
(defmacro integer-writer (bytes)
"Create a function to write integers to a binary stream."
(let ((bits (* 8 bytes)))
(declaim (inline ,(integer-writer-name bytes t)
,(integer-writer-name bytes nil)))
(defun ,(integer-writer-name bytes nil) (socket value)
(declare (type stream socket)
(type (unsigned-byte ,bits) value)
`((write-byte value socket))
(loop :for byte :from (1- bytes) :downto 0
:collect `(write-byte (ldb (byte 8 ,(* byte 8)) value)
(defun ,(integer-writer-name bytes t) (socket value)
(declare (type stream socket)
(type (signed-byte ,bits) value)
`((write-byte (ldb (byte 8 0) value) socket))
(loop :for byte :from (1- bytes) :downto 0
:collect `(write-byte (ldb (byte 8 ,(* byte 8)) value)
(defun write-bytes (socket bytes)
"Write a byte-array to a stream."
(declare (type stream socket)
(type (simple-array (unsigned-byte 8)) bytes)
(write-sequence bytes socket))
(defun write-str (socket string)
"Write a null-terminated string to a stream \(encoding it when UTF-8
(declare (type stream socket)
(enc-write-string string socket)
(declaim (ftype (function (t unsigned-byte)
(simple-array (unsigned-byte 8) (*)))
(defun read-bytes (socket length)
"Read a byte array of the given length from a stream."
(declare (type stream socket)
(let ((result (make-array length :element-type '(unsigned-byte 8))))
(read-sequence result socket)
(declaim (ftype (function (t) string) read-str))
"Read a null-terminated string from a stream. Takes care of encoding
when UTF-8 support is enabled."
(declare (type stream socket)
(enc-read-string socket :null-terminated t))
(defun skip-bytes (socket length)
"Skip a given number of bytes in a binary stream."
(declare (type stream socket)
(type (unsigned-byte 32) length)
"Skip a null-terminated string."
(declare (type stream socket)
(loop :for char :of-type fixnum = (read-byte socket)
(defun ensure-socket-is-closed (socket &key abort)
(when (open-stream-p socket)
(close socket :abort abort)
(warn "Ignoring the error which happened while trying to close PostgreSQL socket: ~A" error)))))