[cl-prevalence-devel] [feature proposal][patch] :external-format for file operations

[Alexey Voznyuk]

    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)