All pastes #612520 Raw Edit

linux.tcl

public text v1 · immutable
·published 2007-07-10 13:38 UTC
rendered paste body
# news-linuxfr (22/03/2003)							#
#################################################################################
#    ___          ___           ___           ___          _____    		#
#   /  /\        /  /\         /  /\         /  /\        /  /::\   		#
#  /  /:/       /  /::\       /  /::\       /  /::\      /  /:/\:\  		#
# /__/::\      /  /:/\:\     /  /:/\:\     /  /:/\:\    /  /:/  \:\ 		#
# \__\/\:\    /  /:/~/::\   /  /:/~/:/    /  /:/  \:\  /__/:/ \__\:|		#
#    \  \:\  /__/:/ /:/\:\ /__/:/ /:/___ /__/:/ \__\:\ \  \:\ /  /:/		#
#     \__\:\ \  \:\/:/__\/ \  \:\/:::::/ \  \:\ /  /:/  \  \:\  /:/ 		#
#     /  /:/  \  \::/       \  \::/~~~~   \  \:\  /:/    \  \:\/:/  		#
#    /__/:/    \  \:\        \  \:\        \  \:\/:/      \  \::/   		#
#    \__\/      \  \:\        \  \:\        \  \::/        \__\/    		#
#                \__\/         \__\/         \__\/                  		#
#										#
#										#
#					 ___					#
#  			     ___        /  /\                  			#
#  			    /  /\      /  /:/                  			#
#  			   /  /:/     /  /:/       ___     ___ 			#
#  			  /  /:/     /  /:/  ___  /__/\   /  /\			#
#  			 /  /::\    /__/:/  /  /\ \  \:\ /  /:/			#
# 			/__/:/\:\   \  \:\ /  /:/  \  \:\  /:/ 			#
# 			\__\/  \:\   \  \:\  /:/    \  \:\/:/  			#
# 			     \  \:\   \  \:\/:/      \  \::/   			#
# 			      \__\/    \  \::/        \__\/    			#
# 			                \__\/                  			#
#										#
#										#
#					web  : http://tcl.lagon-bleu.org	#
#					mail : jarod_angel@yahoo.fr		#
#					IRC  : Jarod_@IRCNet #buffy		#
#					       Asco@UNDERNet #tyranz		#
#										#
#################################################################################
#										#
# NEWS-LINUXFR.TCL vrifie 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) "#linux_system"

### (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) 45

### Indiquer le nom et le repertoire de http.tcl (par dfaut 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 :Dsol, 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" "</span>." "<br/>" $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" "</span>." "<br/>" $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(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 "&lt;" $contenu "<" contenu
	regsub -all "&gt;" $contenu ">" contenu
	regsub -all "&amp;" $contenu "et" contenu
	regsub -all "&quot;" $contenu "" contenu
	regsub -all "&Aacute;" $contenu "" contenu
	regsub -all "&Acirc;" $contenu "" contenu
	regsub -all "&Agrave;" $contenu "" contenu
	regsub -all "&Aring;" $contenu "" contenu
	regsub -all "&Atilde;" $contenu "" contenu
	regsub -all "&Auml;" $contenu "" contenu
	regsub -all "&Ccedil;" $contenu "" contenu
	regsub -all "&Eacute;" $contenu "" contenu
	regsub -all "&Ecirc;" $contenu "" contenu
	regsub -all "&Egrave;" $contenu "" contenu
	regsub -all "&Iacute;" $contenu "" contenu
	regsub -all "&Icirc;" $contenu "" contenu
	regsub -all "&Igrave;" $contenu "" contenu
	regsub -all "&Iuml;" $contenu "" contenu
	regsub -all "&Ntilde;" $contenu "" contenu
	regsub -all "&Oacute;" $contenu "" contenu
	regsub -all "&Ocirc;" $contenu "" contenu
	regsub -all "&Ograve;" $contenu "" contenu
	regsub -all "&Oslash;" $contenu "" contenu
	regsub -all "&Otilde;" $contenu "" contenu
	regsub -all "&Ouml;" $contenu "" contenu
	regsub -all "&Uacute;" $contenu "" contenu
	regsub -all "&Ucirc;" $contenu "" contenu
	regsub -all "&Ugrave;" $contenu "" contenu
	regsub -all "&Uuml;" $contenu "" contenu
	regsub -all "&Yacute;" $contenu "" contenu
	regsub -all "&aacute;" $contenu "" contenu
	regsub -all "&aelig;" $contenu "ae" contenu
	regsub -all "&oelig;" $contenu "oe" contenu
	regsub -all "&agrave;" $contenu "" contenu
	regsub -all "&aring;" $contenu "" contenu
	regsub -all "&atilde;" $contenu "" contenu
	regsub -all "&auml;" $contenu "" contenu
	regsub -all "&ccedil;" $contenu "" contenu
	regsub -all "&eacute;" $contenu "" contenu
	regsub -all "&euml;" $contenu "" contenu
	regsub -all "&iacute;" $contenu "" contenu
	regsub -all "&egrave;" $contenu "" contenu
	regsub -all "&igrave;" $contenu "" contenu
	regsub -all "&iuml;" $contenu "" contenu
	regsub -all "&ntilde;" $contenu "" contenu
	regsub -all "&oacute;" $contenu "" contenu
	regsub -all "&ocirc;" $contenu "" contenu
	regsub -all "&acirc;" $contenu "" contenu
	regsub -all "&ecirc;" $contenu "" contenu
	regsub -all "&ograve;" $contenu "" contenu
	regsub -all "&otilde;" $contenu "" contenu
	regsub -all "&ouml;" $contenu "" contenu
	regsub -all "&uacute;" $contenu "" contenu
	regsub -all "&ucirc;" $contenu "" contenu
	regsub -all "&ugrave;" $contenu "" contenu
	regsub -all "&uuml;" $contenu "" contenu
	regsub -all "&icirc;" $contenu "" contenu
	regsub -all "&yuml;" $contenu "" contenu
	regsub -all "&AElig;" $contenu "AE" contenu
	regsub -all "&OElig;" $contenu "OE" contenu
	regsub -all "&reg;" $contenu "" contenu
	regsub -all "&copy;" $contenu "" contenu
	regsub -all "&trade;" $contenu "(tm)" contenu
	regsub -all "&plusmn;" $contenu "" contenu
	regsub -all "&deg;" $contenu "" contenu
	regsub -all "&sup1;" $contenu "" contenu
	regsub -all "&sup2;" $contenu "" contenu
	regsub -all "&sup3;" $contenu "" contenu
	regsub -all "&times;" $contenu "" contenu
	regsub -all "&divide;" $contenu "" contenu
	regsub -all "&euro;" $contenu "euro" contenu
	regsub -all -nocase "<p>" $contenu "" contenu
	regsub -all -nocase "</p>" $contenu "" contenu
	regsub -all -nocase "<i>" $contenu "" contenu
	regsub -all -nocase "</i>" $contenu "" contenu
	regsub -all -nocase "<b>" $contenu "" contenu
	regsub -all -nocase "<u>" $contenu "" contenu
	regsub -all -nocase "</u>" $contenu "" contenu
	regsub -all -nocase "</b>" $contenu "" contenu
	regsub -all -nocase "<br>" $contenu "" contenu
	regsub -all -nocase "<sup>" $contenu "" contenu
	regsub -all -nocase "</sup>" $contenu "" contenu
	regsub -all -nocase "&#339;" $contenu "oe" contenu
	regsub -all -nocase "&laquo;" $contenu "\"" contenu
	regsub -all -nocase "&raquo;" $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 (\0031322/03/2003\003) par Jarod_"