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