News linuxfr

**Dylan** Mar 29 Déc - 5:02

Code:: # news-linuxfr (08/12/2003) # ################################################################################# # ___ ___ ___ ___ _____ # # / /\ / /\ / /\ / /\ / /::\ # # / /:/ / /::\ / /::\ / /::\ / /:/\:\ # # /__/::\ / /:/\:\ / /:/\:\ / /:/\:\ / /:/ \:\ # # \__\/\:\ / /:/~/::\ / /:/~/:/ / /:/ \:\ /__/:/ \__\:| # # \ \:\ /__/:/ /:/\:\ /__/:/ /:/___ /__/:/ \__\:\ \ \:\ / /:/ # # \__\:\ \ \:\/:/__\/ \ \:\/:::::/ \ \:\ / /:/ \ \:\ /:/ # # / /:/ \ \::/ \ \::/~~~~ \ \:\ /:/ \ \:\/:/ # # /__/:/ \ \:\ \ \:\ \ \:\/:/ \ \::/ # # \__\/ \ \:\ \ \:\ \ \::/ \__\/ # # \__\/ \__\/ \__\/ # # # # # # ___ # # ___ / /\ # # / /\ / /:/ # # / /:/ / /:/ ___ ___ # # / /:/ / /:/ ___ /__/\ / /\ # # / /::\ /__/:/ / /\ \ \:\ / /:/ # # /__/:/\:\ \ \:\ / /:/ \ \:\ /:/ # # \__\/ \:\ \ \:\ /:/ \ \:\/:/ # # \ \:\ \ \:\/:/ \ \::/ # # \__\/ \ \::/ \__\/ # # \__\/ # # # # # # web : http://tcl.lagon-bleu.org # # mail : jarod_angel@yahoo.fr # # IRC : Jarod_@IRCNet #buffy # # Asco@UNDERNet #tyranz # # # ################################################################################# # # # NEWS-LINUXFR.TCL vérifie toutes les 5 minutes si il y a de nouvelles news # # sur le site de http://linuxfr.org/ et les affiche sur le channel. # # Il est également possible de lire la derniere news. Commande : !linuxnews # # # # # ATTENTION ! Ce TCL requiere HTTP.TCL # # # ################################################################################# ##### CONFIGURATION ##### ### Si vous voulez que le bot n'affiche les topics que sur un seul channel, l'indiquer ci-dessous : ### ( mettre sous la forme "#channel", mettre "*" pour tous les channels ) set linuxnews(channel) "#buffy" ### (1 oui/0 non) Si vous voulez que le bot envoi les news avec des couleurs : set linuxnews(couleur) 1 ### Indiquez le nbre de mots qui seront visibles lors de l'affichage de la news ### (genre pour eviter ke le bot affiche un article en entier qui ferait 1000 lignes...) ### (le but est de juste voir le debut de l'article pour voir si c interessant !) set linuxnews(mots) 25 ### Indiquer le nom et le repertoire de http.tcl (par défaut le fichier "http.tcl" est mis dans le repertoire "scripts") set loadhttp "scripts/http.tcl" ##### FIN DE LA CONFIGURATION ##### ##### DEBUT DU PROGRAMME ##### ### Verifie la presence de http.tcl if {![file exists $loadhttp]} { putlog "\002 \037/!\\ ATTENTION VOUS N'AVEZ PAS HTTP.TCL ! CE SCRIPT NE POURRA DONC PAS MARCHER CORRECTEMENT !! /!\\ \002" } ### A ne pas changer :-) # Nom du site set linuxnews(site) "http://linuxfr.org/" bind pub - !linuxnews pub:linuxnews bind pub - !newslinux pub:linuxnews proc pub:linuxnews { nick uhost handle channel arg } { global linuxnews encorebis if {$linuxnews(channel) != "*"} { if {$linuxnews(channel) != "$channel"} { return 0 } } set encore [unixtime] if {[info exists encorebis]} { set trop [expr $encore - $encorebis] if {$trop < 15} { putquick "notice $nick :Désolé, une demande de !linuxnews toutes les 15 secondes" return 0 } } set encorebis $encore ### on regarde la date du jour set date [clock format [unixtime] -format %Y/%m/%d] set token [http::geturl $linuxnews(site)$date/index.html -timeout 10000] if {[http::status $token] != "ok"} { puthelp "notice $nick :#NEWS-LINUXFR# Error : [http::status $token]" return 0 } set reponse [http::data $token] http::cleanup $token putlog "#NEWS-LINUXFR# Demandes de lecture de la derniere news par $nick ..." set indextest [string first "centraldiv" $reponse] ### recupertation de l'url associee set test [linuxnewsgettext "$reponse" "href=\"" "\"" $indextest] set indextest [lindex $test 1] set linuxnews(url) [lindex $test 0] set linuxnews(url) [lindex [split $linuxnews(url) /] end] ### recuperation du topic de la news set test [linuxnewsgettext "$reponse" ">" "</a>" $indextest] regsub -all -nocase "\"" $test "\'" test set taille [llength $test] set indextest [lindex $test [expr $taille - 1]] set linuxnews(topic) [lrange $test 0 [expr $taille - 2]] set linuxnews(topic) [traitementhtml $linuxnews(topic)] regsub -all -nocase "{" $linuxnews(topic) "" linuxnews(topic) regsub -all -nocase "}" $linuxnews(topic) "" linuxnews(topic) ### recuperation des X premieres lettres de la news set test [linuxnewsgettext "$reponse" "." " " $indextest] if { $test == -1 } { return 0 } regsub -all -nocase "\"" $test "\'" test set taille [llength $test] set indextest [lindex $test [expr $taille - 1]] set linuxnews(contenu) [lrange $test 0 [expr $taille - 2]] set linuxnews(contenu) [traitementhtml $linuxnews(contenu)] set taille [llength $linuxnews(contenu)] if {$taille > $linuxnews(mots)} { set linuxnews(contenu) "[lrange $linuxnews(contenu) 0 $linuxnews(mots)] ..." } if {$linuxnews(couleur) == 0} { regsub -all -nocase "{" $linuxnews(contenu) "" linuxnews(contenu) regsub -all -nocase "}" $linuxnews(contenu) "" linuxnews(contenu) regsub -all -nocase "{" $linuxnews(topic) "" linuxnews(topic) regsub -all -nocase "}" $linuxnews(topic) "" linuxnews(topic) puthelp "privmsg $channel :(NEWS-LINUXFR) \002 $linuxnews(topic) : \002 $linuxnews(linuxnews(contenu)) \00315\[$linuxnews(site)$date/$linuxnews(url)\]\00315" } if {$linuxnews(couleur) != 0} { regsub -all -nocase "{" $linuxnews(contenu) "" linuxnews(contenu) regsub -all -nocase "}" $linuxnews(contenu) "" linuxnews(contenu) regsub -all -nocase "{" $linuxnews(topic) "" linuxnews(topic) regsub -all -nocase "}" $linuxnews(topic) "" linuxnews(topic) puthelp "privmsg $channel :\0033 (NEWS-LINUXFR) \0032\002$linuxnews(topic) : \002\0036$linuxnews(contenu) \003\00315\[$linuxnews(site)$date/$linuxnews(url)\]\00315" } return 0 } bind time - "00 * * * *" time:linuxnews bind time - "05 * * * *" time:linuxnews bind time - "10 * * * *" time:linuxnews bind time - "15 * * * *" time:linuxnews bind time - "20 * * * *" time:linuxnews bind time - "25 * * * *" time:linuxnews bind time - "30 * * * *" time:linuxnews bind time - "35 * * * *" time:linuxnews bind time - "40 * * * *" time:linuxnews bind time - "45 * * * *" time:linuxnews bind time - "50 * * * *" time:linuxnews bind time - "55 * * * *" time:linuxnews proc time:linuxnews { min hour day month year } { global linuxnews set channel $linuxnews(channel) if {![info exists linuxnews(url)]} { set linuxnews(url) "rien" } if {![info exists linuxnews(old)]} { set linuxnews(old) "rien" } ### on regarde la date du jour set date [clock format [unixtime] -format %Y/%m/%d] set token [http::geturl $linuxnews(site)$date/index.html -timeout 10000] if {[http::status $token] != "ok"} { putlog "#NEWS-LINUXFR# Error : [http::status $token]" return 0 } set reponse [http::data $token] http::cleanup $token set indextest [string first "centraldiv" $reponse] if {$indextest == -1} { return 0 } set ok 0 while {1} { ### recupertation de l'url associee set test [linuxnewsgettext "$reponse" "href=\"" "\"" $indextest] if {$test == ""} { break } set indextest [lindex $test 1] set linuxnews(url) [lindex $test 0] set linuxnews(url) [lindex [split $linuxnews(url) /] end] if {$linuxnews(url) == "www.templeet.org"} { break } if {$ok == 0} { if {$linuxnews(url) == $linuxnews(old)} { break } set linuxnews(oldold) $linuxnews(old) set linuxnews(old) $linuxnews(url) putlog "#NEWS-LINUXFR# Nouvelle linux news ..." set ok 1 } else { if {$linuxnews(url) == $linuxnews(old)} { break } if {$linuxnews(url) == $linuxnews(oldold)} { break } } ### recuperation du topic de la news set test [linuxnewsgettext "$reponse" ">" "</a>" $indextest] regsub -all -nocase "\"" $test "\'" test set taille [llength $test] set indextest [lindex $test [expr $taille - 1]] set linuxnews(topic) [lrange $test 0 [expr $taille - 2]] set linuxnews(topic) [traitementhtml $linuxnews(topic)] regsub -all -nocase "{" $linuxnews(topic) "" linuxnews(topic) regsub -all -nocase "}" $linuxnews(topic) "" linuxnews(topic) ### recuperation des X premieres lettres de la news set test [linuxnewsgettext "$reponse" "." " " $indextest] if { $test == -1 } { return 0 } regsub -all -nocase "\"" $test "\'" test set taille [llength $test] set indextest [lindex $test [expr $taille - 1]] set linuxnews(contenu) [lrange $test 0 [expr $taille - 2]] set linuxnews(contenu) [traitementhtml $linuxnews(contenu)] set taille [llength $linuxnews(contenu)] if {$taille > $linuxnews(mots)} { set linuxnews(contenu) "[lrange $linuxnews(contenu) 0 $linuxnews(mots)] ..." } set reponse [string range $reponse $indextest end] if {$linuxnews(couleur) == 0} { regsub -all -nocase "{" $linuxnews(contenu) "" linuxnews(contenu) regsub -all -nocase "}" $linuxnews(contenu) "" linuxnews(contenu) regsub -all -nocase "{" $linuxnews(topic) "" linuxnews(topic) regsub -all -nocase "}" $linuxnews(topic) "" linuxnews(topic) puthelp "privmsg $channel :(NEWS-LINUXFR) \002 $linuxnews(topic) : \002 $linuxnews(contenu) \00315\[$linuxnews(site)$date/$linuxnews(url)\]\00315" } if {$linuxnews(couleur) != 0} { regsub -all -nocase "{" $linuxnews(contenu) "" linuxnews(contenu) regsub -all -nocase "}" $linuxnews(contenu) "" linuxnews(contenu) regsub -all -nocase "{" $linuxnews(topic) "" linuxnews(topic) regsub -all -nocase "}" $linuxnews(topic) "" linuxnews(topic) puthelp "privmsg $channel :\0033 (NEWS-LINUXFR) \0032\002$linuxnews(topic) : \002\0036$linuxnews(contenu) \003\00315\[$linuxnews(site)$date/$linuxnews(url)\]\00315" } # on passe à la news suivante .. set test [linuxnewsgettext "$reponse" "archivelin" "\"" 0] if {$test == ""} { break } set indextest [lindex $test [expr [llength $test] - 1]] } return 0 } proc traitementhtml { contenu } { regsub -all "<" $contenu "<" contenu regsub -all ">" $contenu ">" contenu regsub -all "&" $contenu "et" contenu regsub -all """ $contenu "" contenu regsub -all "Á" $contenu "Á" contenu regsub -all "Â" $contenu "Â" contenu regsub -all "À" $contenu "À" contenu regsub -all "Å" $contenu "Å" contenu regsub -all "Ã" $contenu "Ã" contenu regsub -all "Ä" $contenu "Ä" contenu regsub -all "Ç" $contenu "Ç" contenu regsub -all "É" $contenu "É" contenu regsub -all "Ê" $contenu "Ê" contenu regsub -all "È" $contenu "È" contenu regsub -all "Í" $contenu "Í" contenu regsub -all "Î" $contenu "Î" contenu regsub -all "Ì" $contenu "Ì" contenu regsub -all "Ï" $contenu "Ï" contenu regsub -all "Ñ" $contenu "Ñ" contenu regsub -all "Ó" $contenu "Ó" contenu regsub -all "Ô" $contenu "Ô" contenu regsub -all "Ò" $contenu "Ò" contenu regsub -all "Ø" $contenu "Ø" contenu regsub -all "Õ" $contenu "Õ" contenu regsub -all "Ö" $contenu "Ö" contenu regsub -all "Ú" $contenu "Ú" contenu regsub -all "Û" $contenu "Û" contenu regsub -all "Ù" $contenu "Ù" contenu regsub -all "Ü" $contenu "Ü" contenu regsub -all "Ý" $contenu "Ý" contenu regsub -all "á" $contenu "á" contenu regsub -all "æ" $contenu "ae" contenu regsub -all "&oelig;" $contenu "oe" contenu regsub -all "à" $contenu "à" contenu regsub -all "å" $contenu "å" contenu regsub -all "ã" $contenu "ã" contenu regsub -all "ä" $contenu "ä" contenu regsub -all "ç" $contenu "ç" contenu regsub -all "é" $contenu "é" contenu regsub -all "ë" $contenu "ë" contenu regsub -all "í" $contenu "í" contenu regsub -all "è" $contenu "è" contenu regsub -all "ì" $contenu "ì" contenu regsub -all "ï" $contenu "ï" contenu regsub -all "ñ" $contenu "ñ" contenu regsub -all "ó" $contenu "ó" contenu regsub -all "ô" $contenu "ô" contenu regsub -all "â" $contenu "â" contenu regsub -all "ê" $contenu "ê" contenu regsub -all "ò" $contenu "ò" contenu regsub -all "õ" $contenu "õ" contenu regsub -all "ö" $contenu "ö" contenu regsub -all "ú" $contenu "ú" contenu regsub -all "û" $contenu "û" contenu regsub -all "ù" $contenu "ù" contenu regsub -all "ü" $contenu "ü" contenu regsub -all "î" $contenu "î" contenu regsub -all "ÿ" $contenu "ÿ" contenu regsub -all "Æ" $contenu "AE" contenu regsub -all "&OElig;" $contenu "OE" contenu regsub -all "®" $contenu "" contenu regsub -all "©" $contenu "" contenu regsub -all "™" $contenu "(tm)" contenu regsub -all "±" $contenu "±" contenu regsub -all "°" $contenu "°" contenu regsub -all "¹" $contenu "¹" contenu regsub -all "²" $contenu "²" contenu regsub -all "³" $contenu "³" contenu regsub -all "×" $contenu "×" contenu regsub -all "÷" $contenu "÷" contenu regsub -all "€" $contenu "euro" contenu regsub -all -nocase "" $contenu "" contenu regsub -all -nocase "" $contenu "" contenu regsub -all -nocase "" $contenu "" contenu regsub -all -nocase "" $contenu "" contenu regsub -all -nocase "" $contenu "" contenu regsub -all -nocase "" $contenu "" contenu regsub -all -nocase "" $contenu "" contenu regsub -all -nocase "" $contenu "" contenu regsub -all -nocase " " $contenu "" contenu regsub -all -nocase "" $contenu "" contenu regsub -all -nocase "" $contenu "" contenu regsub -all -nocase "œ" $contenu "oe" contenu regsub -all -nocase "«" $contenu "\"" contenu regsub -all -nocase "»" $contenu "\"" contenu regsub -all -nocase "{" $contenu "" contenu regsub -all -nocase "}" $contenu "" contenu return $contenu } proc linuxnewsgettext { data start end index } { set index0 [string first $start $data $index] if {$index0 == -1} { return } set index1 [expr $index0 + [string length $start]] set index2 [string first $end $data $index1] set index2 [expr $index2 - 1] set index [expr $index2 + [string length $end]] return "[string range $data $index1 $index2] $index" } putlog "\0032NEWS-LINUXFR.TCL\003 (\0031308/12/2003\003) par Jarod_"