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

webmaster@eggheads.org
ViewVC Help
Powered by ViewVC 1.1.23