commit 870a499c1fbef28d728e8d312a3161c472036c70
parent c4b3eb2b27ea83d774a27dbaceafc12904901190
Author: Tomas Hlavaty <tom@logand.com>
Date: Tue, 5 Mar 2013 22:05:50 +0100
added dbquery for common lisp
Diffstat:
| A | dbquery.asd | | | 36 | ++++++++++++++++++++++++++++++++++++ |
| A | dbquery.lisp | | | 135 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
2 files changed, 171 insertions(+), 0 deletions(-)
diff --git a/dbquery.asd b/dbquery.asd
@@ -0,0 +1,36 @@
+;;; -*- lisp; -*-
+
+;;; Copyright (C) 2013 Tomas Hlavaty <tom@logand.com>
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+
+(defpackage :dbquery-system
+ (:use :asdf :cl))
+
+(in-package :dbquery-system)
+
+(defsystem :dbquery
+ :description "dbquery for Common Lisp"
+ :author "Tomas Hlavaty <tom@logand.com>"
+ :maintainer "Tomas Hlavaty <tom@logand.com>"
+ :licence "MIT"
+ :serial t
+ :components ((:file "dbquery")))
diff --git a/dbquery.lisp b/dbquery.lisp
@@ -0,0 +1,135 @@
+;;; Copyright (C) 2013 Tomas Hlavaty <tom@logand.com>
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+
+(defpackage :dbquery
+ (:use :cl))
+
+(in-package :dbquery)
+
+(defun call-with-program-output (command fn)
+ (let ((x (ccl:run-program (car command) (cdr command) :output :stream)))
+ (funcall fn (ccl:external-process-output-stream x))
+ #+nil
+ (unwind-protect (funcall fn (ccl:external-process-output-stream x))
+ (ccl:external-process-status ))))
+
+(defmacro with-program-output ((stream command) &body body)
+ `(call-with-program-output ,command (lambda (,stream) ,@body)))
+
+#+nil
+(time
+ (with-program-output (s (list "./dbquery-sqlite"
+ "sqlite.db"
+ "select 123, 1, 0, null, 12.34, 'hello'"))
+ (read s)))
+
+#+nil
+(time
+ (with-program-output (s (list "./dbquery-pg"
+ "dbname='pokus' user='tomas'"
+ "select 123, 1, 0, null, 12.34, 'hello'"))
+ (read s)))
+
+(defun make-concurrent-queue ()
+ (let ((x (cons nil nil))
+ (l (ccl:make-lock 'concurrent-queue-lock))
+ (s (ccl:make-semaphore)))
+ (setf (car x) x)
+ (lambda (&optional (value nil valuep))
+ (if valuep
+ (let ((y (cons value nil)))
+ (ccl:with-lock-grabbed (l)
+ (setf (cdar x) y
+ (car x) y)
+ (ccl:signal-semaphore s))
+ value)
+ (do (done z)
+ (done z)
+ (ccl:wait-on-semaphore s)
+ (ccl:with-lock-grabbed (l)
+ (unless (eq x (car x))
+ (setq done t
+ z (pop (cdr x)))
+ (unless (cdr x)
+ (setf (car x) x)))))))))
+
+;; (setq q (make-concurrent-queue))
+;; (funcall q 1)
+;; (funcall q 2)
+;; (funcall q 3)
+;; (funcall q)
+
+(defun make-program-server (command args writer reader)
+ (let ((p (ccl:run-program command
+ args
+ :input :stream
+ :output :stream
+ :sharing :external
+ :wait nil)))
+ (assert (eq :running (ccl:external-process-status p)))
+ (let ((wq (make-concurrent-queue)))
+ (ccl:process-run-function
+ 'program-server-writer
+ (let ((s (ccl:external-process-input-stream p)))
+ (lambda ()
+ (do (x)
+ ((not (setq x (funcall wq)))
+ (close s))
+ (funcall writer x s)))))
+ (let ((l (ccl:make-lock 'program-server-lock))
+ (s (ccl:external-process-output-stream p)))
+ (lambda (&optional query)
+ (ccl:with-lock-grabbed (l)
+ (when wq
+ (cond
+ (query
+ (funcall wq query)
+ (funcall reader s))
+ (t (funcall wq nil)
+ (setq wq nil)
+ (ccl::external-process-wait p)
+ (multiple-value-bind (status code) (ccl:external-process-status p)
+ (assert (eq :exited status))
+ (assert (zerop code))))))))))))
+
+(defun dbquery-writer (value stream)
+ (write-line value stream)
+ (finish-output stream))
+
+(defun dbquery-reader (stream) ;; TODO raise backend errors!
+ (let (*read-eval*)
+ (prog1 (read stream nil nil)
+ (assert (char= #\newline (read-char stream))))))
+
+(defun make-pg-server (command connection-info)
+ (make-program-server command (list connection-info) 'dbquery-writer 'dbquery-reader))
+
+;; (setq c (make-pg-server "cat" "-"))
+;; (funcall c "123")
+;; (funcall c nil)
+;; (funcall c)
+
+;; (setq c (make-pg-server "./dbquery-pg" "dbname='pokus' user='tomas'"))
+;; (funcall c "select 1, 2+3")
+;; (time (funcall c "select 4, 'hello'"))
+;; (funcall c nil)
+;; (funcall c)
