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