guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

branch master updated: goggles-bot: Support more than one channel at a t


From: Ricardo Wurmus
Subject: branch master updated: goggles-bot: Support more than one channel at a time.
Date: Wed, 02 Nov 2022 17:51:28 -0400

This is an automated email from the git hooks/post-receive script.

rekado pushed a commit to branch master
in repository maintenance.

The following commit(s) were added to refs/heads/master by this push:
     new 9c59eb5  goggles-bot: Support more than one channel at a time.
9c59eb5 is described below

commit 9c59eb50ee3237951497652d4e00ac7229c31f4e
Author: Ricardo Wurmus <rekado@elephly.net>
AuthorDate: Wed Nov 2 22:49:01 2022 +0100

    goggles-bot: Support more than one channel at a time.
    
    * hydra/goggles-bot.scm (%options): Append channel.
    (make-filename): Accept "channel" argument.
    (log-to-file): Maintain a mapping from channels to ports.
    (%channels): New procedure.
    (main): Join all channels.
---
 hydra/goggles-bot.scm | 77 +++++++++++++++++++++++++++++++++------------------
 1 file changed, 50 insertions(+), 27 deletions(-)

diff --git a/hydra/goggles-bot.scm b/hydra/goggles-bot.scm
index 2fa7e3d..890df98 100755
--- a/hydra/goggles-bot.scm
+++ b/hydra/goggles-bot.scm
@@ -17,8 +17,7 @@
 (define %options
   (list (option '("channel") #t #f
                 (lambda (opt name arg result)
-                  (alist-cons 'channel arg
-                              (alist-delete 'channel result))))
+                  (alist-cons 'channel arg result)))
         (option '("directory") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'directory arg
@@ -87,32 +86,44 @@
                  (apply throw args))))))
       (() #t))))
 
-(define (make-filename time)
-  "Return an absolute file name with the basename matching the current
-date as contained in TIME."
+(define (make-filename time channel)
+  "Return an absolute file name for CHANNEL with the basename matching
+the current date as contained in TIME."
   (format #false "~a/~a/~a.log"
-          (assoc-ref %config 'directory)
-          (assoc-ref %config 'channel)
+          (assoc-ref %config 'directory) channel
           (strftime "%F" (localtime (current-time)))))
 
 (define log-to-file
   (let ((day #false)
-        (port #false))
+        (ports #false))
     (lambda (message)
       "Log MESSAGE to a file.  Create a new file for each day."
-      (let ((time (localtime (msg:time message))))
-        (when (or (not day)
-                  (not port)
-                  (< day (tm:mday time)))
-          (and port
-               (begin
-                 (force-output port)
-                 (close-port port)))
-          (let ((file (make-filename time)))
-            (mkdir-p (dirname file))
-            (set! day (tm:mday time))
-            (set! port (open-file file "a"))))
-        (print message port)))))
+      (let ((channel (msg:parse-target message))
+            (time (localtime (msg:time message)))
+            (port-for-channel (lambda (channel)
+                                (and ports (assoc-ref ports channel)))))
+        ;; Only log messages to known channels
+        (when (member channel (%channels))
+
+          ;; When the music's over turn out the lights
+          (let ((port (port-for-channel channel)))
+            (when (or (not day)
+                      (not port)
+                      (< day (tm:mday time)))
+              ;; Day's over, finish the file. 
+              (when port
+                (force-output port)
+                (close-port port))
+              ;; Create a new file for the new day; update
+              ;; channel->port alist.
+              (let ((file (make-filename time channel)))
+                (mkdir-p (dirname file))
+                (set! day (tm:mday time))
+                (set! ports
+                      (assoc-set! ports channel (open-file file "a"))))))
+
+          ;; Write message, ensuring that we're using the latest port.
+          (print message (port-for-channel channel)))))))
 
 (define* (print message #:optional (port (current-output-port)))
   "Format and print MESSAGE to PORT."
@@ -140,23 +151,34 @@ date as contained in TIME."
               timestamp who text)
       (force-output port))))
 
+(define %channels
+  (let ((result #false))
+    (lambda ()
+      (unless result
+        (set! result
+              (fold (match-lambda*
+                      ((('channel . name) res) (cons name res))
+                      ((_ res) res))
+                    '() %config)))
+      result)))
+
 (define (main . args)
   (match args
     ((_ . rest)
      (set! %config (parse-options rest))
-     (let* ((channel (or (assoc-ref %config 'channel)
-                         (error "must provide channel name")))
+     (let* ((channels (or (%channels)
+                          (error "must provide at least one channel name")))
             (irc (make-irc #:nick (assoc-ref %config 'nick)
                            #:server (assoc-ref %config 'server)
                            #:port (assoc-ref %config 'port)
                            #:ssl #true)))
        (install-ping-handler! irc)
-       (add-message-hook! irc log-to-file
-                          #:tag (string->symbol
-                                 (format #f "printer-~a" channel)))
+       (add-message-hook! irc log-to-file #:tag 'log-to-file)
        (do-connect irc)
        (do-register irc)
-       (do-join irc channel)
+       (for-each (lambda (channel)
+                   (do-join irc channel))
+                 channels)
        (while #true
          (run-message-hook irc (do-wait irc)))))
     (_
@@ -164,6 +186,7 @@ date as contained in TIME."
              "\
 usage: goggles-bot
   --channel=...
+  [--channel=...]
   [--nick=...]
   [--server=...]
   [--port=...]



reply via email to

[Prev in Thread] Current Thread [Next in Thread]