gratifiant > comp.lang.* > comp.lang.tcl

christian (21/06/2007, 16h14)
Bonjour,

J'ai écris un bout de code en Tcl qui me permet de rediriger les infos issus
d'un port série vers un port TCP, et inversement. Les comandes reçues sur ce
port TCP sont renvoyées vers le port série.
Seulement voilà, il arrive que mon port série se ferme mal et les commandes
suivantes échouent.

Ci-joint le code en question.

J'aimerais connaître votre avis sur mon code. Peut-être y verrez-vous un pb
ou un moyen de l'améliorer?

Merci

Christian

# Start a socket server for handling device communication requests.
#
#
# Arguments:
# iTcpServerPort listening server's TCP port
#
# Results:
# none
#
proc startServer {iTcpServerPort} {

# Setup a socket server.
socket -server procCallback $iTcpServerPort
puts "started server"
}

#
# Callback procedure which handles a request to initiate a socket
connection.
#
#
# Arguments:
# skt socket connection
# szAddress address of the connecting client
# iPort port of the connecting client
#
# Results:
#
proc procCallback {skt szAddress iPort} {

# Set the buffer mode for the socket to "line".
fconfigure $skt -buffering line -blocking 0

# Setup a file event to listen for messages.
fileevent $skt readable[list procHandleMessages $skt]

# puts $skt "[binary format c6 {255 253 01 255 251 03}] Hello world!"
puts \n
}

#
# Procedure which display messages.on the client and server windows.
#
# Arguments:
# skt socket connection
# msg message to display
#
# Results:
# none
#
proc procDisplayMessages {skt msg} {
puts $msg
flush stdout
catch {puts $skt $msg}
catch {flush $skt}
}

#
# Procedure which processes device messages.
#
# Arguments:
# skt socket connection
#
# Results:
# none
#
proc procHandleMessages {skt} {

global server

# Check for End Of File.
if {[eof $skt]} {
catch {close $skt}
return
}

# process the message: <cmd> <com> <message>
set szMessage [gets $skt]
set cmd [string tolower [lindex $szMessage 0]]
set com [string tolower [lindex $szMessage 1]]
set msg [string tolower [lindex $szMessage 2]]

switch $cmd {
"open" {
# open the serial port
if {$com != "com1" & $com != "com2"} {
procDisplayMessages $skt "Error: serial port should be com1
or com2"
return
}
if {$server(connected)} {
procDisplayMessages $skt "Error: Already connected."
return
}
procDisplayMessages $skt "got open message: $szMessage"
if {![catch {set server($com) [open $com w+]}]} {
fconfigure $server($com) -blocking 0
fconfigure $server($com) -mode 9600,n,8,1
fconfigure $server($com) -buffering none
procDisplayMessages $skt "port $com opened."
set server(connected) 1
} else {
procDisplayMessages $skt "Error: cannot open port $com."
}
}
"send" {
# send the command to the serial port
if {!$server(connected)} {
procDisplayMessages $skt "Error: Open the serial port first:
open <com>"
return
}
if {$com != "com1" & $com != "com2"} {
procDisplayMessages $skt "Error: serial port should be com1
or com2"
return
}
procDisplayMessages $skt "got send message: $szMessage"
if {![info exists server($com)]} {
procDisplayMessages $skt "Error: open serial port first"
return
}
puts $server($com) $msg
flush $server($com)
}
"close" {
# close the serial port
if {!$server(connected)} {
procDisplayMessages $skt "Error: Open the serial port first:
open <com>"
return
}
if {$com != "com1" & $com != "com2"} {
procDisplayMessages $skt "Error: serial port should be com1
or com2"
return
}
if {![info exists server($com)]} {
procDisplayMessages $skt "Error: open serial port first"
return
}
procDisplayMessages $skt "got stop message: $szMessage"
catch { close $server($com); unset server($com)}
procDisplayMessages $skt "port $com closed."
set server(connected) 0
}
"quit" {
# close the serial port
procDisplayMessages $skt "got quit message: $szMessage"
catch { close $server($com) ; unset $server($com) }
catch { close $skt }
set server(connected) 0
}
"help" -
"?" {
# display help message
procDisplayMessages $skt "List of available commands:"
procDisplayMessages $skt "help or ?: display this help message"
procDisplayMessages $skt "open <com>: open the serial port com1
or com2"
procDisplayMessages $skt "send <com> command: send the command
to the serial port"
procDisplayMessages $skt "close <com>: close the serial port"
procDisplayMessages $skt "quit: close the connection to the
server"
}
}
}

# server is created as a global array
set server(version) 1.0
set server(connected) 0

startServer 5000
vwait bStop
David Zolli (22/06/2007, 18h43)
christian a écrit :

> J'aimerais connaître votre avis sur mon code.


C'est très propre et très bien commenté.

> Peut-être y verrez-vous un pb .../... ?


Tu dois corriger tes ET logique (dans tes tests) :

if {$com != "com1" & $com != "com2"} { ...

doit être corrigé en :

if {$com != "com1" && $com != "com2"} { ...

Comme c'est expliqué ici : le "&" simple est un
et bit à bit.

> .../... un moyen de l'améliorer ?


Enlève toutes les instructions catch et tu verras beaucoup mieux d'où
vient le problème (s'il persiste).
christian (28/06/2007, 16h27)
Merci pour les &.
Je me fais avoir chaque fois.

c'est vrai que les "catch" sont pratiques mais n'aide pas au code propre.

Merci

Christian

"David Zolli" <kroc> a écrit dans le message de news:
467bfc17$0$11632$426a34cc...
[..]
Discussions similaires