File: alltools.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 (399 lines) | stat: -rw-r--r-- 8,094 bytes parent folder | download | duplicates (3)
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
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
#
# All-Tools TCL, includes toolbox.tcl, toolkit.tcl and moretools.tcl
# toolbox was authored by cmwagner@sodre.net
# toolkit was authored by (Someone claim this)[unknown]
# moretools was authored by David Sesno(walker@shell.pcrealm.net)
#
# TG        ?????????: modified for 1.3.0 bots
# Tothwolf  02May1999: rewritten and updated
# guppy     02May1999: updated even more
# Tothwolf  02May1999: fixed what guppy broke and updated again
# Tothwolf  24/25May1999: more changes
# rtc       20Sep1999: added isnumber, changes
# dw        20Sep1999: use regexp for isnumber checking
# Tothwolf  06Oct1999: optimized completely
# krbb      09Jun2000: added missing return to randstring
# Tothwolf  18Jun2000: added ispermowner
# Sup       02Apr2001: added matchbotattr
# Tothwolf  13Jun2001: updated/modified several commands
# Hanno     28Sep2001: fixed testip
# guppy     03Mar2002: optimized
# Souperman 05Nov2002: added ordnumber
#
# $Id: alltools.tcl 67 2005-04-26 10:38:39Z shroud23 $
#
########################################
# Descriptions of available commands:
## (toolkit):
# putmsg <nick/chan> <text>
#   send a privmsg to the given nick or channel
#
# putchan <nick/chan> <text>
#   send a privmsg to the given nick or channel
#   (for compat only, this is the same as 'putmsg' above)
#
# putnotc <nick/chan> <text>
#   send a notice to the given nick or channel
#
# putact <nick/chan> <text>
#   send an action to the given nick or channel
#
## (toolbox):
# strlwr <string>
#   string tolower
#
# strupr <string>
#   string toupper
#
# strcmp <string1> <string2>
#   string compare
#
# stricmp <string1> <string2>
#   string compare (case insensitive)
#
# strlen <string>
#   string length
#
# stridx <string> <index>
#   string index
#
# iscommand <command>
#   if the given command exists, return 1
#   else return 0
#
# timerexists <command>
#   if the given command is scheduled by a timer, return its timer id
#   else return empty string
#
# utimerexists <command>
#   if the given command is scheduled by a utimer, return its utimer id
#   else return empty string
#
# inchain <bot>
#   if the given bot is connected to the botnet, return 1
#   else return 0
#   (for compat only, same as 'islinked')
#
# randstring <length>
#   returns a random string of the given length
#
# putdccall <text>
#   send the given text to all dcc users
#
# putdccbut <idx> <text>
#   send the given text to all dcc users except for the given idx
#
# killdccall
#   kill all dcc user connections
#
# killdccbut <idx>
#   kill all dcc user connections except for the given idx
#
## (moretools):
# iso <nick> <channel>
#   if the given nick has +o access on the given channel, return 1
#   else return 0
#
# realtime [format]
#   'time' returns the current time in 24 hour format '14:15'
#   'date' returns the current date in the format '21 Dec 1994'
#   not specifying any format will return the current time in
#   12 hour format '1:15 am'
#
# testip <ip>
#   if the given ip is valid, return 1
#   else return 0
#
# number_to_number <number>
#   if the given number is between 1 and 15, return its text representation
#   else return the number given
#
## (other commands):
# isnumber <string>
#   if the given string is a valid number, return 1
#   else return 0
#
# ispermowner <handle>
#   if the given handle is a permanent owner, return 1
#   else return 0
#
# matchbotattr <bot> <flags>
#   if the given bot has all the given flags, return 1
#   else return 0
#
# ordnumber <string>
#   if the given string is a number, returns the
#   "ordinal" version of that number, i.e. 1 -> "1st",
#   2 -> "2nd", etc.
#   else return <string>
#
########################################

# So scripts can see if allt is loaded.
set alltools_loaded 1
set allt_version 205

# For backward compatibility.
set toolbox_revision 1007
set toolbox_loaded 1
set toolkit_loaded 1

#
# toolbox:
#

proc putmsg {dest text} {
  puthelp "PRIVMSG $dest :$text"
}

proc putchan {dest text} {
  puthelp "PRIVMSG $dest :$text"
}

proc putnotc {dest text} {
  puthelp "NOTICE $dest :$text"
}

proc putact {dest text} {
  puthelp "PRIVMSG $dest :\001ACTION $text\001"
}

#
# toolkit:
#

proc strlwr {string} {
  string tolower $string
}

proc strupr {string} {
  string toupper $string
}

proc strcmp {string1 string2} {
  string compare $string1 $string2
}

proc stricmp {string1 string2} {
  string compare [string tolower $string1] [string tolower $string2]
}

proc strlen {string} {
  string length $string
}

proc stridx {string index} {
  string index $string $index
}

proc iscommand {command} {
  if {[string compare "" [info commands $command]]} then {
    return 1
  }
  return 0
}

proc timerexists {command} {
  foreach i [timers] {
    if {![string compare $command [lindex $i 1]]} then {
      return [lindex $i 2]
    }
  }
  return
}

proc utimerexists {command} {
  foreach i [utimers] {
    if {![string compare $command [lindex $i 1]]} then {
      return [lindex $i 2]
    }
  }
  return
}

proc inchain {bot} {
  islinked $bot
}

proc randstring {length {chars abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789}} {
  set count [string length $chars]
  for {set index 0} {$index < $length} {incr index} {
    append result [string index $chars [rand $count]]
  }
  return $result
}

proc putdccall {text} {
  foreach i [dcclist CHAT] {
    putdcc [lindex $i 0] $text
  }
}

proc putdccbut {idx text} {
  foreach i [dcclist CHAT] {
    set j [lindex $i 0]
    if {$j != $idx} then {
      putdcc $j $text
    }
  }
}

proc killdccall {} {
  foreach i [dcclist CHAT] {
    killdcc [lindex $i 0]
  }
}

proc killdccbut {idx} {
  foreach i [dcclist CHAT] {
    set j [lindex $i 0]
    if {$j != $idx} then {
      killdcc $j
    }
  }
}

#
# moretools:
#

proc iso {nick chan} {
  matchattr [nick2hand $nick $chan] o|o $chan
}

proc realtime {args} {
  switch -exact -- [lindex $args 0] {
    time {
      return [strftime %H:%M]
    }
    date {
      return [strftime "%d %b %Y"]
    }
    default {
      return [strftime "%I:%M %P"]
    }
  }
}

proc testip {ip} {
  set tmp [split $ip .]
  if {[llength $tmp] != 4} then {
    return 0
  }
  set index 0
  foreach i $tmp {
    if {(([regexp \[^0-9\] $i]) || ([string length $i] > 3) || \
         (($index == 3) && (($i > 254) || ($i < 1))) || \
         (($index <= 2) && (($i > 255) || ($i < 0))))} then {
      return 0
    }
    incr index
  }
  return 1
}

proc number_to_number {number} {
  switch -exact -- $number {
    0 {
      return Zero
    }
    1 {
      return One
    }
    2 {
      return Two
    }
    3 {
      return Three
    }
    4 {
      return Four
    }
    5 {
      return Five
    }
    6 {
      return Six
    }
    7 {
      return Seven
    }
    8 {
      return Eight
    }
    9 {
      return Nine
    }
    10 {
      return Ten
    }
    11 {
      return Eleven
    }
    12 {
      return Twelve
    }
    13 {
      return Thirteen
    }
    14 {
      return Fourteen
    }
    15 {
      return Fifteen
    }
    default {
      return $number
    }
  }
}

#
# other commands:
#

proc isnumber {string} {
  if {([string compare "" $string]) && \
      (![regexp \[^0-9\] $string])} then {
    return 1
  }
  return 0
}

proc ispermowner {hand} {
  global owner

  regsub -all -- , [string tolower $owner] "" owners
  if {([matchattr $hand n]) && \
      ([lsearch -exact $owners [string tolower $hand]] != -1)} then {
    return 1
  }
  return 0
}

proc matchbotattr {bot flags} {
  foreach flag [split $flags ""] {
    if {[lsearch -exact [split [botattr $bot] ""] $flag] == -1} then {
      return 0
    }
  }
  return 1
}

proc ordnumber {str} {
  if {[isnumber $str]} {
    set last1 [string range $str [expr [strlen $str]-1] end]
    set last2 [string range $str [expr [strlen $str]-2] end]
    if {$last1=="1"&&$last2!="11"} {
      return "[expr $str]st"
    } elseif {$last1=="2"&&$last2!="12"} {
      return "[expr $str]nd"
    } elseif {$last1=="3"&&$last2!="13"} {
      return "[expr $str]rd"
    } else {
      return "[expr $str]th"
    }
  } else {
    return "$str"
  }
}