| View previous topic :: View next topic |
| Author |
Message |
ZzozZ
Voice
Joined: 13 Nov 2010
Posts: 10
|
 Posted: Mon Oct 15, 2012 7:20 pm Post subject: Youtube title TCL problem, help. |
 |
|
| Code: | ###############################################################################
# Name: Youtube Title
# Author: jotham.read@gmail.com
# Credits: tinyurl proc taken from
# tinyurl.tcl by jer@usa.com.
# design inspiration from
# youtube.tcl by Mookie.
# Eggdrop Version: 1.6.x
# TCL version 8.1.1 or newer http://wiki.tcl.tk/450
#
# Changes:
# 0.5 01/02/09
# Added better error reporting for restricted youtube content.
# 0.4 10/11/09
# Changed title scraping method to use the oembed api.
# Added crude JSON decoder library.
# 0.3 02/03/09
# Fixed entity decoding problems in return titles.
# Added customisable response format.
# Fixed rare query string bug.
###############################################################################
#
# Configuration
#
###############################################################################
# Maximum time to wait for youtube to respond
set youtube(timeout) "30000"
# Youtube oembed location to use as source for title queries. It is best to use
# nearest youtube location to you. For example http://uk.youtube.com/oembed
set youtube(oembed_location) "http://www.youtube.com/"
# Use tinyurl service to create short version of youtube URL. Values can be
# 0 for off and 1 for on.
set youtube(tiny_url) 0
# Response Format
# %botnick% Nickname of bot
# %post_nickname% Nickname of person who posted youtube link
# %title% Title of youtube link
# %youtube_url% URL of youtube link
# %tinyurl% Tiny URL for youtube link. tiny_url needs to be set above.
# Example:
# set youtube(response_format) "\"%title%\" ( %tinyurl% )"
set youtube(response_format) "Youtube Title: \"%title%\""
# Bind syntax, alter as suits your needs
bind pubm - * public_youtube
# Pattern used to patch youtube links in channel public text
set youtube(pattern) {http://.*youtube.*/watch\?(.*)v=([A-Za-z0-9_\-]+)}
# This is just used to avoid recursive loops and can be ignored.
set youtube(maximum_redirects) 2
# The maximum number of characters from a youtube title to print
set youtube(maximum_title_length) 256
###############################################################################
package require http
set gTheScriptVersion "0.5"
proc note {msg} {
putlog "% $msg"
}
###############################################################################
proc make_tinyurl {url} {
if {[info exists url] && [string length $url]} {
if {[regexp {http://tinyurl\.com/\w+} $url]} {
set http [::http::geturl $url -timeout 9000]
upvar #0 $http state ; array set meta $state(meta)
::http::cleanup $http ; return $meta(Location)
} else {
set http [::http::geturl "http://tinyurl.com/create.php" \
-query [::http::formatQuery "url" $url] -timeout 9000]
set data [split [::http::data $http] \n] ; ::http::cleanup $http
for {set index [llength $data]} {$index >= 0} {incr index -1} {
if {[regexp {href="http://tinyurl\.com/\w+"} [lindex $data $index] url]} {
return [string map { {href=} "" \" "" } $url]
}}}}
error "failed to get tiny url."
}
###############################################################################
proc flat_json_decoder {info_array_name json_blob} {
upvar 1 $info_array_name info_array
# 0 looking for key, 1 inside key, 2 looking for value, 3 inside value
set kvmode 0
set cl 0
set i 1
set length [string length $json_blob]
while { $i < $length } {
set c [string index $json_blob $i]
if { [string equal $c "\""] && [string equal $cl "\\"] == 0 } {
if { $kvmode == 0 } {
set kvmode 1
set start [expr $i + 1]
} elseif { $kvmode == 1 } {
set kvmode 2
set name [string range $json_blob $start [expr $i - 1]]
} elseif { $kvmode == 2 } {
set kvmode 3
set start [expr $i + 1]
} elseif { $kvmode == 3 } {
set kvmode 0
set info_array($name) [string range $json_blob $start [expr $i - 1]]
}
}
set cl $c
incr i 1
}
}
proc filter_title {blob} {
# Try and convert escaped unicode
set blob [subst -nocommands -novariables $blob]
set blob [string trim $blob]
set blob
}
proc extract_title {json_blob} {
global youtube
array set info_array {}
flat_json_decoder info_array $json_blob
if { [info exists info_array(title)] } {
set title [filter_title $info_array(title)]
} else {
error "Failed to find title. JSON decoding failure?"
}
if { [string length $title] > $youtube(maximum_title_length) - 1 } {
set title [string range $title 0 $youtube(maximum_title_length)]"..."
} elseif { [string length $title] == 0 } {
set title "No usable title."
}
return $title
}
###############################################################################
proc fetch_title {youtube_uri {recursion_count 0}} {
global youtube
if { $recursion_count > $youtube(maximum_redirects) } {
error "maximum recursion met."
}
set query [http::formatQuery url $youtube_uri]
set response [http::geturl "$youtube(oembed_location)?$query" -timeout $youtube(timeout)]
upvar #0 $response state
foreach {name value} $state(meta) {
if {[regexp -nocase ^location$ $name]} {
return [fetch_title $value [incr recursion_count]]
}
}
if [expr [http::ncode $response] == 401] {
error "Location contained restricted embed data."
} else {
set response_body [http::data $response]
http::cleanup $response
return [extract_title $response_body]
}
}
proc public_youtube {nick userhost handle channel args} {
global youtube botnick
if {[regexp -nocase -- $youtube(pattern) $args match fluff video_id]} {
note "Fetching title for $match."
if {[catch {set title [fetch_title $match]} error]} {
note "Failed to fetch title: $error"
} else {
set tinyurl $match
if { $youtube(tiny_url) == 1 && \
[catch {set tinyurl [make_tinyurl $match]}]} {
note "Failed to make tiny url for $match."
}
set tokens [list %botnick% $botnick %post_nickname% \
$nick %title% "$title" %youtube_url% \
"$match" %tinyurl% "$tinyurl"]
set result [string map $tokens $youtube(response_format)]
putserv "PRIVMSG $channel :$result"
}
}
}
###############################################################################
note "youtube_title$gTheScriptVersion: loaded";
|
I use this tcl, but when i try to past url starting with https:// this tcl didnt respond ....
Can you make it to work with https:// ?? |
|
| Back to top |
|
 |
doggo
Halfop
Joined: 05 Jan 2010
Posts: 97
|
| Posted: Tue Oct 16, 2012 5:51 am Post subject: |
|
|
find this in the code
| Code: | # Pattern used to patch youtube links in channel public text
set youtube(pattern) {http://.*youtube.*/watch\?(.*)v=([A-Za-z0-9_\-]+)} |
and alter to
| Code: | # Pattern used to patch youtube links in channel public text
set youtube(pattern) {http*://.*youtube.*/watch\?(.*)v=([A-Za-z0-9_\-]+)} |
_________________
NON geeky!! http://gotcode4u.com/ |
|
| Back to top |
|
|
tomekk
Master
Joined: 28 Nov 2008
Posts: 255
Location: Oswiecim / Poland
|
| Posted: Tue Oct 16, 2012 6:03 am Post subject: |
|
|
@doggo
REGEXP will work, but not the http:get.
If you want to use https you need to add TLS support and ::http::register
@ZzozZ
Do a little trick:
change:
| Code: | proc public_youtube {nick userhost handle channel args} {
global youtube botnick
if {[regexp -nocase -- $youtube(pattern) $args match fluff video_id]} {
|
to:
| Code: | proc public_youtube {nick userhost handle channel args} {
global youtube botnick
regsub -all -nocase "https" $args "http" args
if {[regexp -nocase -- $youtube(pattern) $args match fluff video_id]} { |
It should work.
I think every https*youtube link should work with http. (without secure pages like login etc.) |
|
| Back to top |
|
|
doggo
Halfop
Joined: 05 Jan 2010
Posts: 97
|
| Posted: Tue Oct 16, 2012 6:18 am Post subject: |
|
|
@tomekk
forgot the http package dont support ssl, i use this script i wrote for youtube.. works with all variations of youtube urls  also saves the embeded code urls to a file so you could display them via a webpage 
looks like this in channel..
and the webpage you could make.. http://goo.gl/TQN9G
| Code: |
bind pubm -|- "% *http*://*youtube.com*" nzbm:youtube:match
bind pubm -|- "% *http*://*youtu.be*" nzbm:youtube:match
setudef flag saveyt
proc nzbm:youtube:match {nick uhost hand chan text} {
if {[channel get $chan saveyt] == 1 } {
if {[regexp -nocase {http://*youtube.com/watch\?(.*)v=([A-Za-z0-9_\-]+)} $text match fluff youtubeid]} {
} elseif {[regexp -nocase {https://*youtube.com/watch\?(.*)v=([A-Za-z0-9_\-]+)} $text match fluff youtubeid]} {
} elseif {[regexp -nocase {https://*youtu.be/([A-Za-z0-9_\-]+)} $text match youtubeid]} {
} elseif {[regexp -nocase {http://*youtu.be/([A-Za-z0-9_\-]+)} $text match youtubeid]} {
} else { return }
set youtube_query "http://www.youtube.com/oembed?url=http%3A%2F%2Fwww.youtube.com%2Fwatch%3Fv%3D$youtubeid&format=xml"
set youtube_save "http://www.youtube.com/embed/$youtubeid"
::http::config -useragent "Mozilla/5.0 (X11; U; Linux i686; ru-RU; rv:1.8.1) Gecko/2006101023 Firefox/2.0"
set url [::http::geturl $youtube_query -timeout 5000]
set html [::http::data $url]
::http::cleanup $html
regexp -nocase {<title>(.*?)</title>} $html match title
set title [nzbm:html:decode $title]
if {$title==0} {return}
set logo "\002\0031,00 You\0031,00 \00300,04 Tube \00300,04\003\002\00314"
putserv "privmsg $chan :$logo \"$title\""
set file [open text/youtube.db r]
set data [read $file]
close $file
set isdupe 0
foreach line [split $data \n] {
if { [string match -nocase "*$youtube_save*" "$line"] == 1 } {
catch {unset data}
set isdupe 1
}
}
if {$isdupe == 1} { return } else {
set fp [open text/youtube.db "a"]
puts $fp $youtube_save
close $fp
}
}
}
proc nzbm:html:decode {content} {
if {$content == ""} {
return 0;
}
if {![string match *&* $content]} {
return $content;
}
set escapes {
\x20 " \x22 & \x26 ' \x27 – \x2D
< \x3C > \x3E ˜ \x7E € \x80 ¡ \xA1
¢ \xA2 £ \xA3 ¤ \xA4 ¥ \xA5 ¦ \xA6
§ \xA7 ¨ \xA8 © \xA9 ª \xAA « \xAB
¬ \xAC ­ \xAD ® \xAE &hibar; \xAF ° \xB0
± \xB1 ² \xB2 ³ \xB3 ´ \xB4 µ \xB5
¶ \xB6 · \xB7 ¸ \xB8 ¹ \xB9 º \xBA
» \xBB ¼ \xBC ½ \xBD ¾ \xBE ¿ \xBF
À \xC0 Á \xC1 Â \xC2 Ã \xC3 Ä \xC4
Å \xC5 Æ \xC6 Ç \xC7 È \xC8 É \xC9
Ê \xCA Ë \xCB Ì \xCC Í \xCD Î \xCE
Ï \xCF Ð \xD0 Ñ \xD1 Ò \xD2 Ó \xD3
Ô \xD4 Õ \xD5 Ö \xD6 × \xD7 Ø \xD8
Ù \xD9 Ú \xDA Û \xDB Ü \xDC Ý \xDD
Þ \xDE ß \xDF à \xE0 á \xE1 â \xE2
ã \xE3 ä \xE4 å \xE5 æ \xE6 ç \xE7
è \xE8 é \xE9 ê \xEA ë \xEB ì \xEC
í \xED î \xEE ï \xEF ð \xF0 ñ \xF1
ò \xF2 ó \xF3 ô \xF4 õ \xF5 ö \xF6
÷ \xF7 ø \xF8 ù \xF9 ú \xFA û \xFB
ü \xFC ý \xFD þ \xFE ÿ \xFF
};
set content [string map $escapes $content];
set content [string map [list "\]" "\\\]" "\[" "\\\[" "\$" "\\\$" "\\" "\\\\"] $content];
regsub -all -- {&#([[:digit:]]{1,5});} $content {[format %c [string trimleft "\1" "0"]]} content;
regsub -all -- {&#x([[:xdigit:]]{1,4});} $content {[format %c [scan "\1" %x]]} content;
regsub -all -- {&#?[[:alnum:]]{2,7};} $content "?" content;
return [subst $content];
}
|
_________________
NON geeky!! http://gotcode4u.com/
Last edited by doggo on Sat Oct 20, 2012 6:05 pm; edited 1 time in total |
|
| Back to top |
|
|
ZzozZ
Voice
Joined: 13 Nov 2010
Posts: 10
|
| Posted: Fri Oct 19, 2012 6:56 pm Post subject: |
|
|
when i try your script i see this message | Code: | | <ZzozZ> [01:54:40] Tcl error [nzbm:youtube:match]: Unknown channel setting. |
in dcc chat. |
|
| Back to top |
|
|
heartbroken
Op
Joined: 23 Jun 2011
Posts: 106
Location: somewhere out there
|
| Posted: Fri Oct 19, 2012 7:19 pm Post subject: |
|
|
i guess need to add a line on the top of the code like :
| Code: | | setudef flag saveyt |
_________________
Life iS Just a dReaM oN tHE wAy to DeaTh |
|
| Back to top |
|
|
doggo
Halfop
Joined: 05 Jan 2010
Posts: 97
|
| Posted: Sat Oct 20, 2012 6:07 pm Post subject: |
|
|
yep.. edited script i pasted above
reload the script and do
| Code: | | .chanset #chan +savety |
from the partyline
_________________
NON geeky!! http://gotcode4u.com/ |
|
| Back to top |
|
|
ZzozZ
Voice
Joined: 13 Nov 2010
Posts: 10
|
| Posted: Mon Oct 22, 2012 8:13 am Post subject: |
|
|
I copy code and write .chanset #Games +saveyt but isn't work :/
----------------------------------------
I was forgot to add http.tcl, but now when i write
www.youtube.com/watch?v=PLrB0PDmsFw isnt worck :/
Now worck only with:
http://youtube.com/watch?v=PLrB0PDmsFw
https://youtube.com/watch?v=PLrB0PDmsFw
and when i write working link i see | Code: |
[03:25] <ZzozZ> [15:25:28] Tcl error [nzbm:youtube:match]: couldn't open "text/youtube.db": no such file or directory |
in the partyline :/
I create folder text and file youtube.db in text folder, but i see same message :/
---Edit-----------------------------------------------------
The code on this post works purfect |
|
| Back to top |
|
|
|
FAQ
Search
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
