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