/[cvs]/wolfpack/wolfpack.tcl
ViewVC logotype

Annotation of /wolfpack/wolfpack.tcl

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.28 - (hide annotations) (download) (as text)
Wed Jan 15 15:09:12 2003 UTC (16 years, 5 months ago) by tothwolf
Branch: MAIN
Changes since 1.27: +4 -1 lines
File MIME type: application/x-tcl
*** empty log message ***

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