长期以来相片管理都是困扰我的问题。
现有的照片管理系统基本上都是基于数据库技术的，用好它的前提是，首先你得付出管理精力，比如给照片分类，分级，添加注释，等等。更专业的程序还包括编辑功能。这大约是专业摄影师才应该做的。我算不上摄影爱好者，我的相片大部分都是居家生活照，其中绝大部分是给孩子照的。在这种情况下，使用复杂的图片管理系统有些得不偿失。
记得以前用 Ubuntu 的时候，使用过 Gnome 内置的一个相片管理程序，叫啥名已经忘记了。它导入照片时进可以识别 Exif 中的拍照时间，并且按照时间存放到文件系统里。比如一张照片拍照时间是 2000:01:01, 它就给它放到 'prefix/2000/01/01' 目录里去。我就觉得这功能挺好用。这甚至意味着有序的管理方式，即便没有任何的照片管理系统，我也能自己有序地组织照片。以至于，不用 Gnome 的这些年，我一直坚持以这种方式手工管理照片。
好吧，最近我忍受不了了。手机里的图照片越攒越多，因为我不知道哪一部分已经导入到电脑里，哪一些还没有导入。相机里的图片也越攒越多，除了面临和手机图片一样的困难，更大的困难是，相机图片在文件名里不包含拍照日期，不能通过文件名简单地判断该放在哪里，必须得用某个图片浏览器查看每一张照片的 Exif 来判断。这是令人恐惧的工作。最近看了一个 Python小脚本，并由此入了 Exif 的坑。
我决定自己用 Racket 写一个 Exif 库，除了供我的导入照片的小脚本用，以后也有可能会用到别的地方。
Exif 是灵活的，也是复杂的，每个 JPG 文件里有可能会有 Exif 段，也可能会有 JFIF 段，有可能两者都有。在 Exif 里，使用 TIFF 的格式来存储信息，而 TIFF 也很复杂，还分大小端。TIFF 通过 IFD 来存放不同类别的信息，IFD 有多有少，IFD 里面还有可能有子 IFD，同样有多有少。不同的 IFD 里有可能有相同的 TAG，而这些相同的 TAG 的值却不一定相同。查询某个 TAG 的值时应该到哪个 IFD 里去查呢？IFD 的数目不固定，怎么给每个 IFD 一个唯一的 ID 呢？用线性结构来组织似乎不合适，用树形结构来组织也似乎不太合适，用哈希表来存也不合适。我算是栽坑里了。代码只不过 300 多行，然却多次推翻重写，没一次满意的。导入照片的小脚本早就写好能跑了，但是动不动就崩溃，原因是它所使用的 Exif 库到处都是 BUG。其间什么奇葩问题都前见过了。比如，TIFF 里，有理数的分母可能会是 0！另外，Racket 的错误提示太弱了，简直连 gcc 都不如。
最后，我放弃了宏伟的蓝图，放弃了写出一个能正确读写 Exif 的库的企图。我不就想从照片里读个日期吗？费那劲干嘛！直接正则表达式就搞定了嘛。
#!/usr/bin/env racket
#lang racket/base
(require racket/path)
(require racket/file)
(require racket/string)
(define err-log "impto-error.log")
(define impto-log "impto.log")
(define (error-log fmt)
(display fmt)
(display-to-file fmt err-log #:mode 'text #:exists 'append))
(define (add-log fmt)
(display fmt)
(display-to-file fmt impto-log #:mode 'text #:exists 'append))
(define (get-u16 in)
(let ((h (read-byte in)))
(+ (* h 256) (read-byte in))))
(define (date-from-exif re path)
(define (find-exif in)
(let ((marker (get-u16 in)))
(let ((size (get-u16 in)))
(if (not (<= #xffe0 marker #xffef))
#f
(if (= marker #xffe1)
(let ((tiff (read-bytes (- size 8) in)))
(let ((m (regexp-match re tiff)))
(if m
(map bytes->string/latin-1 m) ;; 这里必要吗？
#f)))
(begin
(read-bytes (- size 2) in)
(find-exif in)))))))
(call-with-input-file path
(lambda (in)
(let ((header (get-u16 in)))
(if (not (= header #xffd8))
#f
(find-exif in))))))
(define (date-from-file-name re path)
(regexp-match re (file-name-from-path path)))
;; parsing date from Exif or file name, and convert it to path
;; "2017:02:15" -> "2017/02/15"
;; "20170215 -> "2017/02/15"
(define (get-date path)
(let ((re (pregexp "(19[89]\\d|20[012]\\d)\\D?(0[1-9]|1[0-2])\\D?(0[1-9]|[12]\\d|3[01])")))
(let ((ret (or (date-from-exif re path)
(date-from-file-name re path))))
(if ret
(string-join (cdr ret) "/")
#f))))
(define (import-img img dest)
(let ((date-string (get-date img)))
(if date-string
(let* ((sub-dir date-string)
(dir-tree (string-append dest "/" sub-dir))
(new-file (string-append dir-tree "/"
(path->string (file-name-from-path img)))))
(if (file-exists? new-file)
(add-log (format "[Warning]~s already exists\n" new-file))
(begin
(make-directory* dir-tree)
(copy-file img new-file)
(add-log (format "~a -> ~a ok\n" img (path-only new-file))))))
(error-log (format "[Failed]unknow date: ~a\n" img)))))
(define (jpeg? path)
(let ((ext-name (path-get-extension path)))
(member ext-name '(#".jpg" #".jpeg" #".JPG" #".JPEG"))))
(define (worker path type dest)
(when (and (eq? type 'file) (jpeg? path))
(import-img path dest))
dest)
(define (go src dest)
(fold-files worker dest src))
(define (usage)
(printf "\n This program imports digital photos from 'source dir' to
'dest dir' and stores them in a directory tree organized in the form
'yyyy/mm/dd', the date-time information is read from the photo's buile-in
Exif or file name.
This program will recursively copy each JPEG file under the 'source dir'
and all subdirectories. The 'source dir' parameter is optional, in which
case program will look for JPEG images in the 'current working directory'\n
If the attempt to get date info from Exif or file name fails, the
file will be ignored.
All failed log can be found at 'impto-error.log' in current directory. and
All successful logs can be found at 'impto.log' too.
Only files with '.jpg' '.jpeg' '.JPG' '.JPEG' extension will be copied.
Usage: ~a [source dir] <dest dir>\n\n" (file-name-from-path (find-system-path 'run-file))))
(let ((paths (vector->list (current-command-line-arguments))))
(if (null? paths)
(usage)
(let ((src (if (= (length paths) 1)
(current-directory)
(car paths)))
(dest (if (= (length paths) 1)
(car paths)
(cadr paths))))
(cond ((not (directory-exists? src))
(printf "directory ~a does not exists\n" src))
((not (directory-exists? dest))
(printf "directory ~a does not exists\n" dest))
(else
(when (file-exists? err-log)
(delete-file err-log))
(when (file-exists? impto-log)
(delete-file impto-log))
(go src dest))))))
小脚本的健壮性得到了革命性的改善。
使用中发现，我的照片有太多的 Exif 是损坏的。原因是我曾经使用过的某个照片管理程序，自以为是地认为自己能处理每张照片的 Exif ，并且向用户提供了编辑的功能。它编辑的结果就是把 Exif 搞坏。等我发现时悔之晚矣。以前没注意这个问题，现在试图用上面的小脚本重新整理几十个 G 的照片库时发现 Exif 缺失的照片有点多。有些东西失去了，一辈子都找不回来了。要珍惜啊！慎用 Exif 编辑功能。那是元数据，就应该是只读的。甚至是能作为呈堂证供的东西，怎么能随便编辑呢？
问题终究造成了，幸好我一直有序地存储照片，哪怕没有 Exif ，我也能知道每一张照片是哪一天拍的。有没有一个办法能重建缺失的 Exif 结构呢？虽然数据是找不回来了，但至少能保证它结构是完整的。由此我想到了移花接木法：找一张同一型号的相机拍摄的照片，把 Exif dump 出来，然后写到被损坏的照片的对应位置。在嫁接的同时，顺便把日期改一下，这样就不必要面对精准地编辑每一个条目的复杂性，同样可以正则表达式搞定。说干就干：
#!/usr/bin/env racket
#lang racket/base
(require racket/path)
(require racket/port)
(define SOS #xffda)
(define EXIF #xffe1)
(define (get-u16 in)
(let ((h (read-byte in)))
(+ (* h 256) (read-byte in))))
(define (find-range path mk)
(define (find-marker in)
(let ((marker (get-u16 in)))
(let ((size (get-u16 in)))
(cond ((= marker mk)
(let* ((start (- (file-position in) 2))
(end (+ start size)))
(cons start end)))
(else (read-bytes (- size 2) in)
(find-marker in))))))
(call-with-input-file path
(lambda (in)
(let ((header (get-u16 in)))
(if (not (= header #xffd8))
#f
(find-marker in))))))
(define (fix-exif src dest fixed date)
(let ((exif-of-src (find-range src EXIF))
(exif-of-dest (find-range dest EXIF)))
(call-with-output-file fixed
(lambda (fo)
(call-with-input-file dest
(lambda (di)
(call-with-input-file src
(lambda (si)
(let ((meta (update (read-bytes (cdr exif-of-src) si) date)))
(read-bytes (cdr exif-of-dest) di)
(let ((data (port->bytes di)))
(write-bytes meta fo)
(write-bytes data fo))))))))
#:exists 'replace)))
(define (update bv date-str)
(let ((re (pregexp "[12]\\d\\d\\d:[01]\\d:[0-3]\\d")))
(regexp-replace* re bv date-str)))
(let ((args (vector->list (current-command-line-arguments))))
(if (< (length args) 4)
(printf "Usage: ~a <template> <dest> <new-file> <date>\n" (file-name-from-path
(find-system-path 'run-file)))
(fix-exif (car args) (cadr args) (caddr args) (cadddr args))))
初步试了一下，可以正确地拼接。但是比较犹豫要不要用。原因是，这让我总是想到处女膜修补。文件结构固然是修复了，但里面的数据除了日期以外几乎全是假的。