Mise en forme de code: pensez à utiliser les balises [ tcl ] et [ /tcl ] (sans les espaces bien sûr) autour de vos codes tcl afin d'avoir un meilleur rendu et une coloration syntaxique. x


Try/Catch: comment gérer ses erreurs facilement.
#1
En Tcl il n'est pas toujours très intuitif et simple de gérer les erreurs, j'ai donc programmé une procédure pour faire cela.

Ce code ne fonctionne qu'avec Tcl 8.5 ! Pour Tcl 8.4 vous pouvez utiliser la librairies mkGeneric (http://mkextensions.sf.net) !


tcl
# try Script ?catch Pattern CatchScript ...? ?catch DefaultCatchScript? ?finally FinallyScript?
#
#   Cette fonction a pour but d'intercepter les erreurs Tcl simplement, lorsque
#   vous utilisez try, le Script est exécuté, s'il génère une erreur il cherche un
#   catchScript correspondant au type d'erreur spécifié dans Pattern en se
#   basant sur une recherche avec des jokers comme string match.
#
#   S'il n'en trouve pas il exécute le DefaultCatchScript, s'il n'est pas
#   spécifié il ignore l'erreur. Puis à la fin il exécute le FinallyScript dans
#   tous les cas (si votre script génère une erreur).
#
#   Si jamais votre CatchScript génère une erreur elle est propagée, si votre
#   FinallyScript génère une erreur elle est propagée en prioritée.
#
#   L'erreur générée par votre Script est stockée dans $::errorMsg, vous possédez
#   donc trois variables pour afficher l'erreur: $::errorMsg, $::errorInfo et
#   $::errorCode.
 
proc try {script args} {
 
    # On parse $args pour sortir un tableau des pattern de catch, $arrayCatchs.
    # Chaque entrée du tableau est un pattern sauf les valeurs _default et
    # _finally qui sont réservées.
 
    set arrayCatchs(_default) [list]
    set arrayCatchs(_finally) [list]
    set foundPattern 0
    set catchErr 0
 
    for {set i 0} {$i <= [llength $args]} {incr i} {
 
        lassign [lrange $args $i [expr {$i + 2}]] current pattern code
 
        if {$current eq "catch"} {
            if { ($code eq "catch") || ($code eq "") || ($code eq "finally")} {
                set arrayCatchs(_default) $pattern
            } else {
                set arrayCatchs($pattern) $code
            }
        }
 
        if {$current eq "finally"} {
            set arrayCatchs(_finally) $pattern
        }
    }
 
    # On exécute le script et on voit s'il retourne une erreur.
    # Si c'est le cas alors on doit regarder si on a un pattern qui correspond
    # au code d'erreur retourné et mettre le script à éxécuté dans $catchScript.
 
    switch -- [catch [list uplevel 1 $script] scriptRes scriptOpt] {
        1 {
            foreach pattern [array names arrayCatchs] {
                if { [string match $pattern [dict get $scriptOpt -errorcode]] } {
                    set catchScript $arrayCatchs($pattern)
                    set foundPattern 1
                }
            }
 
            if {!$foundPattern} {
                set catchScript $arrayCatchs(_default)
            }
 
            set ::errorMsg $scriptRes
        }
        2 {return -code return}
        3 {return -code break}
        4 {return -code continue}
        0 {return -code ok $scriptRes}
    }
 
    # A partir de maintenant, notre script a retourné une erreur, et on a le code
    # a éxécuté en cas d'erreur dans $catchScript. On doit donc éxécuter notre
    # catchScript, s'il retourne une erreur on devra la propager, de même
    # pour continue et break.    
 
    if { [set catchStatus [catch [list uplevel 1 $catchScript] catchRes catchOpt]] } {
        if { $catchStatus eq 1 } {set catchErr 1}
    }
 
    if { [catch [uplevel 1 $arrayCatchs(_finally)] finallyRes finallyOpt] } {
        # En cas d'erreur dans le catch on exécute le finally AVANT de
        # propager l'erreur du catch car si il y a une erreur dans le
        # le finally on doit la propager en prioritée.
        return -options $finallyOpt
    }
 
    if {$catchErr} {
        return -options $catchOpt
    } else {
        switch -- $catchStatus {
            0 {return -code ok $catchRes}
            2 {return -code return}
            3 {return -code break}
            4 {return -code continue}
        }
    }
}
 
# throw ?errorCode? ?errorMsg? ?errorInfo?
#
# Cette commande est identique à error sauf que vous ne spécifiez pas
# les arguments dans le même ordre. Elle est utile utilisée en parralèle avec
# try car vous pouvez spécifiez un code d'erreur spécifique pour try.
# 
 
proc throw {errorCode args} {
    lassign $args errorMsg errorInfo
    return -code error -errorinfo $errorInfo -errorcode $errorCode $errorMsg
}


Exemple:


tcl
try {
   set fileID [open monfichier.txt]
   puts $fileID "LOL"
   close $fileID
} catch {
   puts "Erreur lors de l'écriture dans le fichier: $::errorMsg"
} finally {
   puts "Ce code sera exécuté même si le code dans catch est erroné!"
}


Pour les utilisateurs un peu plus poussé vous pouvez spécifiez des codes d'erreur après le catch comme ceci:


tcl
try {
   expr {100/0}
} catch "ARITH*" {
   puts "Erreur mathématique: $::errorCode ($::errorMsg)"
} catch {
   puts "Autre erreur: $::errorCode ($::errorMsg)"
}


Vous pouvez aussi générez vos propres codes d'erreur avec throw Smile
#2
Wow merci bien, très pratique, surtout que tcl8.5 est passé en version stable de debian (et donc des autres distributions je présume).

Il serait p-e intéressant de mettre ça dans alltools.tcl (en fait, je me crée un espèce de alltools avec les fonctions pratiques et génériques)
irc.zeolia.net - Offrez-moi un café
Merci de ne pas demander d'aide en MP
Away
#3
Fais donc si tu veux, mes codes sont libres Wink
#4
Il me semble que la gestion des exception viendra nativement avec tcl 8.6
#5
Quote:Posté par aliassangelius - 04-06-2010 20:00
j'ai ça moi sinon

t en a pas mare de pomper les codes des autres?
ca viens de mon tcl-bot !!!!
C'est en reconnaissant ses erreurs que l'on progresse ;)
Away
#6
http://www.eggdrop.fr/board/Propriete-de...t-895.html
PS: Perso je rejoins ce qui est dit dans le post.

:)


Possibly Related Threads…
Thread Author Replies Views Last Post
  [Résolu] Commande /plainte pseudo raison gérer par un eggdrop avec un alias Unrealircd Alucard`68 3 3,987 01/02/2017, 03:39
Last Post: Alucard`68
  options - Gérer des paramètres pour les procédures Merwin 0 2,775 15/06/2008, 18:01
Last Post: Merwin

Forum Jump:


Users browsing this thread: 1 Guest(s)