cl-rw

Layered streams for Common Lisp
git clone https://logand.com/git/cl-rw.git/
Log | Files | Refs

commit 7fc4f2a053445d03f3e22266d15bf85fa1d7b04e
parent 83602ae0390608531a666ea36d1e581027dad2c3
Author: Tomas Hlavaty <tom@logand.com>
Date:   Sat, 28 Jun 2014 20:18:36 +0200

added rw.zip

Diffstat:
Mcl-rw.asd | 3++-
Azip.lisp | 74++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 76 insertions(+), 1 deletion(-)

diff --git a/cl-rw.asd b/cl-rw.asd @@ -50,4 +50,5 @@ (:file "net") (:file "calendar") (:file "ui") - (:file "cas"))) + (:file "cas") + (:file "zip"))) diff --git a/zip.lisp b/zip.lisp @@ -0,0 +1,74 @@ +;;; Copyright (C) 2014 Tomas Hlavaty <tom@logand.com> +;;; +;;; Permission is hereby granted, free of charge, to any person +;;; obtaining a copy of this software and associated documentation +;;; files (the "Software"), to deal in the Software without +;;; restriction, including without limitation the rights to use, copy, +;;; modify, merge, publish, distribute, sublicense, and/or sell copies +;;; of the Software, and to permit persons to whom the Software is +;;; furnished to do so, subject to the following conditions: +;;; +;;; The above copyright notice and this permission notice shall be +;;; included in all copies or substantial portions of the Software. +;;; +;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER +;;; DEALINGS IN THE SOFTWARE. + +(defpackage :rw.zip + (:use :cl) + (:export :unzip + :with-unzip + :zip)) + +(in-package :rw.zip) + +(defstruct entry length method size cmpr date time crc32 name) + +(defun unzip (zip-file) + (rw.os:with-program-output (s "unzip" (list "-v" (namestring zip-file))) + (let ((r (rw:peek-reader (rw:char-reader s)))) + (rw:till r '(#\newline #\return)) + (rw:skip r) + (rw:till r '(#\newline #\return)) + (rw:skip r) + (rw:till r '(#\newline #\return)) + (rw:skip r) + (prog1 + (loop + until (eql #\- (rw:peek r)) + collect (make-entry :length (prog1 (rw:next-z0 r) + (rw:skip r)) + :method (prog1 (rw:till r '(#\space)) + (rw:skip r)) + :size (prog1 (rw:next-z0 r) + (rw:skip r)) + :cmpr (prog1 (rw:till r '(#\space)) + (rw:skip r)) + :date (prog1 (rw:till r '(#\space)) + (rw:skip r)) + :time (prog1 (rw:till r '(#\space)) + (rw:skip r)) + :crc32 (prog1 (rw:till r '(#\space)) + (rw:skip r)) + :name (coerce (prog1 (rw:till r '(#\newline #\return)) + (rw:skip r)) + 'string))) + (rw:till r))))) + +(defun call-with-unzip (zip-file entry-name fn) + (rw.os:with-program-output (s "unzip" (list "-p" (namestring zip-file) entry-name)) + (funcall fn s))) + +(defmacro with-unzip ((stream zip-file entry-name) &body body) + `(call-with-unzip ,zip-file ,entry-name (lambda (,stream) ,@body))) + +(defun zip (zip-file &rest pathnames) + (rw.os:with-program-output (s "zip" `("-r" ,@(mapcar #'namestring pathnames))) + (let ((r (rw:peek-reader (rw:char-reader s)))) + (rw:till r))))