/[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.36 - (hide annotations) (download) (as text)
Tue Jul 8 20:02:47 2003 UTC (16 years, 3 months ago) by tothwolf
Branch: MAIN
Changes since 1.35: +187 -67 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.36 ## $Id: wolfpack.tcl,v 1.35 2003/07/08 02:14:12 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     proc arrayFindElementName {array element} {
692     set list [lsort [array names $array]]
693     set index [lsearch -exact [string tolower $list] [string tolower $name]]
694     if {$index != -1} then {
695     return [lindex $list $index]
696     }
697     return
698     }
699    
700     ##
701 tothwolf 1.9 ## Return length of longest data in an array at index
702 guppy 1.1 ##
703     ## Args: array name
704     ## Returns: length of longest name in an array
705     ##
706 tothwolf 1.9 proc arrayMaxElementDataLength {arrayName index} {
707 guppy 1.1 upvar 1 $arrayName array
708    
709     set maxlength 0
710     foreach {name data} [array get array] {
711 tothwolf 1.9 set length [string length [lindex $data $index]]
712 guppy 1.1 if {$length > $maxlength} then {
713     set maxlength $length
714     }
715     }
716     return $maxlength
717     }
718    
719     ##
720 tothwolf 1.35 ## Append something to the given list if it is not already in the list
721     ##
722     ## Args: listVar, what
723     ## Returns: list
724     ##
725     proc listAppendIf {listVar {what ""}} {
726     upvar 1 $listVar list
727    
728     if {([string compare "" $what]) &&
729     ((![info exists list]) || ([lsearch -exact $list $what] == -1))} then {
730     lappend list $what
731     }
732     return $list
733     }
734    
735     ##
736 guppy 1.1 ## Return length of the longest element in a list
737     ##
738 tothwolf 1.32 ## Args: list, index
739 guppy 1.1 ## Returns: length of longest element in the given list
740     ##
741 tothwolf 1.32 proc listMaxElementLength {list {index 0}} {
742 guppy 1.1 set maxlength 0
743     foreach data $list {
744 tothwolf 1.32 set length [string length [lindex $data $index]]
745 guppy 1.1 if {$length > $maxlength} then {
746     set maxlength $length
747     }
748     }
749     return $maxlength
750     }
751    
752     ##
753 tothwolf 1.2 ## Split up a list into multiple elements
754     ##
755     ## Args: text, max list length, split char, trim chars
756     ## Returns: split list
757     ##
758 tothwolf 1.9 # FIXME: improve this
759 tothwolf 1.2 proc splitList {text {splitLength 75} {splitChar " "} {trimChars " "}} {
760     # Sanity check splitLength and splitChar
761     if {($splitLength >= 1) && ([string compare "" $splitChar])} then {
762     set elementSplitLength [expr $splitLength - 1]
763     set stringLength [string length $text] ;# Total length of string
764     set subStringLength 0 ;# Text left over
765     set elementLength 0 ;# Element length counter
766     set elementStartIndex 0 ;# Start of split element
767     set elementEndIndex 0 ;# End of split element
768     for {
769     set stringIndex 0
770     } {$stringIndex < $stringLength} {
771     incr stringIndex
772     } {
773     # If element length greater than/equal to split length,
774     # Or element length equal to split length - 1,
775     # And character at current string index is splitChar
776     if {(($elementLength >= $splitLength) ||
777     ($elementLength == $elementSplitLength)) &&
778     (![string compare $splitChar \
779     [string index $text $stringIndex]])} then {
780     # Split substring element from text
781     set string [string range $text $elementStartIndex $elementEndIndex]
782     # Append substring element list to list
783     lappend list [string trim $string $trimChars]
784     # Reset element length counter
785     set elementLength 0
786     # Start split of next element at the end + 1 of the current one
787     set elementStartIndex [expr $elementEndIndex + 1]
788     # Reset end of next element to the start of the next element
789     set elementEndIndex $elementStartIndex
790     # Track remaining text length
791     set subStringLength [expr $subStringLength + [string length $string]]
792     } else {
793     # Increment element length
794     incr elementLength
795     # Increment end of next element
796     incr elementEndIndex
797     }
798     }
799     # Append any left over text as a new element
800     if {$stringLength > $subStringLength} then {
801     lappend list [string trim [string range $text $subStringLength end] $trimChars]
802     }
803     # Whew...that was alot of work!
804     if {[info exists list]} then {
805     return $list
806     }
807     }
808     return
809     }
810    
811     ##
812 tothwolf 1.35 ## Expand the given text with a list
813     ##
814     ## Args: text, list, elementIndex, resultVar
815     ## Returns: 0 if text not found
816     ## 1 if text is exactly matched
817     ## 2 if text is matched
818     ## -1 if text is ambiguous
819     ##
820     proc expandText {text list elementIndex resultVar} {
821     upvar 1 $resultVar result
822    
823     set found 0
824     set ambiguous 0
825     set lowerText [string tolower $text]
826     foreach listElement $list {
827     set compareElement [lindex $listElement $elementIndex]
828    
829     # Exact match
830     if {![string compare $text $compareElement]} then {
831     set result $listElement
832     return 1
833    
834     # Partial match
835     } elseif {[string match "$lowerText*" [string tolower $compareElement]]} then {
836     if {!$found} then {
837     set result $listElement
838     set found 1
839     } else {
840     set ambiguous 1
841     }
842     }
843     }
844     if {$ambiguous} then {
845     return -1
846     } elseif {$found} then {
847     return 2
848     }
849     return 0
850     }
851    
852     ##
853 guppy 1.1 ## Search an array for a given word or regexp
854     ##
855     ## Args: array name, word/regexp
856     ## Returns: list of indexes that match the given word/regexp
857     ##
858     proc arraySearch {array word} {
859     set word [string tolower $word]
860     set ret ""
861     foreach {name data} [array get $array] {
862     set string [string tolower $data]
863     if {[lsearch -regexp $string $word] != -1} then {
864     for {
865     set index 0
866     set indexes ""
867     } {
868     if {[regexp -- .*$word $string]} then {
869     lappend indexes $index
870     }
871     } {
872     incr index
873     }
874     lappend ret [list [concat $name $indexes]]
875     }
876     }
877     return $ret
878     }
879    
880     ##
881     ## Find option default for the given option name in a data list
882     ##
883     ## Args: data list, option name
884     ## Returns: option default if found,
885     ## nothing otherwise
886     ##
887     proc dataFormatDefault {list option} {
888     foreach i $list {
889     if {![string compare $option [lindex $i 0]]} then {
890     return [lindex $i 1]
891     }
892     }
893     return
894     }
895    
896     ##
897     ## Find option value for the given option name in a data list
898     ##
899     ## Args: data format, data list, option name
900     ## Returns: option value if found,
901     ## nothing otherwise
902     ##
903     proc dataFormatValue {format data option} {
904     if {[set index [lsearch -exact $format $option]] != -1} then {
905     return [lindex $data $index]
906     }
907     return
908     }
909    
910     ##
911     ## Replace option data in the given data list with a new value
912     ##
913     ## Args: data format, data list, option name, new value
914     ## Returns: data list
915     ##
916     proc dataFormatReplace {format data option value} {
917     if {[set index [lsearch -exact $format $option]] != -1} then {
918     return [lreplace $data $index $index $value]
919     }
920     return $data
921     }
922    
923     ##
924 tothwolf 1.2 ## Create a data format list for a given data format and options
925 guppy 1.1 ##
926     ## Args: data format list, defaults, options {{option1 value} ...}
927     ## Returns: data format list with options and values in proper order
928     ##
929     proc dataFormatBuild {format defaults args} {
930     set ret ""
931     foreach arg $args {
932     set [lindex $arg 0] [lindex $arg 1]
933     }
934     foreach opt $format {
935     if {[info exists $opt]} then {
936     lappend ret [set $opt]
937     } else {
938     lappend ret [dataFormatDefault $defaults $opt]
939     }
940     }
941     return $ret
942     }
943    
944     ##
945     ## Convert a data list from one format to another
946     ##
947     ## Args: from format, to format, data list
948     ## Returns: data list
949     ##
950     proc dataFormatConvert {fromFormat toFormat data} {
951     set ret ""
952     set index 0
953     foreach opt $fromFormat {
954     set $opt [lindex $data $index]
955     incr index
956     }
957     foreach opt $toFormat {
958     if {[info exists $opt]} then {
959     lappend ret [set $opt]
960     } else {
961     lappend ret [dataFormatDefault $defaults $opt]
962     }
963     }
964     return $ret
965     }
966    
967     ##
968     ## Scan the given file for module options
969     ##
970     ## Args: file, args {only scan for these options}
971     ## Returns: list of module options if the given file is a module,
972     ## nothing otherwise
973     ## Errors: unable to open file for reading
974     ##
975     proc scanModule {file args} {
976     variable moduleDatabaseConfig
977     variable moduleDatabaseFormat
978    
979     if {[catch {set fd [open $file r]} result]} then {
980     error $result
981     } else {
982     set ret ""
983     if {![string compare "" $args]} then {
984     set baseOptions [lindex $moduleDatabaseFormat([set moduleDatabaseConfig(version)]) 0]
985     set extraOptions [lindex $moduleDatabaseFormat([set moduleDatabaseConfig(version)]) 1]
986     set scanOptions "name $baseOptions"
987     set formatOptions "name $baseOptions $extraOptions"
988     } else {
989     set scanOptions $args
990     set formatOptions $args
991     }
992     for {
993     set lineCount 0
994     set optionCount 0
995     set continuedLine 0
996     } {(![eof $fd]) && ($lineCount <= $moduleDatabaseConfig(scanlines))} {
997     incr lineCount
998     } {
999     gets $fd line
1000     if {[regexp -- "^# .*:.*" $line]} then {
1001     set opt [string trimright [lindex $line 1] :]
1002     if {[lsearch -glob $scanOptions $opt] != -1} then {
1003     set data [string trimright [string trimleft [string range $line [string first : $line] end] " \t:"] " \t\\"]
1004     if {![info exists $opt]} then {
1005     set $opt $data
1006     } else {
1007     append $opt " $data"
1008     }
1009     }
1010     if {[regexp -- \\\\$ $line]} then {
1011     set continuedLine 1
1012     } else {
1013     set continuedLine 0
1014     }
1015     } elseif {($continuedLine) && ([info exists opt])} then {
1016     append $opt " [string trimright [string trimleft $line " \t#"] " \t\\"]"
1017     if {![regexp -- \\\\$ $line]} then {
1018     set continuedLine 0
1019     }
1020     }
1021     }
1022     close $fd
1023     if {(![string compare "" $args]) && \
1024     ((![info exists name]) || \
1025     ([catch {set md5sum [md5Sum $file]}]))} then {
1026     return
1027     }
1028     foreach option $formatOptions {
1029 tothwolf 1.2 if {(![info exists $option]) || \
1030     (![string compare "" [set $option]])} then {
1031 guppy 1.1 set $option [dataFormatDefault $moduleDatabaseConfig(defaults) $option]
1032     }
1033     lappend ret [set $option]
1034     }
1035     return $ret
1036     }
1037     }
1038    
1039     ##
1040     ## Get data from module db data array
1041     ##
1042     ## Args: module name, data type
1043     ## Returns: data for the given module's data type if it exists,
1044     ## nothing otherwise
1045     ##
1046     proc getModuleDatabaseData {module type} {
1047     variable moduleDatabaseConfig
1048     variable moduleDatabaseFormat
1049     variable moduleDatabaseData
1050    
1051     if {[moduleExists $module]} then {
1052     set index [lsearch -exact [join $moduleDatabaseFormat([set moduleDatabaseConfig(version)])] $type]
1053     if {$index != -1} then {
1054     return [lindex $moduleDatabaseData($module) $index]
1055     }
1056     }
1057     return
1058     }
1059    
1060     ##
1061     ## Set data in module db data array
1062     ##
1063     ## Args: module name, data type, data
1064     ## Returns: 1 if valid module and data type,
1065     ## 0 otherwise
1066     ##
1067     proc setModuleDatabaseData {module type data} {
1068     variable moduleDatabaseConfig
1069     variable moduleDatabaseFormat
1070     variable moduleDatabaseData
1071     variable moduleDatabaseDataChanged
1072    
1073     if {[moduleExists $module]} then {
1074     set index [lsearch -exact [join $moduleDatabaseFormat([set moduleDatabaseConfig(version)])] $type]
1075     if {$index != -1} then {
1076     set moduleDatabaseData($module) [lreplace $moduleDatabaseData($module) $index $index [list $data]]
1077     set moduleDatabaseDataChanged 1
1078     return 1
1079     }
1080     }
1081     return 0
1082     }
1083    
1084     ##
1085     ## Save module database
1086     ##
1087     ## Args: verbose {-1,0,1}
1088     ## Returns: 1 if successful,
1089     ## 0 otherwise
1090     ##
1091     proc saveModuleDatabase {{verbose 0}} {
1092     variable configData
1093     variable moduleDatabaseConfig
1094     variable moduleDatabaseData
1095 tothwolf 1.3 variable moduleDatabaseDataChanged
1096 guppy 1.1
1097     if {[createFile $configData(moddbfile) $verbose "module database file "]} then {
1098     if {[catch {set fd [open $configData(moddbfile) w]} result]} then {
1099     if {$verbose >= 0} then {
1100     wpLog o * "Error: unable to open module database file `$configData(moddbfile)' for writing: $result"
1101     }
1102     } else {
1103     puts $fd "# $moduleDatabaseConfig(header)$moduleDatabaseConfig(version)"
1104     close $fd
1105 tothwolf 1.3 set ret [arraySave moduleDatabaseData $configData(moddbfile) $verbose "module database file " a]
1106     if {$ret} then {
1107     set moduleDatabaseDataChanged 0
1108     }
1109     return $ret
1110 guppy 1.1 }
1111     }
1112     return 0
1113     }
1114    
1115     ##
1116     ## Load module database
1117     ##
1118     ## Args: verbose {-1,0,1}
1119     ## Returns: 1 if successful,
1120     ## 0 otherwise
1121     ##
1122     proc loadModuleDatabase {{verbose 0}} {
1123     variable configData
1124     variable moduleDatabaseConfig
1125     variable moduleDatabaseFormat
1126     variable moduleDatabaseData
1127 tothwolf 1.3 variable moduleDatabaseDataChanged
1128 guppy 1.1
1129     if {![file exists $configData(moddbfile)]} then {
1130     return -1
1131     } else {
1132     if {[catch {set fd [open $configData(moddbfile) r]} result]} then {
1133     if {$verbose >= 0} then {
1134     wpLog o * "Error: unable to open module database file `$configData(moddbfile)' for reading: $result"
1135     }
1136     } else {
1137     set firstline [replaceExpr [gets $fd] "^ "]
1138     if {[regexp -- "^# $moduleDatabaseConfig(header)" $firstline]} then {
1139     regsub -all -- "^# $moduleDatabaseConfig(header)" $firstline "" version
1140     if {![string compare [set version [string trim $version]] $moduleDatabaseConfig(version)]} then {
1141     close $fd
1142     return [arrayLoad moduleDatabaseData $configData(moddbfile) $verbose "module database file "]
1143     } elseif {[info exists moduleDatabaseFormat($version)]} then {
1144     if {[info exists moduleDatabaseData]} then {
1145     unset moduleDatabaseData
1146     }
1147     while {![eof $fd]} {
1148     set line [replaceExpr [gets $fd] "^ "]
1149     if {([string compare "" $line]) && \
1150     (![regexp -- "^#" $line])} then {
1151     set moduleDatabaseData([lindex $line 0]) [dataFormatConvert [join $moduleDatabaseFormat($version)] [join $moduleDatabaseFormat([set moduleDatabaseConfig(version)])] [lindex $line 1]]
1152     }
1153     }
1154     close $fd
1155 tothwolf 1.3 set moduleDatabaseDataChanged 0
1156 guppy 1.1 return 1
1157     } else {
1158     wpLog o * "Error: unknown module database version: $version"
1159     }
1160     } else {
1161     wpLog o * "Error: unknown module database format: [string trimleft $firstline " \t#"]"
1162     }
1163     }
1164     close $fd
1165     }
1166     return 0
1167     }
1168    
1169     ##
1170 tothwolf 1.36 ## Add module data to the module database
1171 tothwolf 1.35 ##
1172 tothwolf 1.36 ## Args: file
1173 tothwolf 1.35 ## Returns: nothing
1174 tothwolf 1.36 ## Errors: if can't open file for reading
1175 tothwolf 1.35 ##
1176 tothwolf 1.36 proc updateModuleData {file} {
1177 tothwolf 1.35 variable moduleDatabaseConfig
1178     variable moduleDatabaseFormat
1179     variable moduleDatabaseData
1180     variable moduleDatabaseDataChanged
1181    
1182     if {[catch {set data [scanModule $file]} result]} then {
1183 tothwolf 1.36 error $result
1184 tothwolf 1.35 } else {
1185     set name [lindex $data 0]
1186     if {[string compare "" $name]} then {
1187     if {[moduleExists $name]} then {
1188     set loadIndex [lsearch -exact [join $moduleDatabaseFormat([set moduleDatabaseConfig(version)])] load]
1189     set moduleDatabaseData($name) [lreplace [lrange $data 1 end] $loadIndex $loadIndex [lindex $moduleDatabaseData($name) $loadIndex]]
1190     } else {
1191     set moduleDatabaseData($name) [lrange $data 1 end]
1192     }
1193     set moduleDatabaseDataChanged 1
1194     }
1195     }
1196     return
1197     }
1198    
1199     ##
1200     ## Update module database
1201 guppy 1.1 ##
1202     ## Args: verbose {-1,0,1}
1203 tothwolf 1.35 ## Returns: nothing
1204 guppy 1.1 ##
1205 tothwolf 1.35 proc updateModuleDatabase {{verbose 0}} {
1206 tothwolf 1.36 variable modulePath
1207 guppy 1.1 variable moduleDatabaseConfig
1208 tothwolf 1.35 variable moduleDatabaseData
1209     variable moduleDatabaseDataChanged
1210 tothwolf 1.36 variable moduleOptionData
1211 tothwolf 1.35
1212     set moduleList [listModules]
1213    
1214 tothwolf 1.36 set foundFiles "" ;# List of '.tcl' files found in module path
1215     set comparedFiles "" ;# List of compared module files
1216 tothwolf 1.35
1217 tothwolf 1.36 # Only update the given module(s) when the '-m <file>' option is used.
1218     if {[string compare "" $moduleOptionData(modulefiles)]} then {
1219     set fullSearch 0
1220     set foundFiles $moduleOptionData(modulefiles)
1221     } else {
1222     set fullSearch 1
1223    
1224     # Build up file list
1225     foreach dir $modulePath {
1226     foreach file [findFiles $dir $moduleDatabaseConfig(maxdepth) .tcl] {
1227     lappend foundFiles $file
1228     }
1229 tothwolf 1.35 }
1230     }
1231 guppy 1.1
1232 tothwolf 1.35 # Find removed files
1233     foreach module $moduleList {
1234     set file [getModuleDatabaseData $module file]
1235    
1236 tothwolf 1.36 # Only update the given modules if the '-m' option was used
1237     if {($fullSearch) ||
1238     ([lsearch -exact $moduleOptionData(modulefiles) $file] != -1)} then {
1239     set shortfile [shortFile $file $modulePath]
1240    
1241     # Remove any invalid module data
1242     if {[lsearch -exact $foundFiles $file] == -1} then {
1243     if {([lsearch -exact $moduleOptionData(excludedfiles) $file] != -1)} then {
1244     if {$verbose >= 1} then {
1245     wpLog o * "Not removing module data for excluded missing file `$shortfile' ($module)"
1246     }
1247     } else {
1248     if {$verbose >= 1} then {
1249     wpLog o * "Removing module data for missing file `$shortfile' ($module)"
1250     }
1251     unset moduleDatabaseData($module)
1252     set moduleDatabaseDataChanged 1
1253     }
1254 tothwolf 1.35
1255     # Compare existing valid modules
1256 tothwolf 1.36 } else {
1257     if {([lsearch -exact $moduleOptionData(excludedfiles) $file] != -1)} then {
1258     if {$verbose >= 1} then {
1259     wpLog o * "Not comparing excluded file `$shortfile'"
1260     }
1261     } else {
1262     if {$verbose >= 1} then {
1263     wpLog o * "Comparing file `$shortfile'"
1264     }
1265 tothwolf 1.35
1266 tothwolf 1.36 # Compare md5 from module db and make sure the module hasn't changed
1267     if {([catch {set md5sum [md5Sum $file]}]) || \
1268     ([string compare [getModuleDatabaseData $module md5sum] $md5sum])} then {
1269     if {$verbose >= 1} then {
1270     wpLog o * "Updating module information for file `$shortfile'"
1271     }
1272     if {[catch {updateModuleData $file} result]} then {
1273     if {$verbose >= 0} then {
1274     wpLog o * "Warning: unable to open file `$shortfile' for reading: $result"
1275     }
1276     }
1277     }
1278 guppy 1.1 }
1279 tothwolf 1.36 lappend comparedFiles $file
1280 guppy 1.1 }
1281 tothwolf 1.35 }
1282     }
1283    
1284 tothwolf 1.36 # Find new module files
1285 tothwolf 1.35 foreach file $foundFiles {
1286 tothwolf 1.36
1287     # Only update the given modules if the '-m' option was used
1288     if {($fullSearch) ||
1289     ([lsearch -exact $moduleOptionData(modulefiles) $file] != -1)} then {
1290     set shortfile [shortFile $file $modulePath]
1291    
1292     if {[lsearch -exact $comparedFiles $file] == -1} then {
1293     if {([lsearch -exact $moduleOptionData(excludedfiles) $file] != -1)} then {
1294     if {$verbose >= 1} then {
1295     wpLog o * "Not adding module information for excluded file `$shortfile'"
1296     }
1297     } else {
1298     if {$verbose >= 1} then {
1299     wpLog o * "Adding module information for file `$shortfile'"
1300     }
1301     if {[catch {updateModuleData $file} result]} then {
1302     if {$verbose >= 0} then {
1303     wpLog o * "Warning: unable to open file `$shortfile' for reading: $result"
1304     }
1305     }
1306     }
1307 guppy 1.1 }
1308     }
1309     }
1310 tothwolf 1.35 return
1311 guppy 1.1 }
1312    
1313     ##
1314     ## Rebuild module database
1315     ##
1316     ## Args: verbose {-1,0,1}
1317     ## Returns: nothing
1318     ##
1319     proc rebuildModuleDatabase {{verbose 0}} {
1320 tothwolf 1.36 variable modulePath
1321 guppy 1.1 variable moduleDatabaseConfig
1322     variable moduleDatabaseFormat
1323     variable moduleDatabaseData
1324    
1325 tothwolf 1.35 # Copy database data for later use
1326     if {[info exists moduleDatabaseData]} then {
1327     set mergeLoad 1
1328     array set moduleDatabaseDataTmp [array get moduleDatabaseData]
1329     unset moduleDatabaseData
1330     } else {
1331     set mergeLoad 0
1332     }
1333    
1334 tothwolf 1.36 foreach dir $modulePath {
1335 tothwolf 1.35 foreach file [findFiles $dir $moduleDatabaseConfig(maxdepth) .tcl] {
1336 tothwolf 1.36 set shortfile [shortFile $file $modulePath]
1337    
1338 guppy 1.1 if {$verbose >= 1} then {
1339 tothwolf 1.36 wpLog o * "Scanning file `$shortfile'"
1340     }
1341     if {[catch {updateModuleData $file} result]} then {
1342     if {$verbose >= 0} then {
1343     wpLog o * "Warning: unable to open file `$shortfile' for reading: $result"
1344     }
1345 guppy 1.1 }
1346     }
1347     }
1348 tothwolf 1.35
1349     # Merge load data into new database
1350     if {$mergeLoad} then {
1351     set loadIndex [lsearch -exact [join $moduleDatabaseFormat([set moduleDatabaseConfig(version)])] load]
1352    
1353     foreach module [listModules] {
1354     set moduleDatabaseData($module) [lreplace $moduleDatabaseData($module) $loadIndex $loadIndex [lindex $moduleDatabaseDataTmp($module) $loadIndex]]
1355     }
1356     # Note: Not modifying moduleDatabaseDataChanged here, since
1357     # 'updateModuleData' will have already done so.
1358 guppy 1.1 }
1359     return
1360     }
1361    
1362     ##
1363     ## List all modules in the database
1364     ##
1365     ## Args: none
1366     ## Returns: list of modules in module database
1367     ##
1368     proc listModules {{loaded 0}} {
1369     variable moduleDatabaseData
1370     variable moduleLoadedList
1371    
1372     if {$loaded} then {
1373     return [lsort $moduleLoadedList]
1374     }
1375     return [lsort [array names moduleDatabaseData]]
1376     }
1377    
1378     ##
1379     ## Check if the given module exists
1380     ##
1381     ## Args: module name
1382     ## Returns: 1 if the given module exists
1383     ## 0 otherwise
1384     ##
1385     proc moduleExists {module} {
1386     variable moduleDatabaseData
1387    
1388     if {[info exists moduleDatabaseData($module)]} then {
1389     return 1
1390     }
1391     return 0
1392     }
1393    
1394     ##
1395     ## Check if a module is loaded
1396     ##
1397     ## Args: module name
1398     ## Returns: 1 if the given module is loaded
1399     ## 0 otherwise
1400     ##
1401     proc moduleLoaded {module} {
1402     variable moduleLoadedList
1403    
1404     if {[lsearch -exact $moduleLoadedList $module] != -1} then {
1405     return 1
1406     }
1407     return 0
1408     }
1409    
1410     ##
1411 tothwolf 1.15 ## Add/remove bindings for a given module
1412 tothwolf 1.7 ##
1413 tothwolf 1.16 ## Args: mode {bind|unbind}, module,
1414 tothwolf 1.29 ## args {{type ...} {option ...} {cmdsub ...} {regsub ...}}
1415 tothwolf 1.7 ## Returns: nothing
1416     ##
1417 tothwolf 1.29 ## Important variables:
1418     ## argTypes "dcc msg pub ..."
1419     ## argOptions "noauto cmdchr ..."
1420     ## argCmdsub(regexp) "command"
1421     ## argRegsub(regexp) "with"
1422     ## optCmdsub(regexp) "command"
1423     ## optRegsub(regexp) "with"
1424     ##
1425 tothwolf 1.16 proc moduleBindUnbind {mode module args} {
1426 tothwolf 1.7 variable NamespaceCurrent
1427    
1428     if {[info exists ${NamespaceCurrent}::${module}::bindDefaults]} then {
1429 tothwolf 1.29 # These are for use in calling this proc directly.
1430     # bindDefaults options are further below
1431     set argTypes ""
1432     set argOptions ""
1433     foreach arg $args {
1434     switch -exact -- [lindex $arg 0] {
1435 tothwolf 1.15 type {
1436 tothwolf 1.29 # Specific types to match against
1437 tothwolf 1.15 # dcc msg pub ...
1438 tothwolf 1.29 set argTypes [lrange $arg 1 end]
1439 tothwolf 1.9 }
1440 tothwolf 1.15 option {
1441 tothwolf 1.29 # Specific options to match against
1442     # noauto cmdchr ...
1443     set argOptions [lrange $arg 1 end]
1444     }
1445     cmdsub {
1446     # Replace 'regexp' with result of 'command'
1447     # NOTE: 'command' will eventually be processed in calling stack
1448     foreach {command regexp} [lindex $arg 1] {break}
1449     # FIXME: better fix for leading '+/$'
1450     regsub -- "\[\\+|\\$\]" $regexp "\\\\&" regexp
1451     # FIXME: can't do this:
1452     #regsub -- {([][\\\*\+\?\{\}\,\(\)\:\.\^\$\=\!\|])} $regexp {\\\1} regexp
1453     # Try to find 'command' in 'module' namespace
1454     if {[string compare "" [info commands ${NamespaceCurrent}::${module}::[lindex $command 0]]]} then {
1455     # Command is module specific or imported
1456     set argCmdsub($regexp) ${NamespaceCurrent}::${module}::$command
1457     } else {
1458     # Must be a global command
1459     set argCmdsub($regexp) $command
1460 tothwolf 1.7 }
1461     }
1462 tothwolf 1.15 regsub {
1463 tothwolf 1.29 # Replace regexp 'rwhat' with 'rwith'
1464     foreach {rwhat rwith} [lindex $arg 1] {break}
1465     # FIXME: better fix for leading '+/$'
1466     regsub -- "\[\\+|\\$\]" $rwhat "\\\\&" rwhat
1467     set argRegsub($rwhat) $rwith
1468 tothwolf 1.15 }
1469     }
1470 tothwolf 1.7 }
1471 tothwolf 1.15 foreach {proc data} [array get ${NamespaceCurrent}::${module}::bindDefaults] {
1472     foreach bind $data {
1473     foreach {type flags mask options help} $bind {break}
1474 tothwolf 1.29 # Continue if a specific bind type is requested and not matched
1475     if {([string compare "" $argTypes]) && \
1476     ([lsearch -exact $argTypes $type] == -1)} then {
1477 tothwolf 1.26 continue
1478     }
1479 tothwolf 1.29 # Sanity check!
1480     # Continue if argOptions specified and bind options don't exist
1481     if {([string compare "" $argOptions]) && \
1482     (![string compare "" $options])} then {
1483 tothwolf 1.15 continue
1484     }
1485 tothwolf 1.29 # These _must_ be clean since they are reused for multiple binds
1486     set continue 0
1487     if {[info exists optCmdsub]} then {
1488     unset optCmdsub
1489     }
1490     if {[info exists optRegsub]} then {
1491     unset optRegsub
1492     }
1493     # Process bind specific options
1494     foreach option $options {
1495     set optcmd [lindex $option 0]
1496     # Search 'argOptions' for 'optcmd'
1497     # Abort bind and continue with next if not found
1498     if {[string compare "" $argOptions]} then {
1499     set found 0
1500     foreach argoption $argOptions {
1501     if {![string compare $optcmd [lindex $argoption 0]]} then {
1502     set found 1
1503     }
1504     }
1505     if {!$found} then {
1506     set continue 1
1507 tothwolf 1.18 break
1508     }
1509     }
1510 tothwolf 1.29 switch -exact -- $optcmd {
1511     noauto {
1512     # Search for noauto override in argOptions
1513     if {[lsearch -exact $argOptions noauto] == -1} then {
1514     # noauto matched and not overriden
1515     set continue 1
1516     break
1517     }
1518     }
1519     cmdsub {
1520     # Replace 'regexp' with result of 'command'
1521     # NOTE: 'command' will eventually be processed in calling stack
1522     foreach {command regexp} [lindex $option 1] {break}
1523     # FIXME: better fix for leading '+/$'
1524     regsub -- "\[\\+|\\$\]" $regexp "\\\\&" regexp
1525     # Try to find 'command' in 'module' namespace
1526     if {[string compare "" [info commands ${NamespaceCurrent}::${module}::[lindex $command 0]]]} then {
1527     # Command is module specific or imported
1528     set optCmdsub($regexp) ${NamespaceCurrent}::${module}::$command
1529     } else {
1530     # Must be a global command
1531     set optCmdsub($regexp) $command
1532     }
1533     }
1534     regsub {
1535     # Replace regexp 'rwhat' with 'rwith'
1536     foreach {rwhat rwith} [lindex $option 1] {break}
1537     # FIXME: better fix for leading '+/$'
1538     regsub -- "\[\\+|\\$\]" $rwhat "\\\\&" rwhat
1539     set optRegsub($rwhat) $rwith
1540     }
1541 tothwolf 1.18 }
1542 tothwolf 1.15 }
1543 tothwolf 1.29 # Abort this bind and continue with the next
1544     if {$continue} then {
1545     continue
1546 tothwolf 1.9 }
1547 tothwolf 1.29 # Make optCmdsub regexp substitutions on mask
1548     if {[array exists optCmdsub]} then {
1549     foreach {regexp command} [array get optCmdsub] {
1550     # Process 'command' in calling stack
1551     regsub -all -- $regexp $mask [uplevel 1 $command] mask
1552     }
1553     }
1554     # Make optRegsub regexp substitutions on mask
1555 tothwolf 1.35 if {[array exists optRegsub]} then {
1556 tothwolf 1.29 foreach {replacewhat replacewith} [array get optRegsub] {
1557 tothwolf 1.15 regsub -all -- $replacewhat $mask $replacewith mask
1558 tothwolf 1.9 }
1559 tothwolf 1.7 }
1560 tothwolf 1.29 # Make argCmdsub regexp substitutions on mask
1561     if {[array exists argCmdsub]} then {
1562     foreach {regexp command} [array get argCmdsub] {
1563     # Process 'command' in calling stack
1564     regsub -all -- $regexp $mask [uplevel 1 $command] mask
1565     }
1566     }
1567     # Make argRegsub regexp substitutions on mask
1568 tothwolf 1.35 if {[array exists argRegsub]} then {
1569 tothwolf 1.29 foreach {replacewhat replacewith} [array get argRegsub] {
1570     regsub -all -- $replacewhat $mask $replacewith mask
1571     }
1572     }
1573     # Finally! bind/unbind
1574     if {[catch {
1575     $mode $type $flags $mask ${NamespaceCurrent}::${module}::$proc
1576     } result]} then {
1577     wpLog d * "Error: ${mode}ing $type for $mask: $result"
1578     }
1579 tothwolf 1.7 }
1580     }
1581     }
1582     return
1583     }
1584    
1585     ##
1586 guppy 1.1 ## Load a module
1587     ##
1588     ## Args: module name, verbose {-1,0,1}, args {loop detection}
1589     ## Returns: nothing
1590     ## Errors: if unable to load module
1591     ##
1592     proc moduleLoad {module {verbose 0} args} {
1593     variable NamespaceCurrent
1594     variable moduleLoadedList
1595    
1596     if {[lsearch -exact [set loop [lindex $args 0]] $module] == -1} then {
1597     if {[moduleExists $module]} then {
1598     set preload ""
1599     set requires [getModuleDatabaseData $module requires]
1600     foreach required $requires {
1601     set preloadModule [whichModuleCommand $required]
1602     if {[string compare "" $preloadModule]} then {
1603     if {([lsearch -exact $preload $preloadModule] == -1) && \
1604     ([string compare wp $preloadModule]) && \
1605     (![moduleLoaded $preloadModule])} then {
1606     lappend preload $preloadModule
1607     }
1608     } else {
1609     error "required command `$required' not found."
1610     }
1611     }
1612     if {[string compare "" $preload]} then {
1613     foreach premod $preload {
1614     if {[catch {moduleLoad $premod $verbose [concat $loop $module]} result]} then {
1615     error $result
1616     }
1617     }
1618     }
1619     if {[catch {source [getModuleDatabaseData $module file]} result]} then {
1620     error $result
1621     } else {
1622     package forget $module
1623     package provide ${NamespaceCurrent}::${module} [getModuleDatabaseData $module version]
1624 tothwolf 1.9 moduleConfigLoad $module 1
1625     moduleConfigCheckdefs $module 1
1626     moduleDataLoad $module 1
1627 guppy 1.1 # Imported commands '# requires: ...'
1628     if {[string compare "" $requires]} then {
1629 tothwolf 1.31 set namespaceScript "namespace eval ${NamespaceCurrent}::${module} \{\n namespace forget *\n namespace import"
1630 guppy 1.1 foreach required $requires {
1631     if {[string compare "" [set command [whichCommand $required]]]} then {
1632 tothwolf 1.31 append namespaceScript " $command"
1633 guppy 1.1 }
1634     }
1635 tothwolf 1.31 append namespaceScript "\n\}"
1636     eval $namespaceScript
1637 guppy 1.1 }
1638     # Exported commands '# provides: ...'
1639     if {[string compare "" [set provides [getModuleDatabaseData $module provides]]]} then {
1640 tothwolf 1.31 set namespaceScript "namespace eval ${NamespaceCurrent}::${module} \{\n namespace export"
1641 guppy 1.1 foreach provided $provides {
1642 tothwolf 1.31 append namespaceScript " $provided"
1643 guppy 1.1 }
1644 tothwolf 1.31 append namespaceScript "\n\}"
1645     eval $namespaceScript
1646 guppy 1.1 }
1647 tothwolf 1.7 if {[string compare "" [info commands ${NamespaceCurrent}::${module}::ModuleInit]]} then {
1648     ${NamespaceCurrent}::${module}::ModuleInit
1649 guppy 1.1 }
1650 tothwolf 1.7 # FIXME: check for bindings? duplicates?
1651 tothwolf 1.15 moduleBindUnbind bind $module
1652 guppy 1.1 if {![getModuleDatabaseData $module load]} then {
1653     setModuleDatabaseData $module load 1
1654     }
1655     if {[lsearch -exact $moduleLoadedList $module] == -1} then {
1656     lappend moduleLoadedList $module
1657     if {$verbose >= 1} then {
1658     wpLog o * "Module loaded: $module"
1659     }
1660     }
1661     }
1662     } else {
1663     error "No such module: $module"
1664     }
1665     } else {
1666     regsub -all -- " " $loop " -> " loop
1667     error "Preload endless loop: $loop -> $module"
1668     }
1669     return
1670     }
1671    
1672     ##
1673     ## Unload a module
1674     ##
1675     ## Args: module name, verbose {-1,0,1}
1676     ## Returns: nothing
1677     ## Errors: if unable to completely unload module
1678     ##
1679     proc moduleUnload {module {verbose 0}} {
1680     variable NamespaceCurrent
1681     variable moduleLoadedList
1682    
1683 tothwolf 1.9 # FIXME: handle dependant modules and modules that can't be unloaded
1684 guppy 1.1 if {[moduleExists $module]} then {
1685 tothwolf 1.7 if {[string compare "" [info commands ${NamespaceCurrent}::${module}::ModuleDestroy]]} then {
1686     ${NamespaceCurrent}::${module}::ModuleDestroy
1687 guppy 1.1 }
1688 tothwolf 1.7 # FIXME: check for bindings?
1689 tothwolf 1.15 moduleBindUnbind unbind $module
1690 tothwolf 1.9 moduleConfigSave $module 1
1691     moduleDataSave $module 1
1692 tothwolf 1.28
1693     # FIXME: we should kill off stale timer/utimers here somewhere before unloading
1694    
1695 guppy 1.1 if {[catch {namespace delete ${NamespaceCurrent}::${module}} result]} then {
1696     error $result
1697     } else {
1698     package forget ${NamespaceCurrent}::${module}
1699     if {[getModuleDatabaseData $module load] == 1} then {
1700     setModuleDatabaseData $module load 0
1701     }
1702     set index [lsearch -exact $moduleLoadedList $module]
1703     if {$index != -1} then {
1704     set moduleLoadedList [lreplace $moduleLoadedList $index $index]
1705     if {$verbose >= 1} then {
1706     wpLog o * "Module unloaded: $module"
1707     }
1708     }
1709     }
1710     } else {
1711     error "No such module: $module"
1712     }
1713     return
1714     }
1715    
1716     ##
1717 tothwolf 1.9 ## Save configuration settings for the given module
1718 guppy 1.1 ##
1719 tothwolf 1.9 ## Args: module, force {0,1}, verbose {-1,0,1}
1720     ## Returns: 1 if settings saved
1721 guppy 1.1 ## 0 otherwise
1722     ##
1723 tothwolf 1.9 proc moduleConfigSave {module {force 0} {verbose 0}} {
1724 guppy 1.1 variable NamespaceCurrent
1725     variable configData
1726    
1727     if {([string compare "" \
1728     [set file [getModuleDatabaseData $module config]]]) && \
1729     ([createDir $configData(configpath)])} then {
1730     set cfgfile [file join $configData(configpath) $file]
1731 tothwolf 1.9 if {([getModuleDatabaseData $module load]) && \
1732     (($force) || \
1733     (![info exists ${NamespaceCurrent}::${module}::configDataChanged]) || \
1734     ([set ${NamespaceCurrent}::${module}::configDataChanged]))} then {
1735     if {[arraySave ${NamespaceCurrent}::${module}::configData $cfgfile 0 "$module configuration file "]} then {
1736     if {$verbose >= 1} then {
1737     wpLog o * "Writing $module config file..."
1738 guppy 1.1 }
1739 tothwolf 1.9 set ${NamespaceCurrent}::${module}::configDataChanged 0
1740     return 1
1741     } elseif {$verbose >= 0} then {
1742     wpLog o * "Error writing $module config file."
1743 guppy 1.1 }
1744 tothwolf 1.9 }
1745     }
1746     return 0
1747     }
1748    
1749     ##
1750     ## Load configuration settings for the given module
1751     ##
1752     ## Args: module, force {0,1}, verbose {-1,0,1}
1753     ## Returns: 1 if settings loaded
1754     ## 0 otherwise
1755     ##
1756     proc moduleConfigLoad {module {force 0} {verbose 0}} {
1757     variable NamespaceCurrent
1758     variable configData
1759    
1760     if {([string compare "" \
1761     [set file [getModuleDatabaseData $module config]]]) && \
1762     ([createDir $configData(configpath)])} then {
1763     set cfgfile [file join $configData(configpath) $file]
1764     if {($force) || \
1765     (![info exists ${NamespaceCurrent}::${module}::configDataChanged]) || \
1766     (![set ${NamespaceCurrent}::${module}::configDataChanged])} then {
1767     if {[arrayLoad ${NamespaceCurrent}::${module}::configData $cfgfile 0 "$module configuration file "]} then {
1768     if {$verbose >= 1} then {
1769     wpLog o * "Loading $module config file..."
1770 guppy 1.1 }
1771 tothwolf 1.9 set ${NamespaceCurrent}::${module}::configDataChanged 0
1772     return 1
1773     } elseif {$verbose >= 0} then {
1774     wpLog o * "Error loading $module config file."
1775 guppy 1.1 }
1776     }
1777     }
1778     return 0
1779     }
1780    
1781     ##
1782 tothwolf 1.9 ## Check and set default configuration settings for the given module
1783 guppy 1.1 ##
1784 tothwolf 1.9 ## Args: module, force {0,1}, verbose {-1,0,1}
1785 guppy 1.1 ## Returns: nothing
1786     ##
1787 tothwolf 1.9 proc moduleConfigCheckdefs {module {force 0} {verbose 0}} {
1788     variable NamespaceCurrent
1789    
1790     if {([array exists ${NamespaceCurrent}::${module}::configDefaults]) && \
1791     ([string compare "" [getModuleDatabaseData $module config]])} then {
1792     set Changed 0
1793     # Unset unknown variables
1794     foreach name [array names ${NamespaceCurrent}::${module}::configData] {
1795     if {![info exists ${NamespaceCurrent}::${module}::configDefaults($name)]} then {
1796     unset ${NamespaceCurrent}::${module}::configData($name)
1797     set Changed 1
1798     }
1799     }
1800     # Set missing variables to defaults
1801     foreach {name data} [array get ${NamespaceCurrent}::${module}::configDefaults] {
1802     if {![info exists ${NamespaceCurrent}::${module}::configData($name)]} then {
1803     set ${NamespaceCurrent}::${module}::configData($name) [lindex $data 1]
1804     set Changed 1
1805     }
1806     }
1807     # FIXME: do this with a trace?
1808     if {$Changed} then {
1809     set ${NamespaceCurrent}::${module}::configDataChanged 1
1810     }
1811     }
1812     return
1813     }
1814 guppy 1.1
1815 tothwolf 1.9 ##
1816     ## Handle config data for a list of modules
1817     ##
1818     ## Args: action {load|save|checkdefs}, module list, force {0,1},
1819     ## verbose {-1,0,1}
1820     ## Returns: nothing
1821     ##
1822     proc moduleConfig {action modules {force 0} {verbose 0}} {
1823 guppy 1.1 if {![string compare * $modules]} then {
1824     set modules [listModules 1]
1825     }
1826 tothwolf 1.9 switch -exact -- $action {
1827     save {
1828     foreach module $modules {
1829     if {([moduleExists $module]) && ([moduleLoaded $module])} then {
1830     moduleConfigSave $module $force $verbose
1831     }
1832     }
1833     }
1834     load {
1835     foreach module $modules {
1836     if {([moduleExists $module]) && ([moduleLoaded $module])} then {
1837     moduleConfigLoad $module $force $verbose
1838     }
1839     }
1840     }
1841     checkdefs {
1842     foreach module $modules {
1843     if {([moduleExists $module]) && ([moduleLoaded $module])} then {
1844     moduleConfigCheckdefs $module $force $verbose
1845     }
1846     }
1847 guppy 1.1 }
1848     }
1849     return
1850     }
1851    
1852     ##
1853 tothwolf 1.9 ## Save data for the given module
1854 guppy 1.1 ##
1855 tothwolf 1.9 ## Args: module, force {0,1}, verbose {-1,0,1}
1856 guppy 1.1 ## Returns: nothing
1857     ##
1858 tothwolf 1.9 proc moduleDataSave {module {force 0} {verbose 0}} {
1859 guppy 1.1 variable NamespaceCurrent
1860     variable configData
1861    
1862     if {([info exists ${NamespaceCurrent}::${module}::dataOptions]) && \
1863     ([createDir $configData(datapath)])} then {
1864 tothwolf 1.9 foreach {name data} [array get ${NamespaceCurrent}::${module}::dataOptions] {
1865     foreach {type file desc} $data {break}
1866     if {([info exists type]) && ([info exists file]) && \
1867     ([info exists desc])} then {
1868     set Changed ${NamespaceCurrent}::${module}::${name}Changed
1869     if {($force) || ((![info exists $Changed]) || ([set $Changed]))} then {
1870     if {[${type}Save ${NamespaceCurrent}::${module}::$name [file join $configData(datapath) $file]]} then {
1871     if {$verbose >= 1} then {
1872     wpLog o * $NamespaceCurrent "Writing $desc data file..."
1873 guppy 1.1 }
1874 tothwolf 1.9 set $Changed 0
1875     } elseif {$verbose >= 0} then {
1876     wpLog o * $NamespaceCurrent "Error writing $desc data file!"
1877 guppy 1.1 }
1878     }
1879     }
1880 tothwolf 1.9 }
1881     }
1882     return
1883     }
1884    
1885     ##
1886     ## Load data for the given module
1887     ##
1888     ## Args: module, force {0,1}, verbose {-1,0,1}
1889     ## Returns: nothing
1890     ##
1891     proc moduleDataLoad {module {force 0} {verbose 0}} {
1892     variable NamespaceCurrent
1893     variable configData
1894    
1895     if {([info exists ${NamespaceCurrent}::${module}::dataOptions]) && \
1896     ([createDir $configData(datapath)])} then {
1897     foreach {name data} [array get ${NamespaceCurrent}::${module}::dataOptions] {
1898     foreach {type file desc} $data {break}
1899     if {([info exists type]) && ([info exists file]) && \
1900     ([info exists desc])} then {
1901     set Changed ${NamespaceCurrent}::${module}::${name}Changed
1902     if {($force) || ((![info exists $Changed]) || ([set $Changed]))} then {
1903     if {[${type}Load ${NamespaceCurrent}::${module}::$name [file join $configData(datapath) $file]]} then {
1904     if {$verbose >= 1} then {
1905     wpLog o * $NamespaceCurrent "Reloading $desc data file..."
1906 guppy 1.1 }
1907 tothwolf 1.9 set $Changed 0
1908     } elseif {$verbose >= 0} then {
1909     wpLog o * $NamespaceCurrent "Error reloading $desc data file!"
1910 guppy 1.1 }
1911     }
1912     }
1913 tothwolf 1.9 }
1914     }
1915     return
1916     }
1917    
1918     ##
1919     ## Backup data for the given module
1920     ##
1921     ## Args: module, force {0,1}, verbose {-1,0,1}
1922     ## Returns: nothing
1923     ##
1924     proc moduleDataBackup {module {force 0} {verbose 0}} {
1925     variable NamespaceCurrent
1926     variable configData
1927    
1928     if {([info exists ${NamespaceCurrent}::${module}::dataOptions]) && \
1929     ([createDir $configData(datapath)])} then {
1930     foreach {name data} [array get ${NamespaceCurrent}::${module}::dataOptions] {
1931     foreach {type file desc} $data {break}
1932     if {([info exists type]) && ([info exists file]) && \
1933     ([info exists desc])} then {
1934     if {[set result [backupFile [file join $configData(datapath) $file] $verbose]]} then {
1935     if {($result >= 1) && ($verbose >= 1)} then {
1936     wpLog o * $NamespaceCurrent "Backing up $desc data file..."
1937 guppy 1.1 }
1938 tothwolf 1.9 } elseif {$verbose >= 0} then {
1939     wpLog o * $NamespaceCurrent "Error backing up $desc data file!"
1940 guppy 1.1 }
1941     }
1942     }
1943     }
1944     return
1945     }
1946    
1947     ##
1948 tothwolf 1.9 ## Handle data for a list of modules
1949 guppy 1.1 ##
1950 tothwolf 1.9 ## Args: action {load|save|backup}, module list, force {0,1},
1951     ## verbose {-1,0,1}
1952 guppy 1.1 ## Returns: nothing
1953     ##
1954 tothwolf 1.9 proc moduleData {action modules {force 0} {verbose 0}} {
1955 guppy 1.1 if {![string compare * $modules]} then {
1956     set modules [listModules 1]
1957     }
1958 tothwolf 1.9 switch -exact -- $action {
1959     save {
1960     foreach module $modules {
1961     if {([moduleExists $module]) && ([moduleLoaded $module])} then {
1962     moduleDataSave $module $force $verbose
1963     }
1964     }
1965     }
1966     load {
1967     foreach module $modules {
1968     if {([moduleExists $module]) && ([moduleLoaded $module])} then {
1969     moduleDataLoad $module $force $verbose
1970     }
1971     }
1972     }
1973     backup {
1974     foreach module $modules {
1975     if {([moduleExists $module]) && ([moduleLoaded $module])} then {
1976     moduleDataBackup $module $force $verbose
1977     }
1978     }
1979 guppy 1.1 }
1980     }
1981     return
1982     }
1983    
1984     ##
1985     ## Builds command matching table from module database
1986     ##
1987     ## Args: none
1988     ## Returns: nothing
1989     ##
1990     proc buildCommandTable {{verbose 0}} {
1991     variable NamespaceCurrent
1992     variable ExportList
1993     variable commandTable
1994    
1995     foreach command $ExportList {
1996     if {![info exists tmp($command)]} then {
1997     if {$verbose >= 2} then {
1998     wpLog o * "Adding command: `$command' as `${NamespaceCurrent}::$command'"
1999     }
2000     set tmp($command) ${NamespaceCurrent}::$command
2001     } elseif {$verbose >= 0} then {
2002     wpLog o * "Warning: ignoring duplicate command `$command', conflicts with `$tmp($command)'"
2003     }
2004     }
2005     foreach module [listModules] {
2006     if {[string compare "" [set provides [getModuleDatabaseData $module provides]]]} then {
2007     foreach command $provides {
2008     if {![info exists tmp($command)]} then {
2009     if {$verbose >= 2} then {
2010     wpLog o * "Adding command: `$command' as `${NamespaceCurrent}::${module}::$command'"
2011     }
2012     set tmp($command) ${NamespaceCurrent}::${module}::$command
2013     } elseif {$verbose >= 0} then {
2014     wpLog o * "Warning: ignoring duplicate command `$command', conflicts with `$tmp($command)'"
2015     }
2016     }
2017     }
2018     }
2019     if {[info exists commandTable]} then {
2020     unset commandTable
2021     }
2022     array set commandTable [array get tmp]
2023     return
2024     }
2025    
2026     ##
2027     ## Return full namespace path for the given command
2028     ##
2029     ## Args: command
2030     ## Returns: full namespace path for the given command if it exists
2031     ## nothing otherwise
2032     ##
2033     proc whichCommand {command} {
2034     variable commandTable
2035    
2036     if {[info exists commandTable($command)]} then {
2037     return $commandTable($command)
2038     }
2039     return
2040     }
2041    
2042     ##
2043     ## Return full namespace path for the given module
2044     ##
2045     ## Args: module
2046     ## Returns: full namespace path for the given module if it's loaded
2047     ## nothing otherwise
2048     ##
2049     proc whichModule {module} {
2050     variable NamespaceCurrent
2051    
2052     if {![string compare $module [namespace tail $NamespaceCurrent] $module]} then {
2053     return $NamespaceCurrent
2054     } elseif {[moduleLoaded $module]} then {
2055     return ${NamespaceCurrent}::$module
2056     }
2057     return
2058     }
2059    
2060     ##
2061     ## Return module name that provides the given command
2062     ##
2063     ## Args: command
2064     ## Returns: name of module that provides the given command
2065     ## nothing otherwise
2066     ##
2067     proc whichModuleCommand {command} {
2068     variable NamespaceCurrent
2069     variable commandTable
2070    
2071     if {[info exists commandTable($command)]} then {
2072     if {![string compare ${NamespaceCurrent}::$command \
2073     $commandTable($command)]} then {
2074     return [namespace tail $NamespaceCurrent]
2075     }
2076     return [namespace tail [namespace qualifiers $commandTable($command)]]
2077     }
2078     return
2079     }
2080    
2081     ##
2082 tothwolf 1.30 ## Check if the given [module] config option exists
2083     ##
2084     ## Args: module, option
2085     ## Returns: 1 if the given module config option exists
2086     ##
2087     proc configExists {module {option ""}} {
2088     variable NamespaceCurrent
2089     variable configData
2090    
2091     if {[string compare "" $module]} then {
2092     set where "${NamespaceCurrent}::${module}::"
2093     } else {
2094     set where ""
2095     }
2096     if {[string compare "" $option]} then {
2097     if {[info exists ${where}configData($option)]} then {
2098     return 1
2099     }
2100     } elseif {[info exists ${where}configData]} then {
2101     return 1
2102     }
2103     return 0
2104     }
2105    
2106     ##
2107 guppy 1.1 ## Compare the given version to eggdrop's version
2108     ##
2109     ## Args: version
2110     ## Returns: 0 if eggdrop's version is older then the given version
2111     ## 1 if eggdrop's version matches the given version
2112     ## 2 if eggdrop's version is newer then the given version
2113 tothwolf 1.33 ## -1 if the given version is invalid
2114 guppy 1.1 ##
2115     proc compareVersion {version} {
2116     global numversion
2117    
2118 tothwolf 1.33 if {([string compare "" $version]) && \
2119     ([info exists numversion])} then {
2120     if {[regexp -- \\. $version]} then {
2121     regsub -all -- \\. $version 0 version
2122     set version ${version}00
2123     }
2124     if {[regexp -- \[^0-9\] $version]} then {
2125     return -1
2126     } elseif {$numversion == $version} then {
2127     return 1
2128     } elseif {$numversion > $version} then {
2129     return 2
2130 guppy 1.1 }
2131     }
2132     return 0
2133     }
2134    
2135     ##
2136     ## Log module information
2137     ##
2138     ## Args: level, channel, args ({<namespace>} {<text>} | {<text>})
2139     ## Returns: nothing
2140     ##
2141     proc wpLog {level channel args} {
2142     if {[llength $args] == 2} then {
2143     if {[string compare wp [set namespace [namespace tail [lindex $args 0]]]]} then {
2144     putloglev $level $channel "Wolfpack: \[$namespace\] [lindex $args 1]"
2145     } else {
2146     putloglev $level $channel "Wolfpack: [lindex $args 1]"
2147     }
2148     } else {
2149     putloglev $level $channel "Wolfpack: [join $args]"
2150     }
2151     return
2152     }
2153    
2154     ##
2155     ## Evaluate command line arguments
2156     ##
2157     ## Args: none
2158     ## Returns: nothing
2159     ##
2160     proc EvalArgs {argc argv argv0} {
2161     variable NamespaceCurrent
2162     variable optionData
2163    
2164     for {set index 0} {$index < $argc} {incr index} {
2165     set option [lindex $argv $index]
2166 tothwolf 1.35 set nextoption [lindex $argv [expr $index + 1]]
2167    
2168 guppy 1.1 switch -regexp -- $option {
2169 tothwolf 1.35 (^--$) {
2170     break
2171     }
2172     (^--cfgfile$) {
2173     if {([string compare "" $nextoption]) && \
2174     (![regexp -- - $nextoption])} then {
2175     set optionData(cfgfile) $nextoption
2176     incr index
2177     } else {
2178     listAppendIf noparms "--cfgfile"
2179     }
2180     }
2181 guppy 1.1 (^--config$) {
2182     set optionData(config) 1
2183     }
2184 tothwolf 1.35 (^--update$) {
2185     set optionData(update) 1
2186     }
2187     (^--noupdate$) {
2188     set optionData(noupdate) 1
2189     }
2190 guppy 1.1 (^--rebuild$) {
2191     set optionData(rebuild) 1
2192     }
2193     (^--time$) {
2194     set optionData(time) 1
2195     }
2196 tothwolf 1.35 (^--include$) {
2197     if {([string compare "" $nextoption]) && \
2198     (![regexp -- - $nextoption])} then {
2199 tothwolf 1.36 listAppendIf optionData(include) $nextoption
2200 tothwolf 1.35 incr index
2201     } else {
2202     listAppendIf noparms "--include"
2203     }
2204     }
2205     (^--exclude$) {
2206     if {([string compare "" $nextoption]) && \
2207     (![regexp -- - $nextoption])} then {
2208 tothwolf 1.36 listAppendIf optionData(exclude) $nextoption
2209 tothwolf 1.35 incr index
2210     } else {
2211     listAppendIf noparms "--exclude"
2212     }
2213     }
2214     (^--module$) {
2215     if {([string compare "" $nextoption]) && \
2216     (![regexp -- - $nextoption])} then {
2217 tothwolf 1.36 listAppendIf optionData(module) $nextoption
2218 tothwolf 1.35 incr index
2219     } else {
2220     listAppendIf noparms "--module"
2221     }
2222     }
2223 guppy 1.1 (^--verbose$) {
2224     incr optionData(verbose)
2225     }
2226     (^--quiet$) {
2227     incr optionData(quiet) -1
2228     }
2229     (^--debug$) {
2230     set optionData(debug) 1
2231     }
2232     (^--help$) {
2233     ShowUsage $argv0
2234     exit
2235     }
2236     (^--version$) {
2237     puts "[file tail $argv0] version [package require ${NamespaceCurrent}]"
2238     exit
2239     }
2240     (^-\[^-\]*$) {
2241     set suboptions [split $option ""]
2242     set sublength [llength [split $suboptions]]
2243     for {set subindex 0} {$subindex < $sublength} {incr subindex} {
2244     set suboption [lindex $suboptions $subindex]
2245     switch -exact -- $suboption {
2246     - {
2247     continue
2248     }
2249 tothwolf 1.35 f {
2250     # Next arg in argv should be a filename: '-f filename.conf',
2251     # so break out of the suboption loop after this option
2252     if {([string compare "" $nextoption]) && \
2253     (![regexp -- - $nextoption])} then {
2254