tcldrop-commits
[Top][All Lists]
Advanced

[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]]
+




reply via email to

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