From 1db2f6c7e5651727ce14ff3d46dbf8777022fdfd Mon Sep 17 00:00:00 2001
From: aleteoryx <alyx@aleteoryx.me>
Date: Wed, 6 Nov 2024 13:36:27 -0500
Subject: [PATCH] add support for message intercepting, bugfix in irc::extern
 remove

---
 irc.tcl | 47 ++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 46 insertions(+), 1 deletion(-)

diff --git a/irc.tcl b/irc.tcl
index 57113c4..9b8dd11 100644
--- a/irc.tcl
+++ b/irc.tcl
@@ -24,6 +24,7 @@ namespace eval ::irc {
   variable logp [logger::init tclircc::irc::proto]
   variable chan.meta
   variable chan.handlers
+  variable chan.interceptors
 
   # documented
   proc is {type value {cap {}}} {
@@ -130,9 +131,11 @@ namespace eval ::irc {
   proc enroll {chan {meta {}}} {
     variable chan.meta
     variable chan.handlers
+    variable chan.interceptors
     fconfigure $chan -translation crlf -blocking 0
     set chan.meta($chan) $meta
     set chan.handlers($chan) {}
+    set chan.interceptors($chan) {}
   }
 
   # documented
@@ -152,6 +155,7 @@ namespace eval ::irc {
   }
 
   # nodoc
+  # helper function that rebrands dict command errors
   proc int-dictsub args {
     if [catch { uplevel [list dict {*}$args] } result options] {
       return -options $options [regsub {dictionary$} $result "channel meta"]
@@ -214,6 +218,7 @@ namespace eval ::irc {
     variable logd
     variable chan.meta
     variable chan.handlers
+    variable chan.interceptors
 
     irc::msg parse $msg tags src cmd params
     set src ""
@@ -231,6 +236,14 @@ namespace eval ::irc {
                               params $params]
 
     set matchedany false
+    foreach interceptor [set chan.interceptors($chan)] {
+      lassign $interceptor id procname
+      if {[uplevel #0 [list $procname $dispatch]]} {
+        ${logd}::debug "message intercepted by interceptor \"$id\", procname \"$procname\""
+        ${logd}::debug "contents: $msg"
+        return
+      }
+    }
     foreach handler [set chan.handlers($chan)] {
       set rest [lassign $handler patlist type id]
 
@@ -238,6 +251,8 @@ namespace eval ::irc {
       foreach msgpat $patlist {
         set parampats [lassign $patlist cmdpat]
 
+        # don't care about extra args to a command, so that the pattern
+        # for e.g. a message can just be "PRIVMSG"
         if {[llength $parampats] > [llength $params]} { continue }
         if ![string match $cmdpat $cmd] { continue }
 
@@ -296,7 +311,7 @@ namespace eval ::irc {
       }
     }
     if !$matchedany {
-      puts stderr "irc warning: unmatched command on channel \"$chan\": $msg"
+      ${logd}::warn "unmatched command on channel \"$chan\": $msg"
     }
   }
 
@@ -448,6 +463,7 @@ namespace eval ::irc {
       }
       remove {
         if {[llength $args] != 1} { return -code error "wrong # args: should be \"irc::extern remove chan id\"" }
+        lassign $args rmid
         set newlist ""
         foreach handler [set chan.handlers($chan)] {
           lassign $handler _ type handlerid ochan ichan
@@ -465,6 +481,35 @@ namespace eval ::irc {
     }
   }
 
+  # documented
+  proc interceptor {subcommand chan args} {
+    variable chan.interceptors
+    switch -- $subcommand {
+      add {
+        if {[llength $args] != 1} { return -code error "wrong # args: should be \"irc::interceptor add chan procname\"" }
+        lassign $args procname
+        set id [format "%016x" [expr {round(rand() * (2**64))}]]
+
+        lappend chan.interceptors($chan) [list $id $procname]
+
+        return $id
+      }
+      remove {
+        if {[llength $args] != 1} { return -code error "wrong # args: should be \"irc::interceptor remove chan id\"" }
+        lassign $args rmid
+        set newlist ""
+        foreach interceptor [set chan.interceptor($chan)] {
+          lassign $interceptor id procname
+          if {$id != $rmid} {
+            lappend newlist $interceptor
+          }
+        }
+        set chan.interceptors($chan) $newlist
+      }
+      default { return -code error "unknown subcommand \"$subcommand\": must be add or remove" }
+    }
+  }
+
   # documented
   proc patlist {chan id {patlist {}}} {
     if {$patlist != ""} {
-- 
2.45.2