--- /dev/null
+proc defset {varname val} {
+ upvar #0 $varname var
+ if {![info exists var]} { set var $val }
+}
+
+# must set host
+defset port 6667
+
+defset nick testbot
+defset ownfullname "testing bot"
+defset ownmailaddr test-irc-bot@example.com
+
+defset musthaveping_ms 10000
+defset out_maxburst 6
+defset out_interval 2100
+defset out_lag_lag 5000
+defset out_lag_very 25000
+
+defset marktime_min 300
+defset marktime_join_startdelay 5000
+
+proc manyset {list args} {
+ foreach val $list var $args {
+ upvar 1 $var my
+ set my $val
+ }
+}
+
+proc try_except_finally {try except finally} {
+ global errorInfo errorCode
+ set er [catch { uplevel 1 $try } emsg]
+ if {$er} {
+ set ei $errorInfo
+ set ec $errorCode
+ if {[catch { uplevel 1 $except } emsg3]} {
+ append ei "\nALSO ERROR HANDLING ERROR:\n$emsg3"
+ }
+ }
+ set er2 [catch { uplevel 1 $finally } emsg2]
+ if {$er} {
+ if {$er2} {
+ append ei "\nALSO ERROR CLEANING UP:\n$emsg2"
+ }
+ return -code $er -errorinfo $ei -errorcode $ec $emsg
+ } elseif {$er2} {
+ return -code $er2 -errorinfo $errorInfo -errorcode $errorCode $emsg2
+ } else {
+ return $emsg
+ }
+}
+
+proc out__vars {} {
+ uplevel 1 {
+ global out_queue out_creditms out_creditat out_interval out_maxburst
+ global out_lag_lag out_lag_very
+#set pr [lindex [info level 0] 0]
+#puts $pr>[clock seconds]|$out_creditat|$out_creditms|[llength $out_queue]<
+ }
+}
+
+proc out_lagged {} {
+ out__vars
+ if {[llength $out_queue]*$out_interval > $out_lag_very} {
+ return 2
+ } elseif {[llength $out_queue]*$out_interval > $out_lag_lag} {
+ return 1
+ } else {
+ return 0
+ }
+}
+
+proc out_restart {} {
+ out__vars
+
+ set now [clock seconds]
+ incr out_creditms [expr {($now - $out_creditat) * 1000}]
+ set out_creditat $now
+ if {$out_creditms > $out_maxburst*$out_interval} {
+ set out_creditms [expr {$out_maxburst*$out_interval}]
+ }
+ out_runqueue $now
+}
+
+proc out_runqueue {now} {
+ global sock
+ out__vars
+
+ while {[llength $out_queue] && $out_creditms >= $out_interval} {
+#puts rq>$now|$out_creditat|$out_creditms|[llength $out_queue]<
+ manyset [lindex $out_queue 0] orgwhen msg
+ set out_queue [lrange $out_queue 1 end]
+ if {[llength $out_queue]} {
+ append orgwhen "+[expr {$now - $orgwhen}]"
+ append orgwhen "([llength $out_queue])"
+ }
+ puts "$orgwhen -> $msg"
+ puts $sock $msg
+ incr out_creditms -$out_interval
+ }
+ if {[llength $out_queue]} {
+ after $out_interval out_nextmessage
+ }
+}
+
+proc out_nextmessage {} {
+ out__vars
+ set now [clock seconds]
+ incr out_creditms $out_interval
+ set out_creditat $now
+ out_runqueue $now
+}
+
+proc sendout_priority {priority command args} {
+ global sock out_queue
+ if {[llength $args]} {
+ set la [lindex $args end]
+ set args [lreplace $args end end]
+ foreach i $args {
+ if {[regexp {[: ]} $i]} {
+ error "bad argument in output $i ($command $args)"
+ }
+ }
+ lappend args :$la
+ }
+ set args [lreplace $args 0 -1 $command]
+ set string [join $args { }]
+ set now [clock seconds]
+ set newe [list $now $string]
+ if {$priority} {
+ set out_queue [concat [list $newe] $out_queue]
+ } else {
+ lappend out_queue $newe
+ }
+ if {[llength $out_queue] == 1} {
+ out_restart
+ }
+}
+
+proc sendout {command args} { eval sendout_priority [list 0 $command] $args }
+
+proc log {data} {
+ puts $data
+}
+
+proc logerror {data} {
+ log $data
+}
+
+proc saveeic {} {
+ global saveei saveec errorInfo errorCode
+
+ set saveei $errorInfo
+ set saveec $errorCode
+
+ puts ">$saveec|$saveei<"
+}
+
+proc bgerror {msg} {
+ global save
+ logerror $msg
+ saveeic
+}
+
+proc onread {args} {
+ global sock nick calling_nick errorInfo errorCode
+
+ if {[gets $sock line] == -1} { fail "EOF/error on input" }
+ regsub -all "\[^ -\176\240-\376\]" $line ? line
+ set org $line
+
+ set ei $errorInfo
+ set ec $errorCode
+ catch { unset calling_nick }
+ set errorInfo $ei
+ set errorCode $ec
+
+ if {[regexp -nocase {^:([^ ]+) (.*)} $line dummy prefix remain]} {
+ set line $remain
+ if {[regexp {^([^!]+)!} $prefix dummy maybenick]} {
+ set calling_nick $maybenick
+ if {"[irctolower $maybenick]" == "[irctolower $nick]"} return
+ }
+ } else {
+ set prefix {}
+ }
+ if {![string length $line]} { return }
+ if {![regexp -nocase {^([0-9a-z]+) *(.*)} $line dummy command line]} {
+ log "bad command: $org"
+ return
+ }
+ set command [string toupper $command]
+ set params {}
+ while {[regexp {^([^ :]+) *(.*)} $line dummy thisword line]} {
+ lappend params $thisword
+ }
+ if {[regexp {^:(.*)} $line dummy thisword]} {
+ lappend params $thisword
+ } elseif {[string length $line]} {
+ log "junk at end: $org"
+ return
+ }
+ if {"$command" == "PRIVMSG" && [privmsg_unlogged $prefix $params]} {
+ return
+ }
+ log "[clock seconds] <- $org"
+ set procname msg_$command
+ if {[catch { info body $procname }]} { return }
+ if {[catch {
+ eval [list $procname $prefix $command] $params
+ } emsg]} {
+ logerror "error: $emsg ($prefix $command $params)"
+ saveeic
+ }
+}
+
+proc sendprivmsg {dest l} {
+ foreach v [split $l "\n"] {
+ sendout [expr {[ischan $dest] ? "PRIVMSG" : "NOTICE"}] $dest $v
+ }
+}
+proc sendaction_priority {priority dest what} {
+ sendout_priority $priority PRIVMSG $dest "\001ACTION $what\001"
+}
+proc msendprivmsg {dest ll} { foreach l $ll { sendprivmsg $dest $l } }
+proc msendprivmsg_delayed {delay dest ll} { after $delay [list msendprivmsg $dest $ll] }
+
+proc check_nick {n} {
+ if {[regexp -nocase {[^][\\`_^{|}a-z0-9-]} $n]} { error "bad char in nick" }
+ if {[regexp {^[-0-9]} $n]} { error "bad nick start" }
+}
+
+proc ischan {dest} {
+ return [regexp {^[&#+!]} $dest]
+}
+
+proc irctolower {v} {
+ foreach {from to} [list "\\\[" "{" \
+ "\\\]" "}" \
+ "\\\\" "|" \
+ "~" "^"] {
+ regsub -all $from $v $to v
+ }
+ return [string tolower $v]
+}
+
+proc msg_PING {p c s1} {
+ global musthaveping_after
+ prefix_none
+ sendout PONG $s1
+ if {[info exists musthaveping_after]} connected
+}