/[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.7 - (hide annotations) (download) (as text)
Sun Jan 27 19:21:00 2002 UTC (17 years, 4 months ago) by tothwolf
Branch: MAIN
Changes since 1.6: +69 -29 lines
File MIME type: application/x-tcl
* global bind/unbind support, bind tables gone
* ModuleInit/ModuleDestroy for each module

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