#
# edited Jun 27 2017 for https by genewitch
# ramok on freenode/#tcl knew the fix
#
# Mar 30 2010
# by horgh
#
# Requires Tcl 8.5+ and tcllib
#
# Wikipedia.org fetcher
#
# To enable you must .chanset #channel +wiki
#
# Tests: Whole number (list of possible interpretations)
#
package require http
package require htmlparse
package require tls
::http::register https 443 ::tls::socket
namespace eval wiki {
variable max_lines 1
variable max_chars 400
variable output_cmd "putserv"
variable url "https://en.wikipedia.org/wiki/"
#bind pub -|- "!w" wiki::search
bind pub -|- "!wiki" wiki::search
# variable parse_regexp {(
)??.*?(.*?)
\n)?.*?(.*)(()|(
)).*?(()|(.*?((may refer to:)|(in one of the following senses:))} $data]} {
# regexp -- {.*?- .*? title="(.*?)">.*?
} $data -> new_query
# return [wiki::fetch $new_query]
#}
if {![regexp -- $wiki::parse_regexp $data -> out]} {
error "Parse error"
}
return [list url $fetched_url result [wiki::sanitise $out]]
}
proc wiki::sanitise {raw} {
set raw [::htmlparse::mapEscapes $raw]
# Remove some help links
set raw [regsub -- {.*?} $raw ""]
set raw [regsub -all -- {<(.*?)>} $raw ""]
set raw [regsub -all -- {\[.*?\]} $raw ""]
set raw [regsub -all -- {\n} $raw " "]
return $raw
}
proc wiki::search {nick uhost hand chan argv} {
if {![channel get $chan wiki]} { return }
if {[string length $argv] == 0} {
$wiki::output_cmd "PRIVMSG $chan :Please provide a term."
return
}
set argv [string trim $argv]
# Upper case first character
set argv [string toupper [string index $argv 0]][string range $argv 1 end]
if {[catch {wiki::fetch $argv} data]} {
$wiki::output_cmd "PRIVMSG $chan :Error: $data"
return
}
foreach line [wiki::split_line $wiki::max_chars [dict get $data result]] {
if {[incr count] > $wiki::max_lines} {
$wiki::output_cmd "PRIVMSG $chan :Output truncated. [dict get $data url]"
break
}
$wiki::output_cmd "PRIVMSG $chan :$line"
}
}
# by fedex
proc wiki::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 "wiki.tcl loaded"