Communauté Eggdrop

# 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
}

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é!"
}

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