#
# $Log: not supported by cvs2svn $
# Revision 1.6  2001/03/20 22:45:22  emery
# Indented code.
#
# Revision 1.5  2000/03/10 21:32:06  borland
# Fixed bug in APSSendEmail (wasn't getting subject in message).
# Removed duplicate version of APSSendEmail from APSRunControl.tcl
#
# Revision 1.4  1999/08/23 17:52:40  soliday
# Changed update idletasks to update when runcontrol is suspended
#
# Revision 1.3  1999/02/25 16:30:59  soliday
# Replaced exec date with clock command
#
# Revision 1.2  1996/10/11 15:37:58  saunders
# Load process id, not application name.
#
# Revision 1.1  1996/10/10 20:52:02  saunders
# Added Tcl equivalent of APS Run Control C library.
#
# 

proc APSRunControlInitHelp {} {
    return "Usage: APSRunControlInit \[-pv <runcontrolpv>\] \[-description <string>\]\n\t\[-timeout <ms>\]\nInitializes runcontrol session, preventing access by others.\nReturns RUNCONTROL_OK if successful, catchable error otherwise:\nRUNCONTROL_DENIED - someone else is running\nRUNCONTROL_ERROR - unable to access runcontrol record"
}

proc APSRunControlInit {args} {
    global apsRunControlInitialized apsScriptUser apsScriptHost apsScriptDate
    global apsScriptCommand
    set pv ""
    set description ""
    set timeout 5000
    APSStrictParseArguments {pv description timeout}

    set pvnameVAL ${pv}.VAL
    set pvnameHBT ${pv}.HBT
    set pvnameUSER ${pv}.USER
    set pvnameHOST ${pv}.HOST
    set pvnamePID ${pv}.PID
    set pvnameSEM ${pv}.SEM
    set pvnameDESC ${pv}.DESC
    set pvnameSTRT ${pv}.STRT
    set pvnameABRT ${pv}.ABRT
    set pvnameSUSP ${pv}.SUSP
    set pvnameHBTO ${pv}.HBTO
    set pvnameMSG ${pv}.MSG
    set pvnameALRM ${pv}.ALRM
    set pvnameCLR ${pv}.CLR

    # Connect up PVs
    set varList {pvVAL pvHBT pvUSER pvHOST pvPID pvSEM pvDESC pvSTRT pvABRT \
                   pvSUSP pvHBTO pvMSG pvALRM pvCLR}
    set nameList [list $pvnameVAL $pvnameHBT $pvnameUSER $pvnameHOST \
                    $pvnamePID $pvnameSEM $pvnameDESC $pvnameSTRT $pvnameABRT \
                    $pvnameSUSP $pvnameHBTO $pvnameMSG $pvnameALRM $pvnameCLR]
    if {[pv linkw $varList $nameList]} {
        return -code error "RUNCONTROL_ERROR"
    }

    eval global $varList

    #check the permissions
    if {[catch {pv info pvHBT access} access]} {
        return -code error "RUNCONTROL_ERROR"
    }
    if {[lindex [lindex $access 0] 1] != "RW"} {
        return -code error "RUNCONTROL_ERROR"
    }

    # Set heartbeat timeout
    set pvHBT $timeout
    if {[pv putw pvHBT]} {
        return -code error "RUNCONTROL_ERROR"
    }

    # Try to take semaphore by putting a 0. Generates error if unavailable.
    set pvSEM 0
    if {[pv putw pvSEM 5]} {
        return -code error "RUNCONTROL_DENIED"
    }

    # Load record with user, host, pid, start time, and description
    set pvUSER $apsScriptUser
    set pvHOST $apsScriptHost
    set pvSTRT $apsScriptDate
    set pvDESC $description
    set pvPID [pid]
    if {[pv putw {pvUSER pvHOST pvSTRT pvDESC pvPID}]} {
        return -code error "RUNCONTROL_ERROR"
    }
    set apsRunControlInitialized 1
    return -code ok "RUNCONTROL_OK"
}

proc APSRunControlPingHelp {} {
    return "Usage: APSRunControlPing \nPings runcontrol record to keep it from timing out. Checks for abort and\nsuspend. This procedure will block if runcontrol record is suspended,\nalthough the tcl event loop will still be serviced.\nReturns RUNCONTROL_OK if successful, catchable error otherwise:\nRUNCONTROL_TIMEOUT - runcontrol record not pinged within timeout\nRUNCONTROL_ABORT - runcontrol record is requesting that you exit\nRUNCONTROL_ERROR - unable to access runcontrol record"
}
proc APSRunControlPing {} {
    global apsRunControlInitialized

    if {!$apsRunControlInitialized} {
        return -code error "RUNCONTROL_ERROR"
    }

    set varList {pvVAL pvABRT pvSUSP pvHBTO pvPID}

    eval global $varList

    if {[pv getw $varList]} {
        return -code error "RUNCONTROL_ERROR"
    }
    if {![string compare $pvABRT Abort]} {
        return -code error "RUNCONTROL_ABORT"
    } elseif {![string compare $pvHBTO Timeout]} {
        return -code error "RUNCONTROL_TIMEOUT"
    } elseif {![string compare $pvSUSP Suspend]} {
        while {![string compare $pvSUSP Suspend]} {
            after 1000
            update
            if {[pv getw {pvABRT pvSUSP pvPID}]} {
                return -code error "RUNCONTROL_ERROR"
            }
            if {![string compare $pvABRT Abort]} {
                return -code error "RUNCONTROL_ABORT"
            } elseif {[string compare $pvPID [pid]]} {
                return -code error "RUNCONTROL_ERROR"
            }
        }
    } elseif {[string compare $pvPID [pid]]} {
        return -code error "RUNCONTROL_ERROR"
    }
    
    # No suspend, abort, or timeout. So ping the record
    set pvVAL 1
    if {[pv putw pvVAL]} {
        return -code error "RUNCONTROL_ERROR"
    }
    return -code ok "RUNCONTROL_OK"
}

proc APSRunControlLogMessageHelp {} {
    return "Usage: APSRunControlLogMessage \[-message <string>\] \[-severity <integer>\]\nWhere <integer> corresponds to EPICS alarm severities\n0 - NO_ALARM\n1 - MINOR_ALARM\n2 - MAJOR_ALARM\n3 - INVALID_ALARM\nReturns RUNCONTROL_OK if successful, catchable error otherwise:\nRUNCONTROL_ERROR - unable to access runcontrol record"
}

proc APSRunControlLogMessage {args} {
    global apsRunControlInitialized pvMSG pvALRM

    if {!$apsRunControlInitialized} {
        return -code error "RUNCONTROL_ERROR"
    }
    set message ""
    set severity 0
    APSStrictParseArguments {message severity}

    set pvMSG $message
    set pvALRM $severity

    if {[pv putw {pvMSG pvALRM}]} {
        return -code error "RUNCONTROL_ERROR"
    }
    return -code ok "RUNCONTROL_OK"
}

proc APSRunControlExitHelp {} {
    return "Usage: APSRunControlExit\nCleans up open runcontrol session\nReturns RUNCONTROL_OK if successful, catchable error otherwise:\nRUNCONTROL_ERROR - unable to access runcontrol record"
}
proc APSRunControlExit {} {
    global apsRunControlInitialized

    if {!$apsRunControlInitialized} {
        return -code error "RUNCONTROL_ERROR"
    }
    set varList {pvVAL pvHBT pvUSER pvHOST pvPID pvSEM pvDESC pvSTRT pvABRT \
                   pvSUSP pvHBTO pvMSG pvALRM}
    eval global $varList
    set pvSEM 1
    if {[pv putw pvSEM]} {
        return -code error "RUNCONTROL_ERROR"
    }
    if {[pv unlink $varList]} {
        return -code error "RUNCONTROL_ERROR"
    }
    set apsRunControlInitialized 0
    return -code ok "RUNCONTROL_OK"
}

