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

webmaster@eggheads.org
ViewVC Help
Powered by ViewVC 1.1.23