#  $Header: /usr/cvsroot/dotNET/GemEqApp/eq_custom_spool.tcl,v 1.1.1.1 2004/09/07 19:03:13 hume Exp $
#  Based on: /usr/cvsroot/gem/equip/eq_spool.tcl,v 1.12 2004/08/20 19:52:07 hume Exp 
#
# Licensed and Supported Software
# (C)Copyright 2004 Hume Integration Software
# All Rights Reserved
#
# $Log: eq_custom_spool.tcl,v $
# Revision 1.1.1.1  2004/09/07 19:03:13  hume
# First checkin.
#


#
# received S2F43 to control spooling
#
# Spooling does not occur unless turned on by this message.
#
# store list of on messages in variable SpoolStreamFns as SnFm SjFk ...
#    Sn means all primaries in Sn are spooled
# any message type not listed is "off"
# 
# Per the standard, S1 cannot be spooled, secondary messages cannot be spooled
# ALL other primarys can be spooled
#    This sounds flakey since many primaries are realtime and transactional.
#    However, it winds up being needed in the context when the host has
#    come back online and the spool is being unloaded, new messages have
#    to go to the end of the spool file instead of being thrown away, or
#    interrupting the one message transaction at a time requirement.
#    The equipment vendor needs to think twice about offering spooling since
#    there is no control over when the messages are actually delivered.
#    Is your equipment safe today if host replies from messages sent yesterday 
#    are being received?  Maybe you should restrict which messages can be
#    spooled to insure proper process operation.
#  
# Most people only care about the spooling of data reports and alarms:
# S5F1 S6F1 S6F3 S6F9 S6F11 S6F13
# The context of running while the spool is unloading becomes non-important
# for a modern HSMS interface that can unload thousands of messages in
# a few seconds.
#
proc eq_custom_spool_control spname {
    global $spname
    # expect L:m {L:2 {U1 <S>} {L:n {U1 <f1>} ...}} ...
    set onlist ""
    set Lm_reply ""
    set RSPACK "B 0"	;# part of success reply
    set msg [set ${spname}(lastrmsg)]
    set Lm [lindex $msg 0]
    set msg [lreplace $msg 0 0]
    foreach clause $msg {
        rset $clause "L2 {tS Stream} Ln"
        if { $tS != "U1:1" } {
            # cheapest way to make sure $Stream is a number
            eq_S9_reply $spname 7
            return
            }
        if { $Stream == 1 } { 
            set RSPACK "B 1"	;# rejected setup, not allowed
            lappend Lm_reply [list L:3 {U1 1} {B 1} L:0]
            continue
            } 

        ###### CUSTOM - look at (spooling_allow) and match allowed message streams ##########
        ###### spooling_allow - list of S<s> tokens ########### 
        set pattern S${Stream}
        if {[lsearch -exact [set ${spname}(spooling_allow)] $pattern] < 0 } {
            set RSPACK "B 1"	;# reject stream, not allowed
            lappend Lm_reply "L:3 {U1 $Stream} {B 1} L:0"
            continue
            }
        ###############################################################

        if { $Ln == "L:0" } {
            # host wants all primes spooled in this stream
            lappend onlist S${Stream} 
            }\
        else {
            set Ln [lreplace $Ln 0 0]
            foreach fn $Ln {
                vset $fn "tF F"
                # must be number - enforce data type
                if { $tF != "U1:1" } {
                    eq_S9_reply $spname 7
                    return
                    }
                # must be odd
                set one [expr {$F % 2}]
                if { $one != "1" } {
                    set RSPACK "B 1"
                    lappend Lm_reply "L:3 {U1 $Stream} {B 4} {L {U1 $F}}"
                    continue
                    }
                set sfpat S${Stream}F${F}
                # it does not hurt anything if this primary is not sent by this equipment
                # respect that the host wants it spooled
                lappend onlist S${Stream}F${F}
                }
            }
        }
    # if the data was ok, save the new spool specification
    if { $RSPACK == "B 0" } {
        SQL "update ei_variable set varvalue='$onlist' where spname='$spname'\
 and varname='SpoolStreamFns'"
        }
    # now reply
    set reply [list L:2 $RSPACK [concat L $Lm_reply]]
    $spname put S2F44 $reply
    }