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

webmaster@eggheads.org
ViewVC Help
Powered by ViewVC 1.1.23