# IMDb query v1.17 (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.17;

  # 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 country   [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];
  set alsoliked [lindex $info 16]; set budget [lindex $info 17];

  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}Plot keywords\002: ${color2}$keywords ${color1}\002Genre\002: ${color2}$genre\003";
  chanmsg $chan "\002${color1}Language\002: ${color2}$language ${color1}\002Country\002: ${color2}$country ${color1}\002Runtime\002: ${color2}$runtime ${color1}\002Budget\002: ${color2}$budget ${color1}\002Link\002: \00312\037http://imdb.com/title/$id\037\003";
  chanmsg $chan "\002${color1}People who liked this also liked\002: ${color2}$alsoliked\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=all" -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]+)/\?ref_=fn_al_tt_[0-9]" ><img src="http://ia.media-imdb.com/images/M.*?} $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; 
  variable color1;
  variable color2;
  http::config -useragent $agent;
  if {[catch {http::geturl "http://www.imdb.com/title/$id/" -timeout 20000} token]} {
    return;
  }
  set data [http::data $token];
  set data [encoding convertfrom utf-8 $data]
  regsub -all -- {\r|\n} $data "" data;
  http::cleanup $token;

  set name ""; set year ""; set desc ""; set dir ""; set rel ""; set genre ""; set country ""; set plot "";
  set rating 0; set votes ""; set runtime ""; set language ""; set storyline ""; set keywords ""; set aka "";
  set top5000 ""; set stars ""; set alsoliked ""; set budget "";

  ### Main.
  regexp -nocase -- {<a href="/year/.*?" >(.*?)</a>.*?<span class="title-extra" itemprop="name">(.*?)<i>} $data -> year name;

  if {$name == ""} {
      regexp -nocase -- {<h1 class="header"> <span class="itemprop" itemprop="name">(.*?)</span} $data -> name;
  }
  if {$year == ""} {
      regexp -nocase -- {<a href="/year/.*?" >(.*?)</a>} $data -> year;
  }

  regexp -nocase -- {<p itemprop="description">(.*?)</p>} $data -> desc;
  regexp -nocase -- {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 -- {<span class="itemprop" itemprop="name">(.*?)</span>} $stars_] {
    lappend stars [string trim $star]
  }

  ### Storyline.
  if {$storyline == ""} {
      regexp -nocase -- {h2>Storyline</h2>(.*?)<em class="nobr">} $data -> storyline;
      regsub -all "<p>" $storyline "" storyline
      regsub -all "<.*?>" $storyline "" storyline
  }

  ### Keywords.
  foreach {null plkw} [regexp -all -nocase -inline -- {<span class="itemprop" itemprop="keywords">(.*?)</span>} $data] {
    lappend keywords [string trim $plkw]
  }
  
  ### Genre.
  foreach {null gen} [regexp -all -nocase -inline -- {<a href="/genre/.*?\?ref_=tt_stry_gnr" >(.*?)</a>} $data] {
    lappend genre [string trim $gen]
  }

  ### Language.
  foreach {null lang} [regexp -all -nocase -inline -- {<a href="/language/.*?>(.*?)</a>} $data] {
    lappend language [string trim $lang];
  }
  
  ### Country.
  foreach {null coun} [regexp -all -nocase -inline -- {<a href="/country/.*?>(.*?)</a>} $data] {
    lappend country [string trim $coun];
  }

  ### AKA.
  regexp -nocase -- {<h4 class="inline">Also Known As:</h4>(.*?)<} $data -> aka;
  regsub -all "<.*?>" $aka "" aka

  ### Technical Specs.
  regexp -- {Runtime:</h4>(.*?)</div>} $data -> runtime;
  regsub -all "<.*?>" $runtime "" runtime
  regsub -all {\s+} $runtime " " runtime
  regexp -nocase -- {<span itemprop="ratingValue">(.*?)</span>} $data -> rating;
  regexp -nocase -- {href="ratings".*?>(.*?) votes</a>\)} $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

  ### Also.
  regexp -nocase -- {People who liked this also liked(.*?)<div class="rec_nav">} $data -> also_;
  if {[info exists also_] && $also_ != ""} {
      foreach {null alsol} [regexp -all -nocase -inline -- {<img height="113" width="76" alt="(.*?)"} $also_] {
            lappend alsoliked [string trim $alsol]
      }
  }
  
  ### Budget.
  regexp -nocase -- {<h4 class="inline">Budget:</h4>(.*?)<span} $data -> budget;
  regsub -all "<.*?>" $budget "" budget
  regsub -all "\n" $budget "" budget
  regsub -all {\s+} $budget " " budget

  return [list [string trim $name] $year [string trim $desc] [string trim $dir] [string trim $rel] [string range [string trim $storyline] 0 200] [join $keywords "$color1/$color2"] [join $country "$color1/$color2"] [join $genre "$color1/$color2"] [join $language "$color1/$color2"] [string trim $aka] [string trim $runtime] $rating $votes [string trim $top5000] [join $stars "$color1/$color2"] [join [lrange $alsoliked 0 5] "$color1/$color2"] [string trim $budget]];
}

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 {
    &nbsp; \x20 &quot; \x22 &amp; \x26 &apos; \x27 &ndash; \x2D
    &lt; \x3C &gt; \x3E &tilde; \x7E &euro; \x80 &iexcl; \xA1
    &cent; \xA2 &pound; \xA3 &curren; \xA4 &yen; \xA5 &brvbar; \xA6
    &sect; \xA7 &uml; \xA8 &copy; \xA9 &ordf; \xAA &laquo; \xAB
    &not; \xAC &shy; \xAD &reg; \xAE &hibar; \xAF &deg; \xB0
    &plusmn; \xB1 &sup2; \xB2 &sup3; \xB3 &acute; \xB4 &micro; \xB5
    &para; \xB6 &middot; \xB7 &cedil; \xB8 &sup1; \xB9 &ordm; \xBA
    &raquo; \xBB &frac14; \xBC &frac12; \xBD &frac34; \xBE &iquest; \xBF
    &Agrave; \xC0 &Aacute; \xC1 &Acirc; \xC2 &Atilde; \xC3 &Auml; \xC4
    &Aring; \xC5 &AElig; \xC6 &Ccedil; \xC7 &Egrave; \xC8 &Eacute; \xC9
    &Ecirc; \xCA &Euml; \xCB &Igrave; \xCC &Iacute; \xCD &Icirc; \xCE
    &Iuml; \xCF &ETH; \xD0 &Ntilde; \xD1 &Ograve; \xD2 &Oacute; \xD3
    &Ocirc; \xD4 &Otilde; \xD5 &Ouml; \xD6 &times; \xD7 &Oslash; \xD8
    &Ugrave; \xD9 &Uacute; \xDA &Ucirc; \xDB &Uuml; \xDC &Yacute; \xDD
    &THORN; \xDE &szlig; \xDF &agrave; \xE0 &aacute; \xE1 &acirc; \xE2
    &atilde; \xE3 &auml; \xE4 &aring; \xE5 &aelig; \xE6 &ccedil; \xE7
    &egrave; \xE8 &eacute; \xE9 &ecirc; \xEA &euml; \xEB &igrave; \xEC
    &iacute; \xED &icirc; \xEE &iuml; \xEF &eth; \xF0 &ntilde; \xF1
    &ograve; \xF2 &oacute; \xF3 &ocirc; \xF4 &otilde; \xF5 &ouml; \xF6
    &divide; \xF7 &oslash; \xF8 &ugrave; \xF9 &uacute; \xFA &ucirc; \xFB
    &uuml; \xFC &yacute; \xFD &thorn; \xFE &yuml; \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"