All pastes #207001 Raw Edit

Mine

public text v1 · immutable
#207001 ·published 2006-10-17 18:40 UTC
rendered paste body
namespace 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) "&nbsp;"])} {
			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