;;; Parse CDDB data base
;;; $Id: cddb.lisp,v 1.2 2003/05/16 15:55:34 bernd Exp bernd $
(defconstant *cddb* #p"/var/cache/cddb/")
(defun all-discs (cddb-path)
"Get all CDDB files in CDDB path."
(mapcar #'(lambda (dir)
(append (last (pathname-directory dir)) ; store category
(directory dir :check-for-subdirs nil))) ; all discs in category
(directory cddb-path :check-for-subdirs t))) ; all categories
(defun parse-cddb-database (cddb-path)
"Parse all files in CDDB path."
(mapcar #'(lambda (x)
(cons (car x)
(mapcar #'parse-cddb-file (cdr x))))
(all-discs cddb-path)))
(defun parse-cddb-file (file-name)
"Parse one CDDB file."
(with-open-file (stream file-name :direction :input)
(parse-cddb stream)))
(defun parse-cddb (stream)
"Parse one CDDB file."
;; Remove "TTITLEx=" from list
(mapcar #'(lambda (x) (if (track-titlep x) (line-content x) x))
(do ((line (read-line stream nil) (read-line stream nil))
dtitle ttitle)
((null line) (cons dtitle (nreverse ttitle)))
(cond
;; Concatenate all DTITLE lines
((disc-titlep line)
(setf dtitle (concatenate 'string dtitle (line-content line))))
;; Concatenate TTITLE lines with the same ID
((track-titlep line)
(if (string= (line-id line) (line-id (car ttitle)))
(rplaca ttitle (concatenate 'string (car ttitle)
(line-content line)))
(push line ttitle)))))))
(defun disc-titlep (str)
(equal (search "DTITLE" str) 0))
(defun track-titlep (str)
(equal (search "TTITLE" str) 0))
(defun line-id (line)
"Get the ID of a line before the character \"=\"."
(let ((pos (search "=" line)))
(when pos (subseq line 0 pos))))
(defun line-content (line)
"Get the content of a line after the character \"=\"."
(let ((pos (search "=" line)))
(when pos (subseq line (1+ pos)))))
;;; HTTP Output
(defun print-html-file (cddb file-name)
"Print the CDDB data base as HTML."
(with-open-file (stream file-name :direction :output)
(print-html cddb stream)))
(defun print-html (cddb stream)
"Print the CDDB data base as HTML."
(format stream "")
(format stream "~%")
(format stream "~%Bings CD-Sammlung")
(format stream "~%")
(format stream "~%")
(print-outline (copy-tree cddb) stream) ; because SORT is destructive
(format stream"~%
")
(print-all-titles cddb stream)
(format stream"~%~%~%"))
(defun print-outline (cddb stream)
"Print CDDB in outline mode."
(let ((anchor 1))
(dolist (category cddb)
(let ((category-name (car category))
(category-list (sort (cdr category) #'string-lessp :key #'car)))
(format stream "~%~:(~A~)
" category-name)
(format stream "~%")
(dolist (disc category-list)
(let ((disc-name (car disc)))
(format stream "~%- ~A
"
anchor disc-name)
(incf anchor)))
(format stream "~%
")))))
(defun print-all-titles (cddb stream)
"Print CDDB in verbose mode."
(let ((anchor 1))
(dolist (category cddb)
(let ((category-name (car category))
(category-list (sort (cdr category) #'string-lessp :key #'car)))
(format stream "~%~:(~A~)
" category-name)
(dolist (disc category-list)
(let ((disc-name (car disc))
(title-list (cdr disc)))
(format stream "~%~A
"
anchor disc-name)
(incf anchor)
(format stream "~%")
(dolist (title title-list)
(format stream "~%- ~A
" title))
(format stream "~%
")))))))
(print-html-file (parse-cddb-database *cddb*) "cddb.html")
; (load "cddb")
; (compile-file "cddb" :load t)