/[cvs]/wolfpack/wolfpack.tcl
ViewVC logotype

Contents of /wolfpack/wolfpack.tcl

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.35 - (show annotations) (download) (as text)
Tue Jul 8 02:14:12 2003 UTC (16 years, 3 months ago) by tothwolf
Branch: MAIN
Changes since 1.34: +424 -169 lines
File MIME type: application/x-tcl
*** empty log message ***

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 ## Copyright (C) 1998-2003 Tothwolf <tothwolf@concentric.net>
41 ##
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 ## './wolfpack.tcl -c' may be used to configure initial settings.
61 ## './wolfpack.tcl --help' will list all avaliable options.
62 ##
63 ## Use '.wpconf' in dcc chat with the bot to configure everything else.
64 ##
65 ###############################################################################
66 ##
67 ## $Id: wolfpack.tcl,v 1.34 2003/02/12 20:36:22 tothwolf Exp $
68 ##
69
70 # Make sure Tcl version is compatible with this code (we use namespaces)
71 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 return
78 }
79
80 namespace eval :: {
81
82 # Eggdrop doesn't currently set argv0, so we use it to detect load type.
83 if {![info exists argv0]} then {
84 # Fix for buggy tcl variables in pre 1.3.28 Eggdrop versions
85 catch {set numversion}
86
87 # Require eggdrop 1.3.0 or later
88 if {(![info exists numversion]) || ($numversion < 1030000)} then {
89 putloglev o * "Wolfpack: Error: wolfpack requires Eggdrop 1.3.0 or later to load."
90 return
91 }
92 } else {
93 # Emulate eggdrop's putloglev when loading with tclsh
94 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 2.0 "{version config author description provides requires} {load file md5sum}"
152 }
153
154 # md5 style, command name and result string index
155 array set md5Format {
156 bsd "md5 3"
157 gnu "md5sum 0"
158 }
159
160 # Configuration defaults, values and descriptions
161 array set configDefaults {
162 modulepath {word modules/ {} {Module path}}
163 configpath {word wpconf/ {} {Config path}}
164 datapath {word wpdata/ {} {Data path}}
165 moddbfile {word wolfpack.db {} {Module database file}}
166 update {{range {0 1}} 1 {} {Automatically update module database}}
167 verbose {{range {0 1}} 0 {} {Verbose operation}}
168 time {{range {0 1}} 0 {} {Time module database compare/update/rebuild}}
169 }
170
171 # Command line option defaults
172 array set optionData {
173 cfgfile ""
174 config 0
175 update 0
176 noupdate 0
177 rebuild 0
178 time 0
179 include ""
180 exclude ""
181 module ""
182 verbose 0
183 quiet 0
184 debug 0
185 }
186
187 # Exported commands
188 set ExportList {
189 md5Sum
190 md5Init
191 replaceExpr
192 listFiles
193 listSubdirs
194 findFiles
195 createFile
196 createDir
197 backupFile
198 shortFile
199 listSave
200 listLoad
201 arraySave
202 arrayLoad
203 arraySetAll
204 arrayFindElementName
205 arrayMaxElementDataLength
206 listAppendIf
207 listMaxElementLength
208 splitList
209 expandText
210 arraySearch
211 dataFormatDefault
212 dataFormatValue
213 dataFormatReplace
214 dataFormatBuild
215 dataFormatConvert
216 scanModule
217 getModuleDatabaseData
218 setModuleDatabaseData
219 saveModuleDatabase
220 loadModuleDatabase
221 updateModuleData
222 updateModuleDatabase
223 rebuildModuleDatabase
224 listModules
225 moduleExists
226 moduleLoaded
227 moduleBindUnbind
228 moduleLoad
229 moduleUnload
230 moduleConfigSave
231 moduleConfigLoad
232 moduleConfigCheckdefs
233 moduleConfig
234 moduleDataSave
235 moduleDataLoad
236 moduleDataBackup
237 moduleData
238 buildCommandTable
239 whichCommand
240 whichModule
241 whichModuleCommand
242 configExists
243 compareVersion
244 wpLog
245 }
246
247 ##
248 ## Create md5 checksum for a file
249 ##
250 ## Args: filename
251 ## Returns: md5 checksum if successful
252 ## Errors: permission denied,
253 ## no such file,
254 ## not a file,
255 ## can't exec md5 command
256 ##
257 proc md5Sum {file} {
258 variable md5Config
259
260 if {![file exists $file]} then {
261 error "$file: no such file"
262 } else {
263 if {![file isfile $file]} then {
264 error "$file: not a file"
265 } else {
266 if {![file readable $file]} then {
267 error "$file: permission denied"
268 } else {
269 if {[catch {set sum [lindex [exec $md5Config(command) $file] $md5Config(index)]} result]} then {
270 error "$file: $result"
271 } else {
272 return $sum
273 }
274 }
275 }
276 }
277 }
278
279 ##
280 ## Init md5 command
281 ##
282 ## Args: none
283 ## Returns: 1 if a useable md5 command found
284 ## 0 otherwise
285 ##
286 proc md5Init {} {
287 variable md5Config
288 variable md5Format
289
290 foreach type [array names md5Format] {
291 foreach {command index} $md5Format($type) {break}
292 if {([catch {exec $command ""} result]) && \
293 (![regexp -- "^couldn't execute" $result])} then {
294 set md5Config(command) $command
295 set md5Config(index) $index
296 return 1
297 }
298 }
299 return 0
300 }
301
302 ##
303 ## Replace all occurances of an expression in a string with the given text
304 ##
305 ## Args: string, expr, replacement text
306 ## Returns: string
307 ##
308 proc replaceExpr {string expr {replace ""}} {
309 while {[regexp -nocase -- $expr $string]} {
310 regsub -all -- $expr $string $replace string
311 }
312 return $string
313 }
314
315 ##
316 ## List files in a path
317 ##
318 ## Args: path
319 ## Returns: list of files in the given path,
320 ## nothing if no files in the given path
321 ## Errors: permission denied,
322 ## no such directory,
323 ## not a directory
324 ##
325 proc listFiles {path} {
326 if {![file exists $path]} then {
327 error "$path: no such directory"
328 } else {
329 if {![file isdirectory $path]} then {
330 error "$path: not a directory"
331 } else {
332 if {![file readable $path]} then {
333 error "$path: permission denied"
334 } else {
335 set ret ""
336 foreach name [lsort [glob -nocomplain -- [file join $path *]]] {
337 if {[file isfile $name]} then {
338 lappend ret $name
339 }
340 }
341 return $ret
342 }
343 }
344 }
345 }
346
347 ##
348 ## List subdirs in a path
349 ##
350 ## Args: path
351 ## Returns: list of subdirs in the given path,
352 ## nothing if no subdirs in the given path
353 ## Errors: permission denied,
354 ## no such directory,
355 ## not a directory
356 ##
357 proc listSubdirs {path} {
358 if {![file exists $path]} then {
359 error "$path: no such directory"
360 } else {
361 if {![file isdirectory $path]} then {
362 error "$path: not a directory"
363 } else {
364 if {![file readable $path]} then {
365 error "$path: permission denied"
366 } else {
367 set ret ""
368 foreach name [lsort [glob -nocomplain -- [file join $path *]]] {
369 if {[file isdirectory $name]} then {
370 lappend ret $name
371 }
372 }
373 return $ret
374 }
375 }
376 }
377 }
378
379 ##
380 ## List files with a set ext in a path and its subdirs up to a set depth
381 ##
382 ## Args: path, max search depth, file extension
383 ## Returns: list of files with a set ext in the given path and its subdirs,
384 ## nothing if no matching files are found
385 ##
386 proc findFiles {path depth {ext ""}} {
387 set ret ""
388 set foundDirs "$path "
389 set searchDirs $path
390 for {
391 set currentDepth 0
392 } {($currentDepth <= $depth) || (!$depth)} {
393 incr currentDepth
394 } {
395 set subDirs ""
396 foreach dir $searchDirs {
397 if {[catch {set dirList [listSubdirs $dir]} result]} then {
398 wpLog o * "Error: unable to get file listing: $result"
399 } elseif {[string compare "" $dirList]} then {
400 append subDirs $dirList " "
401 }
402 }
403 if {![string compare "" $subDirs]} then {
404 break
405 }
406 append foundDirs $subDirs " "
407 set searchDirs $subDirs
408 }
409 foreach dir $foundDirs {
410 if {[catch {set files [listFiles $dir]} result]} then {
411 wpLog o * "Error: unable to get file listing: $result"
412 } else {
413 if {[string compare "" $ext]} then {
414 foreach file $files {
415 if {![string compare $ext \
416 [string tolower [file extension $file]]]} then {
417 lappend ret $file
418 }
419 }
420 } else {
421 set ret $files
422 }
423 }
424 }
425 return $ret
426 }
427
428 ##
429 ## Check if a file exists, and create it if not
430 ##
431 ## Args: filename, verbose {-1,0,1}, description, force new file
432 ## Returns: 1 if the file was created successfully
433 ## 0 if the operation failed
434 ## -1 if the file already exists
435 ##
436 proc createFile {file {verbose 0} {desc "file "} {force 0}} {
437 if {($force) || (![file exists $file])} then {
438 if {[catch {set fd [open $file w]} result]} then {
439 if {$verbose >= 0} then {
440 wpLog o * "Error: unable to create ${desc}`[file tail $file]': $result"
441 }
442 } else {
443 if {(!$force) && ($verbose >= 1)} then {
444 wpLog o * "Warning: ${desc}`[file tail $file]' does not exist -- creating"
445 }
446 close $fd
447 return 1
448 }
449 } elseif {[file isfile $file]} then {
450 return -1
451 } elseif {$verbose >= 0} then {
452 wpLog o * "Error: not a file: $file"
453 }
454 return 0
455 }
456
457 ##
458 ## Check if a directory exists, and create it if not
459 ##
460 ## Args: directory, verbose {-1,0,1}, description
461 ## Returns: 1 if the directory was created successfully
462 ## 0 if the operation failed
463 ## -1 if the directory already exists
464 ##
465 proc createDir {dir {verbose 0} {desc "directory "}} {
466 if {![file exists $dir]} then {
467 if {[catch {file mkdir $dir} result]} then {
468 if {$verbose >= 0} then {
469 wpLog o * "Error: unable to create ${desc}`[file tail $dir]': $result"
470 }
471 } else {
472 if {$verbose >= 1} then {
473 wpLog o * "Warning: ${desc}`[file tail $dir]' does not exist -- creating"
474 }
475 return 1
476 }
477 } elseif {[file isdirectory $dir]} then {
478 return -1
479 } elseif {$verbose >= 0} then {
480 wpLog o * "Error: not a directory: $dir"
481 }
482 return 0
483 }
484
485 ##
486 ## Create a backup of the given file with an optional suffix
487 ##
488 ## Args: filename, suffix, verbose {-1,0,1}
489 ## Returns: 1 if successful
490 ## -1 if file is 0 in size
491 ## 0 otherwise
492 ##
493 proc backupFile {file {verbose 0} {suffix ~bak}} {
494 variable NamespaceCurrent
495
496 if {[string compare "" $suffix]} then {
497 if {[file size $file]} then {
498 if {[catch {
499 file copy -force $file $file${suffix}
500 } result]} then {
501 if {$verbose >= 0} then {
502 wpLog o * $NamespaceCurrent "Error: unable to create backup file for `[file tail $file]': $result"
503 }
504 } else {
505 return 1
506 }
507 } else {
508 return -1
509 }
510 }
511 return 0
512 }
513
514 ##
515 ## Remove directory component from a filename
516 ##
517 ## Args: file, pathlist
518 ## Returns: file with directory component removed
519 ##
520 proc shortFile {file {pathlist ""}} {
521 if {[string compare "" $pathlist]} then {
522 foreach dir [lsort -decreasing $pathlist] {
523 set dirlength [string length $dir]
524 set filedir [string range $file 0 [expr $dirlength - 1]]
525 if {![string compare $dir $filedir]} then {
526 return [string trimleft [string range $file $dirlength end] /]
527 }
528 }
529 }
530 return [string trimleft [string range $file [string last / $file] end] /]
531 }
532
533 ##
534 ## Save data from a list into a file
535 ##
536 ## Args: list, filename, verbose {-1,0,1}, description, access flag
537 ## Returns: 1 is successful,
538 ## 0 otherwise
539 ##
540 proc listSave {listName file {verbose 0} {desc "file "} {access w}} {
541 upvar 1 $listName list
542
543 if {[createFile $file $verbose $desc]} then {
544 if {[catch {set fd [open $file $access]} result]} then {
545 if {$verbose >= 0} then {
546 wpLog o * "Error: unable to open ${desc}`$file' for writing: $result"
547 }
548 } else {
549 if {[info exists list]} then {
550 foreach data $list {
551 puts $fd [list $data]
552 }
553 }
554 close $fd
555 return 1
556 }
557 }
558 return 0
559 }
560
561 ##
562 ## Load data into a list from a file
563 ##
564 ## Args: list, filename, verbose {-1,0,1}, description, ignore regsub
565 ## Returns: 1 if successful,
566 ## 0 otherwise
567 ##
568 proc listLoad {listName file {verbose 0} {desc "file "} {ignore "^#"}} {
569 upvar 1 $listName list
570
571 if {[createFile $file $verbose $desc]} then {
572 if {[catch {set fd [open $file r]} result]} then {
573 if {$verbose >= 0} then {
574 wpLog o * "Error: unable to open ${desc}`$file' for reading: $result"
575 }
576 } else {
577 if {[info exists list]} then {
578 unset list
579 }
580 while {![eof $fd]} {
581 set line [replaceExpr [gets $fd] "^ "]
582 if {([string compare "" $line]) && \
583 (![regexp -- $ignore $line])} then {
584 append list $line " "
585 }
586 }
587 close $fd
588 return 1
589 }
590 }
591 return 0
592 }
593
594 ##
595 ## Save data from an array info a file
596 ##
597 ## Args: array, filename, verbose {-1,0,1}, description, access flag
598 ## Returns: 1 is successful,
599 ## 0 otherwise
600 ##
601 proc arraySave {arrayName file {verbose 0} {desc "file "} {access w}} {
602 upvar 1 $arrayName array
603
604 if {[createFile $file $verbose $desc]} then {
605 if {[catch {set fd [open $file $access]} result]} then {
606 if {$verbose >= 0} then {
607 wpLog o * "Error: unable to open ${desc}`$file' for writing: $result"
608 }
609 } else {
610 if {[array exists array]} then {
611 foreach name [lsort [array names array]] {
612 puts $fd "[list $name] [list $array($name)]"
613 }
614 close $fd
615 return 1
616 } else {
617 close $fd
618 }
619 }
620 }
621 return 0
622 }
623
624 ##
625 ## Load data into an array from a file
626 ##
627 ## Args: array, filename, verbose {-1,0,1}, description, ignore regsub
628 ## Returns: 1 if successful,
629 ## 0 otherwise
630 ##
631 proc arrayLoad {arrayName file {verbose 0} {desc "file "} {ignore "^#"}} {
632 upvar 1 $arrayName array
633
634 if {[createFile $file $verbose $desc]} then {
635 if {[catch {set fd [open $file r]} result]} then {
636 if {$verbose >= 0} then {
637 wpLog o * "Error: unable to open ${desc}`$file' for reading: $result"
638 }
639 } else {
640 if {[info exists array]} then {
641 unset array
642 }
643 while {![eof $fd]} {
644 set line [replaceExpr [gets $fd] "^ "]
645 if {([string compare "" $line]) && \
646 (![regexp -- $ignore $line])} then {
647 set array([lindex $line 0]) [lindex $line 1]
648 }
649 }
650 close $fd
651 return 1
652 }
653 }
654 return 0
655 }
656
657 ##
658 ## Set all elements in the given array the the given value
659 ##
660 ## Args: array name, value
661 ## Returns: 1 if the array exists
662 ## 0 otherwise
663 ##
664 proc arraySetAll {arrayName {value ""}} {
665 upvar 1 $arrayName array
666
667 if {[array exists array]} then {
668 foreach name [array names array] {
669 set array($name) $value
670 }
671 return 1
672 }
673 return 0
674 }
675
676 ##
677 ## Find the given element in an array
678 ##
679 ## Args: array name, element name
680 ## Returns: case sensitive element name if found,
681 ## nothing otherwise
682 ##
683 proc arrayFindElementName {array element} {
684 set list [lsort [array names $array]]
685 set index [lsearch -exact [string tolower $list] [string tolower $name]]
686 if {$index != -1} then {
687 return [lindex $list $index]
688 }
689 return
690 }
691
692 ##
693 ## Return length of longest data in an array at index
694 ##
695 ## Args: array name
696 ## Returns: length of longest name in an array
697 ##
698 proc arrayMaxElementDataLength {arrayName index} {
699 upvar 1 $arrayName array
700
701 set maxlength 0
702 foreach {name data} [array get array] {
703 set length [string length [lindex $data $index]]
704 if {$length > $maxlength} then {
705 set maxlength $length
706 }
707 }
708 return $maxlength
709 }
710
711 ##
712 ## Append something to the given list if it is not already in the list
713 ##
714 ## Args: listVar, what
715 ## Returns: list
716 ##
717 proc listAppendIf {listVar {what ""}} {
718 upvar 1 $listVar list
719
720 if {([string compare "" $what]) &&
721 ((![info exists list]) || ([lsearch -exact $list $what] == -1))} then {
722 lappend list $what
723 }
724 return $list
725 }
726
727 ##
728 ## Return length of the longest element in a list
729 ##
730 ## Args: list, index
731 ## Returns: length of longest element in the given list
732 ##
733 proc listMaxElementLength {list {index 0}} {
734 set maxlength 0
735 foreach data $list {
736 set length [string length [lindex $data $index]]
737 if {$length > $maxlength} then {
738 set maxlength $length
739 }
740 }
741 return $maxlength
742 }
743
744 ##
745 ## Split up a list into multiple elements
746 ##
747 ## Args: text, max list length, split char, trim chars
748 ## Returns: split list
749 ##
750 # FIXME: improve this
751 proc splitList {text {splitLength 75} {splitChar " "} {trimChars " "}} {
752 # Sanity check splitLength and splitChar
753 if {($splitLength >= 1) && ([string compare "" $splitChar])} then {
754 set elementSplitLength [expr $splitLength - 1]
755 set stringLength [string length $text] ;# Total length of string
756 set subStringLength 0 ;# Text left over
757 set elementLength 0 ;# Element length counter
758 set elementStartIndex 0 ;# Start of split element
759 set elementEndIndex 0 ;# End of split element
760 for {
761 set stringIndex 0
762 } {$stringIndex < $stringLength} {
763 incr stringIndex
764 } {
765 # If element length greater than/equal to split length,
766 # Or element length equal to split length - 1,
767 # And character at current string index is splitChar
768 if {(($elementLength >= $splitLength) ||
769 ($elementLength == $elementSplitLength)) &&
770 (![string compare $splitChar \
771 [string index $text $stringIndex]])} then {
772 # Split substring element from text
773 set string [string range $text $elementStartIndex $elementEndIndex]
774 # Append substring element list to list
775 lappend list [string trim $string $trimChars]
776 # Reset element length counter
777 set elementLength 0
778 # Start split of next element at the end + 1 of the current one
779 set elementStartIndex [expr $elementEndIndex + 1]
780 # Reset end of next element to the start of the next element
781 set elementEndIndex $elementStartIndex
782 # Track remaining text length
783 set subStringLength [expr $subStringLength + [string length $string]]
784 } else {
785 # Increment element length
786 incr elementLength
787 # Increment end of next element
788 incr elementEndIndex
789 }
790 }
791 # Append any left over text as a new element
792 if {$stringLength > $subStringLength} then {
793 lappend list [string trim [string range $text $subStringLength end] $trimChars]
794 }
795 # Whew...that was alot of work!
796 if {[info exists list]} then {
797 return $list
798 }
799 }
800 return
801 }
802
803 ##
804 ## Expand the given text with a list
805 ##
806 ## Args: text, list, elementIndex, resultVar
807 ## Returns: 0 if text not found
808 ## 1 if text is exactly matched
809 ## 2 if text is matched
810 ## -1 if text is ambiguous
811 ##
812 proc expandText {text list elementIndex resultVar} {
813 upvar 1 $resultVar result
814
815 set found 0
816 set ambiguous 0
817 set lowerText [string tolower $text]
818 foreach listElement $list {
819 set compareElement [lindex $listElement $elementIndex]
820
821 # Exact match
822 if {![string compare $text $compareElement]} then {
823 set result $listElement
824 return 1
825
826 # Partial match
827 } elseif {[string match "$lowerText*" [string tolower $compareElement]]} then {
828 if {!$found} then {
829 set result $listElement
830 set found 1
831 } else {
832 set ambiguous 1
833 }
834 }
835 }
836 if {$ambiguous} then {
837 return -1
838 } elseif {$found} then {
839 return 2
840 }
841 return 0
842 }
843
844 ##
845 ## Search an array for a given word or regexp
846 ##
847 ## Args: array name, word/regexp
848 ## Returns: list of indexes that match the given word/regexp
849 ##
850 proc arraySearch {array word} {
851 set word [string tolower $word]
852 set ret ""
853 foreach {name data} [array get $array] {
854 set string [string tolower $data]
855 if {[lsearch -regexp $string $word] != -1} then {
856 for {
857 set index 0
858 set indexes ""
859 } {
860 if {[regexp -- .*$word $string]} then {
861 lappend indexes $index
862 }
863 } {
864 incr index
865 }
866 lappend ret [list [concat $name $indexes]]
867 }
868 }
869 return $ret
870 }
871
872 ##
873 ## Find option default for the given option name in a data list
874 ##
875 ## Args: data list, option name
876 ## Returns: option default if found,
877 ## nothing otherwise
878 ##
879 proc dataFormatDefault {list option} {
880 foreach i $list {
881 if {![string compare $option [lindex $i 0]]} then {
882 return [lindex $i 1]
883 }
884 }
885 return
886 }
887
888 ##
889 ## Find option value for the given option name in a data list
890 ##
891 ## Args: data format, data list, option name
892 ## Returns: option value if found,
893 ## nothing otherwise
894 ##
895 proc dataFormatValue {format data option} {
896 if {[set index [lsearch -exact $format $option]] != -1} then {
897 return [lindex $data $index]
898 }
899 return
900 }
901
902 ##
903 ## Replace option data in the given data list with a new value
904 ##
905 ## Args: data format, data list, option name, new value
906 ## Returns: data list
907 ##
908 proc dataFormatReplace {format data option value} {
909 if {[set index [lsearch -exact $format $option]] != -1} then {
910 return [lreplace $data $index $index $value]
911 }
912 return $data
913 }
914
915 ##
916 ## Create a data format list for a given data format and options
917 ##
918 ## Args: data format list, defaults, options {{option1 value} ...}
919 ## Returns: data format list with options and values in proper order
920 ##
921 proc dataFormatBuild {format defaults args} {
922 set ret ""
923 foreach arg $args {
924 set [lindex $arg 0] [lindex $arg 1]
925 }
926 foreach opt $format {
927 if {[info exists $opt]} then {
928 lappend ret [set $opt]
929 } else {
930 lappend ret [dataFormatDefault $defaults $opt]
931 }
932 }
933 return $ret
934 }
935
936 ##
937 ## Convert a data list from one format to another
938 ##
939 ## Args: from format, to format, data list
940 ## Returns: data list
941 ##
942 proc dataFormatConvert {fromFormat toFormat data} {
943 set ret ""
944 set index 0
945 foreach opt $fromFormat {
946 set $opt [lindex $data $index]
947 incr index
948 }
949 foreach opt $toFormat {
950 if {[info exists $opt]} then {
951 lappend ret [set $opt]
952 } else {
953 lappend ret [dataFormatDefault $defaults $opt]
954 }
955 }
956 return $ret
957 }
958
959 ##
960 ## Scan the given file for module options
961 ##
962 ## Args: file, args {only scan for these options}
963 ## Returns: list of module options if the given file is a module,
964 ## nothing otherwise
965 ## Errors: unable to open file for reading
966 ##
967 proc scanModule {file args} {
968 variable moduleDatabaseConfig
969 variable moduleDatabaseFormat
970
971 if {[catch {set fd [open $file r]} result]} then {
972 error $result
973 } else {
974 set ret ""
975 if {![string compare "" $args]} then {
976 set baseOptions [lindex $moduleDatabaseFormat([set moduleDatabaseConfig(version)]) 0]
977 set extraOptions [lindex $moduleDatabaseFormat([set moduleDatabaseConfig(version)]) 1]
978 set scanOptions "name $baseOptions"
979 set formatOptions "name $baseOptions $extraOptions"
980 } else {
981 set scanOptions $args
982 set formatOptions $args
983 }
984 for {
985 set lineCount 0
986 set optionCount 0
987 set continuedLine 0
988 } {(![eof $fd]) && ($lineCount <= $moduleDatabaseConfig(scanlines))} {
989 incr lineCount
990 } {
991 gets $fd line
992 if {[regexp -- "^# .*:.*" $line]} then {
993 set opt [string trimright [lindex $line 1] :]
994 if {[lsearch -glob $scanOptions $opt] != -1} then {
995 set data [string trimright [string trimleft [string range $line [string first : $line] end] " \t:"] " \t\\"]
996 if {![info exists $opt]} then {
997 set $opt $data
998 } else {
999 append $opt " $data"
1000 }
1001 }
1002 if {[regexp -- \\\\$ $line]} then {
1003 set continuedLine 1
1004 } else {
1005 set continuedLine 0
1006 }
1007 } elseif {($continuedLine) && ([info exists opt])} then {
1008 append $opt " [string trimright [string trimleft $line " \t#"] " \t\\"]"
1009 if {![regexp -- \\\\$ $line]} then {
1010 set continuedLine 0
1011 }
1012 }
1013 }
1014 close $fd
1015 if {(![string compare "" $args]) && \
1016 ((![info exists name]) || \
1017 ([catch {set md5sum [md5Sum $file]}]))} then {
1018 return
1019 }
1020 foreach option $formatOptions {
1021 if {(![info exists $option]) || \
1022 (![string compare "" [set $option]])} then {
1023 set $option [dataFormatDefault $moduleDatabaseConfig(defaults) $option]
1024 }
1025 lappend ret [set $option]
1026 }
1027 return $ret
1028 }
1029 }
1030
1031 ##
1032 ## Get data from module db data array
1033 ##
1034 ## Args: module name, data type
1035 ## Returns: data for the given module's data type if it exists,
1036 ## nothing otherwise
1037 ##
1038 proc getModuleDatabaseData {module type} {
1039 variable moduleDatabaseConfig
1040 variable moduleDatabaseFormat
1041 variable moduleDatabaseData
1042
1043 if {[moduleExists $module]} then {
1044 set index [lsearch -exact [join $moduleDatabaseFormat([set moduleDatabaseConfig(version)])] $type]
1045 if {$index != -1} then {
1046 return [lindex $moduleDatabaseData($module) $index]
1047 }
1048 }
1049 return
1050 }
1051
1052 ##
1053 ## Set data in module db data array
1054 ##
1055 ## Args: module name, data type, data
1056 ## Returns: 1 if valid module and data type,
1057 ## 0 otherwise
1058 ##
1059 proc setModuleDatabaseData {module type data} {
1060 variable moduleDatabaseConfig
1061 variable moduleDatabaseFormat
1062 variable moduleDatabaseData
1063 variable moduleDatabaseDataChanged
1064
1065 if {[moduleExists $module]} then {
1066 set index [lsearch -exact [join $moduleDatabaseFormat([set moduleDatabaseConfig(version)])] $type]
1067 if {$index != -1} then {
1068 set moduleDatabaseData($module) [lreplace $moduleDatabaseData($module) $index $index [list $data]]
1069 set moduleDatabaseDataChanged 1
1070 return 1
1071 }
1072 }
1073 return 0
1074 }
1075
1076 ##
1077 ## Save module database
1078 ##
1079 ## Args: verbose {-1,0,1}
1080 ## Returns: 1 if successful,
1081 ## 0 otherwise
1082 ##
1083 proc saveModuleDatabase {{verbose 0}} {
1084 variable configData
1085 variable moduleDatabaseConfig
1086 variable moduleDatabaseData
1087 variable moduleDatabaseDataChanged
1088
1089 if {[createFile $configData(moddbfile) $verbose "module database file "]} then {
1090 if {[catch {set fd [open $configData(moddbfile) w]} result]} then {
1091 if {$verbose >= 0} then {
1092 wpLog o * "Error: unable to open module database file `$configData(moddbfile)' for writing: $result"
1093 }
1094 } else {
1095 puts $fd "# $moduleDatabaseConfig(header)$moduleDatabaseConfig(version)"
1096 close $fd
1097 set ret [arraySave moduleDatabaseData $configData(moddbfile) $verbose "module database file " a]
1098 if {$ret} then {
1099 set moduleDatabaseDataChanged 0
1100 }
1101 return $ret
1102 }
1103 }
1104 return 0
1105 }
1106
1107 ##
1108 ## Load module database
1109 ##
1110 ## Args: verbose {-1,0,1}
1111 ## Returns: 1 if successful,
1112 ## 0 otherwise
1113 ##
1114 proc loadModuleDatabase {{verbose 0}} {
1115 variable configData
1116 variable moduleDatabaseConfig
1117 variable moduleDatabaseFormat
1118 variable moduleDatabaseData
1119 variable moduleDatabaseDataChanged
1120
1121 if {![file exists $configData(moddbfile)]} then {
1122 return -1
1123 } else {
1124 if {[catch {set fd [open $configData(moddbfile) r]} result]} then {
1125 if {$verbose >= 0} then {
1126 wpLog o * "Error: unable to open module database file `$configData(moddbfile)' for reading: $result"
1127 }
1128 } else {
1129 set firstline [replaceExpr [gets $fd] "^ "]
1130 if {[regexp -- "^# $moduleDatabaseConfig(header)" $firstline]} then {
1131 regsub -all -- "^# $moduleDatabaseConfig(header)" $firstline "" version
1132 if {![string compare [set version [string trim $version]] $moduleDatabaseConfig(version)]} then {
1133 close $fd
1134 return [arrayLoad moduleDatabaseData $configData(moddbfile) $verbose "module database file "]
1135 } elseif {[info exists moduleDatabaseFormat($version)]} then {
1136 if {[info exists moduleDatabaseData]} then {
1137 unset moduleDatabaseData
1138 }
1139 while {![eof $fd]} {
1140 set line [replaceExpr [gets $fd] "^ "]
1141 if {([string compare "" $line]) && \
1142 (![regexp -- "^#" $line])} then {
1143 set moduleDatabaseData([lindex $line 0]) [dataFormatConvert [join $moduleDatabaseFormat($version)] [join $moduleDatabaseFormat([set moduleDatabaseConfig(version)])] [lindex $line 1]]
1144 }
1145 }
1146 close $fd
1147 set moduleDatabaseDataChanged 0
1148 return 1
1149 } else {
1150 wpLog o * "Error: unknown module database version: $version"
1151 }
1152 } else {
1153 wpLog o * "Error: unknown module database format: [string trimleft $firstline " \t#"]"
1154 }
1155 }
1156 close $fd
1157 }
1158 return 0
1159 }
1160
1161 ##
1162 ## Add a module to the module database
1163 ##
1164 ## Args: file, verbose {-1,0,1}
1165 ## Returns: nothing
1166 ##
1167 proc updateModuleData {file {verbose 0}} {
1168 variable configData
1169 variable moduleDatabaseConfig
1170 variable moduleDatabaseFormat
1171 variable moduleDatabaseData
1172 variable moduleDatabaseDataChanged
1173
1174 if {[catch {set data [scanModule $file]} result]} then {
1175 if {$verbose >= 0} then {
1176 wpLog o * "Warning: unable to open file `[shortFile $file $configData(modulepath)]' for reading: $result"
1177 }
1178 } else {
1179 set name [lindex $data 0]
1180 if {[string compare "" $name]} then {
1181 if {[moduleExists $name]} then {
1182 set loadIndex [lsearch -exact [join $moduleDatabaseFormat([set moduleDatabaseConfig(version)])] load]
1183 set moduleDatabaseData($name) [lreplace [lrange $data 1 end] $loadIndex $loadIndex [lindex $moduleDatabaseData($name) $loadIndex]]
1184 } else {
1185 set moduleDatabaseData($name) [lrange $data 1 end]
1186 }
1187 set moduleDatabaseDataChanged 1
1188 }
1189 }
1190 return
1191 }
1192
1193 ##
1194 ## Update module database
1195 ##
1196 ## Args: verbose {-1,0,1}
1197 ## Returns: nothing
1198 ##
1199 proc updateModuleDatabase {{verbose 0}} {
1200 variable configData
1201 variable moduleDatabaseConfig
1202 variable moduleDatabaseData
1203 variable moduleDatabaseDataChanged
1204
1205 set moduleList [listModules]
1206
1207 set foundFiles "" ;# List of all '.tcl' files in module path
1208 set moduleFiles "" ;# List of module files
1209
1210 # Build up file list
1211 foreach dir $configData(modulepath) {
1212 foreach file [findFiles $dir $moduleDatabaseConfig(maxdepth) .tcl] {
1213 lappend foundFiles $file
1214 }
1215 }
1216
1217 # Find removed files
1218 foreach module $moduleList {
1219 set file [getModuleDatabaseData $module file]
1220
1221 if {[lsearch -exact $foundFiles $file] == -1} then {
1222 if {$verbose >= 1} then {
1223 wpLog o * "Removing module data for unknown module `$module'"
1224 }
1225 unset moduleDatabaseData($module)
1226 set moduleDatabaseDataChanged 1
1227 } else {
1228
1229 # Compare existing valid modules
1230 if {$verbose >= 1} then {
1231 set shortfile [shortFile $file $configData(modulepath)]
1232 wpLog o * "Comparing file `$shortfile'"
1233 }
1234
1235 # Compare md5 from module db and sure the module hasn't changed
1236 if {([catch {set md5sum [md5Sum $file]}]) || \
1237 ([string compare [getModuleDatabaseData $module md5sum] $md5sum])} then {
1238 if {$verbose >= 1} then {
1239 wpLog o * "Updating module information for file `$shortfile'"
1240 }
1241 updateModuleData $file $verbose
1242 } else {
1243 lappend moduleFiles $file
1244 }
1245 }
1246 }
1247
1248 # Find new files
1249 foreach file $foundFiles {
1250 if {[lsearch -exact $moduleFiles $file] == -1} then {
1251 if {$verbose >= 1} then {
1252 wpLog o * "Adding module information for file `[shortFile $file $configData(modulepath)]'"
1253 }
1254 updateModuleData $file $verbose
1255 }
1256 }
1257 return
1258 }
1259
1260 ##
1261 ## Rebuild module database
1262 ##
1263 ## Args: verbose {-1,0,1}
1264 ## Returns: nothing
1265 ##
1266 proc rebuildModuleDatabase {{verbose 0}} {
1267 variable configData
1268 variable moduleDatabaseConfig
1269 variable moduleDatabaseFormat
1270 variable moduleDatabaseData
1271
1272 # Copy database data for later use
1273 if {[info exists moduleDatabaseData]} then {
1274 set mergeLoad 1
1275 array set moduleDatabaseDataTmp [array get moduleDatabaseData]
1276 unset moduleDatabaseData
1277 } else {
1278 set mergeLoad 0
1279 }
1280
1281 foreach dir $configData(modulepath) {
1282 foreach file [findFiles $dir $moduleDatabaseConfig(maxdepth) .tcl] {
1283 if {$verbose >= 1} then {
1284 wpLog o * "Scanning file `[shortFile $file $configData(modulepath)]'"
1285 }
1286 updateModuleData $file $verbose
1287 }
1288 }
1289
1290 # Merge load data into new database
1291 if {$mergeLoad} then {
1292 set loadIndex [lsearch -exact [join $moduleDatabaseFormat([set moduleDatabaseConfig(version)])] load]
1293
1294 foreach module [listModules] {
1295 set moduleDatabaseData($module) [lreplace $moduleDatabaseData($module) $loadIndex $loadIndex [lindex $moduleDatabaseDataTmp($module) $loadIndex]]
1296 }
1297 # Note: Not modifying moduleDatabaseDataChanged here, since
1298 # 'updateModuleData' will have already done so.
1299 }
1300 return
1301 }
1302
1303 ##
1304 ## List all modules in the database
1305 ##
1306 ## Args: none
1307 ## Returns: list of modules in module database
1308 ##
1309 proc listModules {{loaded 0}} {
1310 variable moduleDatabaseData
1311 variable moduleLoadedList
1312
1313 if {$loaded} then {
1314 return [lsort $moduleLoadedList]
1315 }
1316 return [lsort [array names moduleDatabaseData]]
1317 }
1318
1319 ##
1320 ## Check if the given module exists
1321 ##
1322 ## Args: module name
1323 ## Returns: 1 if the given module exists
1324 ## 0 otherwise
1325 ##
1326 proc moduleExists {module} {
1327 variable moduleDatabaseData
1328
1329 if {[info exists moduleDatabaseData($module)]} then {
1330 return 1
1331 }
1332 return 0
1333 }
1334
1335 ##
1336 ## Check if a module is loaded
1337 ##
1338 ## Args: module name
1339 ## Returns: 1 if the given module is loaded
1340 ## 0 otherwise
1341 ##
1342 proc moduleLoaded {module} {
1343 variable moduleLoadedList
1344
1345 if {[lsearch -exact $moduleLoadedList $module] != -1} then {
1346 return 1
1347 }
1348 return 0
1349 }
1350
1351 ##
1352 ## Add/remove bindings for a given module
1353 ##
1354 ## Args: mode {bind|unbind}, module,
1355 ## args {{type ...} {option ...} {cmdsub ...} {regsub ...}}
1356 ## Returns: nothing
1357 ##
1358 ## Important variables:
1359 ## argTypes "dcc msg pub ..."
1360 ## argOptions "noauto cmdchr ..."
1361 ## argCmdsub(regexp) "command"
1362 ## argRegsub(regexp) "with"
1363 ## optCmdsub(regexp) "command"
1364 ## optRegsub(regexp) "with"
1365 ##
1366 proc moduleBindUnbind {mode module args} {
1367 variable NamespaceCurrent
1368
1369 if {[info exists ${NamespaceCurrent}::${module}::bindDefaults]} then {
1370 # These are for use in calling this proc directly.
1371 # bindDefaults options are further below
1372 set argTypes ""
1373 set argOptions ""
1374 foreach arg $args {
1375 switch -exact -- [lindex $arg 0] {
1376 type {
1377 # Specific types to match against
1378 # dcc msg pub ...
1379 set argTypes [lrange $arg 1 end]
1380 }
1381 option {
1382 # Specific options to match against
1383 # noauto cmdchr ...
1384 set argOptions [lrange $arg 1 end]
1385 }
1386 cmdsub {
1387 # Replace 'regexp' with result of 'command'
1388 # NOTE: 'command' will eventually be processed in calling stack
1389 foreach {command regexp} [lindex $arg 1] {break}
1390 # FIXME: better fix for leading '+/$'
1391 regsub -- "\[\\+|\\$\]" $regexp "\\\\&" regexp
1392 # FIXME: can't do this:
1393 #regsub -- {([][\\\*\+\?\{\}\,\(\)\:\.\^\$\=\!\|])} $regexp {\\\1} regexp
1394 # Try to find 'command' in 'module' namespace
1395 if {[string compare "" [info commands ${NamespaceCurrent}::${module}::[lindex $command 0]]]} then {
1396 # Command is module specific or imported
1397 set argCmdsub($regexp) ${NamespaceCurrent}::${module}::$command
1398 } else {
1399 # Must be a global command
1400 set argCmdsub($regexp) $command
1401 }
1402 }
1403 regsub {
1404 # Replace regexp 'rwhat' with 'rwith'
1405 foreach {rwhat rwith} [lindex $arg 1] {break}
1406 # FIXME: better fix for leading '+/$'
1407 regsub -- "\[\\+|\\$\]" $rwhat "\\\\&" rwhat
1408 set argRegsub($rwhat) $rwith
1409 }
1410 }
1411 }
1412 foreach {proc data} [array get ${NamespaceCurrent}::${module}::bindDefaults] {
1413 foreach bind $data {
1414 foreach {type flags mask options help} $bind {break}
1415 # Continue if a specific bind type is requested and not matched
1416 if {([string compare "" $argTypes]) && \
1417 ([lsearch -exact $argTypes $type] == -1)} then {
1418 continue
1419 }
1420 # Sanity check!
1421 # Continue if argOptions specified and bind options don't exist
1422 if {([string compare "" $argOptions]) && \
1423 (![string compare "" $options])} then {
1424 continue
1425 }
1426 # These _must_ be clean since they are reused for multiple binds
1427 set continue 0
1428 if {[info exists optCmdsub]} then {
1429 unset optCmdsub
1430 }
1431 if {[info exists optRegsub]} then {
1432 unset optRegsub
1433 }
1434 # Process bind specific options
1435 foreach option $options {
1436 set optcmd [lindex $option 0]
1437 # Search 'argOptions' for 'optcmd'
1438 # Abort bind and continue with next if not found
1439 if {[string compare "" $argOptions]} then {
1440 set found 0
1441 foreach argoption $argOptions {
1442 if {![string compare $optcmd [lindex $argoption 0]]} then {
1443 set found 1
1444 }
1445 }
1446 if {!$found} then {
1447 set continue 1
1448 break
1449 }
1450 }
1451 switch -exact -- $optcmd {
1452 noauto {
1453 # Search for noauto override in argOptions
1454 if {[lsearch -exact $argOptions noauto] == -1} then {
1455 # noauto matched and not overriden
1456 set continue 1
1457 break
1458 }
1459 }
1460 cmdsub {
1461 # Replace 'regexp' with result of 'command'
1462 # NOTE: 'command' will eventually be processed in calling stack
1463 foreach {command regexp} [lindex $option 1] {break}
1464 # FIXME: better fix for leading '+/$'
1465 regsub -- "\[\\+|\\$\]" $regexp "\\\\&" regexp
1466 # Try to find 'command' in 'module' namespace
1467 if {[string compare "" [info commands ${NamespaceCurrent}::${module}::[lindex $command 0]]]} then {
1468 # Command is module specific or imported
1469 set optCmdsub($regexp) ${NamespaceCurrent}::${module}::$command
1470 } else {
1471 # Must be a global command
1472 set optCmdsub($regexp) $command
1473 }
1474 }
1475 regsub {
1476 # Replace regexp 'rwhat' with 'rwith'
1477 foreach {rwhat rwith} [lindex $option 1] {break}
1478 # FIXME: better fix for leading '+/$'
1479 regsub -- "\[\\+|\\$\]" $rwhat "\\\\&" rwhat
1480 set optRegsub($rwhat) $rwith
1481 }
1482 }
1483 }
1484 # Abort this bind and continue with the next
1485 if {$continue} then {
1486 continue
1487 }
1488 # Make optCmdsub regexp substitutions on mask
1489 if {[array exists optCmdsub]} then {
1490 foreach {regexp command} [array get optCmdsub] {
1491 # Process 'command' in calling stack
1492 regsub -all -- $regexp $mask [uplevel 1 $command] mask
1493 }
1494 }
1495 # Make optRegsub regexp substitutions on mask
1496 if {[array exists optRegsub]} then {
1497 foreach {replacewhat replacewith} [array get optRegsub] {
1498 regsub -all -- $replacewhat $mask $replacewith mask
1499 }
1500 }
1501 # Make argCmdsub regexp substitutions on mask
1502 if {[array exists argCmdsub]} then {
1503 foreach {regexp command} [array get argCmdsub] {
1504 # Process 'command' in calling stack
1505 regsub -all -- $regexp $mask [uplevel 1 $command] mask
1506 }
1507 }
1508 # Make argRegsub regexp substitutions on mask
1509 if {[array exists argRegsub]} then {
1510 foreach {replacewhat replacewith} [array get argRegsub] {
1511 regsub -all -- $replacewhat $mask $replacewith mask
1512 }
1513 }
1514 # Finally! bind/unbind
1515 if {[catch {
1516 $mode $type $flags $mask ${NamespaceCurrent}::${module}::$proc
1517 } result]} then {
1518 wpLog d * "Error: ${mode}ing $type for $mask: $result"
1519 }
1520 }
1521 }
1522 }
1523 return
1524 }
1525
1526 ##
1527 ## Load a module
1528 ##
1529 ## Args: module name, verbose {-1,0,1}, args {loop detection}
1530 ## Returns: nothing
1531 ## Errors: if unable to load module
1532 ##
1533 proc moduleLoad {module {verbose 0} args} {
1534 variable NamespaceCurrent
1535 variable moduleLoadedList
1536
1537 if {[lsearch -exact [set loop [lindex $args 0]] $module] == -1} then {
1538 if {[moduleExists $module]} then {
1539 set preload ""
1540 set requires [getModuleDatabaseData $module requires]
1541 foreach required $requires {
1542 set preloadModule [whichModuleCommand $required]
1543 if {[string compare "" $preloadModule]} then {
1544 if {([lsearch -exact $preload $preloadModule] == -1) && \
1545 ([string compare wp $preloadModule]) && \
1546 (![moduleLoaded $preloadModule])} then {
1547 lappend preload $preloadModule
1548 }
1549 } else {
1550 error "required command `$required' not found."
1551 }
1552 }
1553 if {[string compare "" $preload]} then {
1554 foreach premod $preload {
1555 if {[catch {moduleLoad $premod $verbose [concat $loop $module]} result]} then {
1556 error $result
1557 }
1558 }
1559 }
1560 if {[catch {source [getModuleDatabaseData $module file]} result]} then {
1561 error $result
1562 } else {
1563 package forget $module
1564 package provide ${NamespaceCurrent}::${module} [getModuleDatabaseData $module version]
1565 moduleConfigLoad $module 1
1566 moduleConfigCheckdefs $module 1
1567 moduleDataLoad $module 1
1568 # Imported commands '# requires: ...'
1569 if {[string compare "" $requires]} then {
1570 set namespaceScript "namespace eval ${NamespaceCurrent}::${module} \{\n namespace forget *\n namespace import"
1571 foreach required $requires {
1572 if {[string compare "" [set command [whichCommand $required]]]} then {
1573 append namespaceScript " $command"
1574 }
1575 }
1576 append namespaceScript "\n\}"
1577 eval $namespaceScript
1578 }
1579 # Exported commands '# provides: ...'
1580 if {[string compare "" [set provides [getModuleDatabaseData $module provides]]]} then {
1581 set namespaceScript "namespace eval ${NamespaceCurrent}::${module} \{\n namespace export"
1582 foreach provided $provides {
1583 append namespaceScript " $provided"
1584 }
1585 append namespaceScript "\n\}"
1586 eval $namespaceScript
1587 }
1588 if {[string compare "" [info commands ${NamespaceCurrent}::${module}::ModuleInit]]} then {
1589 ${NamespaceCurrent}::${module}::ModuleInit
1590 }
1591 # FIXME: check for bindings? duplicates?
1592 moduleBindUnbind bind $module
1593 if {![getModuleDatabaseData $module load]} then {
1594 setModuleDatabaseData $module load 1
1595 }
1596 if {[lsearch -exact $moduleLoadedList $module] == -1} then {
1597 lappend moduleLoadedList $module
1598 if {$verbose >= 1} then {
1599 wpLog o * "Module loaded: $module"
1600 }
1601 }
1602 }
1603 } else {
1604 error "No such module: $module"
1605 }
1606 } else {
1607 regsub -all -- " " $loop " -> " loop
1608 error "Preload endless loop: $loop -> $module"
1609 }
1610 return
1611 }
1612
1613 ##
1614 ## Unload a module
1615 ##
1616 ## Args: module name, verbose {-1,0,1}
1617 ## Returns: nothing
1618 ## Errors: if unable to completely unload module
1619 ##
1620 proc moduleUnload {module {verbose 0}} {
1621 variable NamespaceCurrent
1622 variable moduleLoadedList
1623
1624 # FIXME: handle dependant modules and modules that can't be unloaded
1625 if {[moduleExists $module]} then {
1626 if {[string compare "" [info commands ${NamespaceCurrent}::${module}::ModuleDestroy]]} then {
1627 ${NamespaceCurrent}::${module}::ModuleDestroy
1628 }
1629 # FIXME: check for bindings?
1630 moduleBindUnbind unbind $module
1631 moduleConfigSave $module 1
1632 moduleDataSave $module 1
1633
1634 # FIXME: we should kill off stale timer/utimers here somewhere before unloading
1635
1636 if {[catch {namespace delete ${NamespaceCurrent}::${module}} result]} then {
1637 error $result
1638 } else {
1639 package forget ${NamespaceCurrent}::${module}
1640 if {[getModuleDatabaseData $module load] == 1} then {
1641 setModuleDatabaseData $module load 0
1642 }
1643 set index [lsearch -exact $moduleLoadedList $module]
1644 if {$index != -1} then {
1645 set moduleLoadedList [lreplace $moduleLoadedList $index $index]
1646 if {$verbose >= 1} then {
1647 wpLog o * "Module unloaded: $module"
1648 }
1649 }
1650 }
1651 } else {
1652 error "No such module: $module"
1653 }
1654 return
1655 }
1656
1657 ##
1658 ## Save configuration settings for the given module
1659 ##
1660 ## Args: module, force {0,1}, verbose {-1,0,1}
1661 ## Returns: 1 if settings saved
1662 ## 0 otherwise
1663 ##
1664 proc moduleConfigSave {module {force 0} {verbose 0}} {
1665 variable NamespaceCurrent
1666 variable configData
1667
1668 if {([string compare "" \
1669 [set file [getModuleDatabaseData $module config]]]) && \
1670 ([createDir $configData(configpath)])} then {
1671 set cfgfile [file join $configData(configpath) $file]
1672 if {([getModuleDatabaseData $module load]) && \
1673 (($force) || \
1674 (![info exists ${NamespaceCurrent}::${module}::configDataChanged]) || \
1675 ([set ${NamespaceCurrent}::${module}::configDataChanged]))} then {
1676 if {[arraySave ${NamespaceCurrent}::${module}::configData $cfgfile 0 "$module configuration file "]} then {
1677 if {$verbose >= 1} then {
1678 wpLog o * "Writing $module config file..."
1679 }
1680 set ${NamespaceCurrent}::${module}::configDataChanged 0
1681 return 1
1682 } elseif {$verbose >= 0} then {
1683 wpLog o * "Error writing $module config file."
1684 }
1685 }
1686 }
1687 return 0
1688 }
1689
1690 ##
1691 ## Load configuration settings for the given module
1692 ##
1693 ## Args: module, force {0,1}, verbose {-1,0,1}
1694 ## Returns: 1 if settings loaded
1695 ## 0 otherwise
1696 ##
1697 proc moduleConfigLoad {module {force 0} {verbose 0}} {
1698 variable NamespaceCurrent
1699 variable configData
1700
1701 if {([string compare "" \
1702 [set file [getModuleDatabaseData $module config]]]) && \
1703 ([createDir $configData(configpath)])} then {
1704 set cfgfile [file join $configData(configpath) $file]
1705 if {($force) || \
1706 (![info exists ${NamespaceCurrent}::${module}::configDataChanged]) || \
1707 (![set ${NamespaceCurrent}::${module}::configDataChanged])} then {
1708 if {[arrayLoad ${NamespaceCurrent}::${module}::configData $cfgfile 0 "$module configuration file "]} then {
1709 if {$verbose >= 1} then {
1710 wpLog o * "Loading $module config file..."
1711 }
1712 set ${NamespaceCurrent}::${module}::configDataChanged 0
1713 return 1
1714 } elseif {$verbose >= 0} then {
1715 wpLog o * "Error loading $module config file."
1716 }
1717 }
1718 }
1719 return 0
1720 }
1721
1722 ##
1723 ## Check and set default configuration settings for the given module
1724 ##
1725 ## Args: module, force {0,1}, verbose {-1,0,1}
1726 ## Returns: nothing
1727 ##
1728 proc moduleConfigCheckdefs {module {force 0} {verbose 0}} {
1729 variable NamespaceCurrent
1730
1731 if {([array exists ${NamespaceCurrent}::${module}::configDefaults]) && \
1732 ([string compare "" [getModuleDatabaseData $module config]])} then {
1733 set Changed 0
1734 # Unset unknown variables
1735 foreach name [array names ${NamespaceCurrent}::${module}::configData] {
1736 if {![info exists ${NamespaceCurrent}::${module}::configDefaults($name)]} then {
1737 unset ${NamespaceCurrent}::${module}::configData($name)
1738 set Changed 1
1739 }
1740 }
1741 # Set missing variables to defaults
1742 foreach {name data} [array get ${NamespaceCurrent}::${module}::configDefaults] {
1743 if {![info exists ${NamespaceCurrent}::${module}::configData($name)]} then {
1744 set ${NamespaceCurrent}::${module}::configData($name) [lindex $data 1]
1745 set Changed 1
1746 }
1747 }
1748 # FIXME: do this with a trace?
1749 if {$Changed} then {
1750 set ${NamespaceCurrent}::${module}::configDataChanged 1
1751 }
1752 }
1753 return
1754 }
1755
1756 ##
1757 ## Handle config data for a list of modules
1758 ##
1759 ## Args: action {load|save|checkdefs}, module list, force {0,1},
1760 ## verbose {-1,0,1}
1761 ## Returns: nothing
1762 ##
1763 proc moduleConfig {action modules {force 0} {verbose 0}} {
1764 if {![string compare * $modules]} then {
1765 set modules [listModules 1]
1766 }
1767 switch -exact -- $action {
1768 save {
1769 foreach module $modules {
1770 if {([moduleExists $module]) && ([moduleLoaded $module])} then {
1771 moduleConfigSave $module $force $verbose
1772 }
1773 }
1774 }
1775 load {
1776 foreach module $modules {
1777 if {([moduleExists $module]) && ([moduleLoaded $module])} then {
1778 moduleConfigLoad $module $force $verbose
1779 }
1780 }
1781 }
1782 checkdefs {
1783 foreach module $modules {
1784 if {([moduleExists $module]) && ([moduleLoaded $module])} then {
1785 moduleConfigCheckdefs $module $force $verbose
1786 }
1787 }
1788 }
1789 }
1790 return
1791 }
1792
1793 ##
1794 ## Save data for the given module
1795 ##
1796 ## Args: module, force {0,1}, verbose {-1,0,1}
1797 ## Returns: nothing
1798 ##
1799 proc moduleDataSave {module {force 0} {verbose 0}} {
1800 variable NamespaceCurrent
1801 variable configData
1802
1803 if {([info exists ${NamespaceCurrent}::${module}::dataOptions]) && \
1804 ([createDir $configData(datapath)])} then {
1805 foreach {name data} [array get ${NamespaceCurrent}::${module}::dataOptions] {
1806 foreach {type file desc} $data {break}
1807 if {([info exists type]) && ([info exists file]) && \
1808 ([info exists desc])} then {
1809 set Changed ${NamespaceCurrent}::${module}::${name}Changed
1810 if {($force) || ((![info exists $Changed]) || ([set $Changed]))} then {
1811 if {[${type}Save ${NamespaceCurrent}::${module}::$name [file join $configData(datapath) $file]]} then {
1812 if {$verbose >= 1} then {
1813 wpLog o * $NamespaceCurrent "Writing $desc data file..."
1814 }
1815 set $Changed 0
1816 } elseif {$verbose >= 0} then {
1817 wpLog o * $NamespaceCurrent "Error writing $desc data file!"
1818 }
1819 }
1820 }
1821 }
1822 }
1823 return
1824 }
1825
1826 ##
1827 ## Load data for the given module
1828 ##
1829 ## Args: module, force {0,1}, verbose {-1,0,1}
1830 ## Returns: nothing
1831 ##
1832 proc moduleDataLoad {module {force 0} {verbose 0}} {
1833 variable NamespaceCurrent
1834 variable configData
1835
1836 if {([info exists ${NamespaceCurrent}::${module}::dataOptions]) && \
1837 ([createDir $configData(datapath)])} then {
1838 foreach {name data} [array get ${NamespaceCurrent}::${module}::dataOptions] {
1839 foreach {type file desc} $data {break}
1840 if {([info exists type]) && ([info exists file]) && \
1841 ([info exists desc])} then {
1842 set Changed ${NamespaceCurrent}::${module}::${name}Changed
1843 if {($force) || ((![info exists $Changed]) || ([set $Changed]))} then {
1844 if {[${type}Load ${NamespaceCurrent}::${module}::$name [file join $configData(datapath) $file]]} then {
1845 if {$verbose >= 1} then {
1846 wpLog o * $NamespaceCurrent "Reloading $desc data file..."
1847 }
1848 set $Changed 0
1849 } elseif {$verbose >= 0} then {
1850 wpLog o * $NamespaceCurrent "Error reloading $desc data file!"
1851 }
1852 }
1853 }
1854 }
1855 }
1856 return
1857 }
1858
1859 ##
1860 ## Backup data for the given module
1861 ##
1862 ## Args: module, force {0,1}, verbose {-1,0,1}
1863 ## Returns: nothing
1864 ##
1865 proc moduleDataBackup {module {force 0} {verbose 0}} {
1866 variable NamespaceCurrent
1867 variable configData
1868
1869 if {([info exists ${NamespaceCurrent}::${module}::dataOptions]) && \
1870 ([createDir $configData(datapath)])} then {
1871 foreach {name data} [array get ${NamespaceCurrent}::${module}::dataOptions] {
1872 foreach {type file desc} $data {break}
1873 if {([info exists type]) && ([info exists file]) && \
1874 ([info exists desc])} then {
1875 if {[set result [backupFile [file join $configData(datapath) $file] $verbose]]} then {
1876 if {($result >= 1) && ($verbose >= 1)} then {
1877 wpLog o * $NamespaceCurrent "Backing up $desc data file..."
1878 }
1879 } elseif {$verbose >= 0} then {
1880 wpLog o * $NamespaceCurrent "Error backing up $desc data file!"
1881 }
1882 }
1883 }
1884 }
1885 return
1886 }
1887
1888 ##
1889 ## Handle data for a list of modules
1890 ##
1891 ## Args: action {load|save|backup}, module list, force {0,1},
1892 ## verbose {-1,0,1}
1893 ## Returns: nothing
1894 ##
1895 proc moduleData {action modules {force 0} {verbose 0}} {
1896 if {![string compare * $modules]} then {
1897 set modules [listModules 1]
1898 }
1899 switch -exact -- $action {
1900 save {
1901 foreach module $modules {
1902 if {([moduleExists $module]) && ([moduleLoaded $module])} then {
1903 moduleDataSave $module $force $verbose
1904 }
1905 }
1906 }
1907 load {
1908 foreach module $modules {
1909 if {([moduleExists $module]) && ([moduleLoaded $module])} then {
1910 moduleDataLoad $module $force $verbose
1911 }
1912 }
1913 }
1914 backup {
1915 foreach module $modules {
1916 if {([moduleExists $module]) && ([moduleLoaded $module])} then {
1917 moduleDataBackup $module $force $verbose
1918 }
1919 }
1920 }
1921 }
1922 return
1923 }
1924
1925 ##
1926 ## Builds command matching table from module database
1927 ##
1928 ## Args: none
1929 ## Returns: nothing
1930 ##
1931 proc buildCommandTable {{verbose 0}} {
1932 variable NamespaceCurrent
1933 variable ExportList
1934 variable commandTable
1935
1936 foreach command $ExportList {
1937 if {![info exists tmp($command)]} then {
1938 if {$verbose >= 2} then {
1939 wpLog o * "Adding command: `$command' as `${NamespaceCurrent}::$command'"
1940 }
1941 set tmp($command) ${NamespaceCurrent}::$command
1942 } elseif {$verbose >= 0} then {
1943 wpLog o * "Warning: ignoring duplicate command `$command', conflicts with `$tmp($command)'"
1944 }
1945 }
1946 foreach module [listModules] {
1947 if {[string compare "" [set provides [getModuleDatabaseData $module provides]]]} then {
1948 foreach command $provides {
1949 if {![info exists tmp($command)]} then {
1950 if {$verbose >= 2} then {
1951 wpLog o * "Adding command: `$command' as `${NamespaceCurrent}::${module}::$command'"
1952 }
1953 set tmp($command) ${NamespaceCurrent}::${module}::$command
1954 } elseif {$verbose >= 0} then {
1955 wpLog o * "Warning: ignoring duplicate command `$command', conflicts with `$tmp($command)'"
1956 }
1957 }
1958 }
1959 }
1960 if {[info exists commandTable]} then {
1961 unset commandTable
1962 }
1963 array set commandTable [array get tmp]
1964 return
1965 }
1966
1967 ##
1968 ## Return full namespace path for the given command
1969 ##
1970 ## Args: command
1971 ## Returns: full namespace path for the given command if it exists
1972 ## nothing otherwise
1973 ##
1974 proc whichCommand {command} {
1975 variable commandTable
1976
1977 if {[info exists commandTable($command)]} then {
1978 return $commandTable($command)
1979 }
1980 return
1981 }
1982
1983 ##
1984 ## Return full namespace path for the given module
1985 ##
1986 ## Args: module
1987 ## Returns: full namespace path for the given module if it's loaded
1988 ## nothing otherwise
1989 ##
1990 proc whichModule {module} {
1991 variable NamespaceCurrent
1992
1993 if {![string compare $module [namespace tail $NamespaceCurrent] $module]} then {
1994 return $NamespaceCurrent
1995 } elseif {[moduleLoaded $module]} then {
1996 return ${NamespaceCurrent}::$module
1997 }
1998 return
1999 }
2000
2001 ##
2002 ## Return module name that provides the given command
2003 ##
2004 ## Args: command
2005 ## Returns: name of module that provides the given command
2006 ## nothing otherwise
2007 ##
2008 proc whichModuleCommand {command} {
2009 variable NamespaceCurrent
2010 variable commandTable
2011
2012 if {[info exists commandTable($command)]} then {
2013 if {![string compare ${NamespaceCurrent}::$command \
2014 $commandTable($command)]} then {
2015 return [namespace tail $NamespaceCurrent]
2016 }
2017 return [namespace tail [namespace qualifiers $commandTable($command)]]
2018 }
2019 return
2020 }
2021
2022 ##
2023 ## Check if the given [module] config option exists
2024 ##
2025 ## Args: module, option
2026 ## Returns: 1 if the given module config option exists
2027 ##
2028 proc configExists {module {option ""}} {
2029 variable NamespaceCurrent
2030 variable configData
2031
2032 if {[string compare "" $module]} then {
2033 set where "${NamespaceCurrent}::${module}::"
2034 } else {
2035 set where ""
2036 }
2037 if {[string compare "" $option]} then {
2038 if {[info exists ${where}configData($option)]} then {
2039 return 1
2040 }
2041 } elseif {[info exists ${where}configData]} then {
2042 return 1
2043 }
2044 return 0
2045 }
2046
2047 ##
2048 ## Compare the given version to eggdrop's version
2049 ##
2050 ## Args: version
2051 ## Returns: 0 if eggdrop's version is older then the given version
2052 ## 1 if eggdrop's version matches the given version
2053 ## 2 if eggdrop's version is newer then the given version
2054 ## -1 if the given version is invalid
2055 ##
2056 proc compareVersion {version} {
2057 global numversion
2058
2059 if {([string compare "" $version]) && \
2060 ([info exists numversion])} then {
2061 if {[regexp -- \\. $version]} then {
2062 regsub -all -- \\. $version 0 version
2063 set version ${version}00
2064 }
2065 if {[regexp -- \[^0-9\] $version]} then {
2066 return -1
2067 } elseif {$numversion == $version} then {
2068 return 1
2069 } elseif {$numversion > $version} then {
2070 return 2
2071 }
2072 }
2073 return 0
2074 }
2075
2076 ##
2077 ## Log module information
2078 ##
2079 ## Args: level, channel, args ({<namespace>} {<text>} | {<text>})
2080 ## Returns: nothing
2081 ##
2082 proc wpLog {level channel args} {
2083 if {[llength $args] == 2} then {
2084 if {[string compare wp [set namespace [namespace tail [lindex $args 0]]]]} then {
2085 putloglev $level $channel "Wolfpack: \[$namespace\] [lindex $args 1]"
2086 } else {
2087 putloglev $level $channel "Wolfpack: [lindex $args 1]"
2088 }
2089 } else {
2090 putloglev $level $channel "Wolfpack: [join $args]"
2091 }
2092 return
2093 }
2094
2095 ##
2096 ## Evaluate command line arguments
2097 ##
2098 ## Args: none
2099 ## Returns: nothing
2100 ##
2101 proc EvalArgs {argc argv argv0} {
2102 variable NamespaceCurrent
2103 variable optionData
2104
2105 for {set index 0} {$index < $argc} {incr index} {
2106 set option [lindex $argv $index]
2107 set nextoption [lindex $argv [expr $index + 1]]
2108
2109 switch -regexp -- $option {
2110 (^--$) {
2111 break
2112 }
2113 (^--cfgfile$) {
2114 if {([string compare "" $nextoption]) && \
2115 (![regexp -- - $nextoption])} then {
2116 set optionData(cfgfile) $nextoption
2117 incr index
2118 } else {
2119 listAppendIf noparms "--cfgfile"
2120 }
2121 }
2122 (^--config$) {
2123 set optionData(config) 1
2124 }
2125 (^--update$) {
2126 set optionData(update) 1
2127 }
2128 (^--noupdate$) {
2129 set optionData(noupdate) 1
2130 }
2131 (^--rebuild$) {
2132 set optionData(rebuild) 1
2133 }
2134 (^--time$) {
2135 set optionData(time) 1
2136 }
2137 (^--include$) {
2138 if {([string compare "" $nextoption]) && \
2139 (![regexp -- - $nextoption])} then {
2140 lappend optionData(include) $nextoption
2141 incr index
2142 } else {
2143 listAppendIf noparms "--include"
2144 }
2145 }
2146 (^--exclude$) {
2147 if {([string compare "" $nextoption]) && \
2148 (![regexp -- - $nextoption])} then {
2149 lappend optionData(exclude) $nextoption
2150 incr index
2151 } else {
2152 listAppendIf noparms "--exclude"
2153 }
2154 }
2155 (^--module$) {
2156 if {([string compare "" $nextoption]) && \
2157 (![regexp -- - $nextoption])} then {
2158 set optionData(module) $nextoption
2159 incr index
2160 } else {
2161 listAppendIf noparms "--module"
2162 }
2163 }
2164 (^--verbose$) {
2165 incr optionData(verbose)
2166 }
2167 (^--quiet$) {
2168 incr optionData(quiet) -1
2169 }
2170 (^--debug$) {
2171 set optionData(debug) 1
2172 }
2173 (^--help$) {
2174 ShowUsage $argv0
2175 exit
2176 }
2177 (^--version$) {
2178 puts "[file tail $argv0] version [package require ${NamespaceCurrent}]"
2179 exit
2180 }
2181 (^-\[^-\]*$) {
2182 set suboptions [split $option ""]
2183 set sublength [llength [split $suboptions]]
2184 for {set subindex 0} {$subindex < $sublength} {incr subindex} {
2185 set suboption [lindex $suboptions $subindex]
2186 switch -exact -- $suboption {
2187 - {
2188 continue
2189 }
2190 f {
2191 # Next arg in argv should be a filename: '-f filename.conf',
2192 # so break out of the suboption loop after this option
2193 if {([string compare "" $nextoption]) && \
2194 (![regexp -- - $nextoption])} then {
2195 set optionData(cfgfile) $nextoption
2196 incr index
2197 break
2198 } else {
2199 listAppendIf noparms "-f"
2200 }
2201 }
2202 c {
2203 set optionData(config) 1
2204 }
2205 u {
2206 set optionData(update) 1
2207 }
2208 n {
2209 set optionData(noupdate) 1
2210 }
2211 r {
2212 set optionData(rebuild) 1
2213 }
2214 t {
2215 set optionData(time) 1
2216 }
2217 i {
2218 # Next arg in argv should be a module: '-i module',
2219 # so break out of the suboption loop after this option
2220 if {([string compare "" $nextoption]) && \
2221 (![regexp -- - $nextoption])} then {
2222 lappend optionData(include) $nextoption
2223 incr index
2224 break
2225 } else {
2226 listAppendIf noparms "-i"
2227 }
2228 }
2229 e {
2230 # Next arg in argv should be a module: '-e module',
2231 # so break out of the suboption loop after this option
2232 if {([string compare "" $nextoption]) && \
2233 (![regexp -- - $nextoption])} then {
2234 lappend optionData(exclude) $nextoption
2235 incr index
2236 break
2237 } else {
2238 listAppendIf noparms "-e"
2239 }
2240 }
2241 m {
2242 # Next arg in argv should be a module: '-m module',
2243 # so break out of the suboption loop after this option
2244 if {([string compare "" $nextoption]) && \
2245 (![regexp -- - $nextoption])} then {
2246 set optionData(module) $nextoption
2247 incr index
2248 break
2249 } else {
2250 listAppendIf noparms "-m"
2251 }
2252 }
2253 v {
2254 incr optionData(verbose)
2255 }
2256 q {
2257 incr optionData(quiet) -1
2258 }
2259 d {
2260 set optionData(debug) 1
2261 }
2262 H {
2263 ShowUsage $argv0
2264 exit
2265 }
2266 V {
2267 puts "[file tail $argv0] version [package require ${NamespaceCurrent}]"
2268 exit
2269 }
2270 default {
2271 listAppendIf invalidopt "-$suboption"
2272 }
2273 }
2274 }
2275 }
2276 default {
2277 listAppendIf invalidopt $option
2278 }
2279 }
2280 }
2281
2282 # Complain about invalid command line arguments
2283 if {[info exists invalidopt]} then {
2284 foreach option $invalidopt {
2285 puts stderr "[file tail $argv0]: unrecognized option `$option'"
2286 }
2287 set exit 1
2288 }
2289
2290 # Complain about missing parameters
2291 if {[info exists noparms]} then {
2292 foreach option $noparms {
2293 puts stderr "[file tail $argv0]: option requires a parameter `$option'"
2294 }
2295 set exit 1
2296 }
2297
2298 if {[info exists exit]} then {
2299 exit 1
2300 }
2301 }
2302
2303 ##
2304 ## Show usage information
2305 ##
2306 ## Args: none
2307 ## Returns: nothing
2308 ##
2309 proc ShowUsage {argv0} {
2310 puts "Usage: [file tail $argv0] <options>"
2311 puts " Valid options:"
2312 puts " -f, --cfgfile <file> use configuration file `file'"
2313 puts " -c, --config start interactive configuration"
2314 puts " -u, --update update module database"
2315 puts " -n, --noupdate don't update module database even if its outdated"
2316 puts " -r, --rebuild force complete rebuild of module database"
2317 puts " -t, --time time compare/update/rebuild of module database"
2318 puts " -i, --include <file> include module `file' when updating database"
2319 puts " -e, --exclude <file> exclude module `file' when updating database"
2320 puts " -m, --module <file> only update database for module `file'"
2321 puts " -v, --verbose use more than once for more verbose operation"
2322 puts " -q, --quiet use more than once for quieter operation"
2323 puts " -d, --debug start debug mode with tclsh"
2324 puts " -H, --help show this help"
2325 puts " -V, --version show version information"
2326 }
2327
2328 ##
2329 ## Enter interactive configuration
2330 ##
2331 ## Args: none
2332 ## Returns: nothing
2333 ##
2334 proc Iconfig {} {
2335 variable NamespaceCurrent
2336 variable SessionData
2337
2338 set SessionData(prompt) "wolfpack> "
2339 fileevent stdin readable ${NamespaceCurrent}::IconfigReadStdin
2340 puts "Entering wolfpack configuration system..."
2341 puts "Type 'help' for help."
2342 puts -nonewline $SessionData(prompt)
2343 flush stdout
2344 vwait forever
2345 }
2346
2347 ##
2348 ## Read stdin and process commands
2349 ##
2350 ## Args: none
2351 ## Returns: nothing
2352 ##
2353 # FIXME: readline-like support?
2354 proc IconfigReadStdin {} {
2355 variable SessionData
2356 variable configData
2357 variable configFile
2358
2359 set exit 0
2360 if {[eof stdin]} {
2361 set exit 1
2362 }
2363 set stdin [string trimright [gets stdin]]
2364 set data [join [lrange [split $stdin] 1 end]]
2365 if {[string compare "" $stdin]} then {
2366 switch -exact -- [lindex [split $stdin] 0] {
2367 set {
2368 IconfigSet $data
2369 }
2370 enable {
2371 IconfigEnable $data
2372 }
2373 disable {
2374 IconfigDisable $data
2375 }
2376 modules {
2377 IconfigModules $data
2378 }
2379 info {
2380 IconfigInfo $data
2381 }
2382 help {
2383 IconfigHelp $data
2384 }
2385 quit {
2386 set exit 1
2387 }
2388 default {
2389 puts "What? You need 'help'"
2390 }
2391 }
2392 }
2393 if {(!$exit) && (![eof stdin])} then {
2394 puts -nonewline $SessionData(prompt)
2395 flush stdout
2396 } else {
2397 # Save configuration data
2398 arraySave configData $configFile 0 "configuration file "
2399 # Save module database
2400 saveModuleDatabase
2401 puts ""
2402 flush stdout
2403 exit
2404 }
2405 return
2406 }
2407
2408 ##
2409 ## Set configuration settings
2410 ##
2411 ## Args: data
2412 ## Returns: nothing
2413 ##
2414 proc IconfigSet {data} {
2415 variable configData
2416 variable configDefaults
2417
2418 if {![string compare "" $data]} then {
2419 set fmtlen1 [arrayMaxElementDataLength configDefaults 3]
2420 if {$fmtlen1 < 13} then {
2421 set fmtlen1 13 ;# 'Description: '
2422 }
2423 set names [array names configData]
2424 set fmtlen2 [listMaxElementLength $names]
2425 if {$fmtlen2 < 8} then {
2426 set fmtlen2 8 ;# 'Option: '
2427 }
2428 puts ""
2429 puts "Current settings:"
2430 puts ""
2431 # FIXME: this needs improvement
2432 puts [format " %-${fmtlen1}s %-${fmtlen2}s %s" Description: Option: Value:]
2433 foreach option [lsort $names] {
2434 if {[info exists configDefaults($option)]} then {
2435 puts [format " %-${fmtlen1}s %-${fmtlen2}s %s" [lindex $configDefaults($option) 3] $option $configData($option)]
2436 } else {
2437 puts [format " %-${fmtlen1}s %-${fmtlen2}s %s" "" $option $configData($option)]
2438 }
2439 }
2440 puts ""
2441 } else {
2442 set option [lindex [split $data] 0]
2443 if {![info exists configData($option)]} then {
2444 puts "Invalid option: $option"
2445 } else {
2446 set value [join [lrange [split $data] 1 end]]
2447 if {![string compare "" $value]} then {
2448 puts "Currently: $configData($option)"
2449 } else {
2450 set configData($option) $value
2451 puts "Set $option to: $value"
2452 }
2453 }
2454 }
2455 return
2456 }
2457
2458 ##
2459 ## Enable a module
2460 ##
2461 ## Args: data
2462 ## Returns: nothing
2463 ##
2464 proc IconfigEnable {data} {
2465 set module [lindex [split $data] 0]
2466 if {![string compare "" $module]} then {
2467 puts "Usage: enable <module>"
2468 } elseif {[moduleExists $module]} then {
2469 if {![getModuleDatabaseData $module load]} then {
2470 setModuleDatabaseData $module load 1
2471 puts "Enabled module: $module"
2472 } else {
2473 puts "Module `$module' is already enabled."
2474 }
2475 } else {
2476 puts "Invalid module: $module"
2477 }
2478 return
2479 }
2480
2481 ##
2482 ## Disable a module
2483 ##
2484 ## Args: data
2485 ## Returns: nothing
2486 ##
2487 proc IconfigDisable {data} {
2488 set module [lindex [split $data] 0]
2489 if {![string compare "" $module]} then {
2490 puts "Usage: disable <module>"
2491 } elseif {[moduleExists $module]} then {
2492 if {[getModuleDatabaseData $module load] == 1} then {
2493 setModuleDatabaseData $module load 0
2494 puts "Disabled module: $module"
2495 } else {
2496 puts "Module `$module' is already disabled."
2497 }
2498 } else {
2499 puts "Invalid module: $module"
2500 }
2501 return
2502 }
2503
2504 ##
2505 ## List modules
2506 ##
2507 ## Args: data
2508 ## returns: nothing
2509 ##
2510 # FIXME: format the list of modules better (proc from texttools?)
2511 proc IconfigModules {data} {
2512 if {[string compare "" [set modules [listModules]]]} then {
2513 set what [lindex [split $data] 0]
2514 if {![string compare "" $what]} then {
2515 set what "all"
2516 }
2517 switch -exact -- $what {
2518 * -
2519 all {
2520 puts "Available modules:"
2521 foreach line [splitList $modules 65 " " " "] {
2522 puts " $line"
2523 }
2524 }
2525 enabled {
2526 set list ""
2527 foreach module $modules {
2528 if {[getModuleDatabaseData $module load]} {
2529 lappend list $module
2530 }
2531 }
2532 if {[llength $list]} then {
2533 puts "Enabled modules:"
2534 foreach line [splitList $list 65 " " " "] {
2535 puts " $line"
2536 }
2537 } else {
2538 puts "No modules enabled"
2539 }
2540 }
2541 disabled {
2542 set list ""
2543 foreach module $modules {
2544 if {![getModuleDatabaseData $module load]} {
2545 lappend list $module
2546 }
2547 }
2548 if {[llength $list]} then {
2549 puts "Disabled modules:"
2550 foreach line [splitList $list 65 " " " "] {
2551 puts " $line"
2552 }
2553 } else {
2554 puts "No modules disabled"
2555 }
2556 }
2557 default {
2558 puts "Error: 'option' must be one of: all, enabled, disabled"
2559 }
2560 }
2561 } else {
2562 puts "Error: No modules available."
2563 }
2564 return
2565 }
2566
2567 ##
2568 ## Show info for the given module
2569 ##
2570 ## Args: data
2571 ## returns: nothing
2572 ##
2573 # FIXME: add multiple module support as in config.tcl and or integrate?
2574 proc IconfigInfo {data} {
2575 set module [lindex [split $data] 0]
2576 if {![string compare "" $module]} then {
2577 puts "Usage: info <module>"
2578 } elseif {[moduleExists $module]} then {
2579 puts "Info for module: $module"
2580 puts ""
2581 puts "Filename: [getModuleDatabaseData $module file]"
2582 puts "MD5: [getModuleDatabaseData $module md5sum]"
2583 puts "Version: [getModuleDatabaseData $module version]"
2584 if {[getModuleDatabaseData $module load]} then {
2585 puts "Enabled: yes"
2586 } else {
2587 puts "Enabled: no"
2588 }
2589 if {[string compare "" [set config [getModuleDatabaseData $module config]]]} then {
2590 puts "Config file: $config"
2591 }
2592 if {[string compare "" [set author [getModuleDatabaseData $module author]]]} then {
2593 puts "Author: $author"
2594 }
2595 if {[string compare "" [set provides [getModuleDatabaseData $module provides]]]} then {
2596 puts "Provided commands:"
2597 foreach line [splitList $provides 65 " " " "] {
2598 puts " $line"
2599 }
2600 }
2601 if {[string compare "" [set requires [getModuleDatabaseData $module requires]]]} then {
2602 puts "Required commands:"
2603 foreach line [splitList $requires 65 " " " "] {
2604 puts " $line"
2605 }
2606 }
2607 puts "Description:"
2608 foreach line [splitList [getModuleDatabaseData $module description] 65 " " " "] {
2609 puts " $line"
2610 }
2611 } else {
2612 puts "Invalid module: $module"
2613 }
2614 return
2615 }
2616
2617 ##
2618 ## Show configuration help
2619 ##
2620 ## Args: data
2621 ## Returns: nothing
2622 ##
2623 proc IconfigHelp {data} {
2624 if {![string compare "" $data]} then {
2625 set data help
2626 }
2627 switch -exact -- $data {
2628 set {
2629 puts "### set \[option\] \[value\]"
2630 puts " Sets an option to what you specify."
2631 puts " Shows current setting for an option if no new value is given."
2632 puts " Shows current settings for all options if no option is given."
2633 }
2634 enable {
2635 puts "### enable <module>"
2636 puts " Enables the given module."
2637 }
2638 disable {
2639 puts "### disable <module>"
2640 puts " Disables the given module."
2641 }
2642 info {
2643 puts "### info <module>"
2644 puts " Show info for the given module."
2645 }
2646 modules {
2647 puts "### modules \[what\]"
2648 puts " Available options: all, enabled, disabled"
2649 puts " all: Shows all available modules"
2650 puts " enabled: Shows enabled modules"
2651 puts " disabled: Shows disabled modules"
2652 }
2653 help {
2654 puts "### Avaliable commands:"
2655 puts " set \[option\] \[value\]"
2656 puts " enable <module>"
2657 puts " disable <module>"
2658 puts " info <module>"
2659 puts " modules \[what\]"
2660 puts " help \[command\]"
2661 puts " quit"
2662 puts "You can get help on individual commands: 'help <command>'"
2663 }
2664 quit {
2665 puts "### quit"
2666 puts " Quits interactive configuration."
2667 }
2668 default {
2669 puts "No help available on that."
2670 }
2671 }
2672 return
2673 }
2674
2675 ##
2676 ## Inline startup and init code
2677 ##
2678
2679 # Eggdrop doesn't currently set argv0, so we use it to detect load type.
2680 if {[info exists argv0]} then {
2681 set TclshMode 1
2682 } else {
2683 set TclshMode 0
2684 }
2685
2686 # Eval command line arguments if loading with tclsh
2687 if {$TclshMode} then {
2688 EvalArgs $argc $argv $argv0
2689 }
2690
2691 wpLog o * "wolfpack.tcl v[package require $NamespaceCurrent] loading..."
2692
2693 # Init md5Sum command
2694 if {![md5Init]} then {
2695 wpLog o * "Error: can't find a usable md5 command!"
2696 # FIXME: would it be safe to remove $NamespaceCurrent in this case?
2697 return 0
2698 }
2699
2700 # Export commands
2701 eval namespace export [join $ExportList]
2702
2703 # Set missing variables to default values
2704 if {![info exists configDataChanged]} then {
2705 set configDataChanged 0
2706 }
2707 if {![info exists moduleDatabaseDataChanged]} then {
2708 set moduleDatabaseDataChanged 0
2709 }
2710 if {![info exists moduleLoadedList]} then {
2711 set moduleLoadedList ""
2712 }
2713
2714 # Find configuration file name
2715 global env wp-config-file
2716 if {[string compare "" $optionData(cfgfile)]} then {
2717 set configFile $optionData(cfgfile)
2718 } elseif {([info exists wp-config-file]) && \
2719 ([string compare "" ${wp-config-file}])} then {
2720 set configFile ${wp-config-file}
2721 } elseif {([info exists env(WP_CONFIG_FILE)]) && \
2722 ([string compare "" $env(WP_CONFIG_FILE)])} then {
2723 set configFile $env(WP_CONFIG_FILE)
2724 } else {
2725 set configFile wolfpack.conf
2726 }
2727
2728 wpLog o * "Using configuration file: $configFile"
2729
2730 # Load configuration data
2731 arrayLoad configData $configFile 0 "configuration file "
2732
2733 # Unset unknown configuration variables
2734 foreach name [array names configData] {
2735 if {![info exists configDefaults($name)]} then {
2736 unset configData($name)
2737 set configDataChanged 1
2738 }
2739 }
2740
2741 # Set missing configuration variables to defaults
2742 foreach {name data} [array get configDefaults] {
2743 if {![info exists configData($name)]} then {
2744 set configData($name) [lindex $data 1]
2745 set configDataChanged 1
2746 }
2747 }
2748
2749 # Set oldConfigData configuration variables to match
2750 foreach {name data} [array get configData] {
2751 if {![info exists oldConfigData($name)]} then {
2752 set oldConfigData($name) $data
2753 }
2754 }
2755
2756 # Save configuration data if changed
2757 if {$configDataChanged} then {
2758 arraySave configData $configFile 0 "configuration file "
2759 }
2760
2761 # Check verbose/quiet options
2762 if {$optionData(quiet)} then {
2763 set Verbose $optionData(quiet)
2764 } elseif {$configData(verbose)} then {
2765 set Verbose $configData(verbose)
2766 } else {
2767 set Verbose $optionData(verbose)
2768 }
2769
2770 # Check update/noupdate/rebuild options
2771 if {(($configData(update)) || ($optionData(update))) &&
2772 (!$optionData(noupdate))} then {
2773 set UpdateDatabase 1
2774 } else {
2775 set UpdateDatabase 0
2776 }
2777 if {$optionData(rebuild)} then {
2778 set RebuildDatabase 1
2779 } else {
2780 set RebuildDatabase 0
2781 }
2782
2783 # Sanity check: old eggdrop versions used [time] for a timestamp command
2784 if {(($optionData(time)) || ($configData(time))) && \
2785 ([catch {time}])} then {
2786 set TimeOk 1
2787 } else {
2788 set TimeOk 0
2789 }
2790
2791 ##################################################
2792 #
2793 # FIXME: Add support for 'include', 'exclude', and 'module' options
2794 #
2795 # # Build list of module option data
2796 # set ModuleOptionData [list $optionData(include) $optionData(exclude) $optionData(module)]
2797
2798 foreach opt "include exclude module" {
2799 if {[string compare "" $optionData($opt)]} then {
2800 wpLog o * "Warning: `$opt' option not implemented yet."
2801 }
2802 }
2803
2804 #
2805 ##################################################
2806
2807 # Load module database
2808 if {$Verbose >= 0} then {
2809 wpLog o * "Loading module database..."
2810 }
2811
2812 if {$TimeOk} then {
2813 set LoadTime [time {set LoadResult [loadModuleDatabase $Verbose]}]
2814 } else {
2815 set LoadResult [loadModuleDatabase $Verbose]
2816 }
2817
2818 if {$LoadResult != -1} then {
2819 if {$Verbose >= 0} then {
2820 if {[info exists LoadTime]} then {
2821 wpLog o * "Done. ([format "%.3f" [expr [lindex $LoadTime 0] / 1000000.0]] seconds elapsed)"
2822 } else {
2823 wpLog o * "Done."
2824 }
2825 }
2826 set CreateDatabase 0
2827 } else {
2828 if {$Verbose >= 0} then {
2829 wpLog o * "Warning: module database does not exist."
2830 }
2831 set CreateDatabase 1
2832 }
2833
2834 # Compare and update module database if we are not going to rebuild it
2835 if {($UpdateDatabase) && (!$RebuildDatabase) && (!$CreateDatabase)} then {
2836
2837 if {$Verbose >= 0} then {
2838 wpLog o * "Comparing and updating module database..."
2839 }
2840
2841 if {$TimeOk} then {
2842 set UpdateTime [time {updateModuleDatabase $Verbose}]
2843 } else {
2844 updateModuleDatabase $Verbose
2845 }
2846
2847 if {$Verbose >= 0} then {
2848 if {[info exists UpdateTime]} then {
2849 wpLog o * "Done. ([format "%.3f" [expr [lindex $UpdateTime 0] / 1000000.0]] seconds elapsed)"
2850 } else {
2851 wpLog o * "Done."
2852 }
2853 }
2854
2855 # Rebuild database if requested or it does not exist
2856 } elseif {($RebuildDatabase) || ($CreateDatabase)} then {
2857
2858 if {$Verbose >= 0} then {
2859 if {$CreateDatabase} then {
2860 wpLog o * "Creating module database..."
2861 } else {
2862 wpLog o * "Rebuilding module database..."
2863