<lastactivity> is absolute

[ircbot.git] / ledmodule.tcl

diff --git a/ledmodule.tcl b/ledmodule.tcl
index f95ff215c9830a2ba875565d843896af2211bf63..b4a20fd858b890e3eddc1073c7733fe8cc517ec6 100644 (file)
--- a/ledmodule.tcl
+++ b/ledmodule.tcl
@@ -1,36 +1,5 @@
-# maintains local list of users to userv-slurp config from
-# each user provides list of
-#    monitors
-#    devicesets
-#
-# a monitor specifies
-#    name
-#    IRC channel(s)
-#    nicks ignore totally
-#    nicks ignore presence
-#    nicks prefer speech
-#    time for `a while ago'
-#    time for `very-recently'
-# syntax
-#    nick ignore|nopresence|prefer <glob-pattern> [...]
-#    times <very-recently> <a-while-ago>                  (default 120 450)
-#      (affect subsequent `monitor' directives)
-#    monitor <monname> <#chan>[,<#chan>...]
-#      <monname> must start with <username>:
-#
-# a deviceset specifies
-#    monitor
-#    led-group
-#    led states
-# syntax
-#    leds <led-group> <monname> <state>=<value>
-# where state is one of
-#    [pref]talk[now]  any non-ignored (with `pref', only any preferred)
-#                     nick(s) spoke at least somewhat recently
-#                     (with `now', only if they spoke very recently)
-#    present          at least some non-nopresence nicks present
-#    default          always matches
-# where the first matching state wins; if none, no LEDs are set
+# see ledbot.html
+# $Id$
 
 set helpfile ledhelp
 
@@ -144,6 +113,7 @@ proc_mon gotchanlist {ch nll} {
     foreach nl $nll {
        if {![string compare $nl [irctolower $nick]]} continue
        if {[mon_nick_is $mm(nopresence) $nl]} continue
+       if {[mon_nick_is $mm(ignore) $nl]} continue
        lappend l $nl
     }
     ldebug m$m "$ch names: $l"
@@ -209,10 +179,16 @@ proc_mon destroy {} {
 proc proc_dset {name argl body} {
     proc dset_$name [concat d $argl] "
     upvar #0 deviceset/\$d dd
-    if {\[catch {
+    set returncode \[catch {
         $body
-    } emsg\]==1} {
+    } emsg\]
+    global errorInfo errorCode
+    if {\$returncode==1} {
        reporterr \"error on \$d: \$emsg\"
+    } elseif {\$returncode==2} {
+       return \$emsg
+    } else {
+       return -code \$returncode -errorinfo \$errorInfo -errorcode \$errorCode
     }"
 }
 
@@ -301,15 +277,16 @@ proc reloaduser {username} {
            set l $contin
            set contin {}
            if {[regexp {^\#} $l]} {
-           } elseif {[regexp {^nick\s+(ignore|nopresence|prefer)\s+(\S.*)$} \
-                   $l dummy kind globs]} {
+           } elseif {![regexp {\S} $l]} {
+           } elseif {[regexp {^nick\s+(ignore|nopresence|prefer)\s+(.*)$} \
+                   "$l " dummy kind globs]} {
                set cc($kind) {}
                foreach gl [split $globs " "] {
                    if {![string length $gl]} continue
                    string match $gl {}
                    lappend cc($kind) $gl
                }
-           } elseif {[regexp {^times\s+(\d+)\s+(\d+)$} $l dummy r rnow]} {
+           } elseif {[regexp {^times\s+(\d+)\s+(\d+)$} $l dummy rnow r]} {
                foreach cv {{} now} { set cc(time-recent$cv) [set r$cv] }
            } elseif {[regexp {^monitor\s+(\S+)\s+(\S.*)$} $l dummy m cl]} {
                set cc(chans) {}
@@ -528,6 +505,13 @@ def_ucmd nodebug {
     reporterr "debug disabled by $n"
 }
 
+proc_dset visibledest {} {
+    regsub {\:[^:]*/} $d/ { } p
+    regsub {^([^:]+)\:\d+\:} $p {\1, } p
+    regsub { $} $p {} p
+    return $p
+}
+
 def_ucmd who {
     set r {}
     foreach m [list_objs monitor] {
@@ -536,8 +520,10 @@ def_ucmd who {
     }
     foreach d [list_objs deviceset] {
        upvar #0 deviceset/$d dd
-       regexp {^[^:]*\:[^:]*} $dd(group) dest
-       lappend r "sending $dd(monname) to $dest"
+       set m $dd(monname)
+       upvar #0 monitor/$m mm
+       if {![info exists mm(chans)]} continue
+       lappend r "sending $m to [dset_visibledest $d]"
     }
     ucmdr [join $r "\n"] {}
 }
@@ -551,11 +537,34 @@ proc connected {} {
     config_change
 }
 
-proc msg_JOIN {p c chan} { chan_shortly $chan }
+proc warn_pref {n} {
+    set nl [irctolower $n]
+    set l {}
+    foreach d [list_objs deviceset] {
+       upvar #0 deviceset/$d dd
+       set m $dd(monname)
+       upvar #0 monitor/$m mm
+       if {![info exists mm(prefer)]} continue
+       if {![mon_nick_is $mm(prefer) $nl]} continue
+       foreach ch $mm(chans) { set wch($ch) 1 }
+       lappend l [dset_visibledest $d]
+    }
+    if {[llength $l]} {
+       sendprivmsg $nl "LEDs are watching you on [\
+               join [lsort [array names wch]] ","]: [join $l " "]"
+    }
+}
+
+proc msg_JOIN {p c chan} {
+    prefix_nick
+    set nl [irctolower $n]
+    chan_shortly $chan
+    warn_pref $n
+}
 proc msg_PART {p c chan} { chan_shortly $chan }
 proc msg_KILL {p c user why} { allchans_shortly }
 proc msg_QUIT {p c why} { allchans_shortly }
-proc msg_NICK {p c newnick} { allchans_shortly }
+proc msg_NICK {p c newnick} { allchans_shortly; warn_pref $newnick }
 proc msg_KICK {p c chans users comment} {
     if {[llength $chans] > 1} {
        allchans_shortly