17/09/2011, 10:37
Salut Cain tien j'en et trouver un :
tcl
# ourTube.tcl 1.0.2010 - v.DNS777 -
# 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:
# Fixed showin views proper, some minimal fixes, and cutted out autoupdate, feedback feature and search (((DNS777)))
# Resolved Tcl error [otPub]: can't read "views": no such variable (((? this was not fixed dude!)))
# 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
# -*- IMPORTANT -*-
# Auto Update checker: You can verify if your ourTube copy is the lastest
# version available typing .ourtube update in partyline (((? killed, DNS777)))
#
# FeedBack feature. Type in partyline .ourtube feedback [your email] <message>
# to send the author any suggestion or comment. Insults are not welcome. (((? killed, DNS777)))
#
# Added seacher, !youtube string and it will return matches
# it is customizable (configure ourtube(outputsearch)) (((? killed, we have another !youtube trigger, DNS777)))
setudef flag ourtube
setudef flag ourtubecolors
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.
# -*- This is not for search command (only when someone pasted link)
# 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.
# <uploaded> Date of upload.
set ourtube(output) "\002YouTube Video\002: <title> | \002Views\002: <views> | \002Ratings\002: <rating> | \002Uploader\002: <author> | \002Uploaded\002: <uploaded> | \002Last comment\002: \0032<comment>\003"
# This is not required to edit, or yes.
set ourtube(author) "HackeMate (& DNS)"
set ourtube(name) "ourTube"
set ourtube(version) "1.0.2010"
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 -- {\017|\002|\037|\026|\003(\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 log "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 log "Getting $webTarget ... from $nick on $chan"
set data [otGet $webTarget]
if {!$ourtube(colors)} {
regsub -all -- {\017|\002|\037|\026|\003(\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 log "$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)
set ncode ""
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 log "$web forwards us to $value"
return [otGet $value "(Relocated)"]
}
}
}
"303" {
otLog log "This video does not exists."
http::cleanup $token
return "That video does not exists. Server responded: $lastcode"
}
"404" {
otLog log "$web - No such webpage."
http::cleanup $token
return "$web - No such webpage"
}
default {
http::cleanup $token
otLog log "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 ""
set uploaded ""
#regexp {<title>(.*)</title>} $data "" title
regexp {<meta name=\"title\" content=\"(.*?)\">.*} $data "" title
regexp {class="hLink fn n contributor">(.*?)</a><br>} $data "" author
regexp {<meta name=\"description\" content=\">(.*?)\">.*} $data "" description
regexp {<div id=\"defaultRatingMessage\">(.*?)</span>.*} $data "" rating
regexp {<span class=\"watch-video-added post-date\">(.*?)</span><br>} $data "" uploaded
if {![regexp {<span id=\"watch-view-count\">(.*?)</span>} $data "" views]} { set views "no" }
# 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 [string map {"\n" " "} $title]
set title "$relocation $title"
set title [string trim $title]
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 "<uploaded>" $uploaded "<comment>" $comment] $ourtube(output)]
return $output
}
# upvar #0 $token state
proc otLog {target string} {
global ourtube
if {![validchan $target]} {
putlog "$ourtube(name)\: $string"
} else {
putserv "PRIVMSG $target :$ourtube(name)\: $string"
}
}
otLog log "$ourtube(version) Loaded - by $ourtube(author)"
set ourtube(loaded) 1