命令名称无效“”

时间:2017-06-16 15:15:20

标签: tcl eggdrop

我无法让此脚本接受例如https://youtu.be/HPP0yB-_blAhttps://www.youtube.com/watch?v=HPP0yB-_blA虽然有效。第一个示例只是invalid command name ""

# URL title parse script for Eggdrop.
#
# Based on https://github.com/teeli/urltitle by teel.
#
# Version log:
#   0.11    Minor site specific tweaks.
#   0.1     First version.
#
# Usage:
#   .chanset #channelname +urltitle  ;# Enable script.

namespace eval urltitle {
    # Configuration variables.
    set delay 1  ;# Minimum number of seconds to wait between uses.
    set length 5  ;# Minimum character length of URL to trigger usage.
    set timeout 5000  ;# Geturl timeout in milliseconds (1/1000ths of a second).

    # Internal variables.
    set ignoredSites {apina.biz}  ;# Sites to ignore when parsing URLs.
    set last 1  ;# Stores time of last usage.
    set scriptVersion 0.11  ;# Script version number.

    # Binds/Hooks.
    bind pubm - "*://*" urltitle::handler
    setudef flag urltitle  ;# Channel flag to enable script.

    # Required packages.
    package require http
    package require tdom
    package require tls

    proc socket {args} {
        set opts [lrange $args 0 end-2]
        set host [lindex $args end-1]
        set port [lindex $args end]

        ::tls::socket -autoservername true {*}$opts $host $port
    }

    proc handler {nick host user chan text} {
        set time [clock seconds]
        variable delay
        variable ignoredSites
        variable last
        variable length

        if {[channel get $chan urltitle] && ($time - $delay) > $last} {
            foreach word [split $text] {
                if {[string length $word] >= $length && [regexp {^(f|ht)tp(s|)://} $word] && \
                    ![regexp {://([^/:]*:([^/]*@|\d+(/|$))|.*/\.)} $word]} {
                    foreach site $ignoredSites {
                        if {![string match *$site* $word]} {
                            set last $time

                            # Enable HTTPS support.
                            ::http::register https 443 [list urltitle::socket]
                            set title [urltitle::parse $word]

                            # Disable HTTPS support.
                            ::http::unregister https

                            # Sends text to the server, like 'putserv', but it uses a different queue intended for sending messages to channels or people.
                            puthelp "PRIVMSG $chan :$title"

                            break
                        }
                    }
                }
            }
        }
        return 1
    }

    proc parse {url} {
        set title ""
        variable timeout

        if {[info exists url] && [string length $url]} {
            if {[catch {set http [::http::geturl $url -timeout $timeout]} results]} {
                putlog "Connection to $url failed"
            } else {
                if {[::http::status $http] == "ok" } {
                    set data [::http::data $http]

                    if {[catch {set doc [dom parse -html -simple $data]} results]} {
                        # Remove HTML comments.
                        regsub -all {<!--.*?-->} $data {} data

                        # Remove everything except <head></head> content.
                        regexp -nocase {<head>.*?</head>} $data match
                        #regsub -nocase {.*?<head>} $data {} data
                        #regsub -nocase {</head>.*?} $data {} data

                        regexp -nocase {<title>(.*?)</title>} $data match title
                        #set title [regsub -all -nocase {\s+} $title " "]
                        set title [string trim $title]
                    } else {
                        set root [$doc documentElement]
                        set title [string trim [[$root selectNodes {//head/title[1]/text()}] data]]
                        $doc delete
                    }
                } else {
                    putlog "Connection to $url failed"
                }
                http::cleanup $http
            }
        }
        return $title
    }
    putlog "URL title parser v$scriptVersion"
}

有人为什么会这样?我认为问题是set title [urltitle::parse $word],但我无法做到。

1 个答案:

答案 0 :(得分:1)

问题正式出现在您未展示的代码urltitle::parse中,因为您的模式正确匹配了两个网址。确定实际上是否真实的一个好方法是尝试在交互式shell中运行一些代码。

我猜测实际问题是youtu.be网址会生成HTTP 重定向到另一个网址(或非常类似的网址); Tcl的http库不会为您处理重定向 - 它在顶部是一个更高级别的层(如果this是{{1}的来源然后我可以看到它没有做到这一点 - 而且结果导致某些东西以令人讨厌的方式窒息。

如果您只想支持这些urltitle网址,则可以在将网址传递到youtu.be之前立即使用regsub 重写

urltitle::parse

... regsub {^https?//youtu\.be/([^?/]*)$} $word {https://www.youtube.com/watch?\1} word set title [urltitle::parse $word] ... 得到了谨慎的保护,所以它不会改变它应该做的任何事情,但这种方法是不可扩展的;你不能为每个网站介绍你自己的重写规则!相反,它需要为您正确处理各种重定向。这是regsub代码中的实际错误。