/[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.38 - (hide annotations) (download) (as text)
Thu Jul 10 06:02:55 2003 UTC (15 years, 11 months ago) by tothwolf
Branch: MAIN
Changes since 1.37: +18 -1 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.38 ## $Id: wolfpack.tcl,v 1.37 2003/07/09 06:05:31 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     package forget $module
1642     package provide ${NamespaceCurrent}::${module} [getModuleDatabaseData $module version]
1643 tothwolf 1.9 moduleConfigLoad $module 1
1644     moduleConfigCheckdefs $module 1
1645     moduleDataLoad $module 1
1646 guppy 1.1 # Imported commands '# requires: ...'
1647     if {[string compare "" $requires]} then {
1648 tothwolf 1.31 set namespaceScript "namespace eval ${NamespaceCurrent}::${module} \{\n namespace forget *\n namespace import"
1649 guppy 1.1 foreach required $requires {
1650     if {[string compare "" [set command [whichCommand $required]]]} then {
1651 tothwolf 1.31 append namespaceScript " $command"
1652 guppy 1.1 }
1653     }
1654 tothwolf 1.31 append namespaceScript "\n\}"
1655     eval $namespaceScript
1656 guppy 1.1 }
1657     # Exported commands '# provides: ...'
1658     if {[string compare "" [set provides [getModuleDatabaseData $module provides]]]} then {
1659 tothwolf 1.31 set namespaceScript "namespace eval ${NamespaceCurrent}::${module} \{\n namespace export"
1660 guppy 1.1 foreach provided $provides {
1661 tothwolf 1.31 append namespaceScript " $provided"
1662 guppy 1.1 }
1663 tothwolf 1.31 append namespaceScript "\n\}"
1664     eval $namespaceScript
1665 guppy 1.1 }
1666 tothwolf 1.7 if {[string compare "" [info commands ${NamespaceCurrent}::${module}::ModuleInit]]} then {
1667     ${NamespaceCurrent}::${module}::ModuleInit
1668 guppy 1.1 }
1669 tothwolf 1.7 # FIXME: check for bindings? duplicates?
1670 tothwolf 1.15 moduleBindUnbind bind $module
1671 guppy 1.1 if {![getModuleDatabaseData $module load]} then {
1672     setModuleDatabaseData $module load 1
1673     }
1674     if {[lsearch -exact $moduleLoadedList $module] == -1} then {
1675     lappend moduleLoadedList $module
1676     if {$verbose >= 1} then {
1677     wpLog o * "Module loaded: $module"
1678     }
1679     }
1680     }
1681     } else {
1682     error "No such module: $module"
1683     }
1684     } else {
1685     regsub -all -- " " $loop " -> " loop
1686     error "Preload endless loop: $loop -> $module"
1687     }
1688     return
1689     }
1690    
1691     ##
1692     ## Unload a module
1693     ##
1694     ## Args: module name, verbose {-1,0,1}
1695     ## Returns: nothing
1696     ## Errors: if unable to completely unload module
1697     ##
1698     proc moduleUnload {module {verbose 0}} {
1699     variable NamespaceCurrent
1700     variable moduleLoadedList
1701    
1702 tothwolf 1.9 # FIXME: handle dependant modules and modules that can't be unloaded
1703 guppy 1.1 if {[moduleExists $module]} then {
1704 tothwolf 1.7 if {[string compare "" [info commands ${NamespaceCurrent}::${module}::ModuleDestroy]]} then {
1705     ${NamespaceCurrent}::${module}::ModuleDestroy
1706 guppy 1.1 }
1707 tothwolf 1.7 # FIXME: check for bindings?
1708 tothwolf 1.15 moduleBindUnbind unbind $module
1709 tothwolf 1.9 moduleConfigSave $module 1
1710     moduleDataSave $module 1
1711 tothwolf 1.28
1712     # FIXME: we should kill off stale timer/utimers here somewhere before unloading
1713    
1714 guppy 1.1 if {[catch {namespace delete ${NamespaceCurrent}::${module}} result]} then {
1715     error $result
1716     } else {
1717     package forget ${NamespaceCurrent}::${module}
1718     if {[getModuleDatabaseData $module load] == 1} then {
1719     setModuleDatabaseData $module load 0
1720     }
1721     set index [lsearch -exact $moduleLoadedList $module]
1722     if {$index != -1} then {
1723     set moduleLoadedList [lreplace $moduleLoadedList $index $index]
1724     if {$verbose >= 1} then {
1725     wpLog o * "Module unloaded: $module"
1726     }
1727     }
1728     }
1729     } else {
1730     error "No such module: $module"
1731     }
1732     return
1733     }
1734    
1735     ##
1736 tothwolf 1.9 ## Save configuration settings for the given module
1737 guppy 1.1 ##
1738 tothwolf 1.9 ## Args: module, force {0,1}, verbose {-1,0,1}
1739     ## Returns: 1 if settings saved
1740 guppy 1.1 ## 0 otherwise
1741     ##
1742 tothwolf 1.9 proc moduleConfigSave {module {force 0} {verbose 0}} {
1743 guppy 1.1 variable NamespaceCurrent
1744     variable configData
1745    
1746     if {([string compare "" \
1747     [set file [getModuleDatabaseData $module config]]]) && \
1748     ([createDir $configData(configpath)])} then {
1749     set cfgfile [file join $configData(configpath) $file]
1750 tothwolf 1.9 if {([getModuleDatabaseData $module load]) && \
1751     (($force) || \
1752     (![info exists ${NamespaceCurrent}::${module}::configDataChanged]) || \
1753     ([set ${NamespaceCurrent}::${module}::configDataChanged]))} then {
1754     if {[arraySave ${NamespaceCurrent}::${module}::configData $cfgfile 0 "$module configuration file "]} then {
1755     if {$verbose >= 1} then {
1756     wpLog o * "Writing $module config file..."
1757 guppy 1.1 }
1758 tothwolf 1.9 set ${NamespaceCurrent}::${module}::configDataChanged 0
1759     return 1
1760     } elseif {$verbose >= 0} then {
1761     wpLog o * "Error writing $module config file."
1762 guppy 1.1 }
1763 tothwolf 1.9 }
1764     }
1765     return 0
1766     }
1767    
1768     ##
1769     ## Load configuration settings for the given module
1770     ##
1771     ## Args: module, force {0,1}, verbose {-1,0,1}
1772     ## Returns: 1 if settings loaded
1773     ## 0 otherwise
1774     ##
1775     proc moduleConfigLoad {module {force 0} {verbose 0}} {
1776     variable NamespaceCurrent
1777     variable configData
1778    
1779     if {([string compare "" \
1780     [set file [getModuleDatabaseData $module config]]]) && \
1781     ([createDir $configData(configpath)])} then {
1782     set cfgfile [file join $configData(configpath) $file]
1783     if {($force) || \
1784     (![info exists ${NamespaceCurrent}::${module}::configDataChanged]) || \
1785     (![set ${NamespaceCurrent}::${module}::configDataChanged])} then {
1786     if {[arrayLoad ${NamespaceCurrent}::${module}::configData $cfgfile 0 "$module configuration file "]} then {
1787     if {$verbose >= 1} then {
1788     wpLog o * "Loading $module config file..."
1789 guppy 1.1 }
1790 tothwolf 1.9 set ${NamespaceCurrent}::${module}::configDataChanged 0
1791     return 1
1792     } elseif {$verbose >= 0} then {
1793     wpLog o * "Error loading $module config file."
1794 guppy 1.1 }
1795     }
1796     }
1797     return 0
1798     }
1799    
1800     ##
1801 tothwolf 1.9 ## Check and set default configuration settings for the given module
1802 guppy 1.1 ##
1803 tothwolf 1.9 ## Args: module, force {0,1}, verbose {-1,0,1}
1804 guppy 1.1 ## Returns: nothing
1805     ##
1806 tothwolf 1.9 proc moduleConfigCheckdefs {module {force 0} {verbose 0}} {
1807     variable NamespaceCurrent
1808    
1809     if {([array exists ${NamespaceCurrent}::${module}::configDefaults]) && \
1810     ([string compare "" [getModuleDatabaseData $module config]])} then {
1811     set Changed 0
1812     # Unset unknown variables
1813     foreach name [array names ${NamespaceCurrent}::${module}::configData] {
1814     if {![info exists ${NamespaceCurrent}::${module}::configDefaults($name)]} then {
1815     unset ${NamespaceCurrent}::${module}::configData($name)
1816     set Changed 1
1817     }
1818     }
1819     # Set missing variables to defaults
1820     foreach {name data} [array get ${NamespaceCurrent}::${module}::configDefaults] {
1821     if {![info exists ${NamespaceCurrent}::${module}::configData($name)]} then {
1822     set ${NamespaceCurrent}::${module}::configData($name) [lindex $data 1]
1823     set Changed 1
1824     }
1825     }
1826     # FIXME: do this with a trace?
1827     if {$Changed} then {
1828     set ${NamespaceCurrent}::${module}::configDataChanged 1
1829     }
1830     }
1831     return
1832     }
1833 guppy 1.1
1834 tothwolf 1.9 ##
1835     ## Handle config data for a list of modules
1836     ##
1837     ## Args: action {load|save|checkdefs}, module list, force {0,1},
1838     ## verbose {-1,0,1}
1839     ## Returns: nothing
1840     ##
1841     proc moduleConfig {action modules {force 0} {verbose 0}} {
1842 guppy 1.1 if {![string compare * $modules]} then {
1843     set modules [listModules 1]
1844     }
1845 tothwolf 1.9 switch -exact -- $action {
1846     save {
1847     foreach module $modules {
1848     if {([moduleExists $module]) && ([moduleLoaded $module])} then {
1849     moduleConfigSave $module $force $verbose
1850     }
1851     }
1852     }
1853     load {
1854     foreach module $modules {
1855     if {([moduleExists $module]) && ([moduleLoaded $module])} then {
1856     moduleConfigLoad $module $force $verbose
1857     }
1858     }
1859     }
1860     checkdefs {
1861     foreach module $modules {
1862     if {([moduleExists $module]) && ([moduleLoaded $module])} then {
1863     moduleConfigCheckdefs $module $force $verbose
1864     }
1865     }
1866 guppy 1.1 }
1867     }
1868     return
1869     }
1870    
1871     ##
1872 tothwolf 1.9 ## Save data for the given module
1873 guppy 1.1 ##
1874 tothwolf 1.9 ## Args: module, force {0,1}, verbose {-1,0,1}
1875 guppy 1.1 ## Returns: nothing
1876     ##
1877 tothwolf 1.9 proc moduleDataSave {module {force 0} {verbose 0}} {
1878 guppy 1.1 variable NamespaceCurrent
1879     variable configData
1880    
1881     if {([info exists ${NamespaceCurrent}::${module}::dataOptions]) && \
1882     ([createDir $configData(datapath)])} then {
1883 tothwolf 1.9 foreach {name data} [array get ${NamespaceCurrent}::${module}::dataOptions] {
1884     foreach {type file desc} $data {break}
1885     if {([info exists type]) && ([info exists file]) && \
1886     ([info exists desc])} then {
1887     set Changed ${NamespaceCurrent}::${module}::${name}Changed
1888     if {($force) || ((![info exists $Changed]) || ([set $Changed]))} then {
1889     if {[${type}Save ${NamespaceCurrent}::${module}::$name [file join $configData(datapath) $file]]} then {
1890     if {$verbose >= 1} then {
1891     wpLog o * $NamespaceCurrent "Writing $desc data file..."
1892 guppy 1.1 }
1893 tothwolf 1.9 set $Changed 0
1894     } elseif {$verbose >= 0} then {
1895     wpLog o * $NamespaceCurrent "Error writing $desc data file!"
1896 guppy 1.1 }
1897     }
1898     }
1899 tothwolf 1.9 }
1900     }
1901     return
1902     }
1903    
1904     ##
1905     ## Load data for the given module
1906     ##
1907     ## Args: module, force {0,1}, verbose {-1,0,1}
1908     ## Returns: nothing
1909     ##
1910     proc moduleDataLoad {module {force 0} {verbose 0}} {
1911     variable NamespaceCurrent
1912     variable configData
1913    
1914     if {([info exists ${NamespaceCurrent}::${module}::dataOptions]) && \
1915     ([createDir $configData(datapath)])} then {
1916     foreach {name data} [array get ${NamespaceCurrent}::${module}::dataOptions] {
1917     foreach {type file desc} $data {break}
1918     if {([info exists type]) && ([info exists file]) && \
1919     ([info exists desc])} then {
1920     set Changed ${NamespaceCurrent}::${module}::${name}Changed
1921     if {($force) || ((![info exists $Changed]) || ([set $Changed]))} then {
1922     if {[${type}Load ${NamespaceCurrent}::${module}::$name [file join $configData(datapath) $file]]} then {
1923     if {$verbose >= 1} then {
1924     wpLog o * $NamespaceCurrent "Reloading $desc data file..."
1925 guppy 1.1 }
1926 tothwolf 1.9 set $Changed 0
1927     } elseif {$verbose >= 0} then {
1928     wpLog o * $NamespaceCurrent "Error reloading $desc data file!"
1929 guppy 1.1 }
1930     }
1931     }
1932 tothwolf 1.9 }
1933     }
1934     return
1935     }
1936    
1937     ##
1938     ## Backup data for the given module
1939     ##
1940     ## Args: module, force {0,1}, verbose {-1,0,1}
1941     ## Returns: nothing
1942     ##
1943     proc moduleDataBackup {module {force 0} {verbose 0}} {
1944     variable NamespaceCurrent
1945     variable configData
1946    
1947     if {([info exists ${NamespaceCurrent}::${module}::dataOptions]) && \
1948     ([createDir $configData(datapath)])} then {
1949     foreach {name data} [array get ${NamespaceCurrent}::${module}::dataOptions] {
1950     foreach {type file desc} $data {break}
1951     if {([info exists type]) && ([info exists file]) && \
1952     ([info exists desc])} then {
1953     if {[set result [backupFile [file join $configData(datapath) $file] $verbose]]} then {
1954     if {($result >= 1) && ($verbose >= 1)} then {
1955     wpLog o * $NamespaceCurrent "Backing up $desc data file..."
1956 guppy 1.1 }
1957 tothwolf 1.9 } elseif {$verbose >= 0} then {
1958     wpLog o * $NamespaceCurrent "Error backing up $desc data file!"
1959 guppy 1.1 }
1960     }
1961     }
1962     }
1963     return
1964     }
1965    
1966     ##
1967 tothwolf 1.9 ## Handle data for a list of modules
1968 guppy 1.1 ##
1969 tothwolf 1.9 ## Args: action {load|save|backup}, module list, force {0,1},
1970     ## verbose {-1,0,1}
1971 guppy 1.1 ## Returns: nothing
1972     ##
1973 tothwolf 1.9 proc moduleData {action modules {force 0} {verbose 0}} {
1974 guppy 1.1 if {![string compare * $modules]} then {
1975     set modules [listModules 1]
1976     }
1977 tothwolf 1.9 switch -exact -- $action {
1978     save {
1979     foreach module $modules {
1980     if {([moduleExists $module]) && ([moduleLoaded $module])} then {
1981     moduleDataSave $module $force $verbose
1982     }
1983     }
1984     }
1985     load {
1986     foreach module $modules {
1987     if {([moduleExists $module]) && ([moduleLoaded $module])} then {
1988     moduleDataLoad $module $force $verbose
1989     }
1990     }
1991     }
1992     backup {
1993     foreach module $modules {
1994     if {([moduleExists $module]) && ([moduleLoaded $module])} then {
1995     moduleDataBackup $module $force $verbose
1996     }
1997     }
1998 guppy 1.1 }
1999     }
2000     return
2001     }
2002    
2003     ##
2004     ## Builds command matching table from module database
2005     ##
2006     ## Args: none
2007     ## Returns: nothing
2008     ##
2009     proc buildCommandTable {{verbose 0}} {
2010     variable NamespaceCurrent
2011     variable ExportList
2012     variable commandTable
2013    
2014     foreach command $ExportList {
2015     if {![info exists tmp($command)]} then {
2016     if {$verbose >= 2} then {
2017     wpLog o * "Adding command: `$command' as `${NamespaceCurrent}::$command'"
2018     }
2019     set tmp($command) ${NamespaceCurrent}::$command
2020     } elseif {$verbose >= 0} then {
2021     wpLog o * "Warning: ignoring duplicate command `$command', conflicts with `$tmp($command)'"
2022     }
2023     }
2024     foreach module [listModules] {
2025     if {[string compare "" [set provides [getModuleDatabaseData $module provides]]]} then {
2026     foreach command $provides {
2027     if {![info exists tmp($command)]} then {
2028     if {$verbose >= 2} then {
2029     wpLog o * "Adding command: `$command' as `${NamespaceCurrent}::${module}::$command'"
2030     }
2031     set tmp($command) ${NamespaceCurrent}::${module}::$command
2032     } elseif {$verbose >= 0} then {
2033     wpLog o * "Warning: ignoring duplicate command `$command', conflicts with `$tmp($command)'"
2034     }
2035     }
2036     }
2037     }
2038     if {[info exists commandTable]} then {
2039     unset commandTable
2040     }
2041     array set commandTable [array get tmp]
2042     return
2043     }
2044    
2045     ##
2046     ## Return full namespace path for the given command
2047     ##
2048     ## Args: command
2049     ## Returns: full namespace path for the given command if it exists
2050     ## nothing otherwise
2051     ##
2052     proc whichCommand {command} {
2053     variable commandTable
2054    
2055     if {[info exists commandTable($command)]} then {
2056     return $commandTable($command)
2057     }
2058     return
2059     }
2060    
2061     ##
2062     ## Return full namespace path for the given module
2063     ##
2064     ## Args: module
2065     ## Returns: full namespace path for the given module if it's loaded
2066     ## nothing otherwise
2067     ##
2068     proc whichModule {module} {
2069     variable NamespaceCurrent
2070    
2071     if {![string compare $module [namespace tail $NamespaceCurrent] $module]} then {
2072     return $NamespaceCurrent
2073     } elseif {[moduleLoaded $module]} then {
2074     return ${NamespaceCurrent}::$module
2075     }
2076     return
2077     }
2078    
2079     ##
2080     ## Return module name that provides the given command
2081     ##
2082     ## Args: command
2083     ## Returns: name of module that provides the given command
2084     ## nothing otherwise
2085     ##
2086     proc whichModuleCommand {command} {
2087     variable NamespaceCurrent
2088     variable commandTable
2089    
2090     if {[info exists commandTable($command)]} then {
2091     if {![string compare ${NamespaceCurrent}::$command \
2092     $commandTable($command)]} then {
2093     return [namespace tail $NamespaceCurrent]
2094     }
2095     return [namespace tail [namespace qualifiers $commandTable($command)]]
2096     }
2097     return
2098     }
2099    
2100     ##
2101 tothwolf 1.30 ## Check if the given [module] config option exists
2102     ##
2103     ## Args: module, option
2104     ## Returns: 1 if the given module config option exists
2105     ##
2106     proc configExists {module {option ""}} {
2107     variable NamespaceCurrent
2108     variable configData
2109    
2110     if {[string compare "" $module]} then {
2111     set where "${NamespaceCurrent}::${module}::"
2112     } else {
2113     set where ""
2114     }
2115     if {[string compare "" $option]} then {
2116     if {[info exists ${where}configData($option)]} then {
2117     return 1
2118     }
2119     } elseif {[info exists ${where}configData]} then {
2120     return 1
2121     }
2122     return 0
2123     }
2124    
2125     ##
2126 guppy 1.1 ## Compare the given version to eggdrop's version
2127     ##
2128     ## Args: version
2129     ## Returns: 0 if eggdrop's version is older then the given version
2130     ## 1 if eggdrop's version matches the given version
2131     ## 2 if eggdrop's version is newer then the given version
2132 tothwolf 1.33 ## -1 if the given version is invalid
2133 guppy 1.1 ##
2134     proc compareVersion {version} {
2135     global numversion
2136    
2137 tothwolf 1.33 if {([string compare "" $version]) && \
2138     ([info exists numversion])} then {
2139     if {[regexp -- \\. $version]} then {
2140     regsub -all -- \\. $version 0 version
2141     set version ${version}00
2142     }
2143     if {[regexp -- \[^0-9\] $version]} then {
2144     return -1
2145     } elseif {$numversion == $version} then {
2146     return 1
2147     } elseif {$numversion > $version} then {
2148     return 2
2149 guppy 1.1 }
2150     }
2151     return 0
2152     }
2153    
2154     ##
2155     ## Log module information
2156     ##
2157     ## Args: level, channel, args ({<namespace>} {<text>} | {<text>})
2158     ## Returns: nothing
2159     ##
2160     proc wpLog {level channel args} {
2161     if {[llength $args] == 2} then {
2162     if {[string compare wp [set namespace [namespace tail [lindex $args 0]]]]} then {
2163     putloglev $level $channel "Wolfpack: \[$namespace\] [lindex $args 1]"
2164     } else {
2165     putloglev $level $channel "Wolfpack: [lindex $args 1]"
2166     }
2167     } else {
2168     putloglev $level $channel "Wolfpack: [join $args]"
2169     }
2170     return
2171     }
2172    
2173     ##
2174     ## Evaluate command line arguments
2175     ##
2176     ## Args: none
2177     ## Returns: nothing
2178     ##
2179     proc EvalArgs {argc argv argv0} {
2180     variable NamespaceCurrent
2181     variable optionData
2182    
2183     for {set index 0} {$index < $argc} {incr index} {
2184     set option [lindex $argv $index]
2185 tothwolf 1.35 set nextoption [lindex $argv [expr $index + 1]]
2186    
2187 guppy 1.1 switch -regexp -- $option {
2188 tothwolf 1.35 (^--$) {
2189     break
2190     }
2191     (^--cfgfile$) {
2192     if {([string compare "" $nextoption]) && \
2193     (![regexp -- - $nextoption])} then {
2194     set optionData(cfgfile) $nextoption
2195     incr index
2196     } else {
2197     listAppendIf noparms "--cfgfile"
2198     }
2199     }
2200 guppy 1.1 (^--config$) {
2201     set optionData(config) 1
2202     }
2203 tothwolf 1.35 (^--update$) {
2204     set optionData(update) 1
2205     }
2206     (^--noupdate$) {
2207     set optionData(noupdate) 1
2208     }
2209 guppy 1.1 (^--rebuild$) {
2210     set optionData(rebuild) 1
2211     }
2212     (^--time$) {
2213     set optionData(time) 1
2214     }
2215 tothwolf 1.35 (^--include$) {
2216     if {([string compare "" $nextoption]) && \
2217     (![regexp -- - $nextoption])} then {
2218 tothwolf 1.36 listAppendIf optionData(include) $nextoption
2219 tothwolf 1.35 incr index
2220     } else {
2221     listAppendIf noparms "--include"
2222     }
2223     }
2224     (^--exclude$) {
2225     if {([string compare "" $nextoption]) && \
2226     (![regexp -- - $nextoption])} then {
2227 tothwolf 1.36 listAppendIf optionData(exclude) $nextoption
2228 tothwolf 1.35 incr index
2229     } else {
2230     listAppendIf noparms "--exclude"
2231     }
2232     }
2233     (^--module$) {
2234     if {([string compare "" $nextoption]) && \
2235     (![regexp -- - $nextoption])} then {
2236 tothwolf 1.36 listAppendIf optionData(module) $nextoption
2237 tothwolf 1.35 incr index
2238     } else {
2239     listAppendIf noparms "--module"
2240     }
2241     }
2242 guppy 1.1 (^--verbose$) {
2243     incr optionData(verbose)
2244     }
2245     (^--quiet$) {
2246     incr optionData(quiet) -1
2247     }
2248     (^--debug$) {
2249     set optionData(debug) 1
2250     }
2251     (^--help$) {
2252     ShowUsage $argv0
2253     exit
2254     }
2255     (^--version$) {
2256     puts "[file tail $argv0] version [package require ${NamespaceCurrent}]"
2257     exit
2258     }
2259     (^-\[^-