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

webmaster@eggheads.org
ViewVC Help
Powered by ViewVC 1.1.23