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


VIP multi-channel
#1
tcl
# VIP
# Rapide fait en 4j, retours souhaités par mail
# Gestion des nicks VIP
# Copyright 2020 ian@sibian.fr [sibian0218@gmail.com]
# Date: 2020-05
# Version:  1.6
#
# 14/05/2020 : ajout file d'attente asynchrone
# Les commandes sont
#  .vip pour voir la liste
#  .+vip <nick> pour ajouter un vip (soyez cohérent dans le nick)
#  .-vip <nick> pour le retirer
# LES COMMANDES PRENNENT EN COMPTE LES EXTENSIONS DE NICKS (voir le paramétrage plus bas)
# ET INTÈGRENT LE NICK ENREGISTRÉ DANS LA RÉPONSE SERVEUR AU whois
 
 
namespace eval VIP {
 
 # POUR ACTIVER LE SCRIPT, IL FAUT EN PARTYLINE FAIRE UN .chanset #channel +vip
 setudef flag vip
 
 # Informations de révision
 variable version "1.6 (2020/05)"
 variable scriptFile [info script]
 variable scriptName "VIP (c) ian 2020"
 variable scriptDir [file dirname $scriptFile]
 variable scriptTime [clock format [file atime $scriptFile] -format "%Y-%m-%d %H:%M:%S" ]
 
 ##############
 # Paramétrage
 ##############
 
 #POUR ACTIVER LA VERBOSITÉ
 variable TRACE 0
 
 # Nom du fichier où seront les pseudos autorisés.
 variable fichier "[file dirname [info script]]/vip.db"
 
 # Dictionnaire des vip, vide avant chargement/création
 variable users_chans [::tcl::dict::create]
 
 # Gestion d'une file d'attente d'action par nickname
 variable commandsQueue [::tcl::dict::create]
 
 # En cas de nick effectif non enregistré ou groupé
 variable tempAccountAssoc [::tcl::dict::create]
 
 # Pour identifier par exemple ian et ian|oqp au même nick
 variable discardNickExt 1
 variable extensionSeparators [list "|" "\["]
 
 ####################
 # FIN DU Paramétrage
 ####################
 
 ###############
 #             #
 #    BINDS    #
 #             #
 ###############
 
 # pour la désinstallation et suppression des binds/timers
 # procédure originellement (c) MenzAgitat (merci à lui)
 bind evnt -|- prerehash [namespace current]::uninstall
 
 bind join - "*" [namespace current]::onJoin
 bind raw - 307 [namespace current]::identified
 bind raw - 311 [namespace current]::tempAccAssoc
 bind raw - 318 [namespace current]::endWhois
 bind raw - 312 [namespace current]::see
 bind raw - 313 [namespace current]::see
 bind raw - 314 [namespace current]::see
 bind raw - 315 [namespace current]::see
 bind raw - 316 [namespace current]::see
 bind raw - 317 [namespace current]::see
 bind raw - 319 [namespace current]::see
 
## PENSEZ À CHANGER LE FLAG SI JAMAIS ET LE NOM DE LA COMMANDE
 bind pub o ".+vip" [namespace current]::addVIP
 bind pub o ".-vip" [namespace current]::removeVIP
 bind pub o ".vip" [namespace current]::view
 
 ###############
 #             #
 #   RÉPONSES  #
 #             #
 ###############
 
 #######################
 # Procédure de join.
 #######################
 proc onJoin {nick host hand chan} {
   if {![channel get $chan vip] || $nick == $::nick} { ## si désactivé ou eggdrop
     return 0
   }
   variable users_chans
   set nick [string tolower $nick]
   set chan [string tolower $chan]
   set simple_nick [discardExtension $nick]
   debug "Only if nick seeming to be a vip"
   if {![::tcl::dict::exists $users_chans $nick] && ![::tcl::dict::exists $users_chans $simple_nick]} {
     debug "Not possible vip"
     return 0
   }
   debug "*************************************************************"
   debug "adding $simple_nick : voice $chan $nick"
   debug "*************************************************************"
   addToQueue $simple_nick "voice $chan $nick"
   debug "**********************  WHOIS  ******************************"
   utimer 4 [list puthelp "WHOIS $nick"]
 }
 
 ####################################
 ## Réponse au message 307 (WHOIS)
 ## Le user est identifié, on 
 ## vérifie s'il doit être "voicé"
 ####################################
 proc identified {from key text} {
   debug "IDENTIFIED : $key $text"
   set nick [lindex [split $text] 1]
   if {$nick == $::nick} { ## on 'oublie' l'eggdrop
     return
   }
   set nick [string tolower $nick]
   set simple_nick [discardExtension $nick]
   debug "process queue $simple_nick"
   processQueue $simple_nick
 }
 
 proc see {from key text} {
   debug "$key $text"
 }
 
 ####################################
 ## Réponse au message 311 (WHOIS)
 ####################################
 
 proc tempAccAssoc {from key text} {
   debug "** Temporary Account Association"
   set nick [lindex [split $text] 1]
   set simple_nick [lindex [split $text] 2]
   variable tempAccountAssoc
   ::tcl::dict::set tempAccountAssoc $nick $simple_nick
   debug "Associated $nick with $simple_nick"
 }
 
 ####################################
 ## Réponse au message 318 (ENDWHOIS)
 ## On doit vider la queue au cas où
 ####################################
 proc endWhois {from key text} {
   variable tempAccountAssoc
 
   debug "End WHOIS : $key $text"
   debug "*************************************************************"
   set nick [lindex [split $text] 1]
   if {$nick == $::nick} { ## on 'oublie' l'eggdrop
     return
   }
   set nick [string tolower $nick]
   set simple_nick [discardExtension $nick]
   debug "Looking for a temp account assoc...."
   if {[::tcl::dict::exists $tempAccountAssoc $nick]} {
     set simple_nick [::tcl::dict::get $tempAccountAssoc $nick]
     debug "a temp assoc exists, processing now"
     processQueue $simple_nick
   } else {
     emptyQueue $simple_nick
   }
 
 }
 
 #################
 # TRACE
 #################
 
 proc debug txt {
   variable TRACE
   if {$TRACE==0} {return 0}
   putlog $txt
 }
 
 #################
 # Ajout d'un VIP
 #################
 
 proc addVIP { nick host hand chan arg } {
   set who [lindex $arg 0]
   set chanvip [lindex $arg 1]
 
   if {$who == ""} {
     putserv "NOTICE $nick :Utilisation: .+vip <pseudo> \[<#salon>\]"
     putserv "NOTICE $nick :Exemple .+vip $nick #accueil"
     return 0
   }
   ## Si channel non donné, le chan courant par défaut
   if {$chanvip == ""} {
     set chanvip $chan
   } elseif {[string range $chanvip 0 0]!="#"} {
     putserv "NOTICE $nick :Le salon donné ne commence pas par #"
     return 0
   }
 
   set who [string tolower $who]
   core_addVIP $nick $chanvip $who
 
   set simple_who [discardExtension $who]
   if {$who != $simple_who} {
     core_addVIP $nick $chanvip $simple_who
   }
 }
 
 #######################
 # Suppression d'un VIP
 #######################
 
 proc removeVIP { nick host hand chan arg } {
   set who [lindex $arg 0]
   set chanvip [lindex $arg 1]
 
   if {$who == ""} {
     putserv "NOTICE $nick :Utilisation: .-vip <pseudo> \[<#salon>\]"
     putserv "NOTICE $nick :Exemple .-vip $nick #accueil"
     return 0
   }
   ## Si channel non donné, le chan courant par défaut
   if {$chanvip == ""} {
     set chanvip $chan
   } elseif {[string range $chanvip 0 0]!="#"} {
     putserv "NOTICE $nick :Le salon donné ne commence pas par #"
     return 0
   }
   set who [string tolower $who]
   core_removeVIP $nick $chanvip $who
 
   set simple_who [discardExtension $who]
   if {$who != $simple_who} {
     core_removeVIP $nick $chanvip $simple_who
   }
 }
 
 ####################
 # Affichage des VIP
 ####################
 
 proc view { nick host hand chan arg } {
   ## on inverse l'association dans le dictionnaire
   set chans_users [inverse_dict]
 
   set chan_name [string tolower [string range $chan 1 end]]
 
   putnow "NOTICE $nick :\037\00300,01 -> Liste des VIP pour $chan <-\003"
   if {[::tcl::dict::exists $chans_users $chan_name]} {
     set chan_vips [::tcl::dict::get $chans_users $chan_name]
     foreach who $chan_vips {
       putnow "NOTICE $nick :\0031\[ \0034$who\003 \0031]\003"
     }
   }
   putnow "NOTICE $nick :\037\00300,01 -> Fin de la liste des VIP. <-\003"
 }
 
 ####################
 #                  #
 #  CORE FUNCTIONS  #
 #                  #
 ####################
 
 ##########################################
 ## Ajout commande dans la file ASYNCHRONE 
 ##########################################
 
 proc addToQueue {nick cmd} {
   variable commandsQueue
   ::tcl::dict::lappend commandsQueue $nick $cmd
 }
 
 ##########################################
 ## Traitement de la file ASYNCHRONE 
 ##########################################
 
 proc processQueue nick {
   variable commandsQueue
   
   debug "(processing queue for $nick)"
   if {[::tcl::dict::exists $commandsQueue $nick]} {
     set commands [::tcl::dict::get $commandsQueue $nick]
     foreach cmd $commands {
       eval $cmd
     }
     ::tcl::dict::unset commandsQueue $nick
   }
 }
 
 ##########################################
 ## Vidage de la file ASYNCHRONE 
 ##########################################
 
 proc emptyQueue nick {
   putlog "***** vidage de la file pour $nick *****"
   variable commandsQueue
   puts $commandsQueue
   if {[::tcl::dict::exists $commandsQueue $nick]} {
     ::tcl::dict::unset commandsQueue $nick
   }
 }
 
 ########################################
 ## Voice ASYNCHRONE d'un VIP
 ########################################
 
 proc voice {chan nick} {
   set simple_nick [discardExtension $nick]
   if {[isVIP $nick $chan] || [isVIP $simple_nick $chan]} {
     set msg "$nick est vip sur \002$chan\002"
     puthelp "PRIVMSG $chan :$msg"
     putserv "MODE $chan +v $nick"
   }
 }
 
 ########################################
 ## Ajout ASYNCHRONE du statut VIP
 ########################################
 
 proc core_addVIP {nick chan who} {
   variable users_chans
 
   ## on retire le # pour inclusion dans le dictionnaire, et en minuscules
   set tmpchan [string tolower [string replace $chan 0 0]]
 
   if {[::tcl::dict::exists $users_chans $who]} {
     set user_chans [::tcl::dict::get $users_chans $who]
     if {[lsearch $user_chans $tmpchan] == -1} {
       ## ajout
       ::tcl::dict::lappend users_chans $who $tmpchan
     } else {
       putserv "NOTICE $nick :\002Erreur:\002$who\002 pour le salon $chan \0034est déjà VIP\003"
       return 0
     }
   } else {
     ##création
     ::tcl::dict::lappend users_chans $who $tmpchan
   }
   putserv "NOTICE $nick :\002$who\002 \0034est ajouté aux pseudos VIP pour $chan\003"
   ## On sauvegarde le dictionnaire
   fileUpdate
 }
 
 ########################################
 ## Suppression ASYNCHRONE du statut VIP
 ########################################
 
 proc core_removeVIP {nick chan who} {
   variable users_chans
 
   ## on retire le # pour inclusion dans le dictionnaire, et en minuscules
   set tmpchan [string tolower [string replace $chan 0 0]]
 
   if {[::tcl::dict::exists $users_chans $who]} {
   ## Si le user est VIP quelque part
     set user_chans [::tcl::dict::get $users_chans $who]
     set tmp_index [lsearch -nocase $user_chans $tmpchan]
 
     if { $tmp_index > -1 } {
     ## S'il est VIP du chan courant
       set user_chans [lreplace $user_chans $tmp_index $tmp_index]
       if {[llength $user_chans]>0} {
         ::tcl::dict::set users_chans $who $user_chans
       } else {
         ::tcl::dict::unset users_chans $who
       }
       putserv "NOTICE $nick :\002$who\002 \0034est supprimé des pseudos VIP pour $chan\003"
       fileUpdate
       return 0
     }
   }
   putserv "NOTICE $nick :\002$who\002 \0034n'est pas VIP pour $chan\003"
 }
 
 
 ##################################################
 ## On supprime éventuellement l'extension de nick
 ##################################################
 proc discardExtension nick {
   variable discardNickExt
   variable extensionSeparators
   if {!$discardNickExt} {
     return $nick
   }
   set result $nick
   foreach sep $extensionSeparators {
     set index [string first $sep $result]
     if {$index > 0} {
       # pour éviter de se retrouver avec une chaîne vide
       set result [string range $result 0 [expr $index - 1]]
     }
   }
   return $result
 }
 
 ################################################
 ## Vérification que nick est bien VIP pour chan
 ################################################
 
 proc isVIP {nick chan} {
   variable users_chans
   set $nick [discardExtension $nick]
   set chan_name [string range $chan 1 end]
   if {[::tcl::dict::exists $users_chans $nick]} {
     set chans [::tcl::dict::get $users_chans $nick]
     if {[lsearch -nocase $chans $chan_name]>-1} {
       return 1
     }
   }
   return 0
 }
 
 ###########################################
 # exemple set msg [filtout $salons "msg"]
 # ==> ==> NON UTILISÉ !!
 ###########################################
 proc filtout {chan text} {
   if [string match "*c*" [getchanmode $chan]] {
     return [stripcodes abcgru $text]
   } else {
     return $text
   }
 }
 
 ##########################
 ## Inversion dict
 ##########################
 
 proc inverse_dict {} {
   ## PERMET D'INVERSER L'ASSOCIATION nick -> channels en channel -> nicks
   ## n'est pas stocké, mais simplifie la visualisation ou recherche
   variable users_chans
   set tmp_dict [::tcl::dict::create]
   ::tcl::dict::for {nick chans} $users_chans {
     set l [llength $chans]
     for {set i 0} {$i<$l} {incr i} {
       ::tcl::dict::lappend tmp_dict [lindex $chans $i] $nick
     }
   }
   return $tmp_dict
 }
 
 ###############################
 # Procédure de chargement 
 # ou de création du fichier VIP
 ###############################
 
 proc initFile {} {
   variable fichier
   variable users_chans
   if {![file exists $fichier]} {
     putlog "\002Création du fichier $fichier\002"
     set handle [open $fichier w+]
     puts $handle $users_chans
     close $handle
   } else {
     putlog "\002Chargement de $fichier\002"
     set handle [open $fichier r]
     set users_chans [gets $handle]
     close $handle
   }
 }
 
 ######################################
 # Procédure de mise à jour du fichier
 ######################################
 proc fileUpdate {} {
   variable fichier
   variable users_chans
   set handle [open $fichier w]
   puts $handle $users_chans
   close $handle
 }
 
 ########################################
 # Désinstallation/suppression des binds
 # Par MenzAgitat
 ########################################
 
 proc uninstall {args} {
   variable scriptFile
   putlog "Désallocation des ressources de $scriptFile..."
   foreach binding [lsearch -inline -all -regexp [binds *[set VIP [::tcl::string::range [namespace current] 2 end]]*] " \{?(::)?$VIP"] {
     unbind [lindex $binding 0] [lindex $binding 1] [lindex $binding 2] [lindex $binding 4]
   }
 
   foreach running_utimer [utimers] {
     if { [::tcl::string::match "*[namespace current]::*" [lindex $running_utimer 1]] } { killutimer [lindex $running_utimer 2] }
   }
   namespace delete [namespace current]
 }
 
 ########################################
 ########################################
 ########################################
 ########################################
 
 initFile
 
 putlog "$scriptName version $version ($scriptTime) loaded."
}


  Répondre
#2
Quelle est la question / le problème ?

Edit : on m'informe dans mon oreillette que ce n'est pas une demande d'aide mais une publication de script, sujet déplacé au bon endroit.
Par contre ce qui serait top, c'est de penser à créditer l'auteur quand tu réutilises un morceau de son code.
Toute l'actualité de mes scripts ici     (dernière mise à jour le 22/04/2020)

Tout programme comporte au moins un bug et pourrait être raccourci d'au moins une instruction, de quoi l'on peut déduire que tout programme peut être réduit à une seule instruction qui ne fonctionne pas.
  Répondre


Atteindre :


Utilisateur(s) parcourant ce sujet : 1 visiteur(s)