Re: all you MP3 people out there... a fix for lars!

[wmperry@aventail.com (William M. Perry)]

[-- Attachment #1: Type: text/plain, Size: 1439 bytes --]

wmperry@aventail.com (William M. Perry) writes:

> Darren Stalder <darren@u.washington.edu> writes:
> 
> > -----BEGIN PGP SIGNED MESSAGE-----
> > 
> > Wes Hardaker, in an immanent manifestation of deity, wrote:
> > >Willing?  Heck, thats what my "cdrec" script is currently written in.
> > >Was there another alternative???
> > 
> > Okay.  I've gotten the impression on ding that if it ain't e-lisp, it
> > ain't nuthin.  I need to make a recent change to cd->query and then I
> > can send a snapshot to anyone that wants it.
> 
>   And for those that really do think if it aint-e-lisp, its crap, here's a
> first pass at cddb.el.  It can use cdda2wav or cdparanoia to get the TOC
> from the CD, computes the discid, and can either look up the CD in a local
> CDDB database, or do it remotely.  It even works through my socks.el stuff, 
> wheee. :)
> 
>   Try evaluating (cddb-get-entry) when you have a CD in the drive.  It will
> pull back the XMCD style info.  Next on the list is actually parsing this
> out.  I want to eventually have a suite of elisp scripts that will just
> take a CD, convert the whole damn thing to mp3, and create an appropriate
> .XAM file (the xaudio album format).
> 
>   Or perhaps just go all the way and write an MP3 player in elisp and make
> the playlists, etc, controllable via custom, and album files in a nice easy 
> to (read ...) format.
> 
>   Any interest? :)

  Duh, here's the attachment.

-bp


[-- Attachment #2: cddb.el --]
[-- Type: text/plain, Size: 16831 bytes --]

;;; cddb.el --- CD DataBase interface
;; Author: William M. Perry <wmperry@aventail.com>
;; Created: October 29, 1998
;; Version: 0.1
;; Keywords: multimedia

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Copyright (c) 1998 Free Software Foundation, Inc.
;;;
;;; This file is not part of GNU Emacs, but the same permissions apply.
;;;
;;; GNU Emacs is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2, or (at your option)
;;; any later version.
;;;
;;; GNU Emacs is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Emacs; see the file COPYING.  If not, write to the
;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;;; Boston, MA 02111-1307, USA.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defconst cddb-version "0.1"
  "Version # of CDDB package.")

(defvar cddb-cdparanoia-program "cdparanoia"
  "*Where to find the cdparanoia program.")

(defvar cddb-cdda2wav-program "cdda2wav"
  "*Where to find the cdda2wav program.")

(defvar cddb-cdda2wav-arguments '("-N" "-t" "1" "-d" "1")
  "*Arguments to pass to cdda2wav to get CD track information.")

(defvar cddb-cd-query-function nil
  "*Function to call to get CD track information for a device.")
  
(defvar cddb-hosts '("/opt/kde/share/apps/kscd/cddb/"
		     "/usr/local/share/apps/kscd/cddb/"		     
		     "/usr/share/apps/kscd/cddb/"
		     ("cddb.moonsoft.com" 8880)
		     ("cddb.sonic.net" 888)
		     ("sunsite.unc.edu" 8880)
		     ("www.cddb.com" 8880)
		     ("cddb.netads.com" 8880)
		     ("cddb.kagomi.com" 8880)
		     ("cddb.celestial.com" 888))
  "*A list of CDDB database locations to search.
Entries in this list can be strings to specify a local directory
structure to search, or a list of (hostname portnumber) to specify a
remote CDDB server.
")

(defvar cddb-possible-probe-programs
  '((cddb-cdparanoia-program . cddb-cdparanoia-get-info)
    (cddb-cdda2wav-program . cddb-cdda2wav-get-info))
  "*Possible programs to probe for CD characteristics.
This is used if you have not explicitly set `cddb-cd-query-function'.

It is an assoc list.  The car of each entry is a symbol name that
holds the program name.  The cdr of each entry is a function name that
should be used as the value of `cddb-cd-query-function' if the program
is found.")


(defsubst cddb-sum-digit (i)
  (let ((sum 0))
    (mapc (lambda (char)
	    (setq sum (+ sum (string-to-int (char-to-string char)))))
	  (int-to-string i))
    sum))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Various ways to extract the information we need to do CDDB queries using
;;; external programs.
;;;
;;; Please feel free to add more!  Just please email them to the maintainer
;;; so other people can enjoy them as well.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun cddb-cdparanoia-get-info (&optional device)
  "Extractinformation about a cd using cdparanoia.
Returns a list of (DISCID TRACKS LENGTH TRACKINFO)

DISCID - the CDDB discid of the cd
TRACKS - the # of tracks on the cd
LENGTH - the total running time of the cd
TRACKINFO - a list of the frame offsets of each track
"
  (save-excursion
    (set-buffer (get-buffer-create " *cdparanoia*"))
    (erase-buffer)
    (let ((exit-status (if device
			   (call-process cddb-cdparanoia-program nil t nil "-d" device "-Q")
			 (call-process cddb-cdparanoia-program nil t nil "-Q")))
	  (track-info nil)
	  (track-time-info nil)
	  (sums 0)
	  (tracks 0)
	  (length 0)
	  (last-offset 0))
      (if (/= exit-status 0)
	  (error "Could not get execute `%s'" cddb-cdparanoia-program))
      (goto-char (point-min))
      (while (re-search-forward "\\([0-9]+\\)[^0-9]+[0-9][0-9]:[0-9][0-9]\\.[0-9][0-9].\\s-+\\([0-9]+\\)" nil t)
	(push (string-to-int (match-string 2)) track-info)
	(setq last-offset (+ (string-to-int (match-string 1)) (string-to-int (match-string 2)))))
      (setq track-info (reverse track-info)
	    tracks (length track-info)
	    track-time-info (mapcar (lambda (offset) (+ 2 (/ offset 75))) track-info)
	    length (- (+ 2 (/ last-offset 75)) (car track-time-info))
	    sums (apply (quote +) (mapcar (quote cddb-sum-digit) track-time-info)))
      (list (format "%02x%04x%02x" sums length tracks)
	    tracks
	    length
	    track-info))))

(defun cddb-cdda2wav-get-info (&optional device)
  "Extractinformation about a cd using cdda2wav.
Returns a list of (DISCID TRACKS LENGTH TRACKINFO)

DISCID - the CDDB discid of the cd
TRACKS - the # of tracks on the cd
LENGTH - the total running time of the cd
TRACKINFO - a list of the frame offsets of each track
"

  (save-excursion
    (set-buffer (get-buffer-create " *cdda2wav*"))
    (erase-buffer)
    (let* ((exit-status (if device
			    (apply 'call-process
				   cddb-cdda2wav-program nil t nil 
				   "-D" device
				   cddb-cdda2wav-arguments)
			  (apply 'call-process
				 cddb-cdda2wav-program nil t nil
				 cddb-cdda2wav-arguments)))
	  (track-info nil)
	  (track-time-info nil)
	  (sums 0)
	  (tracks 0)
	  (length 0)
	  (last-offset 0))
      (if (/= exit-status 0)
	  (error "Could not get execute `%s'" cddb-cdda2wav-program))
      (goto-char (point-min))
      (if (not (re-search-forward "starting sectors.*" nil t))
	  (error "Could not understand output of `%s'" cddb-cdda2wav-program))
      (delete-region (point-min) (match-end 0))
      (while (re-search-forward "\\s-*\\([^\(]+\\)\(\\s-*\\([0-9]+\\)\),?" nil t)
	(push (string-to-int (match-string 2)) track-info))
      (setq last-offset (pop track-info))
      (setq track-info (reverse track-info)
	    tracks (length track-info)
	    track-time-info (mapcar (lambda (offset) (+ 2 (/ offset 75))) track-info)
	    length (- (+ 2 (/ last-offset 75)) (car track-time-info))
	    sums (apply (quote +) (mapcar (quote cddb-sum-digit) track-time-info)))
      (list (format "%02x%04x%02x" sums length tracks)
	    tracks
	    length
	    track-info))))    

\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; XMCD file parsing
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defsubst cddb-parse-valid-p ()
  (save-excursion
    (goto-char (point-min))
    (looking-at "# xmcd")))

(defun cddb-parse-get-item (name)
  (goto-char (point-min))
  (let ((regexp (format "^\\s-*%s=\\(.*\\)" name))
	(value ""))
    (while (re-search-forward regexp nil t)
      (setq value (concat value (match-string 1))))
    value))

(defun cddb-parse-info (&optional buffer)
  (save-excursion
    (set-buffer (or buffer (current-buffer)))
    (if (not (cddb-parse-valid-p))
	nil
      )))
	
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Local searching
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun cddb-local-search-internal (discid dir)
  (let ((subdirs (directory-files dir nil nil nil 5))
	(subdir nil)
	(matches nil)
	(entry nil))
    (if (file-exists-p (expand-file-name discid dir))
	(push (expand-file-name discid dir) matches))
    (while subdirs
      (setq subdir (pop subdirs))
      (if (or (string= "." subdir) (string= ".." subdir))
	  nil
	(setq entry (cddb-local-search-internal discid (expand-file-name subdir dir)))
	(if entry
	    (setq matches (append matches entry)))))
    matches))

(defun cddb-local-search (info dir)
  (if (not (file-exists-p dir))
      nil
    (message "Searching locally: %s" dir)
    (let ((matches (cddb-local-search-internal (car info) dir))
	  (discid nil)
	  (filename nil)
	  (title nil))
      (if (not matches)
	  nil
	(save-excursion
	  (set-buffer (get-buffer-create " *cddb*"))
	  (while matches
	    (erase-buffer)
	    (insert-file-contents (car matches))
	    (push (car matches) filename)
	    (push (cddb-parse-get-item "DISCID") discid)
	    (push (cddb-parse-get-item "DTITLE") title)
	    (pop matches)))

	(if (= (length discid) 1)
	    (setq discid (car discid)
		  title (car title)
		  filename (car filename)))

	(if (listp discid)
	    (let ((choices nil)
		  (completion-ignore-case t))
	      (while title
		(push (cons (pop title) (cons (pop filename) (pop discid))) choices))
	      (setq title (completing-read "Multiple matches, choose: " choices nil t))
	      (if (not title)
		  (error "Must choose an item from the list."))
	      (setq filename (car (car (assoc title choices)))
		    discid (cdr (car (assoc title choices))))))
	(save-excursion
	  (set-buffer (get-buffer-create " *cddb*"))
	  (erase-buffer)
	  (insert-file-contents filename)
	  (buffer-string))))))

\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Remote searching
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun cddb-build-query-string (info)
  (format "cddb query %s %d %s %d\r\n"
	  (nth 0 info)
	  (nth 1 info)
	  (mapconcat 'int-to-string (nth 3 info) " ")
	  (nth 2 info)))

(defsubst cddb-process-live-p (process)
  (memq (process-status process) '(run open)))
	
(defsubst cddb-get-multiple-data (process)
  (goto-char (point-min))
  (while (not (re-search-forward "^\\.\r?$" nil t))
    (if (not (cddb-process-live-p process))
	(error "CDDB Connection unexpectedly closed."))
    (accept-process-output process))
  (replace-match "")
  (prog1
      (buffer-substring (point-min) (match-beginning 0))
    (delete-region (point-min) (match-beginning 0))))

(defun cddb-get-response (process &optional error-string)
  "Handles getting a response from a CDDB server.
Return value is a list of (CODE DATA EXTENDEDDATA)

CODE is the numerical response code
DATA is the single-line textual response from the server
EXTENDEDDATA is the extra data from the server (for x1x responses)
"
  (let ((response-code nil)
	(response-data nil)
	(extended-data nil)
	(major-code nil)
	(minor-code nil))
    (goto-char (point-min))
    (while (not (re-search-forward "^\\([0-9]+\\)\\s-+\\([^\r\n]*\\)\r*\n" nil t))
      (if (not (cddb-process-live-p process))
	  (error (or error-string "Error: %s") "Connection unexpectedly closed."))
      (accept-process-output process)
      (goto-char (point-min)))

    (setq response-code (string-to-int (match-string 1))
	  response-data (match-string 2)
	  major-code (/ response-code 100)
	  minor-code (/ (- (% response-code 100) (% (% response-code 100) 10)) 10))
    (replace-match "")
    (case major-code
      (1 nil)				; Informative message
      (2 nil)				; Command OK
      (3 nil)				; Command OK so far, continue
      (4				; Command Ok, but cannot be performed
       (error (or error-string "Cannot perform command: %s") response-data))
      (5				; Command unimplemented, incorrect, or program error
       (error (or error-string "Error: %s") response-data))
      (otherwise			; Unknown major response code!
       (error "Unknown major response code: %d" response-code)))

    (case minor-code
      (0 nil)				; Ready for further commands
      (1				; More server-to-client output follows
       (setq extended-data (cddb-get-multiple-data process)))
      (2 nil)				; More client-to-server input follows
      (3 nil)				; Connection will close
      (otherwise nil))			; Unknown minor code is ok?

    (list response-code response-data extended-data)))

(defun cddb-remote-search (query host port)
  "Perform a search on a remote HOST for a given cddb query QUERY"
  (message "Searching remotely: %s:%d" host port)
  (save-excursion
    (set-buffer (get-buffer-create " *cddb*"))
    (erase-buffer)
    (let ((process (open-network-stream "cddb" (current-buffer) host port))
	  (response nil)
	  (category nil)
	  (discid nil)
	  (title nil)
	  (entry nil))

      ;; This is just so we don't see the annoying (to me)
      ;; 'Process foo exited abnormally with code ###'
      ;; at the end of every connection.
      (set-process-sentinel process 'ignore)

      ;; Slurp in the opening banner
      (cddb-get-response process "Cannot connect to server: %s")

      ;; Send/receive the hello
      (process-send-string process
			   (format "cddb hello %s %s cddb.el %s\r\n"
				   (user-real-login-name)
				   (system-name)
				   cddb-version))
      (cddb-get-response process)

      ;; Actually send the query
      (process-send-string process query)
      (setq response (cddb-get-response process "Could not send query to server: %s"))

      (let ((query-response-regexp "\\(\\w+\\)\\s-+\\(........\\)\\s-\\(.*\\)"))
	(case (car response)
	  (200
	   ;; Found exact match
	   (if (string-match query-response-regexp (nth 1 response))
	       (setq category (match-string 1 (nth 1 response))
		     discid (match-string 2 (nth 1 response))
		     title (match-string 3 (nth 1 response)))))
	  (202
	   ;; No matches found
	   )
	  ((210 211)
	   ;; 210 = Found multiple exact matches, list follows
	   ;; 211 = Found inexact matches, list follows
	   (setq response (split-string "\r?\n" (nth 2 response)))
	   (while response
	     (if (string-match query-response-regexp (car response))
		 (progn
		   (push (match-string 1 (car response)) category)
		   (push (match-string 2 (car response)) discid)
		   (push (match-string 3 (car response)) title))
	       (error "Can not understand query response: %s" (car response)))
	     (pop response)))))
      (if (listp category)
	  (let ((choices nil)
		(completion-ignore-case t))
	    (while title
	      (push (cons (pop title) (cons (pop category) (pop discid))) choices))
	    (setq title (completing-read "Multiple matches, choose: " choices nil t))
	    (if (not title)
		(error "Must choose an item from the list."))
	    (setq category (car (car (assoc title choices)))
		  discid (cdr (car (assoc title choices))))))
      (if (not category)
	  ;; Didn't find _any_ matches, or the user didn't like what they found
	  ;; let's move on to the next server.
	  nil
	(process-send-string process (format "cddb read %s %s\r\n" category discid))
	(setq response (cddb-get-response process "Error during `cddb read': %s")
	      entry (nth 2 response)))
      (process-send-string process "quit\r\n")
      (cddb-get-response process "Problem disconnecting from server: %s")
      (if (and entry (string-match "\r\n" entry))
	  (progn
	    ;; Has \r\n crap, clean it up
	    (erase-buffer)
	    (insert entry)
	    (goto-char (point-min))
	    (while (re-search-forward "\r\n" nil t)
	      (replace-match "\n"))
	    (setq entry (buffer-string))
	    (erase-buffer)))
      entry)))

\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Main entry points
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun cddb-init ()
  (if (not cddb-cd-query-function)
      (let ((paths nil)
	    (possible-probes cddb-possible-probe-programs)
	    (probe nil)
	    (program-name nil))

	(while possible-probes
	  (setq probe (car possible-probes)
		possible-probes (cdr possible-probes)
		paths exec-path
		program-name (symbol-value (car probe)))
	  (while paths
	    (if (and (file-exists-p (expand-file-name program-name (car paths)))
		     (file-executable-p (expand-file-name program-name (car paths))))
		(setq paths nil
		      possible-probes nil
		      cddb-cd-query-function (cdr probe)))
	    (setq paths (cdr paths))))))
  (if (not cddb-cd-query-function)
      (save-window-excursion
	(set-buffer (get-buffer-create "*CDDB Error*"))
	(erase-buffer)
	(insert "*** ERROR ***\n\n"
		"An error occured while trying to determine how to get CD track "
		"information on your system.\n\n"
		"None of the following programs was found on your system.  "
		"Please customize one of the variables and try again.")
	(fill-region (point-min) (point-max))
	(insert "\n")
	(mapcar (lambda (v)
		  (insert (symbol-name (car v)) " -- " (symbol-value (car v)) "\n"))
		cddb-possible-probe-programs)
	(display-buffer (current-buffer))
	(read-string "An error occured - press RETURN to continue...")
	(error "Aborting"))))

(defun cddb-get-entry (&optional device)
  (cddb-init)
  (let* ((current-host nil)
	 (hosts cddb-hosts)
	 (info (funcall cddb-cd-query-function device))
	 (entry nil)
	 (query (cddb-build-query-string info)))
    (while (and hosts (not entry))
      (setq current-host (car hosts)
	    hosts (cdr hosts))
      (if (stringp current-host)
	  (setq entry (cddb-local-search info current-host))
	(setq entry (apply 'cddb-remote-search query current-host))))
    entry))