/[tcldrop]/tcldrop/modules/channels/channels.tcl
ViewVC logotype

Diff of /tcldrop/modules/channels/channels.tcl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.12 by fireegl, Tue Dec 2 00:57:51 2003 UTC revision 1.13 by fireegl, Tue Dec 2 04:22:44 2003 UTC
# Line 31  namespace eval ::tcldrop::channels { Line 31  namespace eval ::tcldrop::channels {
31          variable rcsid {$Id$}          variable rcsid {$Id$}
32          package provide tcldrop::channels $version          package provide tcldrop::channels $version
33          # Initialize variables:          # Initialize variables:
         variable Channels  
         array set Channels {}  
34          variable Udefs          variable Udefs
35          array set Udefs {}          array set Udefs {}
36          # Export all the commands that should be available to 3rd-party scripters:          # Export all the commands that should be available to 3rd-party scripters:
37          namespace export channel channels loadchannels savechannels validchan setudef renudef deludef countchannels          namespace export channel channels loadchannels savechannels validchan setudef renudef deludef countchannels
38            # Set the default channel database module:
39            ::tcldrop::SetDefault channeldbs [list {arraydb}]
40  }  }
41    
42  # Set the internal defaults:  # Set the internal defaults:
 ::tcldrop::SetDefault chanfile {tcldrop.chan}  
43  ::tcldrop::SetDefault force-expire 0  ::tcldrop::SetDefault force-expire 0
44  ::tcldrop::SetDefault share-greet 0  ::tcldrop::SetDefault share-greet 0
45  ::tcldrop::SetDefault use-info 1  ::tcldrop::SetDefault use-info 1
# Line 72  proc ::tcldrop::channels::UdefType {name Line 71  proc ::tcldrop::channels::UdefType {name
71  }  }
72    
73  proc ::tcldrop::channels::channel {command channel args} {  proc ::tcldrop::channels::channel {command channel args} {
74          variable Channels          foreach a [binds channels channel] {
75          set lowerchannel [string tolower $channel]                  foreach {type flags mask count proc} $a {}
76          switch -- $command {                  if {[set lev [catch { $proc $command $channel $args } val]]} {
77                  {add} {                          putlog "Error in script: $proc: $val"
78                          if {[llength $args] > 1} {                          puterrlog "$::errorInfo"
79                                  set options $args                  }
80                          } else {                  ::tcldrop::countbind $type $mask $proc
81                                  set options [lindex $args 0]                  if {![info exists retval]} {
82                          }                          set retlev $lev
83                          # Add the channel:                          set retval $val
                         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"  
                         }  
84                  }                  }
85          }          }
86            if {[info exists retval]} {
87                    return -code $retlev $retval
88            } else {
89                    return -code error {No channel database module has been loaded.}
90            }
91  }  }
92    
93  # Just like in Eggdrop, returns the list of channels.  # Just like in Eggdrop, returns the list of channels.
94  proc ::tcldrop::channels::channels {} {  proc ::tcldrop::channels::channels {} {
95          variable Channels          foreach a [binds channels channels] {
96          set channels {}                  foreach {type flags mask count proc} $a {}
97          foreach c [array names Channels] {                  if {[set lev [catch { $proc } val]]} {
98                  array set chaninfo $Channels($c)                          putlog "Error in script: $proc: $val"
99                  lappend channels $chaninfo(name)                          puterrlog "$::errorInfo"
100                    }
101                    ::tcldrop::countbind $type $mask $proc
102                    if {![info exists retval]} {
103                            set retlev $lev
104                            set retval $val
105                    }
106            }
107            if {[info exists retval]} {
108                    return -code $retlev $retval
109            } else {
110                    return -code error {No channel database module has been loaded.}
111          }          }
         return $channels  
112  }  }
113    
114  # This isn't from Eggdrop, but I'm providing it anyway:  # This isn't from Eggdrop, but I'm providing it anyway:
115  # Works just like [countusers], except this counts how many channels there are.  # Works just like [countusers], except this counts how many channels there are.
116  proc ::tcldrop::channels::countchannels {} {  proc ::tcldrop::channels::countchannels {} {
117          variable Channels          foreach a [binds channels countchannels] {
118          array size Channels                  foreach {type flags mask count proc} $a {}
119                    if {[set lev [catch { $proc } val]]} {
120                            putlog "Error in script: $proc: $val"
121                            puterrlog "$::errorInfo"
122                    }
123                    ::tcldrop::countbind $type $mask $proc
124                    if {![info exists retval]} {
125                            set retlev $lev
126                            set retval $val
127                    }
128            }
129            if {[info exists retval]} {
130                    return -code $retlev $retval
131            } else {
132                    return -code error {No channel database module has been loaded.}
133            }
134  }  }
135    
136  # Saves the channel info to $chanfile:  # Saves the channel info to $chanfile:
137  proc ::tcldrop::channels::savechannels {args} {  proc ::tcldrop::channels::savechannels {args} {
138          set fid [open $::chanfile w]          foreach a [binds channels savechannels] {
139          if {[lsearch $args -flush] != -1} { set flush 1 } else { set flush 0                  foreach {type flags mask count proc} $a {}
140                  fconfigure $fid -blocking 0 -buffering full                  if {[set lev [catch { $proc $args } val]]} {
141                            putlog "Error in script: $proc: $val"
142                            puterrlog "$::errorInfo"
143                    }
144                    ::tcldrop::countbind $type $mask $proc
145                    if {![info exists retval]} {
146                            set retlev $lev
147                            set retval $val
148                    }
149            }
150            if {[info exists retval]} {
151                    return -code $retlev $retval
152            } else {
153                    return -code error {No channel database module has been loaded.}
154          }          }
         variable Channels  
         puts $fid [array get Channels]  
         if {$flush} { flush $fid }  
         close $fid  
155  }  }
156    
157  proc ::tcldrop::channels::SetUdefDefaults {{name {*}}} {  proc ::tcldrop::channels::SetUdefDefaults {{name {*}}} {
# Line 218  proc ::tcldrop::channels::SetUdefDefault Line 172  proc ::tcldrop::channels::SetUdefDefault
172    
173  # Loads the channel info from $chanfile:  # Loads the channel info from $chanfile:
174  proc ::tcldrop::channels::loadchannels {} {  proc ::tcldrop::channels::loadchannels {} {
175          if {[file exists $::chanfile]} {          foreach a [binds channels loadchannels] {
176                  set fid [open $::chanfile r]                  foreach {type flags mask count proc} $a {}
177                  variable Channels                  if {[set lev [catch { $proc } val]]} {
178                  putlog "loading chanfile ($::chanfile)..."                          putlog "Error in script: $proc: $val"
179                  # FixMe: This shouldn't just dump the file into the Channels array...                          puterrlog "$::errorInfo"
180                  #        It needs to check each channel for udefs that                  }
181                  #        are no longer in use, and discard them.                  ::tcldrop::countbind $type $mask $proc
182                  array set Channels [read $fid [file size $::chanfile]]                  if {![info exists retval]} {
183                  close $fid                          set retlev $lev
184                            set retval $val
185                    }
186            }
187            if {[info exists retval]} {
188                    return -code $retlev $retval
189          } else {          } else {
190                  putlog "no chanfile exists..yet."                  return -code error {No channel database module has been loaded.}
191          }          }
192          SetUdefDefaults          SetUdefDefaults
193  }  }
194    
195  # 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:
196  proc ::tcldrop::channels::validchan {channel} {  proc ::tcldrop::channels::validchan {channel} {
197          variable Channels          foreach a [binds channels validchan] {
198          info exists Channels([string tolower $channel])                  foreach {type flags mask count proc} $a {}
199                    if {[set lev [catch { $proc $channel } val]]} {
200                            putlog "Error in script: $proc: $val"
201                            puterrlog "$::errorInfo"
202                    }
203                    ::tcldrop::countbind $type $mask $proc
204                    if {![info exists retval]} {
205                            set retlev $lev
206                            set retval $val
207                    }
208            }
209            if {[info exists retval]} {
210                    return -code $retlev $retval
211            } else {
212                    return -code error {No channel database module has been loaded.}
213            }
214  }  }
215    
216  # Note, types for udef's should be: flag, int, str, and list.  # Note, types for udef's should be: flag, int, str, and list.
# Line 370  namespace eval ::tcldrop::channels { Line 344  namespace eval ::tcldrop::channels {
344          setudef str need-halfop {}          setudef str need-halfop {}
345          setudef str need-voice {}          setudef str need-voice {}
346          # Note, global-chanset better be a list:          # Note, global-chanset better be a list:
347          foreach f ${::global-chanset} {          foreach n ${::global-chanset} {
348                  if {$f != {}} {                  if {$n != {}} {
349                          setudef flag [string range $f 1 end] [string index $f 0]                          setudef flag [string range $n 1 end] [string index $n 0]
350                    }
351            }
352            set dbpriority 1
353            # Load all of the database modules..
354            foreach n $channeldbs {
355                    loadmodule "channels::$n"
356                    foreach c [namespace export] {
357                            if {[info commands "::tcldrop::channels::${n}::$c"] != {}} {
358                                    bind channels {+|+} $c "::tcldrop::channels::${n}::$c" -priority $dbpriority
359                            }
360                  }                  }
361                    incr dbpriority
362          }          }
363          unset f          unset dbpriority n c
364  }  }
365    
366  # After Tcldrop loads, we (re)load the chanfile:  # After Tcldrop loads, we (re)load the chanfile:

Legend:
Removed from v.1.12  
changed lines
  Added in v.1.13

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26