(in-package :asteroid) (defun find-track-by-title (title) "Find a track in the database by its title. Returns track ID or nil. Handles 'Artist - Title' format from Icecast metadata." (when (and title (not (string= title "Unknown"))) (handler-case (with-db ;; Parse 'Artist - Title' format if present (let* ((parts (cl-ppcre:split " - " title :limit 2)) (has-artist (> (length parts) 1)) (artist-part (when has-artist (first parts))) (title-part (if has-artist (second parts) title)) (result (if has-artist ;; Search by both artist and title (postmodern:query (:limit (:select '_id :from 'tracks :where (:and (:ilike 'artist (format nil "%~a%" artist-part)) (:ilike 'title (format nil "%~a%" title-part)))) 1) :single) ;; Fallback: search by title only (postmodern:query (:limit (:select '_id :from 'tracks :where (:ilike 'title (format nil "%~a%" title-part))) 1) :single)))) result)) (error (e) (declare (ignore e)) nil)))) (defun icecast-now-playing (icecast-base-url &optional (mount "asteroid.mp3")) "Fetch now-playing information from Icecast server. ICECAST-BASE-URL - Base URL of the Icecast server (e.g. http://localhost:8000) MOUNT - Mount point to fetch metadata from (default: asteroid.mp3) Returns a plist with :listenurl, :title, and :listeners, or NIL on error." (let* ((icecast-url (format nil "~a/admin/stats.xml" icecast-base-url)) (response (drakma:http-request icecast-url :want-stream nil :basic-authorization '("admin" "asteroid_admin_2024")))) (when response (let ((xml-string (if (stringp response) response (babel:octets-to-string response :encoding :utf-8)))) ;; Extract total listener count from root tag (sums all mount points) ;; Extract title from specified mount point (let* ((total-listeners (multiple-value-bind (match groups) (cl-ppcre:scan-to-strings "(\\d+)" xml-string) (if (and match groups) (parse-integer (aref groups 0) :junk-allowed t) 0))) ;; Escape dots in mount name for regex (mount-pattern (format nil "" (cl-ppcre:regex-replace-all "\\." mount "\\\\."))) (mount-start (cl-ppcre:scan mount-pattern xml-string)) (title (if mount-start (let* ((source-section (subseq xml-string mount-start (or (cl-ppcre:scan "" xml-string :start mount-start) (length xml-string))))) (multiple-value-bind (match groups) (cl-ppcre:scan-to-strings "(.*?)" source-section) (if (and match groups) (plump:decode-entities (aref groups 0)) "Unknown"))) "Unknown"))) ;; Track recently played if title changed ;; Use appropriate last-known-track and list based on stream type (let* ((is-shuffle (string= mount "asteroid-shuffle.mp3")) (last-known (if is-shuffle *last-known-track-shuffle* *last-known-track-curated*)) (stream-type (if is-shuffle :shuffle :curated))) (when (and title (not (string= title "Unknown")) (not (equal title last-known))) (if is-shuffle (setf *last-known-track-shuffle* title) (setf *last-known-track-curated* title)) (add-recently-played (list :title title :timestamp (get-universal-time)) stream-type))) `((:listenurl . ,(format nil "~a/~a" *stream-base-url* mount)) (:title . ,title) (:listeners . ,total-listeners) (:track-id . ,(find-track-by-title title)) (:favorite-count . ,(or (get-track-favorite-count title) 1)))))))) (defun get-now-playing-stats (&optional (mount "stream.mp3")) "Get now-playing stats from Harmony pipeline, falling back to Icecast. Returns an alist with :listenurl, :title, :listeners, :track-id, :favorite-count." (or (harmony-now-playing mount) (icecast-now-playing *stream-base-url* (if (string= mount "stream.mp3") "asteroid.mp3" mount)))) (define-api-with-limit asteroid/partial/now-playing (&optional mount) (:limit 10 :timeout 1) "Get Partial HTML with live now-playing status. Optional MOUNT parameter specifies which stream to get metadata from. Uses Harmony pipeline when available, falls back to Icecast." (with-error-handling (let* ((mount-name (or mount "stream.mp3")) (now-playing-stats (get-now-playing-stats mount-name))) (if now-playing-stats (let* ((title (cdr (assoc :title now-playing-stats))) (favorite-count (or (get-track-favorite-count title) 0))) (setf (header "Content-Type") "text/html") (clip:process-to-string (load-template "partial/now-playing") :stats now-playing-stats :track-id (cdr (assoc :track-id now-playing-stats)) :favorite-count favorite-count)) (progn (setf (header "Content-Type") "text/html") (clip:process-to-string (load-template "partial/now-playing") :connection-error t :stats nil)))))) (define-api-with-limit asteroid/partial/now-playing-inline (&optional mount) (:limit 10 :timeout 1) "Get inline text with now playing info (for admin dashboard and widgets). Optional MOUNT parameter specifies which stream to get metadata from." (with-error-handling (let* ((mount-name (or mount "stream.mp3")) (now-playing-stats (get-now-playing-stats mount-name))) (if now-playing-stats (progn (setf (header "Content-Type") "text/plain") (cdr (assoc :title now-playing-stats))) (progn (setf (header "Content-Type") "text/plain") "Stream Offline"))))) (define-api-with-limit asteroid/partial/now-playing-json (&optional mount) (:limit 10 :timeout 1) "Get JSON with now playing info including track ID for favorites. Optional MOUNT parameter specifies which stream to get metadata from." ;; Register web listener for geo stats (keeps listener active during playback) (register-web-listener) (with-error-handling (let* ((mount-name (or mount "stream.mp3")) (now-playing-stats (get-now-playing-stats mount-name))) (if now-playing-stats (let* ((title (cdr (assoc :title now-playing-stats))) (favorite-count (or (get-track-favorite-count title) 0)) (parsed (parse-track-title title)) (artist (getf parsed :artist)) (song (getf parsed :song)) (search-url (generate-music-search-url artist song))) (api-output `(("status" . "success") ("title" . ,title) ("listeners" . ,(cdr (assoc :listeners now-playing-stats))) ("track_id" . ,(cdr (assoc :track-id now-playing-stats))) ("favorite_count" . ,favorite-count) ("search_url" . ,search-url)))) (api-output `(("status" . "offline") ("title" . "Stream Offline") ("track_id" . nil))))))) (define-api-with-limit asteroid/channel-name () (:limit 180 :timeout 60) "Get the current curated channel name for live updates. Returns JSON with the channel name from the current playlist's PHASE header." (with-error-handling (api-output `(("channel_name" . ,(get-curated-channel-name))))))