13/11/2011, 19:40
Salut,
Genre ça ? :
Genre ça ? :
tcl
#
# ourTube.tcl --
# This file search the web target and show relevant information about.
# Is posible define a YouTube account and the bot will log in. Useful
# when the link are for adult people i.e. It will show the first link
# that finds in a whole phrase.
#
# Copyright (c) 2007-2009 Eggdrop Spain 12-april-2009
# HackeMate (Sentencia) Sentencia@eggdrop.es
#
# This program is free software; you can redistribute it and/or
# modify it _only for your own use_
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
#
# Please, use the email to contact with the author for let him know about all
# what you could do. Everyone wants develop his software as well.
#
# Thank you for feed my empiric life.
#
# If you like, you can contact with the author to suggest him features. By the
# way, do not ask him to make Login, he is working on that.
# This is what you need to get this script work:
# Type in partyline: .chanset #channel +ourtube
# Changelog:
# Fixes:
# Resolved Tcl error [otPub]: can't read "views": no such variable
# Resolved eternal ignore-protection issue
#
# Added features:
# Now will forward to new location 302 http code received when pasting
# http://youtube. links
# Explicit message when 404 error (not found)
# All non 200, 302, 303, 404 errors will stop the procedure showing proper reason
setudef flag ourtube
global ourtube tcl_platform
# (1) Enable or (0) disable colors
set ourtube(colors) 1
# Flood Protection: after show a link, will ignore all links few seconds
# This means 1 link per 10 seconds.
set ourtube(rest) 10
# What language you can receive the youTube data? (if works heh)
set ourtube(lang) en
# This is the final output message what you will read in your channel.
# You can configure all fields that your eggdrop will show.
# <title> will return the title of the video
# <author> It was the author himself who had uploaded the video
# <views> How many views the video has
# <rating> His rating
# <description> Information by author - This may be disabled because it can
# contain spam
# <comment> Will show the last comment if exists - Same as description, take care
# with spam.
set ourtube(output) "02<title>02. (by <author>) <views> views, <rating> rating. Last comment: <comment>"
# This is not required to edit, or yes.
set ourtube(author) "HackeMate"
set ourtube(contact) "HackeMate <Sentencia@eggdrop.es>"
set ourtube(fileName) [file tail [info script]]
set ourtube(projectName) "ourTube"
set ourtube(version) "1.0.1"
set ourtube(package.http) [package require http]
set ourtube(protection) ""
if {$tcl_platform(os) eq "Linux"} {
set platfrm "X11"
} else {
set platfrm $tcl_platform(os)
}
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"
bind pubm - * otPub
proc otPub {nick uhost hand chan text} {
if {![channel get $chan ourtube]} {
return
}
global ourtube
regsub -all -- {17|02|37|26|03(\d{1,2})?(,\d{1,2})?} $text "" arg
set webTarget [lsearch -inline [split $arg] {*http://*youtube*/watch?*}]
if {([info exists ourtube(protection)]) && ([string is digit -strict $ourtube(protection)])} {
set rest [expr [clock seconds]-$ourtube(protection)]
if {$rest >= $ourtube(rest)} {
set ourtube(protection) ""
}
} else {
set ourtube(protection) ""
}
if {$webTarget ne ""} {
if {! [regexp -nocase {^(http://)?([^/:]+)(:([0-9]+))?(/.*)?$} $webTarget]} {
otLog "Unsupported URL: $webTarget"
return
}
if {$ourtube(protection) ne ""} {
otLog "Resting... (flood protection) [duration [expr ([clock seconds]-$ourtube(protection))]] left"
return
}
set ourtube(protection) [clock seconds]
otLog "Getting $webTarget ... from $nick on $chan"
set data [otGet $webTarget]
if {!$ourtube(colors)} {
regsub -all -- {17|02|37|26|03(\d{1,2})?(,\d{1,2})?} $data "" data
}
if {[string length $data] == 0} {
set data "I was not able to reach Youtube's link. Probably I get a timeout. Try again."
}
otLog "$data"
putserv "PRIVMSG $chan :$data"
utimer $ourtube(rest) [list set ourtube(protection) ""]
}
}
proc otGet {web {relocation ""}} {
global ourtube
set token [http::geturl $web -timeout 4000]
upvar #0 $token state
set lastcode $state(http)
regexp {[0-9]{3}} $lastcode ncode
if {$ncode eq ""} {
set ncode $lastcode
}
switch -- $ncode {
"200" {
}
"302" {
foreach {flag value} $state(meta) {
if {$flag eq "Location"} {
# Due to invalid youtube link but valid url syntax we can
# receive an url forward. this handles that
http::cleanup $token
otLog "$web forwards us to $value"
return [otGet $value "(Relocated)"]
}
}
}
"303" {
otLog "This video does not exists."
http::cleanup $token
return "That video does not exists. Server responded: $lastcode"
}
"404" {
otLog "$web - No such webpage."
http::cleanup $token
return "$web - No such webpage"
}
default {
http::cleanup $token
otLog "unforeseen circumstances. Server responded: $lastcode"
return "unforeseen circumstances. Server responded: $lastcode"
}
}
set data [string map {""\;" "\"" "&\;quot\;" "\"" "&" "&"} $state(body)]
http::cleanup $token
set author ""
set description ""
set views ""
set rating ""
regexp {<title>(.*?)</title>} $data "" title
regexp {class="hLink fn n contributor">(.*?)</a><br>} $data "" author
regexp {<meta name=\"description\" content=\"(.*?)\">.*} $data "" description
regexp {<span id=\"watch-view-count\">(.*?)</span>} $data "" views
regexp {<div id=\"defaultRatingMessage\">(.*?)</span>.*} $data "" rating
# This is not so smart way. I know, sorry about :)
set comments ""
set description ""
regexp {<div id="recent_comments" class="comments">(.*?)<div id="div_comment_form_id} $data "" comments
if {$comments ne ""} {
regexp { rel="nofollow">(.*?)</a>} $comments "" user
regexp {<span class="watch-comment-time">(.*?)</span>} $comments "" timeago
regexp {<div class="watch-comment-body">(.*?)</div>} $comments "" comment
set comment [string map {\n " " "<br>" ""} $comment]
regsub -all -- {\<[^\>]*\>|\t} $comment "" comment
regsub -all {\s+} $comment " " comment
set comment "\<$user [string trim $timeago]\> [string trim $comment]"
} else {
set comment ""
}
regsub -all -- {\<[^\>]*\>|\t} $title "" title
regsub -all -- {\<[^\>]*\>|\t} $description "" description
regsub -all -- {\<[^\>]*\>|\t} $views "" views
regsub -all -- {\<[^\>]*\>|\t} $rating "" rating
set rating [lindex [split $rating] 0]
set title "$relocation $title"
set title [string trim $title]
if {![string is digit -strict $views]} {
set views "no"
}
if {![string is digit -strict $rating]} {
set rating "no"
}
if {$comment eq ""} {
set comment "This video doesn't have any comments until now"
}
if {$description eq ""} {
set description "This video doesn't have any description"
}
set output [string map [list "<title>" $title "<author>" $author "<description>" $description "<views>" $views "<rating>" $rating "<comment>" $comment] $ourtube(output)]
return $output
}
# upvar #0 $token state
proc otLog {arg} {
global ourtube
putlog "$ourtube(projectName): $arg"
}
otLog "$ourtube(fileName) $ourtube(version) Loaded - by $ourtube(author)"