├── .gitignore
├── README.md
├── bash.tcl
├── calc.tcl
├── deprecated
    ├── bloomberg.tcl
    ├── github_watch.tcl
    ├── google.tcl
    ├── isgd.tcl
    └── vantrash.tcl
├── dictionary.tcl
├── dictionary_test.tcl
├── horgh_autoop.tcl
├── irb.tcl
├── latoc.tcl
├── mysqlquote.tcl
├── patternban.tcl
├── slang.tcl
├── userrec.tcl
├── weather-darksky.conf.sample
├── weather-darksky.tcl
└── wiki.tcl


/.gitignore:
--------------------------------------------------------------------------------
1 | *.swp
2 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
 1 | This is a collection of scripts for the [Eggdrop](https://eggheads.org) IRC
 2 | bot. Most of them I've written, but some are edited versions of those
 3 | written by others.
 4 | 
 5 | 
 6 | # Scripts
 7 | 
 8 | * bash.tcl - Fetch and output bash.org quotes.
 9 | * calc.tcl - Provide `!calc` calculator function.
10 | * dictionary.tcl - Make your bot respond to certain words/phrases.
11 |   * This is a heavily modified version of dictionary.tcl 2.7 by perpleXa.
12 | * horgh_autoop.tcl - Automatically op all users in a channel which is set
13 |   `+horgh_autoop`.
14 | * irb.tcl - Provide access to a Ruby interpreter in a channel. Very unsafe.
15 | * latoc.tcl - Query Yahoo commodity listings for oil, gold, and silver
16 |   futures.
17 | * mysqlquote.tcl - Store and display quotes from a MySQL database.
18 |   * I use
19 |     [sqlquote.pl](https://github.com/horgh/irssi-scripts/blob/master/sqlquote.pl)
20 |     these days.
21 | * patternban.tcl - Ban people based on patterns. The patterns can be
22 |   managed through binds.
23 | * slang.tcl - Fetch and output definitions from urbandictionary.com.
24 | * userrec.tcl - Provide access to the Eggdrop's user records by telling
25 |   people in a channel who the bot thinks they are.
26 | * weather-darksky.tcl - Look up weather from [Dark
27 |   Sky](https://darksky.net).
28 | * wiki.tcl - Fetch and output synopses from wikipedia.org.
29 | 
30 | Note some of these scripts may not work. Sometimes the APIs or webpages
31 | they scrape go away or change and I might not use them any more and not
32 | notice. If one doesn't work, please let me know, and I'll try to fix it (or
33 | send me a pull request!). If it can't be fixed (or I don't want to for some
34 | reason), it will be moved into the deprecated directory.
35 | 
36 | You might also be interested in [my Irssi
37 | scripts](https://github.com/horgh/irssi-scripts/) and my [Irssi Tcl
38 | scripts](https://github.com/horgh/irssi-tcl-scripts/).
39 | 
40 | # License
41 | All scripts written by me in this repository are Public domain. Those not
42 | written by me (even if edited) are under whatever license specified by
43 | their authors.
44 | 


--------------------------------------------------------------------------------
/bash.tcl:
--------------------------------------------------------------------------------
  1 | # bash.org quote fetcher
  2 | # Must .chanset #channel +bash
  3 | #
  4 | # Usage: !bash [optional search terms]
  5 | # If search terms are not provided, fetch random quotes.
  6 | #
  7 | # Keeps fetched quotes in memory until displayed, including all results per
  8 | # search term
  9 | package require http
 10 | package require htmlparse
 11 | 
 12 | namespace eval ::bash {
 13 | 	variable trigger !bash
 14 | 	variable line_length 399
 15 | 	variable max_lines 10
 16 | 
 17 | 	variable useragent "Mozilla/5.0 (compatible; Y!J; for robot study; keyoshid)"
 18 | 
 19 | 	variable output_cmd putserv
 20 | 
 21 | 	setudef flag bash
 22 | 	bind pub -|- $::bash::trigger ::bash::handler
 23 | 
 24 | 	variable url http://bash.org/?
 25 | 
 26 | 	variable list_regexp {<p class="quote">.*?<p class="qt">.*?</p>}
 27 | 	variable quote_regexp {<p class="quote">.*?<b>#(.*?)</b>.*?class="qa".*?</a>\((.*)\)<a.*?<p class="qt">(.*?)</p>}
 28 | 
 29 | 	variable random_quotes []
 30 | 	variable search_quotes []
 31 | }
 32 | 
 33 | proc ::bash::quote_output {chan quote} {
 34 | 	if {$quote == ""} {
 35 | 		$::bash::output_cmd "PRIVMSG $chan :No result!"
 36 | 		return
 37 | 	}
 38 | 	set number [dict get $quote number]
 39 | 	set rating [dict get $quote rating]
 40 | 	set quote [::htmlparse::mapEscapes [dict get $quote quote]]
 41 | 	set quote [regsub -all -- {<br />} $quote ""]
 42 | 
 43 | 	$::bash::output_cmd "PRIVMSG $chan :#\002${number}\002 (Rating: ${rating})"
 44 | 	foreach line [split $quote \n] {
 45 | 		if {[incr count] > $::bash::max_lines} {
 46 | 			$::bash::output_cmd "PRIVMSG $chan :Output truncated. ${::bash::url}${number}"
 47 | 			break
 48 | 		}
 49 | 		foreach subline [::bash::split_line $::bash::line_length $line] {
 50 | 			$::bash::output_cmd "PRIVMSG $chan : $subline"
 51 | 		}
 52 | 	}
 53 | }
 54 | 
 55 | proc ::bash::handler {nick uhost hand chan argv} {
 56 | 	if {![channel get $chan bash]} { return }
 57 | 	if {$argv == ""} {
 58 | 		if {[catch {::bash::random $chan} result]} {
 59 | 			$::bash::output_cmd "PRIVMSG $chan :Error: $result"
 60 | 			return
 61 | 		}
 62 | 		::bash::quote_output $chan $result
 63 | 	} else {
 64 | 		if {[catch {::bash::search $argv $chan} result]} {
 65 | 			$::bash::output_cmd "PRIVMSG $chan :Error: $result"
 66 | 			return
 67 | 		}
 68 | 		::bash::quote_output $chan $result
 69 | 	}
 70 | }
 71 | 
 72 | proc ::bash::random {chan} {
 73 | 	if {![llength $::bash::random_quotes]} {
 74 | 		$::bash::output_cmd "PRIVMSG $chan :Fetching new random quotes..."
 75 | 		set ::bash::random_quotes [::bash::fetch ${::bash::url}random1]
 76 | 	}
 77 | 	set quote [lindex $::bash::random_quotes 0]
 78 | 	set ::bash::random_quotes [lreplace $::bash::random_quotes 0 0]
 79 | 	return $quote
 80 | }
 81 | 
 82 | proc ::bash::search {query chan} {
 83 | 	if {![dict exists $::bash::search_quotes $query]} {
 84 | 		$::bash::output_cmd "PRIVMSG $chan :Fetching results..."
 85 | 		set url ${::bash::url}[::http::formatQuery search $query sort 0 show 25]
 86 | 		dict set ::bash::search_quotes $query [::bash::fetch $url]
 87 | 	}
 88 | 	set quotes [dict get $::bash::search_quotes $query]
 89 | 	set quote [lindex $quotes 0]
 90 | 	set quotes [lreplace $quotes 0 0]
 91 | 
 92 | 	# Remove key if no more quotes after removal of one, else set quotes to remaining
 93 | 	if {![llength $quotes]} {
 94 | 		dict unset ::bash::search_quotes $query
 95 | 	} else {
 96 | 		dict set ::bash::search_quotes $query $quotes
 97 | 	}
 98 | 
 99 | 	return $quote
100 | }
101 | 
102 | proc ::bash::fetch {url} {
103 | 	::http::config -useragent $::bash::useragent
104 | 	set token [::http::geturl $url -timeout 10000]
105 | 	set data [::http::data $token]
106 | 	set ncode [::http::ncode $token]
107 | 	::http::cleanup $token
108 | 
109 | 	if {$ncode != 200} {
110 | 		error "HTTP fetch error $ncode: $data"
111 | 	}
112 | 
113 | 	return [::bash::parse $data]
114 | }
115 | 
116 | proc ::bash::parse {html} {
117 | 	set quotes []
118 | 	foreach raw_quote [regexp -all -inline -- $::bash::list_regexp $html] {
119 | 		if {![regexp $::bash::quote_regexp $raw_quote -> number rating quote]} {
120 | 			error "Parse error"
121 | 		}
122 | 		# Strip <font color=green|red> from rating
123 | 		regsub -all {<font.*?>} $rating {} rating
124 | 		regsub -all {</font>} $rating {} rating
125 | 		lappend quotes [list number $number rating $rating quote $quote]
126 | 	}
127 | 	return $quotes
128 | }
129 | 
130 | # by fedex
131 | proc ::bash::split_line {max str} {
132 | 	set last [expr {[string length $str] -1}]
133 | 	set start 0
134 | 	set end [expr {$max -1}]
135 | 
136 | 	set lines []
137 | 
138 | 	while {$start <= $last} {
139 | 		if {$last >= $end} {
140 | 			set end [string last { } $str $end]
141 | 		}
142 | 
143 | 		lappend lines [string trim [string range $str $start $end]]
144 | 		set start $end
145 | 		set end [expr {$start + $max}]
146 | 	}
147 | 
148 | 	return $lines
149 | }
150 | 
151 | putlog "bash.tcl loaded"
152 | 


--------------------------------------------------------------------------------
/calc.tcl:
--------------------------------------------------------------------------------
 1 | # created by fedex
 2 | 
 3 | bind pub - !calc safe_calc
 4 | bind pub - .calc safe_calc
 5 | setudef flag calc
 6 | 
 7 | proc is_op {str} {
 8 | 	return [expr [lsearch {{ } . + - * / ( ) %} $str] != -1]
 9 | }
10 | 
11 | proc safe_calc {nick uhost hand chan str} {
12 | 	if {![channel get $chan calc]} { return }
13 | 
14 | 	foreach char [split $str {}] {
15 | 		if {![is_op $char] && ![string is integer $char]} {
16 | 			putserv "PRIVMSG $chan :$nick: Invalid expression for calc."
17 | 			return
18 | 		}
19 | 	}
20 | 
21 | 	# make all values floating point
22 | 	set str [regsub -all -- {((?:\d+)?\.?\d+)} $str {[expr {\1*1.0}]}]
23 | 	set str [subst $str]
24 | 
25 | 	if {[catch {expr $str} out]} {
26 | 		putserv "PRIVMSG $chan :$nick: Invalid equation."
27 | 		return
28 | 	} else {
29 | 		putserv "PRIVMSG $chan :$str = $out"
30 | 	}
31 | }
32 | 


--------------------------------------------------------------------------------
/deprecated/bloomberg.tcl:
--------------------------------------------------------------------------------
  1 | #
  2 | # 20/07/2011
  3 | #
  4 | 
  5 | package require http
  6 | 
  7 | namespace eval ::bloomberg {
  8 | 	bind pub -|- !metals ::bloomberg::metals
  9 | 	bind pub -|- !gold   ::bloomberg::gold
 10 | 	bind pub -|- !silver ::bloomberg::silver
 11 | 	bind pub -|- !oil    ::bloomberg::oil
 12 | 
 13 | 	variable futures_url {http://www.bloomberg.com/markets/commodities/futures/}
 14 | 
 15 | 	variable user_agent "Lynx/2.8.5rel.1 libwww-FM/2.14 SSL-MM/1.4.1 OpenSSL/0.9.7e"
 16 | 	# ms
 17 | 	variable http_timeout 60000
 18 | 
 19 | 	setudef flag bloomberg
 20 | }
 21 | 
 22 | proc ::bloomberg::fetch_data {} {
 23 | 	::http::config -useragent $::bloomberg::user_agent
 24 | 	set token [::http::geturl $::bloomberg::futures_url -timeout $::bloomberg::http_timeout]
 25 | 	set data [::http::data $token]
 26 | 	set ncode [::http::ncode $token]
 27 | 	::http::cleanup $token
 28 | 
 29 | 	if {$ncode != 200} {
 30 | 		error "HTTP error code $ncode $data"
 31 | 	}
 32 | 	return $data
 33 | }
 34 | 
 35 | # Returns a dict, each key name of commodity
 36 | # Each value for key is itself a dict with values
 37 | # name, value, updown, change, change_percent, datetime
 38 | proc ::bloomberg::parse_html {html} {
 39 | 	# Get rid of everything before energy table
 40 | 	regexp -- {<a class="nohov">(.*)} $html -> html
 41 | 
 42 | 	set bulk_commodity_regexp {<tr.*?>.*?<td class="change value_.*?">.*?</tr>}
 43 | 	set commodity_regexp {<td class="name">(.*?)</td>.*?<td class="value">(.*?)</td>.*?<td class="change value_(.*?)">(.*?)</td>.*?<td class="change value_.*?">(.*?)</td>.*?<td class="datetime">(.*?)</td>}
 44 | 
 45 | 	set commodity_dict [dict create]
 46 | 	foreach commodity_html [regexp -all -inline -- $bulk_commodity_regexp $html] {
 47 | 		#puts "comm $commodity_html"
 48 | 		regexp -- $commodity_regexp $commodity_html -> name value updown change change_percent datetime
 49 | 		# Name can have excessive spacing
 50 | 		set name [regsub -all -- {\s+} $name " "]
 51 | 
 52 | 		#puts "name $name value $value updown $updown change $change change_percent $change_percent datetime $datetime"
 53 | 		dict append commodity_dict $name [list name $name value $value updown $updown change $change change_percent $change_percent datetime $datetime]
 54 | 	}
 55 | 	return $commodity_dict
 56 | }
 57 | 
 58 | # Get commodities with names matching the names in list_of_commodities
 59 | proc ::bloomberg::get_futures {list_of_commodities} {
 60 | 	set raw_data [::bloomberg::fetch_data]
 61 | 	set futures_dict [::bloomberg::parse_html $raw_data]
 62 | 
 63 | 	set wanted_commodities [list]
 64 | 	foreach commodity_key [dict keys $futures_dict] {
 65 | 		foreach wanted_commodity $list_of_commodities {
 66 | 			if {[regexp -nocase -- $wanted_commodity $commodity_key]} {
 67 | 				lappend wanted_commodities [dict get $futures_dict $commodity_key]
 68 | 			}
 69 | 		}
 70 | 	}
 71 | 	return $wanted_commodities
 72 | }
 73 | 
 74 | proc ::bloomberg::colour {updown str} {
 75 | 	if {[regexp -nocase -- {up} $updown]} {
 76 | 		return \00309+$str\017\003
 77 | 	} elseif {[regexp -nocase -- {down} $updown]} {
 78 | 		return \00304$str\017\003
 79 | 	} else {
 80 | 		return $str\003
 81 | 	}
 82 | }
 83 | 
 84 | proc ::bloomberg::output_commodity {chan commodity_dict} {
 85 | 	set colour []
 86 | 	set name [dict get $commodity_dict name]
 87 | 	set value [dict get $commodity_dict value]
 88 | 	set change [::bloomberg::colour [dict get $commodity_dict updown] "[dict get $commodity_dict change] [dict get $commodity_dict change_percent]"]
 89 | 	set datetime [dict get $commodity_dict datetime]
 90 | 
 91 | 	putserv "PRIVMSG $chan :$name: \00310$value $change $datetime"
 92 | }
 93 | 
 94 | proc ::bloomberg::oil {nick uhost hand chan argv} {
 95 | 	if {![channel get $chan bloomberg]} { return }
 96 | 
 97 | 	set commodities [::bloomberg::get_futures [list crude]]
 98 | 	foreach commodity_dict $commodities {
 99 | 		::bloomberg::output_commodity $chan $commodity_dict
100 | 	}
101 | }
102 | 
103 | proc ::bloomberg::metals {nick uhost hand chan argv} {
104 | 	if {![channel get $chan bloomberg]} { return }
105 | 
106 | 	set commodities [::bloomberg::get_futures [list copper gold silver]]
107 | 	foreach commodity_dict $commodities {
108 | 		::bloomberg::output_commodity $chan $commodity_dict
109 | 	}
110 | }
111 | 
112 | proc ::bloomberg::gold {nick uhost hand chan argv} {
113 | 	if {![channel get $chan bloomberg]} { return }
114 | 
115 | 	set commodities [::bloomberg::get_futures [list gold]]
116 | 	foreach commodity_dict $commodities {
117 | 		::bloomberg::output_commodity $chan $commodity_dict
118 | 	}
119 | }
120 | 
121 | proc ::bloomberg::silver {nick uhost hand chan argv} {
122 | 	if {![channel get $chan bloomberg]} { return }
123 | 
124 | 	set commodities [::bloomberg::get_futures [list silver]]
125 | 	foreach commodity_dict $commodities {
126 | 		::bloomberg::output_commodity $chan $commodity_dict
127 | 	}
128 | }
129 | 
130 | putlog "bloomberg.tcl loaded"
131 | 


--------------------------------------------------------------------------------
/deprecated/github_watch.tcl:
--------------------------------------------------------------------------------
  1 | #
  2 | # 2011-02-04
  3 | #
  4 | # Fetch commits from a github repo and output to IRC
  5 | #
  6 | # Better way to do this is to use service hooks, but for those repos where
  7 | # one doesn't have admin access, this is an option.
  8 | #
  9 | # Reference: http://develop.github.com/p/commits.html
 10 | #
 11 | 
 12 | package require http
 13 | package require json
 14 | 
 15 | namespace eval github_watch {
 16 | 	variable channel "#idiotbox"
 17 | 
 18 | 	# every 1 minute
 19 | 	bind time - "* * * * *" github_watch::update
 20 | 
 21 | 	variable max_commits 5
 22 | 
 23 | 	# Github user/repo to watch
 24 | 	variable user "sveinfid"
 25 | 	variable repo "Antix"
 26 | 	variable branch "master"
 27 | 
 28 | 	variable url "http://github.com/api/v2/json/commits/list/"
 29 | 
 30 | 	variable state_file "scripts/github_watch.state"
 31 | 	variable last_id
 32 | 
 33 | 	variable timeout 10000
 34 | 
 35 | 	bind evnt -|- "save" github_watch::write_state
 36 | }
 37 | 
 38 | proc github_watch::write_state {args} {
 39 | 	set fid [open $github_watch::state_file w]
 40 | 	puts $fid $github_watch::last_id
 41 | 	close $fid
 42 | }
 43 | 
 44 | proc github_watch::read_state {} {
 45 | 	if {[catch {open $github_watch::state_file r} fid]} {
 46 | 		set github_watch::last_id nt
 47 | 		return
 48 | 	}
 49 | 	set data [read -nonewline $fid]
 50 | 	close $fid
 51 | 	set raw [split $data \n]
 52 | 	set github_watch::last_id [lindex $raw 0]
 53 | }
 54 | 
 55 | proc github_watch::output {commit} {
 56 | 	set committer [dict get $commit committer]
 57 | 	set committer_name [dict get $committer name]
 58 | 
 59 | 	set msg [dict get $commit message]
 60 | 	set url "http://github.com[dict get $commit url]"
 61 | 
 62 | 	#putserv "PRIVMSG $github_watch::channel :${committer_name}: ${msg} - ${url}"
 63 | 	putserv "PRIVMSG $github_watch::channel :\[\002${committer_name}\002\]: ${msg}"
 64 | }
 65 | 
 66 | proc github_watch::get_commits {} {
 67 | 	# Fetch updates
 68 | 	set token [http::geturl ${github_watch::url}${github_watch::user}/${github_watch::repo}/${github_watch::branch}]
 69 | 	set data [http::data $token]
 70 | 	set ncode [http::ncode $token]
 71 | 	set status [http::status $token]
 72 | 	http::cleanup $token
 73 | 
 74 | 	if {$ncode != 200} {
 75 | 		error "HTTP fetch failure: $ncode, $data"
 76 | 	}
 77 | 
 78 | 	set json_dict [json::json2dict $data]
 79 | 	set commits_dict [lindex $json_dict 1]
 80 | 
 81 | 	set commits [list]
 82 | 
 83 | 	set old_last_id $github_watch::last_id
 84 | 	# Take the first $max_commits or up to an id we have already seen and return
 85 | 	for {set i 0} {$i < $github_watch::max_commits} {incr i} {
 86 | 		set commit [lindex $commits_dict $i]
 87 | 
 88 | 		if {[dict get $commit id] == $old_last_id} {
 89 | 			break
 90 | 		}
 91 | 		if {$i == 0} {
 92 | 			set github_watch::last_id [dict get $commit id]
 93 | 		}
 94 | 
 95 | 		lappend commits $commit
 96 | 	}
 97 | 
 98 | 	return [lreverse $commits]
 99 | }
100 | 
101 | proc github_watch::update {min hour day month year} {
102 | 	if {[catch {github_watch::get_commits} result]} {
103 | 		putlog "PRIVMSG $github_watch::channel :github watch: Error: $result"
104 | 		return
105 | 	}
106 | 
107 | 	foreach commit $result {
108 | 		github_watch::output $commit
109 | 	}
110 | }
111 | 
112 | github_watch::read_state
113 | putlog "github_watch.tcl loaded"
114 | 


--------------------------------------------------------------------------------
/deprecated/google.tcl:
--------------------------------------------------------------------------------
  1 | #
  2 | # 0.3 - ?
  3 | #  - switch from decode_html to htmlparse::mapEscape
  4 | #  - fix issue with encoding getting ascii
  5 | #  - add !g1 for one result
  6 | #  - strip remaining html from api result
  7 | #
  8 | # 0.2 - May 10 2010
  9 | #  - fix for garbled utf chars in api queries
 10 | #  - added +google channel flag to enable
 11 | #  - strip html from !convert as some formatting may be present
 12 | #  - fix decode_html to convert html utf to hex
 13 | #  - convert <sup></sup> to exponent
 14 | #
 15 | # 0.1 - Some time in April 2010
 16 | #  - Initial release
 17 | #
 18 | # Created Feb 28 2010
 19 | #
 20 | # License: Public domain
 21 | #
 22 | # Requires Tcl 8.5+
 23 | # Requires tcllib for json
 24 | #
 25 | 
 26 | package require http
 27 | package require json
 28 | package require htmlparse
 29 | 
 30 | namespace eval google {
 31 | 	#variable output_cmd "cd::putnow"
 32 | 	variable output_cmd "putserv"
 33 | 
 34 | 	# Not enforced for API queries
 35 | 	variable useragent "Lynx/2.8.8dev.2 libwww-FM/2.14 SSL-MM/1.4.1"
 36 | 
 37 | 	variable convert_url "http://www.google.ca/search"
 38 | 	variable convert_regexp {<table class=std>.*?<b>(.*?)</b>.*?</table>}
 39 | 
 40 | 	variable api_url "http://ajax.googleapis.com/ajax/services/search/"
 41 | 
 42 | 	variable api_referer "http://www.egghelp.org"
 43 | 
 44 | 	bind pub	-|- "!g" google::search
 45 | 	bind pub	-|- "!google" google::search
 46 | 	bind pub	-|- "!g1" google::search1
 47 | 	bind pub	-|- "!news" google::news
 48 | 	bind pub	-|- "!images" google::images
 49 | 	bind pub	-|- "!convert" google::convert
 50 | 
 51 | 	setudef flag google
 52 | }
 53 | 
 54 | proc google::convert_fetch {terms} {
 55 | 	http::config -useragent $google::useragent
 56 | 
 57 | 	set query [http::formatQuery q $terms]
 58 | 	set token [http::geturl ${google::convert_url}?${query}]
 59 | 	set data [http::data $token]
 60 | 	set ncode [http::ncode $token]
 61 | 	http::cleanup $token
 62 | 
 63 | 	# debug
 64 | 	#set fid [open "g-debug.txt" w]
 65 | 	#puts $fid $data
 66 | 	#close $fid
 67 | 
 68 | 	if {$ncode != 200} {
 69 | 		error "HTTP query failed: $ncode"
 70 | 	}
 71 | 
 72 | 	return $data
 73 | }
 74 | 
 75 | proc google::convert_parse {html} {
 76 | 	if {![regexp -- $google::convert_regexp $html -> result]} {
 77 | 		error "Parse error or no result"
 78 | 	}
 79 | 	set result [htmlparse::mapEscapes $result]
 80 | 	# change <sup>num</sup> to ^num (exponent)
 81 | 	set result [regsub -all -- {<sup>(.*?)</sup>} $result {^\1}]
 82 | 	# strip rest of html code
 83 | 	return [regsub -all -- {<.*?>} $result ""]
 84 | }
 85 | 
 86 | # Query normal html for conversions
 87 | proc google::convert {nick uhost hand chan argv} {
 88 | 	if {![channel get $chan google]} { return }
 89 | 
 90 | 	if {[string length $argv] == 0} {
 91 | 		$google::output_cmd "PRIVMSG $chan :Please provide a query."
 92 | 		return
 93 | 	}
 94 | 
 95 | 	if {[catch {google::convert_fetch $argv} data]} {
 96 | 		$google::output_cmd "PRIVMSG $chan :Error fetching results: $data."
 97 | 		return
 98 | 	}
 99 | 
100 | 	if {[catch {google::convert_parse $data} result]} {
101 | 		$google::output_cmd "PRIVMSG $chan :Error: $result."
102 | 		return
103 | 	}
104 | 
105 | 	$google::output_cmd "PRIVMSG $chan :\002$result\002"
106 | }
107 | 
108 | # Output for results from api query
109 | proc google::output {chan url title content} {
110 | 	regsub -all -- {(?:<b>|</b>)} $title "\002" title
111 | 	regsub -all -- {<.*?>} $title "" title
112 | 	set output "$title @ $url"
113 | 	$google::output_cmd "PRIVMSG $chan :[htmlparse::mapEscapes $output]"
114 | }
115 | 
116 | # Return results from API query of $url
117 | proc google::api_fetch {terms url} {
118 | 	set query [http::formatQuery v "1.0" q $terms safe off]
119 | 	set headers [list Referer $google::api_referer]
120 | 
121 | 	set token [http::geturl ${url}?${query} -headers $headers -method GET]
122 | 	set data [http::data $token]
123 | 	set ncode [http::ncode $token]
124 | 	http::cleanup $token
125 | 
126 | 	# debug
127 | 	#set fid [open "g-debug.txt" w]
128 | 	#fconfigure $fid -translation binary -encoding binary
129 | 	#puts $fid $data
130 | 	#close $fid
131 | 
132 | 	if {$ncode != 200} {
133 | 		error "HTTP query failed: $ncode"
134 | 	}
135 | 
136 | 	return [json::json2dict $data]
137 | }
138 | 
139 | # Validate input and then return list of results
140 | proc google::api_validate {argv url} {
141 | 	if {[string length $argv] == 0} {
142 | 		error "Please supply search terms."
143 | 	}
144 | 
145 | 	if {[catch {google::api_fetch $argv $url} data]} {
146 | 		error "Error fetching results: $data."
147 | 	}
148 | 
149 | 	set response [dict get $data responseData]
150 | 	set results [dict get $response results]
151 | 
152 | 	if {[llength $results] == 0} {
153 | 		error "No results."
154 | 	}
155 | 
156 | 	return $results
157 | }
158 | 
159 | # Query api
160 | proc google::api_handler {chan argv url {num {}}} {
161 | 	if {[catch {google::api_validate $argv $url} results]} {
162 | 		$google::output_cmd "PRIVMSG $chan :$results"
163 | 		return
164 | 	}
165 | 
166 | 	foreach result $results {
167 | 		if {$num != "" && [incr count] > $num} {
168 | 			return
169 | 		}
170 | 		dict with result {
171 | 			# $language holds lang in news results, doesn't exist in web results
172 | 			if {![info exists language] || $language == "en"} {
173 | 				google::output $chan $unescapedUrl $title $content
174 | 			}
175 | 		}
176 | 	}
177 | }
178 | 
179 | # Regular API search
180 | proc google::search {nick uhost hand chan argv} {
181 | 	if {![channel get $chan google]} { return }
182 | 
183 | 	google::api_handler $chan $argv ${google::api_url}web
184 | }
185 | 
186 | # Regular API search, 1 result
187 | proc google::search1 {nick uhost hand chan argv} {
188 | 	if {![channel get $chan google]} { return }
189 | 
190 | 	google::api_handler $chan $argv ${google::api_url}web 1
191 | }
192 | 
193 | # News from API
194 | proc google::news {nick uhost hand chan argv} {
195 | 	if {![channel get $chan google]} { return }
196 | 
197 | 	google::api_handler $chan $argv ${google::api_url}news
198 | }
199 | 
200 | # Images from API
201 | proc google::images {nick uhost hand chan argv} {
202 | 	if {![channel get $chan google]} { return }
203 | 
204 | 	google::api_handler $chan $argv ${google::api_url}images
205 | }
206 | 


--------------------------------------------------------------------------------
/deprecated/isgd.tcl:
--------------------------------------------------------------------------------
 1 | #
 2 | # June 26 2010
 3 | # by horgh
 4 | #
 5 | 
 6 | package provide isgd 0.1
 7 | 
 8 | package require http
 9 | package require tls
10 | ::http::register https 443 [list ::tls::socket -ssl2 0 -ssl3 0 -tls1 1]
11 | 
12 | namespace eval ::isgd {
13 | 	variable url https://is.gd/create.php
14 | }
15 | 
16 | proc ::isgd::shorten {url} {
17 | 	set query [::http::formatQuery format simple url $url]
18 | 	set token [::http::geturl ${::isgd::url}?${query} -timeout 20000 -method GET]
19 | 	set data [::http::data $token]
20 | 	set ncode [::http::ncode $token]
21 | 	::http::cleanup $token
22 | 
23 | 	if {$ncode != 200} {
24 | 		error "HTTP error ($ncode): $data"
25 | 	}
26 | 
27 | 	return $data
28 | }
29 | 


--------------------------------------------------------------------------------
/deprecated/vantrash.tcl:
--------------------------------------------------------------------------------
 1 | #
 2 | # 2010-10-03
 3 | #
 4 | # Notify specific channels when garbage pickup is next day
 5 | # Uses next-day API from http://vantrash.ca
 6 | #
 7 | 
 8 | package require http
 9 | 
10 | namespace eval vantrash {
11 | 	# corresponds to zone name on vantrash.ca
12 | 	variable zone "vancouver-north-blue"
13 | 	variable url "http://vantrash.ca/zones/${zone}/nextpickup.txt"
14 | 
15 | 	# where to output
16 | 	variable channel #tea
17 | 
18 | 	# min hr day month year
19 | 	bind time - {30 19 * * *} vantrash::check
20 | 	bind time - {30 20 * * *} vantrash::check
21 | 	bind time - {30 21 * * *} vantrash::check
22 | 
23 | 	bind pub -|- "!vantrash" vantrash::handler
24 | 
25 | 	variable cached_date []
26 | }
27 | 
28 | proc vantrash::handler {nick uhost hand chan argv} {
29 | 	vantrash::check * * * * *
30 | }
31 | 
32 | proc vantrash::check {min hour day month year} {
33 | 	# Only fetch new date if we haven't yet found one, or that one is past
34 | 	if {$vantrash::cached_date == "" || [clock seconds] > $vantrash::cached_date} {
35 | 		set token [http::geturl $vantrash::url]
36 | 		set data [http::data $token]
37 | 		set ncode [http::ncode $token]
38 | 		http::cleanup $token
39 | 
40 | 		if {$ncode != 200} {
41 | 			putserv "PRIVMSG $vantrash::channel :(vantrash) Error (${ncode}) fetching next pickup date. (Cached date is expired or not present): ${data}"
42 | 			return
43 | 		}
44 | 
45 | 		set next_date [lindex [split $data] 0]
46 | 		set vantrash::cached_date [clock scan $next_date]
47 | 	}
48 | 
49 | 	set next_day [string trim [clock format $vantrash::cached_date -format %e]]
50 | 	set tomorrow_day [string trim [clock format [clock scan tomorrow] -format %e]]
51 | 
52 | 	if {$next_day == $tomorrow_day} {
53 | 		putserv "PRIVMSG $vantrash::channel :Garbage day tomorrow!"
54 | 	}
55 | }
56 | 
57 | putlog "vantrash.tcl loaded"
58 | 


--------------------------------------------------------------------------------
/dictionary.tcl:
--------------------------------------------------------------------------------
  1 | # vim: expandtab
  2 | #
  3 | # This script makes the bot talk a bit. You can teach it terms to respond to. It
  4 | # also has random responses if it sees its nick mentioned.
  5 | #
  6 | # This is a heavily modified version of dictionary.tcl 2.7 by perpleXa.
  7 | #
  8 | # To enable the script on a channel type (partyline):
  9 | #  .chanset #channel +dictionary
 10 | #
 11 | # Dictionary
 12 | # Copyright (C) 2004-2007 perpleXa
 13 | # http://perplexa.ugug.org / #perpleXa on QuakeNet
 14 | #
 15 | # Redistribution, with or without modification, are permitted provided
 16 | # that redistributions retain the above copyright notice, this condition
 17 | # and the following disclaimer.
 18 | #
 19 | # This program is distributed in the hope that it will be useful,
 20 | # but WITHOUT ANY WARRANTY, to the extent permitted by law; without
 21 | # even the implied warranty of MERCHANTABILITY or FITNESS FOR A
 22 | # PARTICULAR PURPOSE.
 23 | 
 24 | namespace eval dictionary {
 25 |   # Definition file. The format is a tcl dict.
 26 |   variable term_file "scripts/dbase/dictionary.db"
 27 | 
 28 |   # File containing nicks to not respond to. Newline separated.
 29 |   variable skip_nick_file "scripts/dictionary_skip_nicks.txt"
 30 | 
 31 |   # File containing chatty responses.
 32 |   #
 33 |   # These are really just random phrases
 34 |   # for the bot to respond with assuming it has been addressed in some way and
 35 |   # has nothing really to say about it. Newline separated.
 36 |   variable chatty_responses_file "scripts/dictionary_chatty_list.txt"
 37 | 
 38 |   # Time to not respond to the same word in the same channel. This is
 39 |   # so we don't respond to the same word in quick succession.
 40 |   variable throttle_time [expr 10*60]
 41 | 
 42 |   # Dictionary terms.
 43 |   #
 44 |   # Each key is a term and associates with another dict.
 45 |   #
 46 |   # The sub-dict has keys:
 47 |   # - def, the definition
 48 |   # - include_term_in_def, which controls whether we output "<term> is <def>"
 49 |   #   or just "<def>"
 50 |   variable terms [dict create]
 51 | 
 52 |   # Nicks to not respond to terms for. e.g., bots.
 53 |   variable skip_nicks [list]
 54 | 
 55 |   variable chatty_responses [list]
 56 | 
 57 |   # Dict with keys <channel><term> with values containing the unixtime the last
 58 |   # time the term was output, if any.
 59 |   #
 60 |   # This is for throttling term outputs.
 61 |   variable flood [dict create]
 62 | 
 63 |   bind pubm -|- "*" ::dictionary::public
 64 |   bind pubm -|- "*" ::dictionary::publearn
 65 | 
 66 |   setudef flag dictionary
 67 | }
 68 | 
 69 | # Respond to terms in the channel
 70 | proc ::dictionary::public {nick host hand chan argv} {
 71 |   variable flood
 72 |   variable terms
 73 |   variable throttle_time
 74 |   variable skip_nicks
 75 |   global botnick
 76 | 
 77 |   if {![channel get $chan dictionary]} {
 78 |     return
 79 |   }
 80 | 
 81 |   # Ignore cases of '<botnick>:' because those are commands to us. We deal with
 82 |   # them in a different proc.
 83 |   if {[::dictionary::is_addressing_bot $argv $botnick]} {
 84 |     return
 85 |   }
 86 | 
 87 |   # If the person saying something has a nick that is one we skip, we're done.
 88 |   foreach skip_nick $skip_nicks {
 89 |     if {[string equal -nocase $nick $skip_nick]} {
 90 |       return
 91 |     }
 92 |   }
 93 | 
 94 |   # Look for a word we know about for us to respond to.
 95 |   set term ""
 96 |   foreach word [dict keys $terms] {
 97 |     if {[::dictionary::string_contains_term $argv $word]} {
 98 |      set term $word
 99 |      break
100 |     }
101 |   }
102 | 
103 |   # If they didn't say a term we know something about, then the only response
104 |   # we'll send is if they said our name. Send them a chatty response if so.
105 |   if {$term == ""} {
106 |     if {[::dictionary::string_contains_term $argv $botnick]} {
107 |       set response [::dictionary::get_chatty_response $nick]
108 |       putserv "PRIVMSG $chan :$response"
109 |     }
110 |     return
111 |   }
112 | 
113 |   # They said a word we know something about. We'll potentially output the
114 |   # definition.
115 | 
116 |   set term_dict [dict get $terms $term]
117 | 
118 |   # We throttle how often we output the term's definition.
119 |   set flood_key $chan$term
120 |   if {![dict exists $flood $flood_key]} {
121 |     dict set flood $flood_key 0
122 |   }
123 |   set last_term_output_time [dict get $flood $flood_key]
124 |   if {[unixtime] - $last_term_output_time <= $throttle_time} {
125 |     return
126 |   }
127 |   dict set flood $flood_key [unixtime]
128 | 
129 |   # Output the definition. Note that terms get output differently depending on
130 |   # how they were added.
131 |   set def [dict get $term_dict def]
132 | 
133 |   if {[dict get $term_dict include_term_in_def]} {
134 |     puthelp "PRIVMSG $chan :$term is $def"
135 |     return
136 |   }
137 |   puthelp "PRIVMSG $chan :$def"
138 | }
139 | 
140 | # Public trigger. This handles commands such as setting, deleting, and listing
141 | # terms the bot knows about.
142 | proc ::dictionary::publearn {nick host hand chan argv} {
143 |   global botnick
144 |   variable terms
145 | 
146 |   if {![channel get $chan dictionary]} {
147 |     return
148 |   }
149 |   set argv [stripcodes "uacgbr" $argv]
150 |   set argv [string trim $argv]
151 | 
152 |   # We only respond if we are directly addressed (botnick: ). This indicates
153 |   # someone is giving us a command.
154 |   if {![::dictionary::is_addressing_bot $argv $botnick]} {
155 |     return
156 |   }
157 | 
158 |   if {![regexp -nocase -- {^\S+\s+(.+)} $argv -> rest]} {
159 |     set response [::dictionary::get_negative_response $nick]
160 |     putserv "PRIVMSG $chan :$response"
161 |     return
162 |   }
163 | 
164 |   # Delete a term. <botnick>: forget <term>
165 |   #
166 |   # Note this means we can't set a term using the "is" syntax (e.g. forget blah
167 |   # is x).
168 |   if {[regexp -nocase -- {^forget\s+(.+)} $rest -> term]} {
169 |     if {![dict exists $terms $term]} {
170 |       set response [::dictionary::get_negative_response $nick]
171 |       putserv "PRIVMSG $chan :I don't know `$term'."
172 |       return
173 |     }
174 | 
175 |     set def [dict get $terms $term def]
176 |     dict unset terms $term
177 |     ::dictionary::save
178 | 
179 |     putserv "PRIVMSG $chan :I forgot `$term'. (It was `$def'.)"
180 |     return
181 |   }
182 | 
183 |   if {[regexp -nocase -- {^remember this:\s+(.+)} $rest -> response]} {
184 |     lappend ::dictionary::chatty_responses $response
185 |     if {[catch {::dictionary::list_to_file $::dictionary::chatty_responses \
186 |           $::dictionary::chatty_responses_file} err]} {
187 |       putserv "PRIVMSG $chan :Error! $err"
188 |       return
189 |     }
190 |     putserv "PRIVMSG $chan :OK, $nick."
191 |     return
192 |   }
193 | 
194 |   # Set a term. <botnick>: <term> is <definition>
195 |   if {[regexp -nocase -- {^(.+?)\s+is\s+(.+)$} $rest -> term def]} {
196 |     if {[dict exists $terms $term]} {
197 |       set def [dict get $terms $term def]
198 |       putserv "PRIVMSG $chan :`$term' is already `$def'"
199 |       return
200 |     }
201 | 
202 |     dict set terms $term [dict create \
203 |       def                 $def \
204 |       include_term_in_def 1 \
205 |     ]
206 |     ::dictionary::save
207 | 
208 |     set response [::dictionary::get_affirmative_response $nick]
209 |     putserv "PRIVMSG $chan :$response"
210 |     return
211 |   }
212 | 
213 |   # Set a term. <botnick>: <term>, <definition>
214 |   if {[regexp -nocase -- {^(.+?)\s*,\s+(.+)$} $rest -> term def]} {
215 |     if {[dict exists $terms $term]} {
216 |       set def [dict get $terms $term def]
217 |       putserv "PRIVMSG $chan :`$term' is already `$def'"
218 |       return
219 |     }
220 | 
221 |     dict set terms $term [dict create \
222 |       def                 $def \
223 |       include_term_in_def 0 \
224 |     ]
225 |     ::dictionary::save
226 | 
227 |     set response [::dictionary::get_affirmative_response $nick]
228 |     putserv "PRIVMSG $chan :$response"
229 |     return
230 |   }
231 | 
232 |   # Message the nick all terms we have
233 |   if {[string tolower $rest] == "listem"} {
234 |     foreach term [lsort -dictionary [dict keys $terms]] {
235 |       set def [dict get $terms $term def]
236 |       puthelp "PRIVMSG $nick :$term: $def"
237 |     }
238 |     return
239 |   }
240 | 
241 |   if {[string tolower $rest] == "braindump"} {
242 |     set i 1
243 |     foreach response $::dictionary::chatty_responses {
244 |       puthelp "PRIVMSG $nick :$i. $response"
245 |       incr i
246 |     }
247 |     return
248 |   }
249 | 
250 |   set response [::dictionary::get_chatty_response $nick]
251 |   putserv "PRIVMSG $chan :$response"
252 | }
253 | 
254 | # Return 1 if the given line is addressing the bot.
255 | #
256 | # This is the case if the line is of the form:
257 | # <botnick>:
258 | #
259 | # For example if the bot's nick is:
260 | # bot: Hi there
261 | #
262 | # This is checked case insensitively.
263 | proc ::dictionary::is_addressing_bot {text botnick} {
264 |   set text [string trim $text]
265 |   set text [string tolower $text]
266 | 
267 |   set prefix [string tolower $botnick]
268 |   append prefix :
269 | 
270 |   set idx [string first $prefix $text]
271 | 
272 |   return [expr $idx == 0]
273 | }
274 | 
275 | # Return 1 if the string contains the term. This is tested case insensitively.
276 | #
277 | # The term is present only if it is by itself surrounded whitespace or
278 | # punctuation.
279 | #
280 | # e.g. if the term is 'test' then these strings contain it:
281 | #
282 | # hi test hi
283 | # hi test, hi
284 | # test
285 | #
286 | # But these do not:
287 | #
288 | # hi testing hi
289 | # hitest
290 | proc ::dictionary::string_contains_term {s term} {
291 |   set term_lc [string tolower $term]
292 |   set term_quoted [::dictionary::quotemeta $term_lc]
293 | 
294 |   set re {\m}
295 |   append re $term_quoted
296 |   append re {\M}
297 |   return [regexp -nocase -- $re $s]
298 | }
299 | 
300 | # Escape/quote metacharacters so that the string becomes suitable for placing in
301 | # a regular expression. This makes it so any regex metacharacter is quoted.
302 | #
303 | # See http://stackoverflow.com/questions/4346750/regular-expression-literal-text-span/4352893#4352893
304 | proc ::dictionary::quotemeta {s} {
305 |   return [regsub -all {\W} $s {\\&}]
306 | }
307 | 
308 | proc ::dictionary::get_affirmative_response {nick} {
309 |   return "OK, $nick"
310 | }
311 | 
312 | proc ::dictionary::get_negative_response {nick} {
313 |   return "Shut up."
314 | }
315 | 
316 | proc ::dictionary::get_chatty_response {nick} {
317 |   set n [llength $::dictionary::chatty_responses]
318 |   if {$n == 0} {
319 |     return "Hi."
320 |   }
321 | 
322 |   set idx [expr int($n*rand())]
323 |   set response [lindex $::dictionary::chatty_responses $idx]
324 | 
325 |   return [regsub -all -- "%%nick%%" $response $nick]
326 | }
327 | 
328 | # Load the term database from our data file.
329 | proc ::dictionary::load_terms {} {
330 |   variable term_file
331 |   variable terms
332 |   set terms [dict create]
333 | 
334 |   if {[catch {open $term_file "r"} fp]} {
335 |     return
336 |   }
337 |   set terms [read -nonewline $fp]
338 |   close $fp
339 |   set count [llength [dict keys $terms]]
340 |   return $count
341 | }
342 | 
343 | # Load contents of a file into a list.
344 | #
345 | # Each line of the file is made into one element in the list.
346 | #
347 | # Blank lines are skipped.
348 | #
349 | # Path: Path to the file to open
350 | #
351 | # Returns: If we do not find the file or we can't open it then we return an
352 | # empty list.
353 | proc ::dictionary::file_contents_to_list {path} {
354 |   if {![file exists $path]} {
355 |     return [list]
356 |   }
357 |   if {[catch {open $path r} fp]} {
358 |     return [list]
359 |   }
360 |   set content [read -nonewline $fp]
361 |   close $fp
362 | 
363 |   set l [list]
364 |   foreach line [split $content "\n"] {
365 |     set line [string trim $line]
366 |     if {[string length $line] == 0} {
367 |       continue
368 |     }
369 |     lappend l $line
370 |   }
371 |   return $l
372 | }
373 | 
374 | proc ::dictionary::list_to_file {l path} {
375 |   set fh [open $path w]
376 |   foreach e $l {
377 |     puts $fh $e
378 |   }
379 |   close $fh
380 | }
381 | 
382 | # Load a list of nicks to skip from a data file.
383 | proc ::dictionary::load_skip_nicks {} {
384 |   set ::dictionary::skip_nicks [::dictionary::file_contents_to_list \
385 |     $::dictionary::skip_nick_file]
386 | }
387 | 
388 | # Load chatty responses from data file.
389 | proc ::dictionary::load_chatty_responses {} {
390 |   set ::dictionary::chatty_responses [::dictionary::file_contents_to_list \
391 |     $::dictionary::chatty_responses_file]
392 | }
393 | 
394 | # Load data from our data files into memory.
395 | proc ::dictionary::load {args} {
396 |   set term_count [::dictionary::load_terms]
397 | 
398 |   ::dictionary::load_skip_nicks
399 | 
400 |   ::dictionary::load_chatty_responses
401 | 
402 |   return $term_count
403 | }
404 | 
405 | # Save the terms and definitions to the data file.
406 | proc ::dictionary::save {} {
407 |   variable term_file
408 |   variable terms
409 | 
410 |   if {![file isdirectory [file dirname $term_file]]} {
411 |     file mkdir [file dirname $term_file]
412 |   }
413 |   set fp [open $term_file w]
414 |   puts -nonewline $fp $terms
415 |   close $fp
416 | }
417 | 
418 | set ::dictionary::count [::dictionary::load]
419 | if {$::dictionary::count == 1} {
420 |   putlog "dictionary.tcl loaded. $::dictionary::count term."
421 | } else {
422 |   putlog "dictionary.tcl loaded. $::dictionary::count terms."
423 | }
424 | 


--------------------------------------------------------------------------------
/dictionary_test.tcl:
--------------------------------------------------------------------------------
  1 | #
  2 | # Unit tests for dictionary.tcl
  3 | #
  4 | 
  5 | # Dummy some eggdrop functions.
  6 | proc ::bind {a b c d} {}
  7 | proc ::setudef {a b} {}
  8 | proc ::putlog {s} {}
  9 | 
 10 | source dictionary.tcl
 11 | 
 12 | proc ::tests {} {
 13 | 	puts "Running tests..."
 14 | 
 15 | 	set success 1
 16 | 
 17 | 	if {![::test_quotemeta]} {
 18 | 		set success 0
 19 | 	}
 20 | 
 21 | 	if {![::test_string_contains_term]} {
 22 | 		set success 0
 23 | 	}
 24 | 
 25 | 	if {![::test_is_addressing_bot]} {
 26 | 		set success 0
 27 | 	}
 28 | 
 29 | 	if {$success} {
 30 | 		puts "Success!"
 31 | 	} else {
 32 | 		puts "Failure."
 33 | 		exit 1
 34 | 	}
 35 | }
 36 | 
 37 | proc ::test_quotemeta {} {
 38 | 	set tests [list \
 39 | 		[dict create input hi! output hi\\!] \
 40 | 		[dict create input hi output hi] \
 41 | 		[dict create input hi*+ output hi\\*\\+] \
 42 | 		[dict create input hi\{\}\\ output hi\\\{\\\}\\\\] \
 43 | 	]
 44 | 
 45 | 	set failed 0
 46 | 
 47 | 	foreach test $tests {
 48 | 		set output [::dictionary::quotemeta [dict get $test input]]
 49 | 		if {$output != [dict get $test output]} {
 50 | 			puts [format "FAILURE: quotemeta(%s) = %s, wanted %s" \
 51 | 				[dict get $test input] $output [dict get $test output]]
 52 | 
 53 | 			incr failed
 54 | 		}
 55 | 	}
 56 | 
 57 | 	if {$failed != 0} {
 58 | 		puts [format "quotemeta: %d/%d tests failed" $failed [llength $tests]]
 59 | 	}
 60 | 
 61 | 	return [expr $failed == 0]
 62 | }
 63 | 
 64 | proc ::test_string_contains_term {} {
 65 | 	set tests [list \
 66 | 		[dict create s "hi test hi" term "test" want 1] \
 67 | 		[dict create s "hi testing hi" term "test" want 0] \
 68 | 		[dict create s "hi test, hi" term "test" want 1] \
 69 | 		[dict create s "hi test. hi" term "test" want 1] \
 70 | 		[dict create s "test" term "test" want 1] \
 71 | 		[dict create s "hi test" term "test" want 1] \
 72 | 		[dict create s "test hi" term "test" want 1] \
 73 | 		[dict create s "test hi" term "TEST" want 1] \
 74 | 		[dict create s "TEST hi" term "test" want 1] \
 75 | 	]
 76 | 
 77 | 	set failed 0
 78 | 
 79 | 	foreach test $tests {
 80 | 		set s [dict get $test s]
 81 | 		set term [dict get $test term]
 82 | 		set want [dict get $test want]
 83 | 
 84 | 		set output [::dictionary::string_contains_term $s $term]
 85 | 		if {$output != $want} {
 86 | 			puts [format "FAILURE: string_contains_term(\"%s\", \"%s\") = %d, wanted %d" \
 87 | 				$s $term $output $want]
 88 | 
 89 | 			incr failed
 90 | 		}
 91 | 	}
 92 | 
 93 | 	if {$failed != 0} {
 94 | 		puts [format "string_contains_term: %d/%d tests failed" $failed \
 95 | 			[llength $tests]]
 96 | 	}
 97 | 
 98 | 	return [expr $failed == 0]
 99 | }
100 | 
101 | proc ::test_is_addressing_bot {} {
102 | 	set tests [list \
103 | 		[dict create line "bot: hi"    botnick "bot" want 1] \
104 | 		[dict create line "BOT: hi"    botnick "bot" want 1] \
105 | 		[dict create line "bot: hi"    botnick "BOT" want 1] \
106 | 		[dict create line "bot:hi"     botnick "BOT" want 1] \
107 | 		[dict create line "bot hi"     botnick "bot" want 0] \
108 | 		[dict create line "bot2: hi"   botnick "bot" want 0] \
109 | 		[dict create line ": hi"       botnick "bot" want 0] \
110 | 		[dict create line "hi bot: hi" botnick "bot" want 0] \
111 | 		[dict create line "bbot: hi"   botnick "bot" want 0] \
112 | 		[dict create line "botbot: hi" botnick "bot" want 0] \
113 | 	]
114 | 
115 | 	set failed 0
116 | 
117 | 	foreach test $tests {
118 | 		set line [dict get $test line]
119 | 		set botnick [dict get $test botnick]
120 | 		set want [dict get $test want]
121 | 
122 | 		set output [::dictionary::is_addressing_bot $line $botnick]
123 | 		if {$output != $want} {
124 | 			puts [format "FAILURE: is_addressing_bot(\"%s\", \"%s\") = %d, wanted %d" \
125 | 				$s $line $botnick $want]
126 | 
127 | 			incr failed
128 | 		}
129 | 	}
130 | 
131 | 	if {$failed != 0} {
132 | 		puts [format "string_contains_term: %d/%d tests failed" $failed \
133 | 			[llength $tests]]
134 | 	}
135 | 
136 | 	return [expr $failed == 0]
137 | }
138 | 
139 | ::tests
140 | 


--------------------------------------------------------------------------------
/horgh_autoop.tcl:
--------------------------------------------------------------------------------
 1 | # Auto op script. Ops everyone in channels set +horgh_autoop
 2 | #
 3 | #
 4 | # Last change Sat Nov 15 17:18:29 PST 2008
 5 | #
 6 | # Created Thu Oct 23 18:32:36 PDT 2008
 7 | # By horgh
 8 | 
 9 | namespace eval horgh_autoop {
10 | 	variable output_cmd putserv
11 | 
12 | 	setudef flag horgh_autoop
13 | 	bind join -|- * horgh_autoop::horgh_autoop
14 | }
15 | 
16 | proc horgh_autoop::horgh_autoop {nick host hand chan} {
17 | 	if {![channel get $chan horgh_autoop]} { return }
18 | 	$horgh_autoop::output_cmd "MODE $chan +o $nick"
19 | }
20 | 
21 | putlog "horgh_autoop.tcl loaded"
22 | 


--------------------------------------------------------------------------------
/irb.tcl:
--------------------------------------------------------------------------------
  1 | #
  2 | # 0.2 - ???
  3 | #  - fix error when rehash/restart if socket isnt open
  4 | #
  5 | # 0.1 - May 15 2010
  6 | #  - initial release
  7 | #
  8 | # by horgh (www.summercat.com)
  9 | #
 10 | # A _VERY UNSAFE_ wrapper for irb <-> irc via eggdrop
 11 | #
 12 | # Setup:
 13 | # - make sure you set/check the 3 variables (channel, command char, irb path)
 14 | #
 15 | # Usage:
 16 | # - {command_char}reset to get a fresh irb session
 17 | #
 18 | # - any commands prefixed with command_char are sent to irb and the result is
 19 | #   posted to the channel
 20 | #   - e.g.
 21 | #     <@horgh> 'test
 22 | #     <@Yorick> Starting new irb session...
 23 | #     <@Yorick> => ArgumentError: wrong number of arguments
 24 | #     <@Yorick> =>     from (irb):1:in `test'
 25 | #     <@Yorick> =>     from (irb):1
 26 | #
 27 | # BUGS:
 28 | #  - since "=>" isn't shown from the open call for some reason (perhaps it goes
 29 | #    to stderr or something, i'm not sure), some results that print on same line
 30 | #    do not display nicely, such as:
 31 | #      '5.times { print "*" }
 32 | #      results in "=> *****5" whereas it should be "*****=> 5" from the prompt
 33 | #
 34 | 
 35 | namespace eval irb {
 36 | 	# Settings
 37 | 
 38 | 	# channel to respond to irb commands / send output
 39 | 	set channel #YOUR_CHANNEL
 40 | 	# system path to irb binary
 41 | 	set irb {/usr/local/bin/irb}
 42 | 	# prefix character for sending data to irb
 43 | 	set command_char "'"
 44 | 
 45 | 	#set output_cmd cd::putnow
 46 | 	set output_cmd putserv
 47 | 
 48 | 	# You shouldn't need to edit anything below here
 49 | 
 50 | 	set irb_chan []
 51 | 	# store commands entered here so we don't output them
 52 | 	# they are deleted as they come up from reading irb output
 53 | 	set cmd_cache []
 54 | 
 55 | 	bind pubm -|- "*" irb::put
 56 | 	bind pub -|- "${command_char}reset" irb::reset
 57 | 	bind evnt -|- "prerestart" irb::end
 58 | 	bind evnt -|- "prerehash" irb::end
 59 | }
 60 | 
 61 | proc irb::put {nick uhost hand chan argv} {
 62 | 	if {$chan != $irb::channel} { return }
 63 | 	if {[string index $argv 0] != $irb::command_char} { return}
 64 | 
 65 | 	set cmd [string range $argv 1 end]
 66 | 	if {$cmd == "reset" } { return }
 67 | 	if {$cmd == ""} { return }
 68 | 
 69 | 	if {$irb::irb_chan == []} {
 70 | 		setup_irb
 71 | 	}
 72 | 
 73 | 	lappend irb::cmd_cache $cmd
 74 | 	puts $irb::irb_chan $cmd
 75 | }
 76 | 
 77 | proc irb::reset {nick uhost hand chan argv} {
 78 | 	$irb::output_cmd "PRIVMSG $irb::channel :Closing irb session."
 79 | 	irb::end
 80 | }
 81 | 
 82 | proc irb::setup_irb {} {
 83 | 	$irb::output_cmd "PRIVMSG $irb::channel :Starting new irb session..."
 84 | 	set irb::irb_chan [open "|${irb::irb}" r+]
 85 | 	fconfigure $irb::irb_chan -blocking 1 -buffering line
 86 | 	# call irb::output when data to be read
 87 | 	fileevent $irb::irb_chan readable irb::output
 88 | }
 89 | 
 90 | proc irb::output {} {
 91 | 	set output [gets $irb::irb_chan]
 92 | 	set output [string map {\t "    "} $output]
 93 | 	
 94 | 	# check if it is a command sent to irb rather than a result (to not print)
 95 | 	set index [lsearch -exact $irb::cmd_cache $output]
 96 | 	if {$index >= 0} {
 97 | 		set irb::cmd_cache [lreplace $irb::cmd_cache $index $index]
 98 | 	} else {
 99 | 		$irb::output_cmd "PRIVMSG $irb::channel :=> $output"
100 | 	}
101 | }
102 | 
103 | # We close channel before restart/rehash
104 | proc irb::end {args} {
105 | 	if {$irb::irb_chan == ""} { return }
106 | 	close $irb::irb_chan
107 | 	set irb::irb_chan []
108 | }
109 | 
110 | putlog "irb.tcl loaded"
111 | 


--------------------------------------------------------------------------------
/latoc.tcl:
--------------------------------------------------------------------------------
  1 | # Provides binds to read Yahoo.com futures
  2 | #
  3 | # If you update this, update the one in
  4 | # https://github.com/horgh/irssi-tcl-scripts.
  5 | package require http
  6 | package require tls
  7 | ::http::register https 443 [list ::tls::socket -ssl2 0 -ssl3 0 -tls1 1]
  8 | 
  9 | namespace eval ::latoc {
 10 | 	variable output_cmd putserv
 11 | 
 12 | 	variable user_agent "Lynx/2.8.5rel.1 libwww-FM/2.14 SSL-MM/1.4.1 OpenSSL/0.9.7e"
 13 | 
 14 | 	variable list_regexp {<tr class="data-row.*?".*?</a></td></tr>}
 15 | 	variable stock_regexp {<td class="data-col0.*>(.*)</a></td><td class="data-col1.*>(.*)</td><td class="data-col2.*>(.*)</td><td class="data-col3.*>(.*)</td><td class="data-col4.*>(.*)</span></td><td class="data-col5.*>(.*)</span></td><td class="data-col6.*>(.*)</td><td class="data-col7.*>(.*)</td><td class="data-col8.*"}
 16 | 
 17 | 	variable url "https://finance.yahoo.com/commodities?ltr=1"
 18 | 
 19 | 	bind pub -|- "!oil"    ::latoc::oil_handler
 20 | 	bind pub -|- "!gold"   ::latoc::gold_handler
 21 | 	bind pub -|- "!silver" ::latoc::silver_handler
 22 | 
 23 | 	setudef flag latoc
 24 | }
 25 | 
 26 | proc ::latoc::fetch {chan} {
 27 | 	::http::config -useragent $::latoc::user_agent
 28 | 	set token [::http::geturl $::latoc::url -timeout 20000]
 29 | 
 30 | 	set status [::http::status $token]
 31 | 	if {$status != "ok"} {
 32 | 		set http_error [::http::error $token]
 33 | 		$::latoc::output_cmd "PRIVMSG $chan :HTTP error: $status: $http_error"
 34 | 		::http::cleanup $token
 35 | 		return
 36 | 	}
 37 | 
 38 | 	set ncode [::http::ncode $token]
 39 | 	if {$ncode != 200} {
 40 | 		set code [::http::code $token]
 41 | 		$::latoc::output_cmd "PRIVMSG $chan :HTTP error: $ncode: $code"
 42 | 		::http::cleanup $token
 43 | 		return
 44 | 	}
 45 | 
 46 | 	set data [::http::data $token]
 47 | 	::http::cleanup $token
 48 | 
 49 | 	return $data
 50 | }
 51 | 
 52 | proc ::latoc::parse {data} {
 53 | 	set lines []
 54 | 	foreach stock [regexp -all -inline -- $::latoc::list_regexp $data] {
 55 | 		if {![regexp $::latoc::stock_regexp $stock -> symbol name price last change percent volume interest]} {
 56 | 			error "error parsing HTML"
 57 | 		}
 58 | 
 59 | 		set direction none
 60 | 		if {$change < 0} {
 61 | 			set direction Down
 62 | 		}
 63 | 		if {$change > 0} {
 64 | 			set direction Up
 65 | 		}
 66 | 		lappend lines [::latoc::format $name $price $last $direction $change $percent]
 67 | 	}
 68 | 
 69 | 	return $lines
 70 | }
 71 | 
 72 | proc ::latoc::output {chan lines symbol_pattern} {
 73 | 	foreach line $lines {
 74 | 		if {![regexp -- $symbol_pattern $line]} {
 75 | 			continue
 76 | 		}
 77 | 		$::latoc::output_cmd "PRIVMSG $chan :$line"
 78 | 	}
 79 | }
 80 | 
 81 | proc ::latoc::oil_handler {nick uhost hand chan argv} {
 82 | 	if {![channel get $chan latoc]} { return }
 83 | 
 84 | 	set data [::latoc::fetch $chan]
 85 | 	set lines [::latoc::parse $data]
 86 | 	::latoc::output $chan $lines {Crude Oil}
 87 | }
 88 | 
 89 | proc ::latoc::gold_handler {nick uhost hand chan argv} {
 90 | 	if {![channel get $chan latoc]} { return }
 91 | 
 92 | 	set data [::latoc::fetch $chan]
 93 | 	set lines [::latoc::parse $data]
 94 | 	::latoc::output $chan $lines {Gold}
 95 | }
 96 | 
 97 | proc ::latoc::silver_handler {nick uhost hand chan argv} {
 98 | 	if {![channel get $chan latoc]} { return }
 99 | 
100 | 	set data [::latoc::fetch $chan]
101 | 	set lines [::latoc::parse $data]
102 | 	::latoc::output $chan $lines {Silver}
103 | }
104 | 
105 | proc ::latoc::format {name price last direction change percent} {
106 | 	return "$name: \00310$price [::latoc::colour $direction $change] [::latoc::colour $direction $percent]\003 $last"
107 | }
108 | 
109 | proc ::latoc::colour {direction value} {
110 | 	if {[string match "Down" $direction]} {
111 | 		return \00304$value\017
112 | 	}
113 | 	if {[string match "Up" $direction]} {
114 | 		return \00309$value\017
115 | 	}
116 | 	return $value
117 | }
118 | 
119 | putlog "latoc.tcl loaded"
120 | 


--------------------------------------------------------------------------------
/mysqlquote.tcl:
--------------------------------------------------------------------------------
  1 | #
  2 | # 16/08/2010
  3 | # by horgh
  4 | #
  5 | # MySQL quote script
  6 | #
  7 | # Setup:
  8 | #  The table must be called "quote" and have the following schema:
  9 | #  CREATE TABLE quote (
 10 | #   	qid SMALLINT UNSIGNED NOT NULL AUTO_INCREMENT,
 11 | #   	uid SMALLINT UNSIGNED NOT NULL,
 12 | #   	quote TEXT NOT NULL,
 13 | #   	PRIMARY KEY (qid)
 14 | #  );
 15 | #  Other keys are possible but not required
 16 | #
 17 | # aq (addquote) usage:
 18 | #  - \n starts a new line for the quote
 19 | #  - e.g.: aq <user> hi there!\n<user2> hey
 20 | #    becomes the quote:
 21 | #     <user> hi there
 22 | #     <user2> hey
 23 | #
 24 | 
 25 | package require mysqltcl
 26 | 
 27 | namespace eval sqlquote {
 28 | 	variable output_cmd putserv
 29 | 
 30 | 	# MySQL settings
 31 | 	variable host localhost
 32 | 	variable user quote
 33 | 	variable pass quote
 34 | 	variable db quote
 35 | 
 36 | 	# mysql connection handler
 37 | 	variable conn []
 38 | 
 39 | 	# search results stored in this dict
 40 | 	variable results []
 41 | 
 42 | 	bind pub -|- latest     sqlquote::latest
 43 | 	bind pub -|- quotestats sqlquote::stats
 44 | 	bind pub -|- quote      sqlquote::quote
 45 | 	bind pub -|- aq         sqlquote::addquote
 46 | 	bind pub m|- delquote   sqlquote::delquote
 47 | 
 48 | 	setudef flag quote
 49 | }
 50 | 
 51 | proc sqlquote::connect {} {
 52 | 	# If connection not initialised or has disconnected
 53 | 	if {![mysql::state $sqlquote::conn -numeric] || ![mysql::ping $sqlquote::conn]} {
 54 | 		set sqlquote::conn [mysql::connect -host $sqlquote::host -user $sqlquote::user -password $sqlquote::pass -db $sqlquote::db]
 55 | 		putlog "Connecting to db..."
 56 | 	}
 57 | }
 58 | 
 59 | # fetch a single quote row with given statement
 60 | proc sqlquote::fetch_single {stmt} {
 61 | 	mysql::sel $sqlquote::conn $stmt
 62 | 	mysql::map $sqlquote::conn {qid quote} {
 63 | 		set q [list qid $qid quote $quote]
 64 | 	}
 65 | 	return $q
 66 | }
 67 | 
 68 | proc sqlquote::fetch_search {terms} {
 69 | 	putlog "Retrieving new quotes for $terms..."
 70 | 	set terms [mysql::escape $sqlquote::conn $terms]
 71 | 	set stmt "SELECT qid, quote FROM quote WHERE quote LIKE \"%${terms}%\" LIMIT 20"
 72 | 	set count [mysql::sel $sqlquote::conn $stmt]
 73 | 	if {$count <= 0} {
 74 | 		return []
 75 | 	}
 76 | 	mysql::map $sqlquote::conn {qid quote} {
 77 | 		lappend quotes [list qid $qid quote $quote]
 78 | 	}
 79 | 	return $quotes
 80 | }
 81 | 
 82 | proc sqlquote::stats {nick host hand chan argv} {
 83 | 	if {![channel get $chan quote]} { return }
 84 | 	sqlquote::connect
 85 | 	set stmt "SELECT COUNT(qid) FROM quote"
 86 | 	mysql::sel $sqlquote::conn $stmt
 87 | 	mysql::map $sqlquote::conn {c} {
 88 | 		set count $c
 89 | 	}
 90 | 	$sqlquote::output_cmd "PRIVMSG $chan :There are $count quotes in the database."
 91 | }
 92 | 
 93 | proc sqlquote::latest {nick host hand chan argv} {
 94 | 	if {![channel get $chan quote]} { return }
 95 | 	sqlquote::connect
 96 | 	set stmt "SELECT qid, quote FROM quote ORDER BY qid DESC LIMIT 1"
 97 | 	sqlquote::output $chan [sqlquote::fetch_single $stmt]
 98 | }
 99 | 
100 | proc sqlquote::random {} {
101 | 	set stmt "SELECT qid, quote FROM quote ORDER BY RAND() LIMIT 1"
102 | 	return [sqlquote::fetch_single $stmt]
103 | }
104 | 
105 | proc sqlquote::quote_by_id {id} {
106 | 	set stmt "SELECT qid, quote FROM quote WHERE qid = ${id}"
107 | 	return [sqlquote::fetch_single $stmt]
108 | }
109 | 
110 | proc sqlquote::quote {nick host hand chan argv} {
111 | 	if {![channel get $chan quote]} { return }
112 | 	sqlquote::connect
113 | 	if {$argv == ""} {
114 | 		sqlquote::output $chan [sqlquote::random]
115 | 	} elseif {[string is integer $argv]} {
116 | 		sqlquote::output $chan [sqlquote::quote_by_id $argv]
117 | 	} else {
118 | 		sqlquote::output $chan {*}[sqlquote::search $argv]
119 | 	}
120 | }
121 | 
122 | proc sqlquote::search {terms} {
123 | 	set terms [regsub -all -- {\*} $terms "%"]
124 | 	if {![dict exists $sqlquote::results $terms]} {
125 | 		dict set sqlquote::results $terms [sqlquote::fetch_search $terms]
126 | 	}
127 | 
128 | 	# Extract one quote from results
129 | 	set quotes [dict get $sqlquote::results $terms]
130 | 	set quote [lindex $quotes 0]
131 | 	set quotes [lreplace $quotes 0 0]
132 | 
133 | 	# Remove key if no quotes after removal of one, else update quotes
134 | 	if {![llength $quotes]} {
135 | 		dict unset sqlquote::results $terms
136 | 	} else {
137 | 		dict set sqlquote::results $terms $quotes
138 | 	}
139 | 	return [list $quote [llength $quotes]]
140 | }
141 | 
142 | proc sqlquote::addquote {nick host hand chan argv} {
143 | 	if {![channel get $chan quote]} { return }
144 | 	if {$argv == ""} {
145 | 		$sqlquote::output_cmd "PRIVMSG $chan :Usage: aq <text...>"
146 | 		return
147 | 	}
148 | 	sqlquote::connect
149 | 
150 | 	set argv [regsub -all -- {\\n} $argv \n]
151 | 	set quote [mysql::escape $sqlquote::conn $argv]
152 | 	set stmt "INSERT INTO quote (uid, quote) VALUES(1, \"${quote}\")"
153 | 	set count [mysql::exec $sqlquote::conn $stmt]
154 | 	$sqlquote::output_cmd "PRIVMSG $chan :${count} quote added."
155 | }
156 | 
157 | proc sqlquote::delquote {nick host hand chan argv} {
158 | 	if {$argv == "" || ![string is integer $argv]} {
159 | 		$sqlquote::output_cmd "PRIVMSG $chan :Usage: delquote <#>"
160 | 		return
161 | 	}
162 | 	sqlquote::connect
163 | 	set stmt "DELETE FROM quote WHERE qid = ${argv}"
164 | 	set count [mysql::exec $sqlquote::conn $stmt]
165 | 	$sqlquote::output_cmd "PRIVMSG $chan :#${argv} deleted. ($count quotes affected.)"
166 | }
167 | 
168 | # quote is dict of form {qid ID quote TEXT}
169 | proc sqlquote::output {chan quote {left {}}} {
170 | 	if {$quote == ""} {
171 | 		$sqlquote::output_cmd "PRIVMSG $chan :No quotes found."
172 | 		return
173 | 	}
174 | 	set qid [dict get $quote qid]
175 | 	set text [dict get $quote quote]
176 | 	set head "Quote #\002$qid\002"
177 | 	if {$left ne ""} {
178 | 		set head "${head} ($left left)"
179 | 	}
180 | 	$sqlquote::output_cmd "PRIVMSG $chan :$head"
181 | 	foreach l [split $text \n] {
182 | 		$sqlquote::output_cmd "PRIVMSG $chan : $l"
183 | 	}
184 | }
185 | 
186 | sqlquote::connect
187 | putlog "sqlquote.tcl loaded"
188 | 


--------------------------------------------------------------------------------
/patternban.tcl:
--------------------------------------------------------------------------------
  1 | #
  2 | # 10/07/2011
  3 | #
  4 | 
  5 | namespace eval patternban {
  6 | 	variable filename "scripts/patternbans.txt"
  7 | 	variable ban_reason "bye"
  8 | 
  9 | 	# List of pattern bans. Each item in list has the syntax:
 10 | 	# {channel} {host pattern} {words pattern}
 11 | 	variable patternbans [list]
 12 | 
 13 | 	bind msg o|- "!addpatternban"   ::patternban::add
 14 | 	bind msg o|- "!listpatternbans" ::patternban::ls
 15 | 	bind msg o|- "!delpatternban"   ::patternban::rm
 16 | 
 17 | 	bind pubm -|- "*" ::patternban::match
 18 | }
 19 | 
 20 | # Return a list consisting of the 3 parts of a uhost: nick!ident@host
 21 | # Not used. Only part of match_mask.
 22 | proc ::patternban::split_uhost {uhost} {
 23 | 	set nick_uhost [split $uhost !]
 24 | 	set nick [lindex $nick_uhost 0]
 25 | 
 26 | 	set ident_host [split [lindex $nick_uhost 1] @]
 27 | 
 28 | 	set ident [lindex $ident_host 0]
 29 | 	set host [lindex $ident_host 1]
 30 | 
 31 | 	return [list $nick $ident $host]
 32 | }
 33 | 
 34 | # Return whether uhost matches the given uhost_mask
 35 | # Not used. Same as matchaddr?
 36 | proc ::patternban::match_mask {uhost_mask uhost} {
 37 | 	set mask_split [::patternban::split_uhost $uhost_mask]
 38 | 	set uhost_split [::patternban::split_uhost $uhost]
 39 | 	# Nick portion
 40 | 	if {[string match [lindex $mask_split 0] [lindex $uhost_split 0]]} {
 41 | 		# Ident portion
 42 | 		if {[string match [lindex $mask_split 1] [lindex $uhost_split 1]]} {
 43 | 			if {[string match [lindex $mask_split 2] [lindex $uhost_split 2]]} {
 44 | 				return 1
 45 | 			}
 46 | 		}
 47 | 	}
 48 | 	return 0
 49 | }
 50 | 
 51 | proc ::patternban::ban {chan nick uhost} {
 52 | 	putlog "Trying to ban ${nick}!${uhost} on $chan."
 53 | 	putserv "mode $chan +b [maskhost $uhost 3]"
 54 | 	putserv "kick $chan $nick :$::patternban::ban_reason"
 55 | }
 56 | 
 57 | proc ::patternban::match {nick uhost hand chan text} {
 58 | 	foreach pattern $::patternban::patternbans {
 59 | 		set pattern_channel [lindex $pattern 0]
 60 | 		set pattern_uhost [lindex $pattern 1]
 61 | 		set pattern_pattern [lindex $pattern 2]
 62 | 		if {$chan == $pattern_channel} {
 63 | 			if {[string match *${pattern_pattern}* $text] && [matchaddr $pattern_uhost ${nick}!${uhost}]} {
 64 | 				::patternban::ban $chan $nick $uhost
 65 | 				return
 66 | 			}
 67 | 		}
 68 | 	}
 69 | }
 70 | 
 71 | proc ::patternban::add {nick uhost hand text} {
 72 | 	set text [split $text]
 73 | 	if {[llength $text] != 3} {
 74 | 		putserv "PRIVMSG $nick :Usage: !addpatternban <#channel> <nick!user@host pattern> <string pattern>"
 75 | 		return
 76 | 	}
 77 | 	set channel [lindex $text 0]
 78 | 	set uhost_pattern [lindex $text 1]
 79 | 	set pattern [lindex $text 2]
 80 | 	lappend ::patternban::patternbans [list $channel $uhost_pattern $pattern]
 81 | 	::patternban::save_patternbans
 82 | 	putserv "PRIVMSG $nick :Added pattern ban on $channel for $uhost_pattern containing $pattern."
 83 | }
 84 | 
 85 | proc ::patternban::ls {nick uhost hand text} {
 86 | 	set count 0
 87 | 	putserv "PRIVMSG $nick :[llength $::patternban::patternbans] patternbans."
 88 | 	foreach pattern $::patternban::patternbans {
 89 | 		putserv "PRIVMSG $nick :#${count}: $pattern"
 90 | 		incr count
 91 | 	}
 92 | }
 93 | 
 94 | proc ::patternban::rm {nick uhost hand text} {
 95 | 	set text [split $text]
 96 | 	if {[llength $text] != 1 || ![string is digit $text]} {
 97 | 		putserv "PRIVMSG $nick :Usage: !delpatternban <#>"
 98 | 		return
 99 | 	}
100 | 	if {$text >= [llength $::patternban::patternbans]} {
101 | 		putserv "PRIVMSG $nick :Error: No such pattern ban."
102 | 		return
103 | 	}
104 | 	set ::patternban::patternbans [lreplace $::patternban::patternbans $text $text]
105 | 	putserv "PRIVMSG $nick :Pattern ban deleted."
106 | 	::patternban::save_patternbans
107 | }
108 | 
109 | proc ::patternban::save_patternbans {} {
110 | 	if {[catch {open $::patternban::filename w} fid]} {
111 | 		return
112 | 	}
113 | 	puts -nonewline $fid $::patternban::patternbans
114 | 	close $fid
115 | }
116 | 
117 | proc ::patternban::load_patternbans {} {
118 | 	if {[catch {open $::patternban::filename r} fid]} {
119 | 		return
120 | 	}
121 | 	set ::patternban::patternbans [read -nonewline $fid]
122 | 	close $fid
123 | }
124 | 
125 | ::patternban::load_patternbans
126 | putlog "patternban.tcl loaded"
127 | 


--------------------------------------------------------------------------------
/slang.tcl:
--------------------------------------------------------------------------------
  1 | #
  2 | # slang.tcl - June 24 2010
  3 | # by horgh
  4 | #
  5 | # Requires Tcl 8.5+ and tcllib
  6 | #
  7 | # Made with heavy inspiration from perpleXa's urbandict script!
  8 | #
  9 | # Must .chanset #channel +ud
 10 | #
 11 | # Uses is.gd to shorten long definition URL if isgd.tcl package present
 12 | #
 13 | 
 14 | package require htmlparse
 15 | package require http
 16 | package require tls
 17 | 
 18 | ::http::register https 443 [list ::tls::socket -ssl2 0 -ssl3 0 -tls1 1]
 19 | 
 20 | namespace eval ::ud {
 21 | 	# set this to !ud or whatever you want
 22 | 	variable trigger "slang"
 23 | 
 24 | 	# maximum lines to output
 25 | 	variable max_lines 1
 26 | 
 27 | 	# approximate characters per line
 28 | 	variable line_length 400
 29 | 
 30 | 	# show truncated message / url if more than one line
 31 | 	variable show_truncate 1
 32 | 
 33 | 	# toggle whether we store raw response data.
 34 | 	# this will store the response from an http request to urbandictionary.com
 35 | 	# in files for debugging.
 36 | 	# NOTE: enabling this will cause a file to be created for every request
 37 | 	#   the script makes, so these can pile up quickly!
 38 | 	variable store_responses 0
 39 | 	# the directory to store responses if store_responses is on.
 40 | 	# this is under your eggdrop directory.
 41 | 	# files under this directory will be named with unix timestamps
 42 | 	# (microseconds).
 43 | 	variable store_responses_dir slang_responses
 44 | 
 45 | 	variable output_cmd "putserv"
 46 | 
 47 | 	variable client "Mozilla/5.0 (compatible; Y!J; for robot study; keyoshid)"
 48 | 	variable url https://www.urbandictionary.com/define.php
 49 | 	variable url_random https://www.urbandictionary.com/random.php
 50 | 
 51 | 	# regex to find the word
 52 | 	variable word_regex {<a class="word" href=.*?>(.*?)</a>}
 53 | 	variable list_regex {<div class="def-panel *" data-defid="[0-9]+?">.*?<div class="def-footer">}
 54 | 	variable def_regex  {<div class="def-panel *" data-defid="([0-9]+?)">.*?<div class="meaning">(.*?)</div>.*?<div class="example">(.*?)</div>}
 55 | 
 56 | 	setudef flag ud
 57 | 	bind pub -|- $::ud::trigger ::ud::handler
 58 | 
 59 | 	# 0 if isgd package is present
 60 | 	variable isgd_disabled [catch {package require isgd}]
 61 | }
 62 | 
 63 | # write a console log message.
 64 | proc ::ud::log {msg} {
 65 | 	if {[string length $msg] == 0} {
 66 | 		return
 67 | 	}
 68 | 	putlog "slang.tcl $msg"
 69 | }
 70 | 
 71 | proc ::ud::handler {nick uhost hand chan argv} {
 72 | 	if {![channel get $chan ud]} { return }
 73 | 	set argv [string trim $argv]
 74 | 	set argv [split $argv]
 75 | 	if {[string is digit [lindex $argv 0]]} {
 76 | 		set number [lindex $argv 0]
 77 | 		set query [join [lrange $argv 1 end]]
 78 | 	} else {
 79 | 		set query [join $argv]
 80 | 		set number 1
 81 | 	}
 82 | 	set query [string trim $query]
 83 | 
 84 | 	if {[llength $argv] == 1 && [string is digit [lindex $argv 0]]} {
 85 | 		$::ud::output_cmd "PRIVMSG $chan :Usage: $::ud::trigger \[#\] <query> (or just $::ud::trigger for random definition)"
 86 | 		return
 87 | 	}
 88 | 
 89 | 	if {$query == ""} {
 90 | 		::ud::log "Performing random query..."
 91 | 		if {[catch {::ud::get_random} result]} {
 92 | 			$::ud::output_cmd "PRIVMSG $chan :Error: $result"
 93 | 			return
 94 | 		}
 95 | 		::ud::output $chan $result
 96 | 	} else {
 97 | 		::ud::log "Fetching definition $number of $query..."
 98 | 		if {[catch {::ud::get_def $query $number} result]} {
 99 | 			$::ud::output_cmd "PRIVMSG $chan :Error: $result"
100 | 			return
101 | 		}
102 | 		::ud::output $chan $result
103 | 	}
104 | }
105 | 
106 | proc ::ud::output {chan def_dict} {
107 | 	set output 0
108 | 	foreach line [::ud::split_line $::ud::line_length [dict get $def_dict definition]] {
109 | 		if {[incr output] > $::ud::max_lines} {
110 | 			if {$::ud::show_truncate} {
111 | 				$::ud::output_cmd "PRIVMSG $chan :Output truncated. [::ud::def_url $def_dict]"
112 | 			}
113 | 			break
114 | 		}
115 | 		$::ud::output_cmd "PRIVMSG $chan :$line"
116 | 	}
117 | }
118 | 
119 | proc ::ud::get_random {} {
120 | 	set result [::ud::http_fetch $::ud::url_random -1]
121 | 	set word [dict get $result word]
122 | 	set defs_html [dict get $result definitions]
123 | 
124 | 	if {[llength $defs_html] < 1} {
125 | 		error "Failure finding random definition."
126 | 	}
127 | 
128 | 	return [::ud::parse $word [lindex $defs_html 0]]
129 | }
130 | 
131 | proc ::ud::get_def {query number} {
132 | 	set page [expr {int(ceil($number / 7.0))}]
133 | 	set number [expr {$number - (($page - 1) * 7)}]
134 | 
135 | 	set url $::ud::url
136 | 	append url ?
137 | 	if {$page == 1} {
138 | 		append url [::http::formatQuery term $query]
139 | 	} else {
140 | 		append url [::http::formatQuery term $query page $page]
141 | 	}
142 | 
143 | 	set result [::ud::http_fetch $url $page]
144 | 	set word [dict get $result word]
145 | 	set defs_html [dict get $result definitions]
146 | 
147 | 	if {[llength $defs_html] < $number} {
148 | 		error "[llength $defs_html] definitions found."
149 | 	}
150 | 
151 | 	return [::ud::parse $word [lindex $defs_html [expr {$number - 1}]]]
152 | }
153 | 
154 | # store an http request response (if enabled).
155 | proc ::ud::store_response {data} {
156 | 	if {!$::ud::store_responses} {
157 | 		return
158 | 	}
159 | 
160 | 	# ensure the directory to store the responses exists.
161 | 	if {![file isdirectory $::ud::store_responses_dir]} {
162 | 		# mkdir raises an error if it fails.
163 | 		file mkdir $::ud::store_responses_dir
164 | 	}
165 | 
166 | 	# make the filename that we will store to.
167 | 	set base [clock microseconds]
168 | 	set path [file join $::ud::store_responses_dir $base]
169 | 
170 | 	# write out the response
171 | 	set f [open $path w]
172 | 	puts -nonewline $f $data
173 | 	close $f
174 | 	::ud::log "stored response to $path"
175 | }
176 | 
177 | proc ::ud::http_fetch {url page} {
178 | 	http::config -useragent $::ud::client
179 | 
180 | 	::ud::log "Fetching $url"
181 | 	set token [http::geturl $url -timeout 20000]
182 | 	set data [http::data $token]
183 | 	set ncode [http::ncode $token]
184 | 	set meta [http::meta $token]
185 | 	http::cleanup $token
186 | 
187 | 	# Follow redirects
188 | 	if {[regexp -- {30[01237]} $ncode]} {
189 | 		set new_url [::ud::get_location_header $meta]
190 | 		# We lose our page parameter apparently.
191 | 		if {$page != -1 && $page != 1} {
192 | 			append new_url &page=$page
193 | 		}
194 | 		return [::ud::http_fetch $new_url $page]
195 | 	}
196 | 
197 | 	if {$ncode == 404} {
198 | 		error "No definitions found."
199 | 	}
200 | 
201 | 	if {$ncode != 200} {
202 | 		error "HTTP fetch error. Code: $ncode"
203 | 	}
204 | 
205 | 	# we may be storing responses for debugging.
206 | 	if {[catch {::ud::store_response $data} result]} {
207 | 		putlog "Problem storing response: $result"
208 | 	}
209 | 
210 | 	return [::ud::parse_word_and_definitions $data]
211 | }
212 | 
213 | proc ::ud::get_location_header {meta} {
214 | 	dict for {k v} $meta {
215 | 		set k [string tolower $k]
216 | 		if {$k == "location"} {
217 | 			return $v
218 | 		}
219 | 	}
220 | 	error "Location header not found"
221 | }
222 | 
223 | # parse a response from a file.
224 | # this is primarily for debugging purposes. we can pass this function
225 | # a stored response file to try to parse it.
226 | proc ::ud::parse_response_file {path} {
227 | 	set f [open $path]
228 | 	set data [read -nonewline $f]
229 | 	close $f
230 | 
231 | 	return [::ud::parse_word_and_definitions $data]
232 | }
233 | 
234 | # first pass parsing - we pull out the word and the definitions from
235 | # the page.
236 | # we return a dictionary with keys 'word' and 'definitions' on success.
237 | # on failure, we raise an error.
238 | proc ::ud::parse_word_and_definitions {data} {
239 | 	# pull out the word.
240 | 	if {![regexp -- $::ud::word_regex $data -> word]} {
241 | 		error "Word not found. No definitions or parsing problem!"
242 | 	}
243 | 	set word [string trim $word]
244 | 	set definitions [regexp -all -inline -- $::ud::list_regex $data]
245 | 	set definition_count [llength $definitions]
246 | 	if {$definition_count == 0} {
247 | 		error "No definitions found"
248 | 	}
249 | 	return [list word $word definitions $definitions]
250 | }
251 | 
252 | proc ::ud::parse {word raw_definition} {
253 | 	if {![regexp $::ud::def_regex $raw_definition -> number definition]} {
254 | 		error "Could not parse definition's HTML"
255 | 	}
256 | 	set definition [htmlparse::mapEscapes $definition]
257 | 	set definition [regsub -all -- {<.*?>} $definition ""]
258 | 	set definition [regsub -all -- {\n+} $definition " "]
259 | 	set definition [string tolower $definition]
260 | 	set definition [string trim $definition]
261 | 	return [list number $number word $word definition "$word is $definition"]
262 | }
263 | 
264 | proc ::ud::def_url {def_dict} {
265 | 	set word [dict get $def_dict word]
266 | 	set number [dict get $def_dict number]
267 | 	set raw_url ${::ud::url}?[http::formatQuery term $word defid $number]
268 | 	if {$::ud::isgd_disabled} {
269 | 		return $raw_url
270 | 	} else {
271 | 		if {[catch {isgd::shorten $raw_url} shortened]} {
272 | 			return "$raw_url (is.gd error)"
273 | 		} else {
274 | 			return $shortened
275 | 		}
276 | 	}
277 | }
278 | 
279 | # by fedex
280 | proc ::ud::split_line {max str} {
281 | 	set last [expr {[string length $str] -1}]
282 | 	set start 0
283 | 	set end [expr {$max -1}]
284 | 
285 | 	set lines []
286 | 
287 | 	while {$start <= $last} {
288 | 		if {$last >= $end} {
289 | 			set end [string last { } $str $end]
290 | 		}
291 | 
292 | 		lappend lines [string trim [string range $str $start $end]]
293 | 		set start $end
294 | 		set end [expr {$start + $max}]
295 | 	}
296 | 
297 | 	return $lines
298 | }
299 | 
300 | putlog "slang.tcl loaded"
301 | 


--------------------------------------------------------------------------------
/userrec.tcl:
--------------------------------------------------------------------------------
 1 | # This script provides minimal Eggdrop user record manipulation in a channel.
 2 | #
 3 | # Primarily I'm interested in letting people know if the bot recognizes them.
 4 | 
 5 | namespace eval ::ur {}
 6 | 
 7 | proc ::ur::whoami {nick uhost hand chan argv} {
 8 | 	if {$hand == "*"} {
 9 | 		putserv "PRIVMSG $chan :I don't know you!"
10 | 		return
11 | 	}
12 | 	putserv "PRIVMSG $chan :You're $hand"
13 | }
14 | 
15 | setudef flag userrec
16 | bind pub -|- .whoami ::ur::whoami
17 | 
18 | putlog "userrec.tcl (https://github.com/horgh/eggdrop-scripts) loaded"
19 | 


--------------------------------------------------------------------------------
/weather-darksky.conf.sample:
--------------------------------------------------------------------------------
1 | geonames_username = example
2 | darksky_key = example
3 | geonames_cache_file = geonames-cache.bin
4 | 


--------------------------------------------------------------------------------
/weather-darksky.tcl:
--------------------------------------------------------------------------------
  1 | # A weather script that uses www.darksky.net as its source. Its output is based
  2 | # on incith-weather.tcl.
  3 | #
  4 | # It relies on two packages:
  5 | # - https://github.com/horgh/geonames-tcl (for looking up latitude/longitude)
  6 | # - https://github.com/horgh/darksky-tcl (for looking up weather)
  7 | #
  8 | # Setup:
  9 | # - Create a weather-darksky.conf and put it in your Eggdrop root directory.
 10 | #   See weather-darksky.conf.sample for the format.
 11 | # - You'll need to source both of those .tcl files in your bot prior to this
 12 | #   one.
 13 | # - Partyline: .chanset #channel +weather-darksky
 14 | # - Channel: .wz <location> for current weather or .wzf <location> for a
 15 | #   forecast
 16 | 
 17 | package require darksky
 18 | package require geonames
 19 | 
 20 | namespace eval ::wds {
 21 | 	variable output_cmd putserv
 22 | 	variable geonames_cache [dict create]
 23 | }
 24 | 
 25 | proc ::wds::lookup_current {nick uhost hand chan argv} {
 26 | 	if {![channel get $chan weather-darksky]} { return }
 27 | 
 28 | 	set query [::wds::get_query $nick $uhost $argv]
 29 | 	if {$query == ""} {
 30 | 		$::wds::output_cmd "PRIVMSG $chan :Usage: .wz <location>"
 31 | 		return
 32 | 	}
 33 | 
 34 | 	set data [::wds::get_data $chan $query]
 35 | 	if {![dict exists $data geonames] || ![dict exists $data darksky]} {
 36 | 		return
 37 | 	}
 38 | 	set geonames [dict get $data geonames]
 39 | 	set darksky [dict get $data darksky]
 40 | 
 41 | 	if {[catch {::wds::output_current $chan $geonames $darksky} error]} {
 42 | 		$::wds::output_cmd "PRIVMSG $chan :Error: $error"
 43 | 	}
 44 | }
 45 | 
 46 | proc ::wds::lookup_forecast {nick uhost hand chan argv} {
 47 | 	if {![channel get $chan weather-darksky]} { return }
 48 | 
 49 | 	set query [::wds::get_query $nick $uhost $argv]
 50 | 	if {$query == ""} {
 51 | 		$::wds::output_cmd "PRIVMSG $chan :Usage: .wzf <location>"
 52 | 		return
 53 | 	}
 54 | 
 55 | 	set data [::wds::get_data $chan $query]
 56 | 	if {![dict exists $data geonames] || ![dict exists $data darksky]} {
 57 | 		return
 58 | 	}
 59 | 	set geonames [dict get $data geonames]
 60 | 	set darksky [dict get $data darksky]
 61 | 
 62 | 	if {[catch {::wds::output_forecast $chan $geonames $darksky} error]} {
 63 | 		$::wds::output_cmd "PRIVMSG $chan :Error: $error"
 64 | 	}
 65 | }
 66 | 
 67 | # Retrieve the query to look up. If none is given, return the last one we used.
 68 | # If one was given, remember it.
 69 | #
 70 | # We only remember it if there is a matching user record. In theory we could add
 71 | # users but in order to do that we must have a handle to assign them, and what
 72 | # to use is unclear. I suppose we could generate something random.
 73 | proc ::wds::get_query {nick uhost argv} {
 74 | 	set query [string trim $argv]
 75 | 	set query [string tolower $query]
 76 | 	if {$query != ""} {
 77 | 		::wds::set_default_location $nick $uhost $query
 78 | 		return $query
 79 | 	}
 80 | 
 81 | 	return [::wds::get_default_location $nick $uhost]
 82 | }
 83 | 
 84 | proc ::wds::set_default_location {nick uhost query} {
 85 | 	set hand [finduser $nick!$uhost]
 86 | 	if {$hand == "*"} {
 87 | 		return
 88 | 	}
 89 | 
 90 | 	setuser $hand XTRA weather-darksky $query
 91 | }
 92 | 
 93 | proc ::wds::get_default_location {nick uhost} {
 94 | 	set hand [finduser $nick!$uhost]
 95 | 	if {$hand == "*"} {
 96 | 		return ""
 97 | 	}
 98 | 
 99 | 	set location [getuser $hand XTRA weather-darksky]
100 | 	return $location
101 | }
102 | 
103 | proc ::wds::get_data {chan query} {
104 | 	set conf [::wds::load_config]
105 | 
106 | 	set geonames_result [::wds::get_lat_long $conf $query]
107 | 	if {[dict exists $geonames_result error]} {
108 | 		$::wds::output_cmd "PRIVMSG $chan :Error looking up latitude/longitude: [dict get $geonames_result error]"
109 | 		return [dict create]
110 | 	}
111 | 
112 | 	set darksky [::darksky::new [dict get $conf darksky_key]]
113 | 	set darksky_result [::darksky::forecast $darksky \
114 | 		[dict get $geonames_result lat] [dict get $geonames_result lng]]
115 | 	if {[dict exists $darksky_result error]} {
116 | 		$::wds::output_cmd "PRIVMSG $chan :Error looking up forecast: [dict get $darksky_result error]"
117 | 		return [dict create]
118 | 	}
119 | 
120 | 	return [dict create geonames $geonames_result darksky $darksky_result]
121 | }
122 | 
123 | proc ::wds::get_lat_long {conf query} {
124 | 	if {[dict exists $::wds::geonames_cache $query]} {
125 | 		return [dict get $::wds::geonames_cache $query]
126 | 	}
127 | 
128 | 	set geonames [::geonames::new [dict get $conf geonames_username]]
129 | 
130 | 	set geonames_result {}
131 | 
132 | 	# If the user gave us what looks like a US zip code, use the postal code
133 | 	# search API rather than the text search API. The text search API gives
134 | 	# unreliable results using zip codes alone.
135 | 	if {[regexp -- {\A[0-9]{5}\Z} $query]} {
136 | 		set geonames_result [::geonames::postalcode_latlong $geonames $query US]
137 | 	} else {
138 | 		set geonames_result [::geonames::search_latlong $geonames $query]
139 | 	}
140 | 
141 | 	if {![dict exists $geonames_result error]} {
142 | 		dict set ::wds::geonames_cache $query $geonames_result
143 | 		::wds::save_cache $conf
144 | 	}
145 | 
146 | 	return $geonames_result
147 | }
148 | 
149 | proc ::wds::save_cache {conf} {
150 | 	set fh [open [dict get $conf geonames_cache_file] w]
151 | 	puts -nonewline $fh $::wds::geonames_cache
152 | 	close $fh
153 | }
154 | 
155 | proc ::wds::load_cache {} {
156 | 	set conf [::wds::load_config]
157 | 
158 | 	if {![file exists [dict get $conf geonames_cache_file]]} {
159 | 		set ::wds::geonames_cache [dict create]
160 | 		return
161 | 	}
162 | 
163 | 	set fh [open [dict get $conf geonames_cache_file]]
164 | 	set ::wds::geonames_cache [read -nonewline $fh]
165 | 	close $fh
166 | }
167 | 
168 | proc ::wds::load_config {} {
169 | 	set fh [open weather-darksky.conf]
170 | 	set contents [read -nonewline $fh]
171 | 	close $fh
172 | 
173 | 	set lines [split $contents \n]
174 | 	set conf [dict create]
175 | 	foreach line $lines {
176 | 		set line [string trim $line]
177 | 		if {$line == ""} {
178 | 			continue
179 | 		}
180 | 
181 | 		set pieces [split $line "="]
182 | 		if {[llength $pieces] != 2} {
183 | 			putlog "weather-darksky.tcl: Invalid configuration line: $line"
184 | 			continue
185 | 		}
186 | 
187 | 		set key [string trim [lindex $pieces 0]]
188 | 		set value [string trim [lindex $pieces 1]]
189 | 		if {$key == ""} {
190 | 			putlog "weather-darksky.tcl: Invalid key on line: $line"
191 | 			continue
192 | 		}
193 | 		if {$value == ""} {
194 | 			putlog "weather-darksky.tcl: Invalid value on line: $line"
195 | 			continue
196 | 		}
197 | 
198 | 		dict set conf $key $value
199 | 	}
200 | 
201 | 	if {![dict exists $conf geonames_username]} {
202 | 		error "no geonames_username set"
203 | 	}
204 | 	if {![dict exists $conf darksky_key]} {
205 | 		error "no darksky_key set"
206 | 	}
207 | 	if {![dict exists $conf geonames_cache_file ]} {
208 | 		error "no geonames_cache_file set"
209 | 	}
210 | 
211 | 	return $conf
212 | }
213 | 
214 | proc ::wds::output_current {chan geonames darksky} {
215 | 	set output ""
216 | 	append output [dict get $geonames name]
217 | 	append output ", "
218 | 	append output [dict get $geonames countryName]
219 | 
220 | 	append output " ("
221 | 	append output [::wds::format_decimal [dict get $darksky latitude]]
222 | 	append output "°N/"
223 | 	append output [::wds::format_decimal [dict get $darksky longitude]]
224 | 	append output "°W)"
225 | 
226 | 	append output " \002Local time\002: "
227 | 	append output [clock format [dict get $darksky time] \
228 | 		-format   "%H:%M" \
229 | 		-timezone :[dict get $darksky timezone] \
230 | 	]
231 | 
232 | 	append output " \002Conditions\002: "
233 | 	append output [dict get $darksky summary]
234 | 	$::wds::output_cmd "PRIVMSG $chan :$output"
235 | 
236 | 	set output ""
237 | 	append output "\002Temperature\002: "
238 | 	append output [dict get $darksky temperature]
239 | 	append output "°C"
240 | 
241 | 	append output " ("
242 | 	append output [::wds::celsius_to_fahrenheit [dict get $darksky temperature]]
243 | 	append output "°F"
244 | 	append output ")"
245 | 
246 | 	append output " \002Humidity\002: "
247 | 	append output [::wds::format_decimal [expr [dict get $darksky humidity]*100]]
248 | 	append output "%"
249 | 
250 | 	append output " \002Pressure\002: "
251 | 	append output [dict get $darksky pressure]
252 | 	append output " hPa"
253 | 	$::wds::output_cmd "PRIVMSG $chan :$output"
254 | 
255 | 	set output ""
256 | 	append output "\002Wind\002: "
257 | 	append output [dict get $darksky windSpeed]
258 | 	append output "m/s"
259 | 
260 | 	append output " \002Clouds\002: "
261 | 	append output [::wds::format_decimal \
262 | 		[expr [dict get $darksky cloudCover]*100] \
263 | 	]
264 | 	append output "%"
265 | 	$::wds::output_cmd "PRIVMSG $chan :$output"
266 | }
267 | 
268 | proc ::wds::output_forecast {chan geonames darksky} {
269 | 	set output ""
270 | 	append output [dict get $geonames name]
271 | 	append output ", "
272 | 	append output [dict get $geonames countryName]
273 | 
274 | 	append output " ("
275 | 	append output [::wds::format_decimal [dict get $darksky latitude]]
276 | 	append output "°N/"
277 | 	append output [::wds::format_decimal [dict get $darksky longitude]]
278 | 	append output "°W) "
279 | 	$::wds::output_cmd "PRIVMSG $chan :$output"
280 | 
281 | 	set output ""
282 | 	set count 0
283 | 	foreach forecast [dict get $darksky forecast] {
284 | 		if {$count == 5} {
285 | 			break
286 | 		}
287 | 		if {![wds::should_show_forecast [dict get $darksky timezone] $forecast]} {
288 | 			continue
289 | 		}
290 | 
291 | 		if {$output != ""} {
292 | 			append output " "
293 | 		}
294 | 		set day [clock format [dict get $forecast time] -format "%A"]
295 | 		append output "\002$day\002: "
296 | 		append output [dict get $forecast summary]
297 | 		append output " "
298 | 
299 | 		append output [dict get $forecast temperatureMax]
300 | 		append output "/"
301 | 		append output [dict get $forecast temperatureMin]
302 | 		append output "°C"
303 | 
304 | 		append output " ("
305 | 		append output [::wds::celsius_to_fahrenheit \
306 | 			[dict get $forecast temperatureMax] \
307 | 		]
308 | 		append output "/"
309 | 		append output [::wds::celsius_to_fahrenheit \
310 | 			[dict get $forecast temperatureMin] \
311 | 		]
312 | 		append output "°F"
313 | 		append output ")"
314 | 		incr count
315 | 	}
316 | 	$::wds::output_cmd "PRIVMSG $chan :$output"
317 | }
318 | 
319 | # We can get old forecast info. For example if it's Sunday we could get
320 | # Saturday's. We don't want to show that.
321 | #
322 | # We do want to show today's though. The time given in the forecast is at
323 | # 00:00:00 of the day.
324 | proc ::wds::should_show_forecast {timezone forecast} {
325 | 	set now [clock seconds]
326 | 
327 | 	set today        [::wds::format_ymd $timezone $now]
328 | 	set forecast_day [::wds::format_ymd $timezone [dict get $forecast time]]
329 | 
330 | 	return $today == $forecast_day || [dict get $forecast time] >= $now
331 | }
332 | 
333 | proc ::wds::format_ymd {timezone time} {
334 | 	return [clock format $time \
335 | 		-format   "%Y-%m-%d" \
336 | 		-timezone :$timezone \
337 | 	]
338 | }
339 | 
340 | proc ::wds::celsius_to_fahrenheit {celsius} {
341 | 	set fahrenheit [expr $celsius*9.0/5.0+32.0]
342 | 	return [::wds::format_decimal $fahrenheit]
343 | }
344 | 
345 | proc ::wds::format_decimal {number} {
346 | 	return [format "%.2f" $number]
347 | }
348 | 
349 | setudef flag weather-darksky
350 | bind pub -|- .wz ::wds::lookup_current
351 | bind pub -|- .wzf ::wds::lookup_forecast
352 | ::wds::load_cache
353 | 
354 | putlog "weather-darksky.tcl (https://github.com/horgh/eggdrop-scripts) loaded"
355 | putlog "weather-darksky.tcl: Powered by Dark Sky (www.darksky.net)"
356 | putlog "weather-darksky.tcl: Powered by GeoNames (www.geonames.org)"
357 | 


--------------------------------------------------------------------------------
/wiki.tcl:
--------------------------------------------------------------------------------
  1 | #
  2 | # edited Jun 27 2017 for https by genewitch
  3 | # ramok on freenode/#tcl knew the fix
  4 | #
  5 | # Mar 30 2010
  6 | # by horgh
  7 | #
  8 | # Requires Tcl 8.5+ and tcllib
  9 | #
 10 | # Wikipedia.org fetcher
 11 | #
 12 | # To enable you must .chanset #channel +wiki
 13 | #
 14 | # Tests: Whole number (list of possible interpretations)
 15 | #
 16 | 
 17 | package require http
 18 | package require htmlparse
 19 | package require tls
 20 | ::http::register https 443 ::tls::socket
 21 | 
 22 | 
 23 | namespace eval wiki {
 24 | 	variable max_lines 1
 25 | 	variable max_chars 400
 26 | 	variable output_cmd "putserv"
 27 | 	variable url "https://en.wikipedia.org/wiki/"
 28 | 
 29 | 	bind pub -|- "!w" wiki::search
 30 | 	bind pub -|- "!wiki" wiki::search
 31 | 
 32 | #	variable parse_regexp {(<table class.*?<p>.*?</p>.*?</table>)??.*?<p>(.*?)</p>\n<table id="toc"}
 33 | 	variable parse_regexp {(?:</table>)?.*?<p>(.*)((</ul>)|(</p>)).*?((<table id="toc")|(<h2>)|(<table id="disambigbox"))}
 34 | 
 35 | 	setudef flag wiki
 36 | }
 37 | 
 38 | 
 39 | proc wiki::fetch {term {url {}}} {
 40 | 	if {$url != ""} {
 41 | 		set token [http::geturl $url -timeout 10000]
 42 | 	} else {
 43 | 		set query [http::formatQuery [regsub -all -- {\s} $term "_"]]
 44 | 		set token [http::geturl ${wiki::url}${query} -timeout 10000]
 45 | 	}
 46 | 	set data [http::data $token]
 47 | 	set ncode [http::ncode $token]
 48 | 	set meta [http::meta $token]
 49 | 	upvar #0 $token state
 50 | 	set fetched_url $state(url)
 51 | 	http::cleanup $token
 52 | 
 53 | 	# debug
 54 | 	putlog "Fetch! term: $term url: $url fetched: $fetched_url"
 55 | 	set fid [open "w-debug.txt" w]
 56 | 	puts $fid $data
 57 | 	close $fid
 58 | 
 59 | 	# Follow redirects
 60 | 	if {[regexp -- {^3\d{2}$} $ncode]} {
 61 | 		return [wiki::fetch $term [dict get $meta Location]]
 62 | 	}
 63 | 
 64 | 	if {$ncode != 200} {
 65 | 		error "HTTP query failed ($ncode): $data: $meta"
 66 | 	}
 67 | 
 68 | 	# If page returns list of results, choose the first one and fetch that
 69 | 	#if {[regexp -- {<p>.*?((may refer to:)|(in one of the following senses:))</p>} $data]} {
 70 | 	#	regexp -- {<ul>.*?<li>.*? title="(.*?)">.*?</li>} $data -> new_query
 71 | 	#	return [wiki::fetch $new_query]
 72 | 	#}
 73 | 
 74 | 	if {![regexp -- $wiki::parse_regexp $data -> out]} {
 75 | 		error "Parse error"
 76 | 	}
 77 | 
 78 | 	return [list url $fetched_url result [wiki::sanitise $out]]
 79 | }
 80 | 
 81 | proc wiki::sanitise {raw} {
 82 | 	set raw [::htmlparse::mapEscapes $raw]
 83 | 	# Remove some help links
 84 | 	set raw [regsub -- {<small class="metadata">.*?</small>} $raw ""]
 85 | 
 86 | 	set raw [regsub -all -- {<(.*?)>} $raw ""]
 87 | 	set raw [regsub -all -- {\[.*?\]} $raw ""]
 88 | 	set raw [regsub -all -- {\n} $raw " "]
 89 | 	return $raw
 90 | }
 91 | 
 92 | proc wiki::search {nick uhost hand chan argv} {
 93 | 	if {![channel get $chan wiki]} { return }
 94 | 	if {[string length $argv] == 0} {
 95 | 		$wiki::output_cmd "PRIVMSG $chan :Please provide a term."
 96 | 		return
 97 | 	}
 98 | 
 99 | 	set argv [string trim $argv]
100 | 	# Upper case first character
101 | 	set argv [string toupper [string index $argv 0]][string range $argv 1 end]
102 | 
103 | 	if {[catch {wiki::fetch $argv} data]} {
104 | 		$wiki::output_cmd "PRIVMSG $chan :Error: $data"
105 | 		return
106 | 	}
107 | 
108 | 	foreach line [wiki::split_line $wiki::max_chars [dict get $data result]] {
109 | 		if {[incr count] > $wiki::max_lines} {
110 | 			$wiki::output_cmd "PRIVMSG $chan :Output truncated. [dict get $data url]"
111 | 			break
112 | 		}
113 | 		$wiki::output_cmd "PRIVMSG $chan :$line"
114 | 	}
115 | }
116 | 
117 | # by fedex
118 | proc wiki::split_line {max str} {
119 | 	set last [expr {[string length $str] -1}]
120 | 	set start 0
121 | 	set end [expr {$max -1}]
122 | 
123 | 	set lines []
124 | 
125 | 	while {$start <= $last} {
126 | 		if {$last >= $end} {
127 | 			set end [string last { } $str $end]
128 | 		}
129 | 
130 | 		lappend lines [string trim [string range $str $start $end]]
131 | 		set start $end
132 | 		set end [expr {$start + $max}]
133 | 	}
134 | 
135 | 	return $lines
136 | }
137 | 
138 | putlog "wiki.tcl loaded"
139 | 


--------------------------------------------------------------------------------