Gauche-archiveはlibarchiveのGaucheバインディングです。
ダウンロード: Gauche-archive-1.1.2.tgz (2019-8-15)
(use gauche.collection) (use util.archives) (guard (exc ((archive-error? exc) (format #t "~a ~a\n" (archive-error-debug-info exc) (archive-error-reason exc)))) (let ((writer (open-output-archive "./testarchive01.tar" ARCHIVE-FORMAT-TAR-GNUTAR)) (entry #f)) (set! entry (create-entry-from-file "read_archive.scm")) (append-entry writer entry) ;;; Raise condition because of forget to close archive for reading at [1]. ;; (guard ;; (exc ;; ((archive-error? exc) ;; (format #t "~a ~a\n" ;; (archive-error-debug-info exc) ;; (archive-error-reason exc)))) ;; (let ((archive (open-input-archive-from-name "./testarchive01.tar"))) ;; (map (^(entry) (if (= (~ entry 'size) 0) (remove-entry writer entry))) ;; archive) ;; ;; (close-input-archive archive) ;;; [1] ;; (close-output-archive writer))) (call-with-file-archive "./testarchive01.tar" (^(archive) (map (^(entry) (cond ((= (~ entry 'size) 0) (remove-entry writer entry)) ;;; Modify archive entry content. In this code we modify 'char' to ;;; 'CHAR\n'. ((string=? (~ entry 'name) "archive_proc.c") (read-data archive entry) (let ((out (open-output-string))) (call-with-input-string (flush-archive-entry-data entry out) (^(iport) (port-for-each (^(string) (if (#/char/ string) (format out "~a\n" (regexp-replace-all #/char/ string "CHAR\n")) (format out "~a\n" string))) (cut read-line iport))))) (modify-entry writer entry)))) archive))) (close-output-archive writer)))