我无法让此脚本接受例如https://youtu.be/HPP0yB-_blA,https://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]
,但我无法做到。
答案 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
代码中的实际错误。