/imdb.tcl

http://github.com/horgh/eggdrop-scripts · TCL · 741 lines · 484 code · 35 blank · 222 comment · 214 complexity · c29967ee3e2291d56619abed8f275065 MD5 · raw file

  1. ###############################################################################
  2. ## This iMDB.tcl requires Eggdrop1.6.0 or higher ##
  3. ## (c) 2003 by B0unTy ##
  4. ## ##
  5. ## changed by OV2 ##
  6. ## 05.01.2010 ##
  7. ## *fixed remaining bugs with imdb changes ##
  8. ## ##
  9. ## 02.01.2010 ##
  10. ## *modified for imdb page changes ##
  11. ## ##
  12. ## 16.09.2008 ##
  13. ## *modified for new imdb page ##
  14. ## ##
  15. ## 25.05.2008 ##
  16. ## *plot works again ##
  17. ## ##
  18. ## 19.05.2008 ##
  19. ## *fixed the non-working cookies (cert, soundmix ...) ##
  20. ## * "|" characters in cookies are displayed again ##
  21. ## ##
  22. ## 21.09.2007 ##
  23. ## *multiline color/underline/bold were broken ##
  24. ## +added single-line cast (%castline) ##
  25. ## +added the remaining information from imdb (color, cert, etc...) ##
  26. ## ##
  27. ## 17.07.2007 ##
  28. ## *fix for the exact title matching ##
  29. ## *exact name matches are no longer confused with exact title matches ##
  30. ## ##
  31. ## 27.06.2007 ##
  32. ## *works with new imdb search page ##
  33. ## *%uline works again ##
  34. ## ##
  35. ## 09.04.2007: ##
  36. ## *fixed director/s writer/s ##
  37. ## +added support for plot keywords ##
  38. ## +added support for user comment line ##
  39. ## ##
  40. ## 28.02.2007: ##
  41. ## *ratings work again ##
  42. ## *director and writing credits work again ##
  43. ## ##
  44. ## 25.02.2007: ##
  45. ## *fixed some bugs of the previous changes (thanks to rosc2112) ##
  46. ## ##
  47. ## 24.02.2007: ##
  48. ## *bold/underline/color in front of the multiline cast will now be ##
  49. ## applied to each of the cast lines ##
  50. ## *the | character is now used to declare sections in the announce line ##
  51. ## if any variable in a section is not found on the imdb page, the ##
  52. ## corresponding section will not be displayed in the output ##
  53. ## (see the default announce line for an example) ##
  54. ## ##
  55. ## 22.02.2007: ##
  56. ## *incorporated some code from rosc2112's version ##
  57. ## *some small fixes ##
  58. ## ##
  59. ## 20.02.2007: ##
  60. ## *changed regexp queries to accomodate the new imdb layout ##
  61. ## *cleaned up the unneccesary post-regexp code ##
  62. ## ##
  63. ## 14.05.2006: ##
  64. ## *fixed plot outline not showing completely if it included links ##
  65. ## (thanks to darkwing for finding the bug) ##
  66. ## +added support for awards (thanks to rosc2112) ##
  67. ## +added support for the cast list (be careful with the limit) ##
  68. ## +added support for writing credits ##
  69. ## ##
  70. ## 21.01.2006: ##
  71. ## *fixed problem with irregular search-result pages from imdb ##
  72. ## ##
  73. ## 31.08.2005: ##
  74. ## *changed search result priority again: ##
  75. ## 1. popular match where the title=search string ##
  76. ## 2. exact matches ##
  77. ## 3. first title on page ##
  78. ## *fixed missig warn_msg var ##
  79. ## ##
  80. ## until 24.06.2005: ##
  81. ## *works with new IMDB ##
  82. ## *works with (hopefully) all search results (popular/exact/partial) ##
  83. ## +added timeouts (20secs) ##
  84. ## +added bottom 100 support ##
  85. ## +added rating bar from chilla's imdb-script ##
  86. ## +added flood control ##
  87. ## *small speedup (if your output does not include %screens or %budget ##
  88. ## *changed proc name to improve compatibility with other scripts ##
  89. ## *changed search result priority to {exact->first displayed} ##
  90. ## ##
  91. ###############################################################################
  92. ## ##
  93. ## INSTALL: ##
  94. ## ======== ##
  95. ## 1- Copy iMDB.tcl in your dir scripts/ ##
  96. ## 2- Add iMDB.tcl in your eggdrop.conf: ##
  97. ## source scripts/imdb.tcl ##
  98. ## ##
  99. ## For each channel you want users to use !imdb cmd ##
  100. ## Just type in partyline: .chanset #channel +imdb ##
  101. ## ##
  102. ###############################################################################
  103. # COOKIES ARE :
  104. # =============
  105. # TITLE = %title | BOLD = %bold
  106. # URL = %url | UNDERLINE = %uline
  107. # DIRECTOR = %name | COLORS = %color#,#
  108. # GENRE = %genre | NEW LINE = \n
  109. # PLOT OUTLINE = %plot |-----------------------------
  110. # RATING = %rating | !! to reset color code !!
  111. # RATING_BAR = %rbar | !! use %color w/o args !!
  112. # VOTES = %votes |
  113. # RUNTIME = %time (numbers only) | "|" declares a section
  114. # AWARDS = %awards | if any cookie in a section
  115. # BUDGET = %budget | is empty the whole section
  116. # SCREENS = %screens | is removed from the output
  117. # TAGLINE = %tagline | (end section with "|")
  118. # MPAA = %mpaa |
  119. # COUNTRY = %country |
  120. # LANGUAGE = %language |
  121. # SOUND MIX = %soundmix |
  122. # TOP 250 = %top250 |
  123. # CAST LINES = %castmline |
  124. # CAST SNGLELINE = %castline |
  125. # WRITING CREDITS = %wcredits |
  126. # PLOT KEYWORDS = %keywords |
  127. # COMMENT LINE = %comment |
  128. # RELEASE DATE = %reldate |
  129. # MOVIE COLOR = %mcolor |
  130. # ASPECT RATIO = %aspect |
  131. # CERTIFICATION = %cert |
  132. # LOCATIONS = %locations |
  133. # COMPANY = %company |
  134. #
  135. # RANDOMIZING OUTPUT :
  136. # ====================
  137. # Exemple:
  138. # set random(IMDBIRC-0) "IMDB info for %bold%title%bold Directed by %name"
  139. # set random(IMDBIRC-1) "IMDB info for %title Directed by %bold%name%bold"
  140. # set random(IMDBIRC-2) "IMDB info for %title Directed by %name"
  141. # TYPE --------^ ^
  142. # ID --------^
  143. #
  144. # set announce(IMDBIRC) "random 3"
  145. # TYPE ---------^ ^ ^
  146. # RANDOM ----------^ ^
  147. # # OF IDS ---------^
  148. #
  149. # exemple random announces:
  150. # set announce(IMDBIRC) "random 3"
  151. # set random(IMDBIRC-0) "IMDB info for %bold%title%bold Directed by %name -> rated %uline%rating%uline (%votes votes) - genre: %genre - runtime: %time mins >> URL: %uline%url%uline >> Budget: %budget >> Screens: (USA) %screens"
  152. # set random(IMDBIRC-1) "TITLE: %bold%title%bold - DIRECTOR: %name - RATE: %rating by %votes users - GENRE: %genre - RUNTIME: %time mins - URL: %url - BUDGET: %budget - SCREENS: (USA) %screens"
  153. # set random(IMDBIRC-2) "%bold%title%bold - %url\n%boldDirected by:%bold %name\n%boldGenre:%bold %genre\n%boldTagline:%bold %tagline\n%boldSynopsis:%bold %plot\n%boldRating:%bold %rating (%votes votes) top 250:%bold%top250%bold\n%boldMPAA:%bold %mpaa\n%boldRuntime:%bold %time mins.
  154. # example normal announce:
  155. #
  156. set announce(IMDBIRC) "%bold%title%bold - %url\n|Genre: %genre|\n|Synopsis: %plot|\n|Rating: %rating (%votes votes) %rbar| |%color3%top250%color|\n|Awards: %awards|"
  157. #set announce(IMDBIRC) "%bold%title%bold |\[%time mins - %mcolor\]| - %url\n|Genre: %genre|\n|Tagline: %tagline|\n|Synopsis: %plot|\n|Rating: %rating (%votes votes) %rbar| |%color3%top250%color|\n|Awards: %awards|"
  158. #set announce(IMDBIRC) "%bold%title%bold - %url\n|%boldGenre:%bold %genre|\n|Plot Keywords: %keywords|\n|Tagline: %tagline|\n|Synopsis: %plot|\n|Rating: %rating (%votes votes) %rbar| |%color3%top250%color|\n|Comment: %comment|\n|Awards: %awards|\n|Runtime: %time mins.|"
  159. #set announce(IMDBIRC) "%bold%title%bold - %url\n|%boldGenre:%bold %genre|\n|Director: %name|\n|Writers: %wcredits|\n|Cast: %castline|\n|Country: %country|\n|Language: %language|\n|Color: %mcolor|\n|Plot Keywords: %keywords|\n|Tagline: %tagline|\n|Synopsis: %plot|\n|Rating: %rating (%votes votes) %rbar| |%color3%top250%color|\n|Locations: %locations|\n|Comment: %comment|\n|Awards: %awards|\n|Runtime: %time mins.|\n|Cert: %cert|\n|Budget: %budget|\n|Screens: %screens|"
  160. #trigger command in channel
  161. set trigger "!imdb"
  162. #rating bar color
  163. #bracket
  164. set barcol1 "14"
  165. #stars
  166. set barcol2 "7"
  167. #cast count to return on multiline and single line (0 means no limit)
  168. set cast_linelimit "5"
  169. #http connection timeout (milliseconds)
  170. set imdb_timeout "25000"
  171. #flood-control
  172. set queue_enabled 1
  173. #max requests
  174. set queue_size 5
  175. #per ? seconds
  176. set queue_time 120
  177. # for a channel !imdb request
  178. # set to 1 = all results will be sent publicly to the channel
  179. # set to 0 = all results will be sent as private notice
  180. set pub_or_not 1
  181. # use or not the imdb debugger (1=enable debug 0=disable debug)
  182. set IMDB_DEBUG 0
  183. # set IMDB_ALTERNATIVE 0 = use the internal tcl http 2.3 package
  184. # set IMDB_ALTERNATIVE 1 = use the external curl 6.0+
  185. set IMDB_ALTERNATIVE 0
  186. # set here the location path where find curl 6.0+
  187. set binary(CURL) "/path/to/curl"
  188. # note for windrop: use normal slashes, e.g. C:/path/to/curl.exe
  189. #################################################################
  190. # DO NOT MODIFY BELOW HERE UNLESS YOU KNOW WHAT YOU ARE DOING! #
  191. #################################################################
  192. if { $IMDB_ALTERNATIVE == 0 } { package require http 2.3 }
  193. package require htmlparse
  194. setudef flag imdb
  195. bind pub -|- $trigger imdb_proc
  196. set instance 0
  197. set warn_msg 0
  198. proc channel_check_imdb { chan } {
  199. foreach setting [channel info $chan] {
  200. if {[regexp -- {^[\+-]} $setting]} {
  201. if {![string compare "+imdb" $setting]} {
  202. set permission 1
  203. break
  204. } else {
  205. set permission 0
  206. }
  207. }
  208. }
  209. return $permission
  210. }
  211. proc replacevar {strin what withwhat} {
  212. set output $strin
  213. set replacement $withwhat
  214. set cutpos 0
  215. while { [string first $what $output] != -1 } {
  216. set cutstart [expr [string first $what $output] - 1]
  217. set cutstop [expr $cutstart + [string length $what] + 1]
  218. set output [string range $output 0 $cutstart]$replacement[string range $output $cutstop end]
  219. }
  220. return $output
  221. }
  222. proc findnth {strin what count} {
  223. set ret 0
  224. for {set x 0} {$x < $count} {incr x} {
  225. set ret [string first $what $strin [expr $ret + 1]]
  226. }
  227. return $ret
  228. }
  229. proc imdb_proc { nick uhost handle chan arg } {
  230. global cast_linelimit instance queue_size queue_time queue_enabled imdb_timeout barcol1 barcol2 IMDB_DEBUG pub_or_not announce random warn_msg trigger binary IMDB_ALTERNATIVE
  231. # channel_check permission
  232. set permission_result [channel_check_imdb $chan]
  233. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG permission_result == $permission_result" }
  234. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG instance == $instance" }
  235. if { $permission_result == 0} { return }
  236. # public or private
  237. if {$pub_or_not == 1 } { set toput "PRIVMSG $chan" } else { set toput "NOTICE $nick" }
  238. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG toput_result == $toput" }
  239. # if no arg passed, show help
  240. if {$arg == ""} {
  241. if { $IMDB_ALTERNATIVE == 0 } { set using "Http 2.3+" } else { set using "Curl 6.0+" }
  242. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG no arg passed, show help" }
  243. putserv "$toput :IMDb info script \002v05.01.2010\002 using \002$using\002"
  244. putserv "$toput :\002Syntax: $trigger <movie title>\002 example: $trigger Beautiful Mind"
  245. return
  246. }
  247. #flood-control
  248. if { $queue_enabled == 1 } {
  249. #flooded?
  250. if { $instance >= $queue_size } {
  251. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG flood detected" }
  252. if { $warn_msg == 0 } {
  253. set warn_msg 1
  254. putquick "$toput :Flood-Control: Request for \"$arg\" from user \"$nick\" will not be answered."
  255. putquick "$toput :Flood-Control: Maximum of $queue_size requests every $queue_time seconds."
  256. utimer 120 wmsg
  257. }
  258. return
  259. }
  260. incr instance
  261. if { $IMDB_DEBUG == 1 } { putlog "IMDB_DEBUG new instance == $instance" }
  262. utimer [set queue_time] decr_inst
  263. }
  264. # initial search
  265. set imdburl "http://www.imdb.com"
  266. set imdbsearchurl "http://akas.imdb.com/find?tt=on;nm=on;mx=5;"
  267. set searchString [string map {\ %20 & %26 , %2C} $arg]
  268. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG searchString: \"$searchString\"" }
  269. if { $IMDB_ALTERNATIVE == 0 } {
  270. set page [::http::config -useragent "MSIE 6.0"]
  271. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG ${imdbsearchurl}q=$searchString" }
  272. if [catch {set page [::http::geturl ${imdbsearchurl}q=$searchString -timeout $imdb_timeout]} error] {
  273. putserv "$toput :Error retrieving URL... try again later."
  274. ::http::Finish $page
  275. return
  276. }
  277. if { [::http::status $page] == "timeout" } {
  278. putserv "$toput :\002Connection to imdb.com timed out while doing initial search.\002"
  279. ::http::Finish $page
  280. return
  281. }
  282. set html [::http::data $page]
  283. ::http::Finish $page
  284. } else {
  285. catch { exec $binary(CURL) "${imdbsearchurl}q=$searchString" } html
  286. }
  287. #if redirect necessary (search page), find first link and redirect
  288. if { ([regexp {<title>IMDb.*Search} $html] == 1) } {
  289. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG redirect 1" }
  290. set ttcode "0000001"
  291. set start "0"
  292. set temp $html
  293. #dealing with different search results
  294. set hit 0
  295. if { [regexp -indices {Popular Titles} $temp tstart] } {
  296. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG found popular titles" }
  297. set temp2 [string range $temp [lindex $tstart 1] end]
  298. regexp {1\..*?<a.*?>(.*?)</a>} $temp2 dummy title
  299. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG compare $title == $arg" }
  300. if { [string equal -nocase $title $arg] } {
  301. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG equals - displaying first popular match" }
  302. set temp $temp2
  303. set hit 1
  304. } else {
  305. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG not equal - searching for exact match" }
  306. }
  307. }
  308. if { $hit == 0 } {
  309. if { [regexp -indices {Titles \(Exact Matches\)} $temp start] } {
  310. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG displaying exact match" }
  311. } elseif { [regexp -indices {Titles} $temp start] } {
  312. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG no exact match - displaying first title on page" }
  313. } else {
  314. putserv "$toput :No useful results."
  315. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG no titles results found" }
  316. return
  317. }
  318. set temp [string range $temp [lindex $start 1] end]
  319. }
  320. #searching for first ttcode
  321. if [regexp {/title/tt[0-9]+} $temp ttcode] {
  322. set pos [string last / $ttcode] ; incr pos
  323. set ttcode [string range $ttcode $pos end]
  324. }
  325. # for bogus ttcode
  326. if { $ttcode == "0000001" } {
  327. putserv "$toput :No no no! I can't find that!"
  328. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG bogus ttcode" }
  329. return
  330. }
  331. set newurl "$imdburl/title/$ttcode/"
  332. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG redirect 1 = $newurl" }
  333. # get the page redirected to
  334. unset html
  335. if { $IMDB_ALTERNATIVE == 0 } {
  336. set page [::http::config -useragent "MSIE 6.0"]
  337. set page [::http::geturl $newurl -timeout $imdb_timeout]
  338. if [catch {set page [::http::geturl $newurl -timeout $imdb_timeout]} error] {
  339. putserv "$toput :Error retrieving URL... try again later."
  340. ::http::Finish $page
  341. return
  342. }
  343. if {[::http::status $page]=="timeout"} {
  344. putserv "$toput :\002Connection to imdb.com timed out.\002"
  345. ::http::Finish $page
  346. return
  347. }
  348. set html [::http::data $page]
  349. ::http::Finish $page
  350. } else {
  351. catch { exec $binary(CURL) "$newurl" } html
  352. }
  353. # if no redirect necessary (only one match in meta), then go there
  354. } else {
  355. set location ""
  356. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG redirect 0" }
  357. if { $IMDB_ALTERNATIVE == 0 } {
  358. upvar 0 $page oldpage
  359. regexp {title/tt[0-9]+/} $oldpage(meta) location
  360. } else {
  361. set result [catch { exec $binary(CURL) -i "${imdbsearchurl}q=$searchString" } oldpage]
  362. putlog $oldpage
  363. regexp {title/tt[0-9]+/} $oldpage location
  364. }
  365. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG redirect 0 Location == $location" }
  366. set newurl "$imdburl/$location"
  367. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG redirect 0 = $newurl" }
  368. if { $location != "" } {
  369. if { $IMDB_ALTERNATIVE == 0 } {
  370. unset html
  371. set page [::http::config -useragent "MSIE 6.0"]
  372. if [catch {set page [::http::geturl $newurl -timeout $imdb_timeout]} error] {
  373. putserv "$toput :Error retrieving URL... try again later."
  374. ::http::Finish $page
  375. return
  376. }
  377. if {[::http::status $page]=="timeout"} {
  378. putserv "$toput :\002Connection to imdb.com timed out.\002"
  379. ::http::Finish $page
  380. return
  381. }
  382. set html [::http::data $page]
  383. ::http::Finish $page
  384. } else {
  385. unset html
  386. catch { exec $binary(CURL) "$newurl" } html
  387. }
  388. } else {
  389. putserv "$toput :Error in search mechanics - you probably need a newer version."
  390. return
  391. }
  392. }
  393. # for bogus searches
  394. if {[string length $newurl] == 0} {
  395. putserv "$toput :No no no! I can't find that!"
  396. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG bogus searches" }
  397. return
  398. }
  399. # decide on output
  400. if { ! [string compare [lindex $announce(IMDBIRC) 0] "random"] && [string is alnum -strict [lindex $announce(IMDBIRC) 1]] == 1 } {
  401. set output $random(IMDBIRC\-[rand [lindex $announce(IMDBIRC) 1]])
  402. } else {
  403. set output $announce(IMDBIRC)
  404. }
  405. # collect output
  406. set title "N/A" ; set name "N/A" ; set genre "N/A" ; set tagline "N/A"
  407. set plot "N/A" ; set rating "N/A" ; set votes "N/A" ; set mpaa "N/A"
  408. set runtime "N/A" ; set budget "N/A" ; set screens "N/A" ; set country "N/A"
  409. set language "N/A" ; set soundmix "N/A" ; set top250 "top/bottom:N/A"; set awards "N/A"
  410. set rating_bar ""; set cast_multiline "N/A"; set wcredits "N/A"; set keywords "N/A"
  411. set comment "N/A"; set reldate "N/A"; set cast_line "N/A"
  412. set movie_color "N/A"; set aspect_ratio "N/A"; set cert "N/A"
  413. set film_locations "N/A"; set company "N/A"
  414. ## get title
  415. if [regexp {<title>[^<]+} $html title] {
  416. set pos [expr [string last > $title] + 1]
  417. set title [string range $title $pos end]
  418. set title [htmlparse::mapEscapes $title]
  419. }
  420. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG title == $title" }
  421. ## get director
  422. if [regexp {<h5>Director.*?</h5>(.*?)</div>} $html dummy name] {
  423. regsub -all {\n[ ]*} $name {} name
  424. set name [string map {"&#38;<br/>" "& " "<br/>" ", " "more" ""} $name]
  425. regsub -all {<[^>]+>} $name {} name
  426. set name [string trim $name]
  427. regsub -all {,$} $name {} name
  428. set name [htmlparse::mapEscapes $name]
  429. }
  430. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG director == $name" }
  431. ## get writing credits
  432. if [regexp {<h5>Writer.*?</h5>(.*?)</div>} $html dummy wcredits] {
  433. regsub -all {\n[ ]*} $wcredits {} wcredits
  434. set wcredits [string map {"more" "" "<br/>&nbsp;" "" "&#38;<br/>" "& " "&#x26;<br/>" "& " "<br/>" ", "} $wcredits]
  435. regsub -all {<[^>]+>} $wcredits {} wcredits
  436. set wcredits [string trim $wcredits]
  437. regsub -all {,$} $wcredits {} wcredits
  438. set wcredits [htmlparse::mapEscapes $wcredits]
  439. }
  440. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG writer == $wcredits" }
  441. # release date
  442. if {[regexp {<h5>Release Date:</h5>(.*?)</div>} $html dummy reldate]} {
  443. regsub -all {<[^\>]*>} $reldate {} reldate
  444. set reldate [string map {"more" "" \n "" &amp; " & "} $reldate]
  445. set reldate [string trim $reldate]
  446. set reldate [htmlparse::mapEscapes $reldate]
  447. }
  448. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG release date == $reldate" }
  449. ## get genre
  450. if [regexp {<h5>Genre:</h5>(.*?)</div>} $html dummy genre] {
  451. set genre [string map {"more" ""} $genre]
  452. regsub -all {<[^\>]*>} $genre {} genre
  453. set genre [string map {"|" "||" } $genre]
  454. set genre [string trim $genre]
  455. regsub {\(.*\)} $genre {} genre
  456. set genre [htmlparse::mapEscapes $genre]
  457. }
  458. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG genre == $genre" }
  459. ## get tagline
  460. if [regexp {<h5>Tagline:</h5>(.*?)</div>} $html dummy tagline] {
  461. set tagline [string map {"more" "" } $tagline]
  462. regsub -all {<[^\>]*>} $tagline {} tagline
  463. set tagline [string trim $tagline]
  464. set tagline [htmlparse::mapEscapes $tagline]
  465. }
  466. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG tagline == $tagline" }
  467. ## get plot outline
  468. if { [regexp {<h5>Plot:</h5>(.*?)</div>} $html dummy plot] || [regexp {<h5>Plot Summary:</h5>(.*?)</div>} $html dummy plot] } {
  469. set plot [string map {"more" "" "(view trailer)" "" "full summary" "" "add synopsis" "" "full synopsis (warning! may contain spoilers)" "" "full synopsis" "" " | " ""} $plot]
  470. regsub -all {<[^\>]*>} $plot {} plot
  471. set plot [string trim $plot]
  472. set plot [htmlparse::mapEscapes $plot]
  473. }
  474. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG plot == $plot" }
  475. ## get plot keywords
  476. if [regexp {<h5>Plot Keywords:</h5>(.*?)</div>} $html dummy keywords] {
  477. set keywords [string map {"more" "" \n ""} $keywords]
  478. regsub -all {<[^\>]*>} $keywords {} keywords
  479. set keywords [string map {"|" "||"} $keywords]
  480. set keywords [string trim $keywords]
  481. set keywords [htmlparse::mapEscapes $keywords]
  482. }
  483. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG keywords == $keywords" }
  484. ## get awards
  485. if [regexp {<h5>Awards:</h5>(.*?)</div>} $html dummy awards] {
  486. set awards [string map {"more" "" \n " "} $awards]
  487. regsub -all {<[^\>]*>} $awards {} awards
  488. set awards [string trim $awards]
  489. set awards [htmlparse::mapEscapes $awards]
  490. }
  491. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG awards == $awards" }
  492. ## get comment
  493. if [regexp {<h5>User Comments:</h5>\n(.*?)\n</div>} $html dummy comment] {
  494. set comment [string map {"more" "" \n " "} $comment]
  495. regsub -all {<[^\>]*>} $comment {} comment
  496. set comment [string trim $comment]
  497. set comment [htmlparse::mapEscapes $comment]
  498. }
  499. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG comment == $comment" }
  500. ## get iMDb rating
  501. if [regexp {<b>((\d.\d)/10)</b>.*?<a href="ratings".*?>([\d,]+).*?votes</a>} $html dummy rating goldstars votes] {
  502. #rating bar code
  503. set goldstars [expr round($goldstars)]
  504. set greystars [expr 10 - $goldstars]
  505. # generating the rating bar
  506. set marker "*"
  507. set rating_bar "$barcol1\[$barcol2"
  508. for {set i2 0} {$i2 < $goldstars} {incr i2 1} {
  509. set rating_bar "$rating_bar$marker"
  510. }
  511. set marker "-"
  512. set rating_bar "$rating_bar14"
  513. for {set i3 0} {$i3 < $greystars} {incr i3 1} {
  514. set rating_bar "$rating_bar$marker"
  515. }
  516. set rating_bar "$rating_bar$barcol1\]"
  517. #end rating bar code
  518. }
  519. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG rating == $rating | votes == $votes | rating bar == $rating_bar" }
  520. ## get TOP 250
  521. if [regexp {>(Top 250: #[\d]+)</a>} $html dummy top250] {
  522. } elseif [regexp {>(Bottom 100: #[\d]+)</a>} $html dummy top250] {
  523. }
  524. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG top250 == $top250" }
  525. ## get MPAA
  526. if [regexp {<h5><a href="/mpaa">MPAA</a>:</h5>(.*?)</div>} $html dummy mpaa] {
  527. regsub -all {<[^\>]*>} $mpaa {} mpaa
  528. #regsub {MPAA: } $mpaa {} mpaa
  529. set mpaa [string trim $mpaa]
  530. set mpaa [htmlparse::mapEscapes $mpaa]
  531. }
  532. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG mpaa == $mpaa" }
  533. ## get runtime
  534. if [regexp {<h5>Runtime:</h5>\n.*?([\d]+).*?\n} $html dummy runtime] {
  535. regsub -all {[\n\s]+} $runtime {} runtime
  536. }
  537. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG runtime == $runtime" }
  538. ## get country
  539. if [regexp {<h5>Country:</h5>\n(.*?)</div>} $html dummy country] {
  540. regsub -all {<[^\>]*>} $country {} country
  541. set country [string map {"|" "||" } $country]
  542. regsub -all {[\n]+} $country {} country
  543. }
  544. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG country == $country" }
  545. ## get language
  546. if [regexp {<h5>Language:</h5>\n(.*?)</div>} $html dummy language] {
  547. regsub -all {<[^\>]*>} $language {} language
  548. regsub -all {[\n]+} $language {} language
  549. set language [string map {"|" "||"} $language]
  550. }
  551. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG language == $language" }
  552. ## get movie color
  553. if [regexp {<h5>Color:</h5>(.*?)</div>} $html dummy movie_color] {
  554. regsub -all {<[^\>]*>} $movie_color {} movie_color
  555. regsub -all {[\n]+} $movie_color {} movie_color
  556. set movie_color [string trim $movie_color]
  557. set movie_color [string map {"|" "||"} $movie_color]
  558. }
  559. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG movie_color == $movie_color" }
  560. ## get aspect ratio
  561. if [regexp {<h5>Aspect Ratio:</h5>(.*?)</div>} $html dummy aspect_ratio] {
  562. regsub -all {<[^\>]*>} $aspect_ratio {} aspect_ratio
  563. set aspect_ratio [string map {"more" "" } $aspect_ratio]
  564. set aspect_ratio [string trim $aspect_ratio]
  565. }
  566. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG aspect_ratio == $aspect_ratio" }
  567. ## get soundmix
  568. if [regexp {<h5>Sound Mix:</h5>\n(.*?)</div>} $html dummy soundmix] {
  569. regsub -all {<[^\>]*>} $soundmix {} soundmix
  570. regsub -all {[\n]+} $soundmix {} soundmix
  571. set soundmix [string map {"|" "||"} $soundmix]
  572. }
  573. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG soundmix == $soundmix" }
  574. ## get certification
  575. if [regexp {<h5>Certification:</h5>\n(.*?)</div>} $html dummy cert] {
  576. regsub -all {<[^\>]*>} $cert {} cert
  577. regsub -all {[\n]+} $cert {} cert
  578. set cert [string map {"|" "||"} $cert]
  579. }
  580. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG cert == $cert" }
  581. ## get locations
  582. if { [regexp {<h5>Filming Locations:</h5>(.*?)</div>} $html dummy film_locations] } {
  583. set film_locations [string map {"more" "" } $film_locations]
  584. regsub -all {<[^\>]*>} $film_locations {} film_locations
  585. set film_locations [string trim $film_locations]
  586. set film_locations [htmlparse::mapEscapes $film_locations]
  587. }
  588. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG film_locations == $film_locations" }
  589. ## get company
  590. if [regexp {<h5>Company:</h5>(.*?)</div>} $html dummy company] {
  591. set company [string map {"more" "" } $company]
  592. regsub -all {<[^\>]*>} $company {} company
  593. set company [string trim $company]
  594. }
  595. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG company == $company" }
  596. ## get cast
  597. if [regexp {<table class="cast">(.*?)</table>} $html dummy cast] {
  598. regsub -all {</tr>.*?<tr.*?>} $cast \n cast_multiline
  599. regsub -all {<[^\>]*>} $cast_multiline {} cast_multiline
  600. set cast_multiline [string map {"rest of cast listed alphabetically:" \n} $cast_multiline]
  601. set cast_multiline [string trim [htmlparse::mapEscapes $cast_multiline]]
  602. if { $cast_linelimit > 0 } {
  603. set nthoccur [expr [findnth $cast_multiline \n $cast_linelimit] - 1]
  604. if {$nthoccur > 0} {set cast_multiline [string range $cast_multiline 0 $nthoccur]}
  605. }
  606. }
  607. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG cast_multiline == $cast_multiline" }
  608. ## fill singleline
  609. regsub -all {\n} $cast_multiline " / " cast_line
  610. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG cast_line == $cast_line" }
  611. # do we need the second page?
  612. if {[string match "*%budget*" $output] || [string match "*%screens*" $output]} {
  613. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG page2 needed" }
  614. unset html
  615. if { $IMDB_ALTERNATIVE == 0 } {
  616. set page2 [::http::config -useragent "MSIE 6.0"]
  617. if [catch {set page2 [::http::geturl ${newurl}business -timeout $imdb_timeout]} error ] {
  618. putserv "$toput :Error retrieving URL... try again later."
  619. ::http::Finish $page
  620. return
  621. }
  622. if {[::http::status $page2]=="timeout"} {
  623. putserv "$toput :\002Connection to imdb.com timed out.\002"
  624. ::http::Finish $page2
  625. return
  626. }
  627. set html [::http::data $page2]
  628. ::http::Finish $page2
  629. } else {
  630. catch { exec $binary(CURL) "${newurl}business" } html
  631. }
  632. ## get budget
  633. if [regexp {<h5>Budget</h5>\n(.*?)<br/>} $html dummy budget] {
  634. set budget [string map {&#8364; &#x20AC; &#163; ? } $budget]
  635. }
  636. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG budget == $budget" }
  637. ## get screens
  638. if [regexp {<h5>Opening Weekend</h5>\n(.*?Screens\))} $html dummy screens] {
  639. regsub -all {<[^\>]*>} $screens {} screens
  640. set screens [htmlparse::mapEscapes $screens]
  641. }
  642. if {$IMDB_DEBUG == 1} { putlog "IMDB_DEBUG screens == $screens" }
  643. }
  644. ## output results
  645. set output [replacevar $output "%title" $title]
  646. set output [replacevar $output "%url" $newurl]
  647. set output [replacevar $output "%name" $name]
  648. set output [replacevar $output "%genre" $genre]
  649. set output [replacevar $output "%tagline" $tagline]
  650. set output [replacevar $output "%plot" $plot]
  651. set output [replacevar $output "%keywords" $keywords]
  652. set output [replacevar $output "%awards" $awards]
  653. set output [replacevar $output "%comment" $comment]
  654. set output [replacevar $output "%rating" $rating]
  655. set output [replacevar $output "%rbar" $rating_bar]
  656. set output [replacevar $output "%votes" $votes]
  657. set output [replacevar $output "%top250" $top250]
  658. set output [replacevar $output "%mpaa" $mpaa]
  659. set output [replacevar $output "%time" $runtime]
  660. set output [replacevar $output "%country" $country]
  661. set output [replacevar $output "%language" $language]
  662. set output [replacevar $output "%mcolor" $movie_color]
  663. set output [replacevar $output "%aspect" $aspect_ratio]
  664. set output [replacevar $output "%soundmix" $soundmix]
  665. set output [replacevar $output "%cert" $cert]
  666. set output [replacevar $output "%locations" $film_locations]
  667. set output [replacevar $output "%company" $company]
  668. set output [replacevar $output "%budget" $budget]
  669. set output [replacevar $output "%screens" $screens]
  670. set output [replacevar $output "%reldate" $reldate]
  671. set checkvar ""
  672. regexp {.*?%castmline} $output checkvar
  673. if { [expr [regexp -all {%uline} $checkvar] % 2] == 1 } {
  674. set cast_multiline [string map {"\n" "\n%uline"} $cast_multiline]
  675. }
  676. if { [expr [regexp -all {%bold} $checkvar] % 2] == 1 } {
  677. set cast_multiline [string map {"\n" "\n%bold"} $cast_multiline]
  678. }
  679. if { [regexp {.*%color([\d]+(?:,[\d]+)?)[^\n]*?%castmline} $checkvar dummy colormline] } {
  680. regsub -all {\n} $cast_multiline "\n%color$colormline" cast_multiline
  681. }
  682. set output [replacevar $output "%castmline" $cast_multiline]
  683. set output [replacevar $output "%castline" $cast_line]
  684. set output [replacevar $output "%wcredits" $wcredits]
  685. regsub -all {\|[^\|]*?N/A[^\|]*?\|} $output "" output
  686. set output [string map {"||" "|" "|" ""} $output]
  687. regsub -all {\n[\n\s]*\n} $output "\n" output
  688. set output [string trim $output]
  689. set output [replacevar $output "%bold" "\002"]
  690. set output [replacevar $output "%color" "\003"]
  691. set output [replacevar $output "%uline" "\037"]
  692. foreach line [split $output "\n"] {
  693. putserv "$toput :$line"
  694. }
  695. }
  696. proc decr_inst { } {
  697. global IMDB_DEBUG instance
  698. if { $instance > 0 } { incr instance -1 }
  699. if { $IMDB_DEBUG == 1 } { putlog "IMDB_DEBUG instance decreased by timer to: $instance" }
  700. }
  701. proc wmsg { } {
  702. global warn_msg
  703. set warn_msg 0
  704. }
  705. putlog "IMDB info version 05.01.2010 loaded"