[zip-cvs] CVS update: zip/README.html zip/zip.lisp - zip-cvs@common-lisp.net - mailman3.common-lisp.net

5 Apr 2005

Update of /project/zip/cvsroot/zip
In directory common-lisp.net:/tmp/cvs-serv21945
Modified Files:
    README.html zip.lisp 
Log Message:
store file-write-date
Date: Tue Apr  5 21:31:13 2005
Author: dlichteblau
Index: zip/README.html
diff -u zip/README.html:1.4 zip/README.html:1.5

--- zip/README.html:1.4	Tue Apr  5 17:47:08 2005
+++ zip/README.html	Tue Apr  5 21:31:13 2005
@@ -54,7 +54,8 @@
     <h2>Recent changes</h2>
     <p>
       2005-04-05: ACL fixes (thank to Edi Weitz).  Lispworks port
-      (thanks to Sean Ross).
+      (thanks to Sean Ross).  Store <tt>file-write-date</tt> (also fixes
+      FilZip compatibility).
     </p>
<h2>Download</h2>
@@ -148,11 +149,14 @@
     <p>
     </p>
-    <div class="def">Function WRITE-ZIPENTRY (zipwriter name data)</div>
+    <div class="def">Function WRITE-ZIPENTRY (zipwriter name data &key file-write-date)</div>
     <p>
       Append a new entry called <tt>name</tt> to <tt>zipwriter</tt>.
       Read data from <tt>(unsigned-byte 8)</tt> stream <tt>data</tt>
       until EOF and compress it into "deflate"-format.
+      Use <tt>file-write-date</tt> as the entry's date and time.
+      Default to <tt>(file-write-date data)</tt>, use 1980-01-01T00:00
+      if <tt>nil</tt>.
     </p>
<div class="def">Function ZIP (pathname source-directory &key if-exists)</div>
@@ -160,6 +164,11 @@
       Compress all files in <tt>source-directory</tt> recursively into a
       new zip archive at <tt>pathname</tt>.  Note that entry file names
       will not contain the name <tt>source-directory</tt>.
+    </p>
+
+    <h2>Bookmark</h2>
+    <p>
+      <a href="http://www.pkware.com/company/standards/appnote/appnote.txt">spec</a>
     </p>
   </body>
 </html>
Index: zip/zip.lisp
diff -u zip/zip.lisp:1.5 zip/zip.lisp:1.6
--- zip/zip.lisp:1.5	Tue Apr  5 20:18:33 2005
+++ zip/zip.lisp	Tue Apr  5 21:31:13 2005
@@ -244,7 +244,8 @@
 (defmethod get-zipfile-entry (name (zipfile zipfile))
   (gethash name (zipfile-entries zipfile)))
-(defun write-zipentry (z name data)
+(defun write-zipentry
+    (z name data &key (file-write-date (file-write-date data)))
   (setf name (substitute #/ #\ name))
   (let* (#+allegro (excl:*locale* (excl:find-locale :latin1))
          (s (zipwriter-stream z))
@@ -258,9 +259,13 @@
     (setf (file/version-needed-to-extract header) 2) ;XXX ist das 2.0?
     (setf (file/flags header) 8)        ;bit 3: descriptor folgt nach daten
     (setf (file/method header) 8)
-    (setf (file/time header) 0)         ;XXX fixme
-    (setf (file/date header) 0)         ;XXX fixme
-    (setf (file/crc header) 0)
+    (multiple-value-bind (s min h d m y)
+        (decode-universal-time
+         (or file-write-date (encode-universal-time 0 0 0 1 1 1980 0)))
+      (setf (file/time header)
+            (logior (ash h 11) (ash min 5) (ash s -1)))
+      (setf (file/date header)
+            (logior (ash (- y 1980) 9) (ash m 5) d)))
     (setf (file/compressed-size header) 0)
     (setf (file/size header) 0)
     (setf (file/name-length header) (length utf8-name))
@@ -428,7 +433,8 @@
                        (write-zipentry
                         zip
                         (enough-namestring (namestring f) base)
-                        (make-concatenated-stream))
+                        (make-concatenated-stream)
+                        :file-write-date (file-write-date f))
                        (recurse #+allegro f
                                 #-allegro (make-pathname
                                            :name :wild

    