Minilog

 

Kroc - 08 Janvier 2009 : une petite extension pour gérer très simplement le déverminage avec la commande "log".

L'extension se compose de 2 fichiers à enregistrer dans un sous-dossier minilog dans un des répertoires de l'auto_path :

pkgIndex.tcl

	package ifneeded minilog 1.0 [list source [file join $dir minilog.tcl]]

minilog.tcl

	################################################################################
	#
	# Système de gestion sommaire des logs.
	#
	# David Zolli - Kroc
	#
	################################################################################
	#
	# Utilisation :
	#
	#	  log ?-nonewline? message
	#
	# Avec les variable globales :
	#
	#	 ::config(debug_level) :
	#			- 0 : aucune sortie
	#			- 1 : génère une sortie
	#
	#	 ::config(debug_out)
	#			- stdout : sortie à l'écran
	#			- autre valeur : sortie dans fichier mouchard
	#
	################################################################################

	package provide minilog 1.0

	# Valeurs par défaut : verbeux
	if {![info exists ::config(debug_level)]} {set ::config(debug_level) 1}
	# ... sur la sortie standard
	if {![info exists ::config(debug_out)]} {set ::config(debug_out) stdout}
	# ... ou un fichier log
	if {![info exists ::config(debug_file)]} {set ::config(debug_file) [file rootname [info name]].log}

	# Redirige les erreurs vers le log :
	proc bgerror {args} {
		catch "log $args"
	}

	# procédure de traitement des logs :
	proc log {args} {
		# Mode verbeux désactivé :
		if {!$::config(debug_level)} { return }
		# stdout ou fichier de log ?
		if {$::config(debug_out) eq "stdout"} {
			# Sortie écran :
			if {[lindex $args 0] eq "-nonewline"} {
				eval puts -nonewline stdout [lrange $args 1 end]
				flush stdout
			} else {
				eval puts stdout $args
				flush stdout
			}
		} else {
			# Sortie fichier :
			set TS [clock format [clock second] -format "%x %X"]
			set fout [open $::config(debug_file) a]
			if {[lindex $args 0] eq "-nonewline"} {
				eval puts -nonewline $fout [lrange $args 1 end]
				flush $fout
			} else {
				puts -nonewline $fout "$TS - "
				eval puts $fout $args
				flush $fout
			}
			close $fout
		}
	}

Catégorie Paquet