File: channel.tcl

package info (click to toggle)
sbnc 1.2-26
  • links: PTS
  • area: main
  • in suites: wheezy
  • size: 6,216 kB
  • sloc: cpp: 17,556; ansic: 15,514; sh: 13,419; tcl: 5,567; php: 448; makefile: 284
file content (327 lines) | stat: -rw-r--r-- 7,755 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
# shroudBNC - an object-oriented framework for IRC
# Copyright (C) 2005 Gunnar Beutner
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

internaltimer 120 1 sbnc:channelflush
internalbind unload sbnc:channelflush
internalbind usrdelete sbnc:channelconfdelete
internalbind server sbnc:channelpart PART
internalbind server sbnc:channeljoin JOIN

proc sbnc:channelflush {} {
	foreach user [bncuserlist] {
		setctx $user
		savechannels

		foreach channel [channels] {
			if {![validchan $channel]} {
				channel set $channel +autochan
				channel set $channel -inactive
			}

			if {![botonchan $channel]} {
				if {[channel get $channel autochan]} {
					channel remove $channel
					continue
				}

				if {![channel get $channel inactive]} {
					# simul so we can take advantage of keyrings
					simul [getctx] "JOIN $channel"
				}
			}
		}
	}
}

proc sbnc:channelconfdelete {client} {
	file delete "/var/lib/sbnc/users/$client.chan"
}

proc sbnc:channelpart {client params} {
	if {![isbotnick [lindex [split [lindex $params 0] "!"] 0]]} { return }

	if {[string equal -nocase [lindex $params 1] "PART"] && [validchan [lindex $params 2]]} {
		channel set [lindex $params 2] +inactive
	}
}

proc sbnc:channeljoin {client params} {
	if {![isbotnick [lindex [split [lindex $params 0] "!"] 0]]} { return }

	if {[string equal -nocase [lindex $params 1] "JOIN"]} {
		if {![validchan [lindex $params 2]]} {
			channel set [lindex $params 2] +autochan
		}

		channel set [lindex $params 2] -inactive
	}
}

proc channel {option chan args} {
	namespace eval [getns] {
		if {![info exists channels]} { array set channels {} }
		if {![info exists channels_dirty]} { set channels_dirty 0 }
		if {![info exists chanoptions]} { array set chanoptions {} }
	}

	setudef flag inactive
	setudef flag autochan

	set chan [string tolower $chan]

	upvar [getns]::channels channels
	upvar [getns]::channels_dirty channels_dirty
	upvar [getns]::chanoptions chanoptions

	if {[botonchan $chan] && ![info exists channels($chan)]} {
		set channels($chan) [list]
	}

	if {[info exists channels($chan)]} {
		array set channel $channels($chan)
	} else {
		array set channel [list]
	}

	switch [string tolower $option] {
		add {
			set channels($chan) [join $args]
			set channels_dirty 1

			if {![channel get $chan autochan] && ![channel get $chan inactive]} {
				simul [getctx] "JOIN $chan"
			}

			return 1
		}
		set {
			if {[llength $args] < 1} { return -code error "Too few parameters" }

			set first [string index [lindex $args 0] 0]

			if {$first == "+" || $first == "-"} {
				set option [string range [lindex $args 0] 1 end]
			} else {
				set option [lindex $args 0]
			}

			set value [lindex $args 1]

			if {![info exists chanoptions($option)]} {
				return -code error "No such option."
			} elseif {[string equal -nocase $chanoptions($option) "int"]} {
				if {[llength $args] < 2} { return -code error "Too few parameters" }
				elseif {![string is digit $value]} { return -code error "Value is not an integer." }

				set channel($option) $value
			} elseif {$first == "+" || $first == "-"} {
				if {![string equal -nocase $chanoptions($option) "flag"]} { return -code error "Value is not a flag." }

				if {$first == "+"} {
					set channel($option) 1
				} else {
					set channel($option) 0
				}
			} elseif {![validchan $chan]} {
				return -code error "no such channel record"
			} else {
				set channel($option) $value
				set channels_dirty 1
			}

			set channels($chan) [array get channel]

			return [lindex $args 1]
		}
		info {
			return $channels($chan)
		}
		get {
			if {[llength $args] < 1} { return -code error "Too few parameters" }

			if {![info exists chanoptions([lindex $args 0])]} {
				return -code error "No such option."
			} elseif {![validchan $chan]} {
				return -code error "no such channel record"
			} elseif {[info exists channel([lindex $args 0])]} {
				return $channel([lindex $args 0])
			} else {
				if {$chanoptions(inactive) == "int" || $chanoptions(inactive) == "flag"} {
					return 0
				} else {
					return {}
				}
			}
		}
		remove {
			if {[botonchan $chan]} {
				puthelp "PART $chan"
			}

			if {[info exists channels($chan)]} {
				unset channels($chan)
				set channels_dirty 1
			} else {
				return -code error "no such channel record"
			}

			return 1
		}
		default {
			return -code error "Option should be one of: add set info get remove"
		}
	}
}

proc savechannels {{force_write 0}} {
	namespace eval [getns] {
		if {![info exists channels]} { array set channels {} }
		if {![info exists channels_dirty]} { set channels_dirty 0 }
	}

	upvar [getns]::channels channels
	upvar [getns]::channels_dirty channels_dirty

	if {$channels_dirty || $force_write} {
		set file [open $::chanfile "w"]

		foreach channel [array names channels] {
			puts $file "channel add $channel \{ $channels($channel) \}"
		}

		close $file
	}

	return 1
}

proc loadchannels {} {
	namespace eval [getns] {
		array set channels {}
	}

	catch [list source $::chanfile]

	return
}

proc channels {} {
	namespace eval [getns] {
		if {![info exists channels]} { array set channels {} }
	}

	upvar [getns]::channels channels

	set tmpchans [array names channels]

	if {[getbncuser [getctx] hasserver] && ![catch [list internalchannels] channellist]} {
		foreach chan $channellist {
			lappend tmpchans $chan
		}
	}

	return [sbnc:uniq [string tolower $tmpchans]]
}

proc validchan {channel} {
	namespace eval [getns] {
		if {![info exists channels]} { array set channels {} }
	}

	set channel [string tolower $channel]

	upvar [getns]::channels channels

	if {[info exists channels($channel)]} {
		return 1
	} else {
		return 0
	}
}

proc isdynamic {channel} {
	return [validchan $channel]
}

proc setudef {type name} {
	namespace eval [getns] {
		if {![info exists chanoptions]} { array set chanoptions {} }
	}

	upvar [getns]::chanoptions chanoptions

	set chanoptions($name) $type

	return
}

proc renudef {type oldname newname} {
	namespace eval [getns] {
		if {![info exists channels]} { array set channels {} }
		if {![info exists chanoptions]} { array set chanoptions {} }
	}

	upvar [getns]::chanoptions chanoptions
	upvar [getns]::channels channels

	if {[info exists chanoptions($newname)]} {
		return -code error "$newname is already a channel option."
	}

	if {[info exists chanoptions($oldname)]} {
		set chanoptions($newname) $chanoptions($oldname)
		unset chanoptions($oldname)
	} else {
		setudef $type $newname
	}

	foreach channame [array names channels] {
		array set channel $channels($channame)

		if {[info exists channel($oldname)]} {
			set channel($newname) $channel($oldname)
			unset channel($oldname)
		}

		set channels($channame) [array get channel]
	}

	return
}

proc deludef {type name} {
	namespace eval [getns] {
		if {![info exists chanoptions]} { array set chanoptions {} }
	}

	upvar [getns]::chanoptions chanoptions

	if {[info exists chanoptions($name)]} {
		unset chanoptions($name)
	}

	return
}

if {![info exists sbnc:channelinit]} {
	foreach user [bncuserlist] {
		setctx $user
		loadchannels
	}

	set sbnc:channelinit 1
}