[cl-dbf-cvs] CVS cl-dbf

[CVS User rklochkov]

Update of /project/cl-dbf/cvsroot/cl-dbf
In directory tiger.common-lisp.net:/tmp/cvs-serv24039

Modified Files:
	src.lisp 
Log Message:
Fix for eof


--- /project/cl-dbf/cvsroot/cl-dbf/src.lisp	2012/05/31 02:45:17	1.4
+++ /project/cl-dbf/cvsroot/cl-dbf/src.lisp	2012/12/31 22:13:27	1.5
@@ -37,7 +37,7 @@
              (write-byte 0 out))))
 
 (defclass xbase-common ()
-  (stream))
+  (stream external-format))
 
 (define-tagged-binary-class dbf-header (xbase-common)
   ((db-type u1))
@@ -136,20 +136,22 @@
                  (+ (header-size driver) (* n (record-size driver)))))
 
 (defun external-format (driver)
-  (case (code-page driver)
-    (2    '(:code-page :id 850))
-    (3    '(:code-page :id 1252))
-    (#x64 '(:code-page :id 852))
-    (#x65 '(:code-page :id 865))
-    (#x66 '(:code-page :id 866))
-    (#xC8 '(:code-page :id 1250))
-    (#xC9 '(:code-page :id 1251))
-    (t '(:code-page :id 437))))
+  (or (slot-value driver 'external-format)
+      (case (code-page driver)
+        (2    '(:code-page :id 850))
+        (3    '(:code-page :id 1252))
+        (#x64 '(:code-page :id 852))
+        (#x65 '(:code-page :id 865))
+        (#x66 '(:code-page :id 866))
+        (#xC8 '(:code-page :id 1250))
+        (#xC9 '(:code-page :id 1251))
+        (t '(:code-page :id 437)))))
 
 (defmethod read-record ((driver dbase3-header))
-  "Return record value as list and move to the next record"
+  "Return record value as list and move to the next record.
+When eof, return nil. Deleted records skipped."
   (with-slots (stream) driver
-    (case (read-byte stream)
+    (case (read-byte stream nil :eof)
       (32 (loop 
              :for field :in (fields driver)
              :collect 
@@ -159,10 +161,12 @@
                (flexi-streams:octets-to-string 
                 s 
                 :external-format (external-format driver)))))
-      (t (file-position stream
-                        (+ (file-position stream)
-                           (1- (record-size driver))))
-         nil))))
+      (:eof nil)
+      (t ; deleted record, skip and read again
+       (file-position stream
+                      (+ (file-position stream)
+                         (1- (record-size driver))))
+       (read-record driver)))))
 
 (defmacro with-db (db filespec &body body)
   (let ((stream (gensym)))
@@ -172,5 +176,17 @@
        (let ((,db (dbopen ,stream)))
          , at body))))
 
+(defun dbf-to-conses-of-strings (filename &key external-format)
+  "filename is a name of dbf file to open.
+Returns a list (field-names . record-values), 
+where values are strings. code-page можно использовать для насильственного указания кодовой страницы"
+  (with-db (db filename)
+    (when external-format
+      (setf (slot-value db 'external-format) external-format)
+      (cons (fields driver)
+            (loop 
+               :for rec = (read-record driver)
+               :while rec
+               :collect rec)))))