From fa3eb6ac4b1c4e28d34dc2c915ae55d76038ba42 Mon Sep 17 00:00:00 2001
From: Clinton Ebadi <clinton@unknownlamer.org>
Date: Mon, 3 Dec 2012 22:04:28 -0500
Subject: [PATCH] New Scheme "abcddb-tool" Script to parse the xmcd files
 generated by the musicbrainz tool. Since you already can't submit these to
 freedb, there's no reason not to add support for separate ARIST/TITLE,
 multiple GENREs, and vorbis/flac specific track tags (e.g. PART, ISRC).
 Currently only implements a trivial database.

---
 abcddb-tool | 95 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 95 insertions(+)
 create mode 100755 abcddb-tool

diff --git a/abcddb-tool b/abcddb-tool
new file mode 100755
index 0000000..8aab4ed
--- /dev/null
+++ b/abcddb-tool
@@ -0,0 +1,95 @@
+#!/usr/bin/guile -s
+!#
+
+;;; -*- scheme -*-
+
+;;; Parse for enhanced XMCD. Original format: http://ftp.freedb.org/pub/freedb/latest/DBFORMAT
+
+(use-modules (ice-9 format)
+	     (ice-9 rdelim)
+	     (ice-9 streams)
+	     (ice-9 regex)
+	     (ice-9 vlist)
+
+	     (srfi srfi-1))
+
+;;; VList/VHash utility functions
+
+(define (vhash-cat key new-value vhash)
+  "Add NEW-VALUE to the VList stored under VHASH.KEY"
+  (vhash-set key (vlist-append (let ((lst (vhash-assoc key vhash)))
+				  (if lst (cdr lst) vlist-null))
+				(vlist-cons new-value vlist-null))
+	      vhash))
+
+(define (vhash-set key new-value vhash)
+  (vhash-cons key new-value (vhash-delete key vhash)))
+
+
+;;; Simple key/value database for cddb and toc info
+
+;;; DO NOT RELY ON THE IMPLEMENTATION, it sucks. Always use the query
+;;; functions. The disc query functions return the list of values, the
+;;; track query functions return an alist of (track-num
+;;; . values). Values are always plural, just grab the car if you want
+;;; a single value. It's not the best interface, but it sure beats
+;;; grepping the xmcd file!
+
+(define (make-initial-db . toplevel-keys)
+  (fold (lambda (key db) (vhash-cons key vlist-null db)) vlist-null toplevel-keys))
+
+(define (cddb-query-disc db tag)
+  "Query the database for a disc attribute"
+  (let ((result (vhash-assoc tag (cdr (vhash-assoc 'disc db)))))
+    (if result (vlist->list (cdr result)) #f)))
+
+(define (cddb-query-tracks db tag)
+  "Query the database for a track attribute and return alist
+of (disc-number . tag-value)"
+  (let ((r (vlist->list (vhash-fold (lambda (key vh results)
+				      (let ((result (vhash-assoc tag vh)))
+					(if result
+					    (vhash-cons key (vlist->list (cdr result)) results)
+					    results)))
+				    vlist-null
+				    (cdr (vhash-assoc 'tracks db))))))
+    (if (null? r) #f r)))
+
+(define (read-cddb cddb-port)
+  (define (parse-cddb-line line db)
+    (define (line-match regex) (string-match regex line))
+
+    (cond
+     ((line-match "^#(.*)$") => (lambda (x) (vhash-cat 'comment (match:substring x 1) db)))
+     ((line-match "^DISCID=([[:graph:]]+)$") => (lambda (x) (let ((disc-db (cdr (vhash-assoc 'disc db))))
+							 (vhash-set 'disc (vhash-cat 'DISCID (match:substring x 1) disc-db)
+								    db))))
+     ((line-match "^D([[:alpha:]]+)=([[:graph:][:space:]]+)$") => (lambda (x)
+								    (let ((disc-db (cdr (vhash-assoc 'disc db)))
+									  (key (string->symbol (match:substring x 1))))
+								      (vhash-set 'disc (vhash-cat key (match:substring x 2) disc-db)
+										 db))))
+   
+     ((line-match "^T([[:alpha:]]+)([[:digit:]]+)=([[:graph:][:space:]]+)$")
+      => (lambda (x)
+	   (let* ((tracks-db (cdr (vhash-assoc 'tracks db)))
+		  (tracknum (string->number (match:substring x 2)))
+		  (tracknum-db ((lambda (vh) (if vh (cdr vh) vlist-null)) (vhash-assoc tracknum tracks-db)))
+		  (key (string->symbol (match:substring x 1)))
+		  (tag-value (match:substring x 3)))
+	     (vhash-set 'tracks (vhash-set tracknum (vhash-cat key tag-value tracknum-db)
+					   tracks-db)
+			db))))
+   
+     ;; Also match EXTD? Might just punt if abcde handles it separately
+     (else db)))
+  
+  (stream-fold parse-cddb-line
+	       (make-initial-db 'comment 'disc 'tracks)
+	       (port->stream cddb-port read-line)))
+
+
+
+
+
+
-- 
2.20.1