[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Tcldrop/CVS] tcldrop/modules/channels channels.tcl pkgIndex....
From: |
Philip Moore |
Subject: |
[Tcldrop/CVS] tcldrop/modules/channels channels.tcl pkgIndex.... |
Date: |
Mon, 01 Dec 2003 23:22:44 -0500 |
CVSROOT: /cvsroot/tcldrop
Module name: tcldrop
Branch:
Changes by: Philip Moore <address@hidden> 03/12/01 23:22:44
Modified files:
modules/channels: channels.tcl pkgIndex.tcl
Added files:
modules/channels: channels_arraydb.tcl
Log message:
Split the channels module into two in the same way that users.tcl and
users_arraydb.tcl is split.
CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/tcldrop/tcldrop/modules/channels/channels_arraydb.tcl?rev=1.1
http://savannah.gnu.org/cgi-bin/viewcvs/tcldrop/tcldrop/modules/channels/channels.tcl.diff?tr1=1.12&tr2=1.13&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/tcldrop/tcldrop/modules/channels/pkgIndex.tcl.diff?tr1=1.2&tr2=1.3&r1=text&r2=text
Patches:
Index: tcldrop/modules/channels/channels.tcl
diff -u tcldrop/modules/channels/channels.tcl:1.12
tcldrop/modules/channels/channels.tcl:1.13
--- tcldrop/modules/channels/channels.tcl:1.12 Mon Dec 1 19:57:51 2003
+++ tcldrop/modules/channels/channels.tcl Mon Dec 1 23:22:44 2003
@@ -1,6 +1,6 @@
# channels.tcl --
#
-# $Id: channels.tcl,v 1.12 2003/12/02 00:57:51 fireegl Exp $
+# $Id: channels.tcl,v 1.13 2003/12/02 04:22:44 fireegl Exp $
#
# Copyright (C) 2003 FireEgl (Philip Moore) <address@hidden>
#
@@ -28,19 +28,18 @@
namespace eval ::tcldrop::channels {
# Provide the channels module:
variable version {0.8}
- variable rcsid {$Id: channels.tcl,v 1.12 2003/12/02 00:57:51 fireegl
Exp $}
+ variable rcsid {$Id: channels.tcl,v 1.13 2003/12/02 04:22:44 fireegl
Exp $}
package provide tcldrop::channels $version
# Initialize variables:
- variable Channels
- array set Channels {}
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:
+ ::tcldrop::SetDefault channeldbs [list {arraydb}]
}
# Set the internal defaults:
-::tcldrop::SetDefault chanfile {tcldrop.chan}
::tcldrop::SetDefault force-expire 0
::tcldrop::SetDefault share-greet 0
::tcldrop::SetDefault use-info 1
@@ -72,132 +71,87 @@
}
proc ::tcldrop::channels::channel {command channel args} {
- variable Channels
- set lowerchannel [string tolower $channel]
- switch -- $command {
- {add} {
- if {[llength $args] > 1} {
- set options $args
- } else {
- set options [lindex $args 0]
- }
- # Add the channel:
- set Channels($lowerchannel) [list name $channel]
- # Call ourself again to set the options:
- channel set $channel $options
- }
- {set} {
- # In the case of "set" $args is already in the form we
can use.
- set options $args
- array set chaninfo $Channels($lowerchannel)
- set setnext 0
- foreach o $options {
- if {$setnext} {
- set setnext 0
- switch -- $type {
- {int} {
- # Note, settings such
as flood-chan are treated as int's. Hence the need for using split here:
- set chaninfo($name)
[split $o {:{ }}]
- }
- {str} { set chaninfo($name) $o }
- {list} { lappend
chaninfo($name) $o }
- {flag} {
- # This is so we can
support flags being set like:
- # [channel set #channel
bitch +]
- # or: [channel set
#channel revenge 1]
- # The old way is still
supported though. (see below)
- switch -- $o {
- {+} - {1} { set
chaninfo($name) 1 }
- {-} - {0} { set
chaninfo($name) 0 }
- {default} {
- #
FixMe: Give an error.
- }
- }
- }
- {unknown} - {default} {
- # FixMe: Give an error.
- }
- }
- } else {
- switch -- [set type [UdefType [set name
[string trimleft $o {+-}]]]] {
- {flag} {
- switch -- [string index
$o 0] {
- {+} { set
chaninfo($name) 1 }
- {-} { set
chaninfo($name) 0 }
- {default} {
- # They
must want to set it using a second arg...
- set
setnext 1
- }
- }
- }
- {int} - {str} - {list} { set
setnext 1 }
- {unknown} - {default} {
- # FixMe: Give an error.
- }
- }
- }
- }
- set Channels($lowerchannel) [array get chaninfo]
- }
- {info} {
- # COMPATIBILITY WARNING: Because Eggdrop doesn't return
the info in any documented or understandable order,
- # Tcldrop will return a list of
each channel setting and it's value. This way makes the info MUCH easier to
use by Tcl scripters.
- if {[info exists Channels($lowerchannel)]} {
- return $Channels($lowerchannel)
- } else {
- return -code error "no such channel record:
$channel"
- }
- }
- {get} {
- if {[info exists Channels($lowerchannel)]} {
- array set chaninfo $Channels($lowerchannel)
- if {[info exists chaninfo($args)]} {
- return $chaninfo($args)
- } else {
- return -code error "Unknown channel
setting: $args"
- }
- } else {
- return -code error "no such channel record:
$channel"
- }
- }
- {remove} {
- if {[info exists Channels($lowerchannel)]} {
- unset Channels($lowerchannel)
- } else {
- return -code error "no such channel record:
$channel"
- }
+ foreach a [binds channels channel] {
+ foreach {type flags mask count proc} $a {}
+ if {[set lev [catch { $proc $command $channel $args } val]]} {
+ putlog "Error in script: $proc: $val"
+ puterrlog "$::errorInfo"
+ }
+ ::tcldrop::countbind $type $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.}
+ }
}
# Just like in Eggdrop, returns the list of channels.
proc ::tcldrop::channels::channels {} {
- variable Channels
- set channels {}
- foreach c [array names Channels] {
- array set chaninfo $Channels($c)
- lappend channels $chaninfo(name)
+ foreach a [binds channels channels] {
+ foreach {type flags mask count proc} $a {}
+ if {[set lev [catch { $proc } val]]} {
+ putlog "Error in script: $proc: $val"
+ puterrlog "$::errorInfo"
+ }
+ ::tcldrop::countbind $type $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.}
}
- return $channels
}
# This isn't from Eggdrop, but I'm providing it anyway:
# Works just like [countusers], except this counts how many channels there are.
proc ::tcldrop::channels::countchannels {} {
- variable Channels
- array size Channels
+ foreach a [binds channels countchannels] {
+ foreach {type flags mask count proc} $a {}
+ if {[set lev [catch { $proc } val]]} {
+ putlog "Error in script: $proc: $val"
+ puterrlog "$::errorInfo"
+ }
+ ::tcldrop::countbind $type $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.}
+ }
}
# Saves the channel info to $chanfile:
proc ::tcldrop::channels::savechannels {args} {
- set fid [open $::chanfile w]
- if {[lsearch $args -flush] != -1} { set flush 1 } else { set flush 0
- fconfigure $fid -blocking 0 -buffering full
+ foreach a [binds channels savechannels] {
+ foreach {type flags mask count proc} $a {}
+ if {[set lev [catch { $proc $args } val]]} {
+ putlog "Error in script: $proc: $val"
+ puterrlog "$::errorInfo"
+ }
+ ::tcldrop::countbind $type $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.}
}
- variable Channels
- puts $fid [array get Channels]
- if {$flush} { flush $fid }
- close $fid
}
proc ::tcldrop::channels::SetUdefDefaults {{name {*}}} {
@@ -218,25 +172,45 @@
# Loads the channel info from $chanfile:
proc ::tcldrop::channels::loadchannels {} {
- if {[file exists $::chanfile]} {
- set fid [open $::chanfile r]
- variable Channels
- putlog "loading chanfile ($::chanfile)..."
- # FixMe: This shouldn't just dump the file into the Channels
array...
- # It needs to check each channel for udefs that
- # are no longer in use, and discard them.
- array set Channels [read $fid [file size $::chanfile]]
- close $fid
+ foreach a [binds channels loadchannels] {
+ foreach {type flags mask count proc} $a {}
+ if {[set lev [catch { $proc } val]]} {
+ putlog "Error in script: $proc: $val"
+ puterrlog "$::errorInfo"
+ }
+ ::tcldrop::countbind $type $mask $proc
+ if {![info exists retval]} {
+ set retlev $lev
+ set retval $val
+ }
+ }
+ if {[info exists retval]} {
+ return -code $retlev $retval
} else {
- putlog "no chanfile exists..yet."
+ 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:
proc ::tcldrop::channels::validchan {channel} {
- variable Channels
- info exists Channels([string tolower $channel])
+ foreach a [binds channels validchan] {
+ foreach {type flags mask count proc} $a {}
+ if {[set lev [catch { $proc $channel } val]]} {
+ putlog "Error in script: $proc: $val"
+ puterrlog "$::errorInfo"
+ }
+ ::tcldrop::countbind $type $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.}
+ }
}
# Note, types for udef's should be: flag, int, str, and list.
@@ -370,12 +344,23 @@
setudef str need-halfop {}
setudef str need-voice {}
# Note, global-chanset better be a list:
- foreach f ${::global-chanset} {
- if {$f != {}} {
- setudef flag [string range $f 1 end] [string index $f 0]
+ foreach n ${::global-chanset} {
+ 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 f
+ unset dbpriority n c
}
# After Tcldrop loads, we (re)load the chanfile:
Index: tcldrop/modules/channels/pkgIndex.tcl
diff -u tcldrop/modules/channels/pkgIndex.tcl:1.2
tcldrop/modules/channels/pkgIndex.tcl:1.3
--- tcldrop/modules/channels/pkgIndex.tcl:1.2 Tue May 27 11:32:09 2003
+++ tcldrop/modules/channels/pkgIndex.tcl Mon Dec 1 23:22:44 2003
@@ -1,11 +1,3 @@
-# Tcl package index file, version 1.1
-# This file is generated by the "pkg_mkIndex" command
-# and sourced either when an application starts up or
-# by a "package unknown" script. It invokes the
-# "package ifneeded" command to set up package-related
-# information so that packages will be loaded automatically
-# in response to "package require" commands. When this
-# script is sourced, the variable $dir must contain the
-# full path name of this file's directory.
-
package ifneeded tcldrop::channels 0.2 [list source [file join $dir
channels.tcl]]
+package ifneeded tcldrop::channels::arraydb 0.1 [list source [file join $dir
channels_arraydb.tcl]]
+
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Tcldrop/CVS] tcldrop/modules/channels channels.tcl pkgIndex....,
Philip Moore <=