Ansa.tcl

Kaa · Post by **Kaa** » Fri Mar 01, 2013 7:14 am

### GLOBALS ###
set ansa(version) "3.1"
set ansa(url) "http://www.ansa.it/main/notizie/awnplus/^RUBRICA/synd/ansait_awnplus_^RUBRICA_medsynd_Today_Idx.xml"
set ansa(timeout) 5000
### Percorso di salvataggio dei Database delle news (la directory deve esistere)
set ansa(filepath) "ansa-tmp"

proc ansa:send { str } {
	set str "$str\n"
	putdccraw 0 [string length $str] $str
}

proc get:rubriche { {char ""} } {
	set rubriche { topnews italia mondo calcio sport spettacolo economia cultura scienza internet moda musica cinema }
	if { $char != ""} {
		return [ join $rubriche $char ]
	} else {
		return $rubriche
	}
}
### END GLOBALS ###

### FLAGS ###
setudef flag ansa
foreach rubrica [get:rubriche] {
  setudef flag ansa_$rubrica
}
### END FLAGS ###

### BINDS ###
bind time - "00 * * * *" ansa:check
bind time - "15 * * * *" ansa:check
bind time - "30 * * * *" ansa:check
bind time - "45 * * * *" ansa:check
bind pub - !ansa ansa:request
### END BINDS ###


### PROCS ###
package require http
http::config -useragent "Mozilla/1.0"

proc strlastpos { string char {max 0} } {
	if { $max == 0} { set max [ string length $string ] }
	if { [ string length $string ] <= $max } { return [ string length $string ] }
	for { set i 0 } { $i < $max } { incr i } {
		if { [ string index $string [ expr $max - $i ] ] == $char } {
			return [ expr $max - $i ]
		}
	}
	return $max
}

proc ansa:mkdir { path } {
	set dir ""
	foreach folder [ split ${path} "/" ] {
		set dir "${dir}${folder}/"
		if { ! [ file exists ${dir} ] } {
			file mkdir ${dir}
		}
	}
}

proc max:privmsg:chars target {
	global botname
	#:nick!user@host PRIVMSG target :
	return [ expr 510 - 1 - [ string length $botname ] - 30 - [ string length $target ] - 2 ]
}

proc ansa:request { nick uhost hand chan arg } {
	global ansa
	if { [ lsearch [ channel info $chan ] "+ansa" ] == -1 } { return }
	putlog "ANSA :: request \"!ansa $arg\" from $nick!$uhost on $chan"

	### HELP ###
	if { $arg == "" || $arg == "help" } {
		set rubriche [ get:rubriche ", " ]
		ansa:send "PRIVMSG $nick :\037ANSA\037 \002::\002 \037HELP\037 - Lo script visualizza le notizie ANSA in canale.\
		Si possono vedere le ultime notizie con \002!ansa list\002 e richiamare la singola notizia con \002!ansa numero\002.\
		Gli operatori del canale possono aggiungere una rubrica con \002!ansa add rubrica\002 o rimuoverla con\
		\002!ansa del rubrica\002."
		ansa:send "PRIVMSG $nick :\037ANSA\037 \002::\002 \037HELP\037 - Per avere una lista delle rubriche attualmente seguite\
		\002!ansa info\002. Le rubriche disponibili sono: $rubriche."
		return
	}
	### END HELP ###
	
	set max_chars [ max:privmsg:chars $chan ]
	set argom [ lindex $arg 0 ]
	set rubrica [ lindex $arg 1 ]
	set rubriche [ ansa:rub $chan ]

	### CONTROLLO ARGOMENTI ###
	switch -- $argom {
		info {
			if { [ llength $rubriche ] == 0 } { lappend rubriche "nessuna" }
			ansa:send "PRIVMSG $chan :\037ANSA\037 \002::\002 \037INFO\037 - Le rubriche ANSA seguite\
			da \002$chan\002 sono: $rubriche"
		}
		add {
			if { ! [ isop $nick $chan ] } {
				ansa:send "PRIVMSG $nick :\037ANSA\037 \002::\002 \037ERROR\037 - Devi essere operatore in $chan per aggiungere una rubrica."
				return
			}
			if { [ lsearch -exact [ get:rubriche ] $rubrica ] > -1 } {
				if { [ lsearch -exact $rubriche $rubrica ] > -1 } {
					ansa:send "PRIVMSG $nick :\037ANSA\037 \002::\002 \037ERROR\037 - Il canale \002$chan\002 segue già la rubrica\
					\002$rubrica\002. Se si desidera rimuoverla \002!ansa rem $rubrica\002. Per una lista \002!ansa info\002"
				} else {
					# AGGIORNAMENTO RUBRICA
					ansa:update new $rubrica
					channel set $chan +ansa_${rubrica}
					ansa:send "PRIVMSG $chan :\037ANSA\037 \002::\002 \037ADD\037 - Ho aggiunto \002$rubrica\002.\
					Ora le rubriche ANSA seguite da \002$chan\002 sono: [ ansa:rub $chan ]."
				}
			} else {
        		set rubr [ get:rubriche ",  " ]
				ansa:send "PRIVMSG $nick :\037ANSA\037 \002::\002 \037ERROR\037 - \002$rubrica\002 è una rubrica non valida.\
				Devi scegliere tra: $rubr."
			}
		}
		del {
			if { ! [ isop $nick $chan ] } {
				ansa:send "PRIVMSG $nick :\037ANSA\037 \002::\002 \037ERROR\037 - Devi essere operatore in $chan per rimuovere una rubrica."
				return
			}
			if { [ lsearch -exact [ get:rubriche ] $rubrica ] > -1 } {
				if { [ lsearch -exact $rubriche $rubrica ] > -1 } {
					channel set $chan -ansa_${rubrica}
					set temp [ lsearch -exact $rubriche $rubrica ]
					set rubriche [ ansa:rub $chan ]
					if { [ llength $rubriche ] == 0 } { set rubriche "nessuna" }
					ansa:send "PRIVMSG $chan :\037ANSA\037 \002::\002 \037DEL\037 - Ho rimosso \002$rubrica\002.\
					Ora le rubriche ANSA seguite da \002$chan\002 sono: $rubriche"
				} else {
					ansa:send "PRIVMSG $nick :\037ANSA\037 \002::\002 \037ERROR\037 - Il canale \002$chan\002 non segue la rubrica\
					\002$rubrica\002. Se si desidera inserirla \002!ansa add $rubrica\002. Per una lista \002!ansa info\002"
				}
			} else {
        		set rubr [ get:rubriche ",  " ]
				ansa:send "PRIVMSG $nick :\037ANSA\037 \002::\002 \037ERROR\037 - \002$rubrica\002 è una rubrica non valida.\
				Devi scegliere tra: $rubr."
			}
		}
		list {
			if { $rubrica == "" } {
				ansa:send "PRIVMSG $nick :\037ANSA\037 \002::\002 \037ERROR\037 - Per avere la lista delle news devi specificare la rubrica con\
				\002!ansa list rubrica\002. Le rubriche seguite da $chan sono: [ ansa:rub $chan ]."
			} else {
				set num 1
				set risposta ""
				set ansafile [ open "$ansa(filepath)/$rubrica.news" r ]
				if { [ lsearch -exact $rubriche $rubrica ] > -1 } {
					while { [ gets $ansafile linedb ] > -1 } {
						if { [ regexp -all -- {(.+)\t(.+)\t.+_(\d+).html} $linedb all title description refer ] } {
							set risposta "$risposta - $title (\037$refer\037)"
							if { $num > 4 } { break }
							incr num
						}
					}
					if { $risposta != "" } { ansa:send "PRIVMSG $chan :\037ANSA\037 \002::\002 \[\037$rubrica\037\]$risposta" }
				}
				close $ansafile
			}
		}
		url {
			set id [ lindex $arg 1 ]
			if { [ regexp -- {\d+} $id ] } {
				set url ""
				set found 0
				foreach rubrica [ get:rubriche ] {
					set ansafile [ open "$ansa(filepath)/$rubrica.news" r ]
					while { [ gets $ansafile linedb ] > -1 && $found != 1 } {
						if { [ regexp -all -- {(.+)\t(.*)\t(.+)} $linedb all title description link ] } {
							if { [ string match -nocase *_$id.html $link ] } {
                				set url $link
								ansa:send "PRIVMSG $chan :\037ANSA\037 \002::\002 \[\037$rubrica\037\] \002::\002 $url"
								set found 1
							}
						}
					}
					close $ansafile
				}
			}
		}
	}

	if { [ regexp -- {\d+} $argom ] } {
		set url ""
		set found 0
		foreach rubrica [ get:rubriche ] {
			set ansafile [ open "$ansa(filepath)/$rubrica.news" r ]
			while { [ gets $ansafile linedb ] > -1 && $found != 1 } {
				if { [ regexp -all -- {(.+)\t(.*)\t(.+)} $linedb all title description link ] } {
					if { [ string match -nocase *_$argom.html $link ] } {
			            set url $link
						### STAMPA NOTIZIA
						set http [ ::http::geturl $url ]
						set html [ ::http::data $http ]
						::http::cleanup $http
						if { [ regexp -all -- {<div[^>]* id\=\"content-corpo\"[^>]*>(.+?)</div><!\-\-\s/\#corpo\s\-\->} $html all risposta ] } {
							regsub -all -- {\n} $risposta " " risposta
							regsub -all -- {\s+} $risposta " " risposta
							regsub -all -- {\/} $risposta "/" risposta
							regsub -all -- {\&#\d+;} $risposta "" risposta
							regsub -all -- {</?[^>]+>} $risposta "" risposta
							regsub -- {^\s*\(ANSA\)\s*-?\s*} $risposta "" risposta
							regsub -- {\s*\(ANSA\).*$} $risposta "" risposta
							regsub -all -- {\s\s+} $risposta " " risposta
							set risposta "\037ANSA\037 \002::\002 \[\037$rubrica\037\] (\002$argom\002) [ string trim $risposta ]"
							while { [ string length $risposta ] > 0 } {
								set limit [ strlastpos $risposta " " $max_chars ]
								set risptemp [ string range $risposta 0 $limit ]
								set risposta [ string range $risposta $limit end ]
								if { [ string length $risposta ] != 0 } {
									ansa:send "PRIVMSG $chan :$risptemp ..."
								} else {
									ansa:send "PRIVMSG $chan :$risptemp"
								}
							}
							unset risposta
						}
						set found 1
					}
				}
			}
			close $ansafile
		}
		if { $found != 1 } {
			ansa:send "PRIVMSG $chan :\037ANSA\037 \002::\002 \037ERRORE\037 - Notizia non trovata !"
		}
	}
}

proc ansa:rub chan {
	set rubriche {}
	if { [ validchan $chan ] } {
		foreach rubrica [ get:rubriche ] {
			if { [ lsearch -exact [ channel info $chan ] "+ansa_$rubrica" ] > -1 } { lappend rubriche $rubrica }
		}
	} else {
		foreach chan [ channels ] {
			foreach rubrica [ get:rubriche ] {
				if { [ lsearch -exact [ channel info $chan ] "+ansa_$rubrica" ] > -1 } {
					if { [ lsearch -exact $rubriche $rubrica ] == -1 } { lappend rubriche $rubrica }
				}
			}
		}
	}
	return $rubriche
}

proc ansa:update { tipo rubrica } {
	global ansa
	set ansafile [ open "$ansa(filepath)/$rubrica.news" r ]
	set ansafilet [ open "$ansa(filepath)/$rubrica.tmp" a ]
	while { [ gets $ansafile linedb ] > -1 } {
		if { [ regexp -nocase -- {(.+)\t(.*)\t(.+)} $linedb all title description link ] } {
			if { [ regexp -all -- {.+_(\d+).html} $link all refer ] } {
				lappend riferimenti $refer
			}
		}
	}
	close $ansafile
	set risposta ""

	regsub -all -- {\^RUBRICA} $ansa(url) "$rubrica" url
	set http [ http::geturl $url ]
	set html [ http::data $http ]
	::http::cleanup $http
	regsub -all -- {\n} $html "" html
	regsub -all -- {<item>} $html "\n<item>" html
	
	### Lettura del Feed RSS
	foreach line [ split $html "\n" ] {
		if { [ regexp -nocase -- {<item><title><!\[CDATA\[(.+)\]\]></title><description><!\[CDATA\[(.*)\]\]></description><link>(.+)</link>.*</item>} $line all title description link ] } {
			if { [ regexp -all -- {.+_(\d+).html} $link all refer ] } {
				if { [ info exists riferimenti ] && [ lsearch -exact $riferimenti $refer ] == -1 } {
					regsub -all -- {\/} $title "/" title
					regsub -all -- {\"} $title "'" title
					set risposta "$risposta $title (\037$refer\037)"
				}
				puts $ansafilet "$title\t$description\t$link"
			}
		}
	}
	close $ansafilet

	if { $risposta != "" && $tipo == "new" } {
		set risposta "\037ANSA\037 \002::\002 \[\037$rubrica\037\]$risposta"
		foreach chan [ channels ] {
			set max_chars [ max:privmsg:chars $chan ]
			if { [ lsearch -exact [ channel info $chan ] "+ansa_$rubrica" ] > -1 } {
				if { [ string length $risposta ] > $max_chars } {
					set risptemp [ string range $risposta 0 [ expr $max_chars - 8 ] ]
					ansa:send "privmsg $chan :$risptemp\017..."
					set risptemp [ string range $risposta [ expr $max_chars - 7 ] end ]
					ansa:send "privmsg $chan :\017...$risptemp"
				} else {
					ansa:send "privmsg $chan :$risposta"
				}
			}
		}
	}

	if { [ file exists "$ansa(filepath)/$rubrica.tmp" ] } { 
		file rename -force -- "$ansa(filepath)/$rubrica.tmp" "$ansa(filepath)/$rubrica.news" 
	}
}

proc ansa:check { min ora giorno mese anno } {
	set rubriche [ get:rubriche ]
	if { [ llength $rubriche ] > 0 } {
		if { $anno == 0 } {
			foreach rubrica $rubriche { ansa:update init $rubrica }
			putlog "\037ANSA\037 \002::\002 \037NEWS\037 - News aggiornate"
		} else {
			foreach rubrica $rubriche { ansa:update new $rubrica }
		}
		if { [ file exists "$::ansa(filepath)/$rubrica.tmp" ] } { 
			file rename -force -- "$::ansa(filepath)/$rubrica.tmp" "$::ansa(filepath)/$rubrica.news" 
		}
	}
}

### END PROCS ###


### CREAZIONE DELLA DIRECTORY DI SALVATAGGIO DEI FILE ###
ansa:mkdir $ansa(filepath)

### PULIZIA FILE TEMPORANEI ###
foreach rubrica [ get:rubriche ] {
	if { [ file exists "$ansa(filepath)/$rubrica.tmp" ] } { 
		file rename -force -- "$ansa(filepath)/$rubrica.tmp" "$ansa(filepath)/$rubrica.news" 
	}
	if { ![ file exists "$ansa(filepath)/$rubrica.news" ] } {
		set ansafile [ open "$ansa(filepath)/$rubrica.news" w ]
		close $ansafile
	}
}

after 1500 ansa:check 0 0 0 0 0

I have this error in partyline: Tcl error [ansa:request]: putdccraw is deprecated. Please use putdcc/putnow instead.

Can you help me to resolve it? Thanks.

Post by **caesar** » Fri Mar 01, 2013 9:13 am

The error is self explanatory. How hard it to change an word on your own? Hint:

Code: Select all

putdccraw 0 [string length $str] $str

Kaa · Post by **Kaa** » Fri Mar 01, 2013 9:52 am

caesar wrote:The error is self explanatory. How hard it to change an word on your own? Hint:
Code: Select all
putdccraw 0 [string length $str] $str

I changed before this post:

putdcc 0 [string length $str] $str
putnow 0 [string length $str] $str

but alway error...

Post by **caesar** » Fri Mar 01, 2013 12:16 pm

After doing this change, have you rehashed the bot?

Kaa · Post by **Kaa** » Fri Mar 01, 2013 12:44 pm

caesar wrote:After doing this change, have you rehashed the bot?

putdcc -raw 0 [string length $str] $str

Error: Tcl error [ansa:request]: wrong # args: should be "putdcc idx text ?o ptions?"

putnow 0 [string length $str] $str

Error: Tcl error [ansa:request]: wrong # args: should be "putnow text ?options?"

I do not solve the problem. That's why I made this post.

Post by **SpiKe^^** » Fri Mar 01, 2013 1:25 pm

Try this forum string and see if that helps...
http://forum.egghelp.org/viewtopic.php?p=94646