# -*- tcl -*- $Id: s.Connection.xotcl 1.7 01/03/23 21:55:31+01:00 neumann@somewhere.wu-wien.ac.at $
package provide xotcl::comm::connection 0.9

Class Connection -parameter {host port req socket handle}

Connection proc make {r host port reuse reusedVar} {
  #[self] showCall
  [self] instvar openConnections
  upvar $reusedVar reused
  if {$reuse} {
    set handle $host:$port-[$r set blocking]
    #if {[array exists openConnections]} {parray openConnections}
    if {![info exists openConnections($handle)]} {
      # there is no persistent connection, we create a new one
      set reused 0
      set openConnections($handle) \
	  [Connection ::[[self] autoname c] \
	       -host $host -port $port -req $r -handle $handle]
      #[self] showMsg "$openConnections($handle) CONNECTION add for $handle added"
    } else {
      # there is a persistent connection
      set reused 1
      set c $openConnections($handle)
      $c instvar req
      #::puts stderr "$c CONNECTION reuse for $handle ($c) new req=$r"
      if {[info exists req]} {
	# the persistent connection is active with some request $req
	#::puts stderr "$c CONNECTION req $req already active"
      } else {
	# the persistent connection is currently not active
	$c set req $r
      }
    }
    return $openConnections($handle)
  } else {
    set reused 0
    return [Connection ::[[self] autoname c] -host $host -port $port -req $r]
  }
}
Connection proc removeHandle handle {
  #[self] showVars
  #puts stderr "***************** unsetting $handle ***************"
  if {[info exists [self]::openConnections($handle)]} {
    unset [self]::openConnections($handle)
  }
}
Connection instproc init args {  ;# the constructor creates the socket
  [self] instvar keepOpen blocked socket error
  set blocked {}
  next
  if {[info exists socket]} {
    set keepOpen 1
  } else {
    set keepOpen 0
    [self] instvar host port req
    if {[catch {set socket [::socket -async $host $port]} msg]} {
      [self] set error $msg
      return
    }
  }
  ::fconfigure $socket -blocking false -buffersize 16384
}
#Connection instproc STATUS {ctx} {
#  [self] instvar socket
#  ::puts stderr "*** $ctx: $socket blocking=[::fconfigure $socket -blocking]"
#}
Connection instproc destroy {} { ;# the destructor closes the socket
  #[self] showCall
  [self] instvar socket handle
  if {[info exists handle]} {
    #[self] showVars handle
    # the connection was created via make
    [self class] removeHandle $handle
    #::puts stderr "[self] CONNECTION close and destroy $handle"
  } else {
    #::puts stderr "[self] CONNECTION close and destroy"
  }
  # in cases of errors we might not have a socket yet
  if {[info exists socket]} {
    ::close $socket
  }
  next
}
Connection instproc translation {translation} {
  #showCall
  ::fconfigure [set [self]::socket] -translation $translation
}    
Connection instproc importSSL args {
  #[self] showCall
  package require tls
  eval tls::import [set [self]::socket] $args
}
Connection instproc fconfigure args {
  #[self] showCall
  eval ::fconfigure [set [self]::socket] $args
}    
Connection instproc event {type r method} {
  #[self] showCall
  [self] instvar req activeRequest socket blocked
  # is the request in the argument list the currently active request?
  if {[info exists req] && $r == $req} {
    # a request can overwrite its active request
    if {$method == ""} {
      ::fileevent $socket $type ""
      #[self] showMsg "CONNECTION clear for $socket"
    } else {
      #[self] showMsg "CONNECTION register for $socket"
      ::fileevent $socket $type [list $r $method]
    }
  } else {
    #[self] showMsg "event BLOCKING current request=$req, new=$r $method"
    #[self] instvar socket
    #[self] showMsg "event BLOCKING rd=[::fileevent $socket readable]"
    #[self] showMsg "event BLOCKING wr=[::fileevent $socket writable]"
    #[self] showMsg "event BLOCKING bl=$blocked"
    ::lappend blocked $r $type $method
  }
}
Connection instproc hold {} {
  [self] instvar continueCmd socket
  set continueCmd [list ::fileevent $socket readable \
		       [::fileevent $socket readable]]
  ::fileevent $socket readable {}
  #[self] showVars continueCmd
}
Connection instproc resume {} {
  #[self] showCall
  [self] instvar continueCmd socket
  if {[info exists continueCmd]} {
    eval $continueCmd
    unset continueCmd
  }
}



Connection instproc puts {string} {
  #[self] showCall
  if {[catch {::puts [set [self]::socket] $string} msg]} {
    ::puts stderr message=$msg
  }
}
Connection instproc puts-nonewline {string} {
  #[self] showCall
  if {[catch {::puts -nonewline [set [self]::socket] $string} msg]} {
    ::puts stderr message=$msg
  }
}
Connection instproc gets {var} {
  #[self] showCall
  upvar $var result
  if {[catch {set n [::gets [set [self]::socket] result]} msg]} {
    [self] set error $msg 
    #[self] showMsg "CONNECTION error"
    return 0
  }
  #[self] showMsg "n=$n, result=<$result>"
  return $n
}
Connection instproc read {} {
  #[self] showCall
  [self] instvar socket
  if {[catch {set result [::read $socket [::fconfigure $socket -buffersize]]} msg]} {
    [self] set error $msg 
    return ""
  }
  #[self] showMsg Done
  return $result
}
Connection instproc readSize {length} {
  if {[catch {set result [::read [set [self]::socket] $length]} msg]} {
    [self] set error $msg 
    return 0
  }
  return $result
}
Connection instproc flush {} {
  #[self] showCall
  if {[catch {::flush [set [self]::socket]} msg]} {
    [self] set error $msg 
  }
}
Connection instproc eof {} {
  #[self] showCall
  if {[info exists [self]::error]} {
    return 1
  } else {
    return [::eof [set [self]::socket]]
  }
}
Connection instproc close {} {
  #[self] showCall
  [self] instvar req persistent socket blocked error
  if {![info exists socket]} return ;# error during connection open
  ::fileevent $socket readable ""
  ::fileevent $socket writable ""
  $req freeConnection
  if {[info exists persistent]} {
    [self] flush
    #::puts stderr "[self] PERSISTENT CONNECTION wanna close"
    if {$blocked == ""} {
      ::fileevent $socket readable [list [self] destroy]
      unset req
    } else {
      #[self] showVars blocked
      set req [lindex $blocked 0]
      set type [lindex $blocked 1]
      set method [lindex $blocked 2]
      set blocked [lrange $blocked 3 end]
      #[self] showMsg "in persistent connection unblock $type [list $req $method]"
      ::fileevent $socket $type [list $req $method]
    }
  } else {
    #[self] showMsg "in nonpersistent connection blocked=$blocked"
    if {$blocked != ""} {
      set req [lindex $blocked 0]
      set type [lindex $blocked 1]
      set method [lindex $blocked 2]
      set nblocked [lrange $blocked 3 end]
      ::close $socket
      unset socket
      if {[info exists [self]::handle]} {
	[self class] removeHandle [set [self]::handle]
      }
      if {[info exists error]} {
	#[self] showMsg "UNSETTING ERROR -----------"
	unset error
      }
      [self] init
      set blocked $nblocked
      ::fileevent $socket $type [list $req $method]
      #[self] showMsg "REANIMATE $socket $type [list $req $method]"
      #[self] showVars
    } else {
      #[self] showMsg "Nothing blocked: readable=[::fileevent $socket readable]"

      [self] destroy
    }
  }
}
Connection instproc makePersistent {p} {
  if {$p} {
    set [self]::persistent 1
  } else {
    if {[info exists [self]::persistent]} {
      unset [self]::persistent
      #[self] showMsg "no longer persistent"
    }
  }
}


if {[info command bgerror] == ""} {
    proc bgerror {msg} { puts stderr "******* bgerror $msg $::errorInfo*****"}
}

