rendered paste bodynamespace eval ::TVRage {
variable sites
variable tvrage
## Config Settings ###############################
##
## Timeout in milliseconds. (default: 3000)
set tvrage(timeout) 3000
##
## User Trigger channels - wildcard matches accepted (leave blank to disable)
set tvrage(channels) "#channel1 #channel2"
##
## Channel trigger. (Leave blank to disable)
set tvrage(ctrigger) "!tv"
##
## Private message trigger. (Leave blank to disable)
set tvrage(ptrigger) ""
##
## Date format. (URL: http://tcl.tk/man/tcl8.4/TclCmd/clock.htm)
set tvrage(date) "%Y-%m-%d"
##
## Genre splitter.
set tvrage(splitter) " / "
##
## Sites to reply too
## 1) Nickname!Ident@Hostmark - Wildcard matching accepts
## 2) Regexp text to match - first match _must_ be the release dir
lappend sites(#channel1) "nick!*ident@hostmark" "\\\[TV\\\] New Release: (.*?) by .*?/.*?"
lappend sites(#channel2) "nick!ident@*" "\\\[PRE\\\] TV/(.*?) by .*?"
##
##################################################
bind evnt -|- prerehash [namespace current]::DeInit
}
proc ::TVRage::Init {args} {
variable tvrage
if {[catch {package require http}] != 0} {
[namespace current]::Error "\"http\" package not found, unloading script."
[namespace current]::DeInit
return
}
if {([info exists tvrage(ctrigger)]) && (![string equal $tvrage(ctrigger) ""])} {
bind pub -|- $tvrage(ctrigger) [namespace current]::Trigger
}
if {([info exists tvrage(ptrigger)]) && (![string equal $tvrage(ptrigger) ""])} {
bind msg -|- $tvrage(ptrigger) [namespace current]::Trigger
}
bind pubm -|- {* *} [namespace current]::SiteTrigger
putlog "\[TVRage\] :: Loaded successfully."
}
proc ::TVRage::DeInit {args} {
variable tvrage
catch {unbind pub -|- $tvrage(ctrigger) [namespace current]::Trigger}
catch {unbind msg -|- $tvrage(ptrigger) [namespace current]::Trigger}
catch {unbind evnt -|- prerehash [namespace current]::DeInit}
namespace delete [namespace current]
}
proc ::TVRage::Error {error} {
putlog "\[TVRage\] Error :: $error"
}
proc ::TVRage::ConvertDate {string} {
variable tvrage
set tmp [string map { "/" " " } $string]
if {[set i [string last " " $tmp]] != -1} {
set tmp [string replace $tmp $i $i ", "]
}
if {[catch {clock format [clock scan $tmp] -format $tvrage(date)} result] == 0} {
set string $result
}
return $string
}
proc ::TVRage::CheckChan {chan} {
variable tvrage
foreach _chan $tvrage(channels) {
if {[string equal -nocase $_chan $chan]} { return }
}
return -code return
}
proc ::TVRage::SiteTrigger {nick uhost handle chan text} {
variable sites
if {![info exists sites($chan)]} { return }
foreach {_uhost _exp} $sites($chan) {
if {![string match $_uhost "$nick!$uhost"]} { continue }
if {![regexp -nocase -- $_exp $text -> release]} { continue }
if {[catch {[namespace current]::FindInfo [file tail $release] [list] "false"} result] != 0} {
[namespace current]::Error $result
return 0
}
array set info $result
set output [list]
lappend output "\[\002TV-INFO\002\] \002$info(show_name): $info(episode_title)\002 ($info(show_genre)) Aired: $info(episode_original_airdate)"
lappend output "\[\002TV-INFO\002\] URL: $info(episode_url)"
foreach line $output {
putserv "PRIVMSG $chan :$line"
}
}
}
proc ::TVRage::Trigger {args} {
variable tvrage
if {[llength $args] == 5} {
[namespace current]::CheckChan [lindex $args 2] [lindex $args 3]
set trigger $tvrage(ctrigger)
} else {
set trigger $tvrage(ptrigger)
}
set text [lindex $args [expr { [llength $args] - 1 }]]
set target [lindex $args [expr { [llength $args] - 2 }]]
if {[string equal $text ""]} {
putserv "PRIVMSG $target :\[TVRage\] Syntax :: $trigger <string> (eg: $trigger Stargate SG-1 S02E10)"
return 1
}
if {[catch {[namespace current]::FindInfo $text [list] "false"} result] != 0} {
putserv "PRIVMSG $target :\[TVRage\] Error :: $result"
return 0
}
array set info $result
set output [list]
## Display full series/episode info if episode_url exists
if {![string equal $info(episode_url) "n/a"]} {
# FULL
lappend output "\[\002TV-INFO\002\] \002$info(show_name): $info(episode_title)\002 ($info(show_genre)) Aired: $info(episode_original_airdate)"
lappend output "\[\002TV-INFO\002\] URL: $info(episode_url)"
} else {
# SHOW
lappend output "\[\002TV-INFO\002\] \002$info(show_name)\002 $info(show_genre))"
lappend output "\[\002TV-INFO\002\] Last Episode: \002$info(show_latest_episode): $info(show_latest_title)\002 ($info(show_latest_airdate))"
lappend output "\[\002TV-INFO\002\] Next Episode: \002$info(show_next_episode): $info(show_next_title)\002 ($info(show_next_airdate))"
lappend output "\[\002TV-INFO\002\] URL: $info(show_url)"
}
foreach line $output {
putserv "PRIVMSG $target :$line"
}
return 1
}
proc ::TVRage::FindInfo {string logData {strict true}} {
set output_order [list show_name show_genre show_country show_status \
show_latest_title show_latest_episode \
show_latest_airdate show_next_title \
show_next_episode show_next_airdate show_url \
show_classification show_premiered episode_url \
episode_season_episode episode_season \
episode_number episode_original_airdate \
episode_title episode_production_number \
episode_score]
set show_str $string
if {(![regexp -- {^(.*?)(\d+x\d+|[sS]\d+[eE]\d+).*$} $string -> show_str episode_str]) && \
([string is true -strict $strict])} {
error "Unable to parse season and episode info from \"$string\""
}
catch {regexp -- {^(\d+)x(\d+)$} $episode_str -> episode_season episode_number}
catch {regexp -- {^[sS](\d+)[eE](\d+)$} $episode_str -> episode_season episode_number}
regsub -all -- {[\._]} $show_str " " show_str
set show_str [string trim $show_str]
::http::config -useragent "Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.8.0.7) Gecko/20060909 Firefox/1.5.0.7"
array set info [[namespace current]::GetShow $show_str]
if {([info exists episode_season]) && ([info exists episode_number]) && \
([info exists info(show_url)])} {
array set info [[namespace current]::FindEpisode $info(show_url) $episode_season $episode_number]
if {[info exists info(episode_url)]} {
array set info [[namespace current]::GetEpisode $info(episode_url)]
}
}
foreach key $output_order {
if {(![info exists info($key)]) || \
([string equal -nocase $info($key) " "])} {
set info($key) "n/a"
}
#lappend logData $info($key)
}
#return $logData
return [array get info]
}
proc ::TVRage::GetShow {show} {
variable tvrage
set token [::http::geturl "http://www.tvrage.com/quickinfo.php?show=[::http::formatQuery $show]" -timeout $tvrage(timeout)]
if {![string equal -nocase [::http::status $token] "ok"]} {
return -code error "Connection [::http::status $token]"
}
## Its pointless checking the http status, its always 200. Errors are
## redirected on the server to an 'Unknown Page' error page.
set data [::http::data $token]
set matches [regexp -inline -nocase -all -- {(.[^@]+)@(.[^\n\r]+)(?:[\n\r]*)} $data]
if {[string length $matches] == 0} {
return -code error "No results found for \"$show\""
}
foreach {junk key value} $matches {
set key [string map { " " "_" } [string tolower $key]]
switch -glob $key {
latest_episode -
next_episode {
regsub -- {_\w+} $key "" key
regexp -- {(.[^\^]+)\^(.[^\^]+)\^(.*)} $value -> info(show_$key\_episode) info(show_$key\_title) info(show_$key\_airdate)
set info(show_$key\_airdate) [[namespace current]::ConvertDate $info(show_$key\_airdate)]
}
genres {
set info(show_genre) [list]
foreach genre [split $value "|"] {
lappend info(show_genre) [string trim $genre]
}
set info(show_genre) [join $info(show_genre) $tvrage(splitter)]
}
show_* {
set info($key) $value
}
default {
set info(show_$key) $value
}
}
}
if {![info exists info(show_url)]} {
return -code error "Invalid results found for \"$show\""
}
return [array get info]
}
proc ::TVRage::FindEpisode {url season episode} {
variable tvrage
set token [::http::geturl "$url/episode_list/$season" -timeout $tvrage(timeout)]
## Its pointless checking the http status, its always 200. Errors are
## redirected on the server to an 'Unknown Page' error page.
set data [::http::data $token]
regexp -- {<font size=.?4.?>Season (\d+)</font>} $data -> tmp_season
if {[string trimleft $season "0"] != $tmp_season} {
error "Invalid season information. Website returned season $tmp_season, we were expecting $season"
}
set matches [regexp -inline -nocase -all -- {<tr bgcolor='#.*?'>.+?</tr>} $data]
if {[string length $matches] == 0} {
error "No results found for \"$season\x$episode\""
}
foreach junk $matches {
regexp -nocase -- {<td width='40'.[^>]+><a href='(.[^']+)'>\d+x(\d+)</i></a></td>} $junk -> tmp_url tmp_episode
if {$episode == $tmp_episode} {
set info(episode_url) "http://www.tvrage.com$tmp_url"
break
}
catch {unset tmp_url tmp_episode}
}
if {![info exists info(episode_url)]} {
error "Invalid results found for \"$season\x$episode\""
}
return [array get info]
}
proc ::TVRage::GetEpisode {url} {
variable tvrage
set token [::http::geturl $url -timeout $tvrage(timeout)]
## Its pointless checking the http status, its always 200. Errors are
## redirected on the server to an 'Unknown Page' error page.
set data [::http::data $token]
if {[set edata [regexp -inline -nocase -- {<table class='b' width='100%' cellspacing='0'>.+?</table>} $data]] != ""} {
set matches [regexp -inline -nocase -all -- {<b>(.+?): </b></td><td.*?>(.+?)</td>} $edata]
foreach {junk key value} $matches {
set key [string trim [string map { "#" "" } $key]]
set key [string map { " " "_" } [string tolower $key]]
set key [string trimright $key "._"]
switch -glob $key {
original_airdate {
set info(episode_$key) [[namespace current]::ConvertDate $value]
}
writer -
director {
set tmp [regexp -inline -nocase -all -- {<a href='(.+?)' >(.+?)</a><br>} $value]
foreach {tmp_junk tmp_url tmp_name} $tmp {
lappend info(episode_$key) $tmp_name $tmp_url
}
catch {unset tmp tmp_junk tmp_url tmp_name}
}
episode_* {
set info($key) $value
}
score {
## TODO
set info(episode_score) ""
}
default {
set info(episode_$key) $value
}
}
}
}
if {![info exists info]} {
error "Unable to parse episode information"
}
return [array get info]
}
::TVRage::Init