7 proc sendout
{command args
} {
10 set la
[lindex $args end
]
11 set args
[lreplace $args end end
]
13 if {[regexp {[: ]} $i]} {
14 error "bad argument in output $i ($command $args)"
19 set args
[lreplace $args 0 -1 $command]
20 set string [join $args { }]
29 proc logerror
{data
} {
34 global saveei saveec errorInfo errorCode
39 puts ">$saveec|$saveei<"
51 if {[gets $sock line
] == -1} { set terminate
1; return }
52 regsub -all "\[^ -\176\240-\376\]" $line ? line
54 if {[regexp -nocase {^
:([^
]+) (.
*)} $line dummy prefix remain
]} {
59 if {![string length
$line]} { return }
60 if {![regexp -nocase {^
([0-9a-z
]+) *(.
*)} $line dummy command line
]} {
61 log
"bad command: $org"
64 set command
[string toupper
$command]
66 while {[regexp {^
([^
:]+) *(.
*)} $line dummy thisword line
]} {
67 lappend params
$thisword
69 if {[regexp {^
:(.
*)} $line dummy thisword
]} {
70 lappend params
$thisword
71 } elseif
{[string length
$line]} {
72 log
"junk at end: $org"
75 if {"$command" == "PRIVMSG" &&
76 [regexp {^
[&#+!]} [lindex $params 0]] &&
77 ![regexp {^
!} [lindex $params 1]]} {
78 # on-channel message, ignore
80 recordlastseen_p
$prefix "talking on [lindex $params 0]"
85 set procname msg_
$command
86 if {[catch { info body
$procname }]} { return }
88 eval [list $procname $prefix $command] $params
90 logerror
"error: $emsg ($prefix $command $params)"
97 if {[string length
$p]} { error "prefix specified" }
100 proc msg_PING
{p c s1
} {
105 proc check_nick
{n
} {
106 if {[regexp -nocase {[^
][\\`_^
{|
}a-z0-9-
]} $n]} { error "bad char in nick" }
107 if {[regexp {^
[-0-9]} $n]} { error "bad nick start" }
111 return [regexp {^
[&#+!]} $dest]
114 proc irctolower
{v
} {
115 foreach {from to
} [list "\\\[" "{" \
119 regsub -all $from $v $to v
121 return [string tolower
$v]
124 proc prefix_nick
{} {
128 if {![regexp {^
([^
!]+)!} $p dummy n
]} { error "not from nick" }
130 if {"[irctolower $n]" == "[irctolower $nick]"} { error "from myself" }
133 proc recordlastseen_n
{n how
} {
135 set lastseen
([irctolower
$n]) [list $n [clock seconds
] $how]
138 proc recordlastseen_p
{p how
} {
140 recordlastseen_n
$n $how
143 proc chanmode_arg
{} {
145 set rv
[lindex $cm_args 0]
146 set cm_args
[lreplace cm_args
0 0]
150 proc chanmode_o0
{m g p chan
} {
153 set who
[chanmode_arg
]
154 recordlastseen_p
$p "being mean to $who"
155 if {"[irctolower $who]" == "[irctolower $nick]"} {
156 set chandeop
($chan) [list [clock seconds
] $p]
160 proc msg_MODE
{p c dest modelist args
} {
161 if {![ischan
$dest]} return
162 if {[regexp {^
\-(.
+)$} $modelist dummy modelist
]} {
164 } elseif
{[regexp {^
\+(.
+)$} $modelist dummy modelist
]} {
167 error "invalid modelist"
169 foreach m
[split $modelist] {
170 set procname chanmode_
$m$give
171 if {[catch { info body
$procname }]} {
172 recordlastseen_p
$p "fiddling with $dest"
174 $procname $m $give $p $dest
179 proc msg_JOIN
{p c chan
} { recordlastseen_p
$p "joining $chan" }
180 proc msg_PART
{p c chan
} { recordlastseen_p
$p "leaving $chan" }
181 proc msg_QUIT
{p c why
} { recordlastseen_p
$p "leaving ($why)" }
183 proc msg_PRIVMSG
{p c dest
text} {
185 if {[ischan
$dest]} {
186 recordlastseen_n
$n "invoking me in $dest"
189 recordlastseen_n
$n "talking to me"
194 regsub {^
! *} $text {} text
196 set procname ucmd_
[string tolower
$ucmd]
197 if {[catch { info body
$procname }]} {
198 error "unknown command; try help for help"
202 sendout PRIVMSG
$n "error: $rv"
204 foreach {td val
} [list $n [lindex $rv 0] $output [lindex $rv 1]] {
205 foreach l
[split $val "\n"] {
206 sendout PRIVMSG
$td $l
214 if {[string length
$text]} { error "too many parameters" }
219 if {![regexp {^
([^
]+) *(.
*)} $text dummy firstword
text]} {
220 error "too few parameters"
232 proc ucmdr
{priv pub
} {
233 return -code return [list $priv $pub]
240 {Commands currently understood
:
245 proc manyset
{list args
} {
246 foreach val
$list var
$args {
255 set n
[irctolower
[ta_nick
]]
257 if {"$n" == "[irctolower $nick]"} {
258 error "I am not self-aware."
259 } elseif
{![info exists lastseen
($n)]} {
260 ucmdr
{} "I've never seen $n."
262 manyset
$lastseen($n) realnick
time what
263 set howlong
[expr {[clock seconds
] - $time}]
266 } elseif
{$howlong < 1000} {
267 set string "${howlong}s ago"
269 if {$howlong < 1000000} {
276 set value
[expr "$howlong.0 / $scale"]
277 foreach {min
format} {100 %.0f
10 %.1f
1 %.2f
} {
278 if {$value < $min} continue
279 set string [format "$format${pfx}s ago" $value]
283 if {![info exists
string]} { set string now
}
284 ucmdr
{} "I last saw $realnick $string, $what."
288 if {![info exists sock
]} {
289 set sock
[socket $host $port]
290 fconfigure $sock -buffering line
291 #fconfigure $sock -translation binary
292 fconfigure $sock -translation crlf
294 sendout USER guest
0 * "chiark testing bot"
296 fileevent $sock readable onread
299 #if {![regexp {tclsh} $argv0]} {