# $Header: /usr/cvsroot/dotNET/GemEqApp/SecsEquip.tcl,v 1.2 2004/10/13 18:34:21 hume Exp $
#
# Tcl support code for the .NET Equipment SECS interface example
#
# Some of the logic for SECS equipment should not be used for Hosts since
# it allows for Spooling and Control State behavior.
#
# $Log: SecsEquip.tcl,v $
# Revision 1.2  2004/10/13 18:34:21  hume
# Changes to accomodate common use with SecsHost.
#
# Revision 1.1.1.1  2004/09/07 19:03:13  hume
# First checkin.
#


######################################### SecsEquip_new ##################################
######################################### SecsEquip_new ##################################
######################################### SecsEquip_new ##################################
# construct a Tcl SECS Equipment interface
# initially communication is disabled so the caller can setup configuration
# 
# assumes ServerStart was called 
#    * to call dmh_import to bring dmh package commands into global namespace
#    * to initialize DMH communication
#    * to create most of the in-memory SQL table schema
#    * to setup the auto_path to find Tcl code files including this one
#    * to setup forwarding of Spooling alerts and Tcl Background errors
#
# has some initialization logic similar to "gemsim" startup
# and also is similar to eq_init in file equip.tcl
# Has differences to better integrate .NET control with DMH messaging
#
# Sets up default DEVID, MDLN, SOFTREV values which are updated before going online
#
proc SecsEquip_new {spname port hsms passive host_or_ip} {
    global $spname
    # during development this could get called extra times
    catch {$spname close}

    set ${spname}(EQUIP) 1		;# play equipment role
    # merged_schema should have been called to create a schema that can be used
    # for either the equipment or host role

    # Parameters and Variables
    eq_var_init $spname    		;# create/reload data items
    # many of the data items are required by GEM but some are just for demonstration
    # here we delete them,  add your own items or changes after this call
    SQL "delete from ei_variable where spname='$spname' and varname like 'Demo%'"
    
    # Alarm definitions - none - add your own
    # initialize the reporting mechanism
    eq_alarmtab_init $spname

    # install standard GEM events - add your own event types
    eq_eventtab_init $spname

    # initialize/restore the spooling state
    eq_spool_init $spname

    # subscribe to operator initiated ECV changes to send the event 
    #  "Operator Equipment Constant Change" (4020) (file gem/equip/eq_variables.tcl)
    eq_var_ECVsub_init $spname
    # subscribe to host initiated changes of ECV's to forward them as DMH messages
    # (eq_server_ECV_update is in file gem/equip/eq_server.tcl)
    SQL "open sub eq_server_${spname} to ei_variable proc=eq_server_ECV_update\
 update varvalue where varclass='ECV' and spname='$spname'"

    # allow TRACE Reports S6F1 (comment out next line to disallow) 
    eq_trace_startup $spname

    # temporary startup values for comm and control state
    set ${spname}(comm_state) DISABLED 		
    set ${spname}(control_intent) OFF-LINE	;# OFF-LINE or ON-LINE
    set ${spname}(control_mode) LOCAL		;# LOCAL or REMOTE
    set ${spname}(control_state) {OFF-LINE Equipment}
    # other startup values which may be changed
    set ${spname}(MULT) 1   ;# host can handle multiple transactions

    # monitor various array elements - send messages
    # to a DMH mailbox when the values change
    DMH_trace $spname {state strace rtrace trace comm_state control_state \
 recipe_delete recipe_download recipe_upload \
 spooling_state SpoolCountActual SpoolMax SpoolCountTotal SpoolStreamFns} ${spname}_STATE

    # listen for Tcl commands
    # the .NET logic executes procedures to send SECS messages and control us.
    # you can also use the inspect application for debugging
    mbx whenmsg ${spname}_RPC mbx_RPC

    # listen for SQL commands (see Datahub docs) 
    # this lets you examine the in-memory table data remotely using the hubclient application
    mbx whenmsg ${spname}_SQL {mbx whenmsg again ; gs_execute $mbxdest $mbxmsg $mbxreply}

    # open a subscription to advise of host inititated parameter changes
    SQL "open sub eq_server_${spname} to ei_variable proc=eq_server_ECV_update\
 update varvalue where varclass='ECV' and spname='$spname'"

    # call eq_init with dummy values for MDLN, SOFTREV and devid
    # we will change these before going online
    set MDLN $spname
    set SOFTREV 1.0
    set DEVID 0
    # for HSMS $port is a socket port, 5555 or similar
    # for serial communication $port is "com1" or similar 
    if { $passive } {set host_or_ip {}} 
    eq_init $spname $port $MDLN $SOFTREV $passive $host_or_ip $DEVID

    # for HSMS passive, $host_or_ip can be one of our hostnames, one or our IP addresses
    # or an empty string for our default network interface
    # It should not be the hostname of the active client.

    # for HSMS active, $host_or_ip is the hostname of the passive client (the host)
    return $spname
    }


################################## SecsEquip_delete ######################
################################## SecsEquip_delete ######################
################################## SecsEquip_delete ######################
#
# If you are dynamically instantiating and deleting SECS interfaces
# it becomes important to do a good cleanup job.
# Its not important for applications that provide a static set of 
# interfaces for the life of the application.
#
proc SecsEquip_delete {spname} {
    global $spname DMH_trace_lasttime
    SQL "close sub eq_server_${spname} to ei_variable"
    SQL "close sub ECV_monitor_${spname} to ei_variable"
    # cleanup data
    foreach table {ei_alarm ei_event ei_event_report\
 ei_report ei_spool_data ei_trace_active ei_variable} {
        SQL "delete from $table where spname='$spname'"
        }
    catch {unset $spname}
    catch {rename eq_custom_online_$spname {}}
    # unregister Tcl receiving
    foreach t {RPC SQL} {
        set mailbox ${spname}_${t}
        mbx disarm $mailbox
        mbx flush $mailbox
        mbx close $mailbox
        }
    # using client cancels his own receiving
    # we can make sure there is nothing queued for him
    foreach t {ALERT PARAMETER SECS_RECV STATE VARVALUE XACT} {
        set mailbox ${spname}_${t}
        mbx flush $mailbox
        mbx close $mailbox
        }
    # remove the custom procedure to forward state changes
    catch {rename DMH_trace_${spname}_${spname}_STATE {}}
    # delete the global data we kept to hide redundant messages
    foreach sub [array names DMH_trace_lasttime ${spname},*] {
        unset DMH_trace_lasttime($sub)
        }
    }

    
################################## eq_send ###############################
################################## eq_send ###############################
################################## eq_send ###############################
#  
#   Send a SECS message, optionally with a reply requested,
#   and optionally waiting for the reply or transaction failure.
#   This call is integrated with spooling, comm_state, and control_state
#   behavior.  It has the logic of eq_checked_put, secs_xact, and eq_spool_add.
#   We expect that multiblock enquire/grant transactions are not needed for
#   the messages sent by this procedure.  First, they are not required for
#   HSMS.  Second, they are done for event reports S6F11 and S6F13 sent by
#   the Tcl logic using eq_checked_put.  So they are only required for S6F3, 
#   and S6F9 and serial communication.  We don't think you are going to use
#   serial communication and send those messages.
#
#   If asking for a reply is optional for the message type, do not ask
#   for a reply, unless you really intend to wait for as long as T3
#   to receive the reply.  
#
#  possible results - always two item list - return code and data/diagnostic
#  <retcode> <data> ;# description
#    -1      <error message>  ;# not sent - argument error such as bad data format
#                             ;# <error message> starts with "ERROR"
#    -2      DISABLED   ;# not sent - comm is disabled 
#    -3      OFF-LINE   ;# not sent - control state is OFF-LINE and only S1F1, S1F13, and S9FX are sendable
#    -4      DISCARDED  ;# not sent - spooling is active and this message type is not spooled
#                        ;# Usually the connection is down.  But this result can also occur for a
#                        ;# newly established connection before the host has purged or finished 
#                        ;# unloading the spool.
#    -5      BUSY        ;# an eq_send call is currently active - how did you call it again
#                        ;# before the 1st call completed?  You should not see this error.
#
#     1      SPOOLED     ;# spooled for later sending
#                        ;# even if you specify waiting for the reply result you receive this 
#                        ;# instead of the reply if the message is spooled
#              
#     0    SENT_NO_REPLY       ;# sent successfully no reply requested
#     0    SENT_NO_REPLY_WAIT  ;# sent successfully, a reply requested, not waiting for reply
#                  ;#  the reply will be ignored when it arrives
#     0    <reply_tsndata>     ;# sent ok, reply requested and received
#    -6     TIMEOUT     ;# sent, reply requested, no reply, T3 timeout
#    -7     ABORTED     ;# sent ok, F0 abort reply received
#    -8     REJECTED    ;# sent ok, Stream 9 error message "reply"
#
# The spooling possibility ruins controller designs that want to see a reply or get reply data 
# as a synchronous or near-realtime result.  A solution that we promote is to only allow
# spooling message types that you do not care about the reply such
# as alarms and event reports.
#
# For convenient programming, this is a synchronous procedure call -
# you get the outcome as the result of the procedure call.  Most of the
# time, this works fine.  When you get into a T3 timeout situation, 
# there can be 45 seconds or so before the call returns.  What you can
# do and should do, is change the control state to OFF-LINE so other messages
# will not incur a similar wait.  The Tcl server is alive and
# responsive to other SECS messages that arrive while you are waiting
# for this reply.  If you make this call via a DMH message, the Tcl
# server will not receive and process the next DMH messsage sent to the
# same mailbox until this call returns.  This is the normal protection 
# from re-entrant execution of whenmsg handling logic.

proc eq_send {spname stream function reply_wanted tsndata {wait4reply 1}} {
    global $spname
    # intended for primary messages only
    if {!($function & 1)} { return {-1 {ERROR expected primary SECS message (odd function)}}}

    # GEM says if communication is disabled, no messages are to be created, spooled, etc
    if { [set ${spname}(comm_state)] == "DISABLED" } {return {-2 DISABLED}}

    # GEM paragraph 3.3 says that if the control state is OFF-LINE only S1F13, S1F1 and S9FX
    # are initiated.  The Hume Tcl code usually takes care of S1F13, S1F1, to get communications
    # established.  We will not interfere if you are trying to do something custom.
    if { [string first OFF-LINE [set ${spname}(control_state)]] >= 0 } {
        if { !(($stream == 9) || (($stream == 1) && ($function == 1 || $function == 13))) } {
            return {-3 OFF-LINE}
            }
        }
    
    set sfr S${stream}F${function}
    if { $reply_wanted } { 
        append sfr R 
        }\
    else {
        set wait4reply 0
        }
    set sendcallback [list eq_send_cb $reply_wanted $wait4reply]

    if { [info exists ${spname}(result)] && [set ${spname}(result)] == "pending" } {
        # don't expect this because DMH prevents re-entry
        return {-5 BUSY}
        }

    if { [set ${spname}(spooling_state)] == "INACTIVE" } {
        # the usual condition
        # use catch in case of bad arguments
        set rc [catch {
            if { $wait4reply } {
                $spname put $sfr $tsndata $sendcallback -whenreply [list eq_send_reply_cb $spname]
                }\
            else {
                $spname put $sfr $tsndata $sendcallback 
                }
            } text]
        if { $rc } { return [list -1 "ERROR $::errorInfo"] }
        }\
    else {
        # spooling active
        # tell caller if this message is spooled or thrown away
        set reply [eq_spool_add $spname $sfr $tsndata]
        if { $reply == "SPOOLED" } { return {1 SPOOLED}}
        return {-4 DISCARDED}
        }

    set ${spname}(result) pending
    # clear the last receive so that failure mode is discernable
    set ${spname}(lastrSFR) {}
    # now we are waiting for completion of sending or closure of the reply
    vwait ${spname}(result)
    set result [set ${spname}(result)]
    if { $result == "SEND_FAILURE" } {  ;# cannot send it, spool it
        set reply [eq_spool_add $spname $sfr $tsndata]
        if { $reply == "SPOOLED" } { return {1 SPOOLED}}
        return {-4 DISCARDED}
        }
    # the message got sent ok
    if { $result == "RECEIVE_FAILURE" } {
        if { [set ${spname}(lastrSFR)] == ""} {
            # no reply
            return {-6 TIMEOUT}
            }
        if { [string first S9 [set ${spname}(lastrSFR)]] == 0} {
            # stream 9 error message
            return {-8 REJECTED}
            }
        # must have been F0 abort
        return {-7 ABORTED}
        }

    # else return with SENT_NO_REPLY, SENT_NO_REPLY_WAIT or received reply data
    return [list 0 $result]
    }

proc eq_send_cb {reply_wanted wait4reply spname sfr reason description} {
    global $spname
    if { $reason == "send_complete" } {
        if {!$reply_wanted} {
            set ${spname}(result) SENT_NO_REPLY
            return
            }
        if {!$wait4reply} {
            set ${spname}(result) SENT_NO_REPLY_WAIT
            }
        return
        }
    if { $reason == "send_failure" } {
        set ${spname}(result) SEND_FAILURE
        return
        }
    if { $reason == "receive_failure" } {
        set ${spname}(result) RECEIVE_FAILURE
        return
        }
    }

proc eq_send_reply_cb {spname} {
    global $spname
    # reply might be late
    if { [set ${spname}(result)] != "pending" } { return }
    set ${spname}(result) [set ${spname}(lastrmsg)]
    }

################################# eq_clientVarValue ##############################
################################# eq_clientVarValue ##############################
################################# eq_clientVarValue ##############################

# executed as the varmethod for a SECS variable in order to obtain the value
# of the variable from client (.NET) application
# we send the varID, the client logic replies with the value
proc eq_clientVarValue {spname varID} {
    set MB_REPLY ${spname}_XACT
    set MB_VARVALUE ${spname}_VARVALUE
    # mbx_do_xact can return a list of replies - we want 1st reply of the list
    set reply [lindex [mbx_do_xact $MB_VARVALUE $varID $MB_REPLY 20000] 0]
    return $reply
    }