zip-other-streams.patch 5.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152
  1. diff -Naur zip/package.lisp zip.new/package.lisp
  2. --- zip/package.lisp 2006-06-10 14:08:38.950000000 +0000
  3. +++ zip.new/package.lisp 2008-09-12 00:59:10.000000000 +0000
  4. @@ -3,6 +3,7 @@
  5. (defpackage :zip
  6. (:use :cl #-allegro :trivial-gray-streams)
  7. (:export #:zipfile ;reading ZIP files
  8. + #:zip-stream-file-length
  9. #:open-zipfile
  10. #:close-zipfile
  11. #:with-zipfile
  12. @@ -16,7 +17,9 @@
  13. #:unzip
  14. #:with-output-to-zipfile ;writing ZIP files
  15. + #:make-zipfile-writer
  16. #:write-zipentry
  17. + #:zip-write-central-directory
  18. #:zip
  19. #:inflate ;inflate.lisp
  20. diff -Naur zip/zip.lisp zip.new/zip.lisp
  21. --- zip/zip.lisp 2006-06-10 14:08:38.980000000 +0000
  22. +++ zip.new/zip.lisp 2008-09-12 16:06:37.790000000 +0000
  23. @@ -161,11 +161,14 @@
  24. (setf crc (update-crc crc buf n)))
  25. (values ntotal ntotal crc)))
  26. +(defmethod zip-stream-file-length ((stream file-stream))
  27. + (file-length stream))
  28. +
  29. (defun seek-to-end-header (s)
  30. (let* ((len (+ 65536 +end-header-length+))
  31. - (guess (max 0 (- (file-length s) len))))
  32. + (guess (max 0 (- (zip-stream-file-length s) len))))
  33. (file-position s guess)
  34. - (let ((v (make-byte-array (min (file-length s) len))))
  35. + (let ((v (make-byte-array (min (zip-stream-file-length s) len))))
  36. (read-sequence v s)
  37. (let ((n (search #(80 75 5 6) v :from-end t)))
  38. (unless n
  39. @@ -218,29 +221,36 @@
  40. :compressed-size (cd/compressed-size header)
  41. :comment comment)))
  42. -(defun open-zipfile
  43. - (pathname &key (external-format (default-external-format)))
  44. - (let* ((s (open pathname
  45. - #-allegro :element-type
  46. - #-allegro '(unsigned-byte 8))))
  47. +(defgeneric open-zipfile (source &key external-format))
  48. +
  49. +(defmethod open-zipfile
  50. + ((pathname string) &key (external-format (default-external-format)))
  51. + (let* ((stream (open pathname
  52. + #-allegro :element-type
  53. + #-allegro '(unsigned-byte 8))))
  54. (unwind-protect
  55. - (progn
  56. - (seek-to-end-header s)
  57. - (let* ((end (make-end-header s))
  58. - (n (end/total-files end))
  59. - (entries (make-hash-table :test #'equal))
  60. - (zipfile (make-zipfile :stream s
  61. - :entries entries
  62. - :external-format external-format)))
  63. - (file-position s (end/central-directory-offset end))
  64. - (dotimes (x n)
  65. - (let ((entry (read-entry-object s external-format)))
  66. - (setf (gethash (zipfile-entry-name entry) entries) entry)))
  67. - #+sbcl (let ((s s)) (sb-ext:finalize zipfile (lambda ()(close s))))
  68. - (setf s nil)
  69. - zipfile))
  70. - (when s
  71. - (close s)))))
  72. + (let ((ret (open-zipfile stream external-format)))
  73. + (when ret
  74. + #+sbcl (let ((stream stream)) (sb-ext:finalize ret (lambda ()(close stream))))
  75. + (setf stream nil))
  76. + ret)
  77. + (when stream
  78. + (close stream)))))
  79. +
  80. +(defmethod open-zipfile
  81. + ((stream stream) &key (external-format (default-external-format)))
  82. + (seek-to-end-header stream)
  83. + (let* ((end (make-end-header stream))
  84. + (n (end/total-files end))
  85. + (entries (make-hash-table :test #'equal))
  86. + (zipfile (make-zipfile :stream stream
  87. + :entries entries
  88. + :external-format external-format)))
  89. + (file-position stream (end/central-directory-offset end))
  90. + (dotimes (x n)
  91. + (let ((entry (read-entry-object stream external-format)))
  92. + (setf (gethash (zipfile-entry-name entry) entries) entry)))
  93. + zipfile))
  94. (defgeneric close-zipfile (zipfile))
  95. (defgeneric get-zipfile-entry (name zipfile))
  96. @@ -294,7 +304,7 @@
  97. (write-sequence descriptor s))
  98. name))
  99. -(defun write-central-directory (z)
  100. +(defun zip-write-central-directory (z)
  101. (let* ((s (zipwriter-stream z))
  102. (pos (file-position s))
  103. (n 0))
  104. @@ -367,21 +377,30 @@
  105. (progn ,@body)
  106. (close-zipfile ,file))))
  107. -(defun make-zipfile-writer
  108. - (pathname &key (if-exists :error)
  109. - (external-format (default-external-format)))
  110. +(defgeneric make-zipfile-writer (source &key external-format))
  111. +
  112. +(defmethod make-zipfile-writer ((stream stream)
  113. + &key
  114. + (external-format (default-external-format)))
  115. (let ((c (cons nil nil)))
  116. (make-zipwriter
  117. - :stream (open pathname
  118. - :direction :output
  119. - :if-exists if-exists
  120. - :element-type '(unsigned-byte 8))
  121. - :external-format external-format
  122. - :head c
  123. - :tail c)))
  124. + :stream stream
  125. + :external-format external-format
  126. + :head c
  127. + :tail c)))
  128. +
  129. +(defmethod make-zipfile-writer ((pathname string)
  130. + &key
  131. + (if-exists :error)
  132. + (external-format (default-external-format)))
  133. + (make-zipfile-writer (open pathname
  134. + :direction :output
  135. + :if-exists if-exists
  136. + :element-type '(unsigned-byte 8))
  137. + :external-format external-format))
  138. (defun close-zipfile-writer (z)
  139. - (write-central-directory z)
  140. + (zip-write-central-directory z)
  141. (close (zipwriter-stream z)))
  142. (defmacro with-output-to-zipfile