Page MenuHomeDevCentral
Paste P152

2007 backup - SurfBoard - scripts/OutilsDeDeveloppement.tcl
ActivePublic
Actions

Authored by dereckson on Jan 18 2016, 01:26.
Tags
Referenced Files
F17001: scripts/OutilsDeDeveloppement.tcl
Jan 18 2016, 01:26
Subscribers
None
# .tcl source scripts/OutilsDeDeveloppement.tcl
#########################################################################
# Table des matières, binds #
#########################################################################
bind dcc - strlen dcc:strlen
bind dcc T findtcl dcc:findtcl
bind dcc T printtcl dcc:printtcl
bind dcc T whereis dcc:whereis
unbind dcc n rehash *dcc:rehash
bind dcc T rehash dcc:rehash
unbind dcc n restart *dcc:restart
bind dcc T restart *dcc:restart
#########################################################################
# Affiche la longueur d'une chaîne #
#########################################################################
proc dcc:strlen {h i a} {
putdcc $i [string length $a]
}
#########################################################################
# FIND TCL #
#########################################################################
proc dcc:findtcl {hand idx arg} {
# Localisation des scripts
set repertoireScript "/home/surfboard/eggdrop/scripts"
#Init compteur
set result 0
#Validation d'une chaîne de recherche ou mauvaise configuration
if {$arg == "" || ![file exists $repertoireScript]} {
putdcc $idx "Erreur dans le traitement: .findtcl <chaine de caractère"
putdcc $idx "Le script doit pouvoir rechercher le texte dans un répertoire valide"
putdcc $idx "Pour vous assurer de la validité de la configuration: Voir le code source"
putdcc $idx "de cette fonction."
return 0
}
#Boucle POUR CHAQUE fichier du répertoire scripts
foreach listeFichier [exec ls $repertoireScript] {
if {[string last ".tcl" $listeFichier] > 0} {
#Ouverture du fichier
set fichierTCL [open $repertoireScript/$listeFichier r]
#Initialisation de la position du curseur
set nbLigne 0
#Boucle TANT QUE NON(fin de fichier)
while {![eof $fichierTCL]} {
#Affectation de la ligne du fichier dans une variable de travail
set ligne [gets $fichierTCL]
#Incrémentation du # de ligne (pour une référence)
set nbLigne [expr $nbLigne +1]
#Recherche de la chaîne
if {[string match "*[lrange $arg 0 end]*" $ligne]} {
#Affichage si la recherche est fructueuse
putdcc $idx "Ligne $nbLigne ($ligne) -> $listeFichier"
incr result
}
}
#Fermeture du fichier
close $fichierTCL
} else {
putdcc $idx "Rejet de $listeFichier"
}
}
if {$result == 0} {
putdcc $idx "$arg - aucune occurence trouvée."
}
return 1
}
#########################################################################
# Dans quels TCL est présent la chaîne ? #
#########################################################################
proc dcc:whereis {hand idx arg} {
# Localisation des scripts
set repertoireScript "/home/surfboard/eggdrop/scripts"
#Init compteur
set result 0
#Validation d'une chaîne de recherche ou mauvaise configuration
if {$arg == "" || ![file exists $repertoireScript]} {
putdcc $idx "Erreur dans le traitement: .whereis <chaine de caractère"
putdcc $idx "Le script doit pouvoir rechercher le texte dans un répertoire valide"
putdcc $idx "Pour vous assurer de la validité de la configuration: Voir le code source"
putdcc $idx "de cette fonction."
return 0
}
#Boucle POUR CHAQUE fichier du répertoire scripts
foreach listeFichier [exec ls $repertoireScript] {
if {[string last ".tcl" $listeFichier] > 0} {
set fichierTCL [open $repertoireScript/$listeFichier r]
set occurence_trouvee_dans_ce_fichier 0
#Boucle TANT QUE NON(fin de fichier)
while {![eof $fichierTCL] && !$occurence_trouvee_dans_ce_fichier} {
#Affectation de la ligne du fichier dans une variable de travail
set ligne [gets $fichierTCL]
#Recherche de la chaîne
if {[string match "*[lrange $arg 0 end]*" $ligne]} {
#Affichage si la recherche est fructueuse
putdcc $idx $listeFichier
set occurence_trouvee_dans_ce_fichier 1
incr result
}
}
#Fermeture du fichier
close $fichierTCL
}
}
if {$result == 0} {
putdcc $idx "$arg - aucune occurence trouvée."
}
return 1
}
#########################################################################
# Affiche la ligne __ du script TCL ______ #
#########################################################################
proc dcc:printtcl {handle idx arg} {
if {[llength $arg] != 2} {
putdcc $idx "## Syntaxe : printtcl <script> <ligne>"
return
}
set script "scripts/[lindex $arg 0].tcl"
if {![file exists $script]} {
putdcc $idx "Pas de $script.tcl, fais gaffe aux majuscules ;)"
return
}
putdcc $idx [file_print_line $script [lindex $arg 1]]
return 1
}
#########################################################################
# Pour rehasher, il faut se déconnecter des bases SQL au préalable #
#########################################################################
proc dcc:rehash {handle idx arg} {
sql disconnect
sql2 disconnect
rehash
}
#########################################################################
# Affichage d'un tableau par récursivité #
#########################################################################
bind dcc T printr dcc:printr
proc dcc:printr {handle idx arg} {
global $arg
if {[llength $arg] != 1} {
putdcc $idx "## Syntaxe : printr <tableau>"
return
}
if {![info exists $arg]} {
putdcc $idx "$arg n'est pas une variable globale."
return
}
putdebug [array names $arg]
set nombre_valeurs 0
foreach key [array names $arg] {
array startsearch arrayName
putdcc $idx "$key => $arg($key)"
incr nombre_valeurs
}
if {$nombre_valeurs == 0} {putdcc $idx "Pas de résultat."}
return 1
}
# .tcl source scripts/OutilsDeDeveloppement.tcl

Event Timeline

dereckson created this paste.Jan 18 2016, 01:26

Extracted from the March 2007 backup of Espace Win site (a GeSHI test).

dereckson changed the title of this paste from scripts/OutilsDeDeveloppement.tcl to 2007 SurfBoard scripts/OutilsDeDeveloppement.tcl.Jan 18 2016, 01:28
dereckson changed the title of this paste from 2007 SurfBoard scripts/OutilsDeDeveloppement.tcl to 2007 backup - SurfBoard - scripts/OutilsDeDeveloppement.tcl.
Nasqueron DevCentral · If it had been much bigger the moon would have had a core of ice. · Powered by Phabricator