Permalink
Browse files

initial import of bash.tcl

  • Loading branch information...
1 parent 9716b6b commit d5ee9ef72736e8e887b2d54863f00499b8e55049 @horgh committed Jun 27, 2010
Showing with 162 additions and 0 deletions.
  1. +162 −0 bash.tcl
  2. 0 isgd.tcl
View
162 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"
View
0 isgd.tcl 100755 → 100644
No changes.

0 comments on commit d5ee9ef

Please sign in to comment.