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