[cl-dbf-cvs] CVS cl-dbf

[rklochkov]

Update of /project/cl-dbf/cvsroot/cl-dbf
In directory cl-net:/tmp/cvs-serv26011

Modified Files:
	cl-dbf.asd src.lisp 
Log Message:
Fixed asd dependencies.
Added with-db macro. Remove stream from function args except dbopen.


--- /project/cl-dbf/cvsroot/cl-dbf/cl-dbf.asd	2011/05/07 18:28:43	1.1.1.1
+++ /project/cl-dbf/cvsroot/cl-dbf/cl-dbf.asd	2011/05/08 13:48:23	1.2
@@ -7,7 +7,7 @@
   :author "Roman Klochkov <kalimehtar at mail.ru>"
   :version "0.1"
   :license "GPL"
-  :depends-on (#:com.gigamonkeys.binary-data)
+  :depends-on (#:com.gigamonkeys.binary-data #:flexi-streams)
   :components
   ((:file #:package)
    (:file #:src :depends-on (#:package))))
\ В конце файла нет новой строки
--- /project/cl-dbf/cvsroot/cl-dbf/src.lisp	2011/05/07 18:28:43	1.1.1.1
+++ /project/cl-dbf/cvsroot/cl-dbf/src.lisp	2011/05/08 13:48:23	1.2
@@ -4,8 +4,8 @@
 ;; for now you can do something like
 ;; (with-open-file (stream filename)
 ;;  (let ((driver (dbopen stream)))
-;;    (read-record driver stream)
-;;    (read-record driver stream)
+;;    (read-record driver)
+;;    (read-record driver)
 ;;    ....))
 
 (in-package #:cl-dbf)
@@ -36,8 +36,10 @@
            (dotimes (i length)
              (write-byte 0 out))))
 
+(defclass xbase-common ()
+  (stream))
 
-(define-tagged-binary-class dbf-header ()
+(define-tagged-binary-class dbf-header (xbase-common)
   ((db-type u1))
   (:dispatch (select-db-driver db-type)))
 
@@ -121,10 +123,13 @@
    
 (defun dbopen (stream)
   (assert (and (input-stream-p stream) (output-stream-p stream)))
-  (read-value 'dbf-header stream))
+  (file-position stream 0)
+  (let ((db (read-value 'dbf-header stream)))
+    (setf (slot-value db 'stream) stream)
+    db))
 
-(defun goto-bof (driver stream)
-  (file-position stream (header-size driver)))
+(defun goto-bof (driver)
+  (file-position (slot-value driver 'stream) (header-size driver)))
 
 (defun external-format (driver)
   (case (code-page driver)
@@ -137,17 +142,27 @@
     (#xC9 '(:code-page :id 1251))
     (t '(:code-page :id 437))))
 
-(defmethod read-record ((driver dbase3-header) stream)
-  (case (read-byte stream)
-    (32 (loop 
-           :for field :in (fields driver)
-           :collect 
-           (let ((s (make-array (size field) :element-type '(unsigned-byte 8))))
-             (read-sequence s stream)
-             (flexi-streams:octets-to-string 
-              s 
-              :external-format (external-format driver)))))
-    (t nil)))
+(defmethod read-record ((driver dbase3-header))
+  (with-slots (stream) driver
+    (case (read-byte stream)
+      (32 (loop 
+             :for field :in (fields driver)
+             :collect 
+             (let ((s (make-array (size field) 
+                                  :element-type '(unsigned-byte 8))))
+               (read-sequence s stream)
+               (flexi-streams:octets-to-string 
+                s 
+                :external-format (external-format driver)))))
+      (t nil))))
+
+(defmacro with-db (db filespec &body body)
+  (let ((stream (gensym)))
+    `(with-open-file (,stream ,filespec :direction :io 
+                              :element-type 'unsigned-byte
+                              :if-exists :overwrite)
+       (let ((,db (dbopen ,stream)))
+         , at body))))