/[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.34 - (hide annotations) (download) (as text)
Wed Feb 12 20:36:22 2003 UTC (16 years, 8 months ago) by tothwolf
Branch: MAIN
Changes since 1.33: +4 -5 lines
File MIME type: application/x-tcl
*** empty log message ***

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