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