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