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

webmaster@eggheads.org
ViewVC Help
Powered by ViewVC 1.1.23