# Connector module for the PS1 Broker.
# $Id: broker.tcl,v 1.1.1.1 2005/11/27 13:59:24 hoppie Exp $

##### constants ###########################################################

namespace eval broker {
  variable BROKER 0          ; # Broker channel handle, 0 = invalid.
  variable DATA              ; # Buffered data from Broker.
  array set DATA {}
  variable APPNAME "Client"  ; # Name with which the application registers.
  variable TRIGGERS {}       ; # List of keys to notify the app for.
  variable CALLBACK {}       ; # Name of procedure to call when data changes.
}


##### external procs ######################################################

proc broker::init {appName triggers {callback {}}} {
  # Connect to the Broker and register the application.
  # <in> appName = Full name of the application, may have spaces.
  # <in> triggers = List of Broker keys that the application wants to know
  #                 about.
  # <in> callback = Procedure name of callback proc, gets {key val key val}
  #                 list of changed variables.
  variable APPNAME
  variable TRIGGERS
  variable CALLBACK

  set APPNAME $appName
  set TRIGGERS $triggers
  set CALLBACK $callback
  after 1000 {
    broker::checkConnection 
  }
}


proc broker::done {} {
  # Disconnect from the Broker.
  variable BROKER

  if {$BROKER!=0} {
    # Neatly disconnect from the Broker.
    send "exit"
    after 250
    close $BROKER
    log "Disconnected from Broker"
  }
}


proc broker::status {status} {
  # Change the line status of the application.
  # <in> status = The new status, such as "Connected" or "Running".
  variable APPNAME
  send "register {$APPNAME} {$status}"
}


proc broker::send {msg} {
  # Send the message to the Broker. Channel may be down, no problem.
  # <in> msg = The message (line) to send.
  # <out> 0 on success, 1 on failure to send.
  variable BROKER
  if {[catch {puts $BROKER $msg}]} {
    return 1
  } else {
    return 0
  }
}; # send


##### internal procs #####################################################

proc broker::log {msg {emph 0}} {
  # Stub for the GUI log procedure.
  gui::log $msg $emph
}; # log


proc broker::checkConnection {} {
  # Check whether the Broker connection is sane. If not, try to
  # reopen it after a delay that depends on the severity of the problem.
  variable BROKER
  variable APPNAME
  variable TRIGGERS

  # Initially a 10-second delay for checking the connection again.
  set after 10000

  if {$BROKER==0} {
    set host [prefs::get broker.host]
    if {$host=="off"} {
      # Ok, forget about the Broker.
      return
    }

    set hostPort [split $host ":"]
    set host [lindex $hostPort 0]
    set port [lindex $hostPort 1]
    if {$host==""} {set host "localhost"}
    if {$port==""} {set port 1863}
    log "Looking for Broker on $host:$port..."
    update idletasks

    # The following call blocks for a minute if the host is not online. This
    # may be considered a bug.
    if {[catch {socket $host $port} ch]} {
      log "Failed to connect to Broker: $ch"
      # Retry after 30 seconds (Broker unreachable).
      set after 30000
    } else {
      # Connection made. Initialize the socket and the handler.
      set BROKER $ch
      fconfigure $ch -buffering line -buffersize 2048 -blocking 0
      fileevent $ch readable "broker::readEvent $ch"
      # Register the application.
      puts $ch "register {$APPNAME} Connected"
      # Register the notification triggers. This will immediately fill up
      # the DATA array via readEvent.
      puts $ch [concat notify $TRIGGERS]
    }
  }

  # Re-check after some delay.
  after $after broker::checkConnection
}; # checkConnection


proc broker::readEvent {ch} {
  variable BROKER
  variable DATA
  variable CALLBACK

  if {[eof $ch]} {
    # Connection dropped. Don't use "disconnect" as this is a forced
    # disconnect and should be logged differently. Reconnect will be
    # attempted automatically by the checkConnection loop.
    catch {close $ch}
    log "Lost connection to Broker"
    set BROKER 0
    return
  }

  # Robust line parsing.
  if {[catch {set line [gets $ch]}]} return
  if {$line==""} return
  if {[catch {set dummy [lindex $line 0]}]} return

  # All set up, process the incoming command and data. Everything is always
  # buffered locally. Applications may register a trigger procedure which is
  # called when something changes, with {key value key value} as parameter.
  switch -- [lindex $line 0] {
    data {
      # Buffer the incoming data in the local store.
      set line [lrange $line 1 end]
      array set DATA $line
      if {$CALLBACK!={}} {
        $CALLBACK $line
      }
    }
    default {
      # Assume this is a meaningful message to the user. Display it verbatim.
      log "$line"
    }
  }; # switch

}; # readEvent


proc broker::getData {key {mask %s}} {
  # Read Broker data and return formatted value.
  # <in> key = Name of the Broker key to read.
  # <in> mask = Optionally, format mask. Default is %s.
  # <out> String containing the value of the key, may be "" or 0, depending
  #       on what type of mask has been given. %s means "", rest means 0.
  variable DATA
  
  if {[info exists DATA($key)]} {
    set data $DATA($key)
  } else {
    set data ""
  }

  if {[catch {format $mask $data} sane]} {
    gui::log "Conversion problem for '$data' with mask '%d', ignored"
    # One more try... this should allow bad data, but catch bad masks.
    if {[regexp {%[-0-9]*s} $mask]} {
      return [format $mask ""]
    } else {
      return [format $mask 0]
    }
  } else {
    return $sane
  }

}; # getData

