りむーばぶる3

先日からチマチマ作ってるやつの話

35万件くらいの画像をsha1ハッシュ値で管理して
重複分はファイルをハードリンクで繋ぎ
ディスク容量削減するようなスクリプトが欲しいのだ

ということで gauchemysqlを扱う入門プログラムという気分で作ってみた

テーブル設計

自分なりにやってみたテーブル設計がこれ

create table hashes 
(
 pathhash char(40) primary key not null,
 sha1hex  char(40) not null,
 mtime    bigint not null,
 path     text not null,
 index    hash (sha1hex));

pathでプライマリキー作ろうとしても文字数制限が256文字とかだったので
pathもsha1でハッシュしてプライマリキーにしてみた
これでファイル名の長さは気にならなくなったけど本当はどうやるんだろ?

mtimeはハードリンクしちゃうと個々のファイルの作成タイミングがわからなくなるから
後でログを消す時に使うために覚えておくために作っておいた

gauhe-dbd-mysqlのインストール

gaucheを入れればmysqlもそのまま叩けるかと思ったら違うみたい
dbd自体も必要とするパッケージがあるみたいだから
そのあたりもいれておく

ubuntuの場合
$sudo aptitude install libmysqlclient15-dev libdbd-mysql gauche-dev
centosの場合
$sudo yum -y install mysql-devel

ウチの場合はこれで準備できたのでdbdを入れてみる

$wget http://www.kahua.org/download/dbi/Gauche-dbd-mysql-0.2.2.tgz
$gauche-package install -S root Gauche-dbd-mysql-0.2.2.tgz

チェックしてみる

$gosh
gosh> (use dbd.mysql)
#<undef>

ロードできない場合はエラーになるので#が帰ってくればOK

登録プログラム register.ss

標準入力からファイル名一覧を受け取り
登録したファイルを標準出力へ書きだす
すでに登録してあるものは無視するようにした

find等からファイル一覧を受け取って
マージプログラムのoptlink.ssに渡すような感じで使う

#!/usr/bin/gosh

(use file.util)
(use dbi)
(use util.digest)
(use rfc.sha1)
(use util.relation)
(use gauche.collection)

(define (main args)
  (let* ((conn (dbi-connect "dbi:mysql:filehashes;host=localhost"
                            :username "filehashes"
                            :password "mydbpass"))
         (find (dbi-prepare conn
                 "select path from hashes where pathhash=?"))
         (insert (dbi-prepare conn
                  "insert into hashes values(?,?,?,?)")))
    (let iter((line (read-line)))
      (if (eof-object? line)
        (dbi-close conn)
        (let* ((pathhash (digest-hexify (sha1-digest-string line)))
               (result (dbi-execute find pathhash))
               (result-size (size-of result)))
            (dbi-close result)
            (if (= 0 result-size)
                (let ((sha1hex (with-input-from-file line
                                 (lambda ()
                                   (digest-hexify (sha1-digest)))))
                      (mtime (file-mtime line)))
                  (dbi-close (dbi-execute insert pathhash sha1hex mtime line))
                  (display line)
                  (newline)))
            (iter (read-line)))))))

マージ optlink.ss

標準入力からファイル名を受け取り
DBに同一のハッシュ値があればリンクする
DBに存在しなければ無視する
マージしたファイルがあれば標準出力に報告する

#!/usr/bin/gosh

(use file.util)
(use dbi)
(use util.digest)
(use rfc.sha1)
(use util.relation)
(use gauche.collection)

(define (main args)
  (guard (e ((<dbi-error> e)
             ;; handle error
             (display e)
            ))
    (let* ((conn (dbi-connect "dbi:mysql:tablename;host=localhost"
                              :username "username"
                              :password "mydbpass"))
           (findfile (dbi-prepare conn
                       "select sha1hex from hashes where pathhash=?"))
           (findhash (dbi-prepare conn
                       "select path from hashes where sha1hex=? and pathhash<>? order by mtime")))
      (let iter((line (read-line)))
        (if (eof-object? line)
            (dbi-close conn)
            (let* ((pathhash (digest-hexify (sha1-digest-string line)))
                   (fileinfo (dbi-execute findfile pathhash))
                   (sha1hex (gettop fileinfo "sha1hex")))
              (dbi-close fileinfo)
              (if sha1hex
                (let* ((result (dbi-execute findhash sha1hex pathhash))
                       (same-file (gettop result "path")))
                  (dbi-close result)
                  (if (and same-file
                           (file-exists? same-file)
                           (= (file-dev line)
                              (file-dev same-file))
                           (not (= (file-ino line)
                                   (file-ino same-file))))
                    (begin
                      (sys-unlink line)
                      (sys-link same-file line)
                      (touch-file line)
                      (display (string-append "marge " same-file " -> " line))
                      (newline)))))
              (iter (read-line))))))))

(define (gettop relation colmn)
  (let ((getter (relation-accessor relation)))
    (let/cc cc
      (for-each (lambda (row)
                  (cc (getter row colmn)))
                relation)
      #f)))

どーも汚い作りになってしまった
次回の課題にしとこう

古いファイルの削除 rmdate.ss

#!/usr/bin/gosh

(use file.util)
(use dbi)
(use util.digest)
(use rfc.sha1)
(use util.relation)
(use gauche.collection)

(define (main args)
  (guard (e ((<dbi-error> e)
             ;; handle error
             (display e)
            ))
    (let* ((conn (dbi-connect "dbi:mysql:tablename;host=localhost"
                              :username "username"
                              :password "mydbpass"))
           (select (dbi-prepare conn
                     "select path from hashes where mtime<?"))
           (delete (dbi-prepare conn
                     "delete from hashes where mtime<?"))
           (border (- (sys-time) (* (string->number (list-ref args 1)) 60 60 24)))
           (result (dbi-execute select border))
           (getter (relation-accessor result)))
      (for-each (lambda (row)
                  (let ((path (getter row "path")))
                    (if (file-exists? path)
                        (begin
                          (sys-unlink path)
                          (display path)
                          (newline)))))
                result)
      (dbi-close result)
      (dbi-close (dbi-execute delete border))
      (dbi-close conn))))


以上

schemeでDBを扱うのがそう難しくない事が解った
リレーションが標準的なcollectionと同様のapiで扱えるのは楽