/[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.6 - (show annotations) (download) (as text)
Mon Jun 4 04:52:40 2001 UTC (18 years ago) by tothwolf
Branch: MAIN
Changes since 1.5: +9 -9 lines
File MIME type: application/x-tcl
*** empty log message ***

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-2001 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 set everything else.
64 ##
65 ###############################################################################
66 ##
67 ## $Id: wolfpack.tcl,v 1.5 2001/06/04 04:47:17 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 # quick hack 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 configDefaults(cfgfile) wolfpack.conf
165
166 # Interactive configuration prompt
167 set configDefaults(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 ## Load a module
1243 ##
1244 ## Args: module name, verbose {-1,0,1}, args {loop detection}
1245 ## Returns: nothing
1246 ## Errors: if unable to load module
1247 ##
1248 proc moduleLoad {module {verbose 0} args} {
1249 variable NamespaceCurrent
1250 variable moduleLoadedList
1251
1252 if {[lsearch -exact [set loop [lindex $args 0]] $module] == -1} then {
1253 if {[moduleExists $module]} then {
1254 set preload ""
1255 set requires [getModuleDatabaseData $module requires]
1256 foreach required $requires {
1257 set preloadModule [whichModuleCommand $required]
1258 if {[string compare "" $preloadModule]} then {
1259 if {([lsearch -exact $preload $preloadModule] == -1) && \
1260 ([string compare wp $preloadModule]) && \
1261 (![moduleLoaded $preloadModule])} then {
1262 lappend preload $preloadModule
1263 }
1264 } else {
1265 error "required command `$required' not found."
1266 }
1267 }
1268 if {[string compare "" $preload]} then {
1269 foreach premod $preload {
1270 if {[catch {moduleLoad $premod $verbose [concat $loop $module]} result]} then {
1271 error $result
1272 }
1273 }
1274 }
1275 if {[catch {source [getModuleDatabaseData $module file]} result]} then {
1276 error $result
1277 } else {
1278 package forget $module
1279 package provide ${NamespaceCurrent}::${module} [getModuleDatabaseData $module version]
1280 moduleConfig load $module 1
1281 moduleConfig checkdefs $module 1
1282 moduleData load $module 1
1283 # Imported commands '# requires: ...'
1284 if {[string compare "" $requires]} then {
1285 set Eval "namespace eval ${NamespaceCurrent}::${module} \{\n namespace forget *\n namespace import"
1286 foreach required $requires {
1287 if {[string compare "" [set command [whichCommand $required]]]} then {
1288 append Eval " $command"
1289 }
1290 }
1291 append Eval "\n\}"
1292 eval $Eval
1293 }
1294 # Exported commands '# provides: ...'
1295 if {[string compare "" [set provides [getModuleDatabaseData $module provides]]]} then {
1296 set Eval "namespace eval ${NamespaceCurrent}::${module} \{\n namespace export"
1297 foreach provided $provides {
1298 append Eval " $provided"
1299 }
1300 append Eval "\n\}"
1301 eval $Eval
1302 }
1303 if {[string compare "" [info commands ${NamespaceCurrent}::${module}::InitTable]]} then {
1304 ${NamespaceCurrent}::${module}::InitTable load
1305 }
1306 if {[string compare "" [info commands ${NamespaceCurrent}::${module}::TraceTable]]} then {
1307 ${NamespaceCurrent}::${module}::TraceTable variable
1308 }
1309 if {[string compare "" [info commands ${NamespaceCurrent}::${module}::BindTable]]} then {
1310 ${NamespaceCurrent}::${module}::BindTable bind *
1311 }
1312 if {![getModuleDatabaseData $module load]} then {
1313 setModuleDatabaseData $module load 1
1314 }
1315 if {[lsearch -exact $moduleLoadedList $module] == -1} then {
1316 lappend moduleLoadedList $module
1317 if {$verbose >= 1} then {
1318 wpLog o * "Module loaded: $module"
1319 }
1320 }
1321 }
1322 } else {
1323 error "No such module: $module"
1324 }
1325 } else {
1326 regsub -all -- " " $loop " -> " loop
1327 error "Preload endless loop: $loop -> $module"
1328 }
1329 return
1330 }
1331
1332 ##
1333 ## Unload a module
1334 ##
1335 ## Args: module name, verbose {-1,0,1}
1336 ## Returns: nothing
1337 ## Errors: if unable to completely unload module
1338 ##
1339 proc moduleUnload {module {verbose 0}} {
1340 variable NamespaceCurrent
1341 variable moduleLoadedList
1342
1343 # FIXME: handle dependant modules and modules that can't be unloaded
1344 if {[moduleExists $module]} then {
1345 if {[string compare "" [info commands ${NamespaceCurrent}::${module}::InitTable]]} then {
1346 ${NamespaceCurrent}::${module}::InitTable unload
1347 }
1348 if {[string compare "" [info commands ${NamespaceCurrent}::${module}::BindTable]]} then {
1349 ${NamespaceCurrent}::${module}::BindTable unbind *
1350 }
1351 if {[string compare "" [info commands ${NamespaceCurrent}::${module}::TraceTable]]} then {
1352 ${NamespaceCurrent}::${module}::TraceTable vdelete
1353 }
1354 moduleConfig save $module 1
1355 moduleData save $module 1
1356 if {[catch {namespace delete ${NamespaceCurrent}::${module}} result]} then {
1357 error $result
1358 } else {
1359 package forget ${NamespaceCurrent}::${module}
1360 if {[getModuleDatabaseData $module load] == 1} then {
1361 setModuleDatabaseData $module load 0
1362 }
1363 set index [lsearch -exact $moduleLoadedList $module]
1364 if {$index != -1} then {
1365 set moduleLoadedList [lreplace $moduleLoadedList $index $index]
1366 if {$verbose >= 1} then {
1367 wpLog o * "Module unloaded: $module"
1368 }
1369 }
1370 }
1371 } else {
1372 error "No such module: $module"
1373 }
1374 return
1375 }
1376
1377 ##
1378 ## Load / save module config data for a module
1379 ##
1380 ## Args: action {load|save|checkdefs}, module, force {0,1},
1381 ## verbose {-1,0,1}
1382 ## Returns: 1 if successful,
1383 ## 0 otherwise
1384 ##
1385 proc moduleConfig {action module {force 0} {verbose 0}} {
1386 variable NamespaceCurrent
1387 variable configData
1388
1389 if {([string compare "" \
1390 [set file [getModuleDatabaseData $module config]]]) && \
1391 ([createDir $configData(configpath)])} then {
1392 set cfgfile [file join $configData(configpath) $file]
1393 switch -exact -- $action {
1394 save {
1395 if {([getModuleDatabaseData $module load]) && \
1396 (($force) || \
1397 (![info exists ${NamespaceCurrent}::${module}::configDataChanged]) || \
1398 ([set ${NamespaceCurrent}::${module}::configDataChanged]))} then {
1399 if {[arraySave ${NamespaceCurrent}::${module}::configData $cfgfile 0 "$module configuration file "]} then {
1400 if {$verbose >= 1} then {
1401 wpLog o * "Writing $module config file..."
1402 }
1403 set ${NamespaceCurrent}::${module}::configDataChanged 0
1404 return 1
1405 } elseif {$verbose >= 0} then {
1406 wpLog o * "Error writing $module config file."
1407 }
1408 }
1409 }
1410 load {
1411 if {($force) || \
1412 (![info exists ${NamespaceCurrent}::${module}::configDataChanged]) || \
1413 (![set ${NamespaceCurrent}::${module}::configDataChanged])} then {
1414 if {[arrayLoad ${NamespaceCurrent}::${module}::configData $cfgfile 0 "$module configuration file "]} then {
1415 if {$verbose >= 1} then {
1416 wpLog o * "Loading $module config file..."
1417 }
1418 set ${NamespaceCurrent}::${module}::configDataChanged 0
1419 return 1
1420 } elseif {$verbose >= 0} then {
1421 wpLog o * "Error loading $module config file."
1422 }
1423 }
1424 }
1425 checkdefs {
1426 if {[array exists ${NamespaceCurrent}::${module}::configDataDefaults]} then {
1427 set Changed 0
1428 # Unset unknown variables
1429 foreach name [array names ${NamespaceCurrent}::${module}::configData] {
1430 if {![info exists ${NamespaceCurrent}::${module}::configDataDefaults($name)]} then {
1431 unset ${NamespaceCurrent}::${module}::configData($name)
1432 set Changed 1
1433 }
1434 }
1435 # Set missing variables to defaults
1436 foreach {name data} [array get ${NamespaceCurrent}::${module}::configDataDefaults] {
1437 if {![info exists ${NamespaceCurrent}::${module}::configData($name)]} then {
1438 set ${NamespaceCurrent}::${module}::configData($name) $data
1439 set Changed 1
1440 }
1441 }
1442 if {$Changed} then {
1443 set ${NamespaceCurrent}::${module}::configDataChanged 1
1444 }
1445 return 1
1446 }
1447 }
1448 }
1449 }
1450 return 0
1451 }
1452
1453 ##
1454 ## Load / save module config data for a list of modules
1455 ##
1456 ## Args: action {load|save}, module list, force {0,1}, verbose {-1,0,1}
1457 ## Returns: nothing
1458 ##
1459 proc moduleConfigList {action modules {force 0} {verbose 0}} {
1460 variable moduleDatabaseData
1461
1462 if {![string compare * $modules]} then {
1463 set modules [listModules 1]
1464 }
1465 foreach module $modules {
1466 if {([moduleExists $module]) && ([moduleLoaded $module])} then {
1467 moduleConfig $action $module $force $verbose
1468 }
1469 }
1470 return
1471 }
1472
1473 ##
1474 ## Load / save module data for a module
1475 ##
1476 ## Args: action {load|save|backup}, module, force {0,1},
1477 ## verbose {-1,0,1}
1478 ## Returns: nothing
1479 ##
1480 proc moduleData {action module {force 0} {verbose 0}} {
1481 variable NamespaceCurrent
1482 variable configData
1483
1484 if {([info exists ${NamespaceCurrent}::${module}::dataOptions]) && \
1485 ([createDir $configData(datapath)])} then {
1486 switch -exact -- $action {
1487 save {
1488 foreach {name data} [array get ${NamespaceCurrent}::${module}::dataOptions] {
1489 foreach {type file desc} $data {break}
1490 if {([info exists type]) && ([info exists file]) && \
1491 ([info exists desc])} then {
1492 set Changed ${NamespaceCurrent}::${module}::${name}Changed
1493 if {($force) || ((![info exists $Changed]) || ([set $Changed]))} then {
1494 if {[${type}Save ${NamespaceCurrent}::${module}::$name [file join $configData(datapath) $file]]} then {
1495 if {$verbose >= 1} then {
1496 wpLog o * $NamespaceCurrent "Writing $desc data file..."
1497 }
1498 set $Changed 0
1499 } elseif {$verbose >= 0} then {
1500 wpLog o * $NamespaceCurrent "Error writing $desc data file!"
1501 }
1502 }
1503 }
1504 }
1505 }
1506 load {
1507 foreach {name data} [array get ${NamespaceCurrent}::${module}::dataOptions] {
1508 foreach {type file desc} $data {break}
1509 if {([info exists type]) && ([info exists file]) && \
1510 ([info exists desc])} then {
1511 set Changed ${NamespaceCurrent}::${module}::${name}Changed
1512 if {($force) || ((![info exists $Changed]) || ([set $Changed]))} then {
1513 if {[${type}Load ${NamespaceCurrent}::${module}::$name [file join $configData(datapath) $file]]} then {
1514 if {$verbose >= 1} then {
1515 wpLog o * $NamespaceCurrent "Reloading $desc data file..."
1516 }
1517 set $Changed 0
1518 } elseif {$verbose >= 0} then {
1519 wpLog o * $NamespaceCurrent "Error reloading $desc data file!"
1520 }
1521 }
1522 }
1523 }
1524 }
1525 backup {
1526 foreach {name data} [array get ${NamespaceCurrent}::${module}::dataOptions] {
1527 foreach {type file desc} $data {break}
1528 if {([info exists type]) && ([info exists file]) && \
1529 ([info exists desc])} then {
1530 if {[set result [backupFile [file join $configData(datapath) $file] $verbose]]} then {
1531 if {($result >= 1) && ($verbose >= 1)} then {
1532 wpLog o * $NamespaceCurrent "Backing up $desc data file..."
1533 }
1534 } elseif {$verbose >= 0} then {
1535 wpLog o * $NamespaceCurrent "Error backing up $desc data file!"
1536 }
1537 }
1538 }
1539 }
1540 }
1541 }
1542 return
1543 }
1544
1545 ##
1546 ## Load / save module data for a list of modules
1547 ##
1548 ## Args: action {load|save}, module list, force {0,1}, verbose {-1,0,1}
1549 ## Returns: nothing
1550 ##
1551 proc moduleDataList {action modules {force 0} {verbose 0}} {
1552 variable moduleDatabaseData
1553
1554 if {![string compare * $modules]} then {
1555 set modules [listModules 1]
1556 }
1557 foreach module $modules {
1558 if {([moduleExists $module]) && ([moduleLoaded $module])} then {
1559 moduleData $action $module $force $verbose
1560 }
1561 }
1562 return
1563 }
1564
1565 ##
1566 ## Builds command matching table from module database
1567 ##
1568 ## Args: none
1569 ## Returns: nothing
1570 ##
1571 proc buildCommandTable {{verbose 0}} {
1572 variable NamespaceCurrent
1573 variable ExportList
1574 variable commandTable
1575
1576 foreach command $ExportList {
1577 if {![info exists tmp($command)]} then {
1578 if {$verbose >= 2} then {
1579 wpLog o * "Adding command: `$command' as `${NamespaceCurrent}::$command'"
1580 }
1581 set tmp($command) ${NamespaceCurrent}::$command
1582 } elseif {$verbose >= 0} then {
1583 wpLog o * "Warning: ignoring duplicate command `$command', conflicts with `$tmp($command)'"
1584 }
1585 }
1586 foreach module [listModules] {
1587 if {[string compare "" [set provides [getModuleDatabaseData $module provides]]]} then {
1588 foreach command $provides {
1589 if {![info exists tmp($command)]} then {
1590 if {$verbose >= 2} then {
1591 wpLog o * "Adding command: `$command' as `${NamespaceCurrent}::${module}::$command'"
1592 }
1593 set tmp($command) ${NamespaceCurrent}::${module}::$command
1594 } elseif {$verbose >= 0} then {
1595 wpLog o * "Warning: ignoring duplicate command `$command', conflicts with `$tmp($command)'"
1596 }
1597 }
1598 }
1599 }
1600 if {[info exists commandTable]} then {
1601 unset commandTable
1602 }
1603 array set commandTable [array get tmp]
1604 return
1605 }
1606
1607 ##
1608 ## Return full namespace path for the given command
1609 ##
1610 ## Args: command
1611 ## Returns: full namespace path for the given command if it exists
1612 ## nothing otherwise
1613 ##
1614 proc whichCommand {command} {
1615 variable commandTable
1616
1617 if {[info exists commandTable($command)]} then {
1618 return $commandTable($command)
1619 }
1620 return
1621 }
1622
1623 ##
1624 ## Return full namespace path for the given module
1625 ##
1626 ## Args: module
1627 ## Returns: full namespace path for the given module if it's loaded
1628 ## nothing otherwise
1629 ##
1630 proc whichModule {module} {
1631 variable NamespaceCurrent
1632
1633 if {![string compare $module [namespace tail $NamespaceCurrent] $module]} then {
1634 return $NamespaceCurrent
1635 } elseif {[moduleLoaded $module]} then {
1636 return ${NamespaceCurrent}::$module
1637 }
1638 return
1639 }
1640
1641 ##
1642 ## Return module name that provides the given command
1643 ##
1644 ## Args: command
1645 ## Returns: name of module that provides the given command
1646 ## nothing otherwise
1647 ##
1648 proc whichModuleCommand {command} {
1649 variable NamespaceCurrent
1650 variable commandTable
1651
1652 if {[info exists commandTable($command)]} then {
1653 if {![string compare ${NamespaceCurrent}::$command \
1654 $commandTable($command)]} then {
1655 return [namespace tail $NamespaceCurrent]
1656 }
1657 return [namespace tail [namespace qualifiers $commandTable($command)]]
1658 }
1659 return
1660 }
1661
1662 ##
1663 ## Compare the given version to eggdrop's version
1664 ##
1665 ## Args: version
1666 ## Returns: 0 if eggdrop's version is older then the given version
1667 ## 1 if eggdrop's version matches the given version
1668 ## 2 if eggdrop's version is newer then the given version
1669 ##
1670 proc compareVersion {version} {
1671 global numversion
1672
1673 if {[string compare "" $version]} then {
1674 if {([info exists numversion]) || \
1675 (![catch {set numversion}]) || \
1676 ([info exists numversion])} then {
1677 if {[regexp -- \\. $version]} then {
1678 regsub -all -- \\. $version 0 version
1679 set version ${version}00
1680 }
1681 if {![regexp -- \[^0-9\] $version]} then {
1682 if {$numversion > $version} then {
1683 return 2
1684 } elseif {$numversion == $version} then {
1685 return 1
1686 }
1687 }
1688 }
1689 }
1690 return 0
1691 }
1692
1693 ##
1694 ## Log module information
1695 ##
1696 ## Args: level, channel, args ({<namespace>} {<text>} | {<text>})
1697 ## Returns: nothing
1698 ##
1699 proc wpLog {level channel args} {
1700 if {[llength $args] == 2} then {
1701 if {[string compare wp [set namespace [namespace tail [lindex $args 0]]]]} then {
1702 putloglev $level $channel "Wolfpack: \[$namespace\] [lindex $args 1]"
1703 } else {
1704 putloglev $level $channel "Wolfpack: [lindex $args 1]"
1705 }
1706 } else {
1707 putloglev $level $channel "Wolfpack: [join $args]"
1708 }
1709 return
1710 }
1711
1712 ##
1713 ## Evaluate command line arguments
1714 ##
1715 ## Args: none
1716 ## Returns: nothing
1717 ##
1718 proc EvalArgs {argc argv argv0} {
1719 variable NamespaceCurrent
1720 variable optionData
1721
1722 # Make sure defaults are sane
1723 arraySetAll optionData 0
1724 for {set index 0} {$index < $argc} {incr index} {
1725 set option [lindex $argv $index]
1726 switch -regexp -- $option {
1727 (^--config$) {
1728 set optionData(config) 1
1729 }
1730 (^--rebuild$) {
1731 set optionData(rebuild) 1
1732 }
1733 (^--norebuild$) {
1734 set optionData(norebuild) 1
1735 }
1736 (^--time$) {
1737 set optionData(time) 1
1738 }
1739 (^--verbose$) {
1740 incr optionData(verbose)
1741 }
1742 (^--quiet$) {
1743 incr optionData(quiet) -1
1744 }
1745 (^--debug$) {
1746 set optionData(debug) 1
1747 }
1748 (^--help$) {
1749 ShowUsage $argv0
1750 exit
1751 }
1752 (^--version$) {
1753 puts "[file tail $argv0] version [package require ${NamespaceCurrent}]"
1754 exit
1755 }
1756 (^-\[^-\]*$) {
1757 set suboptions [split $option ""]
1758 set sublength [llength [split $suboptions]]
1759 for {set subindex 0} {$subindex < $sublength} {incr subindex} {
1760 set suboption [lindex $suboptions $subindex]
1761 switch -exact -- $suboption {
1762 - {
1763 continue
1764 }
1765 c {
1766 set optionData(config) 1
1767 }
1768 r {
1769 set optionData(rebuild) 1
1770 }
1771 n {
1772 set optionData(norebuild) 1
1773 }
1774 t {
1775 set optionData(time) 1
1776 }
1777 v {
1778 incr optionData(verbose)
1779 }
1780 q {
1781 incr optionData(quiet) -1
1782 }
1783 d {
1784 set optionData(debug) 1
1785 }
1786 default {
1787 if {(![info exists invalidopt]) || \
1788 ($subindex == 1) || \
1789 ([lsearch -exact $invalidopt $option] == -1)} then {
1790 lappend invalidopt $option
1791 }
1792 }
1793 }
1794 }
1795 }
1796 default {
1797 lappend invalidopt $option
1798 }
1799 }
1800 }
1801
1802 # complain about invalid command line arguments
1803 if {[info exists invalidopt]} then {
1804 foreach option $invalidopt {
1805 puts stderr "[file tail $argv0]: unrecognized option `$option'"
1806 }
1807 exit 1
1808 }
1809 }
1810
1811 ##
1812 ## Show usage information
1813 ##
1814 ## Args: none
1815 ## Returns: nothing
1816 ##
1817 proc ShowUsage {argv0} {
1818 # FIXME: code missing options
1819 puts "Usage: [file tail $argv0] <options>"
1820 puts " Valid options:"
1821 puts " -c, --config start interactive configuration"
1822 #puts " -u, --update update module database"
1823 puts " -r, --rebuild force rebuild of module database"
1824 puts " -n, --norebuild don't rebuild module database even if it's outdated"
1825 puts " -t, --time time compare and rebuild of module database"
1826 #puts " -i, --include <mod> include `module' when building database"
1827 #puts " -e, --exclude <mod> exclude `module' when building database"
1828 #puts " -m, --module <mod> only update database for `module'"
1829 puts " -v, --verbose use more than once for more verbose operation"
1830 puts " -q, --quiet use more than once for quieter operation"
1831 puts " -d, --debug start in debug mode with tclsh"
1832 puts " --help show this help"
1833 puts " --version show version information"
1834 }
1835
1836 ##
1837 ## Enter interactive configuration
1838 ##
1839 ## Args: none
1840 ## Returns: nothing
1841 ##
1842 proc Iconfig {} {
1843 variable NamespaceCurrent
1844 variable configDefaults
1845
1846 fileevent stdin readable ${NamespaceCurrent}::IconfigReadStdin
1847 puts "Entering wolfpack configuration system..."
1848 puts "Type 'help' for help."
1849 puts -nonewline $configDefaults(prompt)
1850 flush stdout
1851 vwait forever
1852 }
1853
1854 ##
1855 ## Read stdin and process commands
1856 ##
1857 ## Args: none
1858 ## Returns: nothing
1859 ##
1860 proc IconfigReadStdin {} {
1861 variable configDefaults
1862 variable configData
1863
1864 set exit 0
1865 if {[eof stdin]} {
1866 set exit 1
1867 }
1868 set stdin [string trimright [gets stdin]]
1869 set data [join [lrange [split $stdin] 1 end]]
1870 if {[string compare "" $stdin]} then {
1871 switch -exact -- [lindex [split $stdin] 0] {
1872 set {
1873 IconfigSet $data
1874 }
1875 enable {
1876 IconfigEnable $data
1877 }
1878 disable {
1879 IconfigDisable $data
1880 }
1881 modules {
1882 IconfigModules $data
1883 }
1884 help {
1885 IconfigHelp $data
1886 }
1887 quit {
1888 set exit 1
1889 }
1890 default {
1891 puts "What? You need 'help'"
1892 }
1893 }
1894 }
1895 if {(!$exit) && (![eof stdin])} then {
1896 puts -nonewline $configDefaults(prompt)
1897 flush stdout
1898 } else {
1899 # Save configuration data
1900 arraySave configData $configDefaults(cfgfile) 0 "configuration file "
1901 # Save module database
1902 saveModuleDatabase
1903 puts ""
1904 flush stdout
1905 exit
1906 }
1907 return
1908 }
1909
1910 ##
1911 ## Set configuration settings
1912 ##
1913 ## Args: data
1914 ## Returns: nothing
1915 ##
1916 proc IconfigSet {data} {
1917 variable configData
1918 variable configDataDesc
1919
1920 if {![string compare "" $data]} then {
1921 set fmtlen1 [arrayMaxElementDataLength configDataDesc]
1922 if {$fmtlen1 < 13} then {
1923 set fmtlen1 13 ;# 'Description: '
1924 }
1925 set names [array names configData]
1926 set fmtlen2 [listMaxElementLength $names]
1927 if {$fmtlen2 < 8} then {
1928 set fmtlen2 8 ;# 'Option: '
1929 }
1930 puts ""
1931 puts "Current settings:"
1932 puts ""
1933 puts [format " %-${fmtlen1}s %-${fmtlen2}s %s" Description: Option: Value:]
1934 foreach option [lsort $names] {
1935 if {[info exists configDataDesc($option)]} then {
1936 puts [format " %-${fmtlen1}s %-${fmtlen2}s %s" $configDataDesc($option) $option $configData($option)]
1937 } else {
1938 puts [format " %-${fmtlen1}s %-${fmtlen2}s %s" "" $option $configData($option)]
1939 }
1940 }
1941 puts ""
1942 } else {
1943 set option [lindex [split $data] 0]
1944 if {![info exists configData($option)]} then {
1945 puts "Invalid option: $option"
1946 } else {
1947 set value [join [lrange [split $data] 1 end]]
1948 if {![string compare "" $value]} then {
1949 puts "Currently: $configData($option)"
1950 } else {
1951 set configData($option) $value
1952 puts "Set $option to: $value"
1953 }
1954 }
1955 }
1956 return
1957 }
1958
1959 ##
1960 ## Enable a module
1961 ##
1962 ## Args: data
1963 ## Returns: nothing
1964 ##
1965 proc IconfigEnable {data} {
1966 set module [lindex [split $data] 0]
1967 if {![string compare "" $module]} then {
1968 puts "Usage: enable <module>"
1969 } elseif {[moduleExists $module]} then {
1970 if {![getModuleDatabaseData $module load]} then {
1971 setModuleDatabaseData $module load 1
1972 puts "Enabled module: $module"
1973 } else {
1974 puts "Module `$module' is already enabled."
1975 }
1976 } else {
1977 puts "Invalid module: $module"
1978 }
1979 return
1980 }
1981
1982 ##
1983 ## Disable a module
1984 ##
1985 ## Args: data
1986 ## Returns: nothing
1987 ##
1988 proc IconfigDisable {data} {
1989 set module [lindex [split $data] 0]
1990 if {![string compare "" $module]} then {
1991 puts "Usage: disable <module>"
1992 } elseif {[moduleExists $module]} then {
1993 if {[getModuleDatabaseData $module load] == 1} then {
1994 setModuleDatabaseData $module load 0
1995 puts "Disabled module: $module"
1996 } else {
1997 puts "Module `$module' is already disabled."
1998 }
1999 } else {
2000 puts "Invalid module: $module"
2001 }
2002 return
2003 }
2004
2005 ##
2006 ## List modules
2007 ##
2008 ## Args: data
2009 ## returns: nothing
2010 ##
2011 proc IconfigModules {data} {
2012 puts "Modules avaliable:"
2013 foreach module [listModules] {
2014 puts "$module"
2015 foreach line [splitList [getModuleDatabaseData $module description] 65 " " " "] {
2016 puts " $line"
2017 }
2018 }
2019 return
2020 }
2021
2022 ##
2023 ## Show configuration help
2024 ##
2025 ## Args: data
2026 ## Returns: nothing
2027 ##
2028 proc IconfigHelp {data} {
2029 if {![string compare "" $data]} then {
2030 set data help
2031 }
2032 switch -exact -- $data {
2033 set {
2034 puts "### set \[option\] \[value\]"
2035 puts " Sets an option to what you specify."
2036 puts " Shows current setting for an option if no new value is given."
2037 puts " Shows current settings for all options if no option is given."
2038 }
2039 enable {
2040 puts "### enable <module>"
2041 puts " Enables the given module."
2042 }
2043 disable {
2044 puts "### disable <module>"
2045 puts " Disables the given module."
2046 }
2047 modules {
2048 puts "### modules"
2049 puts " Shows modules avaliable."
2050 }
2051 help {
2052 puts "### Avaliable commands:"
2053 puts " set \[option\] \[value\]"
2054 puts " enable <module>"
2055 puts " disable <module>"
2056 puts " modules"
2057 puts " help \[command\]"
2058 puts " quit"
2059 puts "You can get help on individual commands: 'help <command>'"
2060 }
2061 quit {
2062 puts "### quit"
2063 puts " Quits interactive configuration."
2064 }
2065 default {
2066 puts "No help available on that."
2067 }
2068 }
2069 return
2070 }
2071
2072 ##
2073 ## Inline startup and init code
2074 ##
2075
2076 wpLog o * "wolfpack.tcl v[package require $NamespaceCurrent] loading..."
2077
2078 # Init md5Sum command
2079 if {![md5Init]} then {
2080 wpLog o * "Error: can't find a usable md5 command!"
2081 return 0
2082 }
2083
2084 # Export commands
2085 eval namespace export [join $ExportList]
2086
2087 # Set missing variables to default values
2088 if {![info exists configDataChanged]} then {
2089 set configDataChanged 0
2090 }
2091 if {![info exists moduleDatabaseDataChanged]} then {
2092 set moduleDatabaseDataChanged 0
2093 }
2094 if {![info exists moduleLoadedList]} then {
2095 set moduleLoadedList ""
2096 }
2097
2098 # Load configuration data
2099 arrayLoad configData $configDefaults(cfgfile) 0 "configuration file "
2100
2101 # Unset unknown configuration variables
2102 foreach name [array names configData] {
2103 if {![info exists configDataDefaults($name)]} then {
2104 unset configData($name)
2105 set configDataChanged 1
2106 }
2107 }
2108
2109 # Set missing configuration variables to defaults
2110 foreach {name data} [array get configDataDefaults] {
2111 if {![info exists configData($name)]} then {
2112 set configData($name) $data
2113 set configDataChanged 1
2114 }
2115 }
2116
2117 # Save configuration data if changed
2118 if {$configDataChanged} then {
2119 arraySave configData $configDefaults(cfgfile) 0 "configuration file "
2120 }
2121
2122 # Eval command line arguments if loading with tclsh
2123 if {[info exists argv0]} then {
2124 EvalArgs $argc $argv $argv0
2125 }
2126
2127 # Check verbose/quiet options
2128 if {$optionData(quiet)} then {
2129 set Verbose $optionData(quiet)
2130 } elseif {$configData(verbose)} then {
2131 set Verbose $configData(verbose)
2132 } else {
2133 set Verbose $optionData(verbose)
2134 }
2135
2136 # Check rebuild/norebuild options
2137 if {(!$optionData(norebuild)) && ($optionData(rebuild))} then {
2138 set RebuildDatabase 1
2139 } else {
2140 set RebuildDatabase 0
2141 }
2142
2143 # Sanity check: old eggdrop versions used [time] for a timestamp command
2144 if {(($optionData(time)) || ($configData(time))) && \
2145 ([catch {time}])} then {
2146 set TimeOk 1
2147 } else {
2148 set TimeOk 0
2149 }
2150
2151 # Load module database
2152 if {$Verbose >= 0} then {
2153 wpLog o * "Loading module database..."
2154 }
2155
2156 if {$TimeOk} then {
2157 set LoadTime [time {set LoadResult [loadModuleDatabase $Verbose]}]
2158 } else {
2159 set LoadResult [loadModuleDatabase $Verbose]
2160 }
2161
2162 if {$LoadResult != -1} then {
2163 if {$Verbose >= 0} then {
2164 if {[info exists LoadTime]} then {
2165 wpLog o * "Done. ([format "%.3f" [expr [lindex $LoadTime 0] / 1000000.0]] seconds elapsed)"
2166 } else {
2167 wpLog o * "Done."
2168 }
2169 }
2170 set CreateDatabase 0
2171 } else {
2172 if {$Verbose >= 0} then {
2173 wpLog o * "Warning: module database does not exist."
2174 }
2175 set CreateDatabase 1
2176 }
2177
2178 set NeedsRebuild 0
2179
2180 # Compare module database if we are not going to rebuild or create it
2181 if {(!$RebuildDatabase) && (!$CreateDatabase)} then {
2182 if {$Verbose >= 0} then {
2183 wpLog o * "Comparing module database..."
2184 }
2185 if {![file exists $configData(moddbfile)]} then {
2186 set NeedsRebuild 1
2187 } else {
2188 if {$TimeOk} then {
2189 set CompareTime [time {set CompareResult [compareModuleDatabase $Verbose]}]
2190 } else {
2191 set CompareResult [compareModuleDatabase $Verbose]
2192 }
2193 if {!$CompareResult} then {
2194 set NeedsRebuild 1
2195 }
2196 }
2197
2198 if {$Verbose >= 0} then {
2199 if {[info exists CompareTime]} then {
2200 wpLog o * "Done. ([format "%.3f" [expr [lindex $CompareTime 0] / 1000000.0]] seconds elapsed)"
2201 } else {
2202 wpLog o * "Done."
2203 }
2204 if {$NeedsRebuild} then {
2205 wpLog o * "Database is outdated."
2206 } else {
2207 wpLog o * "Database is current."
2208 }
2209 }
2210 }
2211
2212 # Create database if does not exist
2213 # Rebuild database if requested
2214 # Rebuild database if it's outdated and config permits
2215 if {($CreateDatabase) || ($RebuildDatabase) || \
2216 (($NeedsRebuild) && ($configData(rebuild)))} then {
2217
2218 if {$Verbose >= 0} then {
2219 if {$CreateDatabase} then {
2220 wpLog o * "Creating module database..."
2221 } else {
2222 wpLog o * "Rebuilding module database..."
2223 }
2224 }
2225
2226 # Rebuild module database
2227 if {$TimeOk} then {
2228 set RebuildTime [time {rebuildModuleDatabase $Verbose}]
2229 } else {
2230 rebuildModuleDatabase $Verbose
2231 }
2232
2233 if {$Verbose >= 0} then {
2234 if {[info exists RebuildTime]} then {
2235 wpLog o * "Done. ([format "%.3f" [expr [lindex $RebuildTime 0] / 1000000.0]] seconds elapsed)"
2236 } else {
2237 wpLog o * "Done."
2238 }
2239 }
2240
2241 # Save module database
2242 if {$Verbose >= 0} then {
2243 wpLog o * "Saving module database..."
2244 }
2245
2246 if {$TimeOk} then {
2247 set SaveTime [time {set SaveResult [saveModuleDatabase $Verbose]}]
2248 } else {
2249 set SaveResult [saveModuleDatabase $Verbose]
2250 }
2251
2252 if {$Verbose >= 0} then {
2253 if {$SaveResult} then {
2254 if {[info exists SaveTime]} then {
2255 wpLog o * "Done. ([format "%.3f" [expr [lindex $SaveTime 0] / 1000000.0]] seconds elapsed)"
2256 } else {
2257 wpLog o * "Done."
2258 }
2259 } else {
2260 wpLog o * "Error"
2261 }
2262 }
2263
2264 } elseif {($NeedsRebuild) && ($Verbose >= 0)} then {
2265 wpLog o * "Warning: not rebuilding outdated module database..."
2266 }
2267
2268 # Enter interactive configuration if loading with tclsh
2269 if {[info exists argv0]} then {
2270 if {$optionData(config)} then {
2271 Iconfig
2272 }
2273 }
2274
2275 # Build command table
2276 if {(![info exists argv0]) || ($optionData(debug))} then {
2277 if {$Verbose >= 0} then {
2278 wpLog o * "Building command table..."
2279 }
2280 if {$TimeOk} then {
2281 set CommandTime [time {buildCommandTable $Verbose}]
2282 } else {
2283 buildCommandTable $Verbose
2284 }
2285 if {$Verbose >= 0} then {
2286 if {[info exists CommandTime]} then {
2287 wpLog o * "Done. ([format "%.3f" [expr [lindex $CommandTime 0] / 1000000.0]] seconds elapsed)"
2288 } else {
2289 wpLog o * "Done."
2290 }
2291 }
2292
2293 set loadList ""
2294
2295 # Load debug module first if not in eggdrop mode
2296 if {([info exists argv0]) && ([moduleExists debug])} then {
2297 lappend loadList debug
2298 }
2299
2300 # Load other modules next, moduleLoad will preload additional modules
2301 foreach name [lsort [array names moduleDatabaseData]] {
2302 if {[getModuleDatabaseData $name load] == 1} then {
2303 lappend loadList $name
2304 }
2305 }
2306
2307 wpLog o * "Loading modules..."
2308
2309 # Load modules
2310 if {$TimeOk} then {
2311 set LoadTime [time {
2312 foreach module $loadList {
2313 if {[catch {moduleLoad $module $Verbose} result]} then {
2314 wpLog o * "Error: unable to load module `$module': $result"
2315 }
2316 }
2317 }]
2318 } else {
2319 foreach module $loadList {
2320 if {[catch {moduleLoad $module $Verbose} result]} then {
2321 wpLog o * "Error: unable to load module `$module': $result"
2322 }
2323 }
2324 }
2325
2326 if {[info exists LoadTime]} then {
2327 wpLog o * "Done. ([format "%.3f" [expr [lindex $LoadTime 0] / 1000000.0]] seconds elapsed)"
2328 } else {
2329 wpLog o * "Done."
2330 }
2331
2332 set ModuleLoadCount [llength [split $moduleLoadedList]]
2333 set ModuleTotalCount [llength [array names moduleDatabaseData]]
2334 if {$ModuleLoadCount} then {
2335 wpLog o * "Modules loaded ($ModuleLoadCount/$ModuleTotalCount): $moduleLoadedList"
2336 } else {
2337 wpLog o * "No modules loaded."
2338 }
2339
2340 # Unload modules if started in debug mode
2341 if {$optionData(debug)} then {
2342
2343 # FIXME: code module dependency stuff first
2344 # wpLog o * "Unloading modules..."
2345
2346 # Unload all modules except debug
2347 # foreach module $moduleLoadedList {
2348 # if {[string compare $module debug]} then {
2349 # if {[catch {moduleUnload $module $Verbose} result]} then {
2350 # wpLog o * "Error: unable to unload module `$module': $result"
2351 # }
2352 # }
2353 # }
2354
2355 # Unload debug module last to make it display stats
2356 if {[moduleLoaded debug]} then {
2357 if {[catch {moduleUnload debug} result]} then {
2358 wpLog o * "Error: unable to unload module `debug': $result"
2359 }
2360 }
2361 # wpLog o * "Done."
2362 }
2363 }
2364
2365 } ;# namespace ::wp
2366
2367 return

webmaster@eggheads.org
ViewVC Help
Powered by ViewVC 1.1.23