Communauté sur les Eggdrops - Community about Eggdrops
débugger un TCL - Printable Version

+- Communauté sur les Eggdrops - Community about Eggdrops (https://forum.eggdrop.fr)
+-- Forum: Eggdrop et TCL (https://forum.eggdrop.fr/forumdisplay.php?fid=8)
+--- Forum: Scripts TCL (https://forum.eggdrop.fr/forumdisplay.php?fid=4)
+--- Thread: débugger un TCL (/showthread.php?tid=1070)



débugger un TCL - zyrte - 13/11/2011

hello, j'ai trouvé ceci, mais il ne marche pas, si quelqu'un peux le débugger, ca serait cool... Je le met en piéce jointe.


RE: débugger un TCL - lesny - 13/11/2011

bonjour / bonsoir

tu le retrouve ici moi je l'utilise et il fonctionne

http://www.eggdrop.fr/board/downloads.php?action=view&did=43

de plus

http://www.eggdrop.fr/board/Aidez-nous-a-vous-aider-t-112.html


RE: débugger un TCL - zyrte - 13/11/2011

Non, c'est pas la même, il donne pas le nombre de vues...aucune erreur en pl.. Sinon, j'aurais pris celui de Mookie.
Si une personne peux faire ce TCL Fonctionnel, merci....


RE: débugger un TCL - aliasangelius - 13/11/2011

Salut,

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\;" "\"" "&amp\;quot\;" "\"" "&amp;" "&"} $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)"




RE: débugger un TCL - zyrte - 13/11/2011

non je l'avais vu aussi celui là, mais c'est celui que j'ai uploader que j'voudrais de fonctionnel et non pas un autre tcl.


RE: débugger un TCL - aliasangelius - 13/11/2011

bah debug le alors.


RE: débugger un TCL - zyrte - 13/11/2011

Si j'demande de l'aide pour débugger un tcl, c'est que je sais pas faire moi-même et que peut-être des personnes arriveront a le debeugger.


RE: débugger un TCL - CrazyCat - 14/11/2011

L'erreur est dans l'url générée qui comporte deux // (par exemple http://www.youtube.com//watch?v=Ts2DXY0zfLs)
Correction hyper simple: corriger l'url de base de youtube en supprimant le dernier /

tcl
set web(page) "http://www.youtube.com"