Thanks a lot Andy for the Lisp binding! It will be included and referenced on the homepage today or tomorrow.
All the best, Christian
On Sat, Apr 24, 2010 at 2:37 AM, Andy Chambers achambers.home@googlemail.com wrote:
Hey All,
I've recently discovered basex and it seems to be a pretty cool project. Thanks for making it open source. Here's a common lisp language binding to add to the mix. I developed it on sbcl against basex version 6.1 by transcribing the python version.
Thanks again, Andy
;;; file: example.lisp ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defpackage :basex-user (:use :cl :basex))
(in-package :basex-user)
(time (let ((session (make-instance 'session))) (if (execute session "xquery 1 to 10") (print (result session)) (print (info session)))
(close-session session)))
;;; file: basex-client.lisp ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defpackage :basex (:use :cl :usocket) (:export :session :execute :close-session :info :result))
(in-package :basex)
(defconstant +null+ (code-char 0))
(defclass session () ((host :initarg :host :initform "localhost") (port :initarg :port :initform 1984) (user :initarg :user :initform "admin") (pw :initarg :pw :initform "admin") (sock :initform nil) (result :initform nil :accessor result) (info :initform nil :accessor info)))
(defmethod initialize-instance :after ((self session) &key) (with-slots (host port user pw sock) self (setf sock (socket-connect host port :element-type '(unsigned-byte 8))) (unless (hand-shake self) (error "Could not initiate connection"))))
(defun hand-shake (session) (declare (optimize debug)) (labels ((md5 (str) (string-downcase (with-output-to-string (s) (loop for hex across (sb-md5:md5sum-string str) do (format s "~2,'0x" hex))))) (auth-token (pw timestamp) (md5 (format nil "~a~a" (md5 pw) timestamp))))
(with-slots (user pw sock) session (let* ((ts (read-null-terminated (socket-stream sock))) (auth (auth-token pw ts))) (write-null-terminated user (socket-stream sock)) (write-null-terminated auth (socket-stream sock)) (force-output (socket-stream sock)) (eq 0 (read-byte (socket-stream sock)))))))
(defun read-null-terminated (in) (with-output-to-string (s) (loop for char = (code-char (read-byte in)) until (char= char +null+) do (write-char char s))))
(defun write-null-terminated (string out) (loop for char across string do (write-byte (char-code char) out)) (write-byte (char-code +null+) out))
(defmethod execute ((self session) query) (with-slots (sock) self (let ((stream (socket-stream sock))) (write-null-terminated query stream) (force-output stream) (setf (result self) (read-null-terminated stream) (info self) (read-null-terminated stream)) (eq 0 (read-byte (socket-stream sock))))))
(defmethod open-session ((self session)) (unwind-protect (unless (hand-shake self) (error "Could not open session")) (close-session self)))
(defmethod close-session ((self session)) (with-slots (sock) self (write-null-terminated "exit" (socket-stream sock)) (socket-close sock)))
--
Andy Chambers Formedix Ltd _______________________________________________ BaseX-Talk mailing list BaseX-Talk@mailman.uni-konstanz.de https://mailman.uni-konstanz.de/mailman/listinfo/basex-talk