débugger un TCL

[zyrte]

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.

[lesny]

bonjour / bonsoir

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

http://www.eggdrop.fr/board/downloads.ph...iew&did=43

de plus

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

[zyrte]

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....

[aliasangelius]

Salut,

Genre ça ? :

tclcopier

#
# 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)"

[zyrte]

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.

[aliasangelius]

bah debug le alors.

[zyrte]

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.

[CrazyCat]

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 /

tclcopier

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