/update-sightings.rkt

 1#! /bin/sh
 2#| Hey Emacs, this is -*-scheme-*- code!
 3#$Id: v4-script-template.ss 5863 2008-12-21 17:13:36Z erich $
 4exec  racket --require "$0" --main -- ${1+"$@"}
 5|#
 6
 7#lang racket
 8
 9;; if this directory contains no subdirectories
10;;   read the contents of all the files, stick them in a list
11;;   delete the directory
12;;   create a file with the same name as the directory we just deleted
13;;   write the list into that file
14
15(require "userinfo.rkt")
16
17(define old-sightings-root "/home/erich/live-bot/sightings.db")
18(define new-sightings-root "/home/erich/live-bot/userinfo.db")
19
20(define nick-dirs
21  (reverse
22   (fold-files
23    (lambda (path flavor accum)
24      (let* ([rel (find-relative-path old-sightings-root path)]
25             [depth (length (explode-path rel))])
26        (if (and (= 2 depth)
27                 (directory-exists? path))
28            (cons path accum)
29            accum)))
30    '()
31    old-sightings-root)))
32
33(define (upgrade! nick-dir)
34  (fprintf (current-error-port) "~a ... ~%" nick-dir)
35  (let* ([files
36          (map (lambda (rel)
37                 (build-path nick-dir rel))
38               (directory-list nick-dir))]
39         [structs (for/list ([f files])
40                    (call-with-input-file f read))])
41    (delete-directory/files nick-dir)
42    (let ([nick-file (regexp-replace #rx"/$"
43                                     (path->string (simplify-path nick-dir))
44                                     "")])
45    (call-with-output-file nick-file
46      (lambda (op)
47        (pretty-print (list (cons 'sightings structs)) op)
48        (newline op))))))
49
50(for ([nick nick-dirs])
51  (upgrade! nick))
52(rename-file-or-directory old-sightings-root new-sightings-root)