initial import of bash.tcl

bash.tcl

@@ -0,0 +1,162 @@
+#
+# June 26 2010
+# by horgh
+#
+# Requires Tcl 8.5+ and tcllib
+#
+# Must .chanset #channel +bash
+#
+# Usage: !bash [optional search terms]
+# If search terms are not provided, fetch random quotes.
+#
+# Keeps fetched quotes in memory until displayed, including all results per
+# search term
+#
+
+package require http
+package require htmlparse
+
+namespace eval bash {
+	variable trigger !bash
+	variable line_length 400
+	variable max_lines 10
+
+	variable useragent "Mozilla/5.0 (compatible; Y!J; for robot study; keyoshid)"
+
+	variable output_cmd putserv
+
+	setudef flag bash
+	bind pub -|- $bash::trigger bash::handler
+
+	variable url http://bash.org/?
+
+	variable list_regexp {<p class="quote">.*?<p class="qt">.*?</p>}
+	variable quote_regexp {<p class="quote">.*?<b>#(.*?)</b>.*?class="qa".*?</a>\((.*?)\)<a.*?<p class="qt">(.*?)</p>}
+
+	if {![info exists random_quotes]} {
+		variable random_quotes []
+	}
+	if {![info exists search_quotes]} {
+		variable search_quotes []
+	}
+}
+
+proc bash::quote_output {chan quote} {
+	set number [dict get $quote number]
+	set rating [dict get $quote rating]
+	set quote [htmlparse::mapEscapes [dict get $quote quote]]
+	set quote [regsub -all -- {<br />} $quote ""]
+
+	$bash::output_cmd "PRIVMSG $chan :#\002${number}\002 (Rating: ${rating})"
+	foreach line [split $quote \n] {
+		if {[incr count] > $bash::max_lines} {
+			$bash::output_cmd "PRIVMSG $chan :Output truncated. ${bash::url}${number}"
+			break
+		} else {
+			foreach subline [bash::split_line $bash::line_length $line] {
+				$bash::output_cmd "PRIVMSG $chan :$subline"
+			}
+		}
+	}
+}
+
+proc bash::handler {nick uhost hand chan argv} {
+	if {![channel get $chan bash]} { return }
+	if {$argv == ""} {
+		if {[catch {bash::random $chan} result]} {
+			$bash::output_cmd "PRIVMSG $chan :Error: $result"
+			return
+		} else {
+			bash::quote_output $chan $result
+		}
+	} else {
+		if {[catch {bash::search $argv $chan} result]} {
+			$bash::output_cmd "PRIVMSG $chan :Error: $result"
+			return
+		} else {
+			bash::quote_output $chan $result
+		}
+	}
+}
+
+proc bash::random {} {
+	if {![llength $bash::random_quotes]} {
+		$bash::output_cmd "PRIVMSG $chan :Fetching new random quotes..."
+		set bash::random_quotes [bash::fetch ${bash::url}random1]
+	}
+	set quote [lindex $bash::random_quotes 0]
+	set bash::random_quotes [lreplace $bash::random_quotes 0 0]
+	return $quote
+}
+
+proc bash::search {query} {
+	if {![dict exists $bash::search_quotes $query]} {
+		$bash::output_cmd "PRIVMSG $chan :Fetching results..."
+		set url ${bash::url}[http::formatQuery search $query sort 0 show 25]
+		dict set bash::search_quotes $query [bash::fetch $url]
+	}
+	set quotes [dict get $bash::search_quotes $query]
+	set quote [lindex $quotes 0]
+	set quotes [lreplace $quotes 0 0]
+
+	# Remove key if no more quotes after removal of one, else set quotes to remaining
+	if {![llength $quotes]} {
+		dict unset bash::search_quotes $query
+	} else {
+		dict set bash::search_quotes $query $quotes
+	}
+
+	return $quote
+}
+
+proc bash::fetch {url} {
+	putlog "Fetching new bash.org quotes: $url"
+
+	http::config -useragent $bash::useragent
+	set token [http::geturl $url -timeout 10000]
+	set data [http::data $token]
+	set ncode [http::ncode $token]
+	http::cleanup $token
+
+	if {$ncode != 200} {
+		error "HTTP fetch error $ncode: $data"
+	}
+
+	return [bash::parse $data]
+}
+
+proc bash::parse {html} {
+	set quotes []
+	foreach raw_quote [regexp -all -inline -- $bash::list_regexp $html] {
+		if {[regexp $bash::quote_regexp $raw_quote -> number rating quote]} {
+			lappend quotes [list number $number rating $rating quote $quote]
+		} else {
+			error "Parse error"
+		}
+	}
+
+	return $quotes
+}
+
+# by fedex
+proc bash::split_line {max str} {
+	set last [expr {[string length $str] -1}]
+	set start 0
+	set end [expr {$max -1}]
+
+	set lines []
+
+	while {$start <= $last} {
+		if {$last >= $end} {
+			set end [string last { } $str $end]
+		}
+
+		lappend lines [string trim [string range $str $start $end]]
+		set start $end
+		set end [expr {$start + $max}]
+	}
+
+	return $lines
+}
+
+putlog "bash.tcl loaded"