Tcl/Tk
Curso On-Line de Programação

Tratando erros

O mecanismo de tratamento de erros de Tcl, é extremamente simples: todo código que precise ser testado quanto a ocorrência de erros deve ser executado no interior de um comando catch.

A sintaxe geral de catch é a seguinte:
  

set Erro [catch {
    ...comandos Tcl...
} Mensagem]


A variável Erro acima conterá um valor diferente de 0, caso algum erro ocorra durante a execução do script, e a variável Mensagem, conterá a mensagem de erro retornada pelo interpretador Tcl. O uso do comando catch evita que, na ocorrência de um erro, a execução do programa seja interrompida e uma mensagem de erro do interpretador seja exibida ao usuário do programa.

Os principais comandos para tratamento de erros são:
 

Comando Descrição
return [-code código][-errorinfo informação] [-errorcode código] [string] Retorna do procedimento atual, passando, opcionalmente, ao interpretador Tcl, um código de retorno, uma informação sobre o erro, um código de erro e uma string de retorno.
error mensagem [informação] [código] Interrompe a execução do script, retornando a mensagem de erro especificada, e configurando as variaveis globais errorInfo e errorCode com os valores especificados por informação e código.
catch script [variável] Avalia o script especificado, armazenando o resultado na variável indicada. Caso um erro ocorra, catch retornará um valor diferente de 0 e a mensagem de erro será armazenada na variável especificada..

Exemplo
 

O programa a seguir permite o envio e o recebimento de arquivos em formato texto pela porta serial do microcomputador. O script é compatível com o Linux e o Windows.
Observação: para executar este programa no RedHat Linux 7.1, será preciso compilar e instalar o interpretador Tcl 8.3, pois a versão do Tcl 8.3, distribuída no RH 7.1 contém um bug que impede o acesso à porta serial.
  

#
# RCS: @(#) $Id: tkserial.tcl,v 1.0 2001/07/25 14:48:00 monteiro Exp $
#
# Copyright (c) 2001 Roberto Luiz Souza Monteiro.
#
# Este programa e distribuido nos termos da licenca GNU GPL.
#
# A proxima linha reinicializa usando o wish \
exec wish8.3 "$0" "$@"
global serialport filename statusvar err
# Inicializa as variaveis globais.
set serialport 1
set filename ""
set statusvar "Copyright (C) 2001 by Roberto Luiz Souza Monteiro"
set err 0
namespace eval tkserial:: {
    variable handle ""
    variable port "/dev/ttyS0"
    variable baund 19200
    variable parity "n"
    variable data 8
    variable stop 1
    variable timetowait 5000
    variable timeout 0
}
# tkserial::openport
#     Abre e configura a porta serial.
#
# Resultados:
#     0 se a operacao for concluida com exito.
proc tkserial::openport {} {
    variable handle
    variable port
    variable baund
    variable parity
    variable data
    variable stop
 
    # Abre e configura a porta serial.
    set Result [catch {
        set handle [open $port r+]
        fconfigure $handle -blocking 0 -translation binary -mode "$baund,$parity,$data,$stop"
    }]
 
    return $Result
}
# tkserial::closeport
#     Fecha a porta serial.
#
# Resultados:
#     0 se a operacao for concluida com exito.
proc tkserial::closeport {} {
    variable handle
 
    # Fecha a porta serial.
    set Result [catch {
        close $handle
    }]
 
    set handle ""
 
    return $Result
}
# tkserial::putstring
#     Envia uma string para a porta serial.
#
# Argumento:
#     String    String a ser enviada.
proc tkserial::putchar {{Char ""}} {
    variable handle
 
    # Envia a string para a porta serial.
    puts -nonewline $handle $Char
    flush $handle
}
# tkserial::getchar
#     Recebe um byte da porta serial.
#
# Resultados:
#     Byte recebido.
proc tkserial::getchar {} {
    variable handle
    variable timetowait
 
    # Aguarda, time milisegundos, por um byte vindo da porta serial.
    set Byte ""
 
    set Begin [clock clicks -milliseconds]
 
    while {[expr [clock clicks -milliseconds] - $Begin] < $timetowait} {
        set Byte [read $handle 1]
 
        if {[string length $Byte] == 1} {
            break
        }
    }
 
    return $Byte
}
# tkserial::receivefile
#     Recebe um arquivo pela porta serial.
#
# Argumentos:
#     File    Nome do arquivo a ser recebido.
proc tkserial::receivefile {{File ""}} {
    global statusvar
 
    variable timeout
 
    set timeout 0
 
    set Size 0
 
    set Result [catch {
        set Handle [open $File w]
        fconfigure $Handle -translation binary
    }]
    if {$Result != 0} {
        set statusvar "ERRO: Nao foi possivel abrir o arquivo $File"
 
        return
    }
 
    set Byte ""
    set Byte [tkserial::getchar]
 
    if {[string length $Byte] == 0} {
        set timeout 1
 
        flush $Handle
        close $Handle
 
        # Exibe uma mensagem de erro.
        set statusvar "ERRO: TIMEOUT"
 
        return
        # Se for recebido o caractere de inicio de transmissao STX,
        # confirma o recebimento.
    } elseif {$Byte == "\x02"} {
        # Confirma o recebimento, enviando o caractere ENQ.
        putchar "\x05"
    } else {
        flush $Handle
        close $Handle
 
        # Exibe uma mensagem de erro.
        set statusvar "ERRO: Protocolo invalido"
 
        return
    }
 
    set Continue 1
 
    while {$Continue} {
        set Byte ""
        set Byte [tkserial::getchar]
 
        # Se nenhum caractere for recebido, ocorreu um time out.
        if {[string length $Byte] == 0} {
            set timeout 1
 
            # Exibe uma mensagem de erro.
            set statusvar "ERRO: TIMEOUT"
            update
 
            # Finaliza a recepcao de caracteres.
            break
        # Se for recebido o caractere de fim de transmissao ETX, finaliza a recepcao de caracteres.
        } elseif {$Byte == "\x03"} {
            # Confirma o recebimento, enviando o caractere ENQ.
            putchar "\x05"
 
            # Exibe a mensagem recepcao concluida.
            set statusvar "OK: Recebidos $Size bytes."
            update
 
            break
        # Salva o caractere recebido.
        } else {
            catch [incr Size]
 
            set statusvar "BYTE: $Size"
            update
 
            # Confirma o recebimento, enviando o caractere ENQ.
            putchar "\x05"
 
            puts -nonewline $Handle $Byte
        }
    }
 
    flush $Handle
    close $Handle
}
# tkserial::sendfile
#     Envia um arquivo para a porta serial.
#
# Argumentos:
#     File    Nome do arquivo a ser enviado.
proc tkserial::sendfile {{File ""}} {
    global statusvar
 
    variable timeout
 
    set timeout 0
 
    set Size 0
 
    set Result [catch {
        set Handle [open $File r]
        fconfigure $Handle -translation binary
    }]
 
    if {$Result != 0} {
        set statusvar "ERRO: Nao foi possivel abrir o arquivo $File"
 
        return
    }
 
    # Envia o caractere de inicio de transmissao ETX.
    putchar "\x02"
 
    # Aguarda a confirmacao do recebimento.
    set Byte ""
    set Byte [tkserial::getchar]
 
    if {[string length $Byte] == 0} {
        set timeout 1
 
        close $Handle
 
        # Exibe uma mensagem de erro.
        set statusvar "ERRO: TIMEOUT"
 
        return
        # Se o coletor nao enviar um caractere ENQ, confirmando o recebimento,
        # cancela a transmissao.
    } elseif {$Byte != "\x05"} {
        close $Handle
 
        # Exibe uma mensagem de erro.
        set statusvar "ERRO: Protocolo invalido"
 
        return
    }
 
    set Continue 1
 
    while {$Continue} {
        set Char ""
        set Char [read $Handle 1]
 
        if {[eof $Handle] == 1} {
            # Envia o caractere de fim de transmissao ETX.
            putchar "\x03"
 
            set Byte ""
            set Byte [tkserial::getchar]
 
            if {[string length $Byte] == 0} {
                set timeout 1
 
                close $Handle
 
                # Exibe uma mensagem de erro.
                set statusvar "ERRO: TIMEOUT"
 
                break
                # Se o coletor nao enviar um caractere ENQ, confirmando o recebimento,
                # cancela a transmissao.
            } elseif {$Byte == "\x05"} {
                close $Handle
 
                # Exibe a mensagem de fim de transmissao.
                set statusvar "OK: Enviados $Size bytes."
                update
 
                break
            } else  {
                close $Handle
 
                # Exibe uma mensagem de erro.
                set statusvar "ERRO: Protocolo invalido"
 
                break
            }
        }
 
        catch [incr Size]
 
        set statusvar "BYTE: $Size"
        update
 
        putchar $Char
 
        # Aguarda a confirmacao do recebimento.
        set Byte ""
        set Byte [tkserial::getchar]
 
        if {[string length $Byte] == 0} {
            set timeout 1
 
            break
            # Se o coletor nao enviar um caractere ENQ, confirmando o recebimento,
            # cancela a transmissao.
        } elseif {$Byte != "\x05"} {
            close $Handle
 
            break
        }
    }
}
# tkserial::creategui
#     Cria a interface com o usuario.
proc tkserial::creategui {} {
    global tk_strictMotif serialport filename statusvar
 
    set tk_strictMotif 0;
 
    wm withdraw .
 
    if {[winfo exists .tkserial] == 1} {
        return
    }
 
    toplevel .tkserial
 
    wm title .tkserial "TkSerial - Aplicativo para transferencia de arquivos"
 
    # Configura a acao que sera executada quando o usuario clicar
    # no botao fechar da janela.
    wm protocol .tkserial WM_DELETE_WINDOW {tkserial::exitapp}
 
    # Cria os paines.
    frame .tkserial.frame1 -borderwidth 2 -relief ridge
    frame .tkserial.frame2 -relief flat
    frame .tkserial.frame3 -borderwidth 2 -relief ridge
 
    # Cria os botoes de radio.
    radiobutton .tkserial.frame1.com1 -text "COM1" -value 0 -variable serialport -command {tkserial::init}
    radiobutton .tkserial.frame1.com2 -text "COM2" -value 1 -variable serialport -command {tkserial::init}
    radiobutton .tkserial.frame1.com3 -text "COM3" -value 2 -variable serialport -command {tkserial::init}
    radiobutton .tkserial.frame1.com4 -text "COM4" -value 3 -variable serialport -command {tkserial::init}
 
    # Cria os botoes.
    button .tkserial.frame2.send -text "Enviar" -foreground red -width 10 -command {tkserial::send}
    button .tkserial.frame2.receive -text "Receber" -foreground blue -width 10 -command {tkserial::receive}
    button .tkserial.frame2.exit -text "Sair" -underline 3 -width 10 -command {tkserial::exitapp}
 
    # Cria a barra de status.
    label .tkserial.frame3.status -justify left -anchor w -background black -foreground green -textvariable statusvar
 
    # Dispoe os widgets na tela.
    pack .tkserial.frame1 -side top -expand 1 -fill x
    pack .tkserial.frame2 -side top -pady 10 -anchor center
    pack .tkserial.frame3 -side top -expand 1 -fill x
 
    pack .tkserial.frame1.com1 -side left
    pack .tkserial.frame1.com2 -side left
    pack .tkserial.frame1.com3 -side left
    pack .tkserial.frame1.com4 -side left
 
    pack .tkserial.frame2.send -side left
    pack .tkserial.frame2.receive -side left
    pack .tkserial.frame2.exit -side left
 
    pack .tkserial.frame3.status -side left -expand 1 -fill x
 
    update
 
    # Obtem as dimensoes da janela e da tela.
    set W [winfo width .tkserial]
    set H [winfo height .tkserial]
    set X [expr ([winfo screenwidth .tkserial] - $W) / 2]
    set Y [expr ([winfo screenheight .tkserial] - $H) / 2]
 
    set Geometry ""
 
    append Geometry $W x $H + $X + $Y
 
    # Reposiciona a janela.
    wm geometry .tkserial $Geometry
 
    # Cria os eventos.
    bind .tkserial <Key-Alt_L><Key-r> {.tkserial.frame2.exit invoke}
 
    bind .tkserial.frame1.com1 <Enter> {set statusvar "Seleciona a porta serial"}
    bind .tkserial.frame1.com1 <Leave> {set statusvar ""}
    bind .tkserial.frame1.com2 <Enter> {set statusvar "Seleciona a porta serial"}
    bind .tkserial.frame1.com2 <Leave> {set statusvar ""}
    bind .tkserial.frame1.com3 <Enter> {set statusvar "Seleciona a porta serial"}
    bind .tkserial.frame1.com3 <Leave> {set statusvar ""}
    bind .tkserial.frame1.com4 <Enter> {set statusvar "Seleciona a porta serial"}
    bind .tkserial.frame1.com4 <Leave> {set statusvar ""}
 
    bind .tkserial.frame2.send <Enter> {set statusvar "Envia um arquivo para o receptor"}
    bind .tkserial.frame2.send <Leave> {set statusvar ""}
 
    bind .tkserial.frame2.receive <Enter> {set statusvar "Recebe um arquivo do transmissor"}
    bind .tkserial.frame2.receive <Leave> {set statusvar ""}
 
    bind .tkserial.frame2.exit <Enter> {set statusvar "Fecha o aplicativo"}
    bind .tkserial.frame2.exit <Leave> {set statusvar ""}
 
    bind .tkserial.frame3.status <Enter> {set statusvar "Copyright (C) 2001 by Roberto Luiz Souza Monteiro"}
    bind .tkserial.frame3.status <Leave> {set statusvar ""}
}
# tkserial::send
#     Envia os dados pela porta serial.
proc tkserial::send {} {
    global filename statusvar err
 
    # Desativa os botoes.
    .tkserial.frame2.send configure -state disabled
    .tkserial.frame2.receive configure -state disabled
 
    # Obtem o nome do arquivo.
    set filename [tk_getOpenFile -title "Abrir Arquivo" -initialfile $filename -filetypes {{{Arquivos Texto} {.txt}} {{Tabelas CSV} {.csv}} {{Todos os Arquivos} *}}]
 
    # Verifica o nome de arquivo.
    if {[string length $filename] == 0} {
        set statusvar "ERRO: Nome de arquivo invalido"
 
        # Ativa os botoes.
        .tkserial.frame2.send configure -state normal
        .tkserial.frame2.receive configure -state normal
 
        return
    }
 
    set Option [tk_messageBox -title "Enviar Arquivo" -message "Prepare o receptor para receber o arquivo:\n$filename,\n\e clique no botao OK." -icon warning -type okcancel]
 
    if {$Option == "cancel"} {
        set statusvar "Operacao cancelada"
 
        # Ativa os botoes.
        .tkserial.frame2.send configure -state normal
        .tkserial.frame2.receive configure -state normal
 
        return
    }
 
    # Verifica a porta serial.
    if {$err != 0} {
        set statusvar "ERRO: Nao foi possivel abrir a porta serial $tkserial::port"
 
        # Ativa os botoes.
        .tkserial.frame2.send configure -state normal
        .tkserial.frame2.receive configure -state normal
 
        return
    } else {
        tkserial::sendfile $filename
    }
 
    # Ativa os botoes.
    .tkserial.frame2.send configure -state normal
    .tkserial.frame2.receive configure -state normal
}
# tkserial::receive
#     Recebe os dados do coletor.
proc tkserial::receive {} {
    global filename statusvar err
 
    # Desativa os botoes.
    .tkserial.frame2.send configure -state disabled
    .tkserial.frame2.receive configure -state disabled
 
    # Obtem o nome do arquivo.
    set filename [tk_getSaveFile -title "Salvar Arquivo" -initialfile $filename -filetypes {{{Arquivos Texto} {.txt}} {{Tabelas CSV} {.csv}} {{Todos os Arquivos} *}}]
 
    # Verifica o nome de arquivo.
    if {[string length $filename] == 0} {
        set statusvar "ERRO: Nome de arquivo invalido"
 
        # Ativa os botoes.
        .tkserial.frame2.send configure -state normal
        .tkserial.frame2.receive configure -state normal
 
        return
    }
 
    set Option [tk_messageBox -title "Receber Arquivo" -message "Prepare o transmissor para enviar o arquivo:\n$filename,\n\e clique no botao OK." -icon warning -type okcancel]
 
    if {$Option == "cancel"} {
        set statusvar "Operacao cancelada"
 
        # Ativa os botoes.
        .tkserial.frame2.send configure -state normal
        .tkserial.frame2.receive configure -state normal
 
        return
    }
 
    # Verifica a porta serial.
    if {$err != 0} {
        set statusvar "ERRO: Nao foi possivel abrir a porta serial $tkserial::port"
 
        # Ativa os botoes.
        .tkserial.frame2.send configure -state normal
        .tkserial.frame2.receive configure -state normal
 
        return
    } else {
        tkserial::receivefile $filename
    }
 
    # Ativa os botoes.
    .tkserial.frame2.send configure -state normal
    .tkserial.frame2.receive configure -state normal
}
# tkserial::exitapp
#     Sai do aplicativo.
proc tkserial::exitapp {} {
    # Fecha a porta serial se ela estiver aberta.
    if {[string length $tkserial::handle] != 0} {
        tkserial::closeport
    }
 
    # Encerra o aplicativo.
    exit
}
# tkserial::init
#     Abre a comunicacao serial.
proc tkserial::init {} {
    global tcl_platform
    global serialport statusvar err
 
    if {$tcl_platform(platform) == "unix"} {
        if {$serialport == 0} {
            set tkserial::port "/dev/ttyS0"
        } elseif {$serialport == 1} {
            set tkserial::port "/dev/ttyS1"
        } elseif {$serialport == 2} {
            set tkserial::port "/dev/ttyS2"
        } elseif {$serialport == 3} {
            set tkserial::port "/dev/ttyS3"
        }
    } elseif {$tcl_platform(platform) == "windows"} {
        if {$serialport == 0} {
            set tkserial::port "com1:"
        } elseif {$serialport == 1} {
            set tkserial::port "com2:"
        } elseif {$serialport == 2} {
            set tkserial::port "com3:"
        } elseif {$serialport == 3} {
            set tkserial::port "com4:"
        }
    } else  {
        set statusvar "ERRO: Sistema operacional nao suportado"
 
        return
    }
 
    # Fecha a porta serial se ela estiver aberta.
    if {[string length $tkserial::handle] != 0} {
        tkserial::closeport
    }
 
    # Tenta abrir a porta serial.
    if {[tkserial::openport] != 0} {
        set statusvar "ERRO: Nao foi possivel abrir a porta serial $tkserial::port"
        set err 1
 
        return
    } else  {
        set statusvar "OK: Porta serial $tkserial::port aberta"
        set err 0
 
        return
    }
}
tkserial::init
tkserial::creategui
Para uma descrição detalhada de todas as funções para tratamento de erros, consulte a documentação on-line, ou o Tcl/Tk Reference Guide, ou ainda o Tcl/Tk Electronic Reference.

Para maiores informações envie e-mail para info@souzamonteiro.com.

http://www.souzamonteiro.com
info@souzamonteiro.com

Copyright(C) 2001 by Roberto Luiz Souza Monteiro