bash.tcl 4.0 KB

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