Gauche-archive

Gauche-archive is a libarchive binding for Gauche.

Download: Gauche-archive-1.1.2.tgz (2019-8-15)

History

• 2018-7-8 version 1.0 First release
• 2018-7-28 version 1.1 Can edit archive, and build archive or so on.
• 2018-12-21 version 1.1.1 Can compile on Gauche 0.9.7
• 2019-8-15 version 1.1.2 Add some classes for well known archive formats.

Example

(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)))