1 files changed, 46 insertions(+), 1 deletions(-)

M 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


@@ 466,6 482,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 != ""} {
       set newlist ""