/[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.28 - (show annotations) (download) (as text)
Wed Jan 15 15:09:12 2003 UTC (16 years, 5 months ago) by tothwolf
Branch: MAIN
Changes since 1.27: +4 -1 lines
File MIME type: application/x-tcl
*** empty log message ***

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

webmaster@eggheads.org
ViewVC Help
Powered by ViewVC 1.1.23