Restrukturert trunk.
Lispkoden ligger nå i trunk/lisp Lagt til trunk/python, som inneholder interface.py, en sped begynnelse på et brukerinterfjas mot bibsys/databasen. Lagt til modifisert PyZ3950-bibliotek (\ /) (O.o) (> <) Bunny approves these changes.
This commit is contained in:
272
lisp/libyaz.lisp
Normal file
272
lisp/libyaz.lisp
Normal file
@@ -0,0 +1,272 @@
|
||||
|
||||
(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))))
|
||||
Reference in New Issue
Block a user