abcddb-tool

   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
  91
  92
  93
  94
  95