worblehat-old/lisp/libyaz.lisp

(in-package #:z3950)

(define-foreign-library libyaz
  (t (:default "libyaz.3")))

(use-foreign-library libyaz)

(defctype zoom-options :pointer)

(defcfun "ZOOM_options_create" zoom-options)

(defcfun "ZOOM_options_create_with_parent" zoom-options
  (parent zoom-options))

(defcfun "ZOOM_options_destroy" :void
  (opt zoom-options))

(defcfun "ZOOM_options_get" :string
  (opt zoom-options)
  (name :string))

(defcfun "ZOOM_options_set" :void
  (opt zoom-options)
  (name :string)
  (v :string))

;; TODO: ZOOM_options_callback.

(defctype zoom-connection :pointer)

(defcfun "ZOOM_connection_new" zoom-connection
  (host :string)
  (portnum :int))

(defcfun "ZOOM_connection_create" zoom-connection
  (options :pointer))

(defcfun "ZOOM_connection_connect" :void
  (connection zoom-connection)
  (host :string)
  (portnum :int))

(defcfun "ZOOM_connection_destroy" :void
  (connection zoom-connection))

(defctype string-ptr :pointer)

(defcfun "ZOOM_connection_error" :int
  (connection zoom-connection)
  (cp string-ptr)
  (addinfo string-ptr))

(defcfun "ZOOM_connection_option_get" :string
  (connection zoom-connection)
  (key :string))

(defcfun "ZOOM_connection_option_set" :void
  (connection zoom-connection)
  (key :string)
  (value :string))

(defctype zoom-query :pointer)

(defcfun "ZOOM_query_create" zoom-query)

(defcfun "ZOOM_query_destroy" :void
  (query zoom-query))

(defcfun "ZOOM_query_prefix" :int
  (query zoom-query)
  (str :string))

(defcfun "ZOOM_query_cql" :int
  (query zoom-query)
  (str :string))

(defcfun "ZOOM_query_sortby" :int
  (query zoom-query)
  (criteria :string))

(defctype zoom-resultset :pointer)

(defcfun "ZOOM_connection_search" zoom-resultset
  (connection zoom-connection)
  (query zoom-query))

(defcfun "ZOOM_connection_search_pqf" zoom-resultset
  (connection zoom-connection)
  (q :string))

(defcfun "ZOOM_resultset_destroy" :void
  (resultset zoom-resultset))

(defcfun "ZOOM_resultset_option_set" :void
  (resultset zoom-resultset)
  (key :string)
  (val :string))

(defcfun "ZOOM_resultset_option_get" :string
  (resultset zoom-resultset)
  (key :string))

(defcfun "ZOOM_resultset_size" size
  (resultset zoom-resultset))

(defctype zoom-record :pointer)

(defctype zoom-record-ptr :pointer)

(defcfun "ZOOM_resultset_records" :void
  (resultset zoom-resultset)
  (recs zoom-record-ptr)
  (start size)
  (count size))

(defcfun "ZOOM_resultset_record" zoom-record
  (resultset zoom-resultset)
  (pos size))

(defctype size-ptr :pointer)

(defcfun "ZOOM_record_get" :pointer
  (record zoom-record)
  (type :string)
  (len size-ptr))

;; TODO: ZOOM_record_error.

(defcfun "ZOOM_record_clone" zoom-record
  (rec zoom-record))

(defcfun "ZOOM_record_destroy" :void
  (rec zoom-record))

;; TODO: Scan.

(defcfun "memcpy" :pointer
  (dest :pointer)
  (src :pointer)
  (n size))


;;;
;;; Lisp API
;;;

(defclass connection ()
  ((foreign)
   (charset :initarg :charset :accessor connection-charset)
   (result-sets :initform nil :accessor connection-result-sets)))

(define-condition connection-error (error)
  ((cp :initarg :cp)
   (addinfo :initarg :addinfo))
  (:report (lambda (condition stream)
	     (with-slots (cp addinfo) condition
	       (format stream "~A: ~A" cp addinfo)))))

(defmethod check-for-connection-error ((c connection))
  (with-slots (foreign) c
    (cffi:with-foreign-object (cp :pointer)
      (cffi:with-foreign-object (addinfo :pointer)
	(unless (zerop (zoom-connection-error foreign cp addinfo))
	  (error 'connection-error 
		 :cp (cffi:foreign-string-to-lisp (mem-ref cp :pointer))
		 :addinfo (cffi:foreign-string-to-lisp 
			   (mem-ref addinfo :pointer))))))))
  
(defun connect (host &key port (charset :utf8))
  (let ((c (make-instance 'connection :charset charset)))
    (with-slots (foreign) c
      (setf foreign (zoom-connection-create (cffi:null-pointer)))
      (zoom-connection-connect foreign host (or port 0)))
    (check-for-connection-error c)
    c))

(defmethod disconnect ((c connection))
  "Close the connection to the Z39.50 server."
  (with-slots (result-sets foreign) c
    (when foreign
      (dolist (weak-ref result-sets)
	(when #1=(trivial-garbage:weak-pointer-value weak-ref)
	      (close-result-set #1#)))
      (zoom-connection-destroy foreign)
      (setf foreign nil)
      t)))

(defmacro with-open-connection ((var host &rest connect-args) 
				&body body)
  `(let ((,var (connect ,host ,@connect-args)))
     (unwind-protect (progn ,@body)
       (disconnect ,var))))

(defmethod connection-host ((c connection))
  (with-slots (foreign) c
    (zoom-connection-option-get foreign "host")))


(defclass result-set ()
  ((foreign :initarg :foreign)
   (connection :initarg :connection :reader result-set-connection)))

(defmethod initialize-instance :after ((rs result-set) &key)
  (push (trivial-garbage:make-weak-pointer rs)
	(connection-result-sets (result-set-connection rs))))

(defmethod close-result-set ((rs result-set))
  (with-slots (foreign) rs
    (when foreign
      (zoom-resultset-destroy foreign)
      (setf foreign nil)
      t)))

(defmethod (setf result-set-preferred-record-syntax) (value (rs result-set))
  (with-slots (foreign) rs
    (zoom-resultset-option-set foreign "preferredRecordSyntax" value)))

(defmethod result-set-size ((rs result-set))
  (with-slots (foreign) rs
    (zoom-resultset-size foreign)))

(defmethod result-set-record ((rs result-set) i &key (form :raw))
  (with-slots (foreign) rs
    (let ((r (zoom-resultset-record foreign i)))
      (let ((syntax (cffi:foreign-string-to-lisp
		     (zoom-record-get r "syntax" (cffi:null-pointer)))))
	(with-foreign-object (len :int)
	  (let* ((src (zoom-record-get r (ecase form
					   (:raw "raw; charset=marc8"))
				       len))
		 (buf (cffi:make-shareable-byte-vector (cffi:mem-ref len
								     :int))))
	    (with-pointer-to-vector-data (dest buf)
	      (memcpy dest src (cffi:mem-ref len :int)))
	    (values buf syntax)))))))

(defmethod search-pqf ((c connection) (q string))
  (make-instance 'result-set 
		 :connection c
		 :foreign (with-slots (foreign) c
			    ;; (let ((cffi:*default-foreign-encoding* 
			    ;;	   (connection-charset c)))
			      (zoom-connection-search-pqf foreign q)
			      ;; )
			    )))

(defmacro with-query ((var) &body body)
  `(let ((,var (zoom-query-create)))
     (unwind-protect (progn ,@body)
       (zoom-query-destroy ,var))))

(defmethod search-cql ((c connection) (query-string string))
  (with-query (q)
    (zoom-query-cql q query-string) ;; FIXME: Return value?
    (with-slots (foreign) c
      (make-instance 'result-set 
		     :connection c
		     :foreign (zoom-connection-search foreign q)))))


(defun test-loc ()
  (with-open-connection (c "z3950.loc.gov:7490/Voyager" :charset :latin1)
    (let ((rs (search-pqf c "@1=4 \"Alt imellem\"")))
      (setf (result-set-preferred-record-syntax rs) "MARC21")
      (result-set-record rs 0))))

(defun test-bibsys ()
  (with-open-connection (c "z3950.bibsys.no" :port 2100 :charset :latin1)
    (let ((rs (search-pqf c "@1=4 \"Fru Inger til Østråt\"")))
      (setf (result-set-preferred-record-syntax rs) "NORMARC")
      (result-set-record rs 0))))