/[cvs]/wolfpack/wolfpack.tcl
ViewVC logotype

Annotation of /wolfpack/wolfpack.tcl

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.35 - (hide annotations) (download) (as text)
Tue Jul 8 02:14:12 2003 UTC (15 years, 11 months ago) by tothwolf
Branch: MAIN
Changes since 1.34: +424 -169 lines
File MIME type: application/x-tcl
*** empty log message ***

1 guppy 1.1 #! /bin/sh
2     # \
3     # Nice little hack to find latest version of tclsh in PATH \
4     # \
5     # NOTE: backslash and semicolon placements are important! \
6     # \
7     # Search for tclsh[0-9].[0-9] in each valid dir in PATH \
8     for dir in $(echo $PATH | sed 's/:/ /g'); \
9     do \
10     if test -d $dir; \
11     then \
12     files=$(/bin/ls $dir | egrep '^tclsh[0-9]\.[0-9]$'); \
13     if test "$files" != ""; \
14     then \
15     versions="${versions:+$versions }$(echo $files | sed 's/tclsh//g')"; \
16     fi; \
17     fi; \
18     done; \
19     # Loop over each version to find the latest version of tclsh \
20     for ver in $versions; \
21     do \
22     tmpver=$(echo $ver | sed 's/\.//g'); \
23     if test "$lasttmpver" != ""; \
24     then \
25     if test "$tmpver" -gt "$lasttmpver"; \
26     then \
27     lastver=$ver; \
28     lasttmpver=$tmpver; \
29     fi; \
30     else \
31     lastver=$ver; \
32     lasttmpver=$tmpver; \
33     fi; \
34     done; \
35     # Use the latest tclsh version found, otherwise fall back to 'tclsh' \
36     exec tclsh$lastver "$0" "$@"
37     ###############################################################################
38     ##
39     ## Wolfpack - A modular Tcl system for Eggdrop 1.3.0+ with Tcl 8.0+
40 tothwolf 1.9 ## Copyright (C) 1998-2003 Tothwolf <tothwolf@concentric.net>
41 guppy 1.1 ##
42     ## This program is free software; you can redistribute it and/or modify
43     ## it under the terms of the GNU General Public License as published by
44     ## the Free Software Foundation; either version 2 of the License, or
45     ## (at your option) any later version.
46     ##
47     ## This program is distributed in the hope that it will be useful,
48     ## but WITHOUT ANY WARRANTY; without even the implied warranty of
49     ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
50     ## GNU General Public License for more details.
51     ##
52     ## You should have received a copy of the GNU General Public License
53     ## along with this program; if not, write to the Free Software
54     ## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
55     ##
56     ###############################################################################
57     ##
58     ## You should not need to edit anything in any of these files.
59     ##
60 tothwolf 1.9 ## './wolfpack.tcl -c' may be used to configure initial settings.
61 guppy 1.1 ## './wolfpack.tcl --help' will list all avaliable options.
62     ##
63 tothwolf 1.7 ## Use '.wpconf' in dcc chat with the bot to configure everything else.
64 guppy 1.1 ##
65     ###############################################################################
66     ##
67 tothwolf 1.35 ## $Id: wolfpack.tcl,v 1.34 2003/02/12 20:36:22 tothwolf Exp $
68 guppy 1.1 ##
69    
70 tothwolf 1.33 # Make sure Tcl version is compatible with this code (we use namespaces)
71 guppy 1.1 if {[catch {package require Tcl 8.0}]} then {
72     if {[info exists argv0]} then {
73     puts "Wolfpack: Error: wolfpack requires Tcl 8.0 or later to load."
74     } else {
75     putloglev o * "Wolfpack: Error: wolfpack requires Tcl 8.0 or later to load."
76     }
77 tothwolf 1.33 return
78 guppy 1.1 }
79    
80     namespace eval :: {
81    
82 tothwolf 1.35 # Eggdrop doesn't currently set argv0, so we use it to detect load type.
83 guppy 1.1 if {![info exists argv0]} then {
84 tothwolf 1.33 # Fix for buggy tcl variables in pre 1.3.28 Eggdrop versions
85 guppy 1.1 catch {set numversion}
86 tothwolf 1.33
87     # Require eggdrop 1.3.0 or later
88     if {(![info exists numversion]) || ($numversion < 1030000)} then {
89 guppy 1.1 putloglev o * "Wolfpack: Error: wolfpack requires Eggdrop 1.3.0 or later to load."
90 tothwolf 1.33 return
91 guppy 1.1 }
92     } else {
93 tothwolf 1.33 # Emulate eggdrop's putloglev when loading with tclsh
94 guppy 1.1 if {![string compare "" [info commands putloglev]]} then {
95     proc putloglev {level channel text} {
96     puts $text
97     }
98     }
99     }
100    
101     ##
102     ## Log tcl messages where they can be seen
103     ##
104     ## Args: text
105     ## Returns: nothing
106     ##
107     proc tclLog {text} {
108     # Tcl's tclLog embeds newlines in it's output
109     if {[string first \n $text] == -1} then {
110     putloglev o * "Wolfpack: \[Tcl\]: $text"
111     } else {
112     foreach line [split $text \n] {
113     putloglev o * "Wolfpack: \[Tcl\]: $line"
114     }
115     }
116     return
117     }
118    
119     } ;# namespace ::
120    
121     namespace eval ::wp {
122    
123     # manage package information
124     package forget ::wp
125     package provide ::wp 1.9.9.0
126    
127     # set namespace variable
128     set NamespaceCurrent [namespace current]
129    
130     ##
131     ## WARNING: If you change these, you may render your module database useless!
132     ##
133    
134     # Max number of lines to scan in a module file
135     set moduleDatabaseConfig(scanlines) 30
136    
137     # Max depth to list directories in module path
138     set moduleDatabaseConfig(maxdepth) 4
139    
140     # Module database version
141     set moduleDatabaseConfig(version) 2.0
142    
143     # Module database header
144     set moduleDatabaseConfig(header) "Wolfpack module database "
145    
146     # Module database defaults
147     set moduleDatabaseConfig(defaults) "{version 0.1} {description {(no description)}} {load 0}"
148    
149     # Versioned module database formats
150     array set moduleDatabaseFormat {
151 tothwolf 1.34 2.0 "{version config author description provides requires} {load file md5sum}"
152 guppy 1.1 }
153    
154     # md5 style, command name and result string index
155     array set md5Format {
156     bsd "md5 3"
157     gnu "md5sum 0"
158     }
159    
160 tothwolf 1.9 # Configuration defaults, values and descriptions
161     array set configDefaults {
162     modulepath {word modules/ {} {Module path}}
163     configpath {word wpconf/ {} {Config path}}
164     datapath {word wpdata/ {} {Data path}}
165     moddbfile {word wolfpack.db {} {Module database file}}
166 tothwolf 1.35 update {{range {0 1}} 1 {} {Automatically update module database}}
167 tothwolf 1.9 verbose {{range {0 1}} 0 {} {Verbose operation}}
168 tothwolf 1.35 time {{range {0 1}} 0 {} {Time module database compare/update/rebuild}}
169 guppy 1.1 }
170    
171     # Command line option defaults
172     array set optionData {
173 tothwolf 1.35 cfgfile ""
174 guppy 1.1 config 0
175 tothwolf 1.35 update 0
176     noupdate 0
177 guppy 1.1 rebuild 0
178     time 0
179 tothwolf 1.35 include ""
180     exclude ""
181     module ""
182 guppy 1.1 verbose 0
183     quiet 0
184     debug 0
185     }
186    
187     # Exported commands
188     set ExportList {
189     md5Sum
190     md5Init
191     replaceExpr
192     listFiles
193     listSubdirs
194     findFiles
195     createFile
196     createDir
197     backupFile
198 tothwolf 1.35 shortFile
199 guppy 1.1 listSave
200     listLoad
201     arraySave
202     arrayLoad
203     arraySetAll
204     arrayFindElementName
205     arrayMaxElementDataLength
206 tothwolf 1.35 listAppendIf
207 guppy 1.1 listMaxElementLength
208 tothwolf 1.2 splitList
209 tothwolf 1.35 expandText
210 guppy 1.1 arraySearch
211     dataFormatDefault
212     dataFormatValue
213     dataFormatReplace
214     dataFormatBuild
215     dataFormatConvert
216     scanModule
217     getModuleDatabaseData
218     setModuleDatabaseData
219     saveModuleDatabase
220     loadModuleDatabase
221 tothwolf 1.35 updateModuleData
222     updateModuleDatabase
223 guppy 1.1 rebuildModuleDatabase
224     listModules
225     moduleExists
226     moduleLoaded
227 tothwolf 1.15 moduleBindUnbind
228 guppy 1.1 moduleLoad
229     moduleUnload
230 tothwolf 1.9 moduleConfigSave
231     moduleConfigLoad
232     moduleConfigCheckdefs
233 guppy 1.1 moduleConfig
234 tothwolf 1.9 moduleDataSave
235     moduleDataLoad
236     moduleDataBackup
237 guppy 1.1 moduleData
238     buildCommandTable
239     whichCommand
240     whichModule
241     whichModuleCommand
242 tothwolf 1.30 configExists
243 guppy 1.1 compareVersion
244     wpLog
245     }
246    
247     ##
248     ## Create md5 checksum for a file
249     ##
250     ## Args: filename
251     ## Returns: md5 checksum if successful
252     ## Errors: permission denied,
253     ## no such file,
254     ## not a file,
255     ## can't exec md5 command
256     ##
257     proc md5Sum {file} {
258     variable md5Config
259    
260     if {![file exists $file]} then {
261     error "$file: no such file"
262     } else {
263     if {![file isfile $file]} then {
264     error "$file: not a file"
265     } else {
266     if {![file readable $file]} then {
267     error "$file: permission denied"
268     } else {
269     if {[catch {set sum [lindex [exec $md5Config(command) $file] $md5Config(index)]} result]} then {
270     error "$file: $result"
271     } else {
272     return $sum
273     }
274     }
275     }
276     }
277     }
278    
279     ##
280     ## Init md5 command
281     ##
282     ## Args: none
283     ## Returns: 1 if a useable md5 command found
284     ## 0 otherwise
285     ##
286     proc md5Init {} {
287     variable md5Config
288     variable md5Format
289    
290     foreach type [array names md5Format] {
291     foreach {command index} $md5Format($type) {break}
292     if {([catch {exec $command ""} result]) && \
293     (![regexp -- "^couldn't execute" $result])} then {
294     set md5Config(command) $command
295     set md5Config(index) $index
296     return 1
297     }
298     }
299     return 0
300     }
301    
302     ##
303     ## Replace all occurances of an expression in a string with the given text
304     ##
305     ## Args: string, expr, replacement text
306     ## Returns: string
307     ##
308     proc replaceExpr {string expr {replace ""}} {
309     while {[regexp -nocase -- $expr $string]} {
310     regsub -all -- $expr $string $replace string
311     }
312     return $string
313     }
314    
315     ##
316     ## List files in a path
317     ##
318     ## Args: path
319     ## Returns: list of files in the given path,
320     ## nothing if no files in the given path
321     ## Errors: permission denied,
322     ## no such directory,
323     ## not a directory
324     ##
325     proc listFiles {path} {
326     if {![file exists $path]} then {
327     error "$path: no such directory"
328     } else {
329     if {![file isdirectory $path]} then {
330     error "$path: not a directory"
331     } else {
332     if {![file readable $path]} then {
333     error "$path: permission denied"
334     } else {
335     set ret ""
336     foreach name [lsort [glob -nocomplain -- [file join $path *]]] {
337     if {[file isfile $name]} then {
338     lappend ret $name
339     }
340     }
341     return $ret
342     }
343     }
344     }
345     }
346    
347     ##
348     ## List subdirs in a path
349     ##
350     ## Args: path
351     ## Returns: list of subdirs in the given path,
352     ## nothing if no subdirs in the given path
353     ## Errors: permission denied,
354     ## no such directory,
355     ## not a directory
356     ##
357     proc listSubdirs {path} {
358     if {![file exists $path]} then {
359     error "$path: no such directory"
360     } else {
361     if {![file isdirectory $path]} then {
362     error "$path: not a directory"
363     } else {
364     if {![file readable $path]} then {
365     error "$path: permission denied"
366     } else {
367     set ret ""
368     foreach name [lsort [glob -nocomplain -- [file join $path *]]] {
369     if {[file isdirectory $name]} then {
370     lappend ret $name
371     }
372     }
373     return $ret
374     }
375     }
376     }
377     }
378    
379     ##
380     ## List files with a set ext in a path and its subdirs up to a set depth
381     ##
382     ## Args: path, max search depth, file extension
383     ## Returns: list of files with a set ext in the given path and its subdirs,
384     ## nothing if no matching files are found
385     ##
386     proc findFiles {path depth {ext ""}} {
387     set ret ""
388     set foundDirs "$path "
389     set searchDirs $path
390     for {
391     set currentDepth 0
392     } {($currentDepth <= $depth) || (!$depth)} {
393     incr currentDepth
394     } {
395     set subDirs ""
396     foreach dir $searchDirs {
397     if {[catch {set dirList [listSubdirs $dir]} result]} then {
398     wpLog o * "Error: unable to get file listing: $result"
399     } elseif {[string compare "" $dirList]} then {
400     append subDirs $dirList " "
401     }
402     }
403     if {![string compare "" $subDirs]} then {
404     break
405     }
406     append foundDirs $subDirs " "
407     set searchDirs $subDirs
408     }
409     foreach dir $foundDirs {
410     if {[catch {set files [listFiles $dir]} result]} then {
411     wpLog o * "Error: unable to get file listing: $result"
412     } else {
413     if {[string compare "" $ext]} then {
414     foreach file $files {
415     if {![string compare $ext \
416     [string tolower [file extension $file]]]} then {
417     lappend ret $file
418     }
419     }
420     } else {
421     set ret $files
422     }
423     }
424     }
425     return $ret
426     }
427    
428     ##
429     ## Check if a file exists, and create it if not
430     ##
431     ## Args: filename, verbose {-1,0,1}, description, force new file
432     ## Returns: 1 if the file was created successfully
433     ## 0 if the operation failed
434     ## -1 if the file already exists
435     ##
436     proc createFile {file {verbose 0} {desc "file "} {force 0}} {
437     if {($force) || (![file exists $file])} then {
438     if {[catch {set fd [open $file w]} result]} then {
439     if {$verbose >= 0} then {
440     wpLog o * "Error: unable to create ${desc}`[file tail $file]': $result"
441     }
442     } else {
443     if {(!$force) && ($verbose >= 1)} then {
444     wpLog o * "Warning: ${desc}`[file tail $file]' does not exist -- creating"
445     }
446     close $fd
447     return 1
448     }
449     } elseif {[file isfile $file]} then {
450     return -1
451     } elseif {$verbose >= 0} then {
452     wpLog o * "Error: not a file: $file"
453     }
454     return 0
455     }
456    
457     ##
458     ## Check if a directory exists, and create it if not
459     ##
460     ## Args: directory, verbose {-1,0,1}, description
461     ## Returns: 1 if the directory was created successfully
462     ## 0 if the operation failed
463     ## -1 if the directory already exists
464     ##
465     proc createDir {dir {verbose 0} {desc "directory "}} {
466     if {![file exists $dir]} then {
467     if {[catch {file mkdir $dir} result]} then {
468     if {$verbose >= 0} then {
469     wpLog o * "Error: unable to create ${desc}`[file tail $dir]': $result"
470     }
471     } else {
472     if {$verbose >= 1} then {
473     wpLog o * "Warning: ${desc}`[file tail $dir]' does not exist -- creating"
474     }
475     return 1
476     }
477     } elseif {[file isdirectory $dir]} then {
478     return -1
479     } elseif {$verbose >= 0} then {
480     wpLog o * "Error: not a directory: $dir"
481     }
482     return 0
483     }
484    
485     ##
486     ## Create a backup of the given file with an optional suffix
487     ##
488     ## Args: filename, suffix, verbose {-1,0,1}
489 tothwolf 1.5 ## Returns: 1 if successful
490     ## -1 if file is 0 in size
491     ## 0 otherwise
492 guppy 1.1 ##
493     proc backupFile {file {verbose 0} {suffix ~bak}} {
494     variable NamespaceCurrent
495    
496     if {[string compare "" $suffix]} then {
497 tothwolf 1.6 if {[file size $file]} then {
498     if {[catch {
499 guppy 1.1 file copy -force $file $file${suffix}
500 tothwolf 1.6 } result]} then {
501     if {$verbose >= 0} then {
502     wpLog o * $NamespaceCurrent "Error: unable to create backup file for `[file tail $file]': $result"
503     }
504 tothwolf 1.5 } else {
505 tothwolf 1.6 return 1
506 guppy 1.1 }
507     } else {
508 tothwolf 1.6 return -1
509 guppy 1.1 }
510     }
511     return 0
512     }
513    
514     ##
515 tothwolf 1.35 ## Remove directory component from a filename
516     ##
517     ## Args: file, pathlist
518     ## Returns: file with directory component removed
519     ##
520     proc shortFile {file {pathlist ""}} {
521     if {[string compare "" $pathlist]} then {
522     foreach dir [lsort -decreasing $pathlist] {
523     set dirlength [string length $dir]
524     set filedir [string range $file 0 [expr $dirlength - 1]]
525     if {![string compare $dir $filedir]} then {
526     return [string trimleft [string range $file $dirlength end] /]
527     }
528     }
529     }
530     return [string trimleft [string range $file [string last / $file] end] /]
531     }
532    
533     ##
534 guppy 1.1 ## Save data from a list into a file
535     ##
536     ## Args: list, filename, verbose {-1,0,1}, description, access flag
537     ## Returns: 1 is successful,
538     ## 0 otherwise
539     ##
540     proc listSave {listName file {verbose 0} {desc "file "} {access w}} {
541     upvar 1 $listName list
542    
543     if {[createFile $file $verbose $desc]} then {
544     if {[catch {set fd [open $file $access]} result]} then {
545     if {$verbose >= 0} then {
546     wpLog o * "Error: unable to open ${desc}`$file' for writing: $result"
547     }
548     } else {
549     if {[info exists list]} then {
550     foreach data $list {
551     puts $fd [list $data]
552     }
553     }
554     close $fd
555     return 1
556     }
557     }
558     return 0
559     }
560    
561     ##
562     ## Load data into a list from a file
563     ##
564     ## Args: list, filename, verbose {-1,0,1}, description, ignore regsub
565     ## Returns: 1 if successful,
566     ## 0 otherwise
567     ##
568     proc listLoad {listName file {verbose 0} {desc "file "} {ignore "^#"}} {
569     upvar 1 $listName list
570    
571     if {[createFile $file $verbose $desc]} then {
572     if {[catch {set fd [open $file r]} result]} then {
573     if {$verbose >= 0} then {
574     wpLog o * "Error: unable to open ${desc}`$file' for reading: $result"
575     }
576     } else {
577     if {[info exists list]} then {
578     unset list
579     }
580     while {![eof $fd]} {
581     set line [replaceExpr [gets $fd] "^ "]
582     if {([string compare "" $line]) && \
583     (![regexp -- $ignore $line])} then {
584     append list $line " "
585     }
586     }
587     close $fd
588     return 1
589     }
590     }
591     return 0
592     }
593    
594     ##
595     ## Save data from an array info a file
596     ##
597     ## Args: array, filename, verbose {-1,0,1}, description, access flag
598     ## Returns: 1 is successful,
599     ## 0 otherwise
600     ##
601     proc arraySave {arrayName file {verbose 0} {desc "file "} {access w}} {
602     upvar 1 $arrayName array
603    
604     if {[createFile $file $verbose $desc]} then {
605     if {[catch {set fd [open $file $access]} result]} then {
606     if {$verbose >= 0} then {
607     wpLog o * "Error: unable to open ${desc}`$file' for writing: $result"
608     }
609     } else {
610     if {[array exists array]} then {
611     foreach name [lsort [array names array]] {
612     puts $fd "[list $name] [list $array($name)]"
613     }
614     close $fd
615     return 1
616     } else {
617     close $fd
618     }
619     }
620     }
621     return 0
622     }
623    
624     ##
625     ## Load data into an array from a file
626     ##
627     ## Args: array, filename, verbose {-1,0,1}, description, ignore regsub
628     ## Returns: 1 if successful,
629     ## 0 otherwise
630     ##
631     proc arrayLoad {arrayName file {verbose 0} {desc "file "} {ignore "^#"}} {
632     upvar 1 $arrayName array
633    
634     if {[createFile $file $verbose $desc]} then {
635     if {[catch {set fd [open $file r]} result]} then {
636     if {$verbose >= 0} then {
637     wpLog o * "Error: unable to open ${desc}`$file' for reading: $result"
638     }
639     } else {
640     if {[info exists array]} then {
641     unset array
642     }
643     while {![eof $fd]} {
644     set line [replaceExpr [gets $fd] "^ "]
645     if {([string compare "" $line]) && \
646     (![regexp -- $ignore $line])} then {
647     set array([lindex $line 0]) [lindex $line 1]
648     }
649     }
650     close $fd
651     return 1
652     }
653     }
654     return 0
655     }
656    
657     ##
658     ## Set all elements in the given array the the given value
659     ##
660     ## Args: array name, value
661     ## Returns: 1 if the array exists
662     ## 0 otherwise
663     ##
664     proc arraySetAll {arrayName {value ""}} {
665     upvar 1 $arrayName array
666    
667     if {[array exists array]} then {
668     foreach name [array names array] {
669     set array($name) $value
670     }
671     return 1
672     }
673     return 0
674     }
675    
676     ##
677     ## Find the given element in an array
678     ##
679     ## Args: array name, element name
680     ## Returns: case sensitive element name if found,
681     ## nothing otherwise
682     ##
683     proc arrayFindElementName {array element} {
684     set list [lsort [array names $array]]
685     set index [lsearch -exact [string tolower $list] [string tolower $name]]
686     if {$index != -1} then {
687     return [lindex $list $index]
688     }
689     return
690     }
691    
692     ##
693 tothwolf 1.9 ## Return length of longest data in an array at index
694 guppy 1.1 ##
695     ## Args: array name
696     ## Returns: length of longest name in an array
697     ##
698 tothwolf 1.9 proc arrayMaxElementDataLength {arrayName index} {
699 guppy 1.1 upvar 1 $arrayName array
700    
701     set maxlength 0
702     foreach {name data} [array get array] {
703 tothwolf 1.9 set length [string length [lindex $data $index]]
704 guppy 1.1 if {$length > $maxlength} then {
705     set maxlength $length
706     }
707     }
708     return $maxlength
709     }
710    
711     ##
712 tothwolf 1.35 ## Append something to the given list if it is not already in the list
713     ##
714     ## Args: listVar, what
715     ## Returns: list
716     ##
717     proc listAppendIf {listVar {what ""}} {
718     upvar 1 $listVar list
719    
720     if {([string compare "" $what]) &&
721     ((![info exists list]) || ([lsearch -exact $list $what] == -1))} then {
722     lappend list $what
723     }
724     return $list
725     }
726    
727     ##
728 guppy 1.1 ## Return length of the longest element in a list
729     ##
730 tothwolf 1.32 ## Args: list, index
731 guppy 1.1 ## Returns: length of longest element in the given list
732     ##
733 tothwolf 1.32 proc listMaxElementLength {list {index 0}} {
734 guppy 1.1 set maxlength 0
735     foreach data $list {
736 tothwolf 1.32 set length [string length [lindex $data $index]]
737 guppy 1.1 if {$length > $maxlength} then {
738     set maxlength $length
739     }
740     }
741     return $maxlength
742     }
743    
744     ##
745 tothwolf 1.2 ## Split up a list into multiple elements
746     ##
747     ## Args: text, max list length, split char, trim chars
748     ## Returns: split list
749     ##
750 tothwolf 1.9 # FIXME: improve this
751 tothwolf 1.2 proc splitList {text {splitLength 75} {splitChar " "} {trimChars " "}} {
752     # Sanity check splitLength and splitChar
753     if {($splitLength >= 1) && ([string compare "" $splitChar])} then {
754     set elementSplitLength [expr $splitLength - 1]
755     set stringLength [string length $text] ;# Total length of string
756     set subStringLength 0 ;# Text left over
757     set elementLength 0 ;# Element length counter
758     set elementStartIndex 0 ;# Start of split element
759     set elementEndIndex 0 ;# End of split element
760     for {
761     set stringIndex 0
762     } {$stringIndex < $stringLength} {
763     incr stringIndex
764     } {
765     # If element length greater than/equal to split length,
766     # Or element length equal to split length - 1,
767     # And character at current string index is splitChar
768     if {(($elementLength >= $splitLength) ||
769     ($elementLength == $elementSplitLength)) &&
770     (![string compare $splitChar \
771     [string index $text $stringIndex]])} then {
772     # Split substring element from text
773     set string [string range $text $elementStartIndex $elementEndIndex]
774     # Append substring element list to list
775     lappend list [string trim $string $trimChars]
776     # Reset element length counter
777     set elementLength 0
778     # Start split of next element at the end + 1 of the current one
779     set elementStartIndex [expr $elementEndIndex + 1]
780     # Reset end of next element to the start of the next element
781     set elementEndIndex $elementStartIndex
782     # Track remaining text length
783     set subStringLength [expr $subStringLength + [string length $string]]
784     } else {
785     # Increment element length
786     incr elementLength
787     # Increment end of next element
788     incr elementEndIndex
789     }
790     }
791     # Append any left over text as a new element
792     if {$stringLength > $subStringLength} then {
793     lappend list [string trim [string range $text $subStringLength end] $trimChars]
794     }
795     # Whew...that was alot of work!
796     if {[info exists list]} then {
797     return $list
798     }
799     }
800     return
801     }
802    
803     ##
804 tothwolf 1.35 ## Expand the given text with a list
805     ##
806     ## Args: text, list, elementIndex, resultVar
807     ## Returns: 0 if text not found
808     ## 1 if text is exactly matched
809     ## 2 if text is matched
810     ## -1 if text is ambiguous
811     ##
812     proc expandText {text list elementIndex resultVar} {
813     upvar 1 $resultVar result
814    
815     set found 0
816     set ambiguous 0
817     set lowerText [string tolower $text]
818     foreach listElement $list {
819     set compareElement [lindex $listElement $elementIndex]
820    
821     # Exact match
822     if {![string compare $text $compareElement]} then {
823     set result $listElement
824     return 1
825    
826     # Partial match
827     } elseif {[string match "$lowerText*" [string tolower $compareElement]]} then {
828     if {!$found} then {
829     set result $listElement
830     set found 1
831     } else {
832     set ambiguous 1
833     }
834     }
835     }
836     if {$ambiguous} then {
837     return -1
838     } elseif {$found} then {
839     return 2
840     }
841     return 0
842     }
843    
844     ##
845 guppy 1.1 ## Search an array for a given word or regexp
846     ##
847     ## Args: array name, word/regexp
848     ## Returns: list of indexes that match the given word/regexp
849     ##
850     proc arraySearch {array word} {
851     set word [string tolower $word]
852     set ret ""
853     foreach {name data} [array get $array] {
854     set string [string tolower $data]
855     if {[lsearch -regexp $string $word] != -1} then {
856     for {
857     set index 0
858     set indexes ""
859     } {
860     if {[regexp -- .*$word $string]} then {
861     lappend indexes $index
862     }
863     } {
864     incr index
865     }
866     lappend ret [list [concat $name $indexes]]
867     }
868     }
869     return $ret
870     }
871    
872     ##
873     ## Find option default for the given option name in a data list
874     ##
875     ## Args: data list, option name
876     ## Returns: option default if found,
877     ## nothing otherwise
878     ##
879     proc dataFormatDefault {list option} {
880     foreach i $list {
881     if {![string compare $option [lindex $i 0]]} then {
882     return [lindex $i 1]
883     }
884     }
885     return
886     }
887    
888     ##
889     ## Find option value for the given option name in a data list
890     ##
891     ## Args: data format, data list, option name
892     ## Returns: option value if found,
893     ## nothing otherwise
894     ##
895     proc dataFormatValue {format data option} {
896     if {[set index [lsearch -exact $format $option]] != -1} then {
897     return [lindex $data $index]
898     }
899     return
900     }
901    
902     ##
903     ## Replace option data in the given data list with a new value
904     ##
905     ## Args: data format, data list, option name, new value
906     ## Returns: data list
907     ##
908     proc dataFormatReplace {format data option value} {
909     if {[set index [lsearch -exact $format $option]] != -1} then {
910     return [lreplace $data $index $index $value]
911     }
912     return $data
913     }
914    
915     ##
916 tothwolf 1.2 ## Create a data format list for a given data format and options
917 guppy 1.1 ##
918     ## Args: data format list, defaults, options {{option1 value} ...}
919     ## Returns: data format list with options and values in proper order
920     ##
921     proc dataFormatBuild {format defaults args} {
922     set ret ""
923     foreach arg $args {
924     set [lindex $arg 0] [lindex $arg 1]
925     }
926     foreach opt $format {
927     if {[info exists $opt]} then {
928     lappend ret [set $opt]
929     } else {
930     lappend ret [dataFormatDefault $defaults $opt]
931     }
932     }
933     return $ret
934     }
935    
936     ##
937     ## Convert a data list from one format to another
938     ##
939     ## Args: from format, to format, data list
940     ## Returns: data list
941     ##
942     proc dataFormatConvert {fromFormat toFormat data} {
943     set ret ""
944     set index 0
945     foreach opt $fromFormat {
946     set $opt [lindex $data $index]
947     incr index
948     }
949     foreach opt $toFormat {
950     if {[info exists $opt]} then {
951     lappend ret [set $opt]
952     } else {
953     lappend ret [dataFormatDefault $defaults $opt]
954     }
955     }
956     return $ret
957     }
958    
959     ##
960     ## Scan the given file for module options
961     ##
962     ## Args: file, args {only scan for these options}
963     ## Returns: list of module options if the given file is a module,
964     ## nothing otherwise
965     ## Errors: unable to open file for reading
966     ##
967     proc scanModule {file args} {
968     variable moduleDatabaseConfig
969     variable moduleDatabaseFormat
970    
971     if {[catch {set fd [open $file r]} result]} then {
972     error $result
973     } else {
974     set ret ""
975     if {![string compare "" $args]} then {
976     set baseOptions [lindex $moduleDatabaseFormat([set moduleDatabaseConfig(version)]) 0]
977     set extraOptions [lindex $moduleDatabaseFormat([set moduleDatabaseConfig(version)]) 1]
978     set scanOptions "name $baseOptions"
979     set formatOptions "name $baseOptions $extraOptions"
980     } else {
981     set scanOptions $args
982     set formatOptions $args
983     }
984     for {
985     set lineCount 0
986     set optionCount 0
987     set continuedLine 0
988     } {(![eof $fd]) && ($lineCount <= $moduleDatabaseConfig(scanlines))} {
989     incr lineCount
990     } {
991     gets $fd line
992     if {[regexp -- "^# .*:.*" $line]} then {
993     set opt [string trimright [lindex $line 1] :]
994     if {[lsearch -glob $scanOptions $opt] != -1} then {
995     set data [string trimright [string trimleft [string range $line [string first : $line] end] " \t:"] " \t\\"]
996     if {![info exists $opt]} then {
997     set $opt $data
998     } else {
999     append $opt " $data"
1000     }
1001     }
1002     if {[regexp -- \\\\$ $line]} then {
1003     set continuedLine 1
1004     } else {
1005     set continuedLine 0
1006     }
1007     } elseif {($continuedLine) && ([info exists opt])} then {
1008     append $opt " [string trimright [string trimleft $line " \t#"] " \t\\"]"
1009     if {![regexp -- \\\\$ $line]} then {
1010     set continuedLine 0
1011     }
1012     }
1013     }
1014     close $fd
1015     if {(![string compare "" $args]) && \
1016     ((![info exists name]) || \
1017     ([catch {set md5sum [md5Sum $file]}]))} then {
1018     return
1019     }
1020     foreach option $formatOptions {
1021 tothwolf 1.2 if {(![info exists $option]) || \
1022     (![string compare "" [set $option]])} then {
1023 guppy 1.1 set $option [dataFormatDefault $moduleDatabaseConfig(defaults) $option]
1024     }
1025     lappend ret [set $option]
1026     }
1027     return $ret
1028     }
1029     }
1030    
1031     ##
1032     ## Get data from module db data array
1033     ##
1034     ## Args: module name, data type
1035     ## Returns: data for the given module's data type if it exists,
1036     ## nothing otherwise
1037     ##
1038     proc getModuleDatabaseData {module type} {
1039     variable moduleDatabaseConfig
1040     variable moduleDatabaseFormat
1041     variable moduleDatabaseData
1042    
1043     if {[moduleExists $module]} then {
1044     set index [lsearch -exact [join $moduleDatabaseFormat([set moduleDatabaseConfig(version)])] $type]
1045     if {$index != -1} then {
1046     return [lindex $moduleDatabaseData($module) $index]
1047     }
1048     }
1049     return
1050     }
1051    
1052     ##
1053     ## Set data in module db data array
1054     ##
1055     ## Args: module name, data type, data
1056     ## Returns: 1 if valid module and data type,
1057     ## 0 otherwise
1058     ##
1059     proc setModuleDatabaseData {module type data} {
1060     variable moduleDatabaseConfig
1061     variable moduleDatabaseFormat
1062     variable moduleDatabaseData
1063     variable moduleDatabaseDataChanged
1064    
1065     if {[moduleExists $module]} then {
1066     set index [lsearch -exact [join $moduleDatabaseFormat([set moduleDatabaseConfig(version)])] $type]
1067     if {$index != -1} then {
1068     set moduleDatabaseData($module) [lreplace $moduleDatabaseData($module) $index $index [list $data]]
1069     set moduleDatabaseDataChanged 1
1070     return 1
1071     }
1072     }
1073     return 0
1074     }
1075    
1076     ##
1077     ## Save module database
1078     ##
1079     ## Args: verbose {-1,0,1}
1080     ## Returns: 1 if successful,
1081     ## 0 otherwise
1082     ##
1083     proc saveModuleDatabase {{verbose 0}} {
1084     variable configData
1085     variable moduleDatabaseConfig
1086     variable moduleDatabaseData
1087 tothwolf 1.3 variable moduleDatabaseDataChanged
1088 guppy 1.1
1089     if {[createFile $configData(moddbfile) $verbose "module database file "]} then {
1090     if {[catch {set fd [open $configData(moddbfile) w]} result]} then {
1091     if {$verbose >= 0} then {
1092     wpLog o * "Error: unable to open module database file `$configData(moddbfile)' for writing: $result"
1093     }
1094     } else {
1095     puts $fd "# $moduleDatabaseConfig(header)$moduleDatabaseConfig(version)"
1096     close $fd
1097 tothwolf 1.3 set ret [arraySave moduleDatabaseData $configData(moddbfile) $verbose "module database file " a]
1098     if {$ret} then {
1099     set moduleDatabaseDataChanged 0
1100     }
1101     return $ret
1102 guppy 1.1 }
1103     }
1104     return 0
1105     }
1106    
1107     ##
1108     ## Load module database
1109     ##
1110     ## Args: verbose {-1,0,1}
1111     ## Returns: 1 if successful,
1112     ## 0 otherwise
1113     ##
1114     proc loadModuleDatabase {{verbose 0}} {
1115     variable configData
1116     variable moduleDatabaseConfig
1117     variable moduleDatabaseFormat
1118     variable moduleDatabaseData
1119 tothwolf 1.3 variable moduleDatabaseDataChanged
1120 guppy 1.1
1121     if {![file exists $configData(moddbfile)]} then {
1122     return -1
1123     } else {
1124     if {[catch {set fd [open $configData(moddbfile) r]} result]} then {
1125     if {$verbose >= 0} then {
1126     wpLog o * "Error: unable to open module database file `$configData(moddbfile)' for reading: $result"
1127     }
1128     } else {
1129     set firstline [replaceExpr [gets $fd] "^ "]
1130     if {[regexp -- "^# $moduleDatabaseConfig(header)" $firstline]} then {
1131     regsub -all -- "^# $moduleDatabaseConfig(header)" $firstline "" version
1132     if {![string compare [set version [string trim $version]] $moduleDatabaseConfig(version)]} then {
1133     close $fd
1134     return [arrayLoad moduleDatabaseData $configData(moddbfile) $verbose "module database file "]
1135     } elseif {[info exists moduleDatabaseFormat($version)]} then {
1136     if {[info exists moduleDatabaseData]} then {
1137     unset moduleDatabaseData
1138     }
1139     while {![eof $fd]} {
1140     set line [replaceExpr [gets $fd] "^ "]
1141     if {([string compare "" $line]) && \
1142     (![regexp -- "^#" $line])} then {
1143     set moduleDatabaseData([lindex $line 0]) [dataFormatConvert [join $moduleDatabaseFormat($version)] [join $moduleDatabaseFormat([set moduleDatabaseConfig(version)])] [lindex $line 1]]
1144     }
1145     }
1146     close $fd
1147 tothwolf 1.3 set moduleDatabaseDataChanged 0
1148 guppy 1.1 return 1
1149     } else {
1150     wpLog o * "Error: unknown module database version: $version"
1151     }
1152     } else {
1153     wpLog o * "Error: unknown module database format: [string trimleft $firstline " \t#"]"
1154     }
1155     }
1156     close $fd
1157     }
1158     return 0
1159     }
1160    
1161     ##
1162 tothwolf 1.35 ## Add a module to the module database
1163     ##
1164     ## Args: file, verbose {-1,0,1}
1165     ## Returns: nothing
1166     ##
1167     proc updateModuleData {file {verbose 0}} {
1168     variable configData
1169     variable moduleDatabaseConfig
1170     variable moduleDatabaseFormat
1171     variable moduleDatabaseData
1172     variable moduleDatabaseDataChanged
1173    
1174     if {[catch {set data [scanModule $file]} result]} then {
1175     if {$verbose >= 0} then {
1176     wpLog o * "Warning: unable to open file `[shortFile $file $configData(modulepath)]' for reading: $result"
1177     }
1178     } else {
1179     set name [lindex $data 0]
1180     if {[string compare "" $name]} then {
1181     if {[moduleExists $name]} then {
1182     set loadIndex [lsearch -exact [join $moduleDatabaseFormat([set moduleDatabaseConfig(version)])] load]
1183     set moduleDatabaseData($name) [lreplace [lrange $data 1 end] $loadIndex $loadIndex [lindex $moduleDatabaseData($name) $loadIndex]]
1184     } else {
1185     set moduleDatabaseData($name) [lrange $data 1 end]
1186     }
1187     set moduleDatabaseDataChanged 1
1188     }
1189     }
1190     return
1191     }
1192    
1193     ##
1194     ## Update module database
1195 guppy 1.1 ##
1196     ## Args: verbose {-1,0,1}
1197 tothwolf 1.35 ## Returns: nothing
1198 guppy 1.1 ##
1199 tothwolf 1.35 proc updateModuleDatabase {{verbose 0}} {
1200 guppy 1.1 variable configData
1201     variable moduleDatabaseConfig
1202 tothwolf 1.35 variable moduleDatabaseData
1203     variable moduleDatabaseDataChanged
1204    
1205     set moduleList [listModules]
1206    
1207     set foundFiles "" ;# List of all '.tcl' files in module path
1208     set moduleFiles "" ;# List of module files
1209    
1210     # Build up file list
1211     foreach dir $configData(modulepath) {
1212     foreach file [findFiles $dir $moduleDatabaseConfig(maxdepth) .tcl] {
1213     lappend foundFiles $file
1214     }
1215     }
1216 guppy 1.1
1217 tothwolf 1.35 # Find removed files
1218     foreach module $moduleList {
1219     set file [getModuleDatabaseData $module file]
1220    
1221     if {[lsearch -exact $foundFiles $file] == -1} then {
1222     if {$verbose >= 1} then {
1223     wpLog o * "Removing module data for unknown module `$module'"
1224     }
1225     unset moduleDatabaseData($module)
1226     set moduleDatabaseDataChanged 1
1227     } else {
1228    
1229     # Compare existing valid modules
1230     if {$verbose >= 1} then {
1231     set shortfile [shortFile $file $configData(modulepath)]
1232     wpLog o * "Comparing file `$shortfile'"
1233 guppy 1.1 }
1234 tothwolf 1.35
1235     # Compare md5 from module db and sure the module hasn't changed
1236     if {([catch {set md5sum [md5Sum $file]}]) || \
1237     ([string compare [getModuleDatabaseData $module md5sum] $md5sum])} then {
1238 guppy 1.1 if {$verbose >= 1} then {
1239 tothwolf 1.35 wpLog o * "Updating module information for file `$shortfile'"
1240 guppy 1.1 }
1241 tothwolf 1.35 updateModuleData $file $verbose
1242     } else {
1243     lappend moduleFiles $file
1244 guppy 1.1 }
1245 tothwolf 1.35 }
1246     }
1247    
1248     # Find new files
1249     foreach file $foundFiles {
1250     if {[lsearch -exact $moduleFiles $file] == -1} then {
1251     if {$verbose >= 1} then {
1252     wpLog o * "Adding module information for file `[shortFile $file $configData(modulepath)]'"
1253 guppy 1.1 }
1254 tothwolf 1.35 updateModuleData $file $verbose
1255 guppy 1.1 }
1256     }
1257 tothwolf 1.35 return
1258 guppy 1.1 }
1259    
1260     ##
1261     ## Rebuild module database
1262     ##
1263     ## Args: verbose {-1,0,1}
1264     ## Returns: nothing
1265     ##
1266     proc rebuildModuleDatabase {{verbose 0}} {
1267     variable configData
1268     variable moduleDatabaseConfig
1269     variable moduleDatabaseFormat
1270     variable moduleDatabaseData
1271    
1272 tothwolf 1.35 # Copy database data for later use
1273     if {[info exists moduleDatabaseData]} then {
1274     set mergeLoad 1
1275     array set moduleDatabaseDataTmp [array get moduleDatabaseData]
1276     unset moduleDatabaseData
1277     } else {
1278     set mergeLoad 0
1279     }
1280    
1281     foreach dir $configData(modulepath) {
1282     foreach file [findFiles $dir $moduleDatabaseConfig(maxdepth) .tcl] {
1283 guppy 1.1 if {$verbose >= 1} then {
1284 tothwolf 1.35 wpLog o * "Scanning file `[shortFile $file $configData(modulepath)]'"
1285 guppy 1.1 }
1286 tothwolf 1.35 updateModuleData $file $verbose
1287 guppy 1.1 }
1288     }
1289 tothwolf 1.35
1290     # Merge load data into new database
1291     if {$mergeLoad} then {
1292     set loadIndex [lsearch -exact [join $moduleDatabaseFormat([set moduleDatabaseConfig(version)])] load]
1293    
1294     foreach module [listModules] {
1295     set moduleDatabaseData($module) [lreplace $moduleDatabaseData($module) $loadIndex $loadIndex [lindex $moduleDatabaseDataTmp($module) $loadIndex]]
1296     }
1297     # Note: Not modifying moduleDatabaseDataChanged here, since
1298     # 'updateModuleData' will have already done so.
1299 guppy 1.1 }
1300     return
1301     }
1302    
1303     ##
1304     ## List all modules in the database
1305     ##
1306     ## Args: none
1307     ## Returns: list of modules in module database
1308     ##
1309     proc listModules {{loaded 0}} {
1310     variable moduleDatabaseData
1311     variable moduleLoadedList
1312    
1313     if {$loaded} then {
1314     return [lsort $moduleLoadedList]
1315     }
1316     return [lsort [array names moduleDatabaseData]]
1317     }
1318    
1319     ##
1320     ## Check if the given module exists
1321     ##
1322     ## Args: module name
1323     ## Returns: 1 if the given module exists
1324     ## 0 otherwise
1325     ##
1326     proc moduleExists {module} {
1327     variable moduleDatabaseData
1328    
1329     if {[info exists moduleDatabaseData($module)]} then {
1330     return 1
1331     }
1332     return 0
1333     }
1334    
1335     ##
1336     ## Check if a module is loaded
1337     ##
1338     ## Args: module name
1339     ## Returns: 1 if the given module is loaded
1340     ## 0 otherwise
1341     ##
1342     proc moduleLoaded {module} {
1343     variable moduleLoadedList
1344    
1345     if {[lsearch -exact $moduleLoadedList $module] != -1} then {
1346     return 1
1347     }
1348     return 0
1349     }
1350    
1351     ##
1352 tothwolf 1.15 ## Add/remove bindings for a given module
1353 tothwolf 1.7 ##
1354 tothwolf 1.16 ## Args: mode {bind|unbind}, module,
1355 tothwolf 1.29 ## args {{type ...} {option ...} {cmdsub ...} {regsub ...}}
1356 tothwolf 1.7 ## Returns: nothing
1357     ##
1358 tothwolf 1.29 ## Important variables:
1359     ## argTypes "dcc msg pub ..."
1360     ## argOptions "noauto cmdchr ..."
1361     ## argCmdsub(regexp) "command"
1362     ## argRegsub(regexp) "with"
1363     ## optCmdsub(regexp) "command"
1364     ## optRegsub(regexp) "with"
1365     ##
1366 tothwolf 1.16 proc moduleBindUnbind {mode module args} {
1367 tothwolf 1.7 variable NamespaceCurrent
1368    
1369     if {[info exists ${NamespaceCurrent}::${module}::bindDefaults]} then {
1370 tothwolf 1.29 # These are for use in calling this proc directly.
1371     # bindDefaults options are further below
1372     set argTypes ""
1373     set argOptions ""
1374     foreach arg $args {
1375     switch -exact -- [lindex $arg 0] {
1376 tothwolf 1.15 type {
1377 tothwolf 1.29 # Specific types to match against
1378 tothwolf 1.15 # dcc msg pub ...
1379 tothwolf 1.29 set argTypes [lrange $arg 1 end]
1380 tothwolf 1.9 }
1381 tothwolf 1.15 option {
1382 tothwolf 1.29 # Specific options to match against
1383     # noauto cmdchr ...
1384     set argOptions [lrange $arg 1 end]
1385     }
1386     cmdsub {
1387     # Replace 'regexp' with result of 'command'
1388     # NOTE: 'command' will eventually be processed in calling stack
1389     foreach {command regexp} [lindex $arg 1] {break}
1390     # FIXME: better fix for leading '+/$'
1391     regsub -- "\[\\+|\\$\]" $regexp "\\\\&" regexp
1392     # FIXME: can't do this:
1393     #regsub -- {([][\\\*\+\?\{\}\,\(\)\:\.\^\$\=\!\|])} $regexp {\\\1} regexp
1394     # Try to find 'command' in 'module' namespace
1395     if {[string compare "" [info commands ${NamespaceCurrent}::${module}::[lindex $command 0]]]} then {
1396     # Command is module specific or imported
1397     set argCmdsub($regexp) ${NamespaceCurrent}::${module}::$command
1398     } else {
1399     # Must be a global command
1400     set argCmdsub($regexp) $command
1401 tothwolf 1.7 }
1402     }
1403 tothwolf 1.15 regsub {
1404 tothwolf 1.29 # Replace regexp 'rwhat' with 'rwith'
1405     foreach {rwhat rwith} [lindex $arg 1] {break}
1406     # FIXME: better fix for leading '+/$'
1407     regsub -- "\[\\+|\\$\]" $rwhat "\\\\&" rwhat
1408     set argRegsub($rwhat) $rwith
1409 tothwolf 1.15 }
1410     }
1411 tothwolf 1.7 }
1412 tothwolf 1.15 foreach {proc data} [array get ${NamespaceCurrent}::${module}::bindDefaults] {
1413     foreach bind $data {
1414     foreach {type flags mask options help} $bind {break}
1415 tothwolf 1.29 # Continue if a specific bind type is requested and not matched
1416     if {([string compare "" $argTypes]) && \
1417     ([lsearch -exact $argTypes $type] == -1)} then {
1418 tothwolf 1.26 continue
1419     }
1420 tothwolf 1.29 # Sanity check!
1421     # Continue if argOptions specified and bind options don't exist
1422     if {([string compare "" $argOptions]) && \
1423     (![string compare "" $options])} then {
1424 tothwolf 1.15 continue
1425     }
1426 tothwolf 1.29 # These _must_ be clean since they are reused for multiple binds
1427     set continue 0
1428     if {[info exists optCmdsub]} then {
1429     unset optCmdsub
1430     }
1431     if {[info exists optRegsub]} then {
1432     unset optRegsub
1433     }
1434     # Process bind specific options
1435     foreach option $options {
1436     set optcmd [lindex $option 0]
1437     # Search 'argOptions' for 'optcmd'
1438     # Abort bind and continue with next if not found
1439     if {[string compare "" $argOptions]} then {
1440     set found 0
1441     foreach argoption $argOptions {
1442     if {![string compare $optcmd [lindex $argoption 0]]} then {
1443     set found 1
1444     }
1445     }
1446     if {!$found} then {
1447     set continue 1
1448 tothwolf 1.18 break
1449     }
1450     }
1451 tothwolf 1.29 switch -exact -- $optcmd {
1452     noauto {
1453     # Search for noauto override in argOptions
1454     if {[lsearch -exact $argOptions noauto] == -1} then {
1455     # noauto matched and not overriden
1456     set continue 1
1457     break
1458     }
1459     }
1460     cmdsub {
1461     # Replace 'regexp' with result of 'command'
1462     # NOTE: 'command' will eventually be processed in calling stack
1463     foreach {command regexp} [lindex $option 1] {break}
1464     # FIXME: better fix for leading '+/$'
1465     regsub -- "\[\\+|\\$\]" $regexp "\\\\&" regexp
1466     # Try to find 'command' in 'module' namespace
1467     if {[string compare "" [info commands ${NamespaceCurrent}::${module}::[lindex $command 0]]]} then {
1468     # Command is module specific or imported
1469     set optCmdsub($regexp) ${NamespaceCurrent}::${module}::$command
1470     } else {
1471     # Must be a global command
1472     set optCmdsub($regexp) $command
1473     }
1474     }
1475     regsub {
1476     # Replace regexp 'rwhat' with 'rwith'
1477     foreach {rwhat rwith} [lindex $option 1] {break}
1478     # FIXME: better fix for leading '+/$'
1479     regsub -- "\[\\+|\\$\]" $rwhat "\\\\&" rwhat
1480     set optRegsub($rwhat) $rwith
1481     }
1482 tothwolf 1.18 }
1483 tothwolf 1.15 }
1484 tothwolf 1.29 # Abort this bind and continue with the next
1485     if {$continue} then {
1486     continue
1487 tothwolf 1.9 }
1488 tothwolf 1.29 # Make optCmdsub regexp substitutions on mask
1489     if {[array exists optCmdsub]} then {
1490     foreach {regexp command} [array get optCmdsub] {
1491     # Process 'command' in calling stack
1492     regsub -all -- $regexp $mask [uplevel 1 $command] mask
1493     }
1494     }
1495     # Make optRegsub regexp substitutions on mask
1496 tothwolf 1.35 if {[array exists optRegsub]} then {
1497 tothwolf 1.29 foreach {replacewhat replacewith} [array get optRegsub] {
1498 tothwolf 1.15 regsub -all -- $replacewhat $mask $replacewith mask
1499 tothwolf 1.9 }
1500 tothwolf 1.7 }
1501 tothwolf 1.29 # Make argCmdsub regexp substitutions on mask
1502     if {[array exists argCmdsub]} then {
1503     foreach {regexp command} [array get argCmdsub] {
1504     # Process 'command' in calling stack
1505     regsub -all -- $regexp $mask [uplevel 1 $command] mask
1506     }
1507     }
1508     # Make argRegsub regexp substitutions on mask
1509 tothwolf 1.35 if {[array exists argRegsub]} then {
1510 tothwolf 1.29 foreach {replacewhat replacewith} [array get argRegsub] {
1511     regsub -all -- $replacewhat $mask $replacewith mask
1512     }
1513     }
1514     # Finally! bind/unbind
1515     if {[catch {
1516     $mode $type $flags $mask ${NamespaceCurrent}::${module}::$proc
1517     } result]} then {
1518     wpLog d * "Error: ${mode}ing $type for $mask: $result"
1519     }
1520 tothwolf 1.7 }
1521     }
1522     }
1523     return
1524     }
1525    
1526     ##
1527 guppy 1.1 ## Load a module
1528     ##
1529     ## Args: module name, verbose {-1,0,1}, args {loop detection}
1530     ## Returns: nothing
1531     ## Errors: if unable to load module
1532     ##
1533     proc moduleLoad {module {verbose 0} args} {
1534     variable NamespaceCurrent
1535     variable moduleLoadedList
1536    
1537     if {[lsearch -exact [set loop [lindex $args 0]] $module] == -1} then {
1538     if {[moduleExists $module]} then {
1539     set preload ""
1540     set requires [getModuleDatabaseData $module requires]
1541     foreach required $requires {
1542     set preloadModule [whichModuleCommand $required]
1543     if {[string compare "" $preloadModule]} then {
1544     if {([lsearch -exact $preload $preloadModule] == -1) && \
1545     ([string compare wp $preloadModule]) && \
1546     (![moduleLoaded $preloadModule])} then {
1547     lappend preload $preloadModule
1548     }
1549     } else {
1550     error "required command `$required' not found."
1551     }
1552     }
1553     if {[string compare "" $preload]} then {
1554     foreach premod $preload {
1555     if {[catch {moduleLoad $premod $verbose [concat $loop $module]} result]} then {
1556     error $result
1557     }
1558     }
1559     }
1560     if {[catch {source [getModuleDatabaseData $module file]} result]} then {
1561     error $result
1562     } else {
1563     package forget $module
1564     package provide ${NamespaceCurrent}::${module} [getModuleDatabaseData $module version]
1565 tothwolf 1.9 moduleConfigLoad $module 1
1566     moduleConfigCheckdefs $module 1
1567     moduleDataLoad $module 1
1568 guppy 1.1 # Imported commands '# requires: ...'
1569     if {[string compare "" $requires]} then {
1570 tothwolf 1.31 set namespaceScript "namespace eval ${NamespaceCurrent}::${module} \{\n namespace forget *\n namespace import"
1571 guppy 1.1 foreach required $requires {
1572     if {[string compare "" [set command [whichCommand $required]]]} then {
1573 tothwolf 1.31 append namespaceScript " $command"
1574 guppy 1.1 }
1575     }
1576 tothwolf 1.31 append namespaceScript "\n\}"
1577     eval $namespaceScript
1578 guppy 1.1 }
1579     # Exported commands '# provides: ...'
1580     if {[string compare "" [set provides [getModuleDatabaseData $module provides]]]} then {
1581 tothwolf 1.31 set namespaceScript "namespace eval ${NamespaceCurrent}::${module} \{\n namespace export"
1582 guppy 1.1 foreach provided $provides {
1583 tothwolf 1.31 append namespaceScript " $provided"
1584 guppy 1.1 }
1585 tothwolf 1.31 append namespaceScript "\n\}"
1586     eval $namespaceScript
1587 guppy 1.1 }
1588 tothwolf 1.7 if {[string compare "" [info commands ${NamespaceCurrent}::${module}::ModuleInit]]} then {
1589     ${NamespaceCurrent}::${module}::ModuleInit
1590 guppy 1.1 }
1591 tothwolf 1.7 # FIXME: check for bindings? duplicates?
1592 tothwolf 1.15 moduleBindUnbind bind $module
1593 guppy 1.1 if {![getModuleDatabaseData $module load]} then {
1594     setModuleDatabaseData $module load 1
1595     }
1596     if {[lsearch -exact $moduleLoadedList $module] == -1} then {
1597     lappend moduleLoadedList $module
1598     if {$verbose >= 1} then {
1599     wpLog o * "Module loaded: $module"
1600     }
1601     }
1602     }
1603     } else {
1604     error "No such module: $module"
1605     }
1606     } else {
1607     regsub -all -- " " $loop " -> " loop
1608     error "Preload endless loop: $loop -> $module"
1609     }
1610     return
1611     }
1612    
1613     ##
1614     ## Unload a module
1615     ##
1616     ## Args: module name, verbose {-1,0,1}
1617     ## Returns: nothing
1618     ## Errors: if unable to completely unload module
1619     ##
1620     proc moduleUnload {module {verbose 0}} {
1621     variable NamespaceCurrent
1622     variable moduleLoadedList
1623    
1624 tothwolf 1.9 # FIXME: handle dependant modules and modules that can't be unloaded
1625 guppy 1.1 if {[moduleExists $module]} then {
1626 tothwolf 1.7 if {[string compare "" [info commands ${NamespaceCurrent}::${module}::ModuleDestroy]]} then {
1627     ${NamespaceCurrent}::${module}::ModuleDestroy
1628 guppy 1.1 }
1629 tothwolf 1.7 # FIXME: check for bindings?
1630 tothwolf 1.15 moduleBindUnbind unbind $module
1631 tothwolf 1.9 moduleConfigSave $module 1
1632     moduleDataSave $module 1
1633 tothwolf 1.28
1634     # FIXME: we should kill off stale timer/utimers here somewhere before unloading
1635    
1636 guppy 1.1 if {[catch {namespace delete ${NamespaceCurrent}::${module}} result]} then {
1637     error $result
1638     } else {
1639     package forget ${NamespaceCurrent}::${module}
1640     if {[getModuleDatabaseData $module load] == 1} then {
1641     setModuleDatabaseData $module load 0
1642     }
1643     set index [lsearch -exact $moduleLoadedList $module]
1644     if {$index != -1} then {
1645     set moduleLoadedList [lreplace $moduleLoadedList $index $index]
1646     if {$verbose >= 1} then {
1647     wpLog o * "Module unloaded: $module"
1648     }
1649     }
1650     }
1651     } else {
1652     error "No such module: $module"
1653     }
1654     return
1655     }
1656    
1657     ##
1658 tothwolf 1.9 ## Save configuration settings for the given module
1659 guppy 1.1 ##
1660 tothwolf 1.9 ## Args: module, force {0,1}, verbose {-1,0,1}
1661     ## Returns: 1 if settings saved
1662 guppy 1.1 ## 0 otherwise
1663     ##
1664 tothwolf 1.9 proc moduleConfigSave {module {force 0} {verbose 0}} {
1665 guppy 1.1 variable NamespaceCurrent
1666     variable configData
1667    
1668     if {([string compare "" \
1669     [set file [getModuleDatabaseData $module config]]]) && \
1670     ([createDir $configData(configpath)])} then {
1671     set cfgfile [file join $configData(configpath) $file]
1672 tothwolf 1.9 if {([getModuleDatabaseData $module load]) && \
1673     (($force) || \
1674     (![info exists ${NamespaceCurrent}::${module}::configDataChanged]) || \
1675     ([set ${NamespaceCurrent}::${module}::configDataChanged]))} then {
1676     if {[arraySave ${NamespaceCurrent}::${module}::configData $cfgfile 0 "$module configuration file "]} then {
1677     if {$verbose >= 1} then {
1678     wpLog o * "Writing $module config file..."
1679 guppy 1.1 }
1680 tothwolf 1.9 set ${NamespaceCurrent}::${module}::configDataChanged 0
1681     return 1
1682     } elseif {$verbose >= 0} then {
1683     wpLog o * "Error writing $module config file."
1684 guppy 1.1 }
1685 tothwolf 1.9 }
1686     }
1687     return 0
1688     }
1689    
1690     ##
1691     ## Load configuration settings for the given module
1692     ##
1693     ## Args: module, force {0,1}, verbose {-1,0,1}
1694     ## Returns: 1 if settings loaded
1695     ## 0 otherwise
1696     ##
1697     proc moduleConfigLoad {module {force 0} {verbose 0}} {
1698     variable NamespaceCurrent
1699     variable configData
1700    
1701     if {([string compare "" \
1702     [set file [getModuleDatabaseData $module config]]]) && \
1703     ([createDir $configData(configpath)])} then {
1704     set cfgfile [file join $configData(configpath) $file]
1705     if {($force) || \
1706     (![info exists ${NamespaceCurrent}::${module}::configDataChanged]) || \
1707     (![set ${NamespaceCurrent}::${module}::configDataChanged])} then {
1708     if {[arrayLoad ${NamespaceCurrent}::${module}::configData $cfgfile 0 "$module configuration file "]} then {
1709     if {$verbose >= 1} then {
1710     wpLog o * "Loading $module config file..."
1711 guppy 1.1 }
1712 tothwolf 1.9 set ${NamespaceCurrent}::${module}::configDataChanged 0
1713     return 1
1714     } elseif {$verbose >= 0} then {
1715     wpLog o * "Error loading $module config file."
1716 guppy 1.1 }
1717     }
1718     }
1719     return 0
1720     }
1721    
1722     ##
1723 tothwolf 1.9 ## Check and set default configuration settings for the given module
1724 guppy 1.1 ##
1725 tothwolf 1.9 ## Args: module, force {0,1}, verbose {-1,0,1}
1726 guppy 1.1 ## Returns: nothing
1727     ##
1728 tothwolf 1.9 proc moduleConfigCheckdefs {module {force 0} {verbose 0}} {
1729     variable NamespaceCurrent
1730    
1731     if {([array exists ${NamespaceCurrent}::${module}::configDefaults]) && \
1732     ([string compare "" [getModuleDatabaseData $module config]])} then {
1733     set Changed 0
1734     # Unset unknown variables
1735     foreach name [array names ${NamespaceCurrent}::${module}::configData] {
1736     if {![info exists ${NamespaceCurrent}::${module}::configDefaults($name)]} then {
1737     unset ${NamespaceCurrent}::${module}::configData($name)
1738     set Changed 1
1739     }
1740     }
1741     # Set missing variables to defaults
1742     foreach {name data} [array get ${NamespaceCurrent}::${module}::configDefaults] {
1743     if {![info exists ${NamespaceCurrent}::${module}::configData($name)]} then {
1744     set ${NamespaceCurrent}::${module}::configData($name) [lindex $data 1]
1745     set Changed 1
1746     }
1747     }
1748     # FIXME: do this with a trace?
1749     if {$Changed} then {
1750     set ${NamespaceCurrent}::${module}::configDataChanged 1
1751     }
1752     }
1753     return
1754     }
1755 guppy 1.1
1756 tothwolf 1.9 ##
1757     ## Handle config data for a list of modules
1758     ##
1759     ## Args: action {load|save|checkdefs}, module list, force {0,1},
1760     ## verbose {-1,0,1}
1761     ## Returns: nothing
1762     ##
1763     proc moduleConfig {action modules {force 0} {verbose 0}} {
1764 guppy 1.1 if {![string compare * $modules]} then {
1765     set modules [listModules 1]
1766     }
1767 tothwolf 1.9 switch -exact -- $action {
1768     save {
1769     foreach module $modules {
1770     if {([moduleExists $module]) && ([moduleLoaded $module])} then {
1771     moduleConfigSave $module $force $verbose
1772     }
1773     }
1774     }
1775     load {
1776     foreach module $modules {
1777     if {([moduleExists $module]) && ([moduleLoaded $module])} then {
1778     moduleConfigLoad $module $force $verbose
1779     }
1780     }
1781     }
1782     checkdefs {
1783     foreach module $modules {
1784     if {([moduleExists $module]) && ([moduleLoaded $module])} then {
1785     moduleConfigCheckdefs $module $force $verbose
1786     }
1787     }
1788 guppy 1.1 }
1789     }
1790     return
1791     }
1792    
1793     ##
1794 tothwolf 1.9 ## Save data for the given module
1795 guppy 1.1 ##
1796 tothwolf 1.9 ## Args: module, force {0,1}, verbose {-1,0,1}
1797 guppy 1.1 ## Returns: nothing
1798     ##
1799 tothwolf 1.9 proc moduleDataSave {module {force 0} {verbose 0}} {
1800 guppy 1.1 variable NamespaceCurrent
1801     variable configData
1802    
1803     if {([info exists ${NamespaceCurrent}::${module}::dataOptions]) && \
1804     ([createDir $configData(datapath)])} then {
1805 tothwolf 1.9 foreach {name data} [array get ${NamespaceCurrent}::${module}::dataOptions] {
1806     foreach {type file desc} $data {break}
1807     if {([info exists type]) && ([info exists file]) && \
1808     ([info exists desc])} then {
1809     set Changed ${NamespaceCurrent}::${module}::${name}Changed
1810     if {($force) || ((![info exists $Changed]) || ([set $Changed]))} then {
1811     if {[${type}Save ${NamespaceCurrent}::${module}::$name [file join $configData(datapath) $file]]} then {
1812     if {$verbose >= 1} then {
1813     wpLog o * $NamespaceCurrent "Writing $desc data file..."
1814 guppy 1.1 }
1815 tothwolf 1.9 set $Changed 0
1816     } elseif {$verbose >= 0} then {
1817     wpLog o * $NamespaceCurrent "Error writing $desc data file!"
1818 guppy 1.1 }
1819     }
1820     }
1821 tothwolf 1.9 }
1822     }
1823     return
1824     }
1825    
1826     ##
1827     ## Load data for the given module
1828     ##
1829     ## Args: module, force {0,1}, verbose {-1,0,1}
1830     ## Returns: nothing
1831     ##
1832     proc moduleDataLoad {module {force 0} {verbose 0}} {
1833     variable NamespaceCurrent
1834     variable configData
1835    
1836     if {([info exists ${NamespaceCurrent}::${module}::dataOptions]) && \
1837     ([createDir $configData(datapath)])} then {
1838     foreach {name data} [array get ${NamespaceCurrent}::${module}::dataOptions] {
1839     foreach {type file desc} $data {break}
1840     if {([info exists type]) && ([info exists file]) && \
1841     ([info exists desc])} then {
1842     set Changed ${NamespaceCurrent}::${module}::${name}Changed
1843     if {($force) || ((![info exists $Changed]) || ([set $Changed]))} then {
1844     if {[${type}Load ${NamespaceCurrent}::${module}::$name [file join $configData(datapath) $file]]} then {
1845     if {$verbose >= 1} then {
1846     wpLog o * $NamespaceCurrent "Reloading $desc data file..."
1847 guppy 1.1 }
1848 tothwolf 1.9 set $Changed 0
1849     } elseif {$verbose >= 0} then {
1850     wpLog o * $NamespaceCurrent "Error reloading $desc data file!"
1851 guppy 1.1 }
1852     }
1853     }
1854 tothwolf 1.9 }
1855     }
1856     return
1857     }
1858    
1859     ##
1860     ## Backup data for the given module
1861     ##
1862     ## Args: module, force {0,1}, verbose {-1,0,1}
1863     ## Returns: nothing
1864     ##
1865     proc moduleDataBackup {module {force 0} {verbose 0}} {
1866     variable NamespaceCurrent
1867     variable configData
1868    
1869     if {([info exists ${NamespaceCurrent}::${module}::dataOptions]) && \
1870     ([createDir $configData(datapath)])} then {
1871     foreach {name data} [array get ${NamespaceCurrent}::${module}::dataOptions] {
1872     foreach {type file desc} $data {break}
1873     if {([info exists type]) && ([info exists file]) && \
1874     ([info exists desc])} then {
1875     if {[set result [backupFile [file join $configData(datapath) $file] $verbose]]} then {
1876     if {($result >= 1) && ($verbose >= 1)} then {
1877     wpLog o * $NamespaceCurrent "Backing up $desc data file..."
1878 guppy 1.1 }
1879 tothwolf 1.9 } elseif {$verbose >= 0} then {
1880     wpLog o * $NamespaceCurrent "Error backing up $desc data file!"
1881 guppy 1.1 }
1882     }
1883     }
1884     }
1885     return
1886     }
1887    
1888     ##
1889 tothwolf 1.9 ## Handle data for a list of modules
1890 guppy 1.1 ##
1891 tothwolf 1.9 ## Args: action {load|save|backup}, module list, force {0,1},
1892     ## verbose {-1,0,1}
1893 guppy 1.1 ## Returns: nothing
1894     ##
1895 tothwolf 1.9 proc moduleData {action modules {force 0} {verbose 0}} {
1896 guppy 1.1 if {![string compare * $modules]} then {
1897     set modules [listModules 1]
1898     }
1899 tothwolf 1.9 switch -exact -- $action {
1900     save {
1901     foreach module $modules {
1902     if {([moduleExists $module]) && ([moduleLoaded $module])} then {
1903     moduleDataSave $module $force $verbose
1904     }
1905     }
1906     }
1907     load {
1908     foreach module $modules {
1909     if {([moduleExists $module]) && ([moduleLoaded $module])} then {
1910     moduleDataLoad $module $force $verbose
1911     }
1912     }
1913     }
1914     backup {
1915     foreach module $modules {
1916     if {([moduleExists $module]) && ([moduleLoaded $module])} then {
1917     moduleDataBackup $module $force $verbose
1918     }
1919     }
1920 guppy 1.1 }
1921     }
1922     return
1923     }
1924    
1925     ##
1926     ## Builds command matching table from module database
1927     ##
1928     ## Args: none
1929     ## Returns: nothing
1930     ##
1931     proc buildCommandTable {{verbose 0}} {
1932     variable NamespaceCurrent
1933     variable ExportList
1934     variable commandTable
1935    
1936     foreach command $ExportList {
1937     if {![info exists tmp($command)]} then {
1938     if {$verbose >= 2} then {
1939     wpLog o * "Adding command: `$command' as `${NamespaceCurrent}::$command'"
1940     }
1941     set tmp($command) ${NamespaceCurrent}::$command
1942     } elseif {$verbose >= 0} then {
1943     wpLog o * "Warning: ignoring duplicate command `$command', conflicts with `$tmp($command)'"
1944     }
1945     }
1946     foreach module [listModules] {
1947     if {[string compare "" [set provides [getModuleDatabaseData $module provides]]]} then {
1948     foreach command $provides {
1949     if {![info exists tmp($command)]} then {
1950     if {$verbose >= 2} then {
1951     wpLog o * "Adding command: `$command' as `${NamespaceCurrent}::${module}::$command'"
1952     }
1953     set tmp($command) ${NamespaceCurrent}::${module}::$command
1954     } elseif {$verbose >= 0} then {
1955     wpLog o * "Warning: ignoring duplicate command `$command', conflicts with `$tmp($command)'"
1956     }
1957     }
1958     }
1959     }
1960     if {[info exists commandTable]} then {
1961     unset commandTable
1962     }
1963     array set commandTable [array get tmp]
1964     return
1965     }
1966    
1967     ##
1968     ## Return full namespace path for the given command
1969     ##
1970     ## Args: command
1971     ## Returns: full namespace path for the given command if it exists
1972     ## nothing otherwise
1973     ##
1974     proc whichCommand {command} {
1975     variable commandTable
1976    
1977     if {[info exists commandTable($command)]} then {
1978     return $commandTable($command)
1979     }
1980     return
1981     }
1982    
1983     ##
1984     ## Return full namespace path for the given module
1985     ##
1986     ## Args: module
1987     ## Returns: full namespace path for the given module if it's loaded
1988     ## nothing otherwise
1989     ##
1990     proc whichModule {module} {
1991     variable NamespaceCurrent
1992    
1993     if {![string compare $module [namespace tail $NamespaceCurrent] $module]} then {
1994     return $NamespaceCurrent
1995     } elseif {[moduleLoaded $module]} then {
1996     return ${NamespaceCurrent}::$module
1997     }
1998     return
1999     }
2000    
2001     ##
2002     ## Return module name that provides the given command
2003     ##
2004     ## Args: command
2005     ## Returns: name of module that provides the given command
2006     ## nothing otherwise
2007     ##
2008     proc whichModuleCommand {command} {
2009     variable NamespaceCurrent
2010     variable commandTable
2011    
2012     if {[info exists commandTable($command)]} then {
2013     if {![string compare ${NamespaceCurrent}::$command \
2014     $commandTable($command)]} then {
2015     return [namespace tail $NamespaceCurrent]
2016     }
2017     return [namespace tail [namespace qualifiers $commandTable($command)]]
2018     }
2019     return
2020     }
2021    
2022     ##
2023 tothwolf 1.30 ## Check if the given [module] config option exists
2024     ##
2025     ## Args: module, option
2026     ## Returns: 1 if the given module config option exists
2027     ##
2028     proc configExists {module {option ""}} {
2029     variable NamespaceCurrent
2030     variable configData
2031    
2032     if {[string compare "" $module]} then {
2033     set where "${NamespaceCurrent}::${module}::"
2034     } else {
2035     set where ""
2036     }
2037     if {[string compare "" $option]} then {
2038     if {[info exists ${where}configData($option)]} then {
2039     return 1
2040     }
2041     } elseif {[info exists ${where}configData]} then {
2042     return 1
2043     }
2044     return 0
2045     }
2046    
2047     ##
2048 guppy 1.1 ## Compare the given version to eggdrop's version
2049     ##
2050     ## Args: version
2051     ## Returns: 0 if eggdrop's version is older then the given version
2052     ## 1 if eggdrop's version matches the given version
2053     ## 2 if eggdrop's version is newer then the given version
2054 tothwolf 1.33 ## -1 if the given version is invalid
2055 guppy 1.1 ##
2056     proc compareVersion {version} {
2057     global numversion
2058    
2059 tothwolf 1.33 if {([string compare "" $version]) && \
2060     ([info exists numversion])} then {
2061     if {[regexp -- \\. $version]} then {
2062     regsub -all -- \\. $version 0 version
2063     set version ${version}00
2064     }
2065     if {[regexp -- \[^0-9\] $version]} then {
2066     return -1
2067     } elseif {$numversion == $version} then {
2068     return 1
2069     } elseif {$numversion > $version} then {
2070     return 2
2071 guppy 1.1 }
2072     }
2073     return 0
2074     }
2075    
2076     ##
2077     ## Log module information
2078     ##
2079     ## Args: level, channel, args ({<namespace>} {<text>} | {<text>})
2080     ## Returns: nothing
2081     ##
2082     proc wpLog {level channel args} {
2083     if {[llength $args] == 2} then {
2084     if {[string compare wp [set namespace [namespace tail [lindex $args 0]]]]} then {
2085     putloglev $level $channel "Wolfpack: \[$namespace\] [lindex $args 1]"
2086     } else {
2087     putloglev $level $channel "Wolfpack: [lindex $args 1]"
2088     }
2089     } else {
2090     putloglev $level $channel "Wolfpack: [join $args]"
2091     }
2092     return
2093     }
2094    
2095     ##
2096     ## Evaluate command line arguments
2097     ##
2098     ## Args: none
2099     ## Returns: nothing
2100     ##
2101     proc EvalArgs {argc argv argv0} {
2102     variable NamespaceCurrent
2103     variable optionData
2104    
2105     for {set index 0} {$index < $argc} {incr index} {
2106     set option [lindex $argv $index]
2107 tothwolf 1.35 set nextoption [lindex $argv [expr $index + 1]]
2108    
2109 guppy 1.1 switch -regexp -- $option {
2110 tothwolf 1.35 (^--$) {
2111     break
2112     }
2113     (^--cfgfile$) {
2114     if {([string compare "" $nextoption]) && \
2115     (![regexp -- - $nextoption])} then {
2116     set optionData(cfgfile) $nextoption
2117     incr index
2118     } else {
2119     listAppendIf noparms "--cfgfile"
2120     }
2121     }
2122 guppy 1.1 (^--config$) {
2123     set optionData(config) 1
2124     }
2125 tothwolf 1.35 (^--update$) {
2126     set optionData(update) 1
2127     }
2128     (^--noupdate$) {
2129     set optionData(noupdate) 1
2130     }
2131 guppy 1.1 (^--rebuild$) {
2132     set optionData(rebuild) 1
2133     }
2134     (^--time$) {
2135     set optionData(time) 1
2136     }
2137 tothwolf 1.35 (^--include$) {
2138     if {([string compare "" $nextoption]) && \
2139     (![regexp -- - $nextoption])} then {
2140     lappend optionData(include) $nextoption
2141     incr index
2142     } else {
2143     listAppendIf noparms "--include"
2144     }
2145     }
2146     (^--exclude$) {
2147     if {([string compare "" $nextoption]) && \
2148     (![regexp -- - $nextoption])} then {
2149     lappend optionData(exclude) $nextoption
2150     incr index
2151     } else {
2152     listAppendIf noparms "--exclude"
2153     }
2154     }
2155     (^--module$) {
2156     if {([string compare "" $nextoption]) && \
2157     (![regexp -- - $nextoption])} then {
2158     set optionData(module) $nextoption
2159     incr index
2160     } else {
2161     listAppendIf noparms "--module"
2162     }
2163     }
2164 guppy 1.1 (^--verbose$) {
2165     incr optionData(verbose)
2166     }
2167     (^--quiet$) {
2168     incr optionData(quiet) -1
2169     }
2170     (^--debug$) {
2171     set optionData(debug) 1
2172     }
2173     (^--help$) {
2174     ShowUsage $argv0
2175     exit
2176     }
2177     (^--version$) {
2178     puts "[file tail $argv0] version [package require ${NamespaceCurrent}]"
2179     exit
2180     }
2181     (^-\[^-\]*$) {
2182     set suboptions [split $option ""]
2183     set sublength [llength [split $suboptions]]
2184     for {set subindex 0} {$subindex < $sublength} {incr subindex} {
2185     set suboption [lindex $suboptions $subindex]
2186     switch -exact -- $suboption {
2187     - {
2188     continue
2189     }
2190 tothwolf 1.35 f {
2191     # Next arg in argv should be a filename: '-f filename.conf',
2192     # so break out of the suboption loop after this option
2193     if {([string compare "" $nextoption]) && \
2194     (![regexp -- - $nextoption])} then {
2195     set optionData(cfgfile) $nextoption
2196     incr index
2197     break
2198     } else {
2199     listAppendIf noparms "-f"
2200     }
2201     }
2202 guppy 1.1 c {
2203     set optionData(config) 1
2204     }
2205 tothwolf 1.35 u {
2206     set optionData(update) 1
2207     }
2208     n {
2209     set optionData(noupdate) 1
2210     }
2211 guppy 1.1 r {
2212     set optionData(rebuild) 1
2213     }
2214     t {
2215     set optionData(time) 1
2216     }
2217 tothwolf 1.35 i {
2218     # Next arg in argv should be a module: '-i module',
2219     # so break out of the suboption loop after this option
2220     if {([string compare "" $nextoption]) && \
2221     (![regexp -- - $nextoption])} then {
2222     lappend optionData(include) $nextoption
2223     incr index
2224     break
2225     } else {
2226     listAppendIf noparms "-i"
2227     }
2228     }
2229     e {
2230     # Next arg in argv should be a module: '-e module',
2231     # so break out of the suboption loop after this option
2232     if {([string compare "" $nextoption]) && \
2233     (![regexp -- - $nextoption])} then {
2234     lappend optionData(exclude) $nextoption
2235     incr index
2236     break
2237     } else {
2238     listAppendIf noparms "-e"
2239     }
2240     }
2241     m {
2242     # Next arg in argv should be a module: '-m module',
2243     # so break out of the suboption loop after this option
2244     if {([string compare "" $nextoption]) && \
2245     (![regexp -- - $nextoption])} then {
2246     set optionData(module) $nextoption
2247     incr index
2248     break
2249     } else {
2250     listAppendIf noparms "-m"
2251     }
2252     }
2253 guppy 1.1 v {
2254     incr optionData(verbose)
2255     }
2256     q {
2257     incr optionData(quiet) -1
2258     }
2259     d {
2260     set optionData(debug) 1
2261     }
2262 tothwolf 1.35 H {
2263     ShowUsage $argv0
2264     exit
2265     }
2266