Code: Select all
rename theProc ::
Code: Select all
% array set "" {0 a 1 b}
% list $(0) $(1)
a b
Code: Select all
% array set "" {"" exit}
% $()
![Smile :)](./images/smilies/icon_smile.gif)
Code: Select all
rename theProc ::
Code: Select all
% array set "" {0 a 1 b}
% list $(0) $(1)
a b
Code: Select all
% array set "" {"" exit}
% $()
Code: Select all
# A test proc (with a stupid name) that logs all arguments passed to it:
<user> .tcl proc \{ args {putlog "args: $args"}
<bot> Tcl:
# Trying to invoke it the wrong way:
<user> .tcl bind dcc n demo \{
<bot> Tcl: demo
<user> .demo
<bot> [16:54] Tcl error [{]: missing close-brace
# The right way:
<user> .tcl bind dcc n demo [list \{]
<bot> Tcl: demo
<user> .demo
<bot> [16:54] args: user 8 {}
# Adding an argument:
<user> .tcl bind dcc n demo [list \{ newFirstArg]
<bot> Tcl: demo
<user> .demo
<bot> [16:54] args: newFirstArg user 8 {}
Code: Select all
if {![llength [info procs dnslookup]]&&[llength [info commands dnslookup]]} {
rename dnslookup __dnslookup
proc dnslookup {addr code} {eval [list __dnslookup $addr __dnslookedup] $code}
proc __dnslookedup {0 1 2 args} {uplevel #0 [concat $args [list $0 $1 $2]]}
}
Code: Select all
regexp {aaa|bbb|ccc|ddd|eee|fff|ggg|hhh|iii|jjj|kkk} $string
#this becomes annoyling long and not efficient enough
#a smaller way of accomplishing the exact same this is:
regexp {([a-z])\1\1+} $string
#even the + is redudant in my oppinion as for what I tested, so:
regexp {([a-z])\1\1} $string
Code: Select all
<awyeah> .tcl regexp {([a-z])\1\1} "baxcd"
<adapter> Tcl: 0
<awyeah> .tcl regexp {([a-z])\1\1} "baxxcd"
<adapter> Tcl: 0
<awyeah> .tcl regexp {([a-z])\1\1} "baxxxxcd"
<adapter> Tcl: 1
<awyeah> .tcl regexp {([a-z])\1\1} "baxxxcd"
<adapter> Tcl: 1
<awyeah> .tcl regexp {([a-z])\1\1} "baxxxxxcd"
<adapter> Tcl: 1
#for the + sign
<awyeah> .tcl regexp {([a-z])\1\1+} "baxxcd"
<adapter> Tcl: 0
<awyeah> .tcl regexp {([a-z])\1\1+} "baxxxcd"
<adapter> Tcl: 1
<awyeah> .tcl regexp {([a-z])\1\1+} "baxxxxcd"
<adapter> Tcl: 1
([a-z])\1 <=-- Means that letter is present 2 times or more
([a-z])\1\1 <=-- Means that letter is present 3 times or more
and so on...
Actually ([a-z])\1 means any alphabet repeated exactly 2 consecutive times and not 2 or more. If you add a + (which means 1 or more) then you can consider ([a-z])\1+ as any alphabet repeated exactly 2 times once or more (i.e. aa, aaaa, aaaaaa). If you're wondering why it matches 'aaa' for example, that's because 'a' is repeated 2 consecutive times at least once.awyeah wrote:([a-z])\1 <=-- Means that letter is present 2 times or more
([a-z])\1\1 <=-- Means that letter is present 3 times or more
and so on...
(*) When an error is found the bot gives you an error and doesn't load the script.
(*) When no error is found in the script a message similar to the one below will be displayed:
Script: tcldebug.tcl - Size: 3 kb - Status: OK
Code: Select all
set lflags "n"
set lscriptsdir "scripts/"
set ltrigger "!"
bind pub $lflags ${ltrigger}load load:file
proc load:file {nick host hand chan text} {
global lscriptsdir ltrigger
set file [lindex [split $text] 0]
if {$file == ""} {
putserv "PRIVMSG $nick :-(Load)- ${ltrigger}load <scriptname.tcl> -(Info)-"
return 0
} elseif {![file exists [file join $lscriptsdir $file]]} {
putserv "PRIVMSG $nick :-(Load)- Sorry $file doesn't exist -(Info)-"
return 0
} else {
set kbsize [expr {[file size [file join $lscriptsdir/$file]] / 1024.0}]
if {[catch {uplevel {source [file join $lscriptsdir $file]}} error]} {
putserv "PRIVMSG $nick :-(Load)- Script: $file Size: $kbsize kb Status: Error -(Info)-"
putserv "PRIVMSG $nick :-(Load)- $error -(Info)-"
} else {
putserv "PRIVMSG $nick :-(Load)- Script: $file - Size: $kbsize kb - Status: OK -(Info)-"
}
}
}
You need to set the lscriptsdir to your own dir
You can also change the lflags to whatever you want
Example: your trigger is "!"
!load tcldebug.tcl
Well that's a risk I guess they would have to take. Actually I made it for scripters, I myself sometimes miss a brace or two when I write a new script with long procs, so atleast the bot wouldn't crash and I can fix the script and then load it back into the bot. Farewell I'm off to sleep then. Gnitenml375 wrote:Allowing ppl to load arbitrary scripts is a very, very bad idea. Assuming you run your eggdrop on a commercial shell, anyone else on that shell could place a malicious script on the system, and, if the hostmasks are'nt restrictive enough use this loader to load the script in question...
Code: Select all
source [file join $lscriptsdir $file]
Code: Select all
if {[catch {uplevel {source [file join $lscriptsdir $file]}} error]} {
### Change to:
if {[catch {uplevel "source [file join $lscriptsdir $file]"} error]} {
Code: Select all
proc myproc {nick uhost hand chan text} {
putserv "NOTICE @$chan :my_text_here"
}
*** Note: You can even use /notice @#channel with mIRC and it will work just fine.People generally use the command /ONOTICE on clients such as mIRC to send opnotices, but with the eggdrop its a bit different.
=> Use a normal NOTICE followed by a "@" infront of your channel name, e.g. @#mychan to send an opnotice (send a notice to all channel ops) with your eggdrop.
Code: Select all
proc msg {dest data} {
set len [expr {512-[string len ":$::botname PRIVMSG $dest :\r\n"]}]
foreach line [wordwrap $data $len] {
puthelp "PRIVMSG $dest :$line"
}
}
# wordwrap proc that accepts multiline data
# (empty lines will be stripped because there's no way to relay them via irc)
proc wordwrap {data len} {
set out {}
foreach line [split [string trim $data] \n] {
set curr {}
set i 0
foreach word [split [string trim $line]] {
if {[incr i [string len $word]]>$len} {
lappend out [join $curr]
set curr [list $word]
set i [string len $word]
} {
lappend curr $word
}
incr i
}
if {[llength $curr]} {
lappend out [join $curr]
}
}
set out
}
Code: Select all
proc makenice {tmp size} {
set mx [llength $tmp]
set current 0
set total 0
foreach t $tmp {
set total [expr {$total+1}]
if {($mx > $total)} {
lappend out "$t"
set current [expr {$current+1}]
if {($current == $size)} {
puts "$out"
set current 0
set out [list]
}
} else {
lappend out [join [lrange [split $tmp] [expr {$total-1}] $mx]]
puts "$out"
}
}
}
Code: Select all
% llength $mylist
17
% makenice $mylist 6
line1 line2 line3 line4 line5 line6
line7 line8 line9 line10 line11 line12
line13 line14 line15 line16 line17
%
Code: Select all
proc makenice {text size} {
set mx [llength $text]
set current 0
set zap $size
set total 0
set sent 0
set tidy [expr {$mx / $zap}]
foreach t $text {
if {($total != $mx)} {
set total [expr {$total+1}]
} else {
break
}
if {($sent == $tidy)} {
set out [join [lrange [split $text] $total $mx]]
puts "$out"
break
}
if {($current == $zap)} {
puts "$out"
set sent [expr {$sent+1}]
set current 0
set out [list]
} else {
lappend out "$t"
set current [expr {$current+1}]
}
}
}
Code: Select all
% makenice "[lrepeat 17 "bunny-rabbits"]" "6"
bunny-rabbits bunny-rabbits bunny-rabbits bunny-rabbits bunny-rabbits bunny-rabbits
bunny-rabbits bunny-rabbits bunny-rabbits bunny-rabbits bunny-rabbits bunny-rabbits
bunny-rabbits bunny-rabbits
%
Code: Select all
llength $text
...
foreach t $text {
Code: Select all
set total [expr {$total+1}] => incr total
Code: Select all
if {($total != $mx)} {
set total [expr {$total+1}]
} else {
break
}
Code: Select all
proc makenice {text size} {
set items [split $text]
set length [llength $items]
incr size -1
for {set i 0} {$i <$length} {incr i} {
puts [join [lrange $items $i [incr i $size]]]
}
}