Hello!
Current cl-prevalence version does not allow to set specific
:external-format when reading or writing files. This is very
uncomfortable when current working encoding in application differs from
the system locale's one: cl recodes strings on serializing.
Please check this patchset implementing the feature (cumulative with
my previous bugfixes for "serialize-sexp-external" and "backup").
Maybe there are some crossplatform-related changes required.
% hg diff
diff -r 1edf5cd93bb9
src/prevalence.lisp
--- a/src/prevalence.lisp Sun Jul 26 11:10:13 2009
+0200
+++ b/src/prevalence.lisp Tue Sep 08 22:44:04 2009
+0400
@@ -103,7 +103,11
@@
(transaction-hook ;; type
function
:accessor
get-transaction-hook
:initarg
:transaction-hook
- :initform
#'identity))
+ :initform
#'identity)
+ (external-format ;; external encoding for file
operations
+ :reader
get-external-format
+ :initarg
:external-format
+ :initform
:utf-8))
(:documentation "Base Prevalence system implementation
object"))
(defclass guarded-prevalence-system
(prevalence-system)
@@ -156,7 +160,8
@@
(setf transaction-log-stream (open (get-transaction-log
system)
:direction
:output
:if-does-not-exist
:create
- :if-exists
:append)))))
+ :if-exists
:append
+ :external-format
(get-external-format system))))))
(defmethod close-open-streams ((system prevalence-system) &key
abort)
"Close all open stream associated with system (optionally aborting
operations in progress)"
@@ -242,7 +247,7
@@
:type
(get-file-extension system))
snapshot)))
(with-open-file (out
snapshot
- :direction :output :if-does-not-exist :create
:if-exists :supersede)
+ :direction :output :if-does-not-exist :create
:if-exists :supersede :external-format (get-external-format
system))
(funcall (get-serializer system) (get-root-objects system) out
(get-serialization-state system)))
(when (probe-file
transaction-log)
(copy-file transaction-log (merge-pathnames (make-pathname :name
(get-transaction-log-filename system timetag)
@@ -273,7 +278,7
@@
(clrhash (get-root-objects
system))
(close-open-streams
system)
(when (probe-file (get-snapshot
system))
- (with-open-file (in (get-snapshot system) :direction
:input)
+ (with-open-file (in (get-snapshot system) :direction :input
:external-format (get-external-format system))
(setf (get-root-objects system) (funcall (get-deserializer
system) in (get-serialization-state system)))))
(when (probe-file (get-transaction-log
system))
(let ((position
0))
@@ -284,7 +289,7
@@
condition)
(truncate-file (get-transaction-log system)
position)
(return-from
restore))))
- (with-open-file (in (get-transaction-log system) :direction
:input)
+ (with-open-file (in (get-transaction-log system) :direction
:input :external-format (get-external-format system))
(loop
(let ((transaction (funcall (get-deserializer system) in
(get-serialization-state system))))
(setf position (file-position
in))
@@ -310,7 +315,7
@@
(defmethod backup ((system guarded-prevalence-system) &key
directory)
"Do a backup on a system controlled by a
guard"
(funcall (get-guard
system)
- #'(lambda () (call-next-method system directory))))
+ #'(lambda () (call-next-method system :directory directory))))
(defmethod restore ((system guarded-prevalence-system))
"Restore a system controlled by a guard"
@@ -343,8 +348,8 @@
(buffer (make-string 4096))
(index 0)
(read-count 0))
- (with-open-file (in file :direction :input)
- (with-open-file (out tmp-file :direction :output :if-exists
:overwrite :if-does-not-exist :create)
+ (with-open-file (in file :direction :input :external-format
(get-external-format system))
+ (with-open-file (out tmp-file :direction :output :if-exists
:overwrite :if-does-not-exist :create :external-format
(get-external-format system))
(when (> position (file-length in)) (return-from truncate-file))
(loop
(when (= index position) (return))
@@ -360,8 +365,8 @@
(defun copy-file (source target)
(let ((buffer (make-string 4096))
(read-count 0))
- (with-open-file (in source :direction :input)
- (with-open-file (out target :direction :output :if-exists
:overwrite :if-does-not-exist :create)
+ (with-open-file (in source :direction :input :external-format
(get-external-format system))
+ (with-open-file (out target :direction :output :if-exists
:overwrite :if-does-not-exist :create :external-format
(get-external-format system))
(loop
(setf read-count (read-sequence buffer in))
(write-sequence buffer out :end read-count)
diff -r 1edf5cd93bb9 src/serialization/sexp.lisp
--- a/src/serialization/sexp.lisp Sun Jul 26 11:10:13 2009 +0200
+++ b/src/serialization/sexp.lisp Tue Sep 08 22:44:04 2009 +0400
@@ -145,8 +145,9 @@
(write-string " . " stream)
(serialize-sexp-internal (slot-value object slot)
stream serialization-state)
(write-string ")" stream))
- serializable-slots))
- (write-string " ) )" stream)))))
+ serializable-slots)
+ (write-string " )" stream))
+ (write-string " )" stream)))))
;;; objects
(defmethod serialize-sexp-internal ((object standard-object) stream
serialization-state)
