| 1 | # |
| 2 | # ourTube.tcl -- |
| 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 | |
| 40 | setudef flag ourtube |
| 41 | global ourtube tcl_platform |
| 42 | |
| 43 | # (1) Enable or (0) disable colors |
| 44 | set ourtube(colors) 1 |
| 45 | |
| 46 | # Flood Protection: after show a link, will ignore all links few seconds |
| 47 | # This means 1 link per 10 seconds. |
| 48 | set ourtube(rest) 10 |
| 49 | |
| 50 | # What language you can receive the youTube data? (if works heh) |
| 51 | set ourtube(lang) en |
| 52 | |
| 53 | # This is the final output message what you will read in your channel. |
| 54 | # You can configure all fields that your eggdrop will show. |
| 55 | # <title> will return the title of the video |
| 56 | # <author> It was the author himself who had uploaded the video |
| 57 | # <views> How many views the video has |
| 58 | # <rating> His rating |
| 59 | # <description> Information by author - This may be disabled because it can |
| 60 | # contain spam |
| 61 | # <comment> Will show the last comment if exists - Same as description, take care |
| 62 | # with spam. |
| 63 | |
| 64 | set ourtube(output) "02<title>02. (by <author>) <views> views, <rating> rating. Last comment: <comment>" |
| 65 | |
| 66 | # This is not required to edit, or yes. |
| 67 | |
| 68 | set ourtube(author) "HackeMate" |
| 69 | set ourtube(contact) "HackeMate <Sentencia@eggdrop.es>" |
| 70 | set ourtube(fileName) [file tail [info script]] |
| 71 | set ourtube(projectName) "ourTube" |
| 72 | set ourtube(version) "1.0.1" |
| 73 | set ourtube(package.http) [package require http] |
| 74 | set ourtube(protection) "" |
| 75 | if {$tcl_platform(os) eq "Linux"} { |
| 76 | set platfrm "X11" |
| 77 | } else { |
| 78 | set platfrm $tcl_platform(os) |
| 79 | } |
| 80 | 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" |
| 81 | |
| 82 | bind pubm - * otPub |
| 83 | |
| 84 | proc otPub {nick uhost hand chan text} { |
| 85 | |
| 86 | if {![channel get $chan ourtube]} { |
| 87 | return |
| 88 | } |
| 89 | global ourtube |
| 90 | regsub -all -- {17|02|37|26|03(\d{1,2})?(,\d{1,2})?} $text "" arg |
| 91 | |
| 92 | set webTarget [lsearch -inline [split $arg] {*http://*youtube*/watch?*}] |
| 93 | if {([info exists ourtube(protection)]) && ([string is digit -strict $ourtube(protection)])} { |
| 94 | set rest [expr [clock seconds]-$ourtube(protection)] |
| 95 | if {$rest >= $ourtube(rest)} { |
| 96 | set ourtube(protection) "" |
| 97 | } |
| 98 | } else { |
| 99 | set ourtube(protection) "" |
| 100 | } |
| 101 | if {$webTarget ne ""} { |
| 102 | if {! [regexp -nocase {^(http://)?([^/:]+)(:([0-9]+))?(/.*)?$} $webTarget]} { |
| 103 | otLog "Unsupported URL: $webTarget" |
| 104 | return |
| 105 | } |
| 106 | if {$ourtube(protection) ne ""} { |
| 107 | otLog "Resting... (flood protection) [duration [expr ([clock seconds]-$ourtube(protection))]] left" |
| 108 | return |
| 109 | } |
| 110 | set ourtube(protection) [clock seconds] |
| 111 | otLog "Getting $webTarget ... from $nick on $chan" |
| 112 | set data [otGet $webTarget] |
| 113 | if {!$ourtube(colors)} { |
| 114 | regsub -all -- {17|02|37|26|03(\d{1,2})?(,\d{1,2})?} $data "" data |
| 115 | } |
| 116 | if {[string length $data] == 0} { |
| 117 | set data "I was not able to reach Youtube's link. Probably I get a timeout. Try again." |
| 118 | } |
| 119 | otLog "$data" |
| 120 | putserv "PRIVMSG $chan :$data" |
| 121 | utimer $ourtube(rest) [list set ourtube(protection) ""] |
| 122 | } |
| 123 | |
| 124 | } |
| 125 | |
| 126 | proc otGet {web {relocation ""}} { |
| 127 | global ourtube |
| 128 | set token [http::geturl $web -timeout 4000] |
| 129 | upvar #0 $token state |
| 130 | set lastcode $state(http) |
| 131 | regexp {[0-9]{3}} $lastcode ncode |
| 132 | if {$ncode eq ""} { |
| 133 | set ncode $lastcode |
| 134 | } |
| 135 | switch -- $ncode { |
| 136 | "200" { |
| 137 | } |
| 138 | "302" { |
| 139 | foreach {flag value} $state(meta) { |
| 140 | if {$flag eq "Location"} { |
| 141 | # Due to invalid youtube link but valid url syntax we can |
| 142 | # receive an url forward. this handles that |
| 143 | http::cleanup $token |
| 144 | otLog "$web forwards us to $value" |
| 145 | return [otGet $value "(Relocated)"] |
| 146 | } |
| 147 | } |
| 148 | } |
| 149 | "303" { |
| 150 | otLog "This video does not exists." |
| 151 | http::cleanup $token |
| 152 | return "That video does not exists. Server responded: $lastcode" |
| 153 | } |
| 154 | "404" { |
| 155 | otLog "$web - No such webpage." |
| 156 | http::cleanup $token |
| 157 | return "$web - No such webpage" |
| 158 | } |
| 159 | default { |
| 160 | http::cleanup $token |
| 161 | otLog "unforeseen circumstances. Server responded: $lastcode" |
| 162 | return "unforeseen circumstances. Server responded: $lastcode" |
| 163 | } |
| 164 | } |
| 165 | set data [string map {""\;" "\"" "&\;quot\;" "\"" "&" "&"} $state(body)] |
| 166 | |
| 167 | http::cleanup $token |
| 168 | set author "" |
| 169 | set description "" |
| 170 | set views "" |
| 171 | set rating "" |
| 172 | regexp {<title>(.*?)</title>} $data "" title |
| 173 | regexp {class="hLink fn n contributor">(.*?)</a><br>} $data "" author |
| 174 | regexp {<meta name=\"description\" content=\"(.*?)\">.*} $data "" description |
| 175 | regexp {<span id=\"watch-view-count\">(.*?)</span>} $data "" views |
| 176 | regexp {<div id=\"defaultRatingMessage\">(.*?)</span>.*} $data "" rating |
| 177 | # This is not so smart way. I know, sorry about :) |
| 178 | set comments "" |
| 179 | set description "" |
| 180 | regexp {<div id="recent_comments" class="comments">(.*?)<div id="div_comment_form_id} $data "" comments |
| 181 | if {$comments ne ""} { |
| 182 | regexp { rel="nofollow">(.*?)</a>} $comments "" user |
| 183 | regexp {<span class="watch-comment-time">(.*?)</span>} $comments "" timeago |
| 184 | regexp {<div class="watch-comment-body">(.*?)</div>} $comments "" comment |
| 185 | set comment [string map {\n " " "<br>" ""} $comment] |
| 186 | regsub -all -- {\<[^\>]*\>|\t} $comment "" comment |
| 187 | regsub -all {\s+} $comment " " comment |
| 188 | set comment "\<$user [string trim $timeago]\> [string trim $comment]" |
| 189 | } else { |
| 190 | set comment "" |
| 191 | } |
| 192 | regsub -all -- {\<[^\>]*\>|\t} $title "" title |
| 193 | regsub -all -- {\<[^\>]*\>|\t} $description "" description |
| 194 | regsub -all -- {\<[^\>]*\>|\t} $views "" views |
| 195 | regsub -all -- {\<[^\>]*\>|\t} $rating "" rating |
| 196 | set rating [lindex [split $rating] 0] |
| 197 | set title "$relocation $title" |
| 198 | set title [string trim $title] |
| 199 | if {![string is digit -strict $views]} { |
| 200 | set views "no" |
| 201 | } |
| 202 | if {![string is digit -strict $rating]} { |
| 203 | set rating "no" |
| 204 | } |
| 205 | if {$comment eq ""} { |
| 206 | set comment "This video doesn't have any comments until now" |
| 207 | } |
| 208 | if {$description eq ""} { |
| 209 | set description "This video doesn't have any description" |
| 210 | } |
| 211 | set output [string map [list "<title>" $title "<author>" $author "<description>" $description "<views>" $views "<rating>" $rating "<comment>" $comment] $ourtube(output)] |
| 212 | return $output |
| 213 | } |
| 214 | |
| 215 | # upvar #0 $token state |
| 216 | proc otLog {arg} { |
| 217 | global ourtube |
| 218 | putlog "$ourtube(projectName): $arg" |
| 219 | } |
| 220 | otLog "$ourtube(fileName) $ourtube(version) Loaded - by $ourtube(author)" |
Back
Overview
Members
Search
Help
| YouTube info
Quote 
Reply
The user has attached a file: ourTube.tcl (Save, 8,279 Bytes, downloaded 31 times)
Advanced options for this topic: