puts "Hello, World!"
#----------------------
#----------------------
#||| DRM TCL FILE |||
#----------------------
#----------------------
proc get_name {} {
# Gets the name of the DRM
# Return: the name of the DRM
# Create debug file
set dbg_fp [open "vm_htc_dbg.log" a+]
puts $dbg_fp "TCL HTCONDOR DEBUG: Executing get_name"
close $dbg_fp
return "htcondor"
}
proc is_drm_ready {} {
# Checks that the DRM is setup correctly in the environment
# Returns 1 if DRM is set correctly, 0 otherwise
# Create debug file
set dbg_fp [open "vm_htc_dbg.log" a+]
puts $dbg_fp "TCL HTCONDOR DEBUG: Executing is_drm_ready"
puts $dbg_fp "TCL HTCONDOR DEBUG - is_drm_ready: calling condor_status"
set out [run_command_return_output condor_version]
puts $dbg_fp "TCL HTCONDOR DEBUG - is_drm_ready: output is $out"
close $dbg_fp
return [regexp Condor $out]
}
proc submit_job {job_template} {
# Submits new job
# Parameters: job_template -> Associative array including job specification
# Returns the ID of the submitted job
# Create debug file
set dbg_fp [open "vm_htc_dbg.log" a+]
puts $dbg_fp "TCL HTCONDOR DEBUG - Executing submit_job"
# Prepare arguments and variables
upvar $job_template jt
set args [join [get_htc_args jt]]
set env {}
if { [info exists jt(env)] } {
set env $jt(env)
}
# Run condor_submit
#puts $dbg_fp "TCL HTCONDOR DEBUG - submit_job: calling condor_submit $args $env"
#run_command_return_output condor_submit $args $env
puts $dbg_fp "TCL HTCONDOR DEBUG - submit_job: calling condor_submit /home/baudilio.garcia/sleep.sub"
run_command_return_output condor_submit /home/baudilio.garcia/sleep.sub
#puts $dbg_fp "TCL HTCONDOF DEBUG - submit_job: calling condor_submit $jt"
#run_command_return_output condor_submit $job_template
set out [get_job_id]
puts $dbg_fp "TCL HTCONDOR DEBUG - submit_job: output (job ID) is $out"
close $dbg_fp
return $out
}
proc get_job_status {job_id} {
# Queries the DRM for the job status
# Parameters: job_id -> ID of the job
# Returns job status [UNKNOWN, WAITING, SUSPEND_WAITING, RUNNING, SUSPENDED_RUNNING, COMPLETED, TERMINATED]
# Create debug file
set dbg_fp [open "vm_htc_dbg.log" a+]
puts $dbg_fp "TCL HTCONDOR DEBUG - Executing get_job_status"
append args "-analyze " $job_id
puts $dbg_fp "TCL HTCONDOR DEBUG - get_job_status: calling condor_status $args"
set condor_out [run_command_return_output condor_q $args]
puts $dbg_fp "TCL HTCONDOR DEBUG - get_job_status: output is $condor_out"
close $dbg_fp
return [parse_condor_out $condor_out $job_id]
}
proc set_job_priority {job_id, priority} {
exec [condor_prio -p $priority $job_id]
}
proc terminate_job {job_id} {
exec condor_rm $job_id
}
proc suspend_job {job_id} {
exec condor_hold $job_id
}
proc resume_job {job_id} {
exec condor_continue $job_id
}
proc get_job_exit_code {job_id} {
set bhistout [ condor_history "-l $job_id" ] if { [string first "Job <$job_id>" $bhistout] == -1 } {
error "Unexpected output from bhist -l $job_id:\n$bhistout"
}
if { [string first "Done successfully" $bhistout] != -1 } {
return 0;
}
regexp {Exited with exit code ([0-9]+).} $bhistout m c
if { ! [info exists c] } {
error "Unexpected output from bhist -l $job_id:\n$bhistout"
}
return $c
}
###########################################################
### AUXILIARY PROCEDURES
##########################################################
proc run_command_return_output { cmd {args ""} {env ""}} {
set channel [ open "|/usr/bin/env $env $cmd $args 2>@1" r]
fconfigure $channel -buffering none
set output [read $channel]
close $channel
return $output
}
proc get_job_id {} {
set dbg_fp [open "vm_htc_dbg.log" a+]
puts $dbg_fp "TCL HTCONDOR DEBUG: Executing get_job_id (called by submit_job)"
set test [run_command_return_output condor_q]
set linesx [split $test "\n"]
set out [lindex $linesx 4]
regexp {([0-9]+)\..*} $out m s
if { ![info exists s] } {
puts $dbg_fp "TCL HTCONDOR DEBUG: get_job_id: error due to invalid job id $out from submit_job"
close $dbg_fp error "Unexpected output from condor_q: $out"
}
puts $dbg_fp "TCL HTCONDOR DEBUG - get_job_id: job id is $s"
close $dbg_fp
return $s
}
proc get_htc_args { job_template } {
upvar $job_template jt
set htc_opt {}
# HTCondor executable and options should be inside a command script
set fp [open "vm_cmd_script" w+]
puts $fp "cd \$HTC_O_WORKDIR"
# Set dispatch parameters
if { [info exists jt(dispatch_params)] } {
lappend htc_opt $jt(dispatch_params)
}
# Set job name
if { [info exists jt(name)] } {
lappend htc_opt -N
lappend htc_opt $jt(name)
}
# Set working dir
#if { [info exists jt(dir)] } {
# lappend htc_opt
#}
}
proc parse_condor_out {condor_out job_id} {
set dbg_fp [open "vm_htc_dbg.log" a+]
puts $dbg_fp "TCL HTCONDOR DEBUG: Executing parse_condor_out (called by get_job_status)"
set lines [split $condor_out \n]
set jobexists [regexp Job [lindex $lines 4]]
if { ![info exists jobexists] } {
#if { [llength $lines] < 4 }
puts $dbg_fp "TCL HTCONDOR DEBUG - parse_condor_out_ UNKNOWN due to output of condor_q contains less than 4 lines"
close $dbg_fp
return UNKNOWN
}
if { [regexp [parse_condor_history $job_id] UNKNOWN] == 1 } {
puts $dbg_fp "TCL HTCONDOR DEBUG - parse_condor_out: HTCONDOR job status information is [lindex $lines 4]"
close $dbg_fp
return [condor_status_to_drm_status [lindex $lines 4]]
}else{
puts $dbg_fp "TCL HTCONDOR DEBUG - parse_condor_out: HTCONDOR job status information is [lindex $lines 4]"
puts $dbg_fp "TCL HTCONDOR DEBUG - parse_condor_out: vManager equivalent job status code is [condor_status_to_drm_status [lindex $lines 4]]"
close $dbg_fp
return COMPLETED
}
}
proc parse_condor_history {job_id} {
set dbg_fp [open "vm_htc_dbg.log" a+]
puts $dbg_fp "TCL HTCONDOR DEBUG - Executing parse_condor_history (called by parse_condor_out)"
set output [rum_command_return_output condor_history]
set lines [split $output \n]
if { [llength $lines] < 1 } {
puts $dbg_fp "TCL HTCONDOR DEBUG - parse_condor_history: UNKNOWN due to output of condor_history contains less than 2 lines"
close $dbg_fp
return UNKNOWN
}
set cols [regexp -inline -all -- {\S+} [lindex $lines 1]]
if { [llength $cols] < 6 || [regexp [lindex $cols 0] $job_id] != 1 } {
puts $dbg_fp "TCL HTCONDOR DEBUG - parse_condor_history: UNKNOWN due to output of condor_history contains less than 7 columns or jobID does not exist"
close $dbg_fp
return UNKNOWN
}
puts $dbg_fp "TCL HTCONDOR DEBUG - parse_condor_history: HTCondor job status code is [lindex $cols 4]"
puts $dbg_fp "TCL HTCONDOR DEBUG - parse_condor_history: vManager equivalent job status code is COMPLETED"
close $dbg_fp
if { [regexp [lindex $cols 0] $job_id] == 1 } {
return COMPLETED
}else{
return UNKNOWN
}
}
proc condor_status_to_drm_status { condor_status } {
if { [regexp running $condor_status] } {
return RUNNING
}
if { [info exists [regexp idle $condor_status]] } {
return WAITING
}
if { [info exists [regexp unexpanded $condor_status]] } {
return SUSPEND_WAITING
}
if { [info exists [regexp hold $condor_status]] } {
return SUSPENDED_RUNNING
}
return UNKNOWN
}
Write, Run & Share TCL code online using OneCompiler's TCL online compiler for free. It's one of the robust, feature-rich online compilers for TCL language, running the latest TCL version 8.6. Getting started with the OneCompiler's TCL editor is easy and fast. The editor shows sample boilerplate code when you choose language as TCL and start coding.
OneCompiler's TCL online editor supports stdin and users can give inputs to programs using the STDIN textbox under the I/O tab. Following is a sample TCL program which takes name as input and prints hello message with your name.
set name [gets stdin]
puts "Hello $name"
Tool Command Language(TCL) is a general purpose scripting language which is commonly used for GUIs and for testing. Everything is by default string in TCL. It was created by John Osterhout in 1989.
Variable is a identifier which is used to hold the value. set is used to create variables.
set name onecompiler
When ever you want to perform a set of operations based on a condition IF-ELSE is used.
if(conditional-expression) {
#code
} else {
#code
}
You can also use if-else for nested Ifs and If-Else-If ladder when multiple conditions are to be performed on a single variable.
Switch is an alternative to If-Else-If ladder.
switch(conditional-expression) {
value1 {
# code
}
value1 {
# code
}
...
default {
# code
}
For loop is used to iterate a set of statements based on a condition.
for{start}{test}{next}{
# code
}
While is also used to iterate a set of statements based on a condition. Usually while is preferred when number of iterations are not known in advance.
while(condition) {
# code
}
Array is a collection of similar data which is stored in continuous memory addresses. Array values can be fetched using index. Index starts from 0 to size-1.
set ArrayName(Index) value
Procedure is a sub-routine which contains set of statements. Uusually procedures are required when multiple calls are made to same set of statements. Procedures increases re-usuability and modularity.
proc procedureName {arguments} {
# code
}