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

[Matt Simmons <simmonmt@acm.org>]

How hard would it be to make cddb.el get the CDDB records through
HTTP?  Via a proxy?

Dammit.  There were other things I was supposed to be doing tonight.

CAVEATS:
  1. It works for me.  Using galette, it grabs the info for the Out of 
     Sight sound track, and retrieves the record.  I don't have a local 
     database, so my regression testing was limited to retrieving that 
     same CD through a direct socket connection.
  2. The code isn't the prettiest in the world.  See especially line
     442.  I'm also not particularly fond of the name of
     cddb-get-rest, nor of the way I determine whether or not I should 
     call it.
  3. Note that the cddb-hosts variable has changed format for all
     types of servers.
  4. It does NOT implement the CDDB encoding for weird characters, but 
     I don't think it needs to, unless they come up with a category
     name that can't go in a URL.

Matt

-- 
     Matt Simmons  -  simmonmt@acm.org  -  http://www.netcom.com/~simmonmt
       An economist is an expert who will know tomorrow why the things he
	 predicted yesterday didn't happen today.  --Laurence J. Peter
--- -	Thu Nov  5 00:01:51 1998
+++ cddb.el	Wed Nov  4 23:57:37 1998
@@ -43,20 +43,24 @@
 (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))
+(defvar cddb-hosts '((file "/opt/kde/share/apps/kscd/cddb/")
+		     (file "/usr/local/share/apps/kscd/cddb/")
+		     (file "/usr/share/apps/kscd/cddb/")
+		     (remote "cddb.moonsoft.com" 8880)
+		     (remote "cddb.sonic.net" 888)
+		     (remote "sunsite.unc.edu" 8880)
+		     (remote "www.cddb.com" 8880)
+		     (remote "cddb.netads.com" 8880)
+		     (remote "cddb.kagomi.com" 8880)
+		     (remote "cddb.celestial.com" 888)
+		     (http "cddb.sonic.net" "~cddb/cddb.cgi" 80))
   "*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.
+Entries in this list are themselves lists that specify the server
+location and access method.  The lists can be:
+
+ (file \"path\")             ;; Local database
+ (remote \"host\" port)      ;; Direct socket connection to remote server
+ (http \"host\" \"path\" port) ;; Server accessible via HTTP
 ")
 
 (defvar cddb-possible-probe-programs
@@ -322,7 +326,46 @@
       (buffer-substring (point-min) (match-beginning 0))
     (delete-region (point-min) (match-beginning 0))))
 
-(defun cddb-get-response (process &optional error-string)
+(defsubst cddb-get-rest ()
+  (let ((start (point)))
+    (re-search-forward "^\\.\r?$" nil t)
+    (buffer-substring start (match-beginning 0))))
+
+(defconst cddb-response-regexp "^\\([0-9]+\\)\\s-+\\([^\r\n]*\\)\r*\n")
+
+(defun cddb-get-remote-response (process &optional error-string)
+  "Handles getting a response from a CDDB server over a direct socket.
+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)
+"
+    (goto-char (point-min))
+    (while (not (re-search-forward cddb-response-regexp 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)))
+
+    (cddb-get-response process error-string))
+
+(defun cddb-get-http-response (&optional error-string)
+  "Handles getting a response from a CDDB server via HTTP.
+
+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)
+"
+  (if (not (re-search-forward cddb-response-regexp nil t))
+      (error "Malformed HTTP response"))
+
+  (cddb-get-response nil error-string))
+  
+  
+(defun cddb-get-response (process error-string)
   "Handles getting a response from a CDDB server.
 Return value is a list of (CODE DATA EXTENDEDDATA)
 
@@ -335,13 +378,10 @@
 	(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)))
-
+    (re-search-forward cddb-response-regexp nil t)
+    
     (setq response-code (string-to-int (match-string 1))
 	  response-data (match-string 2)
 	  major-code (/ response-code 100)
@@ -361,7 +401,8 @@
     (case minor-code
       (0 nil)				; Ready for further commands
       (1				; More server-to-client output follows
-       (setq extended-data (cddb-get-multiple-data process)))
+       (setq extended-data (if process (cddb-get-multiple-data process)
+			     (cddb-get-rest))))
       (2 nil)				; More client-to-server input follows
       (3 nil)				; Connection will close
       (otherwise nil))			; Unknown minor code is ok?
@@ -387,7 +428,7 @@
       (set-process-sentinel process 'ignore)
 
       ;; Slurp in the opening banner
-      (cddb-get-response process "Cannot connect to server: %s")
+      (cddb-get-remote-response process "Cannot connect to server: %s")
 
       ;; Send/receive the hello
       (process-send-string process
@@ -395,54 +436,29 @@
 				   (user-real-login-name)
 				   (system-name)
 				   cddb-version))
-      (cddb-get-response process)
+      (cddb-get-remote-response process)
 
       ;; Actually send the query
       (process-send-string process query)
-      (setq response (cddb-get-response process "Could not send query to server: %s"))
+      (setq response (cddb-get-remote-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))))))
+      ;; There must be a better way of turning chosen-record into the three
+      ;; three variables (hopefully eliminating the need for chosen-record),
+      ;; but I don't know what it is.
+      (setq chosen-record (cddb-process-query-response response))
+      (setq category (nth 0 chosen-record)
+	    discid (nth 1 chosen-record)
+	    title (nth 2 chosen-record))
+      
       (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")
+	(setq response (cddb-get-remote-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")
+      (cddb-get-remote-response process "Problem disconnecting from server: %s")
       (if (and entry (string-match "\r\n" entry))
 	  (progn
 	    ;; Has \r\n crap, clean it up
@@ -455,6 +471,98 @@
 	    (erase-buffer)))
       entry)))
 
+(defun cddb-http-search (query host url port)
+  "Perform a search on a remote HOST via HTTP for a given cddb query QUERY"
+  (message "Searching via HTTP: %s:%d" host port)
+  (save-excursion
+    (let (url-buffer cddb-command cddb-hello response chosen-record)
+
+      ; Send query
+      (setq cddb-hello
+	    (format "hello=%s+%s+cddb.el+%s&proto=1"
+		    (user-real-login-name)
+		    (system-name)
+		    cddb-version))
+      
+      (setq cddb-command
+	    (format "cmd=cddb+query+%s+%d+%s+%d"
+		    (nth 0 info)
+		    (nth 1 info)
+		    (mapconcat 'int-to-string (nth 3 info) "+")
+		    (nth 2 info)))
+
+      (setq url-buffer
+	    (cdr (url-retrieve
+		   (format "http://%s:%d/%s?%s&%s"
+			   host port url cddb-command cddb-hello))))
+
+      (setq response (cddb-get-http-response "Problem getting query result"))
+      (kill-buffer url-buffer)
+
+      (setq chosen-record (cddb-process-query-response response))
+      
+      (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
+	(setq cddb-command (format "cmd=cddb+read+%s+%s"
+				   (nth 0 chosen-record) (nth 1 chosen-record)))
+	
+	(setq url-buffer
+	      (cdr (url-retrieve
+		    (format "http://%s:%d/%s?%s&%s"
+			    host port url cddb-command cddb-hello))))
+	
+	(setq response (cddb-get-http-response "Error during `cddb read': %s")
+	      entry (nth 2 response))
+	(kill-buffer url-buffer))
+      
+      (if (and entry (string-match "\r\n" entry))
+	  (setq entry (replace-in-string entry "\r\n" "\n")))
+      entry)))
+
+(defun cddb-process-query-response (response)
+  "Process the result of a CDDB query command."
+  
+  (let ((query-response-regexp "\\(\\w+\\)\\s-+\\(........\\)\\s-\\(.*\\)")
+	category discid title)
+    (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))))))
+
+  (list category discid title))
+
+
+
 \f
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Main entry points
@@ -506,7 +614,20 @@
     (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))))
+      (case (car current-host)
+	(file
+	 (setq entry (cddb-local-search info
+					(cadr current-host))))
+
+	(remote
+	 (setq entry (apply 'cddb-remote-search
+			    query (cdr current-host))))
+
+	(http
+	 (setq entry (apply 'cddb-http-search
+			    info (cdr current-host))))
+
+	(t
+	 (concat "Unknown connection type " (symbol-name
+					     (car current-host))))))
     entry))