2018-7-23 [ronsor]: a mostly competent and useful IRC client library. requires [incr Tcl].


======
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 {}
}
======


<<categories>>Network