Code: Select all
# IMDb query v1.15 (updated by username@egghelp.org forums)
# Copyright (C) 2007-2009 perpleXa
# http://perplexa.ugug.org / #perpleXa on QuakeNet
#
# Redistribution, with or without modification, are permitted provided
# that redistributions retain the above copyright notice, this condition
# and the following disclaimer.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
#
# Usage:
# !movie <title>
package require http 2.7; # TCL 8.5
namespace eval imdb {
variable version 1.15;
# Headers color
variable color1 \00314
# Information color
variable color2 \00303
# flood protection (seconds)
variable antiflood "10";
# character encoding
variable encoding "utf-8";
# user agent
variable agent "Mozilla/5.0 (X11; U; Linux i686; en-GB; rv:1.8.1) Gecko/2006101023 Firefox/2.0";
# internal
bind pub -|- "!movie" [namespace current]::public;
bind msg -|- "!movie" [namespace current]::private;
variable flood;
namespace export *;
}
proc imdb::public {nick host hand chan argv} {
imdb::main $nick $host $hand $chan $argv
}
proc imdb::private {nick host hand argv} {
imdb::main $nick $host $hand $nick $argv
}
proc imdb::main {nick host hand chan argv} {
variable flood; variable antiflood;
variable color1; variable color2;
if {![info exists flood($chan)]} { set flood($chan) 0; }
if {[unixtime] - $flood($chan) <= $antiflood} { return 0; }
set flood($chan) [unixtime];
set argv [string trim $argv];
if {$argv == ""} {
puthelp "NOTICE $nick :\002${color1}Syntax\002: ${color2}$::lastbind <title>\003";
return 0;
}
set id [id $argv];
if {$id == ""} {
chanmsg $chan "${color1}Movie not found: ${color2}$argv";
return 0;
}
set info [getinfo $id];
if {![llength $info]} {
chanmsg $chan "${color1}Couldn't get information for movie id ${color2}$id${color1}.\003";
return 0;
}
for {set i 0} {$i < [llength $info]} {incr i} {
set info [lreplace $info $i $i [decode [lindex $info $i]]];
}
set name [lindex $info 0]; set year [lindex $info 1];
set desc [lindex $info 2]; set dir [lindex $info 3];
set rel [lindex $info 4]; set storyline [lindex $info 5];
set keywords [lindex $info 6]; set tagline [lindex $info 7];
set genre [lindex $info 8]; set language [lindex $info 9];
set aka [lindex $info 10]; set runtime [lindex $info 11];
set rating [lindex $info 12]; set votes [lindex $info 13];
set top5000 [lindex $info 14]; set stars [lindex $info 15];
if {$name == ""} {
chanmsg $chan "${color1}Couldn't get information for movie id ${color2}$id${color1}.\003";
return 0;
}
if {$rating == "-"} {
set rating_ 0
} else {
set rating_ $rating
}
chanmsg $chan "\002${color2}$name\002${color1}. Also known as: \002$color2$aka\002 ${color1}\($year\) \002Rating:\002 [bar $rating_] $color2$rating${color1}/10\003";
chanmsg $chan "${color2}$desc\003";
chanmsg $chan "\002${color1}Top 5000\002 ${color2}$top5000\003";
chanmsg $chan "\002${color1}Stars\002: ${color2}$stars \002${color1}Director\002: ${color2}$dir ${color1}\002Release date\002: ${color2}$rel\003";
chanmsg $chan "\002${color1}Storyline\002: ${color2}$storyline\003";
chanmsg $chan "\002${color1}Tagline\002: ${color2}$tagline ${color1}\002Plot keywords\002: ${color2}$keywords ${color1}\002Genre\002: ${color2}$genre\003";
chanmsg $chan "\002${color1}Language\002: ${color2}$language ${color1}\002Runtime\002: ${color2}$runtime ${color1}\002Votes\002: ${color2}$votes${color1}, \002Link\002: \00312\037http://imdb.com/title/$id\037\003";
# chanmsg $chan "\002${color1}Language\002: ${color2}$language ${color1}\002Runtime\002: ${color2}$runtime${color1}, \002Link\002: \00312\037http://imdb.com/title/$id\037\003";
}
proc imdb::bar {float} {
set stars [format "%1.0f" $float];
return "\00312\[\00307[string repeat "*" $stars]\00314[string repeat "-" [expr 10-$stars]]\00312\]\003";
}
proc imdb::chanmsg {chan text} {
if {[validchan $chan]} {
if {[string first "c" [lindex [split [getchanmode $chan]] 0]] >= 0} {
regsub -all {(?:\002|\003([0-9]{1,2}(,[0-9]{1,2})?)?|\017|\026|\037)} $text "" text;
}
}
putquick "PRIVMSG $chan :$text";
}
proc imdb::id {movie} {
variable agent;
http::config -useragent $agent;
if {[catch {http::geturl "http://www.imdb.com/find?q=[urlencode $movie];s=tt;site=aka" -timeout 20000} token]} {
return;
}
set data [http::data $token];
set code [http::ncode $token];
set meta [http::meta $token];
http::cleanup $token;
if {$code == 200} {
set id "";
regexp -nocase -- {<a href="/title/(tt[0-9]+)/"} $data -> id;
return $id;
} else {
foreach {var val} $meta {
if {![string compare -nocase "Location" $var]} {
regexp -nocase {tt\d+} $val val;
return $val;
}
}
}
}
proc imdb::getinfo {id} {
variable agent;
http::config -useragent $agent;
if {[catch {http::geturl "http://www.imdb.com/title/$id/" -timeout 20000} token]} {
return;
}
set data [http::data $token];
regsub -all -- {\r|\n} $data "" data;
http::cleanup $token;
set name ""; set year ""; set desc ""; set dir ""; set rel ""; set genre ""; set tagline ""; set plot "";
set rating 0; set votes ""; set runtime ""; set language ""; set storyline ""; set keywords ""; set aka "";
set top5000 ""; set stars "";
### Main.
regexp -nocase -- {<a href="/year/.*?/">(.*?)</a>.*?<span class="title-extra">\n(.*?)<i>} $data -> year name;
if {$name == ""} {
regexp -nocase -- {<h1 class="header".*?>(.*?)<span>} $data -> name;
}
if {$year == ""} {
regexp -nocase -- {<a href="/year/.*?/">(.*?)</a>} $data -> year;
}
regexp -nocase -- {<p itemprop="description">(.*?)</p>} $data -> desc;
regexp -nocase -- {itemprop="director">(.*?)</a>} $data -> dir;
regsub -all "<.*?>" $dir "" dir
regexp -- {Release Date:.*?</h4>(.*?)<span class="see-more inline">} $data -> rel;
regsub -all "<.*?>" $rel "" rel
### Stars.
regexp -nocase -- {Stars:</h4>(.*?)</div>} $data -> stars_;
foreach {null star} [regexp -all -nocase -inline -- {<a onclick.*?>(.*?)</a>} $stars_] {
lappend stars [string trim $star]
}
### Storyline.
regexp -nocase -- {<h2>Storyline</h2>(.*?)<em class="nobr">} $data -> storyline;
regsub -all "<p>" $storyline "" storyline;
foreach {null plkw} [regexp -all -nocase -inline -- {<a href="/keyword/.*?">(.*?)</a>} $data] {
lappend keywords [string trim $plkw]
}
if {$storyline == ""} {
regexp -nocase -- {h2>Storyline</h2>(.*?)</p>} $data -> storyline;
regsub -all "<p>" $storyline "" storyline
regsub -all "<.*?>" $storyline "" storyline
}
regexp -nocase -- {<h4 class="inline">Taglines:</h4>(.*?)<span class="see-more inline">} $data -> tagline;
regsub -all {<.*?>} $tagline { } tagline
regsub -all {\s+} $tagline { } tagline
foreach {null gen} [regexp -all -nocase -inline -- {<a href="/genre/.*?">(.*?)</a>} $data] {
lappend genre [string trim $gen]
}
### Details.
foreach {null lang} [regexp -all -nocase -inline -- {<a href="/language/.*?">(.*?)</a>} $data] {
lappend language [string trim $lang];
}
regexp -nocase -- {<h4 class="inline">Also Known As:</h4> (.*?)<} $data -> aka;
### Technical Specs.
regexp -- {Runtime:</h4>(.*?)</div>} $data -> runtime;
regsub -all "<.*?>" $runtime "" runtime
regexp -nocase -- {<span itemprop="ratingValue">(.*?)</span>} $data -> rating;
regexp -nocase -- {<span itemprop="ratingCount">(.*?)</span>} $data -> votes;
regsub -all "<.*?>" $votes "" votes
### Top 5000
regexp -nocase -- {<div id="meterChangeRow" class="meterToggleOnHover">(.*?)</div>} $data -> top5000;
regsub -all "<.*?>" $top5000 "" top5000
regsub -all "\n" $top5000 "" top5000
regsub -all {\s+} $top5000 " " top5000
return [list [string trim $name] $year [string trim $desc] [string trim $dir] [string trim $rel] [string trim $storyline] [join $keywords "/"] [string trim $tagline] [join $genre "/"] [join $language "/"] [string trim $aka] [string trim $runtime] $rating $votes [string trim $top5000] [join $stars "/"] ];
}
proc imdb::urlencode {i} {
variable encoding
set index 0;
set i [encoding convertto $encoding $i]
set length [string length $i]
set n ""
while {$index < $length} {
set activechar [string index $i $index]
incr index 1
if {![regexp {^[a-zA-Z0-9]$} $activechar]} {
append n %[format "%02X" [scan $activechar %c]]
} else {
append n $activechar
}
}
return $n
}
proc imdb::decode {content} {
if {$content == ""} {
return "n/a";
}
if {![string match *&* $content]} {
return $content;
}
set escapes {
\x20 " \x22 & \x26 ' \x27 – \x2D
< \x3C > \x3E ˜ \x7E € \x80 ¡ \xA1
¢ \xA2 £ \xA3 ¤ \xA4 ¥ \xA5 ¦ \xA6
§ \xA7 ¨ \xA8 © \xA9 ª \xAA « \xAB
¬ \xAC \xAD ® \xAE &hibar; \xAF ° \xB0
± \xB1 ² \xB2 ³ \xB3 ´ \xB4 µ \xB5
¶ \xB6 · \xB7 ¸ \xB8 ¹ \xB9 º \xBA
» \xBB ¼ \xBC ½ \xBD ¾ \xBE ¿ \xBF
À \xC0 Á \xC1 Â \xC2 Ã \xC3 Ä \xC4
Å \xC5 Æ \xC6 Ç \xC7 È \xC8 É \xC9
Ê \xCA Ë \xCB Ì \xCC Í \xCD Î \xCE
Ï \xCF Ð \xD0 Ñ \xD1 Ò \xD2 Ó \xD3
Ô \xD4 Õ \xD5 Ö \xD6 × \xD7 Ø \xD8
Ù \xD9 Ú \xDA Û \xDB Ü \xDC Ý \xDD
Þ \xDE ß \xDF à \xE0 á \xE1 â \xE2
ã \xE3 ä \xE4 å \xE5 æ \xE6 ç \xE7
è \xE8 é \xE9 ê \xEA ë \xEB ì \xEC
í \xED î \xEE ï \xEF ð \xF0 ñ \xF1
ò \xF2 ó \xF3 ô \xF4 õ \xF5 ö \xF6
÷ \xF7 ø \xF8 ù \xF9 ú \xFA û \xFB
ü \xFC ý \xFD þ \xFE ÿ \xFF
};
set content [string map $escapes $content];
set content [string map [list "\]" "\\\]" "\[" "\\\[" "\$" "\\\$" "\\" "\\\\"] $content];
regsub -all -- {&#([[:digit:]]{1,5});} $content {[format %c [string trimleft "\1" "0"]]} content;
regsub -all -- {&#x([[:xdigit:]]{1,4});} $content {[format %c [scan "\1" %x]]} content;
regsub -all -- {&#?[[:alnum:]]{2,7};} $content "?" content;
return [subst $content];
}
putlog "*IMDb v$imdb::version* Loaded"
