API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Nov 5th, 2009
311
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 19.15 KB | None | 0 0
raw download clone embed print report
  1. #
  2. # ourTube.tcl 1.0.1 --
  3. # This file search the web target and show relevant information about.
  4. # Is posible define a YouTube account and the bot will log in. Useful
  5. # when the link are for adult people i.e. It will show the first link
  6. # that finds in a whole phrase.
  7. #
  8. # Copyright (c) 2007-2009 Eggdrop Spain 12-april-2009
  9. # HackeMate (Sentencia) Sentencia@eggdrop.es
  10. #
  11. # This program is free software; you can redistribute it and/or
  12. # modify it _only for your own use_
  13. #
  14. # This program is distributed in the hope that it will be useful,
  15. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  17. #
  18. # Please, use the email to contact with the author for let him know about all
  19. # what you could do. Everyone wants develop his software as well.
  20. #
  21. # Thank you for feed my empiric life.
  22. #
  23. # If you like, you can contact with the author to suggest him features. By the
  24. # way, do not ask him to make Login, he is working on that.
  25.  
  26. # This is what you need to get this script work:
  27. # Type in partyline: .chanset #channel +ourtube
  28.  
  29. # Changelog:
  30. # Fixes:
  31. # Resolved Tcl error [otPub]: can't read "views": no such variable
  32. # Resolved eternal ignore-protection issue
  33. #
  34. # Added features:
  35. # Now will forward to new location 302 http code received when pasting
  36. # http://youtube. links
  37. # Explicit message when 404 error (not found)
  38. # All non 200, 302, 303, 404 errors will stop the procedure showing proper reason
  39. # -*- IMPORTANT -*-
  40. # Auto Update checker: You can verify if your ourTube copy is the lastest
  41. # version available typing .ourtube update in partyline
  42. #
  43. # FeedBack feature. Type in partyline .ourtube feedback [your email] <message>
  44. # to send the author any suggestion or comment. Insults are not welcome.
  45. #
  46. # Added seacher, !youtube string and it will return matches
  47. # it is customizable (configure ourtube(outputsearch))
  48.  
  49.  
  50. setudef flag ourtube
  51. setudef flag ourtubecolors
  52.  
  53. global ourtube tcl_platform
  54.  
  55. # (1) Enable or (0) disable colors
  56. set ourtube(colors) 0
  57.  
  58. # Flood Protection: after show a link, will ignore all links few seconds
  59. # This means 1 link per 10 seconds.
  60. set ourtube(rest) 10
  61.  
  62. # What language you can receive the youTube data? (if works heh)
  63. set ourtube(lang) en
  64.  
  65. # Limit of links at same time
  66. set ourtube(max) 5
  67.  
  68. # Do you want see all matches at one line? (0) Yes (1) No
  69. set ourtube(multiline) 1
  70.  
  71. # This is the final output message what you will read in your channel.
  72. # -*- This is not for search command (only when someone pasted link)
  73. # You can configure all fields that your eggdrop will show.
  74. # <title> will return the title of the video
  75. # <author> It was the author himself who had uploaded the video
  76. # <views> How many views the video has
  77. # <rating> His rating
  78. # <description> Information by author - This may be disabled because it can
  79. # contain spam
  80. # <comment> Will show the last comment if exists - Same as description, take care
  81. # with spam.
  82.  
  83. set ourtube(output) "\002<title>\002. (by <author>) <views> views, <rating> rating. Description: <description>"
  84.  
  85. # This is the output message of search engine
  86. # -*- This is only for search engine
  87. # You can configure all fields that your eggdrop will show.
  88. # <link> URL video link
  89. # <time> video's duration
  90. # <added> since when it is on line
  91. # <title> will return the title of the video
  92. # <author> It was the author himself who had uploaded the video
  93. # <views> How many views the video has
  94. # <rating> His rating
  95. # <description> Information by author - This may be disabled because it can
  96. # contain spam
  97.  
  98. set ourtube(outputsearch) "\00312\037<link>\003\037 \00315\(<time> rating: <rating>\)\003 \"\0036<title> \0031<author> said\0036: <description>\003\" <views>, added <added>"
  99.  
  100. # Do you want auto update this file when it is possible?
  101. # (1) Yes (0) No - It is recommended, if youtube changes his tags probably this script will broke
  102. set ourtube(autoupdate) 0
  103.  
  104. # This is not required to edit, or yes.
  105.  
  106. set ourtube(author) "HackeMate"
  107. set ourtube(contact) "HackeMate <Sentencia@eggdrop.es>"
  108. set ourtube(name) "ourTube"
  109. set ourtube(fileName) [info script]
  110. set ourtube(projectName) "ourTube"
  111. set ourtube(version) "1.0.1"
  112. set ourtube(package.http) [package require http]
  113. set ourtube(protection) ""
  114. if {$tcl_platform(os) eq "Linux"} {
  115. set platfrm "X11"
  116. } else {
  117. set platfrm $tcl_platform(os)
  118. }
  119. http::config -useragent "Mozilla/5.0 ($platfrm; U; $tcl_platform(os) $tcl_platform(machine); $ourtube(lang); rv:1.9.0.3) ourTube 1.0" -accept "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"
  120.  
  121. bind pub - !youtube otYoutube
  122.  
  123. proc otYoutube {nick uhost hand chan text} {
  124.  
  125. if {![channel get $chan ourtube]} {
  126. if {$text eq "enable"} {
  127. channel set $chan +ourtube
  128. channel set $chan +ourtubecolors
  129. otLog $chan "Usage: !youtube <search string> To see a list of matches."
  130. putserv "NOTICE $nick :You also can use .ourtube update and .ourtube feedback in partyline to upgrade your script or send a feedback to author of this script."
  131. return
  132. } else {
  133. putserv "NOTICE $nick :$chan has this command disabled."
  134. }
  135. if {[matchattr $hand n]} {
  136. putserv "NOTICE $nick :You can enable it directly typing: /msg $chan !youtube enable"
  137. }
  138. return
  139. }
  140. regsub -all -- {\017|\002|\037|\026|\003(\d{1,2})?(,\d{1,2})?} $text "" arg
  141. global ourtube
  142. # This is a generic protection to prevent flood ourtube.com
  143. # No utimer required
  144. #
  145. if {![info exists ourtube(protection)]} {
  146. set ourtube(protection) [clock seconds]
  147. } else {
  148. if {![string is digit -strict $ourtube(protection)]} {
  149. set ourtube(protection) [clock seconds]
  150. } else {
  151. set time [expr [clock seconds]-$ourtube(protection)]
  152. if {$time >= $ourtube(rest)} {
  153. set ourtube(protection) [clock seconds]
  154. } else {
  155. otLog log "Flood protection in $chan from $nick\."
  156. return
  157. }
  158. }
  159. }
  160.  
  161. if {$arg eq ""} {
  162. putserv "NOTICE $nick :Tell me what to search."
  163. return
  164. }
  165. set data [ourtubeGet $arg]
  166.  
  167. if {![channel get $chan ourtubecolors]} {
  168. regsub -all -- {\017|\002|\037|\026|\003(\d{1,2})?(,\d{1,2})?} $data "" data
  169. }
  170. if {[string length $data] == 0} {
  171. set data "I was unable to connect to that website. Probably I get timeout."
  172. return
  173. }
  174. if {$ourtube(multiline) != "1"} {
  175. putserv "PRIVMSG $chan :$data"
  176. } else {
  177. foreach line $data {
  178. putserv "PRIVMSG $chan :$line"
  179. }
  180. }
  181. }
  182.  
  183. proc ourtubeGet {ask} {
  184.  
  185. global ourtube
  186. regsub -all -- {\s+} $ask " " search
  187. set search [http::formatQuery $search]
  188. http::config -useragent "Mozilla/5.0 (Windows NT; U; Windows NT x86; en-ES; rv:1.9.0.3) Firefox 3.0.7" -accept "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"
  189. set token [http::geturl http://www.youtube.com/results?search_query=$search -timeout 10000]
  190. upvar #0 $token state
  191. set data $state(body)
  192. regsub -all {\n|\t} $data "" data
  193. set ncode ""
  194. regexp {[0-9]{3}} $state(http) ncode
  195. if {$ncode eq ""} {
  196. set ncode $state(http)
  197. }
  198. set list {}
  199. switch -- $ncode {
  200. "200" {
  201. set videos [regexp -all -inline {<div class="video-entry">(.*?)<div class="video-clear-list-left"></div>} $data]
  202. set total [expr [llength $videos] /2]
  203. if {$total > $ourtube(max)} {
  204. set list [list "Showing $ourtube(max) of $total."]
  205. }
  206. set i 2
  207. set title ""
  208. set description ""
  209. set rating ""
  210. set added ""
  211. set views ""
  212. set author ""
  213. set link ""
  214. foreach {id line} $videos {
  215. set map {}
  216. foreach {entity number} [regexp -all -inline {&#(\d+);} $line] {
  217. lappend map $entity [format \\u%04x [scan $number %d]]
  218. }
  219. set line [string map [subst -nocomm -novar $map] $line]
  220.  
  221. regexp {<img title="(.*?)"} $line "" title
  222. regsub -all -- {\<[^\>]*\>|\t} $title "" title
  223. regexp {<div class="video-time">(.*?)</span>} $line "" time
  224. regsub -all -- {\<[^\>]*\>|\t} $time "" time
  225. # following line was edited from original
  226. regexp {description">(.*?)</div>} $line "" description
  227. regsub -all -- {\<[^\>]*\>|\t} $description "" description
  228. regexp {<button class="master-sprite ratingVS ratingVS-(.*?)"} $line "" rating
  229. regexp {class="video-date-added">(.*?)</span>} $line "" added
  230. regexp {class="video-view-count">(.*?)</span>} $line "" views
  231. regexp {<span class="video-username">(.*?)</a>} $line "" author
  232. regsub -all -- {\<[^\>]*\>|\t} $author "" author
  233. regexp {<a id="video-url-(.*?)"} $line "" link
  234. set link "http://youtube.com/watch?v=$link"
  235. set output [string map [list "<link>" $link "<time>" $time "<added>" $added "<title>" $title "<author>" $author "<description>" $description "<views>" $views "<rating>" $rating] $ourtube(outputsearch)]
  236. lappend list $output
  237. if {$i > $ourtube(max)} {
  238. break
  239. }
  240. incr i
  241. }
  242. return $list
  243. }
  244. "404" {
  245. otLog log "No such file or webpage."
  246. http::cleanup $token
  247. return [list "No such file or webpage."]
  248. }
  249. default {
  250. otLog log "unforeseen circumstance. Server responded: $ncode"
  251. http::cleanup $token
  252. return [list "unforeseen circumstance. Server responded: $ncode"]
  253. }
  254. }
  255. }
  256. bind pubm - * otPub
  257.  
  258. proc otPub {nick uhost hand chan text} {
  259.  
  260. if {![channel get $chan ourtube]} {
  261. return
  262. }
  263. global ourtube
  264. regsub -all -- {\017|\002|\037|\026|\003(\d{1,2})?(,\d{1,2})?} $text "" arg
  265.  
  266. set webTarget [lsearch -inline [split $arg] {*http://*.youtube.*/watch?*}]
  267. if {([info exists ourtube(protection)]) && ([string is digit -strict $ourtube(protection)])} {
  268. set rest [expr [clock seconds]-$ourtube(protection)]
  269. if {$rest >= $ourtube(rest)} {
  270. set ourtube(protection) ""
  271. }
  272. } else {
  273. set ourtube(protection) ""
  274. }
  275. if {$webTarget ne ""} {
  276. if {! [regexp -nocase {^(http://)?([^/:]+)(:([0-9]+))?(/.*)?$} $webTarget]} {
  277. otLog log "Unsupported URL: $webTarget"
  278. return
  279. }
  280. if {$ourtube(protection) ne ""} {
  281. otLog "Resting... (flood protection) [duration [expr ([clock seconds]-$ourtube(protection))]] left"
  282. return
  283. }
  284. set ourtube(protection) [clock seconds]
  285. otLog log "Getting $webTarget ... from $nick on $chan"
  286. set data [otGet $webTarget]
  287. if {!$ourtube(colors)} {
  288. regsub -all -- {\017|\002|\037|\026|\003(\d{1,2})?(,\d{1,2})?} $data "" data
  289. }
  290. if {[string length $data] == 0} {
  291. set data "I was not able to reach Youtube's link. Probably I get a timeout. Try again."
  292. }
  293. otLog log "$data"
  294. putserv "PRIVMSG $chan :$data"
  295. utimer $ourtube(rest) [list set ourtube(protection) ""]
  296. }
  297. }
  298.  
  299. proc otGet {web {relocation ""}} {
  300. global ourtube
  301. set token [http::geturl $web -timeout 4000]
  302. upvar #0 $token state
  303. set lastcode $state(http)
  304. set ncode ""
  305. regexp {[0-9]{3}} $lastcode ncode
  306. if {$ncode eq ""} {
  307. set ncode $lastcode
  308. }
  309. switch -- $ncode {
  310. "200" {
  311. }
  312. "302" {
  313. foreach {flag value} $state(meta) {
  314. if {$flag eq "Location"} {
  315. # Due to invalid youtube link but valid url syntax we can
  316. # receive an url forward. this handles that
  317. http::cleanup $token
  318. otLog log "$web forwards us to $value"
  319. return [otGet $value "(Relocated)"]
  320. }
  321. }
  322. }
  323. "303" {
  324. otLog log "This video does not exists."
  325. http::cleanup $token
  326. return "That video does not exists. Server responded: $lastcode"
  327. }
  328. "404" {
  329. otLog log "$web - No such webpage."
  330. http::cleanup $token
  331. return "$web - No such webpage"
  332. }
  333. default {
  334. http::cleanup $token
  335. otLog log "unforeseen circumstances. Server responded: $lastcode"
  336. return "unforeseen circumstances. Server responded: $lastcode"
  337. }
  338. }
  339. set data [string map {"&quot\;" "\"" "&amp\;quot\;" "\"" "&amp;" "&"} $state(body)]
  340.  
  341. http::cleanup $token
  342. set author ""
  343. set description ""
  344. set views ""
  345. set rating ""
  346. regexp {<title>(.*?)</title>} $data "" title
  347. regexp {class="hLink fn n contributor">(.*?)</a><br>} $data "" author
  348. regexp {<meta name=\"description\" content=\"(.*?)\">.*} $data "" description
  349. # following two lines were edited from original
  350. if {![regexp {<span id=\"watch-view-count\">(.*?)</span>} $data "" views]} { set views "no" }
  351. if {![regexp {<div id=\"defaultRatingMessage\">(.*?)</span>.*} $data "" rating]} { set rating "no" }
  352. # This is not so smart way. I know, sorry about :)
  353. set comments ""
  354. set description ""
  355. regexp {<div id="recent_comments" class="comments">(.*?)<div id="div_comment_form_id} $data "" comments
  356. if {$comments ne ""} {
  357. regexp { rel="nofollow">(.*?)</a>} $comments "" user
  358. regexp {<span class="watch-comment-time">(.*?)</span>} $comments "" timeago
  359. regexp {<div class="watch-comment-body">(.*?)</div>} $comments "" comment
  360. set comment [string map {\n " " "<br>" ""} $comment]
  361. regsub -all -- {\<[^\>]*\>|\t} $comment "" comment
  362. regsub -all {\s+} $comment " " comment
  363. set comment "\<$user [string trim $timeago]\> [string trim $comment]"
  364. } else {
  365. set comment ""
  366. }
  367. regsub -all -- {\<[^\>]*\>|\t} $title "" title
  368. regsub -all -- {\<[^\>]*\>|\t} $description "" description
  369. regsub -all -- {\<[^\>]*\>|\t} $views "" views
  370. regsub -all -- {\<[^\>]*\>|\t} $rating "" rating
  371. set rating [lindex [split $rating] 0]
  372. set title "$relocation $title"
  373. set title [string trim $title]
  374. # two if statements were deleted from original
  375. if {$comment eq ""} {
  376. set comment "This video doesn't have any comments until now"
  377. }
  378. if {$description eq ""} {
  379. set description "This video doesn't have any description"
  380. }
  381. set output [string map [list "<title>" $title "<author>" $author "<description>" $description "<views>" $views "<rating>" $rating "<comment>" $comment] $ourtube(output)]
  382. return $output
  383. }
  384.  
  385. # upvar #0 $token state
  386.  
  387. proc otLog {target string} {
  388. global ourtube
  389. if {![validchan $target]} {
  390. putlog "$ourtube(name)\: $string"
  391. } else {
  392. putserv "PRIVMSG $target :$ourtube(name)\: $string"
  393. }
  394. }
  395.  
  396. bind dcc n ourtube communication::welcome
  397.  
  398. namespace eval communication {
  399.  
  400. # communication.tcl --
  401. # This is a little library for eggdrop as internal use
  402. # It is done to portablility - You cannot use it without a file.cgi in your
  403. # http server. If you really want that, contact me.
  404. variable version 1.0
  405. variable feedback {http://www.eggdrop.es/cgi-bin/feedback.cgi}
  406. variable update {http://www.eggdrop.es/cgi-bin/update.cgi}
  407.  
  408. proc welcome {hand ipx text} {
  409. global ourtube
  410. set arg [lindex [split $text] 0]
  411. switch -- $arg {
  412. "feedback" {
  413. set contact [lindex [split $text] 1]
  414. set message [join [lrange [split $text] 1 end]]
  415. if {($contact eq "") || ($message eq "")} {
  416. putdcc $ipx "$ourtube(projectName) - FeedBack"
  417. putdcc $ipx "Thank you for tell what you think."
  418. putdcc $ipx "This command sends to author an message with your suggestion, you are able to send one feedback per day (aprox)"
  419. putdcc $ipx "Usage: .webfeedback <your email (put it if you may want a reply or conversation with author, if not, put anything)> <tell me in english or spanish what you want say>"
  420. } else {
  421. set result [[namespace current]::Feedback $contact $ourtube(projectName) $message]
  422. if {$result eq ""} {
  423. putdcc $ipx "The server responded nothing. Did you sent a previous feedback already?"
  424. return
  425. }
  426. putdcc $ipx "The server responded:"
  427. foreach line [split $result \n] {
  428. putdcc $ipx $line
  429. }
  430. }
  431. }
  432. "update" {
  433. set download [lindex [split $text] 1]
  434. putdcc $ipx [join [lrange [split [[namespace current]::Update $ourtube(fileName) $ourtube(projectName) $ourtube(version) $download]] 1 end]]
  435. }
  436. default {
  437. putdcc $ipx "You can use '.ourtube update' to verify the last version and '.ourtube feedback' to send to author a suggestion"
  438. }
  439. }
  440. }
  441.  
  442. proc Feedback {reporter projectName message} {
  443. variable feedback
  444. http::config -useragent "$reporter $projectName"
  445. set token [http::geturl "$feedback\?suggest=[http::formatQuery $message]" -timeout 4000]
  446. set data [http::data $token]
  447. http::cleanup $token
  448. return $data
  449. }
  450.  
  451. proc Update {fileName projectName version {download ""}} {
  452. variable update
  453. set fs [open $fileName]
  454. set data [read $fs]
  455. close $fs
  456. set md5 [md5 $data]
  457. set query [http::formatQuery project $projectName version $version md5 $md5 download $download]
  458. set token [http::geturl "$update\?$query" -timeout 4000]
  459. set data [http::data $token]
  460. http::cleanup $token
  461. set result ""
  462. set info ""
  463. set url ""
  464. regexp {<!-- result -->(.*?)<!-- /result -->} $data "" result
  465. regexp {<!-- info -->(.*?)<!-- /info -->} $data "" info
  466. if {($download ne "") && ($download ne "no") && ($result == 1)} {
  467. regexp {<!-- data -->(.*?)<!-- /data -->} $data "" url
  468. if {![regexp -nocase {^(http://)?([^/:]+)(:([0-9]+))?(/.*)?$} $url]} {
  469. return "0 Invalid URL target file link."
  470. }
  471. set token [http::geturl $url -binary 1 -timeout 4000]
  472. set fileData [http::data $token]
  473. file rename -force -- $fileName $fileName\.bak
  474. set fs [open $fileName w]
  475. puts -nonewline $fs $fileData
  476. close $fs
  477. catch {source $fileName}
  478. set info "$projectName was (purged) downloaded and sourced succesfully, now you are using the lastest version available. There is a backup in $fileName\.bak"
  479. }
  480. return "$result $info"
  481. }
  482. }
  483. if {![info exists ourtube(loaded)]} {
  484. if {$ourtube(autoupdate) == "1"} {
  485. set ourtube(status) [communication::Update $ourtube(fileName) $ourtube(projectName) $ourtube(version) $ourtube(autoupdate)]
  486. set ourtube(result) [lindex [split $ourtube(status)] 0]
  487. set ourtube(info) [join [lrange [split $ourtube(status)] 1 end]]
  488. otLog log $ourtube(info)
  489. }
  490. }
  491. otLog log "[file tail $ourtube(fileName)] $ourtube(version) Loaded - by $ourtube(author) (Feedback and update commands available, type .ourtube in partyline)"
  492.  
  493. set ourtube(loaded) 1
  494.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!