| View previous topic :: View next topic |
| Author |
Message |
testebr
Halfop
Joined: 01 Dec 2005
Posts: 86
|
 Posted: Wed Jul 04, 2007 5:56 pm Post subject: tinyurl.tcl 2.32 by jer problem with chars |
 |
|
Hi,
This tcl work fine, but some url dont work.
Example:
http://www.testeurlwebsitefree.com/ <<< work fine
http://www.testeurlwebsitefree.com/area/page.php?id=8986 <<< dont work
How to fix it?
tcl download: http://www.egghelp.org/cgi-bin/tcl_archive.tcl?mode=download&id=1259
Tcl source:
| Code: | #!/bin/sh
# \
exec tclsh "$0" "$@"
package require http 2.2
;###############################################################################
set tinyurl(version) "tinyurl.tcl v2.32 by jer@usa.com" ;# updated: 2007.02.14
;###############################################################################
;# * command-line:
;# * $ ./tinyurl.tcl 'http://www.icaughtyouadeliciousbass.com/'
;# * console:
;# * $ ./tinyurl.tcl
;# * http://www.dontbejealousthativebeenchattingonlinewithbabesallday.com/
;# * eggdrop:
;# * .chanset #channel +tinyurl +untinyurl +logallurl
;# * /msg #channel http://www.icaughtyouadeliciousbass.com/
;# * /msg bot http://www.icaughtyouadeliciousbass.com/
;###############################################################################
set tinyurl(antiflags) "bdkqr|dkqr" ;# user flags to ignore for eggdrop use
set tinyurl(msgmflags) "o|o" ;# user flags required for message eggdrop use
set tinyurl(pubmflags) "-|-" ;# user flags required for channel eggdrop use
set tinyurl(length) 40 ;# minimum url length to trigger channel eggdrop use
set tinyurl(delay) 30 ;# minimum seconds to wait before another eggdrop use
set tinyurl(last) 408 ;# internal variable, stores time of last eggdrop use
;###############################################################################
proc tinyurl {url} {
if {[info exists url] && [string length $url]} {
if {[regexp {http://tinyurl\.com/\w+} $url]} {
set http [::http::geturl $url -timeout 9000]
upvar #0 $http state ; array set meta $state(meta)
::http::cleanup $http ; return $meta(Location)
} else {
set http [::http::geturl "http://tinyurl.com/create.php" \
-query [::http::formatQuery "url" $url] -timeout 9000]
set data [split [::http::data $http] \n] ; ::http::cleanup $http
for {set index [llength $data]} {$index >= 0} {incr index -1} {
if {[regexp {href="http://tinyurl\.com/\w+"} [lindex $data $index] url]} {
return [string map { {href=} "" \" "" } $url]
}}}}
return ""
}
;###############################################################################
;# tclsh command-line/console procedure
;###############################################################################
if {[info exists argc]} {
if {$argc} {
foreach arg [lrange $argv 0 end] {puts [tinyurl $arg]}
} else {
puts "$tinyurl(version)"
puts "usage: $argv0 http://bullfrog.webhop.net/"
puts "enter url(s), one per line, press ctrl+c to cancel:"
while {[gets stdin line]} {puts [tinyurl [string trim $line]]}
}
exit
}
;###############################################################################
;# eggdrop channel message procedure
;###############################################################################
proc pubm:tinyurl {nick host user chan text} { global tinyurl
if {([channel get $chan tinyurl] || [channel get $chan untinyurl]) && \
[expr [unixtime] - $tinyurl(delay)] > $tinyurl(last) && \
![matchattr $user $tinyurl(antiflags)]} {
foreach word [split $text] {
if {([channel get $chan tinyurl] && \
[string length $word] >= $tinyurl(length) && \
[regexp {^(f|ht)tp(s|)://} $word] && \
![regexp {://([^/:]*:([^/]*@|\d+(/|$))|.*/\.)} $word]) || \
([channel get $chan untinyurl] && \
[regexp {http://tinyurl.com/\w+} $word])} {
set tinyurl(last) [unixtime]
set newurl [tinyurl $word]
if {[string length $newurl]} {
puthelp "PRIVMSG $chan :<$nick> $newurl"
}
putlog "<$nick:$chan> $word <-> $newurl"
break
}}}
if {[channel get $chan logallurl]} {
foreach word [split $text] {
if {[string match "*://*" $word]} {
putlog "<$nick:$chan> $word"
}}}
return 0
}
bind pubm $tinyurl(pubmflags) {*://*} pubm:tinyurl
;###############################################################################
;# eggdrop private message procedure
;###############################################################################
proc msgm:tinyurl {nick host user text} { global tinyurl
if {![matchattr $user $tinyurl(antiflags)] && \
[expr [unixtime] - $tinyurl(delay)] > $tinyurl(last) && \
[string match "*://*" [lindex [split $text] 0]] && \
[llength [split $text]] == 1} {
set tinyurl(last) [unixtime]
set newurl [tinyurl $text]
if {[string length $newurl]} {
puthelp "PRIVMSG $nick :\1ACTION $newurl\1"
putlog "<$nick> $text <-> $newurl"
}}
return 0
}
bind msgm $tinyurl(msgmflags) {*://*} msgm:tinyurl
;###############################################################################
;# eggdrop chanset flags
;###############################################################################
setudef flag tinyurl
setudef flag untinyurl
setudef flag logallurl
;###############################################################################
putlog "loaded: $tinyurl(version)" ;# eggdrop log message
;############################################################################### |
This other TCL have same problem. |
|
| Back to top |
|
 |
incith
Master
Joined: 23 Apr 2005
Posts: 275
Location: Canada
|
| Posted: Wed Jul 04, 2007 9:29 pm Post subject: |
|
|
I suggest incith:xrl (^_^) for now. My script will accept special characters.
Now, I realise you may not want to use XRL, but that's alright, because I'm planning on release a super-shortening script soon (which will include tinyurl).  But anyway, xrl.us is shorter than tinyurl.com anyway.
Regards,
_________________
; Answer a few unanswered posts! |
|
| Back to top |
|
|
rosc2112
Revered One
Joined: 19 Feb 2006
Posts: 1454
Location: Northeast Pennsylvania
|
| Posted: Thu Jul 05, 2007 10:31 am Post subject: |
|
|
| error info would be helpful (read the faq about how to get useful info from .set errorInfo) |
|
| Back to top |
|
|
|
FAQ
Search
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
