| View previous topic :: View next topic |
| Author |
Message |
eggman
Voice
Joined: 09 Aug 2008
Posts: 11
|
 Posted: Thu Oct 29, 2009 11:49 pm Post subject: xrl.tcl v2.32 by jer@usa.com |
 |
|
How can I add a catcher so <nick@anotherircnet> http://example.com/index.html is caught?
Maybe <*> http://example.com/index.html where * is a wildcard or any text between the initial < >'s
| Code: | #!/bin/sh
# \
exec tclsh "$0" "$@"
package require http 2.2
;###############################################################################
set xrl(version) "xrl.tcl v2.32 by jer@usa.com" ;# updated: 2007.02.14
;###############################################################################
;# * command-line:
;# * $ ./xrl.tcl 'http://www.icaughtyouadeliciousbass.com/'
;# * console:
;# * $ ./xrl.tcl
;# * http://www.dontbejealousthativebeenchattingonlinewithbabesallday.com/
;# * eggdrop:
;# * .chanset #channel +xrl +unxrl +logallurls
;# * /msg #channel http://www.icaughtyouadeliciousbass.com/
;# * /msg bot http://www.icaughtyouadeliciousbass.com/
;###############################################################################
set xrl(antiflags) "bdkqr|dkqr" ;# user flags to ignore for eggdrop use
set xrl(msgmflags) "o|o" ;# user flags required for message eggdrop use
set xrl(pubmflags) "-|-" ;# user flags required for channel eggdrop use
set xrl(length) 40 ;# minimum url length to trigger channel eggdrop use
set xrl(delay) 30 ;# minimum seconds to wait before another eggdrop use
set xrl(last) 408 ;# internal variable, stores time of last eggdrop use
;###############################################################################
proc xrl {url} {
if {[info exists url] && [string length $url]} {
if {[regexp {http://xrl\.us/\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://metamark.net/add" \
-query [::http::formatQuery "long_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://xrl\.us/\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 [xrl $arg]}
} else {
puts "$xrl(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 [xrl [string trim $line]]}
}
exit
}
;###############################################################################
;# eggdrop channel message procedure
;###############################################################################
proc pubm:xrl {nick host user chan text} { global xrl
if {([channel get $chan xrl] || [channel get $chan unxrl]) && \
[expr [unixtime] - $xrl(delay)] > $xrl(last) && \
![matchattr $user $xrl(antiflags)]} {
foreach word [split $text] {
if {([channel get $chan xrl] && \
[string length $word] >= $xrl(length) && \
[regexp {^(f|ht)tp(s|)://} $word] && \
![regexp {://([^/:]*:([^/]*@|\d+(/|$))|.*/\.)} $word]) || \
([channel get $chan unxrl] && \
[regexp {http://xrl.us/\w+} $word])} {
set xrl(last) [unixtime]
set newurl [xrl $word]
if {[string length $newurl]} {
puthelp "PRIVMSG $chan :<$nick> $newurl"
}
putlog "<$nick:$chan> $word <-> $newurl"
break
}}}
if {[channel get $chan logallurls]} {
foreach word [split $text] {
if {[string match "*://*" $word]} {
putlog "<$nick:$chan> $word"
}}}
return 0
}
bind pubm $xrl(pubmflags) {*://*} pubm:xrl
;###############################################################################
;# eggdrop private message procedure
;###############################################################################
proc msgm:xrl {nick host user text} { global xrl
if {![matchattr $user $xrl(antiflags)] && \
[expr [unixtime] - $xrl(delay)] > $xrl(last) && \
[string match "*://*" [lindex [split $text] 0]] && \
[llength [split $text]] == 1} {
set xrl(last) [unixtime]
set newurl [xrl $text]
if {[string length $newurl]} {
puthelp "PRIVMSG $nick :\1ACTION $newurl\1"
putlog "<$nick> $text <-> $newurl"
}}
return 0
}
bind msgm $xrl(msgmflags) {*://*} msgm:xrl
;###############################################################################
;# eggdrop chanset flags
;###############################################################################
setudef flag xrl
setudef flag unxrl
setudef flag logallurls
;###############################################################################
putlog "loaded: $xrl(version)" ;# eggdrop log message
;###############################################################################
|
|
|
| Back to top |
|
 |
eggman
Voice
Joined: 09 Aug 2008
Posts: 11
|
|
| Back to top |
|
|
speechles
Revered One
Joined: 26 Aug 2006
Posts: 1398
Location: emerald triangle, california (coastal redwoods)
|
| Posted: Fri Oct 30, 2009 6:58 pm Post subject: Re: Correct prefix needed to catch |
|
|
I'm guessing your relay script and xrl script are run on the same bot, otherwise it would work. You will need to edit your relay script and add this into it after it gives pub text output. | Code: | putserv "privmsg $chan :<$nick@$network> $text"
pubm:xrl $nick foo $hand $chan $text |
The above is merely an example. The bottom line of code will invoke xrl. This is how you would need to do it on a single bot relay/xrl. Of course that channel must be +xrl as well. This is common sense.
To get the $hand variable to contain the handle of the nickname relayed may not be possible... You may need to change the check shown below: | Code: | if {([channel get $chan xrl] || [channel get $chan unxrl]) && \
[expr [unixtime] - $xrl(delay)] > $xrl(last) && \
![matchattr $user $xrl(antiflags)]} { |
To look like this: | Code: | if {([channel get $chan xrl] || [channel get $chan unxrl]) && \
[expr [unixtime] - $xrl(delay)] > $xrl(last)} { |
Then you won't need the $hand variable and can craft the invocation like the way it is below: | Code: | | pubm:xrl $nick foo bar $chan $text |
This way we only need to pass the nickname, channel and text to the procedure. The other 2 variables $uhost and $handle aren't required since they aren't used. Hence they are invoked as "foo" and "bar" basically just used to fill the space with something so the other arguments passed line up correctly.
_________________
speechles' eggdrop tcl archive |
|
| Back to top |
|
|
|
FAQ
Search
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
