1 ;;;; vim: set fenc=utf-8 lisp ic wm=0 et tw=0 sm para=lpppipnpbp sect=shuh ai : 2 ;;;; --------------------------------------------------------------------------- 3 ;;;; FILE IDENTIFICATION 4 ;;;; 5 ;;;; Name: mpdclient.lisp 6 ;;;; Purpose: A Common Lisp interface to MPD. 7 ;;;; Author: Stephen P. Horner 8 ;;;; Started: 2006-03-28 9 ;;;; 10 ;;;; Copyright © 2006 by Stephen P. Horner - All Rights Reserved. 11 ;;;; 12 ;;;; This project's homepage is: http://www.common-lisp.net/project/cl-mpd 13 ;;;; 14 ;;;; Redistribution and use in source and binary forms, with or without 15 ;;;; modification, are permitted provided that the following conditions 16 ;;;; are met: 17 ;;;; 18 ;;;; - Redistributions of source code must retain the above copyright 19 ;;;; notice, this list of conditions and the following disclaimer. 20 ;;;; 21 ;;;; - Redistributions in binary form must reproduce the above copyright 22 ;;;; notice, this list of conditions and the following disclaimer in the 23 ;;;; documentation and/or other materials provided with the distribution. 24 ;;;; 25 ;;;; - Neither the name of CL-MPD nor the names of its contributors may 26 ;;;; be used to endorse or promote products derived from this software 27 ;;;; without specific prior written permission. 28 ;;;; 29 ;;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 30 ;;;; ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 31 ;;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 32 ;;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE FOUNDATION OR 33 ;;;; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 34 ;;;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 35 ;;;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 36 ;;;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 37 ;;;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 38 ;;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 39 ;;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 40 ;;;; 41 ;;;; --------------------------------------------------------------------------- 42 43 ;;; TODO 44 ;;; Add the code to the primary methods that execute mpd commands that checks 45 ;;; for an active connection to mpd before executing commands, and reconnect 46 ;;; to MPD if necessary. 47 ;;; 48 ;;; TODO 49 ;;; Rewrite my parsers; all of them! This multi-STRING= method needs replacing. 50 ;;; 51 ;;; TODO 52 ;;; Rewrite all the code that is using SUBSEQ to analyze parts of a sequence, 53 ;;; because SUBSEQ conses. 54 55 56 (eval-when (:compile-toplevel :load-toplevel) 57 (declaim (optimize (speed 0) (space 0) (safety 1) (debug 3) (compilation-speed 0)))) 58 59 (in-package #:mpd) 60 61 ;;; Find out when a REQUIRE is normally evaluated. 62 (eval-when (:compile-toplevel :load-toplevel :execute) 63 #+sbcl (require :sb-bsd-sockets) 64 #+lispworks (require "comm")) 65 66 ;;; Don't touch this. 67 (defparameter *mpd-welcome-message* "OK MPD ") 68 69 ;;; These aren't used yet, but will be soon. 70 (defconstant +mpd-error-not-list+ 1) 71 72 (defconstant +mpd-error-arg+ 2) 73 (defconstant +mpd-error-password+ 3) 74 (defconstant +mpd-error-permission+ 4) 75 (defconstant +mpd-error-unknown-cmd+ 5) 76 (defconstant +mpd-error-no-exist+ 50) 77 (defconstant +mpd-error-playlist_max+ 51) 78 (defconstant +mpd-error-system+ 52) 79 (defconstant +mpd-error-playlist-load+ 53) 80 (defconstant +mpd-error-update-already+ 54) 81 (defconstant +mpd-error-player-sync+ 55) 82 (defconstant +mpd-error-exist+ 56) 83 84 (eval-when (:compile-toplevel :load-toplevel :execute) 85 (defparameter *debug-on* t 86 "Either NIL or T, determines if debug routines run or not.")) 87 88 89 ;;; -------------------------- 90 ;;; Utilities 91 ;;; -------------------------- 92 93 (defmacro fprint (strm &body body) 94 "FPRINT equates to forced print, since FORMAT is to dumb to print automagically." 95 `(progn 96 (format ,strm ,@body) 97 (finish-output))) 98 99 100 (defmacro dprint (&body body) 101 "Prints debug info if code was compiled with *DEBUG-ON* set to T." 102 (if *debug-on* 103 `(progn 104 (format *debug-io* ,@body) 105 (finish-output)))) 106 107 108 (defun quit () 109 #+sbcl (sb-ext:quit) 110 #+clisp (ext:quit) 111 ) 112 113 (defun fullgc () 114 #+sbcl (sb-ext:gc :full t) 115 #+clisp (ext:gc) 116 ) 117 118 119 ;;; -------------------------- 120 ;;; Backend code 121 ;;; -------------------------- 122 123 (defun scrub-newline-chars (str &key verbose) 124 (when verbose 125 (write-line "SCRUB-NEWLINE-CHARS was passed...") 126 (let ((tmp (map 'vector #'(lambda (x) 127 (format t "~@C " x)) 128 str))))) 129 (substitute #\Space #\Newline str :test #'char=)) 130 131 132 (declaim (inline append-newline-char)) 133 (defun append-newline-char (str) 134 (declare (type simple-string str)) 135 (concatenate 'string str '(#\Newline))) 136 137 138 #+sbcl 139 (defun lookup-hostname (host &key ignore-cache) 140 (when (stringp host) 141 (sb-bsd-sockets:host-ent-address 142 (sb-bsd-sockets:get-host-by-name host)))) 143 144 145 ;;; Find out how to pass the raw socket as a VALUES on clisp 146 (defun make-active-socket (server port) 147 "Returns (VALUES STREAM SOCKET)" 148 #+clisp 149 (let ((iostream (socket:socket-connect port server :external-format :unix))) 150 (values iostream iostream)) 151 #+lispworks 152 (let ((sock (comm:open-tcp-stream server port))) 153 (values sock sock)) 154 #+sbcl 155 (let ((socket (make-instance 'sb-bsd-sockets:inet-socket 156 :type :stream 157 :protocol :tcp)) 158 (hostname (lookup-hostname server))) 159 (sb-bsd-sockets:socket-connect socket hostname port) 160 (values 161 (sb-bsd-sockets:socket-make-stream socket 162 :input t 163 :output t 164 :element-type 'base-char) 165 socket)) 166 #-(or clisp sbcl lispworks) (error "CL-MPD is not implemented on this lisp.")) 167 168 169 (defun read-buf-nonblock (buffer stream) 170 "Like READ-SEQUENCE, but returns early if the full quantity of data isn't there to be read. 171 Blocks if no input at all" 172 (let ((eof (gensym))) 173 (do ((i 0 (1+ i)) 174 (c (read-char stream nil eof) 175 (read-char-no-hang stream nil eof))) 176 ((or (>= i (length buffer)) (not c) (eq c eof)) i) 177 (setf (elt buffer i) c)))) 178 179 180 ;;; TODO 181 ;;; 1) What is preventing this from getting the mpd welcome message in MPD-MAKE-CONNECTION? 182 ;;; 2) What is preventing mpd-get-return-elements from getting the end OK\n? 183 ;;; 3) Does the EOF set to OK\n work correctly? 184 ;;; 185 ;;; TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO 186 ;;; This needs to be rewritten to call another function which calls 187 ;;; READ-BUF-NONBLOCK, so that I can then take the return of that function and 188 ;;; pass it to CHECK-FOR-ERRORS. Then have this function do it's normat 189 ;;; splitting the return elements into (key:value) pairs. I think this will 190 ;;; also fix the above. 191 (defun mpd-get-return-elements (iostream) 192 "Returns a list of MPD return elements, each cons cell being key:value." 193 (let ((ret ()) 194 (eof (append-newline-char "OK"))) 195 (do ((c (read-line iostream nil eof) (read-line iostream nil eof))) 196 ((null (listen iostream)) (nreverse ret)) 197 #+nil 198 (dprint "~&## DEBUG: in MPD-GET-RETURN-ELEMENTS pushing ~D on RET" c) 199 (push (list c) ret)))) 200 201 202 (defun split-mpd-key-value-pair (str) 203 (let ((pos (position #\: str))) 204 (list (subseq str 0 pos) (subseq str (1+ pos))))) 205 206 207 ;;; UNTESTED 208 #+nil 209 (defun flush-return-elements (iostream) 210 (loop while (mpd-get-return-elements iostream))) 211 212 213 (defun mpd-get-port () 214 "Get the environment variable MPD_PORT." 215 #+clisp 216 (let ((port (parse-integer (ext:getenv "MPD_PORT")))) 217 (if (not (null port)) 218 port 219 6600)) 220 #+sbcl 221 (let ((port (parse-integer (sb-ext:posix-getenv "MPD_PORT")))) 222 (if (not (null port)) 223 port 224 6600)) 225 #+lispworks 226 6600 227 ) 228 229 230 (defun mpd-get-host () 231 "Get the environment variable MPD_HOST." 232 #+clisp 233 (let ((host (ext:getenv "MPD_HOST"))) 234 (if (not (null host)) 235 host 236 "localhost")) 237 #+sbcl 238 (let ((host (sb-ext:posix-getenv "MPD_HOST"))) 239 (if (not (null host)) 240 host 241 "localhost")) 242 #+lispworks 243 "localhost" 244 ) 245 246 247 (defun mpd-make-connection (host port &key (timeout 1)) 248 "Creates a connection to MPD. Returns (VALUES STREAM SOCKET)." 249 (let ((data (make-string 200))) 250 (multiple-value-bind (iostream sock) (make-active-socket host port) 251 (if (null iostream) 252 (error "~&Failed to establish a connection with MPD, IOSTREAM was null.~%")) 253 (sleep timeout) 254 (let ((data (subseq data 0 (read-buf-nonblock data iostream)))) 255 (dprint "~&## DEBUG: Recieved [~D] from MPD~%" (scrub-newline-chars data)) 256 (if (not (string= *mpd-welcome-message* (subseq data 0 7))) 257 (error "~&Failed to establish a connection with MPD, *MPD-WELCOME-MESSAGE* was bad.~%")) 258 (values iostream sock))))) 259 260 261 ;;; TODO Get this working with MPD-GET-RETURN-ELEMENTS 262 #+nil 263 (defun mpd-make-connection (host port &key (timeout 1)) 264 "Creates a connection to MPD. Returns (VALUES STREAM SOCKET)." 265 (multiple-value-bind (iostream sock) (make-active-socket host port) 266 (if (null iostream) 267 (error "~&Failed to establish a connection with MPD~%")) 268 (sleep timeout) 269 (dprint "~&## DEBUG: LISTEN returns ~S" (listen iostream)) 270 (let ((ret (mpd-get-return-elements iostream))) 271 (dprint "~&## DEBUG: MPD sent us... ~S." (car ret)) 272 (values iostream sock)))) 273 274 275 276 ;;; -------------------------- 277 ;;; MPD Commands 278 ;;; -------------------------- 279 280 ;;; test if this declare helps at all 281 (defun mpd-send-command (iostream command) 282 (declare (optimize (speed 3) (safety 1)) 283 (type string command) (type iostream iostream)) 284 (if (open-stream-p iostream) 285 (progn 286 (write-string (append-newline-char command) iostream) 287 (force-output iostream)) 288 (error "MPD-SEND-COMMAND was passed a closed stream."))) 289 290 291 (defun mpd-send-add-command (iostream path) 292 (let ((command (format nil "add \"~D\"" path))) 293 (mpd-send-command iostream command))) 294 295 296 (defun mpd-send-addid-command (iostream id) 297 (let ((command (format nil "addid \"~S\"" id))) 298 (mpd-send-command iostream command))) 299 300 301 (defun mpd-send-clear-command (iostream) 302 "Clears the current playlist." 303 (mpd-send-command iostream "clear")) 304 305 306 (defun mpd-send-clearerror-command (iostream) 307 (mpd-send-command iostream "clearerror")) 308 309 310 (defun mpd-send-close-command (iostream) 311 "Closes the connection to MPD." 312 (mpd-send-command iostream "close")) 313 314 315 (defun mpd-send-commands-command (iostream) 316 "Get list of MPD commands." 317 (mpd-send-command iostream "commands")) 318 319 320 (defun mpd-send-crossfade-command (iostream seconds) 321 "Sets crossfading between songs." 322 (let ((command (format nil "crossfade \"~S\"" seconds))) 323 (mpd-send-command iostream command))) 324 325 326 (defun mpd-send-currentsong-command (iostream) 327 (mpd-send-command iostream "currentsong")) 328 329 330 (defun mpd-send-delete-command (iostream song) 331 "Delete the song in the playlist at SONG position." 332 (let ((command (format nil "delete \"~D\"" song))) 333 (mpd-send-command iostream command))) 334 335 336 (defun mpd-send-deleteid-command (iostream songid) 337 "Deletes SONGID in the playlist." 338 (let ((command (format nil "deleteid \"~D\"" songid))) 339 (mpd-send-command iostream command))) 340 341 342 ;;; MPD-SEND-DISABLEOUPUT-COMMAND 343 344 345 ;;; MPD-SEND-ENABLEOUTPUT-COMMAND 346 347 348 (defun mpd-send-find-command (iostream type what) 349 (let ((command (format nil "find \"~D\" \"~D\"" type what))) 350 (mpd-send-command iostream command))) 351 352 353 (defun mpd-send-kill-command (iostream) 354 "Kills MPD." 355 (mpd-send-command iostream "kill")) 356 357 358 ;;; untested 359 (defun mpd-send-list-command (iostream type &optional (arg nil arg-supplied-p)) 360 "Lists all tags of TYPE, ARG is an optional specifier such as an artist." 361 (if arg-supplied-p 362 (progn 363 (let ((command (format nil "list \"~D\" \"~D\"" type arg))) 364 (mpd-send-command iostream command))) 365 (progn 366 (let ((command (format nil "list \"~D\"" type))) 367 (mpd-send-command iostream command))))) 368 369 370 (defun mpd-send-listall-command (iostream dir) 371 "Lists all songs and directories in DIR recursively." 372 (let ((command (format nil "listall \"~D\"" dir))) 373 (mpd-send-command iostream command))) 374 375 376 (defun mpd-send-listallinfo-command (iostream dir) 377 "Lists contents of DIR recursively, including song metadata." 378 (let ((command (format nil "listallinfo \"~D\"" dir))) 379 (mpd-send-command iostream command))) 380 381 382 (defun mpd-send-load-command (iostream name) 383 "Loads the playlist NAME.m3u from the playlist dir." 384 (let ((command (format nil "load \"~D\"" name))) 385 (mpd-send-command iostream command))) 386 387 388 (defun mpd-send-lsinfo-command (iostream dir) 389 "Lists contents of DIR from the db, including song metadata." 390 (let ((command (format nil "lsinfo \"~D\"" dir))) 391 (mpd-send-command iostream command))) 392 393 394 (defun mpd-send-move-command (iostream from to) 395 "Moves song at position FROM to position TO." 396 (let ((command (format nil "move \"~S\" \"~S\"" from to))) 397 (mpd-send-command iostream command))) 398 399 400 (defun mpd-send-moveid-command (iostream songid to) 401 "Moves the song with the id SONGID to position TO in the playlist." 402 (let ((command (format nil "moveid \"~S\" \"~S\"" songid to))) 403 (mpd-send-command iostream command))) 404 405 406 (defun mpd-send-next-command (iostream) 407 (mpd-send-command iostream "next")) 408 409 410 (defun mpd-send-notcommands-command (iostream) 411 (mpd-send-command iostream "notcommands")) 412 413 414 (defun mpd-send-outputs-command (iostream) 415 (mpd-send-command iostream "outputs")) 416 417 418 (defun mpd-send-password-command (iostream password) 419 "Authenticate with the server with PASSWORD." 420 (let ((command (format nil "password \"~D\"" password))) 421 (mpd-send-command iostream command))) 422 423 424 (defun mpd-send-pause-command (iostream mode) 425 "Toggles the pause state of mpd to 1 on, or 0 off." 426 (let ((command (format nil "pause \"~S\"" mode))) 427 (mpd-send-command iostream command))) 428 429 430 (defun mpd-send-ping-command (iostream) 431 (mpd-send-command iostream "ping")) 432 433 434 (defun mpd-send-play-command (iostream song) 435 "Plays song position number SONG in the playlist." 436 (let ((command (format nil "play \"~S\"" song))) 437 (mpd-send-command iostream command))) 438 439 440 (defun mpd-send-playid-command (iostream id) 441 "Plays song associated with ID from the playlist." 442 (let ((command (format nil "playid \"~S\"" id))) 443 (mpd-send-command iostream command))) 444 445 446 ;;; don't use this, use playlistinfo instead. 447 (defun mpd-send-playlist-command (iostream) 448 (mpd-send-command iostream "playlist")) 449 450 451 (defun mpd-send-playlistid-command (iostream &key songid) 452 "Displays list of songs in the playlist, :SONG specializes on a single song id." 453 (if songid 454 (progn 455 (let ((command (format nil "playlistid \"~S\"" songid))) 456 (mpd-send-command iostream command))) 457 (mpd-send-command iostream "playlistinfo "))) 458 459 460 ;;; I need to totally re-write this, since this thing returns a 461 ;;; shit tonne of info. Also SONG is not the ID in this case, 462 ;;; rather it is the numerical position in the playlist. 463 (defun mpd-send-playlistinfo-command (iostream &optional song) 464 "Displays list of songs in the playlist, :SONG specializes on a single song." 465 (if song 466 (progn 467 (let ((command (format nil "playlistinfo \"~S\"" song))) 468 (mpd-send-command iostream command))) 469 (mpd-send-command iostream "playlistinfo "))) 470 471 472 (defun mpd-send-plchanges-command (iostream pls) 473 "Displays changed songs currently in the playlist since PLS version." 474 (let ((command (format nil "plchanges \"~S\"" pls))) 475 (mpd-send-command iostream command))) 476 477 478 (defun mpd-send-prev-command (iostream) 479 (mpd-send-command iostream "previous")) 480 481 482 (defun mpd-send-random-command (iostream mode) 483 "Set random state to MODE, which is either 0 or 1." 484 (let ((command (format nil "random \"~S\"" mode))) 485 (mpd-send-command iostream command))) 486 487 488 (defun mpd-send-repeat-command (iostream mode) 489 "Set repeat state to MODE, which is either 0 or 1." 490 (let ((command (format nil "repeat \"~S\"" mode))) 491 (mpd-send-command iostream command))) 492 493 494 (defun mpd-send-rm-command (iostream name) 495 "Removes the playlist NAME.m3u from the playlist dir." 496 (let ((command (format nil "rm \"~D\"" name))) 497 (mpd-send-command iostream command))) 498 499 500 (defun mpd-send-save-command (iostream name) 501 "Saves the current playlist to NAME.m3u in the playlist dir." 502 (let ((command (format nil "save \"~D\"" name))) 503 (mpd-send-command iostream command))) 504 505 506 (defun mpd-send-search-command (iostream type what) 507 "Search for song containing WHAT, not case sensitive; TYPE is title, artist, album, of filename." ; 508 (let ((command (format nil "search \"~D\" \"~D\"" type what))) 509 (mpd-send-command iostream command))) 510 511 512 (defun mpd-send-seek-command (iostream song time) 513 "Seeks to position TIME in seconds of entry SONG, in the playlist." 514 (let ((command (format nil "seek \"~S\" \"~S\"" song time))) 515 (mpd-send-command iostream command))) 516 517 518 (defun mpd-send-seekid-command (iostream songid time) 519 "Seeks to the position TIME (in seconds) of the song with SONGID." 520 (let ((command (format nil "seekid \"~S\" \"~S\"" songid time))) 521 (mpd-send-command iostream command))) 522 523 524 (defun mpd-send-setvol-command (iostream vol) 525 "Set volume to VOL, with range being 0-100." 526 (let ((command (format nil "setvol \"~S\"" vol))) 527 (mpd-send-command iostream command))) 528 529 530 (defun mpd-send-shuffle-command (iostream) 531 (mpd-send-command iostream "shuffle")) 532 533 534 (defun mpd-send-stats-command (iostream) 535 (mpd-send-command iostream "stats")) 536 537 538 (defun mpd-send-status-command (iostream) 539 (mpd-send-command iostream "status")) 540 541 542 (defun mpd-send-stop-command (iostream) 543 (mpd-send-command iostream "stop")) 544 545 546 (defun mpd-send-swap-command (iostream song1 song2) 547 "Swap positions of SONG1 and SONG2." 548 (let ((command (format nil "swap \"~S\" \"~S\"" song1 song2))) 549 (mpd-send-command iostream command))) 550 551 552 (defun mpd-send-swapid-command (iostream songid1 songid2) 553 "Swap positions of SONG1 and SONG2." 554 (let ((command (format nil "swapid \"~S\" \"~S\"" songid1 songid2))) 555 (mpd-send-command iostream command))) 556 557 558 (defun mpd-send-update-command (iostream &optional (path nil path-supplied-p)) 559 "Searches music directory for new music and removes old music from the db. :PATH is optional." 560 (if path-supplied-p 561 (progn 562 (let ((command (format nil "update \"~D\"" path))) 563 (mpd-send-command iostream command))) 564 (mpd-send-command iostream "update"))) 565 566 567 (defun mpd-send-urlhandlers-command (iostream) 568 (mpd-send-command iostream "urlhandlers")) 569 570 571 ;;; Supposedly this is deprecated; is this true? 572 (defun mpd-send-volume-command (iostream vol) 573 "Increment or decrement the volume by VOL." 574 (let ((command (format nil "volume \"~S\"" vol))) 575 (mpd-send-command iostream command))) 576 577 578 579 ;;; -------------------------- 580 ;;; MPD Command Lists 581 ;;; -------------------------- 582 583 ;;; The new and improved, and 'lispy' way to implement command lists. 584 (defmacro mpd-command-list (client &body forms) 585 "Takes an MPD-CLIENT instance and mpd-send-command forms, then sends a command list to mpd." 586 (let ((conn (gensym))) 587 `(let ((,conn (mpd-iostream ,client))) 588 (mpd-send-command ,conn "command_list_begin") 589 ,@forms 590 (mpd-send-command ,conn "command_list_end")))) 591 592 593 594 ;;; -------------------------- 595 ;;; Classes and Methods 596 ;;; -------------------------- 597 598 599 (deftype iostream-type () 600 #+sbcl 'sb-sys:fd-stream 601 #+clisp 'stream 602 #+lispworks 'comm:socket-stream 603 ) 604 605 (deftype socket-type () 606 #+sbcl 'sb-bsd-sockets:inet-socket 607 #+clisp 'stream 608 #+lispworks 'comm:socket-stream 609 ) 610 611 (defclass mpd-client () 612 ((iostream 613 :initform nil 614 :initarg :iostream 615 :accessor mpd-iostream 616 :type iostream-type 617 :documentation "The input/output stream to MPD.") 618 (socket 619 :initform nil 620 :initarg :socket 621 :accessor mpd-socket 622 :type socket-type 623 :documentation "The raw socket to MPD.") 624 (io-timeout 625 :initform 1 626 :initarg :io-timeout 627 :accessor mpd-io-timeout 628 :type integer 629 :documentation "The connection timeout period in seconds") 630 (command-list-mode 631 :initform 0 632 :accessor mpd-command-list-mode 633 :type integer 634 :documentation "Not used: 1 if we're in, 0 if not.") 635 (host 636 :initform (mpd-get-host) 637 :accessor mpd-host 638 :type string 639 :documentation "Used to keep tabs of the host of MPD.") 640 (port 641 :initform (mpd-get-port) 642 :accessor mpd-port 643 :type integer 644 :documentation "Used to keep tabs of the port of MPD."))) 645 646 647 ;;; Dangerous abstraction, use with caution. 648 (defmacro with-mpd-client-slots ((conn) &body body) 649 `(with-slots (iostream socket io-timeout command-list-mode host port) ,conn 650 ,@body)) 651 652 653 ;;; TODO find out if using MULTIPLE-VALUE-BIND is considered to much work for 654 ;;; such a simple use. 655 ;;; 656 ;;; Create a socket and fd-stream, then setup our mpd-client appropriate object variables. 657 (defmethod initialize-instance :after ((conn mpd-client) &rest initargs) 658 (with-mpd-client-slots (conn) 659 (multiple-value-bind (io sock) (mpd-make-connection host port :timeout io-timeout) 660 (setf iostream io) 661 (setf socket sock)))) 662 663 664 ;;; TODO 665 ;;; Check and make sure that this works on LispWorks 666 (defgeneric mpd-client-disconnect (mpd-client)) 667 668 (defmethod mpd-client-disconnect ((client mpd-client)) 669 "Closes the connection to MPD and performs any necessary cleanup." 670 (with-mpd-client-slots (client) 671 (mpd-send-close-command iostream) 672 #+clisp (close socket) 673 #+sbcl (sb-bsd-sockets:socket-close socket) 674 #+lispworks (close socket) 675 )) 676 677 678 ;;; -------------------------- 679 ;;; MPD stats 680 ;;; -------------------------- 681 682 (defclass mpd-stats () 683 ((artists 684 :initform 0 685 :initarg :artists 686 :accessor mpd-stats-artists 687 :type integer 688 :documentation "Number of artists.") 689 (albums 690 :initform 0 691 :initarg :albums 692 :accessor mpd-stats-albums 693 :type integer 694 :documentation "Number of albums.") 695 (songs 696 :initform 0 697 :initarg :songs 698 :accessor mpd-stats-songs 699 :type integer 700 :documentation "Number of songs.") 701 (uptime 702 :initform 0 703 :initarg :uptime 704 :accessor mpd-stats-uptime 705 :type integer 706 :documentation "Daemon uptime in seconds.") 707 (db-playtime 708 :initform 0 709 :initarg :db-playtime 710 :accessor mpd-stats-db-playtime 711 :type integer 712 :documentation "Sum of all song times in db.") 713 (db-update 714 :initform 0 715 :initarg :db-update 716 :accessor mpd-stats-db-update 717 :type integer 718 :documentation "Last db update in UNIX time.") 719 (playtime 720 :initform 0 721 :initarg :playtime 722 :accessor mpd-stats-playtime 723 :type integer 724 :documentation "Time length of music played."))) 725 726 727 ;;; Dangerous abstraction, use with caution. 728 (defmacro with-mpd-stats-slots ((stats) &body body) 729 `(with-slots (artists albums songs uptime db-playtime db-update playtime) ,stats 730 ,@body)) 731 732 733 (defgeneric mpd-update-stats (mpd-client mpd-stats)) 734 735 ;;; I want to know WTF the point of having STRING= when EQUAL works just as well, 736 ;;; and is MUCH faster? 737 (defmethod mpd-update-stats ((client mpd-client) (stats mpd-stats)) 738 (with-mpd-client-slots (client) 739 (with-mpd-stats-slots (stats) 740 (mpd-send-stats-command iostream) 741 (let* ((response (mpd-get-return-elements iostream)) 742 (key-values (map 'list #'(lambda (x) 743 (split-mpd-key-value-pair (car x))) 744 response))) 745 #+nil 746 (format t "~&~{~A ~}" key-values) 747 (dolist (i key-values) 748 (let ((key (car i)) 749 (value (parse-integer (cadr i) :junk-allowed nil))) 750 (cond ((string= key "artists") (setf artists value)) 751 ((string= key "albums") (setf albums value)) 752 ((string= key "songs") (setf songs value)) 753 ((string= key "uptime") (setf uptime value)) 754 ((string= key "db_playtime") (setf db-playtime value)) 755 ((string= key "db_update") (setf db-update value)) 756 ((string= key "playtime") (setf playtime value)) 757 (t (warn "~&MPD-UPDATE-STATS error, Key == ~S Value == ~S" 758 key value))))))))) 759 760 761 ;;; This is an EVIL! optimization, but I want to get this to work. 762 #| 763 (declaim (inline my-string=)) 764 (defun my-string= (str-a str-b) 765 (declare (optimize (debug 0) (safety 0) (speed 3)) 766 (type (simple-base-string *) str-a) 767 (type (simple-base-string *) str-b)) 768 #+(not sbcl) (equal str-a str-b) 769 #+sbcl (string= str-a str-b)) 770 |# 771 772 773 ;;; -------------------------- 774 ;;; MPD status 775 ;;; -------------------------- 776 777 ;;; some of this shit never gets returned when I issue status; why? 778 (defclass mpd-status () 779 ((volume 780 :initform 0 781 :initarg :volume 782 :accessor mpd-status-volume 783 :type integer 784 :documentation "Volume level 0-100") 785 (repeat 786 :initform 0 787 :initarg :repeat 788 :accessor mpd-status-repeat 789 :type integer 790 :documentation "Repeat state 0 or 1.") 791 (random 792 :initform 0 793 :initarg :random 794 :accessor mpd-status-random 795 :type integer 796 :documentation "Random state 0 or 1.") 797 (playlist 798 :initform 0 799 :initarg :playlist 800 :accessor mpd-status-playlist 801 :type integer 802 :documentation "31-bit unsigned integer, the playlist version number.") 803 (playlist-length 804 :initform 0 805 :initarg :playlist-length 806 :accessor mpd-status-playlist-length 807 :type integer 808 :documentation "Integer, the length of the playlist.") 809 (state 810 :initform "" 811 :initarg :state 812 :accessor mpd-status-state 813 :type string 814 :documentation "play, stop, or pause") 815 (song 816 :initform 0 817 :initarg :song 818 :accessor mpd-status-song 819 :type integer 820 :documentation "Current song stopped on or playing, playlist song number.") 821 (songid 822 :initform 0 823 :initarg :songid 824 :accessor mpd-status-songid 825 :type integer 826 :documentation "Current song stopped on or playing, playlist songid.") 827 (time 828 :initform 0 829 :initarg :time 830 :accessor mpd-status-time 831 :type string 832 :documentation "Represents elapsed:total of current playing/paused song.") 833 (bitrate 834 :initform 0 835 :initarg :bitrate 836 :accessor mpd-status-bitrate 837 :type integer 838 :documentation "Instantaneous bitrate in kbps.") 839 (xfade 840 :initform 0 841 :initarg :xfade 842 :accessor mpd-status-xfade 843 :type integer 844 :documentation "Crossfade in seconds.") 845 (audio 846 :initform nil 847 :initarg :audio 848 :accessor mpd-status-audio 849 :type string 850 :documentation "sample-rate:bits:channels") 851 (updating-db 852 :initform 0 853 :initarg :updating-db 854 :accessor mpd-status-updating-db 855 :type integer 856 :documentation "1 if MPD is updating its db, 0 if not.") 857 (error 858 :initform "" 859 :initarg :error 860 :accessor mpd-status-error 861 :type string 862 :documentation "If there is an error, the message will be here."))) 863 864 865 ;;; Dangerous abstraction, use with caution. 866 (defmacro with-mpd-status-slots ((status) &body body) 867 `(with-slots (volume repeat random playlist playlist-length state song songid 868 time bitrate xfade audio updating-db error) ,status 869 ,@body)) 870 871 872 (defgeneric mpd-update-status (mpd-client mpd-status)) 873 874 ;;; I need to parse-integer the lists in AUDIO and TIME 875 (defmethod mpd-update-status ((client mpd-client) (status mpd-status)) 876 (with-mpd-client-slots (client) 877 (with-mpd-status-slots (status) 878 (mpd-send-status-command iostream) 879 (let* ((response (mpd-get-return-elements iostream)) 880 (key-values (map 'list #'(lambda (x) 881 (split-mpd-key-value-pair (car x))) 882 response))) 883 #+nil 884 (format t "~&~{~A ~}" key-values) 885 (dolist (i key-values) 886 (let ((key (car i)) 887 (value (string-trim '(#\Space) (cadr i)))) 888 (cond ((string= key "volume") (setf volume (parse-integer value))) 889 ((string= key "repeat") (setf repeat (parse-integer value))) 890 ((string= key "random") (setf random (parse-integer value))) 891 ((string= key "playlist") (setf playlist (parse-integer value))) 892 ((string= key "playlistlength") (setf playlist-length (parse-integer value))) 893 ((string= key "xfade") (setf xfade (parse-integer value))) 894 ((string= key "state") (setf state value)) 895 ((string= key "song") (setf song (parse-integer value))) 896 ((string= key "songid") (setf songid (parse-integer value))) 897 ((string= key "time") (setf time value)) 898 ((string= key "bitrate") (setf bitrate (parse-integer value))) 899 ((string= key "audio") (setf audio value)) 900 ((string= key "updating_db") (setf updating-db (parse-integer value))) 901 ((string= key "error") (setf error value)) 902 (t (warn "~&MPD-UPDATE-STATUS error, Key == ~S Value == ~S" 903 key value))))))))) 904 905 ;;; TODO 906 ;;; write generic update MPD-STATUS obj method, and the INITIALIZE-INSTANCE 907 ;;; :after method 908 909 910 911 ;;; -------------------------- 912 ;;; MPD songs/currentsong 913 ;;; -------------------------- 914 915 ;;; Big TODO, need to mention to MPD dev's that on these slots that are integer only slots, that I really need MPD to not pass me non integers like Track: 9/12 916 917 (defclass mpd-song () 918 ((file 919 :initform nil 920 :initarg :file 921 :accessor mpd-song-file 922 :type string 923 :documentation "Relative pathname of the the current playing/paused song.") 924 (artist 925 :initform nil 926 :initarg :artist 927 :accessor mpd-song-artist 928 :type string 929 :documentation "Song artist, may be nil.") 930 (title 931 :initform nil 932 :initarg :title 933 :accessor mpd-song-title 934 :type string 935 :documentation "Song title, may be nil.") 936 (album 937 :initform nil 938 :initarg :album 939 :accessor mpd-song-album 940 :type string 941 :documentation "Song album, may be nil.") 942 (track 943 :initform nil 944 :initarg :track 945 :accessor mpd-song-track 946 :type string 947 :documentation "Song track, may be nil.") 948 (name 949 :initform nil 950 :initarg :name 951 :accessor mpd-song-name 952 :type string 953 :documentation "Song name, may be nil.") 954 (date 955 :initform nil 956 :initarg :date 957 :accessor mpd-song-date 958 :type string 959 :documentation "I'm not sure wtf this is here for...?") 960 (genre 961 :initform nil 962 :initarg :genre 963 :accessor mpd-song-genre 964 :type string 965 :documentation "Song's genre.") 966 (composer 967 :initform nil 968 :initarg :composer 969 :accessor mpd-song-composer 970 :type string 971 :documentation "Songs composer.") 972 (time 973 :initform 0 974 :initarg :time 975 :accessor mpd-song-time 976 :type integer 977 :documentation "Song length in seconds.") 978 (position 979 :initform nil 980 :initarg :position 981 :accessor mpd-song-position 982 :type integer 983 :documentation "The position of the song in the playlist.") 984 (id 985 :initform 0 986 :initarg :id 987 :accessor mpd-song-id 988 :type integer 989 :documentation "Song ID for a song in the playlist.") 990 (initialized 991 :initform nil 992 :accessor mpd-song-initialized 993 :type integer 994 :documentation "0 or 1: Keeps tabs on if this object has been initialized."))) 995 996 997 ;;; Dangerous abstraction, use with caution. 998 (defmacro with-mpd-song-slots ((song) &body body) 999 `(with-slots (file artist title album track name date genre composer time position id initialized) ,song 1000 ,@body)) 1001 1002 ;;; Write an INITIALIZE-INSTANCE :AFTER method that allows you to initialize the song to 1003 ;;; SONG or SONGID by using :POSITION for song and :ID for songid 1004 1005 ;;; NOTES/TODOS/BUGS: 1006 ;;; 1007 ;;; 1) Write this so that it can get the key/values from a song or songid, but 1008 ;;; default to MPD-SEND-CURRENTSONG-COMMAND. 1009 ;;; 1010 ;;; 2) Find out and complain! about the key discrepensies with songs, which 1011 ;;; really should be completely lowercase like status and stats keys. 1012 ;;; 1013 ;;; Ok at the moment this only allows the object to be initialized to either 1014 ;;; A) the current song, or 1015 ;;; B) the song in the playlist held in MPD-SONG-POSITION. 1016 1017 ;;; Why doesn't this clear out my slots? I want to use this in my :before method 1018 ;;; for MPD-UPDATE-SONG. 1019 #+nil 1020 (defmacro unbind-slot (obj slot) 1021 `(if (not (slot-boundp ,obj ,slot)) 1022 (slot-makunbound ,obj ,slot))) 1023 1024 ;;; Use this in :BEFORE to setup our condition handlers. 1025 1026 (defgeneric mpd-update-song (mpd-client mpd-song)) 1027 1028 ;;; Don't wipe out position, the main method depends on it. 1029 ;;; I tried this out with WITH-ACCESSORS but this looked cleaner. 1030 (defmethod mpd-update-song :before ((client mpd-client) (song mpd-song)) 1031 (let ((init (mpd-song-initialized song))) 1032 (when (eql init 1) 1033 (setf (mpd-song-file song) nil) 1034 (setf (mpd-song-artist song) nil) 1035 (setf (mpd-song-title song) nil) 1036 (setf (mpd-song-album song) nil) 1037 (setf (mpd-song-track song) nil) 1038 (setf (mpd-song-name song) nil) 1039 (setf (mpd-song-date song) nil) 1040 (setf (mpd-song-genre song) nil) 1041 (setf (mpd-song-composer song) nil) 1042 (setf (mpd-song-time song) nil) 1043 (setf (mpd-song-id song) nil)))) 1044 1045 1046 (defmethod mpd-update-song ((client mpd-client) (song mpd-song)) 1047 (with-mpd-client-slots (client) 1048 (with-mpd-song-slots (song) 1049 (if (null position) 1050 (mpd-send-currentsong-command iostream) 1051 (mpd-send-playlistinfo-command iostream position)) 1052 (let* ((response (mpd-get-return-elements iostream)) 1053 (key-values (map 'list #'(lambda (x) 1054 (split-mpd-key-value-pair (car x))) 1055 response))) 1056 #+nil 1057 (format t "~&~%~{~A ~}" key-values) 1058 (dolist (i key-values) 1059 (let ((key (car i)) 1060 (value (string-trim '(#\Space) (cadr i)))) 1061 (cond ((string= key "file") (setf file value)) 1062 ((string= key "Time") (setf time (parse-integer value))) 1063 ((string= key "Artist") (setf artist value)) 1064 ((string= key "Title") (setf title value)) 1065 ((string= key "Album") (setf album value)) 1066 ((string= key "Track") (setf track value)) 1067 ((string= key "Name") (setf name value)) 1068 ((string= key "Date") (setf date value)) 1069 ((string= key "Genre") (setf genre value)) 1070 ((string= key "Composer") (setf composer value)) 1071 ((string= key "Pos") (setf position (parse-integer value))) 1072 ((string= key "Id") (setf id (parse-integer value))) 1073 (t (warn "~&MPD-UPDATE-SONG error, Key == ~S Value == ~S" 1074 key value))) 1075 (setf initialized 1))))))) 1076 1077 1078 1079 ;;; -------------------------- 1080 ;;; MPD Error Handling 1081 ;;; -------------------------- 1082 1083 (define-condition mpd-server-error (error) 1084 ((mpd-error-code 1085 :initarg :error-code 1086 :accessor mpd-error-code 1087 :documentation "Contains one of the error numbers.") 1088 (mpd-error-string 1089 :initarg :error-string 1090 :accessor mpd-error-string 1091 :documentation "Contains the string MPD returns, describing the error."))) 1092 1093 1094 (defun check-for-errors (response) 1095 "Checks server response for error message, and signals an appropriate condition." 1096 (declare (type string response)) 1097 (when (string= response "ACK " :start1 0 :end1 4) 1098 (let ((error-code (remove #\@ (subseq response 5 7) :count 1)) 1099 (error-string (subseq response (1+ (position #\] response))))) 1100 (dprint "~&## DEBUG: CHECK-FOR-ERRORS:~%Error code is <~A>~%Error string is <~A>" 1101 error-code error-string) 1102 (error 'mpd-server-error :error-code error-code :error-string error-string))))