OriginalBugID: 1366 Bug
Version: 8.0.4
SubmitDate: '1999-03-02'
LastModified: '1999-09-13'
Severity: CRIT
Status: Closed
Submitter: pat
ChangedBy: hobbs
RelatedBugIDs: 1454
OS: Windows NT
OSVersion: 4.0 SP 3
Machine: X86
ClosedDate: '1999-09-13'
Name:
Steven Sokol
Extensions:
odbctcl80.dll
CustomShell:
None
ReproducibleScript:
set IVRDB {}
set CurValue {}
set Channel_Number {SIM}
set version [join [split $tcl_version .] {}]
load odbctcl$version.dll
wm title . "Stratagy Simulator"
frame .top -borderwidth 0
pack .top -side top -fill x
#label .top.title -text "Stratagy Simulator 1.0" -justify center -font system
#pack .top.title -side top
set but [button .top.select -text "Select" -command Select -width 8]
button .top.exec -text "Run" -command Run -width 8
pack .top.select .top.exec -side left -padx 2 -pady 0
label .top.1 -text "SES Script:" -padx 1
entry .top.cmd -width 20 -relief sunken -textvariable tvFileName
pack .top.1 -side left
pack .top.cmd -side left -fill x -expand true
bind .top.cmd <Return> Run
bind .top.cmd <Control-c> Stop
focus .top.cmd
proc Scrolled_Text {f args} {
frame $f
eval {text $f.text -xscrollcommand [list $f.xscroll set] -yscrollcommand [list $f.yscroll set]} $args
scrollbar $f.xscroll -orient horizontal -command [list $f.text xview]
scrollbar $f.yscroll -orient vertical -command [list $f.text yview]
grid $f.text $f.yscroll -sticky news
grid $f.xscroll -sticky news
grid rowconfigure $f 0 -weight 1
grid columnconfigure $f 0 -weight 1
return $f.text
}
set browse(text) [Scrolled_Text .body -width 80 -height 10 -setgrid true]
pack .body -fill both -expand true
set t [Scrolled_Text .eval -width 80 -height 10]
pack .eval -fill both -expand true
$t tag configure prompt -underline true
$t tag configure result -foreground purple
$t tag configure error -foreground red
$t tag configure output -foreground blue
set eval(prompt) "tcl> "
$t insert insert $eval(prompt) prompt
$t mark set limit insert
$t mark gravity limit left
focus $t
set eval(text) $t
bind $t <Return> {EvalTypein ; break}
bind $t <BackSpace> {
if {[%W tag nextrange set 1.0 end] != ""} {
%W delete sel.first sel.last
} elseif {[%W compare insert > limit]} {
%W delete insert-1c
%W see insert
}
break
}
bind $t <Key> {
if [%W compare insert < limit] {
%W mark set insert end
}
}
proc EvalTypein {} {
global eval
set command [$eval(text) get limit end]
$eval(text) insert insert \n
if [info complete $command] {
$eval(text) mark set limit insert
Eval $command
}
}
proc EvalEcho {command} {
global eval
$eval(text) mark set insert end
$eval(text) insert insert $command\n
Eval $command
}
proc Eval {command} {
global eval
$eval(text) mark set insert end
if [catch {$eval(slave) eval $command} result] {
$eval(text) insert insert $result error
} else {
$eval(text) insert insert $result result
}
if {[$eval(text) compare insert != "insert linestart"]} {
$eval(text) insert insert \n
}
$eval(text) insert insert $eval(prompt) prompt
$eval(text) see insert
$eval(text) mark set limit insert
return
}
proc SlaveInit {slave} {
interp create $slave
interp eval $slave {set Channel_Number {SIM}}
interp alias $slave reset {} ResetAlias $slave
interp alias $slave puts {} PutsAlias $slave
interp alias $slave tTrace {} PutsAlias $slave
interp alias $slave cg_connectdb {} cg_connectdbA
interp alias $slave cg_executesql {} cg_executesqlA
interp alias $slave cg_return {} cg_returnA
interp alias $slave cg_playFile {} cg_playFileA
interp alias $slave cg_collectDtmf {} cg_collectDtmfA
interp alias $slave pValue {} pValueA
return $slave
}
proc ResetAlias {slave} {
interp delete $slave
SlaveInit $slave
}
proc PutsAlias {slave args} {
if {[llength $args] > 3} {
error "invalid arguments"
}
set newline "\n"
if {[string match "-nonewline" [lindex $args 0]]} {
set newline ""
set args [lreplace $args 0 0]
}
if {[llength $args] == 1} {
set chan stdout
set string [lindex $args 0]$newline
} else {
set chan [lindex $args 0]
set string [lindex $args 1]$newline
}
if [regexp (stdout|stderr) $chan] {
global eval
$eval(text) mark gravity limit right
$eval(text) insert limit $string output
$eval(text) see limit
$eval(text) mark gravity limit left
} else {
puts -nonewline $chan $string
}
}
#set eval(slave) [SlaveInit shell]
proc Run {} {
global tvFileName eval
set eval(slave) [SlaveInit shell]
EvalEcho [list source $tvFileName]
}
proc Log {} {
global input log
if [eof $input] {
Stop
} else {
gets $input line
$log insert end $line\n
$log see end
}
}
proc Stop {} {
global input but
catch {close $input}
$but config -text "Run it" -command Run
}
proc Select {} {
global tvFileName browse
set types {{{TCL Scripts} {.tcl} }}
set sFileName [tk_getOpenFile -filetypes $types -initialdir "C:/Vortec/Bin"]
if {[string length $sFileName] > 0} {
set tvFileName $sFileName
set t $browse(text)
$t config -state normal
$t delete 1.0 end
if [catch {open $sFileName} in] {
$t insert end $in
} else {
$t insert end [read $in]
close $in
}
$t config -state disabled
} else {
set tvFileName {}
}
}
proc tTrace {strValue} {
puts $strValue
}
#####################################################################
# DOS Editing/Testing Functions
#####################################################################
proc tTrace {param} {
puts $param
}
proc cg_connectdbA {DSN} {
global IVRDB
puts "CONNECTING TO DSN: $DSN"
odbc_connect IVRDB $DSN
return "Connected"
}
proc cg_playFileA {file opt wap enc rep} {
global CurValue
toplevel .playFile -height 200 -width 200
wm title .playFile "Play File"
frame .playFile.top
pack .playFile.top -side top
label .playFile.top.fileLabel -text "Audio File:"
entry .playFile.top.fileName -textvariable fName -width 80
pack propagate .playFile false
pack .playFile.top.fileLabel .playFile.top.fileName -side left -padx 2 -pady 2
.playFile.top.fileName insert 0 $file
.playFile.top.fileName configure -state disabled
frame .playFile.padOne -borderwidth 2
pack .playFile.padOne
button .playFile.padOne.bOne -width 4 -height 2 -text "1" -command {pValue "1"}
button .playFile.padOne.bTwo -width 4 -height 2 -text "2" -command {pValue "2"}
button .playFile.padOne.bThree -width 4 -height 2 -text "3" -command {pValue "3"}
pack .playFile.padOne.bOne .playFile.padOne.bTwo .playFile.padOne.bThree -side left
frame .playFile.padTwo -borderwidth 2
pack .playFile.padTwo
button .playFile.padTwo.bFour -width 4 -height 2 -text "4" -command {pValue "4"}
button .playFile.padTwo.bFive -width 4 -height 2 -text "5" -command {pValue "5"}
button .playFile.padTwo.bSix -width 4 -height 2 -text "6" -command {pValue "6"}
pack .playFile.padTwo.bFour .playFile.padTwo.bFive .playFile.padTwo.bSix -side left
frame .playFile.padThree -borderwidth 2
pack .playFile.padThree
button .playFile.padThree.bSeven -width 4 -height 2 -text "7" -command {pValue "7"}
button .playFile.padThree.bEight -width 4 -height 2 -text "8" -command {pValue "8"}
button .playFile.padThree.bNine -width 4 -height 2 -text "9" -command {pValue "9"}
pack .playFile.padThree.bSeven .playFile.padThree.bEight .playFile.padThree.bNine -side left
focus .playFile
#if {$wap == 0} {
# puts "NO RESPONSE NEEDED"
# return "Done"
#} else {
# puts "Enter A Response Digit:"
# gets stdin Digit
# if {[string length $Digit] > 0} {
# return "Digit$Digit"
# } else {
# return "Done"
# }
#}
while {[string length $CurValue] < 1} {
vwait CurValue
destroy .playFile
return "Digit$CurValue"
}
}
proc cg_executesqlA {statement} {
global sqlres
set ret_list {}
set full_list {}
puts "SQL STATEMENT: $statement"
if [catch "IVRDB execdirect \$statement" msg] {
puts "error: $msg\n"
return "Error"
} else {
puts "cg_executesql Result = $msg\n"
if {[lindex $msg 0] > 0} {
# Convert sqlres Array Into List
lappend full_list $sqlres(0,1)
for {set row 1} {$row <= [lindex $msg 0]} {incr row} {
for {set col 1} {$col <= [lindex $msg 1]} {incr col} {
lappend ret_list $sqlres($row,$col)
}
lappend full_list $ret_list
unset ret_list
}
return $full_list
} else {
return "1"
}
}
}
proc cg_collectDtmfA {max term silence inter cb ca} {
puts "DIGIT COLLECTION - ENTER UP TO $max DIGITS:"
gets stdin Digits
return "Collected $Digits"
}
proc cg_returnA {args} {
puts "END OF APPLICATION"
}
proc Beep {} {
puts "BEEP!"
}
proc cg_recordFile {path option wait encode} {
puts "RECORDING FILE $path PRESS ENTER TO CONTINUE"
gets stdin junk
return {}
}
proc play_money {amount args} {
puts "PLAY MONEY VALUE: \$$amount"
return {}
}
proc play_number {number} {
puts "PLAY NUMBER VALUE: $number"
return {}
}
proc play_alphanum {cvals} {
puts "PLAY ALPHANUM: " $cvals
return {}
}
proc pValue {Num} {
global CurValue
set CurValue "$CurValue$Num"
}
#####################################################################
ObservedBehavior:
The above script is a simulator for an IVR system we have using TCL as the script language. I feed it a script that calls the oddly named cg_playFile command which can see calls back to the main interp though an alias.
When I select a button in the toplevel which pops up when I call cg_playFileA, the system sometimes (every other time) throws a fit.
Sometimes this gets an "Unrecognized op code 76" message. Somtimes it gets "WISH FATAL ERROR: TclExecuteByteCode Execution Failure: end stack top != start stack top. Occasionally I even get a GPF or IPF from NT.
DesiredBehavior:
The system should simply destroy the window and return the digit value entered with the "Digit" string prepended.
