###########################################################################
# Copyright (c) 1998, Jeffrey Glen Rennie
# All rights reserved.
###########################################################################
###########################################################################
# repo.tcl -- repository for server sockets

namespace eval repo { 
    variable serverTimeout
    set serverTimeout 30000
}

proc repo::CancelTimeout { sock } {
    variable serverTable
    if [catch { 
	after cancel $serverTable($sock)
	unset serverTable($sock) 
    } errMessage ] {
	dbg::puts socket $errMessage
    }
}

proc repo::SetTimeout { sock host port } {
    variable serverTable
    variable serverTimeout

    CancelTimeout $sock
    set serverTable($sock) [after $serverTimeout \
	    [list repo::Timeout $sock $host $port]]
}

proc repo::Timeout { sock host port } {
    dbg::puts socket "$sock on $host:$port timed out."
    CloseSocket $sock $host $port
}    

proc repo::DoneWithServerSocket { sock host port } {
    global repo_ReadyServers

    dbg::puts socket "Done with $sock on $host:$port."
    fileevent $sock readable [list repo::ReceiveServerMessage \
	    $sock $host $port]
    lappend repo_ReadyServers($host,$port) $sock
    SetTimeout $sock $host $port
}

proc repo::CloseSocket { sock host port } {
    global repo_ReadyServers

    catch { close $sock }
    catch { 
	if { [llength $repo_ReadyServers($host,$port)] == 1 } {
	    unset repo_ReadyServers($host,$port)
	} else {
	    set index [lsearch $repo_ReadyServers($host,$port) $sock]
	    lremove repo_ReadyServers($host,$port) $index
	}
	CancelTimeout $sock
    }
}

proc repo::ReceiveServerMessage { sock host port} {
    global repo_ReadyServers
    
    if [ ::eof $sock] {
	dbg::puts socket "Received eof in ReceiveServerMessage for $sock."
	CloseSocket $sock $host $port
    } else {
	catch { gets $sock line } err
	dbg::puts socket "Unexpected message from server $sock, closing: $line"
	CloseSocket $sock $host $port
    }
}

proc repo::GetServerSocket { host port callback } {
    global repo_ReadyServers
    set isOldSock 0

    set sockResult badSock
    if [info exists repo_ReadyServers($host,$port)] {
	set sockResult [lindex $repo_ReadyServers($host,$port) 0]
	if { [llength $repo_ReadyServers($host,$port)] > 1 } {
	    lremove repo_ReadyServers($host,$port) 0
	} else {
	    unset repo_ReadyServers($host,$port)
	}
	catch { fileevent $sockResult readable {} }
	# double check to make sure this socket is still ok
	set errMessage ""
	if { [catch { read $sockResult 1 } ] || [::eof $sockResult] } {
	    dbg::puts socket "closing $sockResult in GetServerSock $errMessage"
	    catch { CloseSocket $sockResult }
	    set sockResult [GetServerSocket $host $port $callback]
	} else {
	    dbg::puts socket "Reusing $sockResult on $host:$port."
	    CancelTimeout $sockResult
	    fconfigure $sockResult -translation {auto crlf}
	    set isOldSock 1
	    eval $callback [list $sockResult $isOldSock]
	}
    } else {
	if [ catch {
	    set sockResult [socket -async $host $port]
	    fconfigure $sockResult -blocking 0 -translation {auto crlf} \
		    -buffering full -buffersize 1024
	    fileevent $sockResult writable \
		    [list repo::ReturnSock \
		    $host $port $callback $sockResult $isOldSock]
	} ] {
	    repo::ReturnSock $host $port $callback $sockResult $isOldSock
	}
    }
    set sockResult
}

proc repo::ReturnSock { host port callback sockResult isOldSock} {
    dbg::puts socket "Created $sockResult on $host:$port."
    catch { fileevent $sockResult writable {} }
    eval $callback [list $sockResult $isOldSock]
}
###########################################################################
# Copyright (c) 1998, Jeffrey Glen Rennie
# All rights reserved.
###########################################################################
