egghelp/eggheads community

"Tip of the day"

2011-02-19T09:23:02-04:00

TCL_no_TK:
Don't treat strings as lists..

Code:

llength $text...foreach t $text {

Also, rather then using expr all the time, use the incr command to increase the value of a variable:

Code:

set total [expr {$total+1}] => incr total

This does not make any sense; you're inside a foreach-loop, and you say $mx is the length of the list your are iterating through.. Thus the loop would have completed before this conditional becomes true:

Code:

if {($total != $mx)} {     set total [expr {$total+1}]    } else {     break    }

Also, your example seems to be missing 3 items, you create 17 instances of "bunny-rabbits", but I only count 14 returned.

I'd rewrite that code somewhat like this:

Code:

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]]]  }}

Statistics: Posted by nml375 — Sat Feb 19, 2011 9:23 am

"Tip of the day"

2011-02-19T15:46:19-04:00

This is losely based of my take on http://wiki.tcl.tk/1774 needed a way to limit the words in a long line of text, so came up with this, its really easy to include in other scripts/snipplets hope someone finds it useful
EDIT (works for me):

Code:

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"    }   }}

And i tested it this time

Code:

% llength $mylist17% makenice $mylist 6line1 line2 line3 line4 line5 line6line7 line8 line9 line10 line11 line12line13 line14 line15 line16 line17%

This is the old code (leaving it here so post below makes sense)

Code:

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}]     }   }}

Example:

Code:

% makenice "[lrepeat 17 "bunny-rabbits"]" "6"bunny-rabbits bunny-rabbits bunny-rabbits bunny-rabbits bunny-rabbits bunny-rabbitsbunny-rabbits bunny-rabbits bunny-rabbits bunny-rabbits bunny-rabbits bunny-rabbitsbunny-rabbits bunny-rabbits%

Statistics: Posted by TCL_no_TK — Sat Feb 19, 2011 4:25 am

Sending long messages

2008-03-14T11:10:25-04:00

The maximum length of a single PRIVMSG is limited by a buffer allocated by the ircd for clients receiving your message. The size of this buffer is most commonly 512 bytes. Some of the space is eaten up by things that are required by the irc protocol, so to know the actual maximum length of the contents of a message, you need to subtract the length of this protocol crap. (:bot!user@host PRIVMSG target :\r\n)

Here's some code to chop long messages into suitable pieces and send the pieces as separate messages:

Code:

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 0foreach 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}

(For this code to work, $botname must match what your bot looks like to other clients on irc, which is not always the case on networks hiding client hosts - if you're on such a network, you will have to adjust the $::botname part of the calculation)

Statistics: Posted by user — Fri Mar 14, 2008 11:10 am

"Tip of the day"

2007-08-10T08:36:26-04:00

Here is what someone asked me after scratching their head for a few days at it, because he couldn't figure it out, a very simple thing.

If you want the bot to send an OPNOTICE to the channel and you have a normal proc:

Code:

proc myproc {nick uhost hand chan text} { putserv "NOTICE @$chan :my_text_here"}

The idea behind something simple as this is:

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.

*** Note: You can even use /notice @#channel with mIRC and it will work just fine.

Statistics: Posted by awyeah — Fri Aug 10, 2007 8:36 am

"Tip of the day"

2007-07-24T17:35:12-04:00

Upon further examination, your code will actually not load any script, as this piece of the code

Code:

source [file join $lscriptsdir $file]

would be executed at global level, where file (hopefully) is not defined at all.
Proper fix would be this change:

Code:

if {[catch {uplevel {source [file join $lscriptsdir $file]}} error]} {### Change to:if {[catch {uplevel "source [file join $lscriptsdir $file]"} error]} {

This would however allow the possible injection of malicious code using [], thus not even requiring shell access, would it not be that the "file exists" test would most likely fail prior to executing that line of code.

I would still suggest removing the possibility of loading scripts outside lscriptsdir, as this would limit the ability of loading unauthorized scripts.

Statistics: Posted by nml375 — Tue Jul 24, 2007 5:35 pm

"Tip of the day"

2007-07-24T11:26:07-04:00

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...

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. Gnite

Statistics: Posted by awyeah — Tue Jul 24, 2007 11:26 am

"Tip of the day"

2007-07-24T11:16:18-04:00

Actually, if you ask me, don't provide such functionality to public interfaces.

Hardcoding hostmasks into the script really does'nt improve anything. Remember that not all eggdrop users (who might've been thinking of using your script) might be able to use "personal hosts", but rather might have to rely on dhcp-assigned addresses.

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...

Statistics: Posted by nml375 — Tue Jul 24, 2007 11:16 am

"Tip of the day"

2007-07-24T11:06:10-04:00

Well nothing is secure now adays. There are backdoors everywhere.

Obviously you can add checks for a specific nick!ident@some.host.com in the proc along with the flags, to make it more secure and yes a password would also be a good idea.. even then if you are not satisfied you can use a dcc trigger rather than using pub, or msgm if you're the only one who knows about the script.

I'm afraid nml375 but thats about it as secure as it gets on an eggdrop. Only a fool would give an "n" flag randomly to people like they give +f and so.

So based on today's conclusion:
Give the "n" flag to only people you really really trust and who know how to use those triggers associated with the bot owner flag.

Statistics: Posted by awyeah — Tue Jul 24, 2007 11:06 am

"Tip of the day"

2007-07-24T09:51:54-04:00

Actually, this would be a very insecure script, as it allows people to load arbitrary scripts using a public interface and no password verification or such (yes, flags are checked, but simply relying on proper hostmasks is a really bad idea, especially for a publically released script).
This is especially bad since you could load virtually any file present on the hosted system, not only the ones within lscriptsdir.

Statistics: Posted by nml375 — Tue Jul 24, 2007 9:51 am

"Tip of the day"

2007-07-24T11:09:15-04:00

Heres a Safe load script (errors in script wont crash the bot). It loads tcl scripts into the bot. If errors are found in that tcl, they are reported and the script is not loaded, if there are no errors it displays a message.

Explanation:

(*) 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

Source code:

Code:

set lflags "n"set lscriptsdir "scripts/"set ltrigger "!"bind pub $lflags ${ltrigger}load load:fileproc load:file {nick host hand chan text} {    global lscriptsdir ltrigger    set file [lindex [split $text] 0]    if {$file == ""} {        putserv "PRIVMSG $nick :-(Load)- ${ltrigger}load  -(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)-"        }    }}

Usage:

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

Statistics: Posted by awyeah — Tue Jul 24, 2007 1:41 am

"Tip of the day"

2007-05-22T03:21:14-04:00

([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.

Statistics: Posted by Sir_Fz — Tue May 22, 2007 3:21 am

"Tip of the day"

2007-05-16T23:51:26-04:00

Heres a cool tip for the day!

If suppose you have a reguar expression:

Code:

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

Here is a test example to prove it works correctly:

Code:

 .tcl regexp {([a-z])\1\1} "baxcd" Tcl: 0 .tcl regexp {([a-z])\1\1} "baxxcd" Tcl: 0 .tcl regexp {([a-z])\1\1} "baxxxxcd" Tcl: 1 .tcl regexp {([a-z])\1\1} "baxxxcd" Tcl: 1 .tcl regexp {([a-z])\1\1} "baxxxxxcd" Tcl: 1#for the + sign .tcl regexp {([a-z])\1\1+} "baxxcd" Tcl: 0 .tcl regexp {([a-z])\1\1+} "baxxxcd" Tcl: 1 .tcl regexp {([a-z])\1\1+} "baxxxxcd" Tcl: 1

Every \1 is an increment for the no. of times u wana match the character.

([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...

Statistics: Posted by awyeah — Wed May 16, 2007 11:51 pm

Callbacks

2007-01-05T13:55:30-04:00

The "proc" part of a bind is actually treated like a piece of tcl code, which means you have to make sure it's a valid list.
When the bind is invoked, the arguments are appended to your code before the whole thing is evaluated.
(like 'eval $yourCode $argsFromBind') This allows you to not only have a proc name in your bind, but also add your own argument(s).

Code:

# A test proc (with a stupid name) that logs all arguments passed to it:  .tcl proc \{ args {putlog "args: $args"}  Tcl: # Trying to invoke it the wrong way:  .tcl bind dcc n demo \{  Tcl: demo  .demo  [16:54] Tcl error [{]: missing close-brace # The right way:  .tcl bind dcc n demo [list \{]  Tcl: demo  .demo  [16:54] args: user 8 {} # Adding an argument:  .tcl bind dcc n demo [list \{ newFirstArg]  Tcl: demo  .demo  [16:54] args: newFirstArg user 8 {}

Note: after, utimer, timer, fileevent, socket -server, and other commands that have callbacks behave in the same way.
An exception to this rule is the dns module's 'dnslookup' command. You can make dnslookup behave like it should using the following code (execute it after loading the dns module):

Code:

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]]}}

...but you probably shouldn't as it will make it incompatible with existing scripts

Statistics: Posted by user — Fri Jan 05, 2007 1:55 pm

Emptyness

2007-01-04T11:50:19-04:00

This is probably useless to most people, but if you ever need to rename a proc to "" (nothing), do

Code:

rename theProc ::

An array with a short name like that can save you some typing:

Code:

% array set "" {0 a 1 b}% list $(0) $(1)a b

An element can also have an empty string as its name:

Code:

% array set "" {"" exit}% $()

And "" is also the name of our beloved global namespace

Statistics: Posted by user — Thu Jan 04, 2007 11:50 am

"Tip of the day"

2007-01-03T08:23:19-04:00

Some handy coding/debugging tools:

pp - print proc
pv - print variable
pn - print namespace (with procs, variables and proper indentation)
indent - apply indentation based on open/close braces

Code:

### pp procName ?in namespace?# proc: fully qualified proc name (or relative to the global namespace)# inNS: to be evaluated inside a namespace? 1/0#       (if '1', output name will be 'namespace tail $fullName')proc pp {proc {inNS 0}} {set args [list]foreach arg [info args $proc] {lappend args [if {[info default $proc $arg val]} {list $arg $val} {list $arg}]}list proc [expr {$inNS?[namespace tail $proc]:$proc}] $args [info body $proc]}### pv variableName ?verbose arrays? ?in namespace?# var: fully qualified variable name (or relative to the global namespace)# verbose: verbose printing of arrays with one or more elements? 1/0# inNS: to be evaluated inside a namespace? 1/0#       (if '1', output name will be 'namespace tail $fullName'#        output will contain 'variable $varName')proc pv {var {verbose 0} {inNS 0}} {upvar 1 $var Varset name [if {$inNS} {namespace tail $var} {set var}]if {[array exists Var]} {set out [if {$inNS} {list [list variable $name]} list]if {$verbose&&[array size Var]} {foreach {key val} [array get Var] {lappend out [list set ${name}($key) $val]}} {lappend out [list array set $name [array get Var]]}join $out \n} elseif {[info exists Var]} {if {$inNS} {list variable $name $Var} {list set $name $Var}}}### pn namespaceName ?maxDepth?# name: root namespace# depth: how many levels of recursion? (special values: 0=none, -1=all)proc pn {{name ::} {depth 0}} {set name [namespace inscope $name {namespace current}]if {[string match *:: $name]} {set mask $name*} {set mask ${name}::*}set code {}foreach var [info vars $mask] {lappend code [pv $var 1 1]}foreach proc [info procs $mask] {lappend code [pp $proc 1]}if {$depth!=0} {incr depth -1foreach ns [namespace children $name] {lappend code [pn $ns $depth]}}list namespace eval [namespace tail $name] [indent \n[join $code \n] \t 1]\n}### indent code ?dentChars? ?startLevel?# code: valid tcl code# dent: character(s) added per level of indentation# curr: start levelproc indent {code {dent \t} {curr 0}} {foreach line [split $code[set code {}] \n] {set escd 0set next 0foreach char [split $line ""] {if {$escd} {set escd 0; continue}switch -- $char {\\ {set escd 1}\{ {incr next 1} \} {if {$next} {incr next -1} {incr curr -1}}}}lappend code [string repeat $dent $curr][string trimleft $line]incr curr $next}join $code \n}# Test: dump EVERY namespace in your interpreter to a file:proc dump {{file dump.tcl}} {set f [open $file w]puts $f [pn :: -1]close $fputs "check $file"}dump

Statistics: Posted by user — Wed Jan 03, 2007 8:23 am