first commit

README

@@ -0,0 +1 @@
+miscellaneous tcl eggdrop scripts

calc.tcl

@@ -0,0 +1,25 @@
+# created by fedex
+
+bind pub - !calc safe_calc
+setudef flag calc
+
+proc is_op {str} {
+	return [expr [lsearch {{ } . + - * / ( ) %} $str] != -1]
+}
+
+proc safe_calc {nick uhost hand chan str} {
+	if {![channel get $chan calc]} { return }
+	foreach char [split $str {}] {
+		if {![is_op $char] && ![string is integer $char]} {
+			putserv "PRIVMSG $chan :$nick: Invalid expression for calc."
+			return
+		}
+	}
+
+	if {[catch {expr $str} out]} {
+		putserv "PRIVMSG $chan :$nick: Invalid equation."
+		return
+	} else {
+		putserv "PRIVMSG $chan :$str = $out"
+	}
+}

google.tcl

@@ -0,0 +1,231 @@
+#
+# 0.2 - May 10 2010
+#  - fix for garbled utf chars in api queries
+#  - added +google channel flag to enable
+#  - strip html from !convert as some formatting may be present
+#  - fix decode_html to convert html utf to hex
+#  - convert <sup></sup> to exponent
+#
+# 0.1 - Some time in April 2010
+#  - Initial release
+#
+# Created Feb 28 2010
+#
+# Requires Tcl 8.5+
+# Requires tcllib for json
+#
+
+package require http
+package require json
+
+namespace eval google {
+	#variable output_cmd "cd::putnow"
+	variable output_cmd "putserv"
+
+	# Not enforced for API queries
+	variable useragent "Lynx/2.8.8dev.2 libwww-FM/2.14 SSL-MM/1.4.1"
+
+	variable convert_url "http://www.google.ca/search"
+	variable convert_regexp {<table class=std>.*?<b>(.*?)</b>.*?</table>}
+
+	variable api_url "http://ajax.googleapis.com/ajax/services/search/"
+
+	variable api_referer "http://www.egghelp.org"
+
+	bind pub	-|- "!g" google::search
+	bind pub	-|- "!google" google::search
+	bind pub	-|- "!news" google::news
+	bind pub	-|- "!images" google::images
+	bind pub	-|- "!convert" google::convert
+
+	setudef flag google
+}
+
+
+proc google::convert_fetch {terms} {
+	http::config -useragent $google::useragent
+
+	set query [http::formatQuery q $terms]
+	set token [http::geturl ${google::convert_url}?${query}]
+	set data [http::data $token]
+	set ncode [http::ncode $token]
+	http::cleanup $token
+
+	# debug
+	#set fid [open "g-debug.txt" w]
+	#puts $fid $data
+	#close $fid
+
+	if {$ncode != 200} {
+		error "HTTP query failed: $ncode"
+	}
+
+	return $data
+}
+
+
+proc google::convert_parse {html} {
+	if {![regexp -- $google::convert_regexp $html -> result]} {
+		error "Parse error or no result"
+	}
+	set result [google::decode_html $result]
+	# change <sup>num</sup> to ^num (exponent)
+	set result [regsub -all -- {<sup>(.*?)</sup>} $result {^\1}]
+	# strip rest of html code
+	return [regsub -all -- {<.*?>} $result ""]
+}
+
+
+# Query normal html for conversions
+proc google::convert {nick uhost hand chan argv} {
+	if {![channel get $chan google]} { return }
+
+	if {[string length $argv] == 0} {
+		$google::output_cmd "PRIVMSG $chan :Please provide a query."
+		return
+	}
+
+	if {[catch {google::convert_fetch $argv} data]} {
+		$google::output_cmd "PRIVMSG $chan :Error fetching results: $data."
+		return
+	}
+
+	if {[catch {google::convert_parse $data} result]} {
+		$google::output_cmd "PRIVMSG $chan :Error: $result."
+		return
+	}
+
+	$google::output_cmd "PRIVMSG $chan :\002$result\002"
+}
+
+
+# Output for results from api query
+proc google::output {chan url title content} {
+	regsub -all -- {(?:<b>|</b>)} $title "\002" title
+	set output "$title @ $url"
+	$google::output_cmd "PRIVMSG $chan :[google::decode_html $output]"
+}
+
+
+# Return results from API query of $url
+proc google::api_fetch {terms url} {
+	set query [http::formatQuery v "1.0" q $terms safe off]
+	set headers [list Referer $google::api_referer]
+
+	set token [http::geturl ${url}?${query} -headers $headers -method GET -binary 1]
+	set data [http::data $token]
+	set ncode [http::ncode $token]
+	http::cleanup $token
+
+	# debug
+	#set fid [open "g-debug.txt" w]
+	#fconfigure $fid -translation binary -encoding binary
+	#puts $fid $data
+	#close $fid
+
+	if {$ncode != 200} {
+		error "HTTP query failed: $ncode"
+	}
+
+	return [json::json2dict $data]
+}
+
+
+# Validate input and then return list of results
+proc google::api_validate {argv url} {
+	if {[string length $argv] == 0} {
+		error "Please supply search terms."
+	}
+
+	if {[catch {google::api_fetch $argv $url} data]} {
+		error "Error fetching results: $data."
+	}
+
+	set response [dict get $data responseData]
+	set results [dict get $response results]
+
+	if {[llength $results] == 0} {
+		error "No results."
+	}
+
+	return $results
+}
+
+
+# Query api
+proc google::api_handler {chan argv url} {
+	if {[catch {google::api_validate $argv $url} results]} {
+		$google::output_cmd "PRIVMSG $chan :$results"
+		return
+	}
+
+	foreach result $results {
+		dict with result {
+			# $language holds lang in news results, doesn't exist in web results
+			if {![info exists language] || $language == "en"} {
+				google::output $chan $unescapedUrl $title $content
+			}
+		}
+	}
+}
+
+
+# Regular API search
+proc google::search {nick uhost hand chan argv} {
+	if {![channel get $chan google]} { return }
+
+	google::api_handler $chan $argv ${google::api_url}web
+}
+
+
+# News from API
+proc google::news {nick uhost hand chan argv} {
+	if {![channel get $chan google]} { return }
+
+	google::api_handler $chan $argv ${google::api_url}news
+}
+
+
+# Images from API
+proc google::images {nick uhost hand chan argv} {
+	if {![channel get $chan google]} { return }
+
+	google::api_handler $chan $argv ${google::api_url}images
+}
+
+# From perpleXa's urbandictionary script
+# Replaces html special chars with their hex equivalent
+proc google::decode_html {content} {
+	if {![string match *&* $content]} {
+		return $content;
+	}
+	set escapes {
+		&nbsp; \x20 &quot; \x22 &amp; \x26 &apos; \x27 &ndash; \x2D
+		&lt; \x3C &gt; \x3E &tilde; \x7E &euro; \x80 &iexcl; \xA1
+		&cent; \xA2 &pound; \xA3 &curren; \xA4 &yen; \xA5 &brvbar; \xA6
+		&sect; \xA7 &uml; \xA8 &copy; \xA9 &ordf; \xAA &laquo; \xAB
+		&not; \xAC &shy; \xAD &reg; \xAE &hibar; \xAF &deg; \xB0
+		&plusmn; \xB1 &sup2; \xB2 &sup3; \xB3 &acute; \xB4 &micro; \xB5
+		&para; \xB6 &middot; \xB7 &cedil; \xB8 &sup1; \xB9 &ordm; \xBA
+		&raquo; \xBB &frac14; \xBC &frac12; \xBD &frac34; \xBE &iquest; \xBF
+		&Agrave; \xC0 &Aacute; \xC1 &Acirc; \xC2 &Atilde; \xC3 &Auml; \xC4
+		&Aring; \xC5 &AElig; \xC6 &Ccedil; \xC7 &Egrave; \xC8 &Eacute; \xC9
+		&Ecirc; \xCA &Euml; \xCB &Igrave; \xCC &Iacute; \xCD &Icirc; \xCE
+		&Iuml; \xCF &ETH; \xD0 &Ntilde; \xD1 &Ograve; \xD2 &Oacute; \xD3
+		&Ocirc; \xD4 &Otilde; \xD5 &Ouml; \xD6 &times; \xD7 &Oslash; \xD8
+		&Ugrave; \xD9 &Uacute; \xDA &Ucirc; \xDB &Uuml; \xDC &Yacute; \xDD
+		&THORN; \xDE &szlig; \xDF &agrave; \xE0 &aacute; \xE1 &acirc; \xE2
+		&atilde; \xE3 &auml; \xE4 &aring; \xE5 &aelig; \xE6 &ccedil; \xE7
+		&egrave; \xE8 &eacute; \xE9 &ecirc; \xEA &euml; \xEB &igrave; \xEC
+		&iacute; \xED &icirc; \xEE &iuml; \xEF &eth; \xF0 &ntilde; \xF1
+		&ograve; \xF2 &oacute; \xF3 &ocirc; \xF4 &otilde; \xF5 &ouml; \xF6
+		&divide; \xF7 &oslash; \xF8 &ugrave; \xF9 &uacute; \xFA &ucirc; \xFB
+		&uuml; \xFC &yacute; \xFD &thorn; \xFE &yuml; \xFF
+	};
+	set content [string map $escapes $content];
+	set content [string map [list "\]" "\\\]" "\[" "\\\[" "\$" "\\\$" "\\" "\\\\"] $content];
+	regsub -all -- {&#([[:digit:]]{1,5});} $content {[format %c [string trimleft "\1" "0"]]} content;
+	regsub -all -- {&#x([[:xdigit:]]{1,4});} $content {[format %c [scan "\1" %x]]} content;
+	regsub -all -- {&#?[[:alnum:]]{2,7};} $content "?" content;
+	return [subst $content];
+}

horgh_autoop.tcl

@@ -0,0 +1,23 @@
+# Auto op script. Ops everyone in channels set +horgh_autoop
+#
+#
+# Last change Sat Nov 15 17:18:29 PST 2008
+#
+# Created Thu Oct 23 18:32:36 PDT 2008
+# By horgh
+
+setudef flag horgh_autoop
+
+bind join -|- * horgh_autoop::horgh_autoop
+
+namespace eval horgh_autoop {
+}
+
+proc horgh_autoop::horgh_autoop {nick host hand chan} {
+	if {![channel get $chan horgh_autoop]} { return }
+	if {[string match -nocase "GoodOne*" $nick]} { return }
+	if {[string match -nocase "*.fr" $host]} { return }
+	quote::putnow "MODE $chan +o $nick"
+}
+
+putlog "horgh_autoop.tcl loaded"

irb.tcl

@@ -0,0 +1,105 @@
+#
+# 0.1 - May 15 2010
+#
+# by horgh (www.summercat.com)
+#
+# A _VERY UNSAFE_ wrapper for irb <-> irc via eggdrop
+#
+# Setup:
+# - make sure you set/check the 3 variables (channel, command char, irb path)
+#
+# Usage:
+# - {command_char}reset to get a fresh irb session
+#
+# - any commands prefixed with command_char are sent to irb and the result is
+#   posted to the channel
+#   - e.g.
+#     <@horgh> 'test
+#     <@Yorick> Starting new irb session...
+#     <@Yorick> => ArgumentError: wrong number of arguments
+#     <@Yorick> =>     from (irb):1:in `test'
+#     <@Yorick> =>     from (irb):1
+#
+# BUGS:
+#  - since "=>" isn't shown from the open call for some reason (perhaps it goes
+#    to stderr or something, i'm not sure), some results that print on same line
+#    do not display nicely, such as:
+#      '5.times { print "*" }
+#      results in "=> *****5" whereas it should be "*****=> 5" from the prompt
+#
+
+namespace eval irb {
+	# Settings
+
+	# channel to respond to irb commands / send output
+	set channel #YOUR_CHANNEL
+	# system path to irb binary
+	set irb {/usr/local/bin/irb}
+	# prefix character for sending data to irb
+	set command_char "'"
+
+	#set output_cmd cd::putnow
+	set output_cmd putserv
+
+	# You shouldn't need to edit anything below here
+
+	set irb_chan []
+	# store commands entered here so we don't output them
+	# they are deleted as they come up from reading irb output
+	set cmd_cache []
+
+	bind pubm -|- "*" irb::put
+	bind pub -|- "${command_char}reset" irb::reset
+	bind evnt -|- "prerestart" irb::end
+	bind evnt -|- "prerehash" irb::end
+}
+
+proc irb::put {nick uhost hand chan argv} {
+	if {$chan != $irb::channel} { return }
+	if {[string index $argv 0] != $irb::command_char} { return}
+
+	set cmd [string range $argv 1 end]
+	if {$cmd == "reset" } { return }
+	if {$cmd == ""} { return }
+
+	if {$irb::irb_chan == []} {
+		setup_irb
+	}
+
+	lappend irb::cmd_cache $cmd
+	puts $irb::irb_chan $cmd
+}
+
+proc irb::reset {nick uhost hand chan argv} {
+	$irb::output_cmd "PRIVMSG $irb::channel :Closing irb session."
+	irb::end
+}
+
+proc irb::setup_irb {} {
+	$irb::output_cmd "PRIVMSG $irb::channel :Starting new irb session..."
+	set irb::irb_chan [open "|${irb::irb}" r+]
+	fconfigure $irb::irb_chan -blocking 1 -buffering line
+	# call irb::output when data to be read
+	fileevent $irb::irb_chan readable irb::output
+}
+
+proc irb::output {} {
+	set output [gets $irb::irb_chan]
+	set output [string map {\t "    "} $output]
+	
+	# check if it is a command sent to irb rather than a result (to not print)
+	set index [lsearch -exact $irb::cmd_cache $output]
+	if {$index >= 0} {
+		set irb::cmd_cache [lreplace $irb::cmd_cache $index $index]
+	} else {
+		$irb::output_cmd "PRIVMSG $irb::channel :=> $output"
+	}
+}
+
+# We close channel before restart/rehash
+proc irb::end {args} {
+	close $irb::irb_chan
+	set irb::irb_chan []
+}
+
+putlog "irb.tcl loaded"

latoc.tcl

@@ -0,0 +1,129 @@
+# to debug this
+      #set junk [open "ig-debug.txt" w]
+      #puts $junk $html
+      #close $junk
+
+package require http
+
+bind pub -|- "!oil" latoc::oil_handler
+#bind pub -|- "!gold" latoc::gold_handler
+bind pub -|- "!c" latoc::commodity_handler
+bind pub -|- "!silver" latoc::silver_handler
+bind pub -|- "!url" latoc::url_handler
+
+setudef flag latoc
+
+namespace eval latoc {
+	variable user_agent "Lynx/2.8.5rel.1 libwww-FM/2.14 SSL-MM/1.4.1 OpenSSL/0.9.7e"
+	variable output_cmd putserv
+
+	variable list_regexp {<tr><td class="first">.*?<td class="last">.*?</td></tr>}
+	#variable stock_regexp {<a href="/q\?s=(.*?)">.*?<td class="second name">(.*?)</td><td><b><span id=".*?">(.*?)</span></b> <nobr><span .*?>(.*?)(?:</span>)??</nobr>.*?(?:alt="(.*?)">)?? <b style="color.*?;">(.*?)</b>.*?<b style="color.*?;"> \((.*?)\)</b>}
+	variable stock_regexp {<a href="/q\?s=(.*?)">.*?<td class="second name">(.*?)</td>.*?<span id=".*?">(.*?)</span></b> <nobr><span id=".*?">(.*?)</span></nobr>.*?(?:alt="(.*?)">)?? <b style="color.*?;">(.*?)</b>.*?<b style="color.*?;"> \((.*?)\)</b>}
+
+	variable commodities [list energy metals grains livestock softs]
+	variable energy_futures "http://finance.yahoo.com/futures?t=energy"
+	variable commodities_url "http://finance.yahoo.com/futures?t="
+}
+
+proc latoc::url_handler {nick uhost hand chan argv} {
+	$latoc::output_cmd "PRIVMSG $chan :$latoc::commodities_url"
+}
+
+proc latoc::commodity_handler {nick uhost hand chan argv} {
+	if {![channel get $chan latoc]} { return }
+	if {[lsearch $latoc::commodities $argv] == -1} {
+		$latoc::output_cmd "PRIVMSG $chan :Valid commodities are: $latoc::commodities"
+		return
+	}
+
+	set token [http::geturl "${latoc::commodities_url}$argv" -timeout 60000]
+	if {![string match "ok" [http::status $token]]} {
+		$latoc::output_cmd "PRIVMSG $chan :Error."
+		return
+	}
+
+# debug stuff
+#	set html [http::data $token]
+#	set junk [open "commodity-debug.txt" w]
+#	puts $junk $html
+#	close $junk
+
+	foreach stock [regexp -all -inline -- $latoc::list_regexp [http::data $token]] {
+		regexp $latoc::stock_regexp $stock -> symbol name price last direction change percent
+		$latoc::output_cmd "PRIVMSG $chan :[latoc::format $name $price $last $direction $change $percent]"
+	}
+}
+
+proc latoc::oil_handler {nick uhost hand chan argv} {
+	if {![channel get $chan latoc]} { return }
+
+	set token [http::geturl $latoc::energy_futures -timeout 60000]
+
+# debug stuff
+#	set html [http::data $token]
+#	set junk [open "oil-debug.txt" w]
+#	puts $junk $html
+#	close $junk
+
+	if {![string match "ok" [http::status $token]]} {
+		$latoc::output_cmd "PRIVMSG $chan :Error."
+		return
+	}
+
+	foreach stock [regexp -all -inline -- $latoc::list_regexp [http::data $token]] {
+		regexp $latoc::stock_regexp $stock -> symbol name price last direction change percent
+		$latoc::output_cmd "PRIVMSG $chan :[latoc::format $name $price $last $direction $change $percent]"
+		break
+	}
+}
+
+proc latoc::gold_handler {nick uhost hand chan argv} {
+	if {![channel get $chan latoc]} { return }
+
+	set token [http::geturl ${latoc::commodities_url}metals -timeout 60000]
+	if {![string match "ok" [http::status $token]]} {
+		$latoc::output_cmd "PRIVMSG $chan :Error."
+		return
+	}
+
+	foreach stock [regexp -all -inline -- $latoc::list_regexp [http::data $token]] {
+		regexp $latoc::stock_regexp $stock -> symbol name price last direction change percent
+		if {[string match -nocase "*Gold*" $name]} {
+			$latoc::output_cmd "PRIVMSG $chan :[latoc::format $name $price $last $direction $change $percent]"
+		}
+	}
+}
+
+proc latoc::silver_handler {nick uhost hand chan argv} {
+	if {![channel get $chan latoc]} { return }
+
+	set token [http::geturl ${latoc::commodities_url}metals -timeout 60000]
+	if {![string match "ok" [http::status $token]]} {
+		$latoc::output_cmd "PRIVMSG $chan :Error."
+		return
+	}
+
+	foreach stock [regexp -all -inline -- $latoc::list_regexp [http::data $token]] {
+		regexp $latoc::stock_regexp $stock -> symbol name price last direction change percent
+		if {[string match -nocase "*Silver*" $name]} {
+			$latoc::output_cmd "PRIVMSG $chan :[latoc::format $name $price $last $direction $change $percent]"
+		}
+	}
+}
+
+proc latoc::format {name price last direction change percent} {
+# this cuts off the Jun 09 part from Crude Oil Jun 09
+#	set name [lrange $name 0 [expr [llength $name]-3]]
+	return "$name: \00310$price [latoc::colour $direction $change] [latoc::colour $direction $percent]\003 $last"
+}
+
+proc latoc::colour {direction value} {
+	if {[string match "Down" $direction]} {
+		return \00304-$value\017
+	} elseif {[string match "Up" $direction]} {
+		return \00309+$value\017
+	} else {
+		return $value
+	}
+}