Nick registration, preferences, etc.

[ircbot] / bot.tcl

diff --git a/bot.tcl b/bot.tcl
index b52e1395e812018c7ba748034d0db6089fb7369c..602a5a32fc3b78948571275df1bc82a76bc1a968 100755 (executable)
--- a/bot.tcl
+++ b/bot.tcl
@@ -80,7 +80,7 @@ proc bgerror {msg} {
 }
 
 proc onread {args} {
-    global sock nick
+    global sock nick calling_nick
     
     if {[gets $sock line] == -1} { set terminate 1; return }
     regsub -all "\[^ -\176\240-\376\]" $line ? line
@@ -89,8 +89,10 @@ proc onread {args} {
        set line $remain
        if {[regexp {^([^!]+)!} $prefix dummy maybenick] &&
            "[irctolower $maybenick]" == "[irctolower $nick]"} return
+       set calling_nick $maybenick
     } else {
        set prefix {}
+       catch { unset calling_nick }
     }
     if {![string length $line]} { return }
     if {![regexp -nocase {^([0-9a-z]+) *(.*)} $line dummy command line]} {
@@ -176,6 +178,10 @@ proc prefix_nick {} {
 }
 
 proc showintervalsecs {howlong} {
+    return [showintervalsecs/[opt timeformat] $howlong]
+}
+
+proc showintervalsecs/ks {howlong} {
     if {$howlong < 1000} {
        return "${howlong}s"
     } else {
@@ -194,6 +200,31 @@ proc showintervalsecs {howlong} {
     }
 }
 
+proc format_qty {qty unit} {
+    set o $qty
+    append o " "
+    append o $unit
+    if {$qty != 1} { append o s }
+    return $o
+}
+
+proc showintervalsecs/hms {qty} {
+    set ul {second 60 minute 60 hour 24 day 7 week}
+    set remainv 0
+    while {[llength $ul] > 1 && $qty >= [set uv [lindex $ul 1]]} {
+       set remainu [lindex $ul 0]
+       set remainv [expr {$qty % $uv}]
+       set qty [expr {($qty-$remainv)/$uv}]
+       set ul [lreplace $ul 0 1]
+    }
+    set o [format_qty $qty [lindex $ul 0]]
+    if {$remainv} {
+       append o " "
+       append o [format_qty $remainv $remainu]
+    }
+    return $o
+}
+
 proc showinterval {howlong} {
     if {$howlong <= 0} {
        return {just now}
@@ -347,6 +378,7 @@ proc process_kickpart {chan user} {
     upvar #0 nick_onchans($user) oc
     set lc [irctolower $chan]
     set oc [grep tc {"$tc" != "$lc"} $oc]
+    if {![llength $oc]} { nick_forget $user }
 }    
 
 proc msg_KICK {p c chans users comment} {
@@ -519,28 +551,34 @@ proc loadhelp {} {
 
     catch { unset help_topics }
     set f [open helpinfos r]
-    set lno 0
-    while {[gets $f l] >= 0} {
-       incr lno
-       if {[regexp {^#.*} $l]} {
-       } elseif {[regexp {^ *$} $l]} {
-           if {[info exists topic]} {
-               set help_topics($topic) [join $lines "\n"]
-               unset topic
-               unset lines
+    try_except_finally {
+       set lno 0
+       while {[gets $f l] >= 0} {
+           incr lno
+           if {[regexp {^#.*} $l]} {
+           } elseif {[regexp {^ *$} $l]} {
+               if {[info exists topic]} {
+                   set help_topics($topic) [join $lines "\n"]
+                   unset topic
+                   unset lines
+               }
+           } elseif {[regexp {^!([-+._0-9a-z]*)$} $l dummy newtopic]} {
+               if {[info exists topic]} {
+                   error "help $newtopic while in $topic"
+               }
+               set topic $newtopic
+               set lines {}
+           } elseif {[regexp {^[^!#]} $l]} {
+               set topic
+               lappend lines [string trimright $l]
+           } else {
+               error "eh ? $lno: $l"
            }
-       } elseif {[regexp {^!([-+._0-9a-z]*)$} $l dummy newtopic]} {
-           if {[info exists topic]} { error "help $newtopic while in $topic" }
-           set topic $newtopic
-           set lines {}
-       } elseif {[regexp {^[^!#]} $l]} {
-           set topic
-           lappend lines [string trimright $l]
-       } else {
-           error "eh ? $lno: $l"
        }
+       if {[info exists topic]} { error "unfinished topic $topic" }
+    } {} {
+       close $f
     }
-    if {[info exists topic]} { error "unfinished topic $topic" }
 }
 
 def_ucmd help {
@@ -574,9 +612,9 @@ proc nickdb__head {} {
        set nl [irctolower $n]
        upvar #0 nickdb($nl) ndbe
        binary scan $nl H* nh
-       set nfn users/$nh
+       set nfn users/n$nh
        if {![info exists ndbe] && [file exists $nfn]} {
-           set f [file open $nfn r]
+           set f [open $nfn r]
            try_except_finally { set newval [read $f] } {} { close $f }
            if {[llength $newval] % 2} { error "invalid length" }
            set ndbe $newval
@@ -611,12 +649,18 @@ def_nickdb set {n args} {
        close $f
        file rename -force $nfn.new $nfn
     } {
-       catch { close $f }
     } {
+       catch { close $f }
     }
     set ndbe $newval
 }
 
+proc opt {key} {
+    global calling_nick
+    if {[info exists calling_nick]} { set n $calling_nick } { set n {} }
+    return [nickdb_opt $n $key]
+}
+
 def_nickdb opt {n key} {
     global default_settings
     if {[info exists ndbe]} {
@@ -730,7 +774,7 @@ def_ucmd set {
     prefix_nick
     check_notonchan
     if {![nickdb_exists $n]} {
-       ucmdr {} "You are unknown to me and so have no settings."
+       ucmdr {} "You are unknown to me and so have no settings.  (Use `register'.)"
     }
     if {![ta_anymore]} {
        set ol {}
@@ -757,7 +801,7 @@ def_ucmd set {
 
 def_ucmd identpass {
     set username [ta_word]
-    set passmd5 [md5sum [ta_word]]
+    set passmd5 [md5sum "[ta_word]\n"]
     ta_nomore
     prefix_nick
     check_notonchan