youtube script

[JazZ]

Salut,

J'viens vous présenter Zurl-0.01.tcl. Ce script fusionne la fonctionnalité d'un urltitle et d'un youtubetitle.

Les derniers posts de ce topic m'ont servi à personnaliser ce script. Les liens vers les sources sont dans la description. C'est le fruit de votre travail. = )

J'suis encore très novice et je n'ai fait qu'adapter les scripts à mes besoins en recherchant des codes simples et légés. Il y a encore quelques bugs que je n'arrive pas à corriger comme:
- La traduction des urls https pour le urltitle (ceux de youtube sont traduits mais pas toutes les autres)
- Empêcher le flood de la PL par le proc [mu] de youtitle (cela vient de la ligne
"set youtubeid "/watch?v=$youtubeid".

A part ça, le script est fonctionnel.

tclcopier

###############
#    Zurl     #
###############

############### Zurl.tcl is based on two grabbers urls titles scripts: 
############### -The first one is a classic grabber who describe all (or most) of urls.
############### (http://forum.eggdrop.fr/Titre-des-urls-diffusees-t-1331.html)
############### - The second one is a youtube grabber. 
############### (http://forum.eggdrop.fr/youtube-tiltle-t-1393.html)

############### So, the youtube (with rating, views, etc) and the classic grabber on 
############### the same script was the point. Hope it'll be usefull.

############### JazZ (jazz@epiknet.org)

 
############### Easy to use; you only need to add the Zurl.tcl file to ../scripts/, 
############### add the source path to the script in the eggdrop.conf and enjoy. 
 
set Zurlversion "0.01"

############### Packages & binding ############### 
 
package require http
package require uri
 
bind PUBM - "*?://*?" check_url
bind PUBM - * mu

############### Proc "classic" ############### 
 
proc check_url {nick uhost handle chan text} {
   if {[regexp -- {([a-z0-9\-]+\://[a-z0-9\-]+\.[a-z0-9\-\.]+(?:/|(?:/[a-zA-Z0-9!#\$%&'\*\+,\-\.:;=\?@\[\]_~]+)*))} $text match url]} {
   set url [string map -nocase { "&" "&" } $url]
      set token [geturl $url]
      set html_data [::http::data $token]
      ::http::cleanup $token
      regexp -all -nocase -- "<title>(.*)</title>" $html_data match title
	if {![string match -nocase "*?/watch?v=*?" $url] && ![string match -nocase "*?://youtu.be*?" $url]} {   ;# than the classic grabber doesn't work on youtube's urls
 
                  putserv "PRIVMSG $chan :.:\[\002URL\002\]:. | $title | "

############### Uncomment the following lines to save titles, urls and linkers in your ../eggdrop/classics file 
############### (classics will be automatically create)   	
	
# set bc [open classics a] 
# set classics ".:\[$a\] \($web(page)$youtubeid\) by \[$nick\]:." 
# puts $bc classics 
# close $bc
      }   
   }
   return 0
}
 
proc geturl {url args} {
    array set URI [::uri::split $url];
    while {1} {
       set token [eval [list http::geturl $url] $args]
       if {![string match {30[1237]} [::http::ncode $token]]} {return $token}
       array set meta [set ${token}(meta)]
       if {![info exist meta(Location)]} {
            return $token
       }
       array set uri [::uri::split $meta(Location)]
       unset meta
       if {$uri(host) == ""} { set uri(host) $URI(host) }
       set url [eval ::uri::join [array get uri]]
    }
}

############### Proc Youtube ############### 
 
proc mu {nick uhost hand chan text} {
   set web(page) http://www.youtube.com
   set watch [regexp -nocase -- {\/watch\?v\=([^\s]{11})} $text youtubeid]
   if { $watch == 0 } {
      set watch [regexp -nocase -- {youtu\.be\/([^\s]{11})} $text a youtubeid]
 
      set youtubeid "/watch?v=$youtubeid" ;# the way this line was write is good but sends mistakes in PL. You can try with {} or something, 
                                       ;# it won't get urls from youtube like https or youtu.be anymore. If you find a solution, 
                                       ;# share your tips. By the way, it's almost perfect the way it is.   
   }
 
   if {$watch && $youtubeid != ""} {
      putlog "$web(page)$youtubeid"
      set agent "Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.9.0.1) Gecko/2008070208 Firefox/3.0.1"   
      set t [::http::config -useragent $agent]
      set t [::http::geturl "$web(page)$youtubeid" -timeout 30000]
      set data [::http::data $t]
      ::http::cleanup $t
 
      set l [regexp -all -inline -- {<meta name="title" content="(.*?)">.*?<span class="watch-view-count " >(.*?)</span>.*?<span class="likes-count">(.*?)</span>.*?\
<span class="dislikes-count">(.*?)</span>} $data] 
 
 
	regexp {"length_seconds": (\d+),} $data "" length
 
      foreach {black a b c d e} $l {
 
         set a [string map -nocase {\&\#39; \x27 &amp; \x26 &quot; \x22} $a]
         set b [string map [list \n ""] $b]
         set c [string map [list \n ""] $c]
         set d [string map [list \n ""] $d]
         set e [string map -nocase {\&\#39; \x27 &amp; \x26 &quot; \x22} $e]
 
         regsub -all {<.*?>} $a {} a
         regsub -all {<.*?>} $b {} b
         regsub -all {<.*?>} $c {} c
         regsub -all {<.*?>} $d {} d
         regsub -all {<.*?>} $e {} e         
 
	 set b [string trim $b] ;# Some scotch to keep view at the right place
 
	proc duration {s} {
            variable etube
            set hours [expr {$s / 3600}]
            set minutes [expr {($s / 60) % 60}]
            set seconds [expr {$s % 60}]
            set res ""
 
            if {$hours != 0} {append res "$hours hrs "}            
            if {$minutes != 0} {append res "$minutes\min "}
            if {$seconds != 0} {append res "$seconds\sec"}
            return $res
         }   
 
         putserv "PRIVMSG $chan :.:\[\002YouTube\002\]:. | $a | [duration $length] | $b vues | + $c / - $d | " 

############### Uncomment the following lines to save titles, urls and linkers in the ../eggdrop/backlistube file 
############### (backlistube will be automatically create)   	
	
# set mt [open backlistube a] 
# set backlistube ".:\[$a\] \($web(page)$youtubeid\) by \[$nick\]:." 
# puts $mt $backlistube 
# close $mt     
      }
   }
}
 
putlog "\0033Zurl-$Zurlversion.tcl\003 loaded"

J'attends vos conseilles et critiques.

Enjoy guys.

--
JazZ