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

webmaster@eggheads.org
ViewVC Help
Powered by ViewVC 1.1.23