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