/[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.1.1.1 - (show annotations) (download) (as text) (vendor branch)
Mon Mar 19 04:16:07 2001 UTC (18 years, 3 months ago) by guppy
Branch: wolfpack
CVS Tags: wolfpack_0
Changes since 1.1: +0 -0 lines
File MIME type: application/x-tcl
moved wolfpack from the old cvsroot to this one

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

webmaster@eggheads.org
ViewVC Help
Powered by ViewVC 1.1.23