Subject: pathnames
From: Aycan iRiCAN <[email-masked]>
To: [email-masked]
Date: Tue, 26 Dec 2006 16:58:40 +0200

Hi,

I wrote a quick pathname support for cl-prevalence.

Here is an example:

CL-PREVALENCE> (deserialize-sexp (make-string-input-stream 
(with-output-to-string (s) (serialize-sexp (make-pathname :directory 
'(:absolute "tmp") :name "name" :type "lisp") s))))
#P"/tmp/name.lisp"

Best Regards,

-- 
Aycan iRiCAN
C0R3 Computer Security Group
http://people.core.gen.tr/~aycan.irican/

? src/blob.fasl
? src/managed-prevalence.fasl
? src/master-slave.fasl
? src/package.fasl
? src/prevalence.fasl
? src/semantic.cache
? src/serialization.fasl
? test/semantic.cache
Index: src/serialization.lisp
===================================================================
RCS file: /project/cl-prevalence/cvsroot/cl-prevalence/src/serialization.lisp,v
retrieving revision 1.10
diff -u -r1.10 serialization.lisp
--- src/serialization.lisp	31 Jan 2006 12:41:48 -0000	1.10
+++ src/serialization.lisp	26 Dec 2006 14:56:28 -0000
@@ -244,7 +244,7 @@
   (declare (ignore serialization-state))
   (print-symbol object stream))
 
-(defun sequence-type-and-length(sequence)
+(defun sequence-type-and-length (sequence)
   (if (listp sequence)
       (handler-case
           (let ((length (list-length sequence)))
@@ -476,6 +476,26 @@
                       (write-string ")" stream))))
 	(write-string " ) )" stream)))))
 
+#+sbcl
+(defmethod serialize-sexp-internal ((object pathname) stream serialization-state)
+  (let ((id (known-object-id serialization-state object)))
+    (if id
+	(progn
+	  (write-string "(:REF . " stream)
+	  (prin1 id stream)
+	  (write-string ")" stream))
+	(let ((serializable-slots (get-serializable-slots serialization-state object)))
+	  (setf id (set-known-object serialization-state object))
+	  (write-string "(:PATHNAME " stream)
+	  (prin1 id stream)
+	  (write-string " :DIRECTORY " stream)
+	  (serialize-sexp-internal (pathname-directory object) stream serialization-state)
+	  (write-string " :NAME " stream)
+	  (prin1 (pathname-name object) stream)
+	  (write-string " :TYPE " stream)
+	  (prin1 (pathname-type object) stream)
+	  (write-string " ) )" stream)))))
+
 ;;; Deserialize CLOS instances and Lisp primitives from the XML representation
 
 (defun get-attribute-value (name attributes)
@@ -593,6 +613,12 @@
                          conspair)                   
                    (rplaca conspair (deserialize-sexp-internal cons-car deserialized-objects))
                    (rplacd conspair (deserialize-sexp-internal cons-cdr deserialized-objects)))))
-        (:ref (gethash (rest sexp) deserialized-objects)))))
+        (:ref (gethash (rest sexp) deserialized-objects))
+	#+sbcl
+	(:pathname (destructuring-bind (id &key directory name type) (rest sexp) 
+		     (let ((pathname (make-pathname :directory (deserialize-sexp-internal directory deserialized-objects)
+						    :name (deserialize-sexp-internal name deserialized-objects)
+						    :type (deserialize-sexp-internal type deserialized-objects))))
+		       (setf (gethash id deserialized-objects) pathname)))))))
 
 ;;;; eof