glenn
/
asteroid
mirror of https://github.com/glenneth1/asteroid.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Merge main into experiment/parenscript-conversion 

- Resolved conflict in frontend-partials.lisp
- Kept cleaner upstream XML parsing logic from main
- Preserved debug logging from experiment branch
This commit is contained in:
Glenn Thompson 2025-11-10 12:44:14 +03:00
parent af2afefbfc 2fa72117cd
commit d0f10a3fff
1 changed files with 33 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

79
frontend-partials.lisp
View File

@ -1,56 +1,50 @@
(in-package :asteroid) (in-package :asteroid)
(defun icecast-now-playing (icecast-base-url) (defun icecast-now-playing (icecast-base-url)
"Fetch now-playing information from Icecast server.
ICECAST-BASE-URL - Base URL of the Icecast server (e.g. http://localhost:8000)
Returns a plist with :listenurl, :title, and :listeners, or NIL on error."
(let* ((icecast-url (format nil "~a/admin/stats.xml" icecast-base-url)) (let* ((icecast-url (format nil "~a/admin/stats.xml" icecast-base-url))
(response (drakma:http-request icecast-url (response (drakma:http-request icecast-url
:want-stream nil :want-stream nil
:basic-authorization '("admin" "asteroid_admin_2024")))) :basic-authorization '("admin" "asteroid_admin_2024"))))
(format t "DEBUG: Fetching Icecast stats from ~a~%" icecast-url) (format t "DEBUG: Fetching Icecast stats from ~a~%" icecast-url)
(when response (when response
(let ((xml-string (if (stringp response) (let ((xml-string (if (stringp response)
response response
(babel:octets-to-string response :encoding :utf-8)))) (babel:octets-to-string response :encoding :utf-8))))
;; Simple XML parsing to extract source information and aggregate listeners ;; Extract total listener count from root <listeners> tag (sums all mount points)
;; Get title from main mp3 stream ;; Extract title from asteroid.mp3 mount point
(let* ((mp3-match (cl-ppcre:scan "<source mount=\"/asteroid\\.mp3\">" xml-string)) (let* ((total-listeners (multiple-value-bind (match groups)
(title (if mp3-match (cl-ppcre:scan-to-strings "<listeners>(\\d+)</listeners>" xml-string)
(let* ((source-section (subseq xml-string mp3-match (if (and match groups)
(or (cl-ppcre:scan "</source>" xml-string :start mp3-match) (parse-integer (aref groups 0) :junk-allowed t)
(length xml-string)))) 0)))
(titlep (cl-ppcre:all-matches "<title>" source-section))) ;; Get title from asteroid.mp3 mount point
(if titlep (mount-start (cl-ppcre:scan "<source mount=\"/asteroid\\.mp3\">" xml-string))
(cl-ppcre:regex-replace-all ".*<title>(.*?)</title>.*" source-section "\\1") (title (if mount-start
"Unknown")) (let* ((source-section (subseq xml-string mount-start
"Unknown")) (or (cl-ppcre:scan "</source>" xml-string :start mount-start)
;; Aggregate listeners from all three streams (length xml-string)))))
(total-listeners 0)) (multiple-value-bind (match groups)
;; Count listeners from each mount point (cl-ppcre:scan-to-strings "<title>(.*?)</title>" source-section)
(dolist (mount '("/asteroid\\.mp3" "/asteroid\\.aac" "/asteroid-low\\.mp3")) (if (and match groups)
(let ((match-pos (cl-ppcre:scan (format nil "<source mount=\"~a\">" mount) xml-string))) (aref groups 0)
(when match-pos "Unknown")))
(let* ((source-section (subseq xml-string match-pos "Unknown")))
(or (cl-ppcre:scan "</source>" xml-string :start match-pos) (format t "DEBUG: Parsed title=~a, total-listeners=~a~%" title total-listeners)
(length xml-string)))) `((:listenurl . ,(format nil "~a/asteroid.mp3" *stream-base-url*))
(listenersp (cl-ppcre:all-matches "<listeners>" source-section))) (:title . ,title)
(when listenersp (:listeners . ,total-listeners)))))))
(let ((listener-count-str (cl-ppcre:regex-replace-all ".*<listeners>(.*?)</listeners>.*" source-section "\\1"))
(count (parse-integer (cl-ppcre:regex-replace-all ".*<listeners>(.*?)</listeners>.*" source-section "\\1") :junk-allowed t)))
(format t "DEBUG: Mount ~a has ~a listeners~%" mount count)
(incf total-listeners count)))))))
(let ((result `((:listenurl . ,(format nil "~a/asteroid.mp3" *stream-base-url*))
(:title . ,title)
(:listeners . ,total-listeners))))
(format t "DEBUG: Parsed title=~a, total-listeners=~a~%" title total-listeners)
result))))))
(define-api asteroid/partial/now-playing () () (define-api asteroid/partial/now-playing () ()
"Get Partial HTML with live status from Icecast server" "Get Partial HTML with live status from Icecast server"
(handler-case (with-error-handling
(let ((now-playing-stats (icecast-now-playing *stream-base-url*))) (let ((now-playing-stats (icecast-now-playing *stream-base-url*)))
(if now-playing-stats (if now-playing-stats
(progn (progn
;; TODO: it should be able to define a custom api-output for this
;; (api-output <clip-parser> :format "html"))
(setf (header "Content-Type") "text/html") (setf (header "Content-Type") "text/html")
(clip:process-to-string (clip:process-to-string
(load-template "partial/now-playing") (load-template "partial/now-playing")
@ -60,14 +54,7 @@
(clip:process-to-string (clip:process-to-string
(load-template "partial/now-playing") (load-template "partial/now-playing")
:connection-error t :connection-error t
:stats nil)))) :stats nil))))))
(error ()
(format t "Error in now-playing endpoint~%")
(setf (header "Content-Type") "text/html")
(clip:process-to-string
(load-template "partial/now-playing")
:connection-error t
:stats nil))))
(define-api asteroid/partial/now-playing-inline () () (define-api asteroid/partial/now-playing-inline () ()
"Get inline text with now playing info (for admin dashboard and widgets)" "Get inline text with now playing info (for admin dashboard and widgets)"