/[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.10 - (show annotations) (download) (as text)
Mon Jan 13 01:10:17 2003 UTC (16 years, 9 months ago) by tothwolf
Branch: MAIN
Changes since 1.9: +4 -2 lines
File MIME type: application/x-tcl
*** empty log message ***

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

webmaster@eggheads.org
ViewVC Help
Powered by ViewVC 1.1.23