All pastes #589738 Raw Edit

Anonymous

public text v1 · immutable
#589738 ·published 2007-06-26 04:47 UTC
rendered paste body

# debug mode?
set DEBUG 0

set ALLAversion "1.0.0"

# proxy support. leave empty to disable
set ALLAhost ""
set ALLAport ""

# trigger you want to use
set ALLAtrigger "?item"

# userflags needed to use this script
set ALLArights "-|-"

# use +imdb chan-mode
set ALLAperm 0

# 0 for response via notice to $nick, 1 for msg to $chan
set pub_or_not 1
#################################################################

setudef flag alla
package require http

bind pub $ALLArights $ALLAtrigger alla_proc

proc htmlcodes {tempfile} {
	set mapfile [string map {" ' & & [ ( \ / ] ) { ( } ) £ £ ¨ ¨ © © « « ­ ­ ® ® } $tempfile]
	set mapfile [string map {´ ´ · · ¹ ¹ » » ¼ ¼ ½ ½ ¾ ¾ À À Á Á Â Â } $mapfile]
	set mapfile [string map {Ã Ã Ä Ä Å Å Æ Æ Ç Ç È È É É Ê Ê Ë Ë Ì Ì Í Í Î Î Ï Ï Ð Ð Ñ Ñ Ò Ò Ó Ó Ô Ô Õ Õ Ö Ö } $mapfile]
	set mapfile [string map {× × Ø Ø Ù Ù Ú Ú Û Û Ü Ü Ý Ý Þ Þ ß ß à à á á â â ã ã ä ä å å æ æ ç ç è è é é ê ê } $mapfile]
	set mapfile [string map {ë ë ì ì í í î î ï ï ð ð ñ ñ ò ò ó ó ô ô õ õ ö ö ÷ ÷ ø ø ù ù ú ú û û ü ü ý ý þ þ } $mapfile]
	return $mapfile
}

proc channel_check { chan } {
        foreach setting [channel info $chan] {
                if {[regexp -- {^[\+-]} $setting]} {
                        if {![string compare "+alla" $setting]} {
                                set permission 1
                        } else {
                                set permission 0
                        }
                }
        }
        return $permission
}

proc replacevar {strin what withwhat} {
        set output $strin
        set replacement $withwhat
        set cutpos 0
        while { [string first $what $output] != -1 } {
                set cutstart [expr [string first $what $output] - 1]
                set cutstop  [expr $cutstart + [string length $what] + 1]
                set output [string range $output 0 $cutstart]$replacement[string range $output $cutstop end]
        }
        return $output
}

proc alla_proc { nick uhost handle chan argv } {
	global DEBUG ALLAtrigger announce pub_or_not ALLAperm allablow
        # channel_check permission
	if {$ALLAperm == 1} {
	        set permission_result [channel_check $chan]
	        if {$DEBUG == 1} { putserv "NOTICE $nick :DEBUG permission_result == $permission_result" }
	        if { $permission_result == 0 } { return }
	}
        if {$pub_or_not == 1 } { set toput "PRIVMSG $chan" } else { set toput "NOTICE $nick" }
	set start 0
	set extended 1
	set linkonly 0
	if {$argv == ""} {
		if {$DEBUG == 1} { putserv "NOTICE $nick :DEBUG no argv passed, show help notice" }
		putserv "PRIVMSG $chan :\[\002WoW\002\] try $ALLAtrigger -h"
		return
	}
	if {[lindex $argv 0] == "-h" || [lindex $argv 1] == "-h" || [lindex $argv 2] == "-h" || [lindex $argv 3] == "-h"} {
		if {$DEBUG == 1} { putserv "NOTICE $nick :DEBUG argv == help, show help" }
#		putserv "PRIVMSG $nick :Allakhazam item info v$ALLAversion by Lopo"
#		putserv "PRIVMSG $nick :----------------------------------------------------------------"
#		putserv "PRIVMSG $nick :$ALLAtrigger \[-hl\] <itemname>"
#		putserv "PRIVMSG $nick :     "
#		putserv "PRIVMSG $nick :\002options\002:"
#		putserv "PRIVMSG $nick :\002-h\002    show help"
#		putserv "PRIVMSG $nick :\002-l\002    show only http link"
		return
	}

	# check for commands
	if {[lindex $argv 0] == "-l" || [lindex $argv 1] == "-l" || [lindex $argv 2] == "-l" || [lindex $argv 3] == "-l"} {
		incr start
		incr linkonly
		set moviename [lrange $argv $start end]
		}
	# create moviename using $start
	set moviename [lrange $argv $start end]
	# initial search
	set allaurl "http://wow.allakhazam.com"
	set allasearchurl "http://wow.allakhazam.com/search.html?q="
	set timeout 20000
	set searchString [::http::formatQuery $moviename]
	set searchString [string trimleft $searchString "+"]
	if {$DEBUG == 1} { putserv "NOTICE $nick :DEBUG searchString: \"$searchString\"" }
	set page [::http::config -useragent "MSIE 6.0" -proxyhost $::ALLAhost -proxyport $::ALLAport]
	if {$DEBUG == 1} { putserv "NOTICE $nick :DEBUG ${allasearchurl}$searchString" }
	if {[catch {::http::geturl ${allasearchurl}$searchString -timeout $timeout} page]} {
		putlog "\002ALLA Error\002: $page"
	} elseif {[http::status $page] == "timeout"} {
		putlog "\002ALLA Error\002: Timeout after $timeout seconds"
	}
	set html [::http::data $page]
	::http::Finish $page

	if {$DEBUG == 1} { putserv "NOTICE $nick :DEBUG redirect 0" }
	upvar 0 $page oldpage
	set body $oldpage(body)
	set pos [expr [string first ">0 items found.<" $body] + 0]
	if {$pos != -1} {
		putserv "$toput :0 items found."
		return
		}
	set pos [expr [string first "items found" $body] + 11]
	set body [string range $body $pos end]
	set lpole {}
	set sname [string tolower [replacevar $searchString "+" " "]]
	while {[string length $body] > 0} {
		set pos [expr [string first "/images/icons/" $body]]
		if {$pos == -1} {
			break
			}
		set body [string range $body $pos end]
		set pos [expr [string first "/db/item.html?witem=" $body] + 0]
		set body [string range $body $pos end]
		regexp {witem=[0-9]+} $body itemid
		set itemid [string range $itemid 6 end] 
		if {$DEBUG == 1} { putserv "NOTICE $nick :DEBUG ItemID == $itemid" }
		set pos [expr [string first "name\">" $body] + 6]
		set body [string range $body $pos end]
		set pos1 [expr [string first < $body] - 1]
		set itemname [string range $body 0 $pos1]
		set pole($itemid) $itemname
		lappend lpole $itemid
		set itemname [string tolower $itemname]
		if {$DEBUG == 1} { putserv "NOTICE $nick :DEBUG Itemname == $itemname" }
		set exact [string compare $sname $itemname]
		if {$exact == 0} {
			break
			}
		}
	if {$DEBUG == 1} { putserv "NOTICE $nick :DEBUG lpole == $lpole" }
	if {$DEBUG == 1} { putserv "NOTICE $nick :DEBUG exact == $exact" }
	if {$exact != 0 && [llength $lpole] > 1} {
		putserv "$toput :[llength $lpole] items found"
		foreach i $lpole {
			if {[llength $lpole] < 11} {
				putserv "$toput :http://wow.allakhazam.com/db/item.html?witem=$i - $pole($i)"
				} {
				putserv "PRIVMSG $nick :http://wow.allakhazam.com/db/item.html?witem=$i - $pole($i)"
				}
			}
		return
		}
	set iid $itemid
	if {$DEBUG == 1} { putserv "NOTICE $nick :DEBUG redirect 0 iID == $iid" }
	if {$linkonly>0} {
		putserv "$toput :http://wow.allakhazam.com/db/item.html?witem=$iid"
		return
		}
	set newurl "$allaurl/dev/wow/item-xml.pl?witem=$iid"
	if {$DEBUG == 1} { putserv "NOTICE $nick :DEBUG redirect 0 = $newurl" }
	unset html
	set page [::http::config -useragent "MSIE 6.0" -proxyhost $::ALLAhost -proxyport $::ALLAport]
	if {[catch {::http::geturl $newurl -timeout $timeout} page]} {
		putlog "\002ALLA Error\002: $page"
	} elseif {[http::status $page] == "timeout"} {
		putlog "\002ALLA Error\002: Timeout after $timeout mseconds"
		if {$DEBUG == 1} { putserv "NOTICE $nick :DEBUG Timeout after $timeout mseconds"}
		return
	}
	set html [::http::data $page]
	::http::Finish $page
	# for bogus searches
	if {[string length $newurl] == 0} {
		putserv "$toput :No no no! I can't find that!"
		if {$DEBUG == 1} { putserv "NOTICE $nick :DEBUG bogus searches" }
		return
	}
	set iname "N/A"; set idesc "N/A"
	## get title
	if [regexp {<name1>[^<]+} $html iname] {
		set pos [expr [string last > $iname] + 1]
		set iname [string range $iname $pos end]
		set iname [htmlcodes $iname]
	}
	if {$DEBUG == 1} { putserv "NOTICE $nick :DEBUG iname == $iname" }
## full desc
	set fhtml {}
	set beg 0
	foreach i $html {
		set pos [string first "<display_html>" $i]
		if {$pos>-1} {
			set fhtml [string range $i $pos end]
			set beg 1
			continue
			}
		set pos1 [string first "</display_html>" $i]
		if {$pos1>-1} {
			append fhtml " "
			append fhtml [string range $i 0 $pos1]
			break
			}
		append fhtml " "
		append fhtml $i
		}
	set pos [expr [string first > $fhtml] + 1]
	set pos1 [expr [string last < $fhtml] - 1]
	set popis [string range $fhtml $pos $pos1]
	set phtml [replacevar $popis "&amp;nbsp;" " "]
	set phtml [replacevar $phtml "&lt;" "<"]
	set phtml [replacevar $phtml "&gt;" ">"]
	set phtml [replacevar $phtml "&quot;" "\""]
	set phtml [replacevar $phtml " <" "<"]
	set phtml [replacevar $phtml "> " ">"]
	set phtml [replacevar $phtml "<br />" "<br/>"]
	set pos [expr [string first "<span class=\"akznotice\">" $phtml] -1]
	set dhtml [string range $phtml 0 $pos]
	set pos [expr [string first $iname $dhtml] + [string length $iname]]
	set icname [string range $dhtml 0 $pos]
	set pos1 [expr [string last "\"" $icname] - 5]
	set icname [string range $icname 0 $pos1]
	set pos1 [expr [string last "\"" $icname] + 1]
	set icname [string range $icname $pos1 end]
	set dhtml [string range $dhtml $pos end]
	set pos [expr [string first "<br/>" $dhtml] + 5]
	set dhtml [string range $dhtml $pos end]
	set dhtml [htmlcodes $dhtml]
	set out {}
	set len [expr [string length $dhtml]]
	while {$len>0} {
		set pos [expr [string first < $dhtml]]
		if {$pos == -1} {
			lappend out $dhtml
			break;
			}
		if {$pos == 0} {
			set pos [expr [string first > $dhtml] + 1]
			set dhtml [string range $dhtml $pos end]
			continue
			}
		set pos1 [expr [string first < $dhtml] - 1]
		set line [string range $dhtml 0 $pos1]
		lappend out $line
		set dhtml [string range $dhtml $pos end]
		set len [string length $dhtml]
		}
	if {$DEBUG == 1} { putserv "NOTICE $nick :DEBUG out == $out" }
	putserv "$toput : Item: $iname ($icname)"
	foreach line $out {
		putserv "$toput :$line"
        }
	putserv "$toput :http://wow.allakhazam.com/db/item.html?witem=$iid"
}
putlog "alla info - v$ALLAversion loaded ..."