Eggdrop TCL script

Programovacie jazyky, rady, poradňa...
DjBass
Darca
Darca
Používateľov profilový obrázok
Príspevky: 2068
Registrovaný: 24 máj 2008, 13:07
Bydlisko: Košice
Kontaktovať používateľa:

Eggdrop TCL script

Príspevok od používateľa DjBass »

Zdravím, nevedeli by ste niekto tento script upraviť tak, aby na IRC dával výsledky hľadania bez diakritiky? Ďakujem.

Kód: Vybrať všetko

package require http

bind pub - !google pub:google
bind pub - !g pub:google
bind pub m !debug pub:debug

set agent "Mozilla"

# Tryb Debug. Jesli ustawiony na "1", bot bedzie wyswietlal na kanale wartosci zmiennych zamiast gotowego wyniku. Domyslnie: "0".
# Aby zmienic status trybu debug wpisz !debug on/off na kanale. Aby zobaczyc obecny status, wpisz !debug bez parametrow.

set debug "0"

proc pub:debug { nick uhost handle channel arg } {
 global debug
	if {[llength $arg]==0} {
		if { $debug == "0" } {
		putserv "PRIVMSG $channel :\002\[NOTICE\]\002 Tryb \002debug\002 jest teraz \00304wylaczony\003"
		} else {
		putserv "PRIVMSG $channel :\002\[NOTICE\]\002 Tryb \002debug\002 jest teraz \00303wlaczony\003"
		}
	} else {
		if { $arg == "on" } {
			set debug "1"
			putserv "PRIVMSG $channel :\002\[NOTICE\]\002 Tryb \002debug\002 jest teraz \00303wlaczony\003"
		} elseif { $arg == "off" } {
			set debug "0"
			putserv "PRIVMSG $channel :\002\[NOTICE\]\002 Tryb \002debug\002 jest teraz \00304wylaczony\003"
		}
	}
}

proc pub:google { nick uhost handle channel arg } {
 global agent
 global debug
	if {[llength $arg]==0} {
		putserv "PRIVMSG $channel :$nick: Naucz sie kur*a z google korzystac ;X"
	} else {
		set query "http://www.google.sk/custom?hl=sk&q=$arg&ieUTF-8"
		set query [string map {" " "+"} $query]
	       set token [http::config -useragent $agent]
		set token [http::geturl $query]
		set token [http::geturl $query]; regexp -nocase {(.*)} [http::data $token] -> title; http::cleanup $token;
		set token [http::geturl $query]; regexp -nocase {<a href="([^"]+)" class=l[^>]*>} [http::data $token] -> newurl; http::cleanup $token;
		set title [string map {"<em>" "\002*"} $title]
		set title [string map {"</em>" "*\002"} $title]
		set title [string map {"–" "-"} $title]
		set title [string map {"—" "--"} $title]
		set title [string map {"•" "-"} $title]
#### ZAKOMENTUJ, JESLI NIE MA PRACOWAC W UTF-8!
		set title [encoding convertfrom utf-8 $title] 
#####
		 regexp {class=l[^>]*>([^>]*)</a>} $title -> title2
			if {$debug==1} {
				putserv "PRIVMSG $channel :\002\[DEBUG\]\002 \$query = $query"
				if { [info exists title2] } {
					putserv "PRIVMSG $channel :\002\[DEBUG\]\002 \$title2 = $title2"
				} else { 
					putserv "PRIVMSG $channel :\002\[DEBUG\]\002 \$title2 = \002zmienna nie istnieje!\002"
				}
				if { [info exists newurl] } {
				putserv "PRIVMSG $channel :\002\[DEBUG\]\002 \$newurl = $newurl" 
				} else {
				putserv "PRIVMSG $channel :\002\[DEBUG\]\002 \$newurl = \002zmienna nie istnieje!\002" 
				}
			} else {
				if { [info exists title2] && [info exists newurl] } {
				putserv "PRIVMSG $channel :\002\[GOOGLE\]\002 $title2 -> $newurl"
				} else {
				putserv "PRIVMSG $channel :\002\[GOOGLE\]\002 Nic nie znalazlem ;<"
				}
			}
	}
}

putlog "Google 0.9.beta by samaelszafran (www.samaelszafran.pl) loaded!"
Napísať odpoveď