tcldrop-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Tcldrop/CVS] tcldrop/modules conn.tcl channels/channels.tcl ...


From: Philip Moore
Subject: [Tcldrop/CVS] tcldrop/modules conn.tcl channels/channels.tcl ...
Date: Tue, 02 Dec 2003 04:01:48 -0500

CVSROOT:        /cvsroot/tcldrop
Module name:    tcldrop
Branch:         
Changes by:     Philip Moore <address@hidden>   03/12/02 04:01:47

Modified files:
        modules        : conn.tcl 
        modules/channels: channels.tcl channels_arraydb.tcl 
        modules/server : server.tcl 
        modules/users  : users.tcl 

Log message:
        Bugfixes all over the place.. =)

CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/tcldrop/tcldrop/modules/conn.tcl.diff?tr1=1.8&tr2=1.9&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/tcldrop/tcldrop/modules/channels/channels.tcl.diff?tr1=1.13&tr2=1.14&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/tcldrop/tcldrop/modules/channels/channels_arraydb.tcl.diff?tr1=1.1&tr2=1.2&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/tcldrop/tcldrop/modules/server/server.tcl.diff?tr1=1.15&tr2=1.16&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/tcldrop/tcldrop/modules/users/users.tcl.diff?tr1=1.20&tr2=1.21&r1=text&r2=text

Patches:
Index: tcldrop/modules/channels/channels.tcl
diff -u tcldrop/modules/channels/channels.tcl:1.13 
tcldrop/modules/channels/channels.tcl:1.14
--- tcldrop/modules/channels/channels.tcl:1.13  Mon Dec  1 23:22:44 2003
+++ tcldrop/modules/channels/channels.tcl       Tue Dec  2 04:01:46 2003
@@ -1,6 +1,6 @@
 # channels.tcl --
 #
-# $Id: channels.tcl,v 1.13 2003/12/02 04:22:44 fireegl Exp $
+# $Id: channels.tcl,v 1.14 2003/12/02 09:01:46 fireegl Exp $
 #
 # Copyright (C) 2003 FireEgl (Philip Moore) <address@hidden>
 #
@@ -28,11 +28,8 @@
 namespace eval ::tcldrop::channels {
        # Provide the channels module:
        variable version {0.8}
-       variable rcsid {$Id: channels.tcl,v 1.13 2003/12/02 04:22:44 fireegl 
Exp $}
+       variable rcsid {$Id: channels.tcl,v 1.14 2003/12/02 09:01:46 fireegl 
Exp $}
        package provide tcldrop::channels $version
-       # Initialize variables:
-       variable Udefs
-       array set Udefs {}
        # Export all the commands that should be available to 3rd-party 
scripters:
        namespace export channel channels loadchannels savechannels validchan 
setudef renudef deludef countchannels
        # Set the default channel database module:
@@ -59,17 +56,6 @@
 ::tcldrop::SetDefault global-exempt-time 29
 ::tcldrop::SetDefault global-chanset [list -autoop -autovoice -bitch -cycle 
+dontkickops +dynamicbans +dynamicexempts +dynamicinvites -enforcebans -greet 
-inactive -nodesynch -protectfriends -protectops -revenge -revengebot -secret 
-seen +shared -statuslog +userbans +userexempts +userinvites -protecthalfops 
-autohalfop]
 
-# Gives the type of the udef given in $name:
-# It returns one of the following: int, flag, str, list, or unknown.
-proc ::tcldrop::channels::UdefType {name} {
-       variable Udefs
-       if {[info exists Udefs($name)]} {
-               return $Udefs($name)
-       } else {
-               return {unknown}
-       }
-}
-
 proc ::tcldrop::channels::channel {command channel args} {
        foreach a [binds channels channel] {
                foreach {type flags mask count proc} $a {}
@@ -154,22 +140,6 @@
        }
 }
 
-proc ::tcldrop::channels::SetUdefDefaults {{name {*}}} {
-       variable Channels
-       variable UdefDefaults
-       foreach c [array names Channels] {
-               array set chaninfo $Channels($c)
-               foreach n [array names UdefDefaults $name] {
-                       if {![info exists chaninfo($n)]} {
-                               # It's not already set, so we set it to the 
default:
-                               set chaninfo($n) $UdefDefaults($n)
-                               set Channels($c) [array get chaninfo]
-                       }
-               }
-               array unset chaninfo
-       }
-}
-
 # Loads the channel info from $chanfile:
 proc ::tcldrop::channels::loadchannels {} {
        foreach a [binds channels loadchannels] {
@@ -189,7 +159,6 @@
        } else {
                return -code error {No channel database module has been loaded.}
        }
-       SetUdefDefaults
 }
 
 # Returns 1 if a channel exists in the channel database, or 0 if it doesn't:
@@ -218,32 +187,23 @@
 
 # Defines a new udef:
 proc ::tcldrop::channels::setudef {type name {default {}}} {
-       # Store the default for this udef:
-       variable UdefDefaults
-       switch -- $type {
-               {flag} {
-                       switch -- $default {
-                               {1} - {+} { set UdefDefaults($name) 1 }
-                               {0} - {-} - {default} { set UdefDefaults($name) 
0 }
-                       }
-               }
-               {int} {
-                       if {$default != {}} {
-                               set UdefDefaults($name) $default
-                       } else {
-                               set UdefDefaults($name) 0
-                       }
+       foreach a [binds channels setudef] {
+               foreach {bindtype flags mask count proc} $a {}
+               if {[set lev [catch { $proc $type $name } val]]} {
+                       putlog "Error in script: $proc: $val"
+                       puterrlog "$::errorInfo"
                }
-               {str} - {list} { set UdefDefaults($name) $default }
-               {default} {
-                       # FixMe: Give an invalid type error.
+               ::tcldrop::countbind $bindtype $mask $proc
+               if {![info exists retval]} {
+                       set retlev $lev
+                       set retval $val
                }
        }
-       # Store the udef itself:
-       variable Udefs
-       set Udefs($name) [string tolower $type]
-       # Apply the default to all channels that don't already have it set:
-       SetUdefDefaults $name
+       if {[info exists retval]} {
+               return -code $retlev $retval
+       } else {
+               return -code error {No channel database module has been loaded.}
+       }
 }
 
 #  renudef <flag/int> <oldname> <newname>
@@ -253,33 +213,25 @@
 # Proc written by address@hidden
 # FixMe: This proc is untested and unmodified from what he sent me.
 proc ::tcldrop::channels::renudef {type oldname newname} {
-       variable Channels
-       variable Udefs
-       variable UdefDefaults
-       if {[info exists Udefs($oldname)] && [string compare -nocase 
$Udefs($oldname) $type]} {
-               #just delete this loop if you don't want it to rename the udef 
in all channels
-               foreach c [array names Channels] {
-                       array set chaninfo $Channels($c)
-                       foreach n [array names UdefDefaults $oldname] {
-                               if {[info exists chaninfo($n)]} {
-                                       set chaninfo($newname) $UdefDefaults($n)
-                                       set Channels($c) [array get chaninfo]
-                                       array unset Channels $n
-                               }
-                       }
-                       array unset chaninfo
+       foreach a [binds channels renudef] {
+               foreach {bindtype flags mask count proc} $a {}
+               if {[set lev [catch { $proc $type $oldname $newname } val]]} {
+                       putlog "Error in script: $proc: $val"
+                       puterrlog "$::errorInfo"
+               }
+               ::tcldrop::countbind $bindtype $mask $proc
+               if {![info exists retval]} {
+                       set retlev $lev
+                       set retval $val
                }
-
-               set tempUdefs($newname) $Udefs($oldname)
-               set tempDefaults($newname) $Udefs($oldname)
-               array unset Udefs $oldname
-               array unset UdefDefaults $oldname
-               array set Udefs [array get tempUdefs]
-               array set UdefDefaults [array get tempDefaults]
+       }
+       if {[info exists retval]} {
+               return -code $retlev $retval
+       } else {
+               return -code error {No channel database module has been loaded.}
        }
 }
 
-
 #  deludef <flag/int> <name>
 #    Description: deletes a user defined channel flag or integer setting.
 #    Returns: nothing
@@ -287,23 +239,22 @@
 # Proc written by address@hidden
 # FixMe: This proc is untested and unmodified from what he sent me.
 proc ::tcldrop::channels::deludef {type name} {
-       variable Channels
-       variable Udefs
-       variable UdefDefaults
-       if {[info exists Udefs($name)] && [string compare -nocase $Udefs($name) 
$type]} {
-               #just delete this loop if you don't want it to remove the udef 
from all channels
-               foreach c [array names Channels] {
-                       array set chaninfo $Channels($c)
-                       foreach n [array names UdefDefaults $name] {
-                               if {[info exists chaninfo($n)]} {
-                                       array unset Channels $n
-                               }
-                       }
-                       array unset chaninfo
+       foreach a [binds channels deludef] {
+               foreach {bindtype flags mask count proc} $a {}
+               if {[set lev [catch { $proc $type $name } val]]} {
+                       putlog "Error in script: $proc: $val"
+                       puterrlog "$::errorInfo"
                }
-
-               array unset Udefs $name
-               array unset UdefDefaults $name
+               ::tcldrop::countbind $bindtype $mask $proc
+               if {![info exists retval]} {
+                       set retlev $lev
+                       set retval $val
+               }
+       }
+       if {[info exists retval]} {
+               return -code $retlev $retval
+       } else {
+               return -code error {No channel database module has been loaded.}
        }
 }
 
@@ -322,6 +273,17 @@
 
 # Note, these settings are defined here, but their actual functions are in the 
irc module (or possibly other modules).
 namespace eval ::tcldrop::channels {
+       set dbpriority 1
+       # Load all of the database modules..
+       foreach n $channeldbs {
+               loadmodule "channels::$n"
+               foreach c [namespace export] {
+                       if {[info commands "::tcldrop::channels::${n}::$c"] != 
{}} {
+                               bind channels {+|+} $c 
"::tcldrop::channels::${n}::$c" -priority $dbpriority
+                       }
+               }
+               incr dbpriority
+       }
        setudef str chanmode ${global-chanmode}
        setudef int idle-kick ${global-idle-kick}
        setudef int stopnethack-mode ${global-stopnethack-mode}
@@ -348,17 +310,6 @@
                if {$n != {}} {
                        setudef flag [string range $n 1 end] [string index $n 0]
                }
-       }
-       set dbpriority 1
-       # Load all of the database modules..
-       foreach n $channeldbs {
-               loadmodule "channels::$n"
-               foreach c [namespace export] {
-                       if {[info commands "::tcldrop::channels::${n}::$c"] != 
{}} {
-                               bind channels {+|+} $c 
"::tcldrop::channels::${n}::$c" -priority $dbpriority
-                       }
-               }
-               incr dbpriority
        }
        unset dbpriority n c
 }
Index: tcldrop/modules/channels/channels_arraydb.tcl
diff -u tcldrop/modules/channels/channels_arraydb.tcl:1.1 
tcldrop/modules/channels/channels_arraydb.tcl:1.2
--- tcldrop/modules/channels/channels_arraydb.tcl:1.1   Mon Dec  1 23:22:44 2003
+++ tcldrop/modules/channels/channels_arraydb.tcl       Tue Dec  2 04:01:46 2003
@@ -1,6 +1,6 @@
 # channels_arraydb.tcl --
 #
-# $Id: channels_arraydb.tcl,v 1.1 2003/12/02 04:22:44 fireegl Exp $
+# $Id: channels_arraydb.tcl,v 1.2 2003/12/02 09:01:46 fireegl Exp $
 #
 # Copyright (C) 2003 FireEgl (Philip Moore) <address@hidden>
 #
@@ -28,37 +28,37 @@
 
 namespace eval ::tcldrop::channels::arraydb {
        # Provide the channels::arraydb module:
-       variable version {0.1}
-       variable rcsid {$Id: channels_arraydb.tcl,v 1.1 2003/12/02 04:22:44 
fireegl Exp $}
+       variable version {0.8}
+       variable rcsid {$Id: channels_arraydb.tcl,v 1.2 2003/12/02 09:01:46 
fireegl Exp $}
        package provide tcldrop::channels::arraydb $version
        # Initialize variables:
+       variable Udefs
+       array set Udefs {}
        variable Channels
        array set Channels {}
+       # Set the internal defaults:
+       ::tcldrop::SetDefault chanfile {tcldrop.chan}
 }
 
-# Set the internal defaults:
-::tcldrop::SetDefault chanfile {tcldrop.chan}
-
 proc ::tcldrop::channels::arraydb::channel {command channel opts} {
-       # FixMe: Change the args variable name in the rest of this proc...
-       set args $opts
        variable Channels
        set lowerchannel [string tolower $channel]
        switch -- $command {
                {add} {
-                       if {[llength $args] > 1} {
-                               set options $args
+                       if {[llength $opts] > 1} {
+                               set options $opts
                        } else {
-                               set options [lindex $args 0]
+                               set options [lindex $opts 0]
                        }
                        # Add the channel:
                        set Channels($lowerchannel) [list name $channel]
                        # Call ourself again to set the options:
                        channel set $channel $options
+                       SetUdefDefaults
                }
                {set} {
-                       # In the case of "set", $args is already in the form we 
can use.
-                       set options $args
+                       # In the case of "set", $opts is already in the form we 
can use.
+                       set options $opts
                        array set chaninfo $Channels($lowerchannel)
                        set setnext 0
                        foreach o $options {
@@ -89,7 +89,7 @@
                                                }
                                        }
                                } else {
-                                       switch -- [set type 
[::tcldrop::channels::UdefType [set name [string trimleft $o {+-}]]]] {
+                                       switch -- [set type [UdefType [set name 
[string trimleft $o {+-}]]]] {
                                                {flag} {
                                                        switch -- [string index 
$o 0] {
                                                                {+} { set 
chaninfo($name) 1 }
@@ -121,10 +121,10 @@
                {get} {
                        if {[info exists Channels($lowerchannel)]} {
                                array set chaninfo $Channels($lowerchannel)
-                               if {[info exists chaninfo($args)]} {
-                                       return $chaninfo($args)
+                               if {[info exists chaninfo($opts)]} {
+                                       return $chaninfo($opts)
                                } else {
-                                       return -code error "Unknown channel 
setting: $args"
+                                       return -code error "Unknown channel 
setting: $opts"
                                }
                        } else {
                                return -code error "no such channel record: 
$channel"
@@ -159,10 +159,9 @@
 }
 
 # Saves the channel info to $chanfile:
-proc ::tcldrop::channels::arraydb::savechannels {opts} {
-       set args $opts
+proc ::tcldrop::channels::arraydb::savechannels {{opts {}}} {
        set fid [open $::chanfile w]
-       if {[lsearch $args -flush] != -1} { set flush 1 } else { set flush 0
+       if {[lsearch $opts -flush] != -1} { set flush 1 } else { set flush 0
                fconfigure $fid -blocking 0 -buffering full
        }
        variable Channels
@@ -185,7 +184,7 @@
        } else {
                putlog "no chanfile exists..yet."
        }
-       ::tcldrop::channels::SetUdefDefaults
+       SetUdefDefaults
 }
 
 # Returns 1 if a channel exists in the channel database, or 0 if it doesn't:
@@ -201,4 +200,124 @@
 #    Module: channels
 #
 # channame2dname <channel-name>
-# chandname2name <channel-dname>
\ No newline at end of file
+# chandname2name <channel-dname>
+
+# Gives the type of the udef given in $name:
+# It returns one of the following: int, flag, str, list, or unknown.
+proc ::tcldrop::channels::arraydb::UdefType {name} {
+       variable Udefs
+       if {[info exists Udefs($name)]} {
+               return $Udefs($name)
+       } else {
+               return {unknown}
+       }
+}
+
+proc ::tcldrop::channels::arraydb::SetUdefDefaults {{name {*}}} {
+       variable Channels
+       variable UdefDefaults
+       foreach c [array names Channels] {
+               array set chaninfo $Channels($c)
+               foreach n [array names UdefDefaults $name] {
+                       if {![info exists chaninfo($n)]} {
+                               # It's not already set, so we set it to the 
default:
+                               set chaninfo($n) $UdefDefaults($n)
+                               set Channels($c) [array get chaninfo]
+                       }
+               }
+               array unset chaninfo
+       }
+}
+
+# Note, types for udef's should be: flag, int, str, and list.
+# In the case of lists, the channel command should provide lappend, lreplace, 
and lremove commands.
+
+# Defines a new udef:
+proc ::tcldrop::channels::arraydb::setudef {type name {default {}}} {
+       # Store the default for this udef:
+       variable UdefDefaults
+       switch -- $type {
+               {flag} {
+                       switch -- $default {
+                               {1} - {+} { set UdefDefaults($name) 1 }
+                               {0} - {-} - {default} { set UdefDefaults($name) 
0 }
+                       }
+               }
+               {int} {
+                       if {$default != {}} {
+                               set UdefDefaults($name) $default
+                       } else {
+                               set UdefDefaults($name) 0
+                       }
+               }
+               {str} - {list} { set UdefDefaults($name) $default }
+               {default} {
+                       # FixMe: Give an invalid type error.
+               }
+       }
+       # Store the udef itself:
+       variable Udefs
+       set Udefs($name) [string tolower $type]
+       # Apply the default to all channels that don't already have it set:
+       SetUdefDefaults $name
+}
+
+#  renudef <flag/int> <oldname> <newname>
+#    Description: renames a user defined channel flag or integer setting.
+#    Returns: nothing
+#    Module: channels
+# Proc written by address@hidden
+# FixMe: This proc is untested and unmodified from what he sent me.
+proc ::tcldrop::channels::arraydb::renudef {type oldname newname} {
+       variable Channels
+       variable Udefs
+       variable UdefDefaults
+       if {[info exists Udefs($oldname)] && [string compare -nocase 
$Udefs($oldname) $type]} {
+               #just delete this loop if you don't want it to rename the udef 
in all channels
+               foreach c [array names Channels] {
+                       array set chaninfo $Channels($c)
+                       foreach n [array names UdefDefaults $oldname] {
+                               if {[info exists chaninfo($n)]} {
+                                       set chaninfo($newname) $UdefDefaults($n)
+                                       set Channels($c) [array get chaninfo]
+                                       array unset Channels $n
+                               }
+                       }
+                       array unset chaninfo
+               }
+
+               set tempUdefs($newname) $Udefs($oldname)
+               set tempDefaults($newname) $Udefs($oldname)
+               array unset Udefs $oldname
+               array unset UdefDefaults $oldname
+               array set Udefs [array get tempUdefs]
+               array set UdefDefaults [array get tempDefaults]
+       }
+}
+
+
+#  deludef <flag/int> <name>
+#    Description: deletes a user defined channel flag or integer setting.
+#    Returns: nothing
+#    Module: channels
+# Proc written by address@hidden
+# FixMe: This proc is untested and unmodified from what he sent me.
+proc ::tcldrop::channels::arraydb::deludef {type name} {
+       variable Channels
+       variable Udefs
+       variable UdefDefaults
+       if {[info exists Udefs($name)] && [string compare -nocase $Udefs($name) 
$type]} {
+               #just delete this loop if you don't want it to remove the udef 
from all channels
+               foreach c [array names Channels] {
+                       array set chaninfo $Channels($c)
+                       foreach n [array names UdefDefaults $name] {
+                               if {[info exists chaninfo($n)]} {
+                                       array unset Channels $n
+                               }
+                       }
+                       array unset chaninfo
+               }
+               array unset Udefs $name
+               array unset UdefDefaults $name
+       }
+}
\ No newline at end of file
Index: tcldrop/modules/conn.tcl
diff -u tcldrop/modules/conn.tcl:1.8 tcldrop/modules/conn.tcl:1.9
--- tcldrop/modules/conn.tcl:1.8        Sun Nov 30 20:59:51 2003
+++ tcldrop/modules/conn.tcl    Tue Dec  2 04:01:46 2003
@@ -3,7 +3,7 @@
 #              * The connect and control commands, used for all outgoing 
connections.
 #      Depends: idx.
 #
-# $Id: conn.tcl,v 1.8 2003/12/01 01:59:51 fireegl Exp $
+# $Id: conn.tcl,v 1.9 2003/12/02 09:01:46 fireegl Exp $
 #
 # Copyright (C) 2003 FireEgl (Philip Moore) <address@hidden>
 #
@@ -134,6 +134,10 @@
        if {![catch { read -nonewline $idxinfo(sock) } lines]} {
                foreach line [split $lines \n] {
                        $idxinfo(control) $idx $line
+                       # The update is here so that one connection can't be 
flooded and drown
+                       # out the other connections and therefore making them 
less responsive.
+                       # At least that's what I hope it's good for.  =)
+                       update
                }
        } else {
                putloglev d * "net: eof!(read) idx $idx"
Index: tcldrop/modules/server/server.tcl
diff -u tcldrop/modules/server/server.tcl:1.15 
tcldrop/modules/server/server.tcl:1.16
--- tcldrop/modules/server/server.tcl:1.15      Mon Dec  1 16:38:35 2003
+++ tcldrop/modules/server/server.tcl   Tue Dec  2 04:01:46 2003
@@ -1,6 +1,6 @@
 # server.tcl --
 #
-# $Id: server.tcl,v 1.15 2003/12/01 21:38:35 fireegl Exp $
+# $Id: server.tcl,v 1.16 2003/12/02 09:01:46 fireegl Exp $
 #
 # Copyright (C) 2003 FireEgl (Philip Moore) <address@hidden>
 #
@@ -27,7 +27,7 @@
 
 namespace eval ::tcldrop::server {
        variable version {0.8}
-       variable rcsid {$Id: server.tcl,v 1.15 2003/12/01 21:38:35 fireegl Exp 
$}
+       variable rcsid {$Id: server.tcl,v 1.16 2003/12/02 09:01:46 fireegl Exp 
$}
        # Provide the server module:
        package provide tcldrop::server $version
        # Initialize variables:
@@ -57,7 +57,8 @@
        ::tcldrop::SetDefault server-cycle-wait {93}
        ::tcldrop::SetDefault servererror-quit {1}
        ::tcldrop::SetDefault botname {}
-       loadmodule conn
+       ::tcldrop::SetDefault botnick {}
+       checkmodule conn
 }
 
 proc ::tcldrop::server::isbotnick {nick} { string equal -nocase $nick 
$::botnick }
Index: tcldrop/modules/users/users.tcl
diff -u tcldrop/modules/users/users.tcl:1.20 
tcldrop/modules/users/users.tcl:1.21
--- tcldrop/modules/users/users.tcl:1.20        Mon Dec  1 19:57:51 2003
+++ tcldrop/modules/users/users.tcl     Tue Dec  2 04:01:47 2003
@@ -1,6 +1,6 @@
 # users.tcl --
 #
-# $Id: users.tcl,v 1.20 2003/12/02 00:57:51 fireegl Exp $
+# $Id: users.tcl,v 1.21 2003/12/02 09:01:47 fireegl Exp $
 #
 # Copyright (C) 2003 FireEgl (Philip Moore) <address@hidden>
 #
@@ -51,7 +51,7 @@
 
 namespace eval ::tcldrop::users {
        variable version {0.7}
-       variable rcsid {$Id: users.tcl,v 1.20 2003/12/02 00:57:51 fireegl Exp $}
+       variable rcsid {$Id: users.tcl,v 1.21 2003/12/02 09:01:47 fireegl Exp $}
        # Provide the users module:
        package provide tcldrop::users $version
        # Export all the commands that should be available to 3rd-party 
scripters:
@@ -453,9 +453,6 @@
 }
 
 # Saves the user database to the hard disk:
-# The default is to write it in the background (nonblocking).
-# If the -flush option is given, then save doesn't return until it's been 
completly written to disk.
-# Note, I don't even know if there's any noticable speed difference by using 
nonblocking..
 proc ::tcldrop::users::save {args} {
        foreach a [binds users save] {
                foreach {type flags mask count proc} $a {}
@@ -522,17 +519,19 @@
 # The ban, ignore, exempt, and invite related stuff should be in other modules.
 
 # Load all of the database modules..
-set dbpriority 1
-foreach n $userdbs {
-       loadmodule "users::$n"
-       foreach c {adduser countusers validuser finduser matchattr 
matchchanattr userlist passwdok getuser setuser getinfo getchaninfo 
getting-users chhandle chattr botattr adduser addbot deluser delhost addchanrec 
delchanrec encpass save backup reload chpass setlaston} {
-               if {[info commands "::tcldrop::users::${n}::$c"] != {}} {
-                       bind users {+|+} $c "::tcldrop::users::${n}::$c" 
-priority $dbpriority
+namespace eval ::tcldrop::users {
+       set dbpriority 1
+       foreach n $userdbs {
+               loadmodule "users::$n"
+               foreach c [namespace export] {
+                       if {[info commands "::tcldrop::users::${n}::$c"] != {}} 
{
+                               bind users {+|+} $c 
"::tcldrop::users::${n}::$c" -priority $dbpriority
+                       }
                }
+               incr dbpriority
        }
-       incr dbpriority
+       unset dbpriority n c
 }
-unset dbpriority n
 
 # After Tcldrop loads, we (re)load the userfile:
 bind evnt - loaded ::tcldrop::users::Loaded -priority 0




reply via email to

[Prev in Thread] Current Thread [Next in Thread]