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