Commit | Line | Data |
---|---|---|
fa3eb6ac CE |
1 | #!/usr/bin/guile -s |
2 | !# | |
3 | ||
4 | ;;; -*- scheme -*- | |
5 | ||
6 | ;;; Parse for enhanced XMCD. Original format: http://ftp.freedb.org/pub/freedb/latest/DBFORMAT | |
7 | ||
8 | (use-modules (ice-9 format) | |
9 | (ice-9 rdelim) | |
10 | (ice-9 streams) | |
11 | (ice-9 regex) | |
12 | (ice-9 vlist) | |
13 | ||
14 | (srfi srfi-1)) | |
15 | ||
16 | ;;; VList/VHash utility functions | |
17 | ||
18 | (define (vhash-cat key new-value vhash) | |
19 | "Add NEW-VALUE to the VList stored under VHASH.KEY" | |
20 | (vhash-set key (vlist-append (let ((lst (vhash-assoc key vhash))) | |
21 | (if lst (cdr lst) vlist-null)) | |
22 | (vlist-cons new-value vlist-null)) | |
23 | vhash)) | |
24 | ||
25 | (define (vhash-set key new-value vhash) | |
26 | (vhash-cons key new-value (vhash-delete key vhash))) | |
27 | ||
28 | ||
29 | ;;; Simple key/value database for cddb and toc info | |
30 | ||
31 | ;;; DO NOT RELY ON THE IMPLEMENTATION, it sucks. Always use the query | |
32 | ;;; functions. The disc query functions return the list of values, the | |
33 | ;;; track query functions return an alist of (track-num | |
34 | ;;; . values). Values are always plural, just grab the car if you want | |
35 | ;;; a single value. It's not the best interface, but it sure beats | |
36 | ;;; grepping the xmcd file! | |
37 | ||
38 | (define (make-initial-db . toplevel-keys) | |
39 | (fold (lambda (key db) (vhash-cons key vlist-null db)) vlist-null toplevel-keys)) | |
40 | ||
41 | (define (cddb-query-disc db tag) | |
42 | "Query the database for a disc attribute" | |
43 | (let ((result (vhash-assoc tag (cdr (vhash-assoc 'disc db))))) | |
44 | (if result (vlist->list (cdr result)) #f))) | |
45 | ||
46 | (define (cddb-query-tracks db tag) | |
47 | "Query the database for a track attribute and return alist | |
48 | of (disc-number . tag-value)" | |
49 | (let ((r (vlist->list (vhash-fold (lambda (key vh results) | |
50 | (let ((result (vhash-assoc tag vh))) | |
51 | (if result | |
52 | (vhash-cons key (vlist->list (cdr result)) results) | |
53 | results))) | |
54 | vlist-null | |
55 | (cdr (vhash-assoc 'tracks db)))))) | |
56 | (if (null? r) #f r))) | |
57 | ||
58 | (define (read-cddb cddb-port) | |
59 | (define (parse-cddb-line line db) | |
60 | (define (line-match regex) (string-match regex line)) | |
61 | ||
62 | (cond | |
63 | ((line-match "^#(.*)$") => (lambda (x) (vhash-cat 'comment (match:substring x 1) db))) | |
64 | ((line-match "^DISCID=([[:graph:]]+)$") => (lambda (x) (let ((disc-db (cdr (vhash-assoc 'disc db)))) | |
65 | (vhash-set 'disc (vhash-cat 'DISCID (match:substring x 1) disc-db) | |
66 | db)))) | |
67 | ((line-match "^D([[:alpha:]]+)=([[:graph:][:space:]]+)$") => (lambda (x) | |
68 | (let ((disc-db (cdr (vhash-assoc 'disc db))) | |
69 | (key (string->symbol (match:substring x 1)))) | |
70 | (vhash-set 'disc (vhash-cat key (match:substring x 2) disc-db) | |
71 | db)))) | |
72 | ||
73 | ((line-match "^T([[:alpha:]]+)([[:digit:]]+)=([[:graph:][:space:]]+)$") | |
74 | => (lambda (x) | |
75 | (let* ((tracks-db (cdr (vhash-assoc 'tracks db))) | |
76 | (tracknum (string->number (match:substring x 2))) | |
77 | (tracknum-db ((lambda (vh) (if vh (cdr vh) vlist-null)) (vhash-assoc tracknum tracks-db))) | |
78 | (key (string->symbol (match:substring x 1))) | |
79 | (tag-value (match:substring x 3))) | |
80 | (vhash-set 'tracks (vhash-set tracknum (vhash-cat key tag-value tracknum-db) | |
81 | tracks-db) | |
82 | db)))) | |
83 | ||
84 | ;; Also match EXTD? Might just punt if abcde handles it separately | |
85 | (else db))) | |
86 | ||
87 | (stream-fold parse-cddb-line | |
88 | (make-initial-db 'comment 'disc 'tracks) | |
89 | (port->stream cddb-port read-line))) | |
90 | ||
dde7052d CE |
91 | ;;; Commands |
92 | ||
93 | ;; string-tokenize is weird, might want to just use regexeps instead | |
94 | (define cddb-dtitle-char-set (char-set-difference char-set:printing | |
95 | (char-set #\/))) | |
96 | ||
97 | (define* (cddb->export cddb #:optional (out (current-output-port))) | |
98 | "Convert database to shell expression for abcde" | |
99 | ;; Using single quoting instead of "" to make life easier | |
100 | (letrec* ((escape-for-shell | |
101 | (lambda (x) (regexp-substitute/global #f "['\\\\]" x | |
102 | 'pre | |
103 | (lambda (m) (string-append "\\" (match:substring m))) | |
104 | 'post))) | |
105 | (disc-query (lambda* (key #:optional (default '(""))) | |
106 | (cond ((cddb-query-disc cddb key) => identity) | |
107 | (else default)))) | |
108 | ||
109 | (artist ((lambda (s) (substring s 0 (- (string-index s #\/) 1))) (car (disc-query 'TITLE))) | |
110 | ||
111 | #;(string-trim-right (car (string-tokenize (car (disc-query 'TITLE)) cddb-dtitle-char-set)))) | |
112 | ||
113 | (album ((lambda (s) (substring s (+ (string-index s #\/) 2))) (car (disc-query 'TITLE))) | |
114 | #;(string-trim (string-join (cdr (string-tokenize (car (disc-query 'TITLE)) cddb-dtitle-char-set)) | |
115 | "/")))) | |
116 | ||
117 | ||
118 | (newline out) | |
119 | ||
120 | ;; Not exported CDDBGENRE intentionally, since it appears unused | |
121 | (format out "DISCID=$'~A'~%DALBUM=$'~A'~%DARTIST=$'~A'~%CDYEAR=$'~A'~%" | |
122 | (escape-for-shell (car (disc-query 'DISCID))) | |
dde7052d | 123 | (escape-for-shell album) |
3a072eba | 124 | (escape-for-shell artist) |
dde7052d CE |
125 | (escape-for-shell (car (disc-query 'YEAR)))) |
126 | ||
127 | ;; Store genre(s) in a bash array. mp3s will just have to live with | |
128 | ;; using the first, but Vorbis/FLAC can handle an arbitrary set of | |
129 | ;; genres | |
5adf8455 | 130 | (format out "CDGENRE=(~{$'~A' ~})~%" (map escape-for-shell (disc-query 'GENRE))) |
dde7052d CE |
131 | |
132 | (format out "~:{TRACK~A=$'~A'~%~}" | |
133 | (map (lambda (ttitle) (list (1+ (first ttitle)) (escape-for-shell (second ttitle)))) | |
134 | (cddb-query-tracks cddb 'TITLE))))) | |
fa3eb6ac | 135 | |
27e5be1d CE |
136 | (define (main args) |
137 | (cond ((string= (second args) "parse") | |
138 | (call-with-input-file (third args) | |
139 | (lambda (f) (cddb->export (read-cddb f))))) | |
140 | (else | |
141 | (apply execlp "cddb-tool" args)))) | |
fa3eb6ac CE |
142 | |
143 | ||
27e5be1d CE |
144 | (when (batch-mode?) |
145 | (exit (main (program-arguments)))) |