# copyright (C) 1997-2006 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu

# $Id: peer.tcl,v 1.17 2006/01/28 19:16:59 jfontain Exp $


package provide peer [lindex {$Revision: 1.17 $} 1]
package require msgcat
namespace import msgcat::*
package require internationalization


namespace eval peer {                             ;# internal peer module for cells data exchange between moodss or moomps instances

    variable pattern
    set pattern(data) {[0-9]*,[01]}
    set pattern(type) {type,[0-9]*}
    variable times {10 10 20 20 20 60 60 60 60 60 300}                                                                 ;# in seconds
    variable try 0

    array set data [list\
        updates 0\
        0,label [mc cell] 0,type ascii 0,message [mc {data cell description}]\
        1,label [mc value] 1,type dictionary 1,message [mc {current value of data cell}]\
        pollTimes -60\
        persistent 1 64Bits 1\
        switches {--source 1}\
    ]

    proc initialize {optionsName} {
        upvar 1 $optionsName options
        variable data
        variable source
        variable port
        variable socket

        catch {set source $options(--source)}
        set port 8008; catch {set port $options(--port)}
        if {[info exists source]} {
            set data(identifier) peer($source:$port)
            # what follows could fail, which would be caught by the core, but other code in this module must handle such cases
            set socket [socket -async $source $port]
            fconfigure $socket -blocking 0 -encoding utf-8
            fileevent $socket readable peer::imported
            after idle peer::import
        } else {
            set data(identifier) peer(export:$port)
            # what follows could fail, which would be caught by the core, but other code in this module must handle such cases
            set socket [socket -server peer::accept $port]                                    ;# mail fail so socket may never exist
            fconfigure $socket -blocking 0 -encoding utf-8                         ;# best for communicating for other Tcl processes
        }
    }

    proc milliseconds {{next 1}} {                                                          ;# time before retry, progressively long
        variable times
        variable try

        if {$next} {
            set seconds [lindex $times $try]
            if {$seconds eq ""} {set seconds [lindex $times end]}
            incr try
            return [expr {1000 * $seconds}]
        } else {                                                                                                            ;# reset
            set try 0
        }
    }

    proc messages {} {
        variable data

        return [list $data(0,message) $data(1,message)]
    }

    proc new {row type} {
        variable data

        set data($row,0) {}
        set data($row,1) ?
        set data(type,$row) $type                                                     ;# remember the type of the original data cell
    }

    proc value {row value} {
        variable data

        set data($row,1) $value
    }

    proc cell {row string} {
        variable data

        set data($row,0) $string
    }

    proc type {row} {
        variable data

        return $data(type,$row)
    }

    proc exists {row column} {
        variable data

        return [info exists data($row,$column)]
    }

    proc delete {row} {
        variable data

        unset data($row,0) data($row,1) data(type,$row)
    }

    proc update {} {
        variable data
        variable client

        foreach socket [array names client] {
            export $socket
        }
        incr data(updates)
    }

    proc accept {socket address port} {
        variable client

        set client($socket) [lindex [fconfigure $socket -peername] 1]                                   ;# remember client host name
        fconfigure $socket -blocking 0 -encoding utf-8
        gets $socket                                                          ;# discard data as this is just for registering client
        export $socket
    }

    proc export {socket} {
        variable data
        variable pattern
        variable client

        # work with data packed in a single line for supposedly better reliability and simplicity
        if {[catch {
            puts $socket [regsub -all \n [concat [array get data $pattern(data)] [array get data $pattern(type)]] \v]
            flush $socket
        } message]} {
            flashMessage "error: cannot communicate with client $client($socket): $message"
            catch {close $client($socket)}; unset client($socket)
        }
    }

    proc import {} {
        variable socket
        variable source
        variable port
        variable seconds
        variable event

        catch {after cancel $event}
        if {![info exists socket]} {
            if {[catch {set socket [socket -async $source $port]} message]} {
                flashMessage "error: cannot initiate communication with server $source: $message"
                set event [after [milliseconds] peer::import]                                    ;# retry connecting to server later
            } else {
                fconfigure $socket -blocking 0 -encoding utf-8
                fileevent $socket readable peer::imported
                import                                                                                       ;# register with server
            }
        } elseif {[catch {puts $socket {}; flush $socket} message]} {
            flashMessage "error: cannot communicate with server $source: $message"
            catch {fileevent $socket readable {}}; catch {close $socket}; unset -nocomplain socket
            set event [after [milliseconds] peer::import]                                        ;# retry connecting to server later
        }
    }

    proc imported {} {
        variable socket
        variable data
        variable pattern
        variable source
        variable seconds
        variable event

        set line {}
        if {[catch {set end [eof $socket]} error] || $end} {
            set message "error: connection to server $source broken"
            if {![info exists end]} {append message ": $error"}
        }
        if {[catch {set line [gets $socket]} error]} {
            set message "error: data retrieval from server $source: $error"
        }
        if {[info exists message]} {                                                               ;# report unexpected event if any
            flashMessage $message
            catch {fileevent $socket readable {}}; catch {close $socket}; unset -nocomplain socket
            set event [after [milliseconds] peer::import]                                        ;# retry connecting to server later
        } else {
            milliseconds 0                                                                             ;# communicating: reset timer
        }
        array unset data $pattern(data); array unset data $pattern(type)                                  ;# perform a brutal update
        array set data [regsub -all \v $line \n]
        updated [array get data $pattern(data)]
        incr data(updates)
    }

    proc clear {} {                                                                     ;# and update, used from core in import code
        variable data
        variable pattern

        array unset data $pattern(data); array unset data $pattern(type)
        incr data(updates)
    }

}
