commit f43845d322f289deb19749161ed01ba2dba70f2b
parent 94bd5f470d032edc611f095d11618732d5f6bfe1
Author: Tomas Hlavaty <tom@logand.com>
Date: Mon, 23 Sep 2013 00:04:54 +0200
depend on cl-rw, pg improvements e.g. :null handling protocol
Diffstat:
4 files changed, 56 insertions(+), 193 deletions(-)
diff --git a/Makefile b/Makefile
@@ -10,12 +10,12 @@ dbquery-pg: dbquery-pg.c common.c
$(CC) $(CFLAGS) -o $@ $< -lpq
strip $@
-dbquery-mysql: dbquery-mysql.c common.o
- $(CC) $(CFLAGS) -o $@ $< common.o `mysql_config --cflags --libs`
+dbquery-mysql: dbquery-mysql.c common.c
+ $(CC) $(CFLAGS) -o $@ $< `mysql_config --cflags --libs`
strip $@
-dbquery-sqlite: dbquery-sqlite.c common.o
- $(CC) $(CFLAGS) -o $@ $< common.o -lsqlite3
+dbquery-sqlite: dbquery-sqlite.c common.c
+ $(CC) $(CFLAGS) -o $@ $< -lsqlite3
strip $@
clean:
diff --git a/common.c b/common.c
@@ -54,7 +54,7 @@ static void pqstr(char *x) {
putchar('"');
putchar('\n');
}
-static void pnil() {pqstr("NIL");}
+static void pnil() {putchar('?'); putchar('\n');}
static int rnum(void) { // TODO limit interval
int z = 0, y = 0;
@@ -73,7 +73,12 @@ static char *buf;
static char *rstr(void) {
char *z = buf;
- if('"' != getchar()) die("expected string");
+ char c = getchar();
+ if('?' == c) { // :null value
+ if('\n' != getchar()) die("expected eol");
+ return NULL;
+ }
+ if('"' != c) die("expected string");
for(;;) {
if(heap + HLEN <= buf) die("out of memory");
int c = getchar();
diff --git a/dbquery.asd b/dbquery.asd
@@ -32,6 +32,6 @@
:author "Tomas Hlavaty <tom@logand.com>"
:maintainer "Tomas Hlavaty <tom@logand.com>"
:licence "MIT"
- :depends-on (#+sbcl :sb-concurrency)
+ :depends-on (:cl-rw)
:serial t
:components ((:file "dbquery")))
diff --git a/dbquery.lisp b/dbquery.lisp
@@ -33,175 +33,6 @@
(in-package :dbquery)
-;; (defun call-with-program-output (command fn)
-;; #+ccl
-;; (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 )))
-;; #+ecl
-;; (multiple-value-bind (io status proc)
-;; (ext:run-program (car command) (cdr command)
-;; :input nil
-;; :output :stream
-;; :error nil ;;t
-;; :wait nil)
-;; (when proc
-;; (funcall fn io)
-;; #+nil
-;; (unwind-protect (funcall fn io)
-;; (close io)
-;; (ext:external-process-wait proc))))
-;; #-(or ccl ecl)
-;; (error "DBQUERY::CALL-WITH-PROGRAM-OUTPUT not implemented"))
-
-;; (defmacro with-program-output ((stream command) &body body)
-;; `(call-with-program-output ,command (lambda (,stream) ,@body)))
-
-;; ;;(with-program-output (s '("sha1sum" "/etc/passwd")))
-;; ;;(with-program-output (s '("sha1sum" "/etc/passwd")) (read-line s))
-
-(defmacro with-lock ((lock) &body body)
- #+ccl `(ccl:with-lock-grabbed (,lock) ,@body)
- #+ecl `(mp:with-lock (,lock) ,@body)
- #+sbcl `(sb-concurrency::with-mutex (,lock) ,@body)
- #-(or ccl ecl sbcl) (error "DBQUERY::WITH-LOCK not implemented"))
-
-(defun make-lock (name)
- #+ccl (ccl:make-lock name)
- #+ecl (mp:make-lock :name name)
- #+sbcl (sb-concurrency::make-mutex :name (string name))
- #-(or ccl ecl sbcl) (error "DBQUERY::MAKE-LOCK not implemented"))
-
-(defun make-semaphore ()
- #+ccl (ccl:make-semaphore)
- #+ecl (mp:make-semaphore)
- #+sbcl (sb-concurrency::make-semaphore)
- #-(or ccl ecl sbcl) (error "DBQUERY::MAKE-SEMAPHORE not implemented"))
-
-(defun signal-semaphore (x)
- #+ccl (ccl:signal-semaphore x)
- #+ecl (mp:signal-semaphore x)
- #+sbcl (sb-concurrency::signal-semaphore x)
- #-(or ccl ecl sbcl) (error "DBQUERY::SIGNAL-SEMAPHORE not implemented"))
-
-(defun wait-on-semaphore (x)
- #+ccl (ccl:wait-on-semaphore x)
- #+ecl (mp:wait-on-semaphore x)
- #+sbcl (sb-concurrency::wait-on-semaphore x)
- #-(or ccl ecl sbcl) (error "DBQUERY::WAIT-ON-SEMAPHORE not implemented"))
-
-(defun make-concurrent-queue ()
- (let ((x (cons nil nil))
- (l (make-lock 'concurrent-queue-lock))
- (s (make-semaphore)))
- (setf (car x) x)
- (lambda (&optional (value nil valuep))
- (if valuep
- (let ((y (cons value nil)))
- (with-lock (l)
- (setf (cdar x) y
- (car x) y)
- (signal-semaphore s))
- value)
- (do (done z)
- (done z)
- (wait-on-semaphore s)
- (with-lock (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-thread (name fn)
- #+ccl (ccl:process-run-function name fn)
- #+ecl (mp:process-run-function name fn)
- #+sbcl (sb-concurrency::make-thread fn :name (string name))
- #-(or ccl ecl sbcl) (error "DBQUERY::MAKE-THREAD not implemented"))
-
-(defun make-program (command args)
- #+ccl
- (let ((p (ccl:run-program command
- args
- :input :stream
- :output :stream
- :error nil
- :sharing :external
- :wait nil)))
- (assert (eq :running (ccl:external-process-status p)))
- (lambda (msg)
- (ecase msg
- (status-and-code (ccl:external-process-status p))
- (input-stream (ccl:external-process-input-stream p))
- (output-stream (ccl:external-process-output-stream p))
- (wait (ccl::external-process-wait p)))))
- #+ecl
- (multiple-value-bind (io x p)
- (ext:run-program command
- args
- :input :stream
- :output :stream
- :error nil
- :wait nil)
- (declare (ignore x))
- (assert (eq :running (ext:external-process-status p)))
- (lambda (msg)
- (ecase msg
- (status-and-code (ext:external-process-status p))
- (input-stream io)
- (output-stream io)
- (wait (ext:external-process-wait p)))))
- #+sbcl
- (let ((p (sb-ext:run-program command
- args
- :input :stream
- :output :stream
- :error nil
- :wait nil)))
- (assert (eq :running (sb-ext:process-status p)))
- (lambda (msg)
- (ecase msg
- (status-and-code (sb-ext:process-status p))
- (input-stream (sb-ext:process-input p))
- (output-stream (sb-ext:process-output p))
- (wait (sb-ext:process-wait p)))))
- #-(or ccl ecl sbcl)
- (error "DBQUERY::MAKE-PROGRAM not implemented"))
-
-(defun make-program-server (command args writer reader)
- (let ((p (make-program command args))
- (wq (make-concurrent-queue)))
- (make-thread 'program-server-writer
- (let ((s (funcall p 'input-stream)))
- (lambda ()
- (do (x)
- ((not (setq x (funcall wq)))
- (close s))
- (funcall writer x s)))))
- (let ((l (make-lock 'program-server-lock))
- (s (funcall p 'output-stream)))
- (lambda (query)
- (with-lock (l)
- (when wq
- (cond
- (query
- (funcall wq query)
- (funcall reader s))
- (t (funcall wq nil)
- (setq wq nil)
- (funcall p 'wait)
- (multiple-value-bind (status code) (funcall p 'status-and-code)
- (assert (eq :exited status))
- (assert (zerop code)))))))))))
-
(defun query (server q &rest args)
(funcall server `(:query ,q ,@args)))
@@ -229,16 +60,20 @@
(t (error "expected number ~d ~s" z c))))))
(defun rstr ()
- (assert (char= #\" (read-char)))
- (with-output-to-string (*standard-output*)
- (do (done)
- (done)
- (let ((c (read-char)))
- (case c
- (#\\ (write-char (read-char)))
- (#\" (assert (char= #\newline (read-char)))
- (setq done t))
- (t (write-char c)))))))
+ (ecase (read-char)
+ (#\?
+ (assert (char= #\newline (read-char)))
+ :null)
+ (#\"
+ (with-output-to-string (*standard-output*)
+ (do (done)
+ (done)
+ (let ((c (read-char)))
+ (case c
+ (#\\ (write-char (read-char)))
+ (#\" (assert (char= #\newline (read-char)))
+ (setq done t))
+ (t (write-char c)))))))))
(defun dbquery-pg-writer (value *standard-output*)
(destructuring-bind (cmd &rest rest) value
@@ -262,6 +97,7 @@
(format t "3~%~d~%~s~%" (length args) stm)
(dolist (a args)
(etypecase a
+ (null (format t "-~%"))
(integer (format t "\"~s\"~%" a))
(string (format t "~s~%" a))))))
(:deallocate
@@ -269,6 +105,22 @@
(%query (format nil "DEALLOCATE ~s" stm)))))))
(finish-output))
+;;http://doxygen.postgresql.org/interfaces_2ecpg_2ecpglib_2pg__type_8h.html
+(defun parse-pg-value (value type)
+ (if (eq :null value)
+ :null
+ (ecase type
+ (16 (cond
+ ((equal "t" value) :true)
+ ((equal "f" value) :false)
+ (t (error "unexpected boolean value ~s" value))))
+ ((#+nil 25 1700) (parse-integer value))
+ (1043 value)
+ (1184 ;; TODO parse "2010-06-21 18:54:11+02"
+ value))))
+
+;;(DBQUERY::PARSE-PG-VALUE "VAF0co3Ymo/mWob7qH1p/zCdSyhgp4+5n+Wp/cuoVy75v9BRKIVlSQtb8Jq4p3AexYExdbmEZO2wKcpkymsqAbfN8F5dB+atrBsIAAAA" 25)
+
(defun dbquery-pg-reader (*standard-input*)
(ecase (rnum)
(0 (error "Database error ~s ~s" (rstr) (rstr)))
@@ -276,21 +128,27 @@
(let ((n (rnum))
(m (rnum)))
(when (and (plusp n) (plusp m))
- (cons (loop for i from 0 below m collect (cons (rnum) (rstr)))
- (loop
- for i from 0 below n
- appending (loop for j from 0 below m collect (rstr)))))))
+ (let ((cols (loop for i from 0 below m collect (cons (rnum) (rstr)))))
+ (progn ;;cons cols
+ (loop
+ for i from 0 below n
+ collect (loop
+ for j from 0 below m
+ for (type . name) in cols
+ collect (parse-pg-value (rstr) type))))))))
(2)))
(defun make-pg-server (command connection-info)
- (make-program-server
+ (rw.concurrency:make-program-server
command (list connection-info) 'dbquery-pg-writer 'dbquery-pg-reader))
(defun make-sqlite-server (command db)
- (make-program-server command (list db) 'dbquery-writer 'dbquery-reader))
+ (rw.concurrency:make-program-server
+ command (list db) 'dbquery-writer 'dbquery-reader))
(defun make-mysql-server (command host user password db)
- (make-program-server command (list host user password db) 'dbquery-writer 'dbquery-reader))
+ (rw.concurrency:make-program-server
+ command (list host user password db) 'dbquery-writer 'dbquery-reader))
;; (setq c (make-pg-server "cat" "-"))
;; (funcall c "123")
