Let's start Scheme

2013-10-10

書庫と圧縮ライブラリ

日本語で書くとちょっとかっこいいw

一つ前の記事で書いたけど、パッケージシステムがあるといいよなぁと思い始めたのでその準備段階として書庫と圧縮展開ライブラリの増強をすることにした。とりあえずzip、tarとgzipを追加。それぞれ、(archive core zip)、(archive core tar)と(rfc gzip)という感じになっている。書庫ライブラリにcoreと付いているのはこの上にジェネリックなインターフェースを構築してやろうかなぁと目論んでいるため。っが、書いてて要らないかもと思っていたりもしているので、実装されるかは目下のところ微妙(多分する)。

とりあえず、以下は簡単な使い方。
まずはtarとgzip
(import (rnrs)
        (srfi :26)
        (archive core tar)
        (rfc gzip))

(define-constant gzip-file "test.tar.gz")
(when (file-exists? gzip-file)
  (delete-file gzip-file))

;; archive and compress
(call-with-output-file gzip-file
  (lambda (out)
    (let ((h (make-gzip-header-from-file gzip-file :comment "comment")))
      (call-with-port (open-gzip-output-port out :header h)
        (lambda (gout)
          (append-file gout "test.scm")
          (append-file gout "dir/test.zip")))))
  :transcoder #f)

;; expand
(call-with-input-file gzip-file
  (lambda (in)
    (call-with-port (open-gzip-input-port in)
      (cut extract-all-files <> :overwrite #t)))
  :transcoder #f)
gzipな出力ポートを開いてそこに追加していくという方式でtar.gzができる。tarはシーケンシャルアクセスなので割りと直感的な操作でかなり楽に行ける。make-gzip-header-from-fileは特に呼ばなくてもよくて、その際はheaderキーワードを削除すればよい。指定しない場合はzlibのウィンドウビット16以上(31を使用)のオプションを利用して空のGZIPヘッダが付くようになる。

tarは現状のところUSTARフォーマットのみをサポートしているので、ファイル名は最大で255バイトまでになる。(prefixフィールドを使用している。コマンドでも展開できるから正しいよね、多分。)

次はzip
(import (rnrs)
        (srfi :26)
        (archive core zip))

(define-constant zip-file "test.zip")
(when (file-exists? zip-file)
  (delete-file zip-file))

;; archive
(call-with-output-file zip-file
  (lambda (out)
    (let ((centrals (map (cut append-file out <>)
                         '("test.scm" "dir/test.zip"))))
      (append-central-directory out centrals)))
  :transcoder #f)

;; expand
(call-with-input-file zip-file
  (cut extract-all-files <> :overwrite #t)
  :transcoder #f)
zipはランダムアクセス可能という特性があるのだが、それを可能にしているのは末尾に付いた情報なので、ファイルを追加するたびに生成される情報を保持して最後に足してやる必要がある。tarとの違いを意識しなくてもいいようにジェネリックなインターフェースを作って操作を統一したいというのがあるので、多分作られる。

 あとRAR辺りを作ったら何でも来いになる感じがある。あぁ、LZHとかもあったな。多分サポートされないけど・・・(^^;

No comments:

Post a Comment