Custom Binds - Neat trick

[KevKev]

I just figured out a neat little trick. The hidden ability to create, call and bind to your own custom binds.

ever put together a bunch of scripts for various things and wanted to be able to add/remove parts without manual editing even when pieces are dependant on eachother and such? I came across this with one of my projects (EQEgg). Basicly the type of IRC server that i was connecting a bot to doesn't respond to joins and such the way that Eggdrop expects. So i wrote my own Join/Part detection in my script. Then i had to manually hack it into various other pieces of my script to either detect it on it's own or to be called from the original detection routine inlieu of a join binding.

I have since found that bind evnt <type> takes any random string you want to throw at it and the associated callevent(<type>) will as well.

By putting a callevent("eqegg_join") line in my custom join detection script and bind all on join events to the evnt bind with a type of eqegg_join i can now worry less about glueing the scripts together and tying them too tightly together so that i can't even remove modules. and it'll be even easier to add new modules that need to respond to events detected in the core of my script.

Anyway, just figured i'd pass my realization on as i've been looking for ways of creating and using my own bindings for quite some time.

[awyeah]

Bind evnt has a few newber of types of parameters that can be used. Some as we know are listed in tcl-commands.doc.

Code: Select all

bind evnt <flags> <type> <proc>
proc-name <type>

Description: Description: triggered whenever one of these events happen; flags are ignored; valid events are:

    sighup    called on a kill -HUP <pid>
    sigterm    called on a kill -TERM <pid>
    sigill    called on a kill -ILL <pid>
    sigquit    called on a kill -QUIT <pid>

    save    called when the userfile is saved
    rehash    called just after a rehash
    prerehash    called just before a rehash
    prerestart    called just before a restart

    logfile     called when the logs are switched daily
    loaded    called when the bot is done loading
    userfile-loaded    called after userfile has been loaded

    connect-server    called just before we connect to an IRC server
    init-server    called when we actually get on our IRC server
    disconnect-server    called when we disconnect from our IRC server

Module: core

Well lets see could you paste a the script here, so we know exactly what you are talking about, the binding types. And also this script has a join detection, so what actually does it do?

[Ofloo]

i always thought callevent was to trigger stuff like simulate a rehash and so on.. so you could see what happens.. not to actual make your own..

=> altho if you where to bind an event to test for example then call upon event test well that would trigger a bind so .. in a way yes .. you could make your own event binds but its not realy your own bind

for example

bind evnt - blah some_command

then something happens on the eggdrop or in your script where you put the command callevent blah that would call the event yes .. but thats not realy new right ?? its been on there for a while .. or isn't this possible ?

for example bind evnt - names names_event

proc names_event ...

bind on raw for names then you got a names event put in that raw bind callevent names and that should work..

but you might as well bind to the raw ... if you know what i mean ???

[KevKev]

Try it out

Code: Select all

.tcl bind evnt - foo {putlog "foo event happened"}

then

Code: Select all

.tcl callevent foo

It takes a nice little text string which can be anything you want it to.

Yes it's simplistic and such and i'm assuming it'll take a mask on the bind as in i could do bin evnt - foo* and then use the rest of the string to pass arguments to it. It's simplistic and crude but it's better than adding the trigger to every single script.

I haven't fully tested everything and i'm just now including it into my script.

In my case I hope to use it to replace putting calls to about 5 or 6 different "modules" for my suite of scripts in this proc. If i have to put them all in here i can never remove the modules and nobody could add custom modules that need to do things on join without editing this proc or re-implementing it in their module. The point of modular programming is to do things once and use them a lot.

Code: Select all

# Raw Binds
bind raw - JOIN eqim_join_raw

proc eqim_join_raw {src key chan} {
	global loglev
	set autoadd 0
	set module eqim_join_raw
	if {[do_debug $module]} {
		putloglev $loglev(debug) $chan "#$module# found src: $src key: $key chan: $chan"
	}
	set nick [lindex [split $src "!"] 0]
	if {[string match ":*" $chan]} {
		set chan [string range $chan 1 end]
	}
	if {[checkbans $src $chan]} {
		return 0
	}
	eqim-int_send_news $nick $chan $nick 2
	set hand [finduser $src]
	if {$hand == "*"} {
		if {$autoadd} {
			eqim-add_flagged_user $nick $chan none
			set hand $nick
		} else {
			return 0
		}
	} 
	if {![haschanrec $hand $chan]} {
		addchanrec $hand $chan
	}
	eqim_update_host $hand
	setuser $hand LASTON [clock seconds] $chan
	if {[channel get $chan greet]} {
		if {[do_debug $module]} {
			putloglev $loglev(debug) $chan "#$module# greeting $nick in $chan"
		}
		eqim-greet $nick $hand $chan
	}
	eqim-checkflags $nick $hand $chan
	return 0
}

[KevKev]

Update:

Unfortunately the event type in the bind will not take wildcards. This would have been a perfect solution but alas i'm back to searching for a good way to handle this.

Any suggestions?

[user]

How about something like this? It's sort of like a stacking "bind" with nothing more than a keyword to match against (no flags or other fancy stuff)

Code: Select all

# use this to create "binds"
proc bind2 {name cmd} {
	global bind2
	if {![info exists bind2($name)]||[lsearch -exact $bind($name) $cmd]==-1} {
		lappend bind2($name) $cmd
	}
}
# use this to invoke your "binds"
proc bind2invoke {mask args} {
	global bind2
	foreach name [array names bind2 $mask] {
		foreach cmd $bind2($name) {
			uplevel #0 [concat $cmd $args]
		}
	}
}

# example:
proc fakeJOINtest {nick uhost hand chan} {
	putlog "$nick!$uhost fakeJOINed $chan as $hand?"
}
bind2 fakeJOIN fakeJOINtest
bind2invoke fake* TheNick who@? TheHandle #chan

It should at least give you an idea or two

[Ofloo]

if you are willing to use alternate names for the word bind then check this script, its a bind i wrote bit messy maybe but it works..

http://cvs.ofloo.net/q-srv/bin/q-srv.tc ... cvs-markup

[KevKev]

Thanks too you both!

Hook sounds good to me

Looks very spiffy i'll have to see about incorporating an adaptation of one of thses as a hook proc

I might even write it as a full standalone toolscript for others to use

[user]

Here's a custom bind command for you. I didn't test it much, but it seems to get the job done and it's fairly flexible and fast. The createType proc looks a bit ugly, but most of that ugly code is to speed up the invoking of your binds, so I guess it's a good thing

Code: Select all

namespace eval ::cbind {

	variable cfg
	variable binds
	
	# create a new custom bind type
	proc createType {type args mstr mtype stack hand chan} {
		variable cfg

		set all [lrange [info level 0] 2 end]
		# replace an existing type?
		if {[info exists cfg($type)]} {
			if {$cfg($type)==$all} {
				return 2
			} {
				variable binds
				array unset binds $type,*
			}
		}
		# generate code to produce the string that is matched against your
		# masks (command substitution is performed when the bind is invoked)
		set j [llength $args]
		set code {}
		for {set i 0} {$i<$j} {incr i} {
			lappend code "\[lindex \$args $i\]"
		}
		if {[catch {
			set cfg($type,mstr) [peval {
				foreach [uplevel 1 {set args}] [uplevel 1 {set code}] break
				subst -noc [string map {\\ \\\\ [ \\\\[ ] \\\\]} [uplevel 1 {set mstr}]]
			}]
		} err]} {
			error "invalid mstr: $err"
		}
		# generate code for matching and flag checking based on your settings
		set code {}
		if {$hand>-1} {
			if {$chan>-1} {
				lappend code {($flags!="-"&&![matchattr $hand $flags $chan])}
			} {
				lappend code {($flags!="-"&&![matchattr $hand $flags])}			
			}
		}
		switch -- $mtype {
			"-nocase"     {lappend code {![string eq -noc $mask $mstr]}}
			"-glob"       {lappend code {![string match $mask $mstr]}}
			"-globnocase" {lappend code {![string match -noc $mask $mstr]}}
			default       {lappend code {![string eq $mask $mstr]}}
		}
		if {[llength $code]} {
			set cfg($type,code) "if \{[join $code "||"]\} continue"
		} else {
			set cfg($type,code) ""
		}
		# store the rest of the settings
		set cfg($type) $all
		set cfg($type,args) $args
		set cfg($type,argn) $j
		set cfg($type,stack) $stack
		set cfg($type,hand) $hand
		set cfg($type,chan) $chan
		set all
	}
	
	# guess
	proc bind {type flags mask command} {
		variable cfg
		variable binds
		if {![info exists cfg($type)]} {error "invalid type"}
		if {![string match {*[a-zA-Z0-9]*} $flags]} {set flags -}
		set name $type,$mask
		set bind [list $type $flags $mask $command]
		if {[info exists binds($name)]&&$cfg($type,stack)} {
			if {[lsearch -exact $binds($name) $bind]==-1} {
				lappend binds($name) $bind
			}
		} else {
			set binds($name) [list $bind]
		}
		set command
	}
	
	# guess
	proc unbind {type flags mask command} {
		variable binds
		if {![string match {*[a-zA-Z0-9]*} $flags]} {set flags -}
		set name $type,$mask
		set bind [list $type $flags $mask $command]
		if {[info exists binds($name)]} {
			if {[set i [lsearch -exact $binds($name) $bind]]>-1} {
				if {[llength $binds($name)]>1} {
					set binds($name) [lreplace $binds($name) $i $i]
				} {
					unset binds($name)
				}
				return $command
			}
		}
		error "no such bind"
	}
	
	# make stuff happen
	proc invoke {type args} {
		variable cfg
		variable binds
		
		if {![info exists cfg($type)]} {error "invalid type \"$type\""}
		if {[llength $args]!=$cfg($type,argn)} {
			error "wrong # args for \"$type\" i want: $cfg($type,args)"
		}
		
		if {$cfg($type,hand)>-1} {
			set hand [lindex $args $cfg($type,hand)]
			set chan [lindex $args $cfg($type,chan)]
		}
		
		set mstr [subst $cfg($type,mstr)]
		set code $cfg($type,code)

		foreach name [array names binds $type,*] {
			foreach bind $binds($name) {
				foreach {. flags mask cmd} $bind break
				eval $code
				uplevel #0 [concat $cmd $args]
			}
		}
	}
	
	# a clean, temporary scope (used to generate the mstr code)
	proc peval code {
		eval [set code] [unset code]
	}

}

Code: Select all

"Manual" (i used the code tag to preserve formatting):

::cbind::createType <type> <args> <mstr> <mtype> <stack> <hand> <chan>
	creates a new bind type based on your settings
	arguments:
		type: the "name" of your new bind
		args: the list of arguments required when invoking the bind
		mstr: a piece of "code" used to generate the string that your
		      bind masks are matched against
		mtype: match type (-exact, -nocase, -glob or -globnocase)
		stack: stackable or not? (1/0)
		hand: if you want flag matching, give the position of the
		      handle in your argument list (index), or -1
		chan: if you want channel flag matching (like the above, but
		      to indicate the position of the channel name)

::cbind::bind <type> <flags> <mask> <command>
	create a bind
	(you created the type, so you should know how it works :P)

::cbind::unbind <type> <flags> <mask> <command>
	remove a bind

::cbind::invoke <type> [arg1, arg2...argN]
	make stuff happen :)
	arguments:
		type: must be a valid type
		args: the remaining arguments must match the number of
		      arguments in the type's argument list
		      the values are used in different ways depending
		      on the settings you used when creating the type.

Example emulating the built in "join" bind:
- require the arguments nick, uhost, hand and chan (when invoking it)
- match against "#chan nick!user@host"
- use glob and nocase matching (note: this is not the same as eggdrop's matching. 'string match -nocase' is used. If you don't know the difference, you've got some tcl-commands.doc/manual reading to do
- stackable
- handle is the 3rd argument (so flag checking is done)
- channel is the 4th arg (so the channel name is used when matching flags)

Code: Select all

# create the new type:
cbind::createType join {nick uhost hand chan} {$chan $nick!$uhost} -globnocase 1 2 3

# a test bind + proc
cbind::bind join - * test
proc test {n u h c} {putlog "$n!$u joined $c as $h"}

# invoke the type and see what happens
cbind::invoke join It seems@to.work * #chan

EDIT: added code for rewriting flags with no alphanumeric chars to "-" in bind/unbind

[KevKev]

Holy jeebus User awesome stuff

Thanks a ton. I'll have to run through all of it till I understand how it works. The usage side looks simple enough (for such a complex task at least )

If any of the eggheads are peering in. this sort of thing would be awesome for 1.9.

[Ofloo]

hmm i was reading the code a bit seems nice but just out of curiousity.. why

Code: Select all

foreach [uplevel 1 {set args}] [uplevel 1 {set code}] break

and not just use $args &nd $code .. why use set ..?


ps nice code you seem to have everything coverd..

[user]

why

Code: Select all

foreach [uplevel 1 {set args}] [uplevel 1 {set code}] break

and not just use $args &nd $code .. why use set ..?

How would you do what I did using $?

(hint: "$args" == "[set args]" != "set args")

[Ofloo]

ic .. sorry then..