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

webmaster@eggheads.org
ViewVC Help
Powered by ViewVC 1.1.23