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

Contents of /wolfpack/wolfpack.tcl

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


Revision 1.7 - (show annotations) (download) (as text)
Sun Jan 27 19:21:00 2002 UTC (17 years, 8 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 #! /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 ## Copyright (C) 1998-2002 Tothwolf <tothwolf@concentric.net>
41 ##
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 ## Use '.wpconf' in dcc chat with the bot to configure everything else.
64 ##
65 ###############################################################################
66 ##
67 ## $Id: wolfpack.tcl,v 1.6 2001/06/04 04:52:40 tothwolf Exp $
68 ##
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 # HACK: quick fix for buggy tcl variables in older bots
87 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 set IconfigDefaults(cfgfile) wolfpack.conf
165
166 # Interactive configuration prompt
167 set IconfigDefaults(prompt) "wolfpack> "
168
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 splitList
224 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 ## Returns: 1 if successful
497 ## -1 if file is 0 in size
498 ## 0 otherwise
499 ##
500 proc backupFile {file {verbose 0} {suffix ~bak}} {
501 variable NamespaceCurrent
502
503 if {[string compare "" $suffix]} then {
504 if {[file size $file]} then {
505 if {[catch {
506 file copy -force $file $file${suffix}
507 } result]} then {
508 if {$verbose >= 0} then {
509 wpLog o * $NamespaceCurrent "Error: unable to create backup file for `[file tail $file]': $result"
510 }
511 } else {
512 return 1
513 }
514 } else {
515 return -1
516 }
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 ## 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 ## 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 ## Create a data format list for a given data format and options
848 ##
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 if {(![info exists $option]) || \
953 (![string compare "" [set $option]])} then {
954 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 variable moduleDatabaseDataChanged
1019
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 set ret [arraySave moduleDatabaseData $configData(moddbfile) $verbose "module database file " a]
1029 if {$ret} then {
1030 set moduleDatabaseDataChanged 0
1031 }
1032 return $ret
1033 }
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 variable moduleDatabaseDataChanged
1051
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 set moduleDatabaseDataChanged 0
1079 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 ## 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 ## 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 if {[string compare "" [info commands ${NamespaceCurrent}::${module}::ModuleInit]]} then {
1352 ${NamespaceCurrent}::${module}::ModuleInit
1353 }
1354 # FIXME: check for bindings? duplicates?
1355 moduleBind $module
1356 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 if {[string compare "" [info commands ${NamespaceCurrent}::${module}::ModuleDestroy]]} then {
1390 ${NamespaceCurrent}::${module}::ModuleDestroy
1391 }
1392 # FIXME: check for bindings?
1393 moduleUnbind $module
1394 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 if {[set result [backupFile [file join $configData(datapath) $file] $verbose]]} then {
1571 if {($result >= 1) && ($verbose >= 1)} then {
1572 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 variable IconfigDefaults
1885
1886 fileevent stdin readable ${NamespaceCurrent}::IconfigReadStdin
1887 puts "Entering wolfpack configuration system..."
1888 puts "Type 'help' for help."
1889 puts -nonewline $IconfigDefaults(prompt)
1890 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 variable IconfigDefaults
1902 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 puts -nonewline $IconfigDefaults(prompt)
1937 flush stdout
1938 } else {
1939 # Save configuration data
1940 arraySave configData $IconfigDefaults(cfgfile) 0 "configuration file "
1941 # 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 puts "$module"
2055 foreach line [splitList [getModuleDatabaseData $module description] 65 " " " "] {
2056 puts " $line"
2057 }
2058 }
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 wpLog o * "Error: can't find a usable md5 command!"
2121 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 arrayLoad configData $IconfigDefaults(cfgfile) 0 "configuration file "
2140
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 arraySave configData $IconfigDefaults(cfgfile) 0 "configuration file "
2160 }
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
2315 # Build command table
2316 if {(![info exists argv0]) || ($optionData(debug))} then {
2317 if {$Verbose >= 0} then {
2318 wpLog o * "Building command table..."
2319 }
2320 if {$TimeOk} then {
2321 set CommandTime [time {buildCommandTable $Verbose}]
2322 } else {
2323 buildCommandTable $Verbose
2324 }
2325 if {$Verbose >= 0} then {
2326 if {[info exists CommandTime]} then {
2327 wpLog o * "Done. ([format "%.3f" [expr [lindex $CommandTime 0] / 1000000.0]] seconds elapsed)"
2328 } else {
2329 wpLog o * "Done."
2330 }
2331 }
2332
2333 set loadList ""
2334
2335 # Load debug module first if not in eggdrop mode
2336 if {([info exists argv0]) && ([moduleExists debug])} then {
2337 lappend loadList debug
2338 }
2339
2340 # Load other modules next, moduleLoad will preload additional modules
2341 foreach name [lsort [array names moduleDatabaseData]] {
2342 if {[getModuleDatabaseData $name load] == 1} then {
2343 lappend loadList $name
2344 }
2345 }
2346
2347 wpLog o * "Loading modules..."
2348
2349 # Load modules
2350 if {$TimeOk} then {
2351 set LoadTime [time {
2352 foreach module $loadList {
2353 if {[catch {moduleLoad $module $Verbose} result]} then {
2354 wpLog o * "Error: unable to load module `$module': $result"
2355 }
2356 }
2357 }]
2358 } else {
2359 foreach module $loadList {
2360 if {[catch {moduleLoad $module $Verbose} result]} then {
2361 wpLog o * "Error: unable to load module `$module': $result"
2362 }
2363 }
2364 }
2365
2366 if {[info exists LoadTime]} then {
2367 wpLog o * "Done. ([format "%.3f" [expr [lindex $LoadTime 0] / 1000000.0]] seconds elapsed)"
2368 } else {
2369 wpLog o * "Done."
2370 }
2371
2372 set ModuleLoadCount [llength [split $moduleLoadedList]]
2373 set ModuleTotalCount [llength [array names moduleDatabaseData]]
2374 if {$ModuleLoadCount} then {
2375 wpLog o * "Modules loaded ($ModuleLoadCount/$ModuleTotalCount): $moduleLoadedList"
2376 } else {
2377 wpLog o * "No modules loaded."
2378 }
2379
2380 # Unload modules if started in debug mode
2381 if {$optionData(debug)} then {
2382
2383 # FIXME: code module dependency stuff first
2384 # wpLog o * "Unloading modules..."
2385
2386 # Unload all modules except debug
2387 # foreach module $moduleLoadedList {
2388 # if {[string compare $module debug]} then {
2389 # if {[catch {moduleUnload $module $Verbose} result]} then {
2390 # wpLog o * "Error: unable to unload module `$module': $result"
2391 # }
2392 # }
2393 # }
2394
2395 # Unload debug module last to make it display stats
2396 if {[moduleLoaded debug]} then {
2397 if {[catch {moduleUnload debug} result]} then {
2398 wpLog o * "Error: unable to unload module `debug': $result"
2399 }
2400 }
2401 # wpLog o * "Done."
2402 }
2403 }
2404
2405 } ;# namespace ::wp
2406
2407 return

webmaster@eggheads.org
ViewVC Help
Powered by ViewVC 1.1.23