package require Itcl
namespace path itcl
class irc {
public variable nick {}
public variable user {}
public variable pass {}
public variable host {127.0.0.1}
public variable port {6667}
public variable real {Client}
public variable socketengine {socket}
private variable binds {}
private variable sock {}
private variable temp
private variable bindShare {}
private variable responses {}
common modelists {
ban {+b 367 368}
invite {+I 346 347}
except {+e 348 349}
}
constructor {args} {
configure {*}$args
reconnect
}
destructor {
close $sock
array unset ::ircvwait $this,*
}
method bindShare {args} {
set bindShare $args
}
method bind {tag arg body} {
dict set binds $tag [list [list this {*}[dict keys $bindShare] raw {*}$arg] $body]
}
method unbind {tag} {
dict unset binds $tag
}
method raise {tag args} {
if {[dict exists $binds $tag]} {
apply [dict get $binds $tag] $this {*}[dict values $bindShare] {*}$args
}
}
method reconnect {} {
set sock [{*}$socketengine $host $port]
fconfigure $sock -buffering line -translation crlf -encoding utf-8
fileevent $sock readable [list $this incoming]
if {$pass ne ""} {/raw PASS $pass}
/raw NICK $nick
/raw USER $user * * $real
}
method /raw {args} {
if {[string match "* *" [lindex $args end]]} {
lset args end :[lindex $args end]
}
puts $sock [join $args " "]
raise <rawout> [parseline [join $args " "]]
}
method /join {chans} {
/raw JOIN [join $chans ","]
}
method /nick {n} {
/raw NICK $n
}
method /part {chan msg} {
/raw PART $chan $msg
array unset temp [string tolower $chan],*
}
method /msg {tgt msg} {
/raw PRIVMSG $tgt $msg
}
method /notice {tgt msg} {
/raw NOTICE $tgt $msg
}
method /ctcp {tgt args} {
if {[lindex $args 0] eq "-reply"} {
/notice $tgt "\x01[join [lrange $args 1 end] " "]\x01"
} else {
/msg $tgt "\x01[join $args " "]\x01"
}
}
method /topic {chan {tpc {}}} {
if {$tpc ne ""} {
/raw TOPIC $chan $tpc
} else {
set chan [string tolower $chan]
return $temp($chan,topic)
}
}
method /mode {args} {
/raw MODE {*}$args
}
method /names {chan} {
set chan [string tolower $chan]
set temp($chan,names) {}
/raw NAMES $chan
vwait ::ircvwait($this,$chan,366)
unset ::ircvwait($this,$chan,366)
return [lsort -dictionary -unique $temp($chan,names)]
}
method eval {args} {{*}$args}
method /quit {msg} {
/raw QUIT $msg
}
method /modelist {chan type} {
set chan [string tolower $chan]
lassign [dict get $modelists $type] mode lnum enum
/mode $chan $mode
set temp($chan,$lnum) {}
bind <raw-$lnum> {} {
lassign [dict get $raw args] lnum _ chan mask
set chan [string tolower $chan]
$this eval lappend temp($chan,$lnum) $mask
}
bind <raw-$enum> {} {
lassign [dict get $raw args] enum _ chan
set chan [string tolower $chan]
set ::ircvwait($this,$chan,$enum) 1
}
vwait ::ircvwait($this,$chan,$enum)
unset ::ircvwait($this,$chan,$enum)
unbind <raw-$enum>
unbind <raw-$lnum>
return $temp($chan,$lnum)
}
method parseline {line} {
set rawline $line
if {![string match ":*" $line]} {set line ":Remote.Server $line"}
set src [lindex [split $line ": "] 1]
set nn {}; set uu {}; set hh {}; set append {}
lassign [split $src "!@"] nn uu hh
if {[set pos [string first " :" $line]] != -1} {
set append [list [string range $line $pos+2 end]]
set line [string range $line 0 ${pos}-1]
}
set args [lrange [split $line " "] 1 end]
lappend args {*}$append
return [dict create src [dict create "" $src nick $nn user $uu host $hh] \
cmd [string tolower [lindex $args 0]] args $args raw $rawline]
}
method incoming {} {
set line [gets $sock]
if {$line eq ""} {
close $sock
raise <closed> {}
return
}
set raw [parseline $line]
raise <raw> $raw
raise <raw-[dict get $raw cmd]> $raw
switch -exact -- [dict get $raw cmd] {
001 {raise <ready> $raw}
privmsg - notice {
lassign [dict get $raw args] _ tgt msg
if {[string match "\x01*\x01" $msg]} {
set ctcp [split [string range $msg 1 end-1] " "]
lset ctcp 0 [string tolower [lindex $ctcp 0]]
raise <ctcp> $raw [dict get $raw src nick] $tgt {*}$ctcp
raise <ctcp-[lindex $ctcp 0]> $raw [dict get $raw src nick] $tgt {*}$ctcp
} else {
raise <msg> $raw [dict get $raw src nick] $tgt $msg
}
}
nick {
lassign [dict get $raw args] _ newnick
raise <nick> $raw [dict get $raw src nick] $newnick
if {[string equal -nocase [dict get $raw src nick] $nick]} {
set nick $newnick
}
}
join {
lassign [dict get $raw args] _ chan
set chan [string tolower $chan]
if {[string equal -nocase $nick [dict get $raw src nick]]} {
set temp($chan,joined) 1
set temp($chan,topic) {}
set temp($chan,names) {}
}
raise <join> $raw [dict get $raw src nick] $chan
}
353 {
lassign [dict get $raw args] _ _ _ chan names
set chan [string tolower $chan]
set names [split $names " "]
foreach n $names {dict set temp($chan,names) $n $n}
}
366 {
lassign [dict get $raw args] _ _ chan
set ::ircvwait($this,$chan,366) 1
}
quit {
raise <quit> $raw [dict get $raw src nick] {*}[lrange [dict get $raw args] 1 end]
}
part {
raise <part> $raw [dict get $raw src nick] {*}[lrange [dict get $raw args] 1 end]
}
error {
raise <error> $raw [lindex [dict get $raw args] end]
}
kick {
lassign [dict get $raw args] _ chan tgt msg
set chan [string tolower $chan]
raise <kick> $raw [dict get $raw src nick] $chan $tgt $msg
if {[string equal -nocase $nick $tgt]} {
/part $chan
}
}
332 {
lassign [dict get $raw args] _ _ chan topic
set chan [string tolower $chan]
set temp($chan,topic) $topic
raise <topic> $raw * $chan $topic
}
topic {
lassign [dict get $raw args] _ chan topic
set chan [string tolower $chan]
set temp($chan,topic) $topic
raise <topic> $raw [dict get $raw src nick] $chan $topic
}
}
}
}
if {[info script] eq $argv0} {
puts "Starting..."
irc test -nick test -user test -pass test123 -real {test client}
test bind <raw> {} {
puts "<- [dict get $raw raw]"
}
test bind <rawout> {} {
puts "-> [dict get $raw raw]"
}
test bind <ready> {} {
$this /join #abc
puts [$this /names #abc]
puts [$this /modelist #abc ban]
puts [$this /modelist #abc invite]
puts [$this /modelist #abc except]
}
vwait {}
}2018-7-23 ronsor: a mostly competent and useful IRC client library. requires incr Tcl.
Getting started
Home • Recent changes • Help • Create new page • Search • Add comments
• Edit