30 |
variable version {0.8} |
variable version {0.8} |
31 |
variable rcsid {$Id$} |
variable rcsid {$Id$} |
32 |
package provide tcldrop::channels $version |
package provide tcldrop::channels $version |
|
# Initialize variables: |
|
|
variable Udefs |
|
|
array set Udefs {} |
|
33 |
# Export all the commands that should be available to 3rd-party scripters: |
# Export all the commands that should be available to 3rd-party scripters: |
34 |
namespace export channel channels loadchannels savechannels validchan setudef renudef deludef countchannels |
namespace export channel channels loadchannels savechannels validchan setudef renudef deludef countchannels |
35 |
# Set the default channel database module: |
# Set the default channel database module: |
56 |
::tcldrop::SetDefault global-exempt-time 29 |
::tcldrop::SetDefault global-exempt-time 29 |
57 |
::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] |
::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] |
58 |
|
|
|
# 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} |
|
|
} |
|
|
} |
|
|
|
|
59 |
proc ::tcldrop::channels::channel {command channel args} { |
proc ::tcldrop::channels::channel {command channel args} { |
60 |
foreach a [binds channels channel] { |
foreach a [binds channels channel] { |
61 |
foreach {type flags mask count proc} $a {} |
foreach {type flags mask count proc} $a {} |
140 |
} |
} |
141 |
} |
} |
142 |
|
|
|
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 |
|
|
} |
|
|
} |
|
|
|
|
143 |
# Loads the channel info from $chanfile: |
# Loads the channel info from $chanfile: |
144 |
proc ::tcldrop::channels::loadchannels {} { |
proc ::tcldrop::channels::loadchannels {} { |
145 |
foreach a [binds channels loadchannels] { |
foreach a [binds channels loadchannels] { |
159 |
} else { |
} else { |
160 |
return -code error {No channel database module has been loaded.} |
return -code error {No channel database module has been loaded.} |
161 |
} |
} |
|
SetUdefDefaults |
|
162 |
} |
} |
163 |
|
|
164 |
# Returns 1 if a channel exists in the channel database, or 0 if it doesn't: |
# Returns 1 if a channel exists in the channel database, or 0 if it doesn't: |
187 |
|
|
188 |
# Defines a new udef: |
# Defines a new udef: |
189 |
proc ::tcldrop::channels::setudef {type name {default {}}} { |
proc ::tcldrop::channels::setudef {type name {default {}}} { |
190 |
# Store the default for this udef: |
foreach a [binds channels setudef] { |
191 |
variable UdefDefaults |
foreach {bindtype flags mask count proc} $a {} |
192 |
switch -- $type { |
if {[set lev [catch { $proc $type $name } val]]} { |
193 |
{flag} { |
putlog "Error in script: $proc: $val" |
194 |
switch -- $default { |
puterrlog "$::errorInfo" |
|
{1} - {+} { set UdefDefaults($name) 1 } |
|
|
{0} - {-} - {default} { set UdefDefaults($name) 0 } |
|
|
} |
|
|
} |
|
|
{int} { |
|
|
if {$default != {}} { |
|
|
set UdefDefaults($name) $default |
|
|
} else { |
|
|
set UdefDefaults($name) 0 |
|
|
} |
|
195 |
} |
} |
196 |
{str} - {list} { set UdefDefaults($name) $default } |
::tcldrop::countbind $bindtype $mask $proc |
197 |
{default} { |
if {![info exists retval]} { |
198 |
# FixMe: Give an invalid type error. |
set retlev $lev |
199 |
|
set retval $val |
200 |
} |
} |
201 |
} |
} |
202 |
# Store the udef itself: |
if {[info exists retval]} { |
203 |
variable Udefs |
return -code $retlev $retval |
204 |
set Udefs($name) [string tolower $type] |
} else { |
205 |
# Apply the default to all channels that don't already have it set: |
return -code error {No channel database module has been loaded.} |
206 |
SetUdefDefaults $name |
} |
207 |
} |
} |
208 |
|
|
209 |
# renudef <flag/int> <oldname> <newname> |
# renudef <flag/int> <oldname> <newname> |
213 |
# Proc written by Papillon@EFNet. |
# Proc written by Papillon@EFNet. |
214 |
# FixMe: This proc is untested and unmodified from what he sent me. |
# FixMe: This proc is untested and unmodified from what he sent me. |
215 |
proc ::tcldrop::channels::renudef {type oldname newname} { |
proc ::tcldrop::channels::renudef {type oldname newname} { |
216 |
variable Channels |
foreach a [binds channels renudef] { |
217 |
variable Udefs |
foreach {bindtype flags mask count proc} $a {} |
218 |
variable UdefDefaults |
if {[set lev [catch { $proc $type $oldname $newname } val]]} { |
219 |
if {[info exists Udefs($oldname)] && [string compare -nocase $Udefs($oldname) $type]} { |
putlog "Error in script: $proc: $val" |
220 |
#just delete this loop if you don't want it to rename the udef in all channels |
puterrlog "$::errorInfo" |
221 |
foreach c [array names Channels] { |
} |
222 |
array set chaninfo $Channels($c) |
::tcldrop::countbind $bindtype $mask $proc |
223 |
foreach n [array names UdefDefaults $oldname] { |
if {![info exists retval]} { |
224 |
if {[info exists chaninfo($n)]} { |
set retlev $lev |
225 |
set chaninfo($newname) $UdefDefaults($n) |
set retval $val |
|
set Channels($c) [array get chaninfo] |
|
|
array unset Channels $n |
|
|
} |
|
|
} |
|
|
array unset chaninfo |
|
226 |
} |
} |
227 |
|
} |
228 |
set tempUdefs($newname) $Udefs($oldname) |
if {[info exists retval]} { |
229 |
set tempDefaults($newname) $Udefs($oldname) |
return -code $retlev $retval |
230 |
array unset Udefs $oldname |
} else { |
231 |
array unset UdefDefaults $oldname |
return -code error {No channel database module has been loaded.} |
|
array set Udefs [array get tempUdefs] |
|
|
array set UdefDefaults [array get tempDefaults] |
|
232 |
} |
} |
233 |
} |
} |
234 |
|
|
|
|
|
235 |
# deludef <flag/int> <name> |
# deludef <flag/int> <name> |
236 |
# Description: deletes a user defined channel flag or integer setting. |
# Description: deletes a user defined channel flag or integer setting. |
237 |
# Returns: nothing |
# Returns: nothing |
239 |
# Proc written by Papillon@EFNet. |
# Proc written by Papillon@EFNet. |
240 |
# FixMe: This proc is untested and unmodified from what he sent me. |
# FixMe: This proc is untested and unmodified from what he sent me. |
241 |
proc ::tcldrop::channels::deludef {type name} { |
proc ::tcldrop::channels::deludef {type name} { |
242 |
variable Channels |
foreach a [binds channels deludef] { |
243 |
variable Udefs |
foreach {bindtype flags mask count proc} $a {} |
244 |
variable UdefDefaults |
if {[set lev [catch { $proc $type $name } val]]} { |
245 |
if {[info exists Udefs($name)] && [string compare -nocase $Udefs($name) $type]} { |
putlog "Error in script: $proc: $val" |
246 |
#just delete this loop if you don't want it to remove the udef from all channels |
puterrlog "$::errorInfo" |
|
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 |
|
247 |
} |
} |
248 |
|
::tcldrop::countbind $bindtype $mask $proc |
249 |
array unset Udefs $name |
if {![info exists retval]} { |
250 |
array unset UdefDefaults $name |
set retlev $lev |
251 |
|
set retval $val |
252 |
|
} |
253 |
|
} |
254 |
|
if {[info exists retval]} { |
255 |
|
return -code $retlev $retval |
256 |
|
} else { |
257 |
|
return -code error {No channel database module has been loaded.} |
258 |
} |
} |
259 |
} |
} |
260 |
|
|
273 |
|
|
274 |
# Note, these settings are defined here, but their actual functions are in the irc module (or possibly other modules). |
# Note, these settings are defined here, but their actual functions are in the irc module (or possibly other modules). |
275 |
namespace eval ::tcldrop::channels { |
namespace eval ::tcldrop::channels { |
276 |
|
set dbpriority 1 |
277 |
|
# Load all of the database modules.. |
278 |
|
foreach n $channeldbs { |
279 |
|
loadmodule "channels::$n" |
280 |
|
foreach c [namespace export] { |
281 |
|
if {[info commands "::tcldrop::channels::${n}::$c"] != {}} { |
282 |
|
bind channels {+|+} $c "::tcldrop::channels::${n}::$c" -priority $dbpriority |
283 |
|
} |
284 |
|
} |
285 |
|
incr dbpriority |
286 |
|
} |
287 |
setudef str chanmode ${global-chanmode} |
setudef str chanmode ${global-chanmode} |
288 |
setudef int idle-kick ${global-idle-kick} |
setudef int idle-kick ${global-idle-kick} |
289 |
setudef int stopnethack-mode ${global-stopnethack-mode} |
setudef int stopnethack-mode ${global-stopnethack-mode} |
311 |
setudef flag [string range $n 1 end] [string index $n 0] |
setudef flag [string range $n 1 end] [string index $n 0] |
312 |
} |
} |
313 |
} |
} |
|
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 |
|
|
} |
|
314 |
unset dbpriority n c |
unset dbpriority n c |
315 |
} |
} |
316 |
|
|