#
# ourTube.tcl 1.0.2 --
# 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 15-november-2009
# HackeMate (Sentencia) Sentencia@eggdrop.es
# RedRum (Redrum) redrum@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 1.0.2:
# (RedRrum)
# Fixes:
# Resolved Tcl error [otPub]: wrong # args: should be "otLog target string"
# Resolved broken line in the actual youtube html title format (new regsub)
#
# Changes:
# Changed description Youtube match.
# Modify otPub function(minor cost):
# - Regular expresion by exact uri.
# - Break before nothing else if not youtube link.
# Added features:
# Added category Youtube match.
# AntiSpam on Results: spliting URIs on points.
# Added dirty link search
#
# TODO:
# Add related links match.
# Move HTTP errors to logs only or disable them.
# Changelog 1.0.1:
# (HackeMate)
# 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
#
# -*- IMPORTANT -*-
# Auto Update checker: You can verify if your ourTube copy is the lastest
# version available typing .ourtube update in partyline
#
# FeedBack feature. Type in partyline .ourtube feedback [your email] <message>
# to send the author any suggestion or comment. Insults are not welcome.
#
# Added seacher, !youtube string and it will return matches
# it is customizable (configure ourtube(outputsearch))
# initializes a user defined channel flag
setudef flag ourtube
setudef flag ourtubecolors
global ourtube tcl_platform
## START EDITALE ZONE ##
########################
# (1) Enable or (0) disable logs.
set ourtube(logs) 1
# (1-8) Level log. It use the reserved user level logs.
set ourtube(levellog) 1
# (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(flood) 10
# What language you can receive the youTube data? (if works heh)
set ourtube(lang) es
# Limit of links at same time
set ourtube(max) 5
# Do you want see all matches at one line? (0) Yes (1) No
set ourtube(multiline) 1
# Do you want match for dirty links? (1) Yes (0) No
set ourtube(dirtysearch) 1
# 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.
# <category> category information.
# <link> clear link
#set ourtube(output) "\002<title>\002. (by <author>) <views> views, <rating> rating. Last comment: <comment>"
set ourtube(output) "<link> -> \002<title> (<category>)\002"
# - <description>"
# This is the output message of search engine
# -*- This is only for search engine
# You can configure all fields that your eggdrop will show.
# <link> URL video link
# <time> video's duration
# <added> since when it is on line
# <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
set ourtube(outputsearch) "\00312\037<link>\003\037 \00315\(<time> rating: <rating>\)\003 \"\0036<title> \0031<author> said\0036: <description>\003\" <views>, added <added>"
# Do you want auto update this file when it is possible?
# (1) Yes (0) No - It is recommended, if youtube changes his tags probably this script will broke
set ourtube(autoupdate) 0
## END EDITABLE ZONE #############
##################################
# This is not required to edit, or yes.
set ourtube(author) "HackeMate, RedRum"
set ourtube(contact) "HackeMate <Sentencia@eggdrop.es>"
set ourtube(name) "ourTube"
set ourtube(fileName) [info script]
set ourtube(projectName) "ourTube"
set ourtube(version) "1.0.2"
set ourtube(package.http) [package require http]
## No inicializar (uso interno)
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
# Clean all colour marks
regsub -all -- {\017|\002|\037|\026|\003(\d{1,2})?(,\d{1,2})?} $text "" text
if {$ourtube(dirtysearch)} {
set id [regexp -inline -nocase -- {youtube.*watch\?v=.{11}} $text]
regsub -nocase -- {.*watch\?v=} $id "" id
if {$id eq ""} { return }
set uri "http://www.youtube.com/watch?v=$id"
} else {
set uri [regexp -inline -nocase -- {http://www\.youtube\.com/watch\?v=.{11}} $text]
if {$uri eq ""} { return }
}
if {[string is digit -strict $ourtube(protection)]} {
set flood [expr [clock seconds]-$ourtube(protection)]
if {$flood >= $ourtube(flood)} {
set ourtube(protection) ""
} else {
otLog log "Resting... (flood protection) [duration [expr ($ourtube(flood) - [expr ([clock seconds]-$ourtube(protection))])]] left"
return
}
}
set ourtube(protection) [clock seconds]
otLog log "Getting $uri ... from $nick on $chan"
set data [otGet $uri]
##pasar a otGet
if {![string length $data]} {
set data "I was not able to reach $uri. Probably I get a timeout. Try again."
}
if {!$ourtube(colors)} {
regsub -all -- {\017|\002|\037|\026|\003(\d{1,2})?(,\d{1,2})?} $data "" data
}
# Este formato de log facilita el paso a xml para posterior posible procesado.
otLog log "$chan:$nick:$uri:$data"
putserv "PRIVMSG $chan :$data"
utimer $ourtube(flood) [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 ""
set ncode [regexp -inline -- {[0-9]{3}} $lastcode]
# 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
# Title
regexp {<title>(.*?)</title>} $data "" title
regsub -all -- {\<[^\>]*\>|\t|\n|YouTube} $title "" title
regsub -all -- {^- } $title "" title
regsub -all -- {( *)\.( *)} $title ". " title
set title "$relocation $title"
set title [string trim $title]
# Author
set author ""
regexp {class="hLink fn n contributor">(.*?)</a><br>} $data "" author
# Views
set views ""
regexp {<span id=\"watch-view-count\">(.*?)</span>} $data "" views
regsub -all -- {\<[^\>]*\>|\t} $views "" views
if {![string is digit -strict $views]} {
set views "no"
}
# Rating
set rating ""
regexp {<div id=\"defaultRatingMessage\">(.*?)</span>.*} $data "" rating
regsub -all -- {\<[^\>]*\>|\t} $rating "" rating
set rating [lindex [split $rating] 0]
if {![string is digit -strict $rating]} {
set rating "no"
}
# Description
set description ""
regexp {class="watch-video-desc description">(.*?)</div>} $data "" description
regsub -all -- {<a href=(.*?)</a>} $description "" description
regsub -all -- {\<(.*?)\>} $description "" description
regsub -all -- {\n|\t} $description "" description
regsub -all -- {\. *} $description ". " description
regsub -all -- { +} $description " " description
regsub -all -- {^(- *)} $description "" description
regsub -all -- {\.*( *)$} $description "" description
set description ${description}.
# if {[string length $description] > 300} {
#
# } else {
#
# }
# if {$description eq ""} {
# set description "This video doesn't have any description"
# }
# Comment
set comments ""
set comment ""
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 ""
}
if {$comment eq ""} {
set comment "This video doesn't have any comments until now"
}
# Category
set category ""
regexp {VideoCategoryLink'\);\">(.*?)</a>} $data "" category
set output [string map [list "<title>" $title "<author>" $author "<description>" $description "<views>" $views "<rating>" $rating "<comment>" $comment "<category>" $category <link> $web] $ourtube(output)]
return $output
}
# upvar #0 $token state
proc otLog {target string} {
global ourtube
if {![validchan $target]} {
if {$ourtube(logs) == "1"} {
putloglev $ourtube(levellog) * "$ourtube(name)\: $string"
}
} else {
putserv "PRIVMSG $target :$ourtube(name)\: $string"
}
}
# This binds not work yet
bind pubm - !youtube otYoutube
proc otYoutube {nick uhost hand chan text} {
if {![channel get $chan ourtube]} {
if {$text eq "enable"} {
channel set $chan +ourtube
channel set $chan +ourtubecolors
otLog $chan "Usage: !youtube <search string> To see a list of matches."
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."
return
} else {
putserv "NOTICE $nick :$chan has this command disabled."
}
if {[matchattr $hand n]} {
putserv "NOTICE $nick :You can enable it directly typing: /msg $chan !youtube enable"
}
return
}
regsub -all -- {\017|\002|\037|\026|\003(\d{1,2})?(,\d{1,2})?} $text "" arg
global ourtube
# This is a generic protection to prevent flood ourtube.com
# No utimer required
if {![info exists ourtube(protection)]} {
set ourtube(protection) [clock seconds]
} else {
if {![string is digit -strict $ourtube(protection)]} {
set ourtube(protection) [clock seconds]
} else {
set time [expr [clock seconds]-$ourtube(protection)]
if {$time >= $ourtube(flood)} {
set ourtube(protection) [clock seconds]
} else {
otLog log "Flood protection in $chan from $nick\."
return
}
}
}
if {$arg eq ""} {
putserv "NOTICE $nick :Tell me what to search."
return
}
set data [ourtubeGet $arg]
if {![channel get $chan ourtubecolors]} {
regsub -all -- {\017|\002|\037|\026|\003(\d{1,2})?(,\d{1,2})?} $data "" data
}
if {[string length $data] == 0} {
set data "I was unable to connect to that website. Probably I get timeout."
return
}
if {$ourtube(multiline) != "1"} {
putserv "PRIVMSG $chan :$data"
} else {
foreach line $data {
putserv "PRIVMSG $chan :$line"
}
}
}
proc ourtubeGet {ask} {
global ourtube
regsub -all -- {\s+} $ask " " search
set search [http::formatQuery $search]
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"
set token [http::geturl http://www.youtube.com/results?search_query=$search -timeout 10000]
upvar #0 $token state
set data $state(body)
regsub -all {\n|\t} $data "" data
set ncode ""
regexp {[0-9]{3}} $state(http) ncode
if {$ncode eq ""} {
set ncode $state(http)
}
set list {}
switch -- $ncode {
"200" {
set videos [regexp -all -inline {<div class="video-entry">(.*?)<div class="video-clear-list-left"></div>} $data]
set total [expr [llength $videos] /2]
if {$total > $ourtube(max)} {
set list [list "Showing $ourtube(max) of $total."]
}
set i 2
set title ""
set description ""
set rating ""
set added ""
set views ""
set author ""
set link ""
foreach {id line} $videos {
set map {}
foreach {entity number} [regexp -all -inline {&#(\d+);} $line] {
lappend map $entity [format \\u%04x [scan $number %d]]
}
set line [string map [subst -nocomm -novar $map] $line]
regexp {<img title="(.*?)"} $line "" title
regsub -all -- {\<[^\>]*\>|\t} $title "" title
regexp {<div class="video-time">(.*?)</span>} $line "" time
regsub -all -- {\<[^\>]*\>|\t} $time "" time
regexp {class="video-description">(.*?)</div>} $line "" description
regsub -all -- {\<[^\>]*\>|\t} $description "" description
regexp {<button class="master-sprite ratingVS ratingVS-(.*?)"} $line "" rating
regexp {class="video-date-added">(.*?)</span>} $line "" added
regexp {class="video-view-count">(.*?)</span>} $line "" views
regexp {<span class="video-username">(.*?)</a>} $line "" author
regsub -all -- {\<[^\>]*\>|\t} $author "" author
regexp {<a id="video-url-(.*?)"} $line "" link
set link "http://youtube.com/watch?v=$link"
set output [string map [list "<link>" $link "<time>" $time "<added>" $added "<title>" $title "<author>" $author "<description>" $description "<views>" $views "<rating>" $rating] $ourtube(outputsearch)]
lappend list $output
if {$i > $ourtube(max)} {
break
}
incr i
}
return $list
}
"404" {
otLog log "No such file or webpage."
http::cleanup $token
return [list "No such file or webpage."]
}
default {
otLog log "unforeseen circumstance. Server responded: $ncode"
http::cleanup $token
return [list "unforeseen circumstance. Server responded: $ncode"]
}
}
}
bind dcc n ourtube communication::welcome
namespace eval communication {
# communication.tcl --
# This is a little library for eggdrop as internal use
# It is done to portablility - You cannot use it without a file.cgi in your
# http server. If you really want that, contact me.
variable version 1.0
variable feedback {http://www.eggdrop.es/cgi-bin/feedback.cgi}
variable update {http://www.eggdrop.es/cgi-bin/update.cgi}
proc welcome {hand ipx text} {
global ourtube
set arg [lindex [split $text] 0]
switch -- $arg {
"feedback" {
set contact [lindex [split $text] 1]
set message [join [lrange [split $text] 1 end]]
if {($contact eq "") || ($message eq "")} {
putdcc $ipx "$ourtube(projectName) - FeedBack"
putdcc $ipx "Thank you for tell what you think."
putdcc $ipx "This command sends to author an message with your suggestion, you are able to send one feedback per day (aprox)"
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>"
} else {
set result [[namespace current]::Feedback $contact $ourtube(projectName) $message]
if {$result eq ""} {
putdcc $ipx "The server responded nothing. Did you sent a previous feedback already?"
return
}
putdcc $ipx "The server responded:"
foreach line [split $result \n] {
putdcc $ipx $line
}
}
}
"update" {
set download [lindex [split $text] 1]
putdcc $ipx [join [lrange [split [[namespace current]::Update $ourtube(fileName) $ourtube(projectName) $ourtube(version) $download]] 1 end]]
}
default {
putdcc $ipx "You can use '.ourtube update' to verify the last version and '.ourtube feedback' to send to author a suggestion"
}
}
}
proc Feedback {reporter projectName message} {
variable feedback
http::config -useragent "$reporter $projectName"
set token [http::geturl "$feedback\?suggest=[http::formatQuery $message]" -timeout 4000]
set data [http::data $token]
http::cleanup $token
return $data
}
proc Update {fileName projectName version {download ""}} {
variable update
set fs [open $fileName]
set data [read $fs]
close $fs
set md5 [md5 $data]
set query [http::formatQuery project $projectName version $version md5 $md5 download $download]
set token [http::geturl "$update\?$query" -timeout 4000]
set data [http::data $token]
http::cleanup $token
set result ""
set info ""
set url ""
regexp {<!-- result -->(.*?)<!-- /result -->} $data "" result
regexp {<!-- info -->(.*?)<!-- /info -->} $data "" info
if {($download ne "") && ($download ne "no") && ($result == 1)} {
regexp {<!-- data -->(.*?)<!-- /data -->} $data "" url
if {![regexp -nocase {^(http://)?([^/:]+)(:([0-9]+))?(/.*)?$} $url]} {
return "0 Invalid URL target file link."
}
set token [http::geturl $url -binary 1 -timeout 4000]
set fileData [http::data $token]
file rename -force -- $fileName $fileName\.bak
set fs [open $fileName w]
puts -nonewline $fs $fileData
close $fs
catch {source $fileName}
set info "$projectName was (purged) downloaded and sourced succesfully, now you are using the lastest version available. There is a backup in $fileName\.bak"
}
return "$result $info"
}
}
if {![info exists ourtube(loaded)]} {
if {$ourtube(autoupdate) == "1"} {
set ourtube(status) [communication::Update $ourtube(fileName) $ourtube(projectName) $ourtube(version) $ourtube(autoupdate)]
set ourtube(result) [lindex [split $ourtube(status)] 0]
set ourtube(info) [join [lrange [split $ourtube(status)] 1 end]]
otLog log $ourtube(info)
}
}
otLog log "[file tail $ourtube(fileName)] $ourtube(version) Loaded - by $ourtube(author) (Feedback and update commands available, type .ourtube in partyline)"
set ourtube(loaded) 1
