#
# $Source: /home/nlfm/Working/Zircon/Released/lib/RCS/Notrace.tcl,v $
# $Date: 2002/01/18 12:22:23 $
# $Revision: 1.18.1.37 $
#
#
package provide Notrace 1.18
#
proc ircInput {unusedmode conn} {
    global STN zircon inexp1 inexp2 currentNet
    set net $STN($conn)
    if {[catch {gets $conn} line]} {
	switch {socket is not connected} $line {
	    set line {connection request timed out}
 	}
	$net close $line
	return
    }
    
    if {[eof $conn]} {
	$net doClose $conn
	switch $conn [$net sock] { $net close }
    } {
	if {![regexp -- $inexp1 $line match prefix cmd b c d e param]} {
	    if {![regexp -- $inexp2 $line match prefix cmd b]} {
		switch {} $line {} default {
		    $net errmsg "Error on server connection - $line"
		}
		return
	    }
	    set param {}
	}
	set currentNet $net
	switch -glob $prefix {
	:* { }
	PING {
		$net q1Send "PONG :[string range $cmd 1 end]"
		return
	    }
	ERROR {
		switch {} [$net closing] {
		    $net error {} [string range $line 7 end] {}
		} default {
		    $net doClose $conn
		}
		return
	    }
	NOTICE {
		set prefix :[$net host]
		set b $cmd
		set cmd NOTICE
	    }
	default { set prefix :[$net host] }
	}
	if {[catch {irc$cmd $net $prefix $param [safeClean [string range $b 1 end]]} msg]} {
	    zError $msg $cmd $prefix $param [string range $b 1 end]
	}
    }
}
#
proc net_send {this op args} {
    upvar #0 $this ndata
    if {$ndata(sock) == {}} { return 1 }
    set msg $op
    switch : [set last :[lindex $args end]] {} default {
	if {![catch {set foo [lreplace $args end end]}]} {
	    append msg " $foo $last"
	}
    }
    if {[catch {puts $ndata(sock) $msg} err]} {$this close $err ; return 1}
    return 0
}
#
proc net_qSend {this op args} {
    upvar #0 $this ndata
    if {[catch {puts $ndata(sock) "$op [join $args]"} msg]} {
        $this close $msg
	return 1
    }
    return 0
}
#
proc net_sendRaw {this value} {
    upvar #0 ${this}(sock) sock
    switch {} $sock {} default {
        if {[catch {puts $sock $value} msg]} {$this close $msg ; return 1}
    }
    return 0
}
#
proc net_q1Send {this op} {
    upvar #0 $this ndata
    if {[catch {puts $ndata(sock) $op} msg]} { $this close $msg ; return 1}
    return 0
}
#
proc net_connect {this host port} {
    set sk [[$this sockcmd] $host $port]
    sconf $sk {}
    return $sk
}
#
proc net_doClose {this sock} {
    switch {} $sock return
    upvar #0 $this ndata
    catch {close $sock}
    switch $sock $ndata(sock) {
	$this inform "Disconnected from [$this host]"
    }
    switch {} $ndata(closing) {} default {
	catch {after cancel $ndata(closing)}
	set ndata(closing) {}
    }
}
#
proc net_closeSock {this msg} {
    upvar #0 $this ndata MkOp$this MkOp
    foreach x {monitorTest pingTest isonTest ircTests popQueue} {
	catch {after cancel "$this $x"}
    }
    catch {unset MkOp}
    set ctl [$this control]
    $ctl setQuit open "$ctl open"
    switch {} [set sock $ndata(sock)] {} default {
	set ndata(sock) {}
	set ndata(pinged) 0
	switch {} $msg {
	    $this doClose $sock
	} default {
	    catch {puts $sock "QUIT :$msg"}
	    set ndata(closing) [after $ndata(quitwait) "$this doClose $sock"]
	}
    }
    if {!$ndata(integrate)} {
        retitleFrame [MainInfo] [$this info] [$this name] $this 1
    }
    retitleFrame [MainControl] $this [$this name] $this 1
    [$this listid] release
}
#
proc net_queue {this req} {
    upvar #0 $this ndata
    if {$ndata(antiflood)} {
	switch {} $ndata(maxQueue) {} default {
	    if {$ndata(msgQLen) >= $ndata(maxQueue)} return
	}
	lappend ndata(msgQueue) $req
	incr ndata(msgQLen)
	switch {} $ndata(msgQTag) {
	    set ndata(msgQTag) [after $ndata(antiflood) "$this popQueue"]
	}
    } elseif {[catch {puts $ndata(sock) $req} msg]} { $this close $msg }
}
#
proc net_popQueue {this} {
    upvar #0 $this ndata
    set ndata(msgQTag) {}
    switch {} $ndata(sysQueue) {
	switch {} $ndata(msgQueue) return
	if {[catch {puts $ndata(sock) [lindex $ndata(msgQueue) 0]} msg]} {
	    $this close $msg
	}
	set ndata(msgQueue) [lrange $ndata(msgQueue) 1 end]
	if {[incr ndata(msgQLen) -1]} {
	    set ndata(msgQTag) [after $ndata(antiflood) "$this popQueue"]
	}
    } default {
	if {[catch {puts $ndata(sock) [lindex $ndata(sysQueue) 0]} msg]} {
	    $this close $msg
	}
	switch {} [set ndata(sysQueue) [lrange $ndata(sysQueue) 1 end]] { 
	    switch {} $ndata(msgQueue) return
	    set ndata(msgQTag) [after $ndata(antiflood) "$this popQueue"]

	} default {
	    set ndata(msgQTag) [after $ndata(sysQDelay) "$this popQueue"]
	}
    }
}
#
proc chat_action {this str} {
    notIdle {} [$this net]
    if {$str == {}} return
    upvar #0 ${this}(sock) sock
    switch {} $sock {
	$this addText {} {*** Connection is closed!!!!}
    } default {
	if {[catch {puts $sock "\001ACTION $str\001"} err]} {
	    $this addText {} "*** Error : $err"
	} {
	    flush $sock
	    $this addText @me "* [[$this net] nickname] $str"
	}
    }
}
#
proc chat_send {this str args} {
    notIdle {} [set net [$this net]]
    if {$str == {}} return
    upvar #0 ${this}(sock) sock
    $this addHist $str
    switch {} $sock {
	$this addText {} {*** Connection is closed!!!!}
    } default {
	if {[catch {puts $sock $str} err]} {
	    $this addText {} "*** Error : $err"
	} {
	    flush $sock
	    regsub -all %n [$this mytag] [[$net myid] name] pr
	    $this addText @me "$pr $str"
	}
    }
}
#
proc acceptChat {usr newc unusedhst args} {
    set net [$usr net]
    upvar #0 AChat$net AChat
    [set cht [$net eval "Chat [list [$usr name]] -caller $usr"]] show
    $cht addUser $usr 0 0
    upvar #0 $newc chdata
    $cht configure -sock $newc
    set chdata(who) [$usr ref]
    set chdata(obj) $cht
    fconfigure $newc -buffering none -blocking 0 -translation auto
    fileevent $newc readable "dccChat r $newc"
    catch {close $AChat($usr)}
    catch {unset AChat($usr)}
    if {[winfo exists .@dls$net]} { buildDCCList $net }
}
